run ormolu formatterHEADmaster

1 files changed, 734 insertions, 673 deletions

diff --git a/Resources.hs b/Resources.hs
index ce38b21..da5040e 100644
--- a/Resources.hs
+++ b/Resources.hs
@@ -1,580 +1,612 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE LambdaCase #-}
-module Resources where
 
-import qualified SDL
-import qualified SDL.Image
+module Resources where
 
-import Foreign.Storable
-import Foreign.Ptr
+import Control.Applicative
+import Control.Concurrent
+import Control.Monad
+import Data.Angle
+import Data.Array
+import qualified Data.Array.IO as ArrIO
+import qualified Data.Foldable as Fold
+import Data.Function
+import Data.Maybe
+import qualified Data.Sequence as Seq
+import qualified Data.StateVar as SV
+import Data.Time.Clock.POSIX
+import Debug.Trace
 import Foreign.Marshal.Array
-
+import Foreign.Ptr
+import Foreign.Storable
+import Graphics.GL.Compatibility30
+import Graphics.Glyph.BufferBuilder
+import Graphics.Glyph.ExtendedGL as Ex
 import Graphics.Glyph.GLMath as V
 import Graphics.Glyph.GlyphObject
+import Graphics.Glyph.Mat4
 import Graphics.Glyph.ObjLoader
 import Graphics.Glyph.Shaders
-import Graphics.SDL.SDLHelp
-import Graphics.Glyph.BufferBuilder
-import Graphics.Glyph.Mat4
 import Graphics.Glyph.Util
-import Graphics.Glyph.ExtendedGL as Ex
 import Graphics.Rendering.OpenGL as GL
-import Graphics.GL.Compatibility30
-
-import Control.Applicative
-import Control.Monad
-
-import Data.Angle
-import Data.Function
-import qualified Data.Sequence as Seq
-import qualified Data.Foldable as Fold
-import Data.Maybe
-import Debug.Trace
-
+import Graphics.SDL.SDLHelp
+import qualified SDL
+import qualified SDL.Image
 import System.Exit
-import qualified Data.Array.IO as ArrIO
-
-import Data.Array
-import qualified Data.StateVar as SV
-import Data.Time.Clock.POSIX
-import Control.Concurrent
-import Text.Printf
 import System.IO
 import System.Random hiding (uniform)
-import qualified SDL
+import Text.Printf
 
 {- Types of terrain which are possible -}
-data TileType = Forest | Beach | Water | Grass | Jungle | Mountains | 
-                Tundra | Unknown deriving (Enum,Eq)
+data TileType
+  = Forest
+  | Beach
+  | Water
+  | Grass
+  | Jungle
+  | Mountains
+  | Tundra
+  | Unknown
+  deriving (Enum, Eq)
+
 instance Show TileType where
-   show = \case
-     Forest -> "F"
-     Beach  -> "B"
-     Water -> "W"
-     Grass -> "G"
-     Jungle -> "J"
-     Mountains -> "M"
-     Tundra -> "T"
-     Unknown -> "?"
+  show = \case
+    Forest -> "F"
+    Beach -> "B"
+    Water -> "W"
+    Grass -> "G"
+    Jungle -> "J"
+    Mountains -> "M"
+    Tundra -> "T"
+    Unknown -> "?"
 
 {- A tile has 2 things, a type and
  - elevation, however, the term tile is
  - a litte misleading, it is really a point. -}
-data Tile = Tile {
-    tileType :: TileType,
+data Tile = Tile
+  { tileType :: TileType,
     elevation :: Int
-} deriving Show
+  }
+  deriving (Show)
 
 {- Position of the camera as described by
  - polar coordinates -}
-data CameraPosition = CameraPosition {
-    pEye :: Vec3 GLfloat,
+data CameraPosition = CameraPosition
+  { pEye :: Vec3 GLfloat,
     pTh :: GLfloat,
     pPh :: GLfloat
-} deriving Show
+  }
+  deriving (Show)
 
 {- The central data type for rendering
  - the scene. Contains the 'global' information -}
-data Resources = Resources {
-    rWindow :: SDL.Window,
-
+data Resources = Resources
+  { rWindow :: SDL.Window,
     rPosition :: CameraPosition,
     rDPosition :: CameraPosition,
-
     pMatrix :: Mat4 GLfloat,
     mvMatrix :: Mat4 GLfloat,
-
     routines :: [ResourcesClosure -> IO ()],
-
     timeSpeed :: Int,
     time :: Int,
-
-    heightMap :: Array (Int,Int) Tile,
+    heightMap :: Array (Int, Int) Tile,
     positionUpdate :: (Resources -> IO Resources),
-
     {- Smaller if in first person -}
     speedFactor :: GLfloat,
     {- Higher if shift is held -}
     speedMultiplier :: GLfloat,
     {- Direction -}
     speedDirection :: Vec3 GLfloat,
-
     dDown :: GLfloat,
-    waterArray :: ArrIO.IOArray (Int,Int) GLfloat,
+    waterArray :: ArrIO.IOArray (Int, Int) GLfloat,
     headBob :: GLfloat,
     mode :: CameraMode,
     threadDiff :: Double
-}
+  }
 
 setHeadBob :: GLfloat -> Resources -> Resources
-setHeadBob f r = r { headBob = f }
+setHeadBob f r = r {headBob = f}
 
 setThreadDiff :: Double -> Resources -> Resources
-setThreadDiff f r = r { threadDiff = f }
+setThreadDiff f r = r {threadDiff = f}
 
 setRSurface :: SDL.Window -> Resources -> Resources
-setRSurface x r = r { rWindow = x }
+setRSurface x r = r {rWindow = x}
 
 setRPosition :: CameraPosition -> Resources -> Resources
-setRPosition x r = r { rPosition = x }
+setRPosition x r = r {rPosition = x}
 
 setRDPosition :: CameraPosition -> Resources -> Resources
