Format with ormolu

6 files changed, 237 insertions, 131 deletions

diff --git a/Setup.hs b/Setup.hs
index 9a994af..e8ef27d 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,2 +1,3 @@
 import Distribution.Simple
+
 main = defaultMain
diff --git a/shaders/phong.frag.glsl b/shaders/phong.frag.glsl
index a1a0645..e7d7a33 100644
--- a/shaders/phong.frag.glsl
+++ b/shaders/phong.frag.glsl
@@ -10,7 +10,7 @@ uniform vec3 light_pos;
 void main() {
     vec3 ambient = vec3(0.2, 0.2, 0.2);
     vec3 light_colour = vec3(1.0, 1.0, 1.0);
-    vec3 object_colour = vec3(0.5, 0.2, 0.8);
+    vec3 object_colour = vec3(0.8, 0.6, 0.2);
     vec3 norm = normalize(o_normal);
     vec3 light_dir = normalize(light_pos - o_frag_pos);
     float diff = max(dot(norm, light_dir), 0.0);
diff --git a/src/Vivant.hs b/src/Vivant.hs
index 001b463..21c397e 100644
--- a/src/Vivant.hs
+++ b/src/Vivant.hs
@@ -14,7 +14,7 @@
 
 module Main where
 
-import Control.Lens ((.~), (^.), (%~))
+import Control.Lens ((%~), (.~), (^.))
 import Control.Monad
 import qualified Data.ByteString as BS
 import Data.Fixed (mod')
@@ -29,11 +29,11 @@ import Foreign.Marshal.Alloc (free, malloc)
 import Foreign.Ptr
 import Foreign.Storable (poke, sizeOf)
 import qualified Graphics.GL.Compatibility33 as GL
+import Graphics.Rendering.OpenGL (($=))
 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 Graphics.Rendering.OpenGL (($=))
 import qualified SDL
 import SDL.Raw.Enum as SDL
 import SDL.Raw.Video as SDL (glSetAttribute)
@@ -41,10 +41,10 @@ import SDL.Time (ticks)
 import SDL.Vect
 import System.Exit (exitFailure)
 import System.IO
-import Vivant.Shader (createProgram)
+import Vivant.Noise
 import Vivant.Renderer
+import Vivant.Shader (createProgram)
 import Vivant.Terrain
-import Vivant.Noise
 
 screenWidth, screenHeight :: CInt
 (screenWidth, screenHeight) = (640, 480)
@@ -123,7 +123,7 @@ main = do
 
   window <-
     SDL.createWindow
-      "SDL / OpenGL Example"
+      "Vivant"
       SDL.defaultWindow
         { SDL.windowInitialSize = V2 screenWidth screenHeight,
           SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
@@ -182,14 +182,14 @@ parseEvents keys mouse = do
     . changeIfIn events' mouseWheel (\(k, m) -> (k, m {mouseWheel = 0}))
     $ changeIfIn events' mouseMoving (\(k, m) -> (k, m {mouseRelative = V2 0 0})) (k, m)
   where
-    mouseMoving (SDL.MouseMotionEvent{}) = True
+    mouseMoving (SDL.MouseMotionEvent {}) = True
     mouseMoving _ = False
-    mouseWheel (SDL.MouseWheelEvent{}) = True
+    mouseWheel (SDL.MouseWheelEvent {}) = True
     mouseWheel _ = False
     changeIfIn events event modification initial =
       if (> 0) . length $ filter event events
-      then initial
-      else modification initial
+        then initial
+        else modification initial
 
 handleEvents ::
   SDL.EventPayload ->
@@ -212,20 +212,23 @@ handleEvents event (k, m) =
         ) ->
         (k, MouseInputs pos vel (mousePositionOld m) (mousePressed m) (mouseWheel m))
     SDL.MouseButtonEvent
-      (SDL.MouseButtonEventData
-       { SDL.mouseButtonEventMotion = SDL.Pressed
-       }) ->
-      (k, m {mousePressed = True})
+      ( SDL.MouseButtonEventData
+          { SDL.mouseButtonEventMotion = SDL.Pressed
+          }
+        ) ->
+        (k, m {mousePressed = True})
     SDL.MouseButtonEvent
-      (SDL.MouseButtonEventData
-       { SDL.mouseButtonEventMotion = SDL.Released
-       }) ->
-      (k, m {mousePressed = False})
+      ( SDL.MouseButtonEventData
+          { SDL.mouseButtonEventMotion = SDL.Released
+          }
+        ) ->
+        (k, m {mousePressed = False})
     SDL.MouseWheelEvent
-      (SDL.MouseWheelEventData
-       { SDL.mouseWheelEventPos = V2 x y
-       }) ->
-      (k, m {mouseWheel = y})
+      ( SDL.MouseWheelEventData
+          { SDL.mouseWheelEventPos = V2 x y
+          }
+        ) ->
+        (k, m {mouseWheel = y})
     SDL.QuitEvent {} ->
       (Set.insert escapeKey k, m)
     _ -> (k, m)
@@ -235,40 +238,43 @@ updateMouse mouse game =
   game
     { gameCamera =
         (gameCamera game)
-          {
-            cameraPos = newPos ^+^ (fromIntegral (mouseWheel mouse) *^ newFront),
+          { cameraPos = newPos ^+^ (fromIntegral (mouseWheel mouse) *^ newFront),
             cameraFront = newFront,
             cameraUp = newUp
           }
     }
   where
     rotation v
-      | mousePressed mouse = rotate (axisAngle (V3 0 0 1)
-                                     ((/ 2) . toRadians . fromIntegral
-                                      $ - (mouseRelative mouse ^. _x))) v
+      | mousePressed mouse =
+        rotate
+          ( axisAngle
+              (V3 0 0 1)
+              ( (/ 2) . toRadians . fromIntegral $
+                  - (mouseRelative mouse ^. _x)
+              )
+          )
+          v
       | otherwise = v
     newPos = rotation . cameraPos $ gameCamera game
     newUp = rotation . cameraUp $ gameCamera game
     newFront = normalize (V3 0 0 0 ^-^ newPos)
 
-pixelRenderer :: Double -> Int -> Int -> Word8
+pixelRenderer :: Double -> Int -> Int -> Float
 pixelRenderer n x y =
-  doubleToByte $
+  fromRational . toRational $
     ( ( perlin3
           permutation
-          ( (fromIntegral x - 32) / 4,
-            (fromIntegral y - 32) / 4,
+          ( (fromIntegral x - 32) / 16,
+            (fromIntegral y - 32) / 16,
             n
           )
       )
         + 1
     )
-      / 2
-      * 128
 
 createTerrain :: [[Float]]
 createTerrain =
-  fmap (\y -> fmap (\x -> fromIntegral (pixelRenderer 0 x y) / 20) [0..63]) [0..63]
+  fmap (\y -> fmap (\x -> pixelRenderer 3 x y * 5) [0 .. 256]) [0 .. 256]
 
 initResources :: IO Game
 initResources = do
@@ -327,7 +333,7 @@ draw game@(Game {gameProgram = Just p, gameVao = Just v, gameTerrain = Just t})
       cameraPosition = cameraPos camera
       targetPosition = cameraPosition ^+^ cameraFront camera
       viewMatrix = lookAt cameraPosition targetPosition (cameraUp camera)
-      projectionMatrix = perspective (toRadians 45) (640 / 480) 0.1 200
+      projectionMatrix = perspective (toRadians 45) (640 / 480) 0.1 500
 
   poke (gameViewP game) viewMatrix
   poke (gameProjectionP game) projectionMatrix
@@ -336,9 +342,9 @@ draw game@(Game {gameProgram = Just p, gameVao = Just v, gameTerrain = Just t})
   GL.glUniformMatrix4fv projection 1 1 (castPtr (gameProjectionP game))
 
   ourColorLoc <- GL.uniformLocation p "light_pos"
-  GL.uniform ourColorLoc $=
-    (GL.Vector3 (0::Float) (32 * sin (fromIntegral tick / 2000)) (16 * (abs $ cos (fromIntegral tick / 2000))))
-    --castV3 (cameraPos (gameCamera game))
+  GL.uniform ourColorLoc
+    $= (GL.Vector3 (0 :: Float) (128 * sin (fromIntegral tick / 2000)) (64 * (abs $ cos (fromIntegral tick / 2000))))
+  --castV3 (cameraPos (gameCamera game))
 
   render $ terrainRenderer t
 
@@ -351,59 +357,138 @@ vectorSize array = fromIntegral $ V.length array * sizeOf (1.0 :: Float)
 vertices :: V.Vector Float
 vertices =
   V.fromList
-    [ 0.5, -0.5,  0,
-      -0.5, -0.5, 0,
-      0.5, 0.5,   0,
-      -0.5, 0.5,  0,
-      -0.5, -0.5, 0,
-      0.5, 0.5,   0
+    [ 0.5,
+      -0.5,
+      0,
+      -0.5,
+      -0.5,
+      0,
+      0.5,
+      0.5,
+      0,
+      -0.5,
+      0.5,
+      0,
+      -0.5,
+      -0.5,
+      0,
+      0.5,
+      0.5,
+      0
     ]
 
 square :: V.Vector Float
 square =
   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,
-    -0.5,  0.5, -0.5,
-    -0.5, -0.5, -0.5,
-
-    -0.5, -0.5,  0.5,
-     0.5, -0.5,  0.5,
-     0.5,  0.5,  0.5,
-     0.5,  0.5,  0.5,
-    -0.5,  0.5,  0.5,
-    -0.5, -0.5,  0.5,
-
-    -0.5,  0.5,  0.5,
-    -0.5,  0.5, -0.5,
-    -0.5, -0.5, -0.5,
-    -0.5, -0.5, -0.5,
-    -0.5, -0.5,  0.5,
-    -0.5,  0.5,  0.5,
-
-     0.5,  0.5,  0.5,
-     0.5,  0.5, -0.5,
-     0.5, -0.5, -0.5,
-     0.5, -0.5, -0.5,
-     0.5, -0.5,  0.5,
-     0.5,  0.5,  0.5,
-
-    -0.5, -0.5, -0.5,
-     0.5, -0.5, -0.5,
-     0.5, -0.5,  0.5,
-     0.5, -0.5,  0.5,
-    -0.5, -0.5,  0.5,
-    -0.5, -0.5, -0.5,
-
-    -0.5,  0.5, -0.5,
-     0.5,  0.5, -0.5,
-     0.5,  0.5,  0.5,
-     0.5,  0.5,  0.5,
-    -0.5,  0.5,  0.5,
-    -0.5,  0.5, -0.5
-  ]
+    [ -0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      0.5,
+      -0.5,
+      0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      0.5,
+      -0.5,
+      0.5,
+      0.5,
+      0.5,
+      0.5,
+      0.5,
+      0.5,
+      0.5,
+      -0.5,
+      0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      0.5,
+      0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      0.5,
+      0.5,
+      0.5,
+      0.5,
+      0.5,
+      0.5,
+      0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      0.5,
+      0.5,
+      0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      0.5,
+      0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      -0.5,
+      0.5,
+      -0.5,
+      0.5,
+      0.5,
+      -0.5,
+      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 =
diff --git a/src/Vivant/Common.hs b/src/Vivant/Common.hs
index cf017ca..a02f8ad 100644
--- a/src/Vivant/Common.hs
+++ b/src/Vivant/Common.hs
@@ -1,6 +1,4 @@
-module Vivant.Common
-  (vectorSize, uncurry3)
-where
+module Vivant.Common (vectorSize, uncurry3) where
 
 import qualified Data.Vector.Storable as V
 import Foreign.Storable (sizeOf)
diff --git a/src/Vivant/Renderer.hs b/src/Vivant/Renderer.hs
index f66b0d7..91a395f 100644
--- a/src/Vivant/Renderer.hs
+++ b/src/Vivant/Renderer.hs
@@ -1,28 +1,27 @@
-module Vivant.Renderer
-  (Renderer(..), getUniformLocation, destroyRenderer, render, setVertexAttribute)
-where
+module Vivant.Renderer (Renderer (..), getUniformLocation, destroyRenderer, render, setVertexAttribute) where
 
-import qualified Graphics.Rendering.OpenGL as GL
-import Linear
+import Foreign.Marshal.Alloc (free)
 import Foreign.Ptr
+import Foreign.Storable (sizeOf)
 import qualified Graphics.GL.Functions as GL (glUniformMatrix4fv)
 import Graphics.Rendering.OpenGL (($=))
-import Foreign.Marshal.Alloc (free)
-import Foreign.Storable (sizeOf)
+import qualified Graphics.Rendering.OpenGL as GL
+import Linear
 
 data Renderer = Renderer
   { rendererProgram :: Maybe GL.Program,
     rendererVao :: Maybe GL.VertexArrayObject,
     rendererModelP :: Ptr (M44 Float),
     rendererTriangleNum :: Int
-  } deriving (Show)
+  }
+  deriving (Show)
 
 getUniformLocation :: GL.UniformLocation -> GL.GLint
 getUniformLocation (GL.UniformLocation i) = i
 
 render :: Renderer -> IO ()
 render r@(Renderer {rendererProgram = Just p}) = do
---  GL.currentProgram $= rendererProgram r
+  --  GL.currentProgram $= rendererProgram r
   GL.bindVertexArrayObject $= rendererVao r
 
   model <- getUniformLocation <$> GL.uniformLocation p "model"
diff --git a/src/Vivant/Terrain.hs b/src/Vivant/Terrain.hs
index befee88..b73469a 100644
--- a/src/Vivant/Terrain.hs
+++ b/src/Vivant/Terrain.hs
@@ -1,24 +1,22 @@
-module Vivant.Terrain
-  (Terrain(..), initTerrain)
-where
+module Vivant.Terrain (Terrain (..), initTerrain) where
 
-import Vivant.Renderer
 import qualified Data.Vector.Storable as V
-import qualified Graphics.Rendering.OpenGL as GL
-import SDL (($=))
 import Foreign.Marshal.Alloc (free, malloc)
 import Foreign.Ptr
-import Vivant.Common (vectorSize, uncurry3)
 import Foreign.Storable (poke)
+import qualified Graphics.Rendering.OpenGL as GL
 import Linear
+import SDL (($=))
+import Vivant.Common (uncurry3, vectorSize)
+import Vivant.Renderer
 
 data Terrain = Terrain
-  {
-    terrainWidth :: Int,
+  { terrainWidth :: Int,
     terrainHeight :: Int,
     terrainGeometry :: [[Float]],
     terrainRenderer :: Renderer
-  } deriving (Show)
+  }
+  deriving (Show)
 
 normal :: Num c => (c, c, c) -> (c, c, c) -> (c, c, c) -> (c, c, c)
 normal a b c =
@@ -26,30 +24,53 @@ normal a b c =
   where
     transform (V3 a b c) = (a, b, c)
 
-partition
-  :: (V.Storable a1, Enum a1, Num a1) => [[a1]] -> V.Vector a1
+partition ::
+  (V.Storable a1, Enum a1, Num a1) => [[a1]] -> V.Vector a1
 partition r =
-  V.fromList . concat . concat .
-  fmap (\(e, y) -> fmap (generateP y) $ zip (zip (uncurry zip e) $ tail (uncurry zip e)) [0..])
-  $ zip (zip r $ tail r) [0..]
+  V.fromList . concat . concat
+    . fmap (\(e, y) -> fmap (generateP y) $ zip (zip (uncurry zip e) $ tail (uncurry zip e)) [0 ..])
+    $ zip (zip r $ tail r) [0 ..]
   where
     generateP y (((z1, z2), (z3, z4)), x) =
-      let (n1x, n1y, n1z) = normal (x, y, z1) (x, y+1, z2) (x+1, y, z3)
-          (n2x, n2y, n2z) = normal (x+1, y+1, z4) (x, y+1, z2) (x+1, y, z3)
-      in
-      [ x,   y,   z1
-      , -n1x, -n1y, -n1z
-      , x,   y+1, z2
-      , -n1x, -n1y, -n1z
-      , x+1, y,   z3
-      , -n1x, -n1y, -n1z
-      , x,   y+1, z2
-      , n2x, n2y, n2z
-      , x+1, y,   z3
-      , n2x, n2y, n2z
-      , x+1, y+1, z4
-      , n2x, n2y, n2z
-      ]
+      let (n1x, n1y, n1z) = normal (x, y, z1) (x, y + 1, z2) (x + 1, y, z3)
+          (n2x, n2y, n2z) = normal (x + 1, y + 1, z4) (x, y + 1, z2) (x + 1, y, z3)
+       in [ x,
+            y,
+            z1,
+            - n1x,
+            - n1y,
+            - n1z,
+            x,
+            y + 1,
+            z2,
+            - n1x,
+            - n1y,
+            - n1z,
+            x + 1,
+            y,
+            z3,
+            - n1x,
+            - n1y,
+            - n1z,
+            x,
+            y + 1,
+            z2,
+            n2x,
+            n2y,
+            n2z,
+            x + 1,
+            y,
+            z3,
+            n2x,
+            n2y,
+            n2z,
+            x + 1,
+            y + 1,
+            z4,
+            n2x,
+            n2y,
+            n2z
+          ]
 
 initTerrain :: [[Float]] -> GL.Program -> IO Terrain
 initTerrain g p = do
@@ -70,8 +91,10 @@ initTerrain g p = do
 
   let h = length g
       w = length (head g)
-      modelMatrix = mkTransformation (axisAngle (V3 0 0 0) 0)
-        (V3 (- fromIntegral w / 2) (- fromIntegral h / 2) 0)
+      modelMatrix =
+        mkTransformation
+          (axisAngle (V3 0 0 0) 0)
+          (V3 (- fromIntegral w / 2) (- fromIntegral h / 2) 0)
 
   modelP <- malloc
   poke modelP modelMatrix