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 <- get $ uniformLocation terrainProg "dX"
-    dYlocation <- get $ uniformLocation terrainProg "dY"
-    putStrLn $ "(dx,dy)=" ++! (dx,dy)
-    obj <- newDefaultGlyphObjectWithClosure builder () $ \_ -> do
-                    currentProgram $= Just terrainProg
-                    forM_ (zip [0..] lst) $ \(i,(loc,td)) ->
-                        setupTexturing td loc i
-                    uniform dXlocation $= Index1 (dx::GLfloat)
-                    uniform dYlocation $= Index1 (dy::GLfloat)
-                    printErrors "terrainObjectClosure"
-
-    [lightposU, globalAmbientU, pjMatrixU, mvMatrixU, normalMatrixU, fogU]
-        <- getUniformsSafe terrainProg ["lightPos","globalAmbient","pjMatrix","mvMatrix","normalMatrix","fog"]
-    return $ \rc -> do
-        draw $ prepare obj $ \_ -> do
-            cullFace $= Just Front
-            uniform mvMatrixU $= rcMVMatrix rc
-            uniform pjMatrixU $= rcPMatrix rc
-            uniform lightposU $= rcLightPos rc
-            uniform normalMatrixU $= rcNormalMatrix rc
-            uniform globalAmbientU $= rcGlobalAmbient rc
-            bool <- (resourcesUnderWater $ rcResources rc)
-            if bool then
-                uniform fogU $= Index1 (0.9::GLfloat) else
-                uniform fogU $= Index1 (0.0::GLfloat)
+  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 <- get $ uniformLocation terrainProg "dX"
+  dYlocation <- get $ uniformLocation terrainProg "dY"
+  putStrLn $ "(dx,dy)=" ++! (dx, dy)
+  obj <- newDefaultGlyphObjectWithClosure builder () $ \_ -> do
+    currentProgram $= Just terrainProg
+    forM_ (zip [0 ..] lst) $ \(i, (loc, td)) ->
+      setupTexturing td loc i
+    uniform dXlocation $= Index1 (dx :: GLfloat)
+    uniform dYlocation $= Index1 (dy :: GLfloat)
+    printErrors "terrainObjectClosure"
+
+  [lightposU, globalAmbientU, pjMatrixU, mvMatrixU, normalMatrixU, fogU] <-
+    getUniformsSafe terrainProg ["lightPos", "globalAmbient", "pjMatrix", "mvMatrix", "normalMatrix", "fog"]
+  return $ \rc -> do
+    draw $
+      prepare obj $ \_ -> do
+        cullFace $= Just Front
+        uniform mvMatrixU $= rcMVMatrix rc
+        uniform pjMatrixU $= rcPMatrix rc
+        uniform lightposU $= rcLightPos rc
+        uniform normalMatrixU $= rcNormalMatrix rc
+        uniform globalAmbientU $= rcGlobalAmbient rc
+        bool <- (resourcesUnderWater $ rcResources rc)
+        if bool
+          then uniform fogU $= Index1 (0.9 :: GLfloat)
+          else uniform fogU $= Index1 (0.0 :: GLfloat)
 
 -- cloudProgram :: IO (ResourcesClosure -> IO ())
 -- cloudProgram = do
@@ -583,13 +615,13 @@ buildTerrainObject builder = do
 --                 bColor4 (x,y,z,0)
 --                 bVertex3 (x,y+20,z)
 --     program <- loadProgramSafe' "shaders/clouds.vert" "shaders/clouds.frag" noShader
--- 
+--
 --     stgen <- newStdGen
 --     array3D <- SA.newListArray ((0,0,0,0),(3,64,64,64)) (map (fromIntegral . (`mod`256)) $ (randoms stgen::[Int]))
--- 
+--
 --     SA.withStorableArray array3D $ \ptr3D -> do
 --         density <- makeTexture3D >>= textureFromPointer3D ptr3D (64,64,64)
--- 
+--
 --         obj' <- newDefaultGlyphObjectWithClosure builder () $ \_ -> do
 --                     currentProgram $= Just program
 --         [mvMatU, pMatU, densityU, globalAmbientU,lightposU] <- mapM (get . uniformLocation program)