-setRDPosition x r = r { rDPosition = x }
+setRDPosition x r = r {rDPosition = x}
 
 setPMatrix :: Mat4 GLfloat -> Resources -> Resources
-setPMatrix x r = r { pMatrix = x }
+setPMatrix x r = r {pMatrix = x}
 
 setMvMatrix :: Mat4 GLfloat -> Resources -> Resources
-setMvMatrix x r = r { mvMatrix = x }
+setMvMatrix x r = r {mvMatrix = x}
 
 setRoutines :: [ResourcesClosure -> IO ()] -> Resources -> Resources
-setRoutines x r = r { routines = x }
+setRoutines x r = r {routines = x}
 
 setSpeedDirection :: Vec3 GLfloat -> Resources -> Resources
-setSpeedDirection x r = r { speedDirection = x }
+setSpeedDirection x r = r {speedDirection = x}
 
 setTimeSpeed :: Int -> Resources -> Resources
-setTimeSpeed x r = r { timeSpeed = x }
+setTimeSpeed x r = r {timeSpeed = x}
 
 setTime :: Int -> Resources -> Resources
-setTime x r = r { time = x }
+setTime x r = r {time = x}
 
-setHeightMap :: Array (Int,Int) Tile -> Resources -> Resources
-setHeightMap x r = r { heightMap = x }
+setHeightMap :: Array (Int, Int) Tile -> Resources -> Resources
+setHeightMap x r = r {heightMap = x}
 
 setPositionUpdate :: (Resources -> IO Resources) -> Resources -> Resources
-setPositionUpdate x r = r { positionUpdate = x }
+setPositionUpdate x r = r {positionUpdate = x}
 
 setSpeedFactor :: GLfloat -> Resources -> Resources
-setSpeedFactor x r = r { speedFactor = x }
+setSpeedFactor x r = r {speedFactor = x}
 
 setDDown :: GLfloat -> Resources -> Resources
-setDDown x r = r { dDown = x }
+setDDown x r = r {dDown = x}
 
-setWaterArray :: ArrIO.IOArray (Int,Int) GLfloat -> Resources -> Resources
-setWaterArray x r = r { waterArray = x }
+setWaterArray :: ArrIO.IOArray (Int, Int) GLfloat -> Resources -> Resources
+setWaterArray x r = r {waterArray = x}
 
 getSpeed :: Resources -> GLfloat
-getSpeed res =speedFactor res * speedMultiplier res * norm (speedDirection res)
+getSpeed res = speedFactor res * speedMultiplier res * norm (speedDirection res)
 
 cameraForward :: CameraPosition -> Vec3 GLfloat
-cameraForward (CameraPosition _ th ph) = Vec3 $ toEuclidian (1,th,ph)
+cameraForward (CameraPosition _ th ph) = Vec3 $ toEuclidian (1, th, ph)
 
 cameraUp :: CameraPosition -> Vec3 GLfloat
-cameraUp (CameraPosition _ _ ph) = 
-    if ph' >= 90 && ph' < 270 then Vec3 (0,-1,0) else Vec3 (0,1,0)
-            where ph' = (floor ph::Int) `mod` 360
+cameraUp (CameraPosition _ _ ph) =
+  if ph' >= 90 && ph' < 270 then Vec3 (0, -1, 0) else Vec3 (0, 1, 0)
+  where
+    ph' = (floor ph :: Int) `mod` 360
 
 cameraRight :: CameraPosition -> Vec3 GLfloat
 cameraRight cam = cameraUp cam × cameraForward cam
 
-
 getVelocity :: Resources -> Vec3 GLfloat
 getVelocity res =
-    let dir = speedDirection res
-        camdir = cameraForward $ rPosition res
-        truedir = coordinateConvert camdir (Vec3 (0,1,0)) dir in
-    getSpeed res `vScale` maybeNormalize truedir
+  let dir = speedDirection res
+      camdir = cameraForward $ rPosition res
+      truedir = coordinateConvert camdir (Vec3 (0, 1, 0)) dir
+   in getSpeed res `vScale` maybeNormalize truedir
 
-data CameraMode = Oracle | FirstPerson deriving Eq
+data CameraMode = Oracle | FirstPerson deriving (Eq)
 
 {- Central data type for rendering each frame -}
-data ResourcesClosure = ResourcesClosure {
-      rcMVMatrix :: Mat4 GLfloat
-    , rcPMatrix  :: Mat4 GLfloat
-    , rcLightPos :: Vec4 GLfloat
-    , rcTime     :: GLfloat
-    , rcNormalMatrix  :: Mat3 GLfloat
-    , rcGlobalAmbient :: Vec4 GLfloat
-    , rcCameraPos :: CameraPosition
-    , rcCameraLocation :: Vec3 GLfloat
-    , rcResources :: Resources
-}
+data ResourcesClosure = ResourcesClosure
+  { rcMVMatrix :: Mat4 GLfloat,
+    rcPMatrix :: Mat4 GLfloat,
+    rcLightPos :: Vec4 GLfloat,
+    rcTime :: GLfloat,
+    rcNormalMatrix :: Mat3 GLfloat,
+    rcGlobalAmbient :: Vec4 GLfloat,
+    rcCameraPos :: CameraPosition,
+    rcCameraLocation :: Vec3 GLfloat,
+    rcResources :: Resources
+  }
 
 {- A function that makes the resources data first
  - person -}
 firstPerson :: Resources -> IO Resources
 firstPerson res =
