Format with ormolu

4 files changed, 656 insertions, 343 deletions

diff --git a/src/Vivant.hs b/src/Vivant.hs
index 4a93b62..19548ce 100644
--- a/src/Vivant.hs
+++ b/src/Vivant.hs
@@ -14,137 +14,146 @@
 
 module Main where
 
-import           Control.Lens                                 ((.~), (^.))
-import           Control.Monad
-import           Data.Fixed                                   (mod')
-import           Data.Function                                ((&))
-import           Data.Int                                     (Int32)
-import           Data.Set                                     (Set)
-import qualified Data.Set                                     as Set
-import           Data.Word                                    (Word32)
-import           Foreign.C.Types
-import           Foreign.Marshal.Alloc                        (free, malloc)
-import           Foreign.Ptr
-import           Foreign.Storable                             (poke, sizeOf)
-import           Linear
-import           SDL                                          (($=))
-import           SDL.Raw.Enum                                 as SDL
-import           SDL.Raw.Video                                as SDL (glSetAttribute)
-import           SDL.Time                                     (ticks)
-import           SDL.Vect
-import           System.Exit                                  (exitFailure)
-import           System.IO
-
-import qualified Data.ByteString                              as BS
-import qualified Data.Vector.Storable                         as V
-import qualified Graphics.GL.Functions                        as GL (glUniformMatrix4fv)
-import qualified Graphics.Rendering.OpenGL                    as GL
+import Control.Lens ((.~), (^.))
+import Control.Monad
+import qualified Data.ByteString as BS
+import Data.Fixed (mod')
+import Data.Function ((&))
+import Data.Int (Int32)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import qualified Data.Vector.Storable as V
+import Data.Word (Word32)
+import Foreign.C.Types
+import Foreign.Marshal.Alloc (free, malloc)
+import Foreign.Ptr
+import Foreign.Storable (poke, sizeOf)
+import qualified Graphics.GL.Functions as GL (glUniformMatrix4fv)
+import qualified Graphics.Rendering.OpenGL as GL
 import qualified Graphics.Rendering.OpenGL.GL.Shaders.Uniform as GL (UniformLocation (..))
+import Linear
+import Paths_vivant (getDataDir)
+import SDL (($=))
 import qualified SDL
-
-import           Paths_vivant                                 (getDataDir)
-import           Vivant.Shader                                (createProgram)
+import SDL.Raw.Enum as SDL
+import SDL.Raw.Video as SDL (glSetAttribute)
+import SDL.Time (ticks)
+import SDL.Vect
+import System.Exit (exitFailure)
+import System.IO
+import Vivant.Shader (createProgram)
 
 screenWidth, screenHeight :: CInt
 (screenWidth, screenHeight) = (640, 480)
 
 data Camera = Camera
-  { cameraPos   :: V3 Float
-  , cameraUp    :: V3 Float
-  , cameraFront :: V3 Float
-  , cameraSpeed :: Float
-  , cameraPitch :: Float
-  , cameraYaw   :: Float
-  } deriving (Show)
+  { cameraPos :: V3 Float,
+    cameraUp :: V3 Float,
+    cameraFront :: V3 Float,
+    cameraSpeed :: Float,
+    cameraPitch :: Float,
+    cameraYaw :: Float
+  }
+  deriving (Show)
 
 initialCamera :: Camera
-initialCamera = Camera
-  { cameraPos   = V3 0 0 10
-  , cameraUp    = V3 0 1 0
-  , cameraFront = V3 0 0 (-1)
-  , cameraSpeed = 0.05
-  , cameraPitch = 0
-  , cameraYaw   = (-90)
-  }
+initialCamera =
+  Camera
+    { cameraPos = V3 0 0 10,
+      cameraUp = V3 0 1 0,
+      cameraFront = V3 0 0 (-1),
+      cameraSpeed = 0.05,
+      cameraPitch = 0,
+      cameraYaw = (-90)
+    }
 
 data Game = Game
-  { gameProgram     :: Maybe (GL.Program)
-  , gameVao         :: Maybe (GL.VertexArrayObject)
-  , gameModelP      :: Ptr (M44 Float)
-  , gameViewP       :: Ptr (M44 Float)
-  , gameProjectionP :: Ptr (M44 Float)
-  , gameCamera      :: Camera
-  } deriving (Show)
+  { gameProgram :: Maybe (GL.Program),
+    gameVao :: Maybe (GL.VertexArrayObject),
+    gameModelP :: Ptr (M44 Float),
+    gameViewP :: Ptr (M44 Float),
+    gameProjectionP :: Ptr (M44 Float),
+    gameCamera :: Camera
+  }
+  deriving (Show)
 
 initialGameState :: Game
-initialGameState = Game
-  { gameProgram     = Nothing
-  , gameVao         = Nothing
-  , gameModelP      = nullPtr
-  , gameViewP       = nullPtr
-  , gameProjectionP = nullPtr
-  , gameCamera      = initialCamera
-  }
+initialGameState =
+  Game
+    { gameProgram = Nothing,
+      gameVao = Nothing,
+      gameModelP = nullPtr,
+      gameViewP = nullPtr,
+      gameProjectionP = nullPtr,
+      gameCamera = initialCamera
+    }
 
 data MouseInputs = MouseInputs
-  { mousePosition    :: Point V2 Int32
-  , mouseRelative    :: V2 Int32
-  , mousePositionOld :: Maybe (V2 Int32)
-  } deriving (Show)
+  { mousePosition :: Point V2 Int32,
+    mouseRelative :: V2 Int32,
+    mousePositionOld :: Maybe (V2 Int32)
+  }
+  deriving (Show)
 
 initialMouse :: MouseInputs
-initialMouse = MouseInputs
-  { mousePosition = P (V2 400 300)
-  , mouseRelative = V2 0 0
-  , mousePositionOld = Nothing
-  }
+initialMouse =
+  MouseInputs
+    { mousePosition = P (V2 400 300),
+      mouseRelative = V2 0 0,
+      mousePositionOld = Nothing
+    }
 
 main :: IO ()
 main = do
-    SDL.initialize [SDL.InitVideo]
-    SDL.HintRenderScaleQuality $= SDL.ScaleLinear
-    do renderQuality <- SDL.get SDL.HintRenderScaleQuality
-       when (renderQuality /= SDL.ScaleLinear) $
-         putStrLn "Warning: Linear texture filtering not enabled!"
+  SDL.initialize [SDL.InitVideo]
+  SDL.HintRenderScaleQuality $= SDL.ScaleLinear
+  do
+    renderQuality <- SDL.get SDL.HintRenderScaleQuality
+    when (renderQuality /= SDL.ScaleLinear) $
+      putStrLn "Warning: Linear texture filtering not enabled!"
 
-    window <-
-      SDL.createWindow
-        "SDL / OpenGL Example"
-        SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight,
-                           SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL}
+  window <-
+    SDL.createWindow
+      "SDL / OpenGL Example"
+      SDL.defaultWindow
+        { SDL.windowInitialSize = V2 screenWidth screenHeight,
+          SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
+        }
 
-    SDL.glSetAttribute SDL_GL_CONTEXT_PROFILE_MASK SDL_GL_CONTEXT_PROFILE_CORE
-    SDL.glSetAttribute SDL_GL_CONTEXT_MAJOR_VERSION 3
-    SDL.glSetAttribute SDL_GL_CONTEXT_MINOR_VERSION 2
+  SDL.glSetAttribute SDL_GL_CONTEXT_PROFILE_MASK SDL_GL_CONTEXT_PROFILE_CORE
+  SDL.glSetAttribute SDL_GL_CONTEXT_MAJOR_VERSION 3
+  SDL.glSetAttribute SDL_GL_CONTEXT_MINOR_VERSION 2
 
-    SDL.glSetAttribute SDL_GL_DOUBLEBUFFER 1
-    SDL.glSetAttribute SDL_GL_DEPTH_SIZE 24
+  SDL.glSetAttribute SDL_GL_DOUBLEBUFFER 1
+  SDL.glSetAttribute SDL_GL_DEPTH_SIZE 24
 
-    SDL.showWindow window
+  SDL.showWindow window
 
-    _ <- SDL.glCreateContext window
+  _ <- SDL.glCreateContext window
 
-    GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral screenWidth) (fromIntegral screenHeight))
+  GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral screenWidth) (fromIntegral screenHeight))
 