@@ -602,93 +634,102 @@ buildTerrainObject builder = do
 --                 uniform globalAmbientU $= rcGlobalAmbient rc
 --                 uniform lightposU $= rcLightPos rc
 --                 setupTexturing3D density densityU 0
-            
-buildSnowVal :: Array (Int,Int) Tile -> StdGen -> BuilderM GLfloat ()
+
+buildSnowVal :: Array (Int, Int) Tile -> StdGen -> BuilderM GLfloat ()
 buildSnowVal arr gen =
-    let (_,(w,h)) = bounds arr
-        run :: [Int] -> (Int,Int) -> BuilderM GLfloat [Int]
-        run rs (x,y) = do
-            let (seed:npart:t) = rs
-                nStdGen = mkStdGen seed
-                height = elevation (arr ! (x,y))
-            when (tileType (arr ! (x,y)) == Tundra) $
-                forM_ (take (npart`mod`50) $ chunkList3 $ randomRs (0::GLfloat,1) nStdGen ) $ \(a,b,c) -> do
-                    let (x',y') = (int x + a, int y + b)
-                    bVertex3 (x',c*100,y')
-                    bColor4 (int $ height `div` 10,1, 0, 0)
-
-            return t
-        in
-
-        foldM_ run (randoms gen) [(x,y) | x <- [1..w], y <- [1..h]]
-
-buildSnowObject :: Array (Int,Int) Tile -> StdGen -> IO (ResourcesClosure -> IO ())
+  let (_, (w, h)) = bounds arr
+      run :: [Int] -> (Int, Int) -> BuilderM GLfloat [Int]
+      run rs (x, y) = do
+        let (seed : npart : t) = rs
+            nStdGen = mkStdGen seed
+            height = elevation (arr ! (x, y))
+        when (tileType (arr ! (x, y)) == Tundra) $
+          forM_ (take (npart `mod` 50) $ chunkList3 $ randomRs (0 :: GLfloat, 1) nStdGen) $ \(a, b, c) -> do
+            let (x', y') = (int x + a, int y + b)
+            bVertex3 (x', c * 100, y')
+            bColor4 (int $ height `div` 10, 1, 0, 0)
+
+        return t
+   in foldM_ run (randoms gen) [(x, y) | x <- [1 .. w], y <- [1 .. h]]
+
+buildSnowObject :: Array (Int, Int) Tile -> StdGen -> IO (ResourcesClosure -> IO ())
 buildSnowObject arr gen = do
-    snowProgram <- loadProgramSafe' "shaders/snow.vert" "shaders/snow.frag" (Just "shaders/snow.geom")
-    obj <-
-        liftM (flip setPrimitiveMode Ex.Points) $
-        newDefaultGlyphObjectWithClosure (buildSnowVal arr gen) () $ \_ -> do
-            currentProgram $= Just snowProgram 
-
-    [globalAmbientU,pjMatrixU,mvMatrixU,timeU] <-
-        getUniformsSafe snowProgram ["globalAmbient","pjMatrix","mvMatrix","time"]
-    return $ \rc -> do
-        draw $ (prepare obj) $ \_ -> do
-            uniform mvMatrixU $= rcMVMatrix rc
-            uniform pjMatrixU $= rcPMatrix rc
-            uniform timeU $= (Index1 $ (rcTime rc/75))
-            uniform globalAmbientU $= rcGlobalAmbient rc
+  snowProgram <- loadProgramSafe' "shaders/snow.vert" "shaders/snow.frag" (Just "shaders/snow.geom")
+  obj <-
+    liftM (flip setPrimitiveMode Ex.Points) $
+      newDefaultGlyphObjectWithClosure (buildSnowVal arr gen) () $ \_ -> do
+        currentProgram $= Just snowProgram
+
+  [globalAmbientU, pjMatrixU, mvMatrixU, timeU] <-
+    getUniformsSafe snowProgram ["globalAmbient", "pjMatrix", "mvMatrix", "time"]
+  return $ \rc -> do
+    draw $
+      (prepare obj) $ \_ -> do
+        uniform mvMatrixU $= rcMVMatrix rc
+        uniform pjMatrixU $= rcPMatrix rc
+        uniform timeU $= (Index1 $ (rcTime rc / 75))
+        uniform globalAmbientU $= rcGlobalAmbient rc
 
 buildForestObject :: Seq.Seq GLfloat -> String -> String -> IO (ResourcesClosure -> IO ())
 buildForestObject a_seq obj tex =