-    let camera@(CameraPosition (Vec3 (x,curh,y)) th ph) = rPosition res
-        (_,(w,h)) = bounds $ heightMap res
-        (!!!) arr (x',y') = if x' < 0 || y' < 0 || x' > w || y' > h then -1000 else elevation (arr ! (x',y'))
-        h1 = ((/10.0).fromIntegral) (heightMap res !!! (floor x, floor y) )
-        h2 = ((/10.0).fromIntegral) (heightMap res !!! (floor x, floor (y+1)) )
-        h3 = ((/10.0).fromIntegral) (heightMap res !!! (floor (x+1), floor y) )
-        h4 = ((/10.0).fromIntegral) (heightMap res !!! (floor (x+1), floor (y+1)))
-        u = x - (int $ (floor x::Int))
-        v = y - (int $ (floor y::Int))
-        mixu1 = mix h3 h1 u
-        mixu2 = mix h4 h2 u
-        newh = mix mixu2 mixu1 v
-        droph = curh - dDown res
-        speed = getSpeed res
-        jitter = (max 0 $ speed - 0.029) ** 0.1 / 2
-        dy = sin (headBob res*2) * jitter
-        dx = realToFrac $ cos (headBob res) * jitter 
-        in do
-    return $ ((setHeadBob.(+ jitter)) <..> headBob) $
-        if (newh+0.3 > droph) then
-            setSpeedFactor 0.03 $
-            setRPosition (CameraPosition (Vec3 (x,newh+0.2,y)) (th + (asin dx) * speed * 15) (ph - (asin dy) * speed * 15)) $
+  let camera@(CameraPosition (Vec3 (x, curh, y)) th ph) = rPosition res
+      (_, (w, h)) = bounds $ heightMap res
+      (!!!) arr (x', y') = if x' < 0 || y' < 0 || x' > w || y' > h then -1000 else elevation (arr ! (x', y'))
+      h1 = ((/ 10.0) . fromIntegral) (heightMap res !!! (floor x, floor y))
+      h2 = ((/ 10.0) . fromIntegral) (heightMap res !!! (floor x, floor (y + 1)))
+      h3 = ((/ 10.0) . fromIntegral) (heightMap res !!! (floor (x + 1), floor y))
+      h4 = ((/ 10.0) . fromIntegral) (heightMap res !!! (floor (x + 1), floor (y + 1)))
+      u = x - (int $ (floor x :: Int))
+      v = y - (int $ (floor y :: Int))
+      mixu1 = mix h3 h1 u
+      mixu2 = mix h4 h2 u
+      newh = mix mixu2 mixu1 v
+      droph = curh - dDown res
+      speed = getSpeed res
+      jitter = (max 0 $ speed - 0.029) ** 0.1 / 2
+      dy = sin (headBob res * 2) * jitter
+      dx = realToFrac $ cos (headBob res) * jitter
+   in do
+        return $
+          ((setHeadBob . (+ jitter)) <..> headBob) $
+            if (newh + 0.3 > droph)
+              then
+                setSpeedFactor 0.03 $
+                  setRPosition (CameraPosition (Vec3 (x, newh + 0.2, y)) (th + (asin dx) * speed * 15) (ph - (asin dy) * speed * 15)) $
                     setDDown 0 res
-            else
+              else
                 setRPosition (CameraPosition (Vec3 (x, droph, y)) th ph) $
-                        setDDown (dDown res + 0.03) res
+                  setDDown (dDown res + 0.03) res
 
 {- A function which will explode if a uniform
  - does not exist for the shader given, otherwis,
  - it will return a list of uniform locations -}
 getUniformsSafe :: Program -> [String] -> IO [UniformLocation]
 getUniformsSafe prog uniforms =
-    forM uniforms $ \a_uniform -> do
-        tmp <- get $ uniformLocation prog a_uniform
-        case tmp of
-            UniformLocation (-1) -> do
-                putStrLn $ "No uniform with name: "++a_uniform
-                exitWith (ExitFailure 112)
-            _ ->  return tmp
+  forM uniforms $ \a_uniform -> do
+    tmp <- get $ uniformLocation prog a_uniform
+    case tmp of
+      UniformLocation (-1) -> do
+        putStrLn $ "No uniform with name: " ++ a_uniform
+        exitWith (ExitFailure 112)
+      _ -> return tmp
 
 {- Builds an model view matrix given the
  - camera position of the scene -}
 buildMVMatrix :: CameraPosition -> Mat4 GLfloat
 buildMVMatrix camera@(CameraPosition eye _ _) =
-    let lookat = eye <+> cameraForward camera in
-        lookAtMatrix eye lookat (cameraUp camera)
+  let lookat = eye <+> cameraForward camera
+   in lookAtMatrix eye lookat (cameraUp camera)
 
 {- Called after each frame to crunch throught the
  - events -}
 eventHandle :: SDL.EventPayload -> Resources -> IO Resources
 eventHandle event = case event of