-    game <- initResources
+  game <- initResources
 
-    let loop key mouse = do
-          (keys', mouse') <- parseEvents key mouse
+  let loop key mouse = do
+        (keys', mouse') <- parseEvents key mouse
 
-          draw game
-          SDL.glSwapWindow window
+        draw game
+        SDL.glSwapWindow window
 
-          unless (Set.member escapeKey keys') (loop keys' mouse')
+        unless (Set.member escapeKey keys') (loop keys' mouse')
 
-    loop Set.empty initialMouse
+  loop Set.empty initialMouse
 
-    mapM_ free [ gameModelP game
-               , gameViewP game
-               , gameProjectionP game
-               ]
+  mapM_
+    free
+    [ gameModelP game,
+      gameViewP game,
+      gameProjectionP game
+    ]
 
-    SDL.destroyWindow window
-    SDL.quit
+  SDL.destroyWindow window
+  SDL.quit
 
 noKeyModifier :: SDL.KeyModifier
 noKeyModifier = SDL.KeyModifier False False False False False False False False False False False
@@ -154,86 +163,100 @@ escapeKey = SDL.Keysym SDL.ScancodeEscape SDL.KeycodeEscape noKeyModifier
 
 parseEvents :: Set SDL.Keysym -> MouseInputs -> IO (Set SDL.Keysym, MouseInputs)
 parseEvents keys mouse = do
-    events <- SDL.pollEvents
-    return $ foldr handleEvents (keys, mouse) (fmap SDL.eventPayload events)
+  events <- SDL.pollEvents
+  return $ foldr handleEvents (keys, mouse) (fmap SDL.eventPayload events)
 
-handleEvents
-  :: SDL.EventPayload
-     -> (Set SDL.Keysym, MouseInputs) -> (Set SDL.Keysym, MouseInputs)
+handleEvents ::
+  SDL.EventPayload ->
+  (Set SDL.Keysym, MouseInputs) ->
+  (Set SDL.Keysym, MouseInputs)
 handleEvents event (k, m) =
-    case event of
-      SDL.KeyboardEvent (SDL.KeyboardEventData { SDL.keyboardEventKeyMotion = e
-                                               , SDL.keyboardEventKeysym = k'}) ->
+  case event of
+    SDL.KeyboardEvent
+      ( SDL.KeyboardEventData
+          { SDL.keyboardEventKeyMotion = e,
+            SDL.keyboardEventKeysym = k'
+          }
+        ) ->
         ((if e == SDL.Released then Set.delete else Set.insert) k' k, m)
-
-      SDL.MouseMotionEvent (SDL.MouseMotionEventData { SDL.mouseMotionEventPos = pos
-                                                     , SDL.mouseMotionEventRelMotion = vel
-                                                     }) ->
+    SDL.MouseMotionEvent
+      ( SDL.MouseMotionEventData
+          { SDL.mouseMotionEventPos = pos,
+            SDL.mouseMotionEventRelMotion = vel
+          }
+        ) ->
         (k, MouseInputs pos vel Nothing)
-
-      SDL.QuitEvent{} ->
-        (Set.insert escapeKey k, m)
-
-      _ -> (k, m)
-
+    SDL.QuitEvent {} ->
+      (Set.insert escapeKey k, m)
+    _ -> (k, m)
 
 updateMouse :: MouseInputs -> Game -> Game
 updateMouse mouse game =
-  game { gameCamera = (gameCamera game)
-                  { cameraFront = front
-                  , cameraPitch = pitchDegrees
-                  , cameraYaw   = yawDegrees
-                  }
-       }
+  game
+    { gameCamera =
+        (gameCamera game)
+          { cameraFront = front,
+            cameraPitch = pitchDegrees,
+            cameraYaw = yawDegrees
+          }
+    }
   where
     camera = gameCamera game
     front = normalize $ V3 (cos pitch * cos yaw) (sin pitch) (cos pitch * sin yaw)
     pitch = toRadians pitchDegrees
-    yaw   = toRadians yawDegrees
+    yaw = toRadians yawDegrees
     pitchDegrees = min 89 . max (-89) $ cameraPitch camera + negate dy
-    yawDegrees   = (`mod'` 360) $ cameraYaw camera + dx
+    yawDegrees = (`mod'` 360) $ cameraYaw camera + dx
     sensitivity = 0.05
-    V2 dx dy = (* sensitivity) . fromIntegral <$>
-               if P (mouseRelative mouse) == mousePosition mouse
-               then V2 0 0
-               else mouseRelative mouse
+    V2 dx dy =
+      (* sensitivity) . fromIntegral
+        <$> if P (mouseRelative mouse) == mousePosition mouse
+          then V2 0 0
+          else mouseRelative mouse
 
 setVertexAttribute :: GL.Program -> String -> Int -> Int -> Int -> IO ()
 setVertexAttribute program name vertices stride offset = do
-    let floatSize = sizeOf (1.0 :: Float)
-    attrib <- GL.get $ GL.attribLocation program name
-    GL.vertexAttribPointer attrib $= (GL.ToFloat, GL.VertexArrayDescriptor 2 GL.Float
-                                       (fromIntegral $ stride * floatSize)
-                                       (plusPtr nullPtr (offset * floatSize)))
-    GL.vertexAttribArray attrib $= GL.Enabled
+  let floatSize = sizeOf (1.0 :: Float)
+  attrib <- GL.get $ GL.attribLocation program name
+  GL.vertexAttribPointer attrib
+    $= ( GL.ToFloat,
+         GL.VertexArrayDescriptor
+           2
+           GL.Float
+           (fromIntegral $ stride * floatSize)
+           (plusPtr nullPtr (offset * floatSize))
+       )
+  GL.vertexAttribArray attrib $= GL.Enabled
 
 getUniformLocation :: GL.UniformLocation -> GL.GLint
 getUniformLocation (GL.UniformLocation i) = i
 
 initResources :: IO Game
 initResources = do
-    vao <- GL.genObjectName
-    GL.bindVertexArrayObject $= Just vao
+  vao <- GL.genObjectName
+  GL.bindVertexArrayObject $= Just vao
 
-    vbo <- GL.genObjectName
-    GL.bindBuffer GL.ArrayBuffer $= Just vbo
-    V.unsafeWith vertices $ \ptr ->
-        GL.bufferData GL.ArrayBuffer $= (vectorSize vertices, castPtr ptr, GL.StaticDraw)
+  vbo <- GL.genObjectName
+  GL.bindBuffer GL.ArrayBuffer $= Just vbo
+  V.unsafeWith vertices $ \ptr ->
+    GL.bufferData GL.ArrayBuffer $= (vectorSize vertices, castPtr ptr, GL.StaticDraw)
 
-    prog <- createProgram
+  prog <- createProgram
 
-    setVertexAttribute prog "position" 2 0 0
+  setVertexAttribute prog "position" 2 0 0
 
-    modelP <- malloc
-    viewP <- malloc
-    projectionP <- malloc
+  modelP <- malloc
+  viewP <- malloc
+  projectionP <- malloc
 
-    return $ initialGameState { gameProgram = Just prog
-                              , gameVao = Just vao
-                              , gameModelP = modelP
-                              , gameViewP = viewP
-                              , gameProjectionP = projectionP
-                              }
+  return $
+    initialGameState
+      { gameProgram = Just prog,
+        gameVao = Just vao,
+        gameModelP = modelP,
+        gameViewP = viewP,
+        gameProjectionP = projectionP
+      }
 
 -- | Convert degrees to radians
 toRadians :: Float -> Float
@@ -244,68 +267,82 @@ scaledMat n = ((n * identity) & _w . _w .~ 1)
 
 draw :: Game -> IO ()
 draw game@(Game {gameProgram = Just p, gameVao = Just v}) = do
-    tick <- ticks
-    GL.clearColor $= GL.Color4 1 1 1 1
-    GL.clear [GL.ColorBuffer, GL.DepthBuffer]
+  tick <- ticks
+  GL.clearColor $= GL.Color4 1 1 1 1
+  GL.clear [GL.ColorBuffer, GL.DepthBuffer]
 
-    GL.currentProgram $= gameProgram game
-    GL.bindVertexArrayObject $= gameVao game
+  GL.currentProgram $= gameProgram game
+  GL.bindVertexArrayObject $= gameVao game
 
-    model <- getUniformLocation <$> GL.uniformLocation p "model"
-    view <- getUniformLocation <$> GL.uniformLocation p "view"
-    projection <- getUniformLocation <$> GL.uniformLocation p "projection"
+  model <- getUniformLocation <$> GL.uniformLocation p "model"
+  view <- getUniformLocation <$> GL.uniformLocation p "view"
+  projection <- getUniformLocation <$> GL.uniformLocation p "projection"
 
-    let camera = gameCamera game
-        cameraPosition = cameraPos camera
-        targetPosition = cameraPosition ^+^ cameraFront camera
-        viewMatrix = lookAt cameraPosition targetPosition (cameraUp camera)
-        projectionMatrix = perspective (toRadians 45) (640/480) 0.1 100
+  let camera = gameCamera game
+      cameraPosition = cameraPos camera
+      targetPosition = cameraPosition ^+^ cameraFront camera
+      viewMatrix = lookAt cameraPosition targetPosition (cameraUp camera)
+      projectionMatrix = perspective (toRadians 45) (640 / 480) 0.1 100
 
-    poke (gameViewP game) viewMatrix
-    poke (gameProjectionP game) projectionMatrix
+  poke (gameViewP game) viewMatrix
+  poke (gameProjectionP game) projectionMatrix
 
-    GL.glUniformMatrix4fv view 1 1 (castPtr (gameViewP game))
-    GL.glUniformMatrix4fv projection 1 1 (castPtr (gameProjectionP game))
+  GL.glUniformMatrix4fv view 1 1 (castPtr (gameViewP game))
+  GL.glUniformMatrix4fv projection 1 1 (castPtr (gameProjectionP game))
 
-    ourColorLoc <- GL.uniformLocation p "ourColour"
-    GL.uniform ourColorLoc $= (GL.Vector4 (1::Float) (sin (fromIntegral tick / 500) / 2 + 0.5) 1 1)
+  ourColorLoc <- GL.uniformLocation p "ourColour"
+  GL.uniform ourColorLoc $= (GL.Vector4 (1 :: Float) (sin (fromIntegral tick / 500) / 2 + 0.5) 1 1)
 
-    forM_ locs $ \l -> do
-        let modelMatrix = mkTransformation (axisAngle (V3 1 0 0) 0) l
-        poke (gameModelP game) modelMatrix
-        GL.glUniformMatrix4fv model 1 1 (castPtr (gameModelP game))
-        GL.drawArrays GL.Triangles 0 6
+  forM_ locs $ \l -> do
+    let modelMatrix = mkTransformation (axisAngle (V3 1 0 0) 0) l
+    poke (gameModelP game) modelMatrix
+    GL.glUniformMatrix4fv model 1 1 (castPtr (gameModelP game))
+    GL.drawArrays GL.Triangles 0 6
 
-    GL.bindVertexArrayObject $= Nothing
-    return ()
+  GL.bindVertexArrayObject $= Nothing
+  return ()
 
 vectorSize :: (Num b, V.Storable a) => V.Vector a -> b
 vectorSize array = fromIntegral $ V.length array * sizeOf (1.0 :: Float)
 
 vertices :: V.Vector Float
-vertices = V.fromList [  0.5, -0.5
-                      , -0.5, -0.5
-                      ,  0.5,  0.5
-                      , -0.5,  0.5
-                      , -0.5, -0.5
-                      ,  0.5,  0.5
-                      ]
+vertices =
+  V.fromList
+    [ 0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      0.5
+    ]
 
 locs :: [V3 Float]
-locs = [ V3 0 0 0
-       , V3 1 0 0
-       , V3 2 0 0
-       , V3 3 0 0
-       , V3 4 0 0
-       , V3 0 1 0
-       , V3 1 1 0
-       , V3 2 1 0
-       , V3 3 1 0
-       , V3 4 1 0
-       ]
+locs =
+  [ V3 0 0 0,
+    V3 1 0 0,
+    V3 2 0 0,
+    V3 3 0 0,
+    V3 4 0 0,
+    V3 0 1 0,
+    V3 1 1 0,
+    V3 2 1 0,
+    V3 3 1 0,
+    V3 4 1 0
+  ]
 
 texCoords :: V.Vector Float
-texCoords = V.fromList [   0, 0
-                       ,   1, 0
-                       , 0.5, 1
-                       ]
+texCoords =
+  V.fromList
+    [ 0,
+      0,
+      1,
+      0,
+      0.5,
+      1
+    ]
diff --git a/src/Vivant/Noise.hs b/src/Vivant/Noise.hs
index 131ffce..32cd08e 100644
--- a/src/Vivant/Noise.hs
+++ b/src/Vivant/Noise.hs
@@ -1,61 +1,69 @@
 {-# LANGUAGE BangPatterns #-}
 
-module Vivant.Noise
-  (Permutation(..), perlin3, permutation, mkPermutation)
-where
-
-import           Control.Arrow
-import           Data.Bits
-import           Data.Vector.Unboxed ((!))
-import           Data.Word
-import           System.Environment  (getArgs)
-
-import qualified Codec.Picture       as P
-import qualified Data.ByteString     as B
+module Vivant.Noise (Permutation (..), perlin3, permutation, mkPermutation) where
+
+import qualified Codec.Picture as P
+import Control.Arrow
+import Data.Bits
+import qualified Data.ByteString as B
+import Data.Vector.Unboxed ((!))
 import qualified Data.Vector.Unboxed as V
+import Data.Word
+import System.Environment (getArgs)
 
 perlin3 :: (Ord a, Num a, RealFrac a, V.Unbox a) => Permutation -> (a, a, a) -> a
-perlin3 p (!x', !y', !z')
-  = let (!xX, !x) = actuallyProperFraction x'
-        (!yY, !y) = actuallyProperFraction y'
-        (!zZ, !z) = actuallyProperFraction z'
-
-        !u = fade x
-        !v = fade y
-        !w = fade z
-
-        !h = xX
-        !a = next p h + yY
-        !b = next p (h+1) + yY
-        !aa = next p a + zZ
-        !ab = next p (a+1) + zZ
-        !ba = next p b + zZ
-        !bb = next p (b+1) + zZ
-        !aaa = next p aa
-        !aab = next p (aa+1)
-        !aba = next p ab
-        !abb = next p (ab+1)
-        !baa = next p ba
-        !bab = next p (ba+1)
-        !bba = next p bb
-        !bbb = next p (bb+1)
-
-    in
-        lerp w
-            (lerp v
-                (lerp u
-                    (grad aaa (x, y, z))
-                    (grad baa (x-1, y, z)))
-                (lerp u
-                    (grad aba (x, y-1, z))
-                    (grad bba (x-1, y-1, z))))
-            (lerp v
-                (lerp u
-                    (grad aab (x, y, z-1))
-                    (grad bab (x-1, y, z-1)))
-                (lerp u
-                    (grad abb (x, y-1, z-1))
-                    (grad bbb (x-1, y-1, z-1))))
+perlin3 p (!x', !y', !z') =
+  let (!xX, !x) = actuallyProperFraction x'
+      (!yY, !y) = actuallyProperFraction y'
+      (!zZ, !z) = actuallyProperFraction z'
+
+      !u = fade x
+      !v = fade y
+      !w = fade z
+
+      !h = xX
+      !a = next p h + yY
+      !b = next p (h + 1) + yY
+      !aa = next p a + zZ
+      !ab = next p (a + 1) + zZ
+      !ba = next p b + zZ
+      !bb = next p (b + 1) + zZ
+      !aaa = next p aa
+      !aab = next p (aa + 1)
+      !aba = next p ab
+      !abb = next p (ab + 1)
+      !baa = next p ba
+      !bab = next p (ba + 1)
+      !bba = next p bb
+      !bbb = next p (bb + 1)
+   in lerp
+        w
+        ( lerp
+            v
+            ( lerp
+                u
+                (grad aaa (x, y, z))
+                (grad baa (x -1, y, z))
+            )
+            ( lerp
+                u
+                (grad aba (x, y -1, z))
+                (grad bba (x -1, y -1, z))
+            )
+        )
+        ( lerp
+            v
+            ( lerp
+                u
+                (grad aab (x, y, z -1))
+                (grad bab (x -1, y, z -1))
+            )
+            ( lerp
+                u
+                (grad abb (x, y -1, z -1))
+                (grad bbb (x -1, y -1, z -1))
+            )
+        )
 
 fade :: (Ord a, Num a) => a -> a
 fade !t | 0 <= t, t <= 1 = t * t * t * (t * (t * 6 - 15) + 10)
@@ -66,11 +74,24 @@ lerp !t !a !b | 0 <= t, t <= 1 = a + t * (b - a)
 grad :: (Bits hash, Integral hash, Num a, V.Unbox a) => hash -> (a, a, a) -> a
 grad !hash (!x, !y, !z) = dot3 (vks `V.unsafeIndex` fromIntegral (hash .&. 15)) (x, y, z)
   where
-    vks = V.fromList
-        [ (1,1,0), (-1,1,0), (1,-1,0), (-1,-1,0)
-        , (1,0,1), (-1,0,1), (1,0,-1), (-1,0,-1)
-        , (0,1,1), (0,-1,1), (0,1,-1), (0,-1,-1)
-        , (1,1,0), (-1,1,0), (0,-1,1), (0,-1,-1)
+    vks =
+      V.fromList
+        [ (1, 1, 0),
+          (-1, 1, 0),
+          (1, -1, 0),
+          (-1, -1, 0),
+          (1, 0, 1),
+          (-1, 0, 1),
+          (1, 0, -1),
+          (-1, 0, -1),
+          (0, 1, 1),
+          (0, -1, 1),
+          (0, 1, -1),
+          (0, -1, -1),
+          (1, 1, 0),
+          (-1, 1, 0),
+          (0, -1, 1),
+          (0, -1, -1)
         ]
 
 dot3 :: Num a => (a, a, a) -> (a, a, a) -> a
@@ -78,55 +99,311 @@ dot3 (!x0, !y0, !z0) (!x1, !y1, !z1) = x0 * x1 + y0 * y1 + z0 * z1
 
 -- Unlike `properFraction`, `actuallyProperFraction` rounds as intended.
 actuallyProperFraction :: (RealFrac a, Integral b) => a -> (b, a)
-actuallyProperFraction x
-  = let (ipart, fpart) = properFraction x
-        r = if x >= 0 then (ipart, fpart)
-                      else (ipart-1, 1+fpart)
-    in r
+actuallyProperFraction x =
+  let (ipart, fpart) = properFraction x
+      r =
+        if x >= 0
+          then (ipart, fpart)
+          else (ipart -1, 1 + fpart)
+   in r
 
 newtype Permutation = Permutation (V.Vector Word8)
 
 mkPermutation :: [Word8] -> Permutation
 mkPermutation xs
-    | length xs >= 256
-    = Permutation . V.fromList $ xs
+  | length xs >= 256 =
+    Permutation . V.fromList $ xs
 
 permutation :: Permutation
-permutation = mkPermutation
-    [151,160,137,91,90,15,
-   131,13,201,95,96,53,194,233,7,225,140,36,103,30,69,142,8,99,37,240,21,10,23,
-   190, 6,148,247,120,234,75,0,26,197,62,94,252,219,203,117,35,11,32,57,177,33,
-   88,237,149,56,87,174,20,125,136,171,168, 68,175,74,165,71,134,139,48,27,166,
-   77,146,158,231,83,111,229,122,60,211,133,230,220,105,92,41,55,46,245,40,244,
-   102,143,54, 65,25,63,161, 1,216,80,73,209,76,132,187,208, 89,18,169,200,196,
-   135,130,116,188,159,86,164,100,109,198,173,186, 3,64,52,217,226,250,124,123,
-   5,202,38,147,118,126,255,82,85,212,207,206,59,227,47,16,58,17,182,189,28,42,
-   223,183,170,213,119,248,152, 2,44,154,163, 70,221,153,101,155,167, 43,172,9,
-   129,22,39,253, 19,98,108,110,79,113,224,232,178,185, 112,104,218,246,97,228,
-   251,34,242,193,238,210,144,12,191,179,162,241, 81,51,145,235,249,14,239,107,
-   49,192,214, 31,181,199,106,157,184, 84,204,176,115,121,50,45,127, 4,150,254,
-   138,236,205,93,222,114,67,29,24,72,243,141,128,195,78,66,215,61,156,180
-   ]
+permutation =
+  mkPermutation
+    [ 151,
+      160,
+      137,
+      91,
+      90,
+      15,
+      131,
+      13,
+      201,
+      95,
+      96,
+      53,
+      194,
+      233,
+      7,
+      225,
+      140,
+      36,
+      103,
+      30,
+      69,
+      142,
+      8,
+      99,
+      37,
+      240,
+      21,
+      10,
+      23,
+      190,
+      6,
+      148,
+      247,
+      120,
+      234,
+      75,
+      0,
+      26,
+      197,
+      62,
+      94,
+      252,
+      219,
+      203,
+      117,
+      35,
+      11,
+      32,
+      57,
+      177,
+      33,
+      88,
+      237,
+      149,
+      56,
+      87,
+      174,
+      20,
+      125,
+      136,
+      171,
+      168,
+      68,
+      175,
+      74,
+      165,
+      71,
+      134,
+      139,
+      48,
+      27,
+      166,
+      77,
+      146,
+      158,
+      231,
+      83,
+      111,
+      229,
+      122,
+      60,
+      211,
+      133,
+      230,
+      220,
+      105,
+      92,
+      41,
+      55,
+      46,
+      245,
+      40,
+      244,
+      102,
+      143,
+      54,
+      65,
+      25,
+      63,
+      161,
+      1,
+      216,
+      80,
+      73,
+      209,
+      76,
+      132,
+      187,
+      208,
+      89,
+      18,
+      169,
+      200,
+      196,
+      135,
+      130,
+      116,
+      188,
+      159,
+      86,
+      164,
+      100,
+      109,
+      198,
+      173,
+      186,
+      3,
+      64,
+      52,
+      217,
+      226,
+      250,
+      124,
+      123,
+      5,
+      202,
+      38,
+      147,
+      118,
+      126,
+      255,
+      82,
+      85,
+      212,
+      207,
+      206,
+      59,
+      227,
+      47,
+      16,
+      58,
+      17,
+      182,
+      189,
+      28,
+      42,
+      223,
+      183,
+      170,
+      213,
+      119,
+      248,
+      152,
+      2,
+      44,
+      154,
+      163,
+      70,
+      221,
+      153,
+      101,
+      155,
+      167,
+      43,
+      172,
+      9,
+      129,
+      22,
+      39,
+      253,
+      19,
+      98,
+      108,
+      110,
+      79,
+      113,
+      224,
+      232,
+      178,
+      185,
+      112,
+      104,
+      218,
+      246,
+      97,
+      228,
+      251,
+      34,
+      242,
+      193,
+      238,
+      210,
+      144,
+      12,
+      191,
+      179,
+      162,
+      241,
+      81,
+      51,
+      145,
+      235,
+      249,
+      14,
+      239,
+      107,
+      49,
+      192,
+      214,
+      31,
+      181,
+      199,
+      106,
+      157,
+      184,
+      84,
+      204,
+      176,
+      115,
+      121,
+      50,
+      45,
+      127,
+      4,
+      150,
+      254,
+      138,
+      236,
+      205,
+      93,
+      222,
+      114,
+      67,
+      29,
+      24,
+      72,
+      243,
+      141,
+      128,
+      195,
+      78,
+      66,
+      215,
+      61,
+      156,
+      180
+    ]
 
 doubleToByte :: Double -> Word8
 doubleToByte f = fromIntegral (truncate f :: Int)
 
 next :: Permutation -> Int -> Int
-next (Permutation !v) !idx'
-  = fromIntegral $ v `V.unsafeIndex` (fromIntegral idx' .&. 0xFF)
+next (Permutation !v) !idx' =
+  fromIntegral $ v `V.unsafeIndex` (fromIntegral idx' .&. 0xFF)
 
 main = do
-    [target, n] <- getArgs
-    let image = P.generateImage (pixelRenderer n) 64 64
-    P.writePng target image
+  [target, n] <- getArgs
+  let image = P.generateImage (pixelRenderer n) 64 64
+  P.writePng target image
   where
     pixelRenderer, pixelRenderer' :: String -> Int -> Int -> Word8
-    pixelRenderer !n !x !y
-        = doubleToByte $ ((perlin3 permutation ((fromIntegral x - 32) / 4,
-          (fromIntegral y - 32) / 4, read n :: Double))+1)/2 * 128
+    pixelRenderer !n !x !y =
+      doubleToByte $
+        ( ( perlin3
+              permutation
+              ( (fromIntegral x - 32) / 4,
+                (fromIntegral y - 32) / 4,
+                read n :: Double
+              )
+          )
+            + 1
+        )
+          / 2
+          * 128
 
-    pixelRenderer' !n x y
-        = (\w -> doubleToByte $ ((w+1)/2 * 128)) -- w should be in [-1,+1]
+    pixelRenderer' !n x y =
+      (\w -> doubleToByte $ ((w + 1) / 2 * 128)) -- w should be in [-1,+1]
         . perlin3 permutation
-        . (\(x,y,z) -> ((x-256)/32, (y-256)/32, (z-256)/32))
+        . (\(x, y, z) -> ((x -256) / 32, (y -256) / 32, (z -256) / 32))
         $ (fromIntegral x, fromIntegral y, 0 :: Double)
diff --git a/src/Vivant/Shader.hs b/src/Vivant/Shader.hs
index c2df314..aa884c6 100644
--- a/src/Vivant/Shader.hs
+++ b/src/Vivant/Shader.hs
@@ -1,50 +1,50 @@
 module Vivant.Shader (createProgram) where
 
-import           Control.Monad             (unless)
-import qualified Data.ByteString           as BS
+import Control.Monad (unless)
+import qualified Data.ByteString as BS
 import qualified Graphics.Rendering.OpenGL as GL
-import           Paths_vivant              (getDataDir)
-import           SDL                       (($=))
-import           System.Exit               (exitFailure)
-import           System.IO                 (hPutStrLn, stderr)
+import Paths_vivant (getDataDir)
+import SDL (($=))
+import System.Exit (exitFailure)
+import System.IO (hPutStrLn, stderr)
 
 createProgram :: IO GL.Program
 createProgram = do
-    datadir <- getDataDir
-    -- compile vertex shader
-    vs <- GL.createShader GL.VertexShader
-    vsSource <- BS.readFile $ datadir <> "/shaders/triangle.vert"
-    GL.shaderSourceBS vs $= vsSource
-    GL.compileShader vs
-    vsOK <- GL.get $ GL.compileStatus vs
-    unless vsOK $ do
-        log <- GL.shaderInfoLog vs
-        hPutStrLn stderr ("Error in vertex shader\n" <> log)
-        exitFailure
+  datadir <- getDataDir
+  -- compile vertex shader
+  vs <- GL.createShader GL.VertexShader
+  vsSource <- BS.readFile $ datadir <> "/shaders/triangle.vert"
+  GL.shaderSourceBS vs $= vsSource
+  GL.compileShader vs
+  vsOK <- GL.get $ GL.compileStatus vs
+  unless vsOK $ do
+    log <- GL.shaderInfoLog vs
+    hPutStrLn stderr ("Error in vertex shader\n" <> log)
+    exitFailure
 
-    -- Do it again for the fragment shader
-    fs <- GL.createShader GL.FragmentShader
-    fsSource <- BS.readFile $ datadir <> "/shaders/triangle.frag"
-    GL.shaderSourceBS fs $= fsSource
-    GL.compileShader fs
-    fsOK <- GL.get $ GL.compileStatus fs
-    unless fsOK $ do
-        log <- GL.shaderInfoLog fs
-        hPutStrLn stderr ("Error in fragment shader\n" <> log)
-        exitFailure
+  -- Do it again for the fragment shader
+  fs <- GL.createShader GL.FragmentShader
+  fsSource <- BS.readFile $ datadir <> "/shaders/triangle.frag"
+  GL.shaderSourceBS fs $= fsSource
+  GL.compileShader fs
+  fsOK <- GL.get $ GL.compileStatus fs
+  unless fsOK $ do
+    log <- GL.shaderInfoLog fs
+    hPutStrLn stderr ("Error in fragment shader\n" <> log)
+    exitFailure
 
-    program <- GL.createProgram
-    GL.attachShader program vs
-    GL.attachShader program fs
-    GL.linkProgram program
-    linkOK <- GL.get $ GL.linkStatus program
-    GL.validateProgram program
-    status <- GL.get $ GL.validateStatus program
-    unless (linkOK && status) $ do
-        hPutStrLn stderr "GL.linkProgram error"
-        plog <- GL.get $ GL.programInfoLog program
-        putStrLn plog
-        exitFailure
-    GL.currentProgram $= Just program
+  program <- GL.createProgram
+  GL.attachShader program vs
+  GL.attachShader program fs
+  GL.linkProgram program
+  linkOK <- GL.get $ GL.linkStatus program
+  GL.validateProgram program
+  status <- GL.get $ GL.validateStatus program
+  unless (linkOK && status) $ do
+    hPutStrLn stderr "GL.linkProgram error"
+    plog <- GL.get $ GL.programInfoLog program
+    putStrLn plog
+    exitFailure
+  GL.currentProgram $= Just program
 
-    return program
+  return program
diff --git a/src/Vivant/Texture.hs b/src/Vivant/Texture.hs
index dceba80..d81a28a 100644
--- a/src/Vivant/Texture.hs
+++ b/src/Vivant/Texture.hs
@@ -1,19 +1,18 @@
 module Vivant.Texture (initTexture, loadTexture) where
 
-import           Codec.Picture.Jpg         (decodeJpeg)
-import           Codec.Picture.Types       (convertImage)
-import qualified Data.ByteString           as BS
-import qualified Data.Vector.Storable      as V
+import Codec.Picture.Jpg (decodeJpeg)
+import Codec.Picture.Types (convertImage)
+import qualified Data.ByteString as BS
+import qualified Data.Vector.Storable as V
 import qualified Graphics.Rendering.OpenGL as GL
-
-import           Paths_vivant              (getDataDir)
+import Paths_vivant (getDataDir)
 
 initTexture = do
-    GL.textureWrapMode GL.Texture2D GL.S $= (GL.Mirrored, GL.Repeat)
-    GL.textureWrapMode GL.Texture2D GL.T $= (GL.Mirrored, GL.Repeat)
-    GL.textureBorderColor GL.Texture2D $= GL.Color4 1 1 1 1
-    GL.textureFilter GL.Texture2D $= ((GL.Nearest, Nothing), GL.Linear')
+  GL.textureWrapMode GL.Texture2D GL.S $= (GL.Mirrored, GL.Repeat)
+  GL.textureWrapMode GL.Texture2D GL.T $= (GL.Mirrored, GL.Repeat)
+  GL.textureBorderColor GL.Texture2D $= GL.Color4 1 1 1 1
+  GL.textureFilter GL.Texture2D $= ((GL.Nearest, Nothing), GL.Linear')
 
 loadTexture = do
-    image <- BS.readFile $ datadir <> "/assets/wall.jpg"
-    convertImage $ decodeJpeg image
+  image <- BS.readFile $ datadir <> "/assets/wall.jpg"
+  convertImage $ decodeJpeg image