-    if Seq.null a_seq then return ((const.return) ()) else do
-    let bufferIO :: IO BufferObject
-        bufferIO = (newArray . Fold.toList) a_seq >>= ptrToBuffer ArrayBuffer (Seq.length a_seq * 4)
-    
-    !buffer <- bufferIO
-    (log',file) <- loadObjFile obj :: IO ([String],ObjectFile GLfloat)
-    mapM_ putStrLn log'
-    let !treeF = trace "build tree" $ (basicBuildObject file :: BuilderM GLfloat ())
-
-    forestProg <- loadProgramSafe' 
-        "shaders/forest.vert" "shaders/forest.frag" noShader
-
-    woodTexture <- SDL.Image.load tex >>= textureFromSurface
-    let (dx,dy) = (mapT2 $ (1/).fromIntegral) (textureSize woodTexture)
-    dXlocation <- get $ uniformLocation forestProg "dX"
-    dYlocation <- get $ uniformLocation forestProg "dY"
-
-    [textureU,lightU,globalAmbientU,pjMatrixU,mvMatrixU,timeU,normalMatrixU] <-
-        getUniformsSafe forestProg ["texture","light","globalAmbient","pjMatrix","mvMatrix","time","normalMatrix"]
-
-    obj' <- newDefaultGlyphObjectWithClosure treeF () $ \_ -> do
-                currentProgram $= Just forestProg
-                setupTexturing woodTexture textureU 0
-                uniform dXlocation $= (Index1 $ (dx::GLfloat))
-                uniform dYlocation $= (Index1 $ (dy::GLfloat))
-
-                bindBuffer ArrayBuffer $= Just buffer
-
-                let declareAttr location nelem' offset = do
-                            vertexAttribPointer location $=
-                                (ToFloat, VertexArrayDescriptor
-                                    nelem' Float (fromIntegral $ (3+3+2+1+1)*sizeOf (0::GLfloat))
-                                    (wordPtrToPtr offset))
-                            vertexAttribArray location $= Enabled
-                            vertexAttributeDivisor location SV.$= 1
-
-                declareAttr (AttribLocation 10) 3 0
-                declareAttr (AttribLocation 11) 3 (3*4)
-                declareAttr (AttribLocation 12) 2 (6*4)
-                declareAttr (AttribLocation 13) 1 (8*4)
-                declareAttr (AttribLocation 14) 1 (9*4)
-
-                printErrors "forestClosure"
-    putStrLn $ "N trees = " ++! (Seq.length a_seq `div` 3)
-    let obj'' = setNumInstances obj' (Seq.length a_seq `div` 3)
-
-    return $ \rc -> do
-        draw $ (prepare obj'') $ \_ -> do
+  if Seq.null a_seq
+    then return ((const . return) ())
+    else do
+      let bufferIO :: IO BufferObject
+          bufferIO = (newArray . Fold.toList) a_seq >>= ptrToBuffer ArrayBuffer (Seq.length a_seq * 4)
+
+      !buffer <- bufferIO
+      (log', file) <- loadObjFile obj :: IO ([String], ObjectFile GLfloat)
+      mapM_ putStrLn log'
+      let !treeF = trace "build tree" $ (basicBuildObject file :: BuilderM GLfloat ())
+
+      forestProg <-
+        loadProgramSafe'
+          "shaders/forest.vert"
+          "shaders/forest.frag"
+          noShader
+
+      woodTexture <- SDL.Image.load tex >>= textureFromSurface
+      let (dx, dy) = (mapT2 $ (1 /) . fromIntegral) (textureSize woodTexture)
+      dXlocation <- get $ uniformLocation forestProg "dX"
+      dYlocation <- get $ uniformLocation forestProg "dY"
+
+      [textureU, lightU, globalAmbientU, pjMatrixU, mvMatrixU, timeU, normalMatrixU] <-
+        getUniformsSafe forestProg ["texture", "light", "globalAmbient", "pjMatrix", "mvMatrix", "time", "normalMatrix"]
+
+      obj' <- newDefaultGlyphObjectWithClosure treeF () $ \_ -> do
+        currentProgram $= Just forestProg
+        setupTexturing woodTexture textureU 0
+        uniform dXlocation $= (Index1 $ (dx :: GLfloat))
+        uniform dYlocation $= (Index1 $ (dy :: GLfloat))
+
+        bindBuffer ArrayBuffer $= Just buffer
+
+        let declareAttr location nelem' offset = do
+              vertexAttribPointer location
+                $= ( ToFloat,
+                     VertexArrayDescriptor
+                       nelem'
+                       Float
+                       (fromIntegral $ (3 + 3 + 2 + 1 + 1) * sizeOf (0 :: GLfloat))
+                       (wordPtrToPtr offset)
+                   )
+              vertexAttribArray location $= Enabled
+              vertexAttributeDivisor location SV.$= 1
+
+        declareAttr (AttribLocation 10) 3 0
+        declareAttr (AttribLocation 11) 3 (3 * 4)
+        declareAttr (AttribLocation 12) 2 (6 * 4)
+        declareAttr (AttribLocation 13) 1 (8 * 4)
+        declareAttr (AttribLocation 14) 1 (9 * 4)
+
+        printErrors "forestClosure"
+      putStrLn $ "N trees = " ++! (Seq.length a_seq `div` 3)
+      let obj'' = setNumInstances obj' (Seq.length a_seq `div` 3)
+
+      return $ \rc -> do
+        draw $
+          (prepare obj'') $ \_ -> do
             uniform mvMatrixU $= rcMVMatrix rc
             uniform pjMatrixU $= rcPMatrix rc
             uniform lightU $= rcLightPos rc
@@ -698,185 +739,205 @@ buildForestObject a_seq obj tex =
 
 buildWaterObject :: BuilderM GLfloat a -> IO (ResourcesClosure -> IO ())
 buildWaterObject builder = do
-    waterProg <- loadProgramFullSafe' 
-         (Just ("shaders/water.tcs","shaders/water.tes"))
-         noShader "shaders/water.vert" "shaders/water.frag"
-    waterTexture <- SDL.Image.load "textures/water.jpg" >>= textureFromSurface
-    skyTexture <- SDL.Image.load "textures/skybox_top.png" >>= textureFromSurface
-    skyNightTexture <- SDL.Image.load "textures/skybox_top_night.png" >>= textureFromSurface
-    location <- get (uniformLocation waterProg "texture")
-    skyLocation <- get (uniformLocation waterProg "skytex") 
-    skyNightLocation <- get (uniformLocation waterProg "skynight")
-    obj <- (liftM (flip setPrimitiveMode Ex.Patches) $ newDefaultGlyphObjectWithClosure builder () $ \_ -> do
-                currentProgram $= Just waterProg
-                setupTexturing waterTexture location 0
-                setupTexturing skyTexture skyLocation 1
-                setupTexturing skyNightTexture skyNightLocation 2
-            )
-    [fogU] <- getUniformsSafe waterProg ["fog"]
-    return $ \rc -> do
-        draw $ prepare obj $ \_ -> do
-            cullFace $= Nothing
-            GL.patchVertices $= 4
-            uniform (UniformLocation 4) $= rcPMatrix rc 
-            uniform (UniformLocation 5) $= rcMVMatrix rc
-            uniform (UniformLocation 7) $= rcNormalMatrix rc
-            uniform (UniformLocation 8) $= rcLightPos rc
-            uniform (UniformLocation 9) $= Index1 (rcTime rc / 20.0);
-            uniform (UniformLocation 10) $= rcGlobalAmbient rc
-            bool <- (resourcesUnderWater $ rcResources rc)
-            if bool then
-                uniform fogU $= Index1 (0.9::GLfloat) else
-                uniform fogU $= Index1 (0.0::GLfloat)
-    
-
-makeResources :: SDL.Window -> BuilderM GLfloat b ->
-    Seq.Seq GLfloat -> Seq.Seq GLfloat ->
-    BuilderM GLfloat a -> Array (Int,Int) Tile ->
-    ArrIO.IOArray (Int,Int) GLfloat -> IO Resources
+  waterProg <-
+    loadProgramFullSafe'
+      (Just ("shaders/water.tcs", "shaders/water.tes"))
+      noShader
+      "shaders/water.vert"
+      "shaders/water.frag"
+  waterTexture <- SDL.Image.load "textures/water.jpg" >>= textureFromSurface
+  skyTexture <- SDL.Image.load "textures/skybox_top.png" >>= textureFromSurface
+  skyNightTexture <- SDL.Image.load "textures/skybox_top_night.png" >>= textureFromSurface
+  location <- get (uniformLocation waterProg "texture")
+  skyLocation <- get (uniformLocation waterProg "skytex")
+  skyNightLocation <- get (uniformLocation waterProg "skynight")
+  obj <-
+    ( liftM (flip setPrimitiveMode Ex.Patches) $
+        newDefaultGlyphObjectWithClosure builder () $ \_ -> do
+          currentProgram $= Just waterProg
+          setupTexturing waterTexture location 0
+          setupTexturing skyTexture skyLocation 1
+          setupTexturing skyNightTexture skyNightLocation 2
+      )
+  [fogU] <- getUniformsSafe waterProg ["fog"]
+  return $ \rc -> do
+    draw $
+      prepare obj $ \_ -> do
+        cullFace $= Nothing
+        GL.patchVertices $= 4
+        uniform (UniformLocation 4) $= rcPMatrix rc
+        uniform (UniformLocation 5) $= rcMVMatrix rc
+        uniform (UniformLocation 7) $= rcNormalMatrix rc
+        uniform (UniformLocation 8) $= rcLightPos rc
+        uniform (UniformLocation 9) $= Index1 (rcTime rc / 20.0)
+        uniform (UniformLocation 10) $= rcGlobalAmbient rc
+        bool <- (resourcesUnderWater $ rcResources rc)
+        if bool
+          then uniform fogU $= Index1 (0.9 :: GLfloat)
+          else uniform fogU $= Index1 (0.0 :: GLfloat)
+
+makeResources ::
+  SDL.Window ->
+  BuilderM GLfloat b ->
+  Seq.Seq GLfloat ->
+  Seq.Seq GLfloat ->
+  BuilderM GLfloat a ->
+  Array (Int, Int) Tile ->
+  ArrIO.IOArray (Int, Int) GLfloat ->
+  IO Resources
 makeResources window builder forestB jungleB water arr waterarr = do
-    hSetBuffering stdout NoBuffering
-    let pMatrix' = perspectiveMatrix 50 1.8 0.1 100
-
-    stdgen <- newStdGen
-    let l_routines = sequence [
-            skyboxObject,
-            (return $ \_ -> do
+  hSetBuffering stdout NoBuffering
+  let pMatrix' = perspectiveMatrix 50 1.8 0.1 100
+
+  stdgen <- newStdGen
+  let l_routines =
+        sequence
+          [ skyboxObject,
+            ( return $ \_ -> do
                 vertexProgramPointSize $= Enabled
-                depthFunc $= Just Less),
+                depthFunc $= Just Less
+            ),
             buildTerrainObject builder,
-            (return $ \_-> do
+            ( return $ \_ -> do
                 blend $= Disabled
                 cullFace $= Just Back
-                blendFunc $= (GL.SrcAlpha,OneMinusSrcAlpha)),
+                blendFunc $= (GL.SrcAlpha, OneMinusSrcAlpha)
+            ),
             buildWaterObject water,
             buildForestObject forestB "tree.obj" "textures/wood_low.png",
             buildForestObject jungleB "jungletree.obj" "textures/jungle_tree.png"
             -- buildSnowObject arr stdgen
             -- cloudProgram
-         ]
-    Resources 
-        <$> pure window
-        <*> do CameraPosition
-                <$> pure (Vec3 (10,10,-10))
-                <*> pure 0
-                <*> pure 0
-        <*> do CameraPosition
-                <$> pure (Vec3 (0,0,0))
-                <*> pure 0
-                <*> pure 0
-        <*> pure pMatrix'
-        <*> pure pMatrix'
-        <*> l_routines
-        <*> pure 1
+          ]
+  Resources
+    <$> pure window
+    <*> do
+      CameraPosition
+        <$> pure (Vec3 (10, 10, -10))
         <*> pure 0
-        <*> pure arr
-        <*> pure return
-        <*> pure 1
-        <*> pure 1
-        <*> pure (Vec3 (0,0,0))
         <*> pure 0
-        <*> pure waterarr
+    <*> do
+      CameraPosition
+        <$> pure (Vec3 (0, 0, 0))
         <*> pure 0
-        <*> pure Oracle
-        <*> pure 0.033
+        <*> pure 0
+    <*> pure pMatrix'
+    <*> pure pMatrix'
+    <*> l_routines
+    <*> pure 1
+    <*> pure 0
+    <*> pure arr
+    <*> pure return
+    <*> pure 1
+    <*> pure 1
+    <*> pure (Vec3 (0, 0, 0))
+    <*> pure 0
+    <*> pure waterarr
+    <*> pure 0
+    <*> pure Oracle
+    <*> pure 0.033
 
 printErrors :: String -> IO ()
 printErrors ctx =
-    get errors >>= mapM_ (putStrLn . (("GL["++ctx++"]: ")++) . show)
+  get errors >>= mapM_ (putStrLn . (("GL[" ++ ctx ++ "]: ") ++) . show)
 
 skyboxSides :: GLfloat -> BuilderM GLfloat ()
 skyboxSides dist = do
-    let q = trianglesFromQuads $
-                -- back
-                [(bTexture2(0,0),    bVertex3 (-dist,  dist, -dist)),
-                 (bTexture2(0.25,0), bVertex3 ( dist,  dist, -dist)),
-                 (bTexture2(0.25,1), bVertex3 ( dist, -dist, -dist)),
-                 (bTexture2(0,1),    bVertex3 (-dist, -dist, -dist))] ++
-                
-                -- front
-                [(bTexture2(0.75,0),    bVertex3 (-dist,  dist, dist)),
-                 (bTexture2(0.5,0),   bVertex3 ( dist,  dist, dist)),
-                 (bTexture2(0.5,1),   bVertex3 ( dist, -dist, dist)),
-                 (bTexture2(0.75,1),    bVertex3 (-dist, -dist, dist))] ++
-
-                -- right
-                [(bTexture2(0.75,1),    bVertex3 (-dist, -dist,  dist)),
-                 (bTexture2(0.75,0),   bVertex3 (-dist,  dist,  dist)),
-                 (bTexture2(1.0,0),   bVertex3 (-dist,  dist, -dist)),
-                 (bTexture2(1.0,1),    bVertex3 (-dist, -dist, -dist))] ++
-
-                -- left
-                [(bTexture2(0.5,1),    bVertex3 ( dist, -dist,  dist)),
-                 (bTexture2(0.5,0),    bVertex3 ( dist,  dist,  dist)),
-                 (bTexture2(0.25,0) ,    bVertex3 ( dist,  dist, -dist)),
-                 (bTexture2(0.25,1) ,    bVertex3 ( dist, -dist, -dist))]
-
-            in
-        mapM_ (uncurry (>>)) q
+  let q =
+        trianglesFromQuads $
+          -- back
+          [ (bTexture2 (0, 0), bVertex3 (- dist, dist, - dist)),
+            (bTexture2 (0.25, 0), bVertex3 (dist, dist, - dist)),
+            (bTexture2 (0.25, 1), bVertex3 (dist, - dist, - dist)),
+            (bTexture2 (0, 1), bVertex3 (- dist, - dist, - dist))
+          ]
+            ++
+            -- front
+            [ (bTexture2 (0.75, 0), bVertex3 (- dist, dist, dist)),
+              (bTexture2 (0.5, 0), bVertex3 (dist, dist, dist)),
+              (bTexture2 (0.5, 1), bVertex3 (dist, - dist, dist)),
+              (bTexture2 (0.75, 1), bVertex3 (- dist, - dist, dist))
+            ]
+            ++
+            -- right
+            [ (bTexture2 (0.75, 1), bVertex3 (- dist, - dist, dist)),
+              (bTexture2 (0.75, 0), bVertex3 (- dist, dist, dist)),
+              (bTexture2 (1.0, 0), bVertex3 (- dist, dist, - dist)),
+              (bTexture2 (1.0, 1), bVertex3 (- dist, - dist, - dist))
+            ]
+            ++
+            -- left
+            [ (bTexture2 (0.5, 1), bVertex3 (dist, - dist, dist)),
+              (bTexture2 (0.5, 0), bVertex3 (dist, dist, dist)),
+              (bTexture2 (0.25, 0), bVertex3 (dist, dist, - dist)),
+              (bTexture2 (0.25, 1), bVertex3 (dist, - dist, - dist))
+            ]
+   in mapM_ (uncurry (>>)) q
+
 skyboxTop :: GLfloat -> BuilderM GLfloat ()
 skyboxTop dist = do
-        mapM_ (uncurry (>>)) $
-            trianglesFromQuads
-                [(bTexture2(1,0),   bVertex3 ( -dist, dist,  dist)),
-                 (bTexture2(1,1),   bVertex3 (  dist, dist,  dist)),
-                 (bTexture2(0,1),   bVertex3 (  dist, dist, -dist)),
-                 (bTexture2(0,0),   bVertex3 ( -dist, dist, -dist))]
+  mapM_ (uncurry (>>)) $
+    trianglesFromQuads
+      [ (bTexture2 (1, 0), bVertex3 (- dist, dist, dist)),
+        (bTexture2 (1, 1), bVertex3 (dist, dist, dist)),
+        (bTexture2 (0, 1), bVertex3 (dist, dist, - dist)),
+        (bTexture2 (0, 0), bVertex3 (- dist, dist, - dist))
+      ]
 
 skyboxObject :: IO (ResourcesClosure -> IO ())
 skyboxObject = do
-    prog <- loadProgramSafe' "shaders/sky.vert" "shaders/sky.frag" (Nothing::Maybe String)
-    texLoc <- get $ uniformLocation prog "texture"
-    texLocNight <- get $ uniformLocation prog "night_tex"
-    matLoc <- get $ uniformLocation prog "mvMatrix"
-    pmatLoc <- get $ uniformLocation prog "pjMatrix"
-
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $ fromIntegral GL_CLAMP_TO_EDGE
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $ fromIntegral GL_CLAMP_TO_EDGE
-    l_texture <- SDL.Image.load "textures/skybox_sides.png" >>= textureFromSurface
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $ fromIntegral GL_CLAMP_TO_EDGE
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $ fromIntegral GL_CLAMP_TO_EDGE
-    l_texture2 <- SDL.Image.load "textures/skybox_sides_night.png" >>= textureFromSurface
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $ fromIntegral GL_CLAMP_TO_EDGE
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $ fromIntegral GL_CLAMP_TO_EDGE
-    l_textureTop <- SDL.Image.load "textures/skybox_top.png" >>= textureFromSurface
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $ fromIntegral GL_CLAMP_TO_EDGE
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $ fromIntegral GL_CLAMP_TO_EDGE
-    l_textureTopNight <- SDL.Image.load "textures/skybox_top_night.png" >>= textureFromSurface
-
-    [lightposU,multU] <- mapM (get . uniformLocation prog) 
-                    ["lightpos","mult"]
-    topObj <- newDefaultGlyphObjectWithClosure (skyboxTop 1) () $ \_ -> do
-        setupTexturing l_textureTop texLoc 2
-        setupTexturing l_textureTopNight texLocNight 3
-
-    obj <- newDefaultGlyphObjectWithClosure (skyboxSides 1) (matLoc,pmatLoc) $ \_ -> do
-             currentProgram $= Just prog
-             setupTexturing l_texture texLoc 0
-             setupTexturing l_texture2 texLocNight 1
-             printErrors "Skybox"
-
-    let obj' = teardown obj $ \_ -> do
-                 draw topObj
-
-    return $ \rc -> do
-        depthFunc $= Nothing
-        cullFace $= Nothing
-        draw $ prepare obj' $ \this -> do
-            let (l_matLoc,l_pmatLoc) = getResources this
-            let (CameraPosition _ th ph) = rcCameraPos rc
-            uniform lightposU $= rcLightPos rc
-            uniform l_pmatLoc $= rcPMatrix rc
-            uniform l_matLoc $= buildMVMatrix (CameraPosition (Vec3 (0,0,0)) th ph)
-            uniform (UniformLocation 1) $= rcGlobalAmbient rc
-            bool <- (resourcesUnderWater $ rcResources rc)
-            if bool then
-                uniform multU $= Index1 (0.0::GLfloat) else
-                uniform multU $= Index1 (1.0::GLfloat)
-                
-    
+  prog <- loadProgramSafe' "shaders/sky.vert" "shaders/sky.frag" (Nothing :: Maybe String)
+  texLoc <- get $ uniformLocation prog "texture"
+  texLocNight <- get $ uniformLocation prog "night_tex"
+  matLoc <- get $ uniformLocation prog "mvMatrix"
+  pmatLoc <- get $ uniformLocation prog "pjMatrix"
+
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $ fromIntegral GL_CLAMP_TO_EDGE
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $ fromIntegral GL_CLAMP_TO_EDGE
+  l_texture <- SDL.Image.load "textures/skybox_sides.png" >>= textureFromSurface
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $ fromIntegral GL_CLAMP_TO_EDGE
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $ fromIntegral GL_CLAMP_TO_EDGE
+  l_texture2 <- SDL.Image.load "textures/skybox_sides_night.png" >>= textureFromSurface
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $ fromIntegral GL_CLAMP_TO_EDGE
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $ fromIntegral GL_CLAMP_TO_EDGE
+  l_textureTop <- SDL.Image.load "textures/skybox_top.png" >>= textureFromSurface
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $ fromIntegral GL_CLAMP_TO_EDGE
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $ fromIntegral GL_CLAMP_TO_EDGE
+  l_textureTopNight <- SDL.Image.load "textures/skybox_top_night.png" >>= textureFromSurface
+
+  [lightposU, multU] <-
+    mapM
+      (get . uniformLocation prog)
+      ["lightpos", "mult"]
+  topObj <- newDefaultGlyphObjectWithClosure (skyboxTop 1) () $ \_ -> do
+    setupTexturing l_textureTop texLoc 2
+    setupTexturing l_textureTopNight texLocNight 3
+
+  obj <- newDefaultGlyphObjectWithClosure (skyboxSides 1) (matLoc, pmatLoc) $ \_ -> do
+    currentProgram $= Just prog
+    setupTexturing l_texture texLoc 0
+    setupTexturing l_texture2 texLocNight 1
+    printErrors "Skybox"
+
+  let obj' = teardown obj $ \_ -> do
+        draw topObj
+
+  return $ \rc -> do
+    depthFunc $= Nothing
+    cullFace $= Nothing
+    draw $
+      prepare obj' $ \this -> do
+        let (l_matLoc, l_pmatLoc) = getResources this
+        let (CameraPosition _ th ph) = rcCameraPos rc
+        uniform lightposU $= rcLightPos rc
+        uniform l_pmatLoc $= rcPMatrix rc
+        uniform l_matLoc $= buildMVMatrix (CameraPosition (Vec3 (0, 0, 0)) th ph)
+        uniform (UniformLocation 1) $= rcGlobalAmbient rc
+        bool <- (resourcesUnderWater $ rcResources rc)
+        if bool
+          then uniform multU $= Index1 (0.0 :: GLfloat)
+          else uniform multU $= Index1 (1.0 :: GLfloat)
 
 prepareSkybox :: Mat4 GLfloat -> Mat4 GLfloat -> GlyphObject (Mat4 GLfloat -> Mat4 GLfloat -> IO ()) -> IO ()
 prepareSkybox proj lookat obj = do
-    (getResources obj) proj lookat
-
+  (getResources obj) proj lookat