-    SDL.KeyboardEvent e ->
-      case (SDL.keyboardEventKeyMotion e, SDL.keysymScancode (SDL.keyboardEventKeysym e)) of
-        (SDL.Pressed, SDL.ScancodeW) -> setPh 2
-        (SDL.Released, SDL.ScancodeW) -> setPh 0
-        (SDL.Pressed, SDL.ScancodeA) -> setTh (-2)
-        (SDL.Released, SDL.ScancodeA) -> setTh 0
-        (SDL.Pressed, SDL.ScancodeS) -> setPh (-2)
-        (SDL.Released, SDL.ScancodeS) -> setPh 0
-        (SDL.Pressed, SDL.ScancodeD) -> setTh 2
-        (SDL.Released, SDL.ScancodeD) -> setTh 0
-        (SDL.Pressed, SDL.ScancodeI) -> return . setSpeedDirection (Vec3 (0, 0, 1))
-        (SDL.Released, SDL.ScancodeI) -> return . setSpeedDirection (Vec3 (0, 0, 0))
-        (SDL.Pressed, SDL.ScancodeK) -> return . setSpeedDirection (Vec3 (0, 0, -1))
-        (SDL.Released, SDL.ScancodeK) -> return . setSpeedDirection (Vec3 (0, 0, 0))
-
-        -- Pressing the 'q' enters first-person-mode
-        (SDL.Pressed, SDL.ScancodeQ) -> return . appAll
-           [setPositionUpdate firstPerson,
-            setSpeedFactor 0.1,
-            \res -> res { dDown = negate $ (\(Vec3 (_,y,_)) -> y) $ resourcesVelocity res}]
-
-        (SDL.Pressed, SDL.ScancodeE) -> return . appAll
-          [setPositionUpdate return,
-           setSpeedFactor 1,
-           \res -> res { dDown = 0 }]
-
-        (SDL.Pressed, SDL.ScancodeSpace) -> return . appAll
-          [setSpeedFactor 0.05,
-           \res -> res { dDown = -0.2 }]
-
-        (SDL.Pressed, SDL.ScancodeLShift) -> \res -> return $ res { speedMultiplier = 4 }
-
-        (SDL.Released, SDL.ScancodeLShift) -> \res -> return $ res { speedMultiplier = 1 }
-          
-    --  KeyDown (Keysym SDLK_LSHIFT _ _) -> do
-    --      return $ setSpeedMultiplier 4 res
-
-    --  KeyUp (Keysym SDLK_LSHIFT _ _) -> do
-    --      return $ setSpeedMultiplier 1 res
-    --     KeyUp (Keysym SDLK_e _ _) ->
-    --         return $
-    --             setPositionUpdate return $
-    --             setSpeedFactor 1 $
-    --                 if speed res > 0 then setSpeed 1 res else res
-              
-        _ -> return
-    _ -> return
-
-    where
-      appAll :: [a -> a] -> a -> a
-      appAll (f:fs) a = appAll fs (f a)
-      appAll [] a = a
-
-      setPh i res =
-        let (CameraPosition eye th ph) = rDPosition res in
-              return $ setRDPosition (CameraPosition eye th i) res
-      setTh i res =
-        let (CameraPosition eye th ph) = rDPosition res in
-              return $ setRDPosition (CameraPosition eye i ph) res
+  SDL.KeyboardEvent e ->
+    case (SDL.keyboardEventKeyMotion e, SDL.keysymScancode (SDL.keyboardEventKeysym e)) of
+      (SDL.Pressed, SDL.ScancodeW) -> setPh 2
+      (SDL.Released, SDL.ScancodeW) -> setPh 0
+      (SDL.Pressed, SDL.ScancodeA) -> setTh (-2)
+      (SDL.Released, SDL.ScancodeA) -> setTh 0
+      (SDL.Pressed, SDL.ScancodeS) -> setPh (-2)
+      (SDL.Released, SDL.ScancodeS) -> setPh 0
+      (SDL.Pressed, SDL.ScancodeD) -> setTh 2
+      (SDL.Released, SDL.ScancodeD) -> setTh 0
+      (SDL.Pressed, SDL.ScancodeI) -> return . setSpeedDirection (Vec3 (0, 0, 1))
+      (SDL.Released, SDL.ScancodeI) -> return . setSpeedDirection (Vec3 (0, 0, 0))
+      (SDL.Pressed, SDL.ScancodeK) -> return . setSpeedDirection (Vec3 (0, 0, -1))
+      (SDL.Released, SDL.ScancodeK) -> return . setSpeedDirection (Vec3 (0, 0, 0))
+      -- Pressing the 'q' enters first-person-mode
+      (SDL.Pressed, SDL.ScancodeQ) ->
+        return
+          . appAll
+            [ setPositionUpdate firstPerson,
+              setSpeedFactor 0.1,
+              \res -> res {dDown = negate $ (\(Vec3 (_, y, _)) -> y) $ resourcesVelocity res}
+            ]
+      (SDL.Pressed, SDL.ScancodeE) ->
+        return
+          . appAll
+            [ setPositionUpdate return,
+              setSpeedFactor 1,
+              \res -> res {dDown = 0}
+            ]
+      (SDL.Pressed, SDL.ScancodeSpace) ->
+        return
+          . appAll
+            [ setSpeedFactor 0.05,
+              \res -> res {dDown = -0.2}
+            ]
+      (SDL.Pressed, SDL.ScancodeLShift) -> \res -> return $ res {speedMultiplier = 4}
+      (SDL.Released, SDL.ScancodeLShift) -> \res -> return $ res {speedMultiplier = 1}
+      --  KeyDown (Keysym SDLK_LSHIFT _ _) -> do
+      --      return $ setSpeedMultiplier 4 res
+
+      --  KeyUp (Keysym SDLK_LSHIFT _ _) -> do
+      --      return $ setSpeedMultiplier 1 res
+      --     KeyUp (Keysym SDLK_e _ _) ->
+      --         return $
+      --             setPositionUpdate return $
+      --             setSpeedFactor 1 $
+      --                 if speed res > 0 then setSpeed 1 res else res
+
+      _ -> return
+  _ -> return
+  where
+    appAll :: [a -> a] -> a -> a
+    appAll (f : fs) a = appAll fs (f a)
+    appAll [] a = a
+
+    setPh i res =
+      let (CameraPosition eye th ph) = rDPosition res
+       in return $ setRDPosition (CameraPosition eye th i) res
+    setTh i res =
+      let (CameraPosition eye th ph) = rDPosition res
+       in return $ setRDPosition (CameraPosition eye i ph) res
 
 -- eventHandle :: SDL.Event -> Resources -> IO Resources
 -- eventHandle event res = do
-    -- let (CameraPosition eye th ph) = rDPosition res
-    -- let (CameraPosition peye pth pph) = rPosition res
-    -- case event of
-    --     KeyDown (Keysym SDLK_ESCAPE _ _) -> exitSuccess
-
-    --     KeyDown (Keysym SDLK_EQUALS _ _) ->
-    --         return $ (setTimeSpeed <..> ((+1).timeSpeed)) res
-    --     KeyDown (Keysym SDLK_MINUS _ _) ->
-    --         return $ (setTimeSpeed <..> ((subtract 1).timeSpeed)) res
-
-    --     KeyDown (Keysym SDLK_UP _ _) ->
-    --         return $ setRDPosition (CameraPosition eye th (ph+1)) res
-    --     KeyDown (Keysym SDLK_DOWN _ _) ->
-    --         return $ setRDPosition (CameraPosition eye th (ph-1)) res
-    --     KeyDown (Keysym SDLK_RIGHT _ _) ->
-    --         return $ setRDPosition (CameraPosition eye (th+1) ph) res
-    --     KeyDown (Keysym SDLK_LEFT _ _) ->
-    --         return $ setRDPosition (CameraPosition eye (th-1) ph) res
-
-    --     KeyUp (Keysym SDLK_UP _ _) ->
-    --         return $ setRDPosition (CameraPosition eye th (ph-1)) res
-    --     KeyUp (Keysym SDLK_DOWN _ _) ->
-    --         return $ setRDPosition (CameraPosition eye th (ph+1)) res
-    --     KeyUp (Keysym SDLK_RIGHT _ _) ->
-    --         return $ setRDPosition (CameraPosition eye (th-1) ph) res
-    --     KeyUp (Keysym SDLK_LEFT _ _) ->
-    --         return $ setRDPosition (CameraPosition eye (th+1) ph) res
-
-    --     MouseMotion _ _ x y -> do
-    --         return $ setRPosition (CameraPosition peye (pth+(fromIntegral x/30.0)) (pph-(fromIntegral y/30.0))) res
-
-    --     KeyDown (Keysym SDLK_w _ _) ->
-    --         return $ setSpeed (speed res + speedFactor res) res
-    --     KeyDown (Keysym SDLK_s _ _) ->
-    --         return $ setSpeed (speed res - speedFactor res) res
-    --     KeyUp (Keysym SDLK_w _ _) ->
-    --         return $ setSpeed 0 res
-    --     KeyUp (Keysym SDLK_s _ _) ->
-    --         return $ setSpeed 0 res
-
-    --     KeyUp (Keysym SDLK_q _ _) ->
-    --         let getY (Vec3 (_,y,_)) = y in
-    --         return $
-    --             setPositionUpdate firstPerson $
-    --             setSpeedFactor 0.1 $
-    --                 (setDDown <..> (negate . getY . resourcesVelocity)) res
-    --     KeyUp (Keysym SDLK_e _ _) ->
-    --         return $
-    --             setPositionUpdate return $
-    --             setSpeedFactor 1 $
-    --                 if speed res > 0 then setSpeed 1 res else res
-
-    --     KeyUp (Keysym SDLK_f _ _) -> do
-    --         ret <- reshape 1920 1080 res
-    --         SDL.toggleFullscreen $ rSurface ret
-    --         SDL.showCursor False
-    --         SDL.grabInput True
-    --         return ret
-    --     KeyUp (Keysym SDLK_g _ _) -> do
-    --         SDL.showCursor False
-    --         SDL.grabInput True
-    --         return res
-
-    --     KeyDown (Keysym SDLK_SPACE _ _) -> do
-    --         return $ setDDown (-0.3) res
-    --  MouseMotion _ _ x y -> do
-    --      return $
-    --          setRPosition (CameraPosition peye (pth+(fromIntegral x/30.0)) (pph-(fromIntegral y/30.0))) res
-
-    --  KeyDown (Keysym SDLK_w _ _) ->
-    --      return $ ((setSpeedDirection.(<+>Vec3 (0,0,1))) <..> speedDirection) res
-    --  KeyDown (Keysym SDLK_s _ _) ->
-    --      return $ ((setSpeedDirection.(<->Vec3 (0,0,1))) <..> speedDirection) res
-    --  KeyDown (Keysym SDLK_d _ _) ->
-    --      return $ ((setSpeedDirection.(<+>Vec3 (1,0,0))) <..> speedDirection) res
-    --  KeyDown (Keysym SDLK_a _ _) ->
-    --      return $ ((setSpeedDirection.(<->Vec3 (1,0,0))) <..> speedDirection) res
-
-    --  KeyUp (Keysym SDLK_w _ _) ->
-    --      return $ ((setSpeedDirection.(<->Vec3 (0,0,1))) <..> speedDirection) res
-    --  KeyUp (Keysym SDLK_s _ _) ->
-    --      return $ ((setSpeedDirection.(<+>Vec3 (0,0,1))) <..> speedDirection) res
-    --  KeyUp (Keysym SDLK_d _ _) ->
-    --      return $ ((setSpeedDirection.(<->Vec3 (1,0,0))) <..> speedDirection) res
-    --  KeyUp (Keysym SDLK_a _ _) ->
-    --      return $ ((setSpeedDirection.(<+>Vec3 (1,0,0))) <..> speedDirection) res
-
-    --  KeyUp (Keysym SDLK_q _ _) ->
-    --      let getY (Vec3 (_,y,_)) = y in
-    --      return $
-    --          setPositionUpdate firstPerson $
-    --          setMode FirstPerson $
-    --              (setDDown <..> (negate . getY . resourcesVelocity)) res
-    --  KeyUp (Keysym SDLK_e _ _) ->
-    --      return $
-    --          setPositionUpdate return $
-    --          setSpeedFactor 1 $
-    --          setMode Oracle res
-
-    --  KeyUp (Keysym SDLK_f _ _) -> do
-    --      ret <- reshape 1920 1080 res
-    --      SDL.toggleFullscreen $ rSurface ret
-    --      SDL.showCursor False
-    --      SDL.grabInput True
-    --      return ret
-    --  KeyUp (Keysym SDLK_c _ _) -> do
-    --      SDL.showCursor True
-    --      SDL.grabInput False
-    --      return res
-    --  KeyUp (Keysym SDLK_g _ _) -> do
-    --      SDL.showCursor False
-    --      SDL.grabInput True
-    --      return res
-
-    --  KeyDown (Keysym SDLK_SPACE _ _) -> do
-    --      return $ 
-    --          setDDown (-0.2) $
-    --          setSpeedFactor 0.05 res
-
-    --  KeyDown (Keysym SDLK_LSHIFT _ _) -> do
-    --      return $ setSpeedMultiplier 4 res
-
-    --  KeyUp (Keysym SDLK_LSHIFT _ _) -> do
-    --      return $ setSpeedMultiplier 1 res
-
-    --     KeyDown (Keysym SDLK_LSHIFT _ _) -> do
-    --         return $ (setSpeed <..> ((*3) . speed)) res
-    --     KeyUp (Keysym SDLK_LSHIFT _ _) -> do
-    --         return $ (setSpeed <..> ((/3) . speed)) res
-
-    --     _ -> return res
+-- let (CameraPosition eye th ph) = rDPosition res
+-- let (CameraPosition peye pth pph) = rPosition res
+-- case event of
+--     KeyDown (Keysym SDLK_ESCAPE _ _) -> exitSuccess
+
+--     KeyDown (Keysym SDLK_EQUALS _ _) ->
+--         return $ (setTimeSpeed <..> ((+1).timeSpeed)) res
+--     KeyDown (Keysym SDLK_MINUS _ _) ->
+--         return $ (setTimeSpeed <..> ((subtract 1).timeSpeed)) res
+
+--     KeyDown (Keysym SDLK_UP _ _) ->
+--         return $ setRDPosition (CameraPosition eye th (ph+1)) res
+--     KeyDown (Keysym SDLK_DOWN _ _) ->
+--         return $ setRDPosition (CameraPosition eye th (ph-1)) res
+--     KeyDown (Keysym SDLK_RIGHT _ _) ->
+--         return $ setRDPosition (CameraPosition eye (th+1) ph) res
+--     KeyDown (Keysym SDLK_LEFT _ _) ->
+--         return $ setRDPosition (CameraPosition eye (th-1) ph) res
+
+--     KeyUp (Keysym SDLK_UP _ _) ->
+--         return $ setRDPosition (CameraPosition eye th (ph-1)) res
+--     KeyUp (Keysym SDLK_DOWN _ _) ->
+--         return $ setRDPosition (CameraPosition eye th (ph+1)) res
+--     KeyUp (Keysym SDLK_RIGHT _ _) ->
+--         return $ setRDPosition (CameraPosition eye (th-1) ph) res
+--     KeyUp (Keysym SDLK_LEFT _ _) ->
+--         return $ setRDPosition (CameraPosition eye (th+1) ph) res
+
+--     MouseMotion _ _ x y -> do
+--         return $ setRPosition (CameraPosition peye (pth+(fromIntegral x/30.0)) (pph-(fromIntegral y/30.0))) res
+
+--     KeyDown (Keysym SDLK_w _ _) ->
+--         return $ setSpeed (speed res + speedFactor res) res
+--     KeyDown (Keysym SDLK_s _ _) ->
+--         return $ setSpeed (speed res - speedFactor res) res
+--     KeyUp (Keysym SDLK_w _ _) ->
+--         return $ setSpeed 0 res
+--     KeyUp (Keysym SDLK_s _ _) ->
+--         return $ setSpeed 0 res
+
+--     KeyUp (Keysym SDLK_q _ _) ->
+--         let getY (Vec3 (_,y,_)) = y in
+--         return $
+--             setPositionUpdate firstPerson $
+--             setSpeedFactor 0.1 $
+--                 (setDDown <..> (negate . getY . resourcesVelocity)) res
+--     KeyUp (Keysym SDLK_e _ _) ->
+--         return $
+--             setPositionUpdate return $
+--             setSpeedFactor 1 $
+--                 if speed res > 0 then setSpeed 1 res else res
+
+--     KeyUp (Keysym SDLK_f _ _) -> do
+--         ret <- reshape 1920 1080 res
+--         SDL.toggleFullscreen $ rSurface ret
+--         SDL.showCursor False
+--         SDL.grabInput True
+--         return ret
+--     KeyUp (Keysym SDLK_g _ _) -> do
+--         SDL.showCursor False
+--         SDL.grabInput True
+--         return res
+
+--     KeyDown (Keysym SDLK_SPACE _ _) -> do
+--         return $ setDDown (-0.3) res
+--  MouseMotion _ _ x y -> do
+--      return $
+--          setRPosition (CameraPosition peye (pth+(fromIntegral x/30.0)) (pph-(fromIntegral y/30.0))) res
+
+--  KeyDown (Keysym SDLK_w _ _) ->
+--      return $ ((setSpeedDirection.(<+>Vec3 (0,0,1))) <..> speedDirection) res
+--  KeyDown (Keysym SDLK_s _ _) ->
+--      return $ ((setSpeedDirection.(<->Vec3 (0,0,1))) <..> speedDirection) res
+--  KeyDown (Keysym SDLK_d _ _) ->
+--      return $ ((setSpeedDirection.(<+>Vec3 (1,0,0))) <..> speedDirection) res
+--  KeyDown (Keysym SDLK_a _ _) ->
+--      return $ ((setSpeedDirection.(<->Vec3 (1,0,0))) <..> speedDirection) res
+
+--  KeyUp (Keysym SDLK_w _ _) ->
+--      return $ ((setSpeedDirection.(<->Vec3 (0,0,1))) <..> speedDirection) res
+--  KeyUp (Keysym SDLK_s _ _) ->
+--      return $ ((setSpeedDirection.(<+>Vec3 (0,0,1))) <..> speedDirection) res
+--  KeyUp (Keysym SDLK_d _ _) ->
+--      return $ ((setSpeedDirection.(<->Vec3 (1,0,0))) <..> speedDirection) res
+--  KeyUp (Keysym SDLK_a _ _) ->
+--      return $ ((setSpeedDirection.(<+>Vec3 (1,0,0))) <..> speedDirection) res
+
+--  KeyUp (Keysym SDLK_q _ _) ->
+--      let getY (Vec3 (_,y,_)) = y in
+--      return $
+--          setPositionUpdate firstPerson $
+--          setMode FirstPerson $
+--              (setDDown <..> (negate . getY . resourcesVelocity)) res
+--  KeyUp (Keysym SDLK_e _ _) ->
+--      return $
+--          setPositionUpdate return $
+--          setSpeedFactor 1 $
+--          setMode Oracle res
+
+--  KeyUp (Keysym SDLK_f _ _) -> do
+--      ret <- reshape 1920 1080 res
+--      SDL.toggleFullscreen $ rSurface ret
+--      SDL.showCursor False
+--      SDL.grabInput True
+--      return ret
+--  KeyUp (Keysym SDLK_c _ _) -> do
+--      SDL.showCursor True
+--      SDL.grabInput False
+--      return res
+--  KeyUp (Keysym SDLK_g _ _) -> do
+--      SDL.showCursor False
+--      SDL.grabInput True
+--      return res
+
+--  KeyDown (Keysym SDLK_SPACE _ _) -> do
+--      return $
+--          setDDown (-0.2) $
+--          setSpeedFactor 0.05 res
+
+--  KeyDown (Keysym SDLK_LSHIFT _ _) -> do
+--      return $ setSpeedMultiplier 4 res
+
+--  KeyUp (Keysym SDLK_LSHIFT _ _) -> do
+--      return $ setSpeedMultiplier 1 res
+
+--     KeyDown (Keysym SDLK_LSHIFT _ _) -> do
+--         return $ (setSpeed <..> ((*3) . speed)) res
+--     KeyUp (Keysym SDLK_LSHIFT _ _) -> do
+--         return $ (setSpeed <..> ((/3) . speed)) res
+
+--     _ -> return res
 
 {- Callback for the display -}
 displayHandle :: Resources -> IO Resources
 displayHandle resources = do
-    time1 <- getPOSIXTime
-    let cameraPos@(CameraPosition loc _ _) = rPosition resources
-    let lighty = ((/10) . fromIntegral . time) resources
-    let logist c =  (1 / (1 + 2.71828**(-c*x))) * 0.9 + 0.1
-            where x = sine $ Degrees (lighty)
-    let globalAmbient::(GLfloat,GLfloat,GLfloat,GLfloat)
-        globalAmbient = ( logist 2+0.1, logist 10, (logist 15) + 0.1,(sine.Degrees) lighty)
-    let lightPos = Vec4( 50,
-                         1000000 * (sine.Degrees $ lighty),
-                         -1000000 * (cosine.Degrees . (/10) . fromIntegral . time) resources,
-                         1 )
-    let l_mvMatrix = buildMVMatrix $ cameraPos
-    let normalMatrix = glslModelViewToNormalMatrix l_mvMatrix
-
-    clearColor $= Color4 0 0 0 0
-    clear [ColorBuffer, DepthBuffer]
-    printErrors "Display"
-
-
-    let rc = ResourcesClosure l_mvMatrix
-                (pMatrix resources)
-                (l_mvMatrix `glslMatMul` lightPos)
-                (fromIntegral $ time resources)
-                (normalMatrix)
-                (Vec4 globalAmbient)
-                cameraPos
-                loc
-                resources
-
-                in mapM_ (Prelude.$rc) $ routines resources
-
-    SDL.glSwapWindow (rWindow resources)
-    time2 <- getPOSIXTime
-
-    let diff = threadDiff resources - (realToFrac $ time2 - time1)
-    when (diff > 0) (threadDelay $ round $ diff * 1000000)
-    time3 <- getPOSIXTime
-    let fps = realToFrac $ 1 / (time3 - time1) :: Double
-
-    putStr $ printf "FPS: %.2f\r" fps
-
-    return $
-        if' (fps < 30)
-            ((setThreadDiff.(subtract 0.0001)) <..> threadDiff)
-            ((setThreadDiff.(+0.0001)) <..> threadDiff) resources
+  time1 <- getPOSIXTime
+  let cameraPos@(CameraPosition loc _ _) = rPosition resources
+  let lighty = ((/ 10) . fromIntegral . time) resources
+  let logist c = (1 / (1 + 2.71828 ** (- c * x))) * 0.9 + 0.1
+        where
+          x = sine $ Degrees (lighty)
+  let globalAmbient :: (GLfloat, GLfloat, GLfloat, GLfloat)
+      globalAmbient = (logist 2 + 0.1, logist 10, (logist 15) + 0.1, (sine . Degrees) lighty)
+  let lightPos =
+        Vec4
+          ( 50,
+            1000000 * (sine . Degrees $ lighty),
+            -1000000 * (cosine . Degrees . (/ 10) . fromIntegral . time) resources,
+            1
+          )
+  let l_mvMatrix = buildMVMatrix $ cameraPos
+  let normalMatrix = glslModelViewToNormalMatrix l_mvMatrix
+
+  clearColor $= Color4 0 0 0 0
+  clear [ColorBuffer, DepthBuffer]
+  printErrors "Display"
+
+  let rc =
+        ResourcesClosure
+          l_mvMatrix
+          (pMatrix resources)
+          (l_mvMatrix `glslMatMul` lightPos)
+          (fromIntegral $ time resources)
+          (normalMatrix)
+          (Vec4 globalAmbient)
+          cameraPos
+          loc
+          resources
+   in mapM_ (Prelude.$ rc) $ routines resources
+
+  SDL.glSwapWindow (rWindow resources)
+  time2 <- getPOSIXTime
+
+  let diff = threadDiff resources - (realToFrac $ time2 - time1)
+  when (diff > 0) (threadDelay $ round $ diff * 1000000)
+  time3 <- getPOSIXTime
+  let fps = realToFrac $ 1 / (time3 - time1) :: Double
+
+  putStr $ printf "FPS: %.2f\r" fps
+
+  return $
+    if'
+      (fps < 30)
+      ((setThreadDiff . (subtract 0.0001)) <..> threadDiff)
+      ((setThreadDiff . (+ 0.0001)) <..> threadDiff)
+      resources
 
 cameraToEuclidian :: CameraPosition -> Vec3 GLfloat
-cameraToEuclidian (CameraPosition _ ph th) = V.normalize $ Vec3 $ toEuclidian (1,ph,th)
+cameraToEuclidian (CameraPosition _ ph th) = V.normalize $ Vec3 $ toEuclidian (1, ph, th)
 
 resourcesVelocity :: Resources -> Vec3 GLfloat
 resourcesVelocity res = getSpeed res `vScale` cameraToEuclidian (rPosition res)
 
 resourcesUnderWater :: Resources -> IO Bool
 resourcesUnderWater res = do
-    let (CameraPosition (Vec3 (x,ch,y)) _ _) = rPosition res
-    (_,(w,h)) <- ArrIO.getBounds $ waterArray res
-    if x < 0 || y < 0 || x > int w || y > int h then return False else do
-        height <- ArrIO.readArray (waterArray res) (floor x, floor y)
-        return (height > ch && height >= 0)
+  let (CameraPosition (Vec3 (x, ch, y)) _ _) = rPosition res
+  (_, (w, h)) <- ArrIO.getBounds $ waterArray res
+  if x < 0 || y < 0 || x > int w || y > int h
+    then return False
+    else do
+      height <- ArrIO.readArray (waterArray res) (floor x, floor y)
+      return (height > ch && height >= 0)
 
 updateHandle :: Resources -> IO Resources
 updateHandle res = do
-   (positionUpdate res) $ setRPosition (rPosition res `cAdd` rDPosition res) $
-            let new = ((+) `on` (Prelude.$ res)) timeSpeed time  in
-                setTime new res
-   where (CameraPosition x y z) `cAdd` (CameraPosition _ y' z') =
-           let x' = getVelocity res in
-            CameraPosition (x <+> x') (y + y') (z + z')
+  (positionUpdate res) $
+    setRPosition (rPosition res `cAdd` rDPosition res) $
+      let new = ((+) `on` (Prelude.$ res)) timeSpeed time
+       in setTime new res
+  where
+    (CameraPosition x y z) `cAdd` (CameraPosition _ y' z') =
+      let x' = getVelocity res
+       in CameraPosition (x <+> x') (y + y') (z + z')
 
 reshape :: Int -> Int -> Resources -> IO Resources
 reshape w h res =
-    defaultReshape w h () >> do
-        let pMatrix' = perspectiveMatrix 50 (fromIntegral w / fromIntegral h) 0.1 10000
-        return $ setPMatrix pMatrix' res
+  defaultReshape w h () >> do
+    let pMatrix' = perspectiveMatrix 50 (fromIntegral w / fromIntegral h) 0.1 10000
+    return $ setPMatrix pMatrix' res
 
 loadProgramSafe' ::
-    (IsShaderSource a,
-     IsShaderSource b,
-     IsShaderSource c) => a -> b -> Maybe c -> IO Program
+  ( IsShaderSource a,
+    IsShaderSource b,
+    IsShaderSource c
+  ) =>
+  a ->
+  b ->
+  Maybe c ->
+  IO Program
 loadProgramSafe' s1 s2 s3 = do
-    progMaybe <- loadProgramSafe s1 s2 s3
-    when (isNothing progMaybe) $ exitWith (ExitFailure 111)
-    return $ fromJust progMaybe
-
-loadProgramFullSafe' :: 
-    (IsShaderSource tc, IsShaderSource te,
-     IsShaderSource g, IsShaderSource v,
-     IsShaderSource f) => Maybe (tc, te) -> Maybe g -> v -> f -> IO Program
+  progMaybe <- loadProgramSafe s1 s2 s3
+  when (isNothing progMaybe) $ exitWith (ExitFailure 111)
+  return $ fromJust progMaybe
+
+loadProgramFullSafe' ::
+  ( IsShaderSource tc,
+    IsShaderSource te,
+    IsShaderSource g,
+    IsShaderSource v,
+    IsShaderSource f
+  ) =>
+  Maybe (tc, te) ->
+  Maybe g ->
+  v ->
+  f ->
+  IO Program
 loadProgramFullSafe' a b c d = do
-    progMaybe <- loadProgramFullSafe a b c d
-    when (isNothing progMaybe) $ exitWith (ExitFailure 111)
-    return $ fromJust progMaybe
+  progMaybe <- loadProgramFullSafe a b c d
+  when (isNothing progMaybe) $ exitWith (ExitFailure 111)
+  return $ fromJust progMaybe
 
 buildTerrainObject :: BuilderM GLfloat b -> IO (ResourcesClosure -> IO ())
 buildTerrainObject builder = do
-    let terrainList = map ("terrain/"++)
-         [ "forest.png", "beach.png",
-           "oceanfloor.png", "grass.png",
-           "jungle.png", "mountains.png",
-           "tundra.png" ]
-    print terrainList
-    terrainProg <- loadProgramSafe' "shaders/basic.vert" "shaders/basic.frag" (Nothing::Maybe String)
-    lst <- forM (zip [0..7::Int] $ terrainList ++ repeat "terrain/unknown.png") $ \(idx,str) -> do
-            location <- get $ uniformLocation terrainProg $ "textures[" ++! idx ++ "]"
-            SDL.Image.load str >>= textureFromSurface >>= return . (,) location
-
-    let (dx,dy) = (mapT2 $ (1/).fromIntegral) (mapT2 maximum (unzip $ map (textureSize.snd) lst));
-    dXlocation <-