hypercube, format igHEADmaster

4 files changed, 370 insertions, 280 deletions

diff --git a/src/Game/Internal.hs b/src/Game/Internal.hs
index 39f3fd4..e606505 100644
--- a/src/Game/Internal.hs
+++ b/src/Game/Internal.hs
@@ -1,28 +1,27 @@
-{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, OverloadedRecordDot #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 
-{- |
- - Module      : Game.Internal
- - Description : internal functions
- - Copyright   : 2025 Andromeda
- - License     : BSD 3-clause
- - Maintainer  : Matrix @Andromeda:tchncs.de
- - Stability   : Experimental
- -}
+-- |
+-- - Module      : Game.Internal
+-- - Description : internal functions
+-- - Copyright   : 2025 Andromeda
+-- - License     : BSD 3-clause
+-- - Maintainer  : Matrix @Andromeda:tchncs.de
+-- - Stability   : Experimental
 module Game.Internal
-  ( cursorPosHandler
-  , drawObjects
-  , initResources
-  , keyPressed
-  , loop
-  , resizeWindow
-  , shutdownWindow
-  , updateCursorPos
-  , updateKeyPressed
-  , updateKeyReleased
-  ) where
-
-import Game.Internal.LoadShaders
-import Game.Internal.Types
+  ( cursorPosHandler,
+    drawObjects,
+    initResources,
+    keyPressed,
+    loop,
+    resizeWindow,
+    shutdownWindow,
+    updateCursorPos,
+    updateKeyPressed,
+    updateKeyReleased,
+  )
+where
 
 import Control.Concurrent (threadDelay)
 import Control.Monad (when)
@@ -32,53 +31,56 @@ import Foreign.Marshal.Array (withArray)
 import Foreign.Ptr (nullPtr, plusPtr)
 import Foreign.Storable (Storable, sizeOf)
 import GHC.Float (double2Float)
-
-import qualified Graphics.Rendering.OpenGL as GL
+import Game.Internal.LoadShaders
+import Game.Internal.Types
 import Graphics.Rendering.OpenGL (($=))
+import qualified Graphics.Rendering.OpenGL as GL
 import qualified Graphics.UI.GLFW as GLFW
-
-import Linear (V3(..))
+import Linear (V3 (..), V4 (..))
 
 --------------------------------------------------------------------------------
 -- Shader creation and object initialisation
 --------------------------------------------------------------------------------
--- | loads models, shaders
-initResources :: [[V3 GL.GLfloat]] -> IO ([Object], GL.Program)
+
+initResources :: [[V4 GL.GLfloat]] -> IO ([Object], GL.Program)
 initResources arrays = do
-  -- create objects
-  objects <- listIOsToIOlist [ createObject arr 3 GL.TriangleStrip | arr <- arrays ] []
-  -- load shaders
+  objects <-
+    listIOsToIOlist
+      [createObject arr 4 GL.TriangleStrip (GL.AttribLocation 0) | arr <- arrays]
+      []
   program <-
     loadShaders
-      [ ShaderInfo GL.VertexShader (StringSource vertShader)
-      , ShaderInfo GL.FragmentShader (StringSource fragShader)
+      [ ShaderInfo GL.VertexShader (StringSource vertShader),
+        ShaderInfo GL.FragmentShader (StringSource fragShader)
       ]
   GL.currentProgram $= Just program
   return (objects, program)
 
 listIOsToIOlist :: [IO a] -> [a] -> IO [a]
 listIOsToIOlist [] out = return out
-listIOsToIOlist (io:ios) out = do
+listIOsToIOlist (io : ios) out = do
   ioVal <- io
-  listIOsToIOlist ios (ioVal:out)
+  listIOsToIOlist ios (ioVal : out)
 
 -- a_ vertex shader input
 -- v_ varying
 -- u_ uniform
 -- o_ fragment shader output
+
 -- | vertex shader
 vertShader :: String
 vertShader =
   "#version 330 core\n"
-    ++ "layout (location = 0) in vec3 a_vPos;\n"
+    ++ "layout (location = 0) in vec4 a_vPos;\n"
     ++ "uniform mat4 u_view;\n"
     ++ "uniform mat4 u_projection;\n"
     ++ "out vec3 v_pos;\n"
+    ++ glslProjectTo3d
     ++ "void main()\n"
     ++ "{\n"
-    ++ "  gl_Position = u_projection * u_view * vec4(a_vPos.xyz, 1.0);\n"
-    ++ "  v_pos = a_vPos;\n"
-    ++ "}"
+    ++ "  gl_Position = u_projection * u_view * vec4(projectTo3d(a_vPos), 1.0);\n"
+    ++ "  v_pos = a_vPos.xyz;\n"
+    ++ "}\n"
 
 -- | fragment shader
 fragShader :: String
@@ -89,23 +91,32 @@ fragShader =
     ++ "void main()\n"
     ++ "{\n"
     ++ "  o_vColor = vec4(0.5 + 0.5 * normalize(v_pos), 1);\n"
-    ++ "}"
+    ++ "}\n"
+
+glslProjectTo3d :: String
+glslProjectTo3d =
+  "vec3 projectTo3d(vec4 point)\n"
+    ++ "{\n"
+    ++ "  float perspective = 1.0 / (1.0 + point.w);\n"
+    ++ "  return perspective * point.xyz;\n"
+    ++ "}\n"
 
 --------------------------------------------------------------------------------
 -- Objects
 --------------------------------------------------------------------------------
+
 -- | calculates the size in memory of an array
 sizeOfArray :: (Storable a, Num b) => [a] -> b
 sizeOfArray [] = 0
-sizeOfArray (x:xs) = fromIntegral $ (*) (1 + length xs) $ sizeOf x
+sizeOfArray (x : xs) = fromIntegral $ (*) (1 + length xs) $ sizeOf x
 
 -- | loads a given array into a given attribute index
 createVBO ::
-     Storable (a GL.GLfloat)
-  => [a GL.GLfloat]
-  -> GL.NumComponents
-  -> GL.AttribLocation
-  -> IO GL.BufferObject
+  (Storable (a GL.GLfloat)) =>
+  [a GL.GLfloat] ->
+  GL.NumComponents ->
+  GL.AttribLocation ->
+  IO GL.BufferObject
 createVBO array numComponents attribLocation = do
   -- vbo for buffer
   buffer <- GL.genObjectName
@@ -115,37 +126,45 @@ createVBO array numComponents attribLocation = do
     GL.bufferData GL.ArrayBuffer $= (sizeOfArray array, ptr, GL.StaticDraw)
   -- create attribute pointer to buffer
   GL.vertexAttribPointer attribLocation
-    $= ( GL.ToFloat
-       , GL.VertexArrayDescriptor numComponents GL.Float 0 (plusPtr nullPtr 0))
+    $= ( GL.ToFloat,
+         GL.VertexArrayDescriptor numComponents GL.Float 0 (plusPtr nullPtr 0)
+       )
   GL.vertexAttribArray attribLocation $= GL.Enabled
   return buffer
 
 -- | creates an object from a given array; deals with vbos and everything
 createObject ::
-     Storable (a GL.GLfloat)
-  => [a GL.GLfloat]
-  -> GL.NumComponents
-  -> GL.PrimitiveMode
-  -> IO Object
-createObject array numComponents primitiveMode = do
+  (Storable (a GL.GLfloat)) =>
+  [a GL.GLfloat] ->
+  GL.NumComponents ->
+  GL.PrimitiveMode ->
+  GL.AttribLocation ->
+  IO Object
+createObject array numComponents primitiveMode attrLocation = do
   -- vao for object
   vao <- GL.genObjectName
   GL.bindVertexArrayObject $= Just vao
   -- vbo for vertices
-  _ <- createVBO array numComponents $ GL.AttribLocation 0
+  _ <- createVBO array numComponents attrLocation
   return (Object vao (fromIntegral $ length array) numComponents primitiveMode)
 
 --------------------------------------------------------------------------------
 -- Elm-like data structures
 --------------------------------------------------------------------------------
+
 -- | gameloop
 loop ::
-     GLFW.Window -- ^ window to display on
-  -> Float -- ^ dt
-  -> (Float -> Model -> Model) -- ^ update function
-  -> (GLFW.Window -> Model -> IO ()) -- ^ view function
-  -> IORef Model -- ^ model
-  -> IO ()
+  -- | window to display on
+  GLFW.Window ->
+  -- | dt
+  Float ->
+  -- | update function
+  (Float -> Model -> Model) ->
+  -- | view function
+  (GLFW.Window -> Model -> IO ()) ->
+  -- | model
+  IORef Model ->
+  IO ()
 loop window dt update view modelRef = do
   -- start frame timer
   Just frameStart <- GLFW.getTime
@@ -183,16 +202,17 @@ updateCursorPos x y model =
         (((fst model.cursorPos) - x) ** 2 + ((snd model.cursorPos) - y) ** 2)
           ** 0.5
    in if pyth < 16
-        then model
-               { cursorPos = (x, y)
-               , cursorDeltaPos = applyToTuples (-) model.cursorPos (x, y)
-               }
+        then
+          model
+            { cursorPos = (x, y),
+              cursorDeltaPos = applyToTuples (-) model.cursorPos (x, y)
+            }
         else model {cursorPos = (x, y)}
 
 -- | draws objects
 drawObjects :: [Object] -> IO ([Object])
 drawObjects [] = return []
-drawObjects ((Object vao numVertices _ primitiveMode):objects) = do
+drawObjects ((Object vao numVertices _ primitiveMode) : objects) = do
   GL.bindVertexArrayObject $= Just vao
   GL.drawArrays primitiveMode 0 numVertices
   drawObjects objects
@@ -200,6 +220,7 @@ drawObjects ((Object vao numVertices _ primitiveMode):objects) = do
 --------------------------------------------------------------------------------
 -- interrupts
 --------------------------------------------------------------------------------
+
 -- | shuts down GLFW
 shutdownWindow :: GLFW.WindowCloseCallback
 shutdownWindow window = do
diff --git a/src/Game/Internal/LoadShaders.hs b/src/Game/Internal/LoadShaders.hs
index 86b549f..43d423b 100644
--- a/src/Game/Internal/LoadShaders.hs
+++ b/src/Game/Internal/LoadShaders.hs
@@ -1,4 +1,7 @@
 --------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+
 -- |
 -- Module      :  LoadShaders
 -- Copyright   :  (c) Sven Panne 2013
@@ -10,13 +13,12 @@
 --
 -- Utilities for shader handling, adapted from LoadShaders.cpp which is (c) The
 -- Red Book Authors.
---
---------------------------------------------------------------------------------
 module Game.Internal.LoadShaders
-  ( ShaderSource(..)
-  , ShaderInfo(..)
-  , loadShaders
-  ) where
+  ( ShaderSource (..),
+    ShaderInfo (..),
+    loadShaders,
+  )
+where
 
 import Control.Exception
 import Control.Monad
@@ -24,14 +26,15 @@ import qualified Data.ByteString as B
 import Graphics.Rendering.OpenGL
 
 --------------------------------------------------------------------------------
+
 -- | The source of the shader source code.
 data ShaderSource
-  = ByteStringSource B.ByteString
-     -- ^ The shader source code is directly given as a 'B.ByteString'.
-  | StringSource String
-     -- ^ The shader source code is directly given as a 'String'.
-  | FileSource FilePath
-     -- ^ The shader source code is located in the file at the given 'FilePath'.
+  = -- | The shader source code is directly given as a 'B.ByteString'.
+    ByteStringSource B.ByteString
+  | -- | The shader source code is directly given as a 'String'.
+    StringSource String
+  | -- | The shader source code is located in the file at the given 'FilePath'.
+    FileSource FilePath
   deriving (Eq, Ord, Show)
 
 getSource :: ShaderSource -> IO B.ByteString
@@ -40,12 +43,14 @@ getSource (StringSource str) = return $ packUtf8 str
 getSource (FileSource path) = B.readFile path
 
 --------------------------------------------------------------------------------
+
 -- | A description of a shader: The type of the shader plus its source code.
-data ShaderInfo =
-  ShaderInfo ShaderType ShaderSource
+data ShaderInfo
+  = ShaderInfo ShaderType ShaderSource
   deriving (Eq, Ord, Show)
 
 --------------------------------------------------------------------------------
+
 -- | Create a new program object from the given shaders, throwing an
 -- 'IOException' if something goes wrong.
 loadShaders :: [ShaderInfo] -> IO Program
@@ -60,7 +65,7 @@ linkAndCheck = checked linkProgram linkStatus programInfoLog "link"
 
 loadCompileAttach :: Program -> [ShaderInfo] -> IO ()
 loadCompileAttach _ [] = return ()
-loadCompileAttach program (ShaderInfo shType source:infos) =
+loadCompileAttach program (ShaderInfo shType source : infos) =
   createShader shType `bracketOnError` deleteObjectName $ \shader -> do
     src <- getSource source
     shaderSourceBS shader $= src
@@ -72,12 +77,12 @@ compileAndCheck :: Shader -> IO ()
 compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile"
 
 checked ::
-     (t -> IO ())
-  -> (t -> GettableStateVar Bool)
-  -> (t -> GettableStateVar String)
-  -> String
-  -> t
-  -> IO ()
+  (t -> IO ()) ->
+  (t -> GettableStateVar Bool) ->
+  (t -> GettableStateVar String) ->
+  String ->
+  t ->
+  IO ()
 checked action getStatus getInfoLog message object = do
   action object
   ok <- get (getStatus object)
diff --git a/src/Game/Internal/Types.hs b/src/Game/Internal/Types.hs
index 8095cfb..b8e7229 100644
--- a/src/Game/Internal/Types.hs
+++ b/src/Game/Internal/Types.hs
@@ -1,69 +1,80 @@
-{-# LANGUAGE NamedFieldPuns, OverloadedRecordDot #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 
-{- |
- - Module      : Game.Internal.Types
- - Description : 
- - Copyright   : 2025 Andromeda
- - License     : BSD 3-clause
- - Maintainer  : Matrix @Andromeda:tchncs.de
- - Stability   : Experimental
- -}
+-- |
+-- - Module      : Game.Internal.Types
+-- - Description :
+-- - Copyright   : 2025 Andromeda
+-- - License     : BSD 3-clause
+-- - Maintainer  : Matrix @Andromeda:tchncs.de
+-- - Stability   : Experimental
 module Game.Internal.Types
-  ( Object(..)
-  , toGLMatrix
-  , Model(camera, objects, cursorDeltaPos, cursorPos, program, keys, wprop)
-  , mkModel
-  , Camera(camPos, camPitch, camYaw, camReference, mouseSensitivity, camVel, strafeStrength, jumpStrength, hasJumped, airTime)
-  , mkCamera
-  , WorldProperties(g, friction, up)
-  , mkWorldProperties
-  ) where
+  ( Object (..),
+    toGLMatrix,
+    Model (camera, objects, cursorDeltaPos, cursorPos, program, keys, wprop),
+    mkModel,
+    Camera (camPos, camPitch, camYaw, camReference, mouseSensitivity, camVel, strafeStrength, jumpStrength, hasJumped, airTime),
+    mkCamera,
+    WorldProperties (g, friction, up),
+    mkWorldProperties,
+  )
+where
 
 import qualified Graphics.Rendering.OpenGL as GL
 import qualified Graphics.UI.GLFW as GLFW
-
+import Linear (V3 (..), V4 (..))
 import qualified Linear as L
-import Linear (V3, V3(..), V4(..))
 
 -- | represents a single draw call
 data Object = Object
-  { vao :: GL.VertexArrayObject -- ^ vao of vertex buffer
-  , numIndicies :: GL.NumArrayIndices -- ^ number of vertices
-  , numComponents :: GL.NumComponents -- ^ dimensionallity; vec3, vec4, etc.
-  , primitiveMode :: GL.PrimitiveMode -- ^ primitive mode to be drawn with
-  } deriving (Show)
+  { -- | vao of vertex buffer
+    vao :: GL.VertexArrayObject,
+    -- | number of vertices
+    numIndicies :: GL.NumArrayIndices,
+    -- | dimensionallity; vec3, vec4, etc.
+    numComponents :: GL.NumComponents,
+    -- | primitive mode to be drawn with
+    primitiveMode :: GL.PrimitiveMode
+  }
+  deriving (Show)
 
 -- | converts M44 to a 16array for OpenGL
 toGLMatrix :: L.M44 GL.GLfloat -> [GL.GLfloat]
 toGLMatrix (V4 (V4 c00 c01 c02 c03) (V4 c10 c11 c12 c13) (V4 c20 c21 c22 c23) (V4 c30 c31 c32 c33)) =
-  [ c00
-  , c01
-  , c02
-  , c03
-  , c10
-  , c11
-  , c12
-  , c13
-  , c20
-  , c21
-  , c22
-  , c23
-  , c30
-  , c31
-  , c32
-  , c33
+  [ c00,
+    c01,
+    c02,
+    c03,
+    c10,
+    c11,
+    c12,
+    c13,
+    c20,
+    c21,
+    c22,
+    c23,
+    c30,
+    c31,
+    c32,
+    c33
   ]
 
 -- | gamestate
 data Model = Model
-  { camera :: Camera
-  , cursorDeltaPos :: (Double, Double) -- ^ frame-on-frame delta mouse position
-  , cursorPos :: (Double, Double) -- ^ current mouse position
-  , keys :: [GLFW.Key] -- ^ currently pressed keys
-  , objects :: [Object] -- ^ draw calls
-  , program :: GL.Program -- ^ shader program
-  , wprop :: WorldProperties
-  } deriving (Show)
+  { camera :: Camera,
+    -- | frame-on-frame delta mouse position
+    cursorDeltaPos :: (Double, Double),
+    -- | current mouse position
+    cursorPos :: (Double, Double),
+    -- | currently pressed keys
+    keys :: [GLFW.Key],
+    -- | draw calls
+    objects :: [Object],
+    -- | shader program
+    program :: GL.Program,
+    wprop :: WorldProperties
+  }
+  deriving (Show)
 
 -- | smart constructor for Model
 mkModel :: Camera -> [Object] -> GL.Program -> WorldProperties -> Model
@@ -72,29 +83,40 @@ mkModel camera objects program wprop =
 
 -- | camera
 data Camera = Camera
-  { camPos :: V3 Float -- ^ position in world space
-  , camPitch :: Float -- ^ pitch in radians, up positive
-  , camYaw :: Float -- ^ yaw in radians, right positive
-  , camReference :: V3 Float -- ^ reference direction; orientation applied to
-  , camVel :: V3 Float -- ^ velocity in world space
-  , mouseSensitivity :: Float -- ^ scale factor for mouse movement
-  , strafeStrength :: Float -- ^ scale factor for strafe
-  , jumpStrength :: Float -- ^ scale factor for jump initial velocity
-  , hasJumped :: Bool -- ^ whether the camera still has jumping state
-  , airTime :: Float -- ^ time since jumping state entered in seconds
-  } deriving (Show)
+  { -- | position in world space
+    camPos :: V3 Float,
+    -- | pitch in radians, up positive
+    camPitch :: Float,
+    -- | yaw in radians, right positive
+    camYaw :: Float,
+    -- | reference direction; orientation applied to
+    camReference :: V3 Float,
+    -- | velocity in world space
+    camVel :: V3 Float,
+    -- | scale factor for mouse movement
+    mouseSensitivity :: Float,
+    -- | scale factor for strafe
+    strafeStrength :: Float,
+    -- | scale factor for jump initial velocity
+    jumpStrength :: Float,
+    -- | whether the camera still has jumping state
+    hasJumped :: Bool,
+    -- | time since jumping state entered in seconds
+    airTime :: Float
+  }
+  deriving (Show)
 
 -- | smart constructor for Camera
 mkCamera ::
-     V3 Float
-  -> Float
-  -> Float
-  -> V3 Float
-  -> V3 Float
-  -> Float
-  -> Float
-  -> Float
-  -> Camera
+  V3 Float ->
+  Float ->
+  Float ->
+  V3 Float ->
+  V3 Float ->
+  Float ->
+  Float ->
+  Float ->
+  Camera
 mkCamera camPos camPitch camYaw camReference camVel mouseSensitivity strafeStrength jumpStrength =
   Camera
     camPos
@@ -110,10 +132,14 @@ mkCamera camPos camPitch camYaw camReference camVel mouseSensitivity strafeStren
 
 -- | physical properties of the world
 data WorldProperties = WorldProperties
-  { g :: Float -- ^ gravity `g`
-  , friction :: Float -- ^ scale factor for floor friction
-  , up :: V3 Float -- ^ global up vector
-  } deriving (Show)
+  { -- | gravity `g`
+    g :: Float,
+    -- | scale factor for floor friction
+    friction :: Float,
+    -- | global up vector
+    up :: V3 Float
+  }
+  deriving (Show)
 
 -- | smart constructor for WorldProperties
 mkWorldProperties :: Float -> Float -> V3 Float -> WorldProperties
diff --git a/src/Main.hs b/src/Main.hs
index 6dec8ad..2786f86 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,30 +1,29 @@
-{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, OverloadedRecordDot #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 
-{- |
- - Module      : Game
- - Description : runs game
- - Copyright   : 2025 Andromeda
- - License     : BSD 3-clause
- - Maintainer  : Matrix @Andromeda:tchncs.de
- - Stability   : Experimental
- -}
+-- |
+-- - Module      : Game
+-- - Description : runs game
+-- - Copyright   : 2025 Andromeda
+-- - License     : BSD 3-clause
+-- - Maintainer  : Matrix @Andromeda:tchncs.de
+-- - Stability   : Experimental
 module Main
-  ( main
-  ) where
-
-import Game.Internal
-import Game.Internal.Types
+  ( main,
+  )
+where
 
 import Control.Lens ((^.))
 import Data.IORef (newIORef)
 import GHC.Float (double2Float)
-
-import qualified Graphics.Rendering.OpenGL as GL
+import Game.Internal
+import Game.Internal.Types
 import Graphics.Rendering.OpenGL (($=))
+import qualified Graphics.Rendering.OpenGL as GL
 import qualified Graphics.UI.GLFW as GLFW
-
+import Linear (V3 (..), V4 (..), _y)
 import qualified Linear as L
-import Linear (V3(..), _y)
 
 -- | Main function runs game
 main :: IO ()
@@ -47,21 +46,23 @@ main = do
   GLFW.setKeyCallback window $ Just (keyPressed Nothing)
   GLFW.setCursorInputMode window GLFW.CursorInputMode'Hidden
   GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing)
-  (objects, program) <- initResources
-    [ map (+ V3 a 0 0) cube | a <- take 100 [0,2..]]
-  -- init model
+  (objects, program) <-
+    initResources $
+      -- [map (v3tov4 0) $ map (+ V3 a 0 0) cube | a <- take 100 [0, 2 ..]]
+      [hCube]
+
   let model =
         mkModel
-          (mkCamera
-             (V3 0 0 3) -- camPos
-             0 -- pitch
-             0 -- yaw
-             (V3 0 0 (-1)) -- reference vector
-             (V3 0 0 0) -- velocity
-             2 -- mouse sensitivity
-             16 -- strafe strength
-             12 -- jump strength
-           )
+          ( mkCamera
+              (V3 0 0 3) -- camPos
+              0 -- pitch
+              0 -- yaw
+              (V3 0 0 (-1)) -- reference vector
+              (V3 0 0 0) -- velocity
+              2 -- mouse sensitivity
+              16 -- strafe strength
+              12 -- jump strength
+          )
           objects
           program
           (mkWorldProperties 2 0.16 (V3 0 1 0))
@@ -76,84 +77,114 @@ main = do
 --------------------------------------------------------------------------------
 top :: [V3 GL.GLfloat]
 top =
-  [ V3 p 0 p
-  , V3 p 0 m
-  , V3 m 0 p
-  , V3 m 0 m
+  [ V3 p 0 p,
+    V3 p 0 m,
+    V3 m 0 p,
+    V3 m 0 m
   ]
+
 side :: [V3 GL.GLfloat]
 side =
-  [ V3 0 p p
-  , V3 0 p m
-  , V3 0 m p
-  , V3 0 m m
+  [ V3 0 p p,
+    V3 0 p m,
+    V3 0 m p,
+    V3 0 m m
   ]
+
 front :: [V3 GL.GLfloat]
 front =
-  [ V3 p p 0
-  , V3 p m 0
-  , V3 m p 0
-  , V3 m m 0
+  [ V3 p p 0,
+    V3 p m 0,
+    V3 m p 0,
+    V3 m m 0
   ]
 
 m = (0 - p)
+
 p = 0.5
 
--- TODO optimise cube
--- | cube vertices
+v3tov4 :: GL.GLfloat -> V3 GL.GLfloat -> V4 GL.GLfloat
+v3tov4 w (V3 x y z) = V4 x y z w
+
+v3tov4' :: GL.GLfloat -> V3 GL.GLfloat -> V4 GL.GLfloat
+v3tov4' w (V3 x y z) = V4 x y w z
+
+v3tov4'' :: GL.GLfloat -> V3 GL.GLfloat -> V4 GL.GLfloat
+v3tov4'' w (V3 x y z) = V4 x w y z
+
+v3tov4''' :: GL.GLfloat -> V3 GL.GLfloat -> V4 GL.GLfloat
+v3tov4''' w (V3 x y z) = V4 w x y z
+
+-- | TODO optimise cube
 cube :: [V3 GL.GLfloat]
 cube =
-  [ V3 p p p -- front
-  , V3 p m p
-  , V3 m p p
-  , V3 m m p -- down
-  , V3 m m m
-  , V3 p m p
-  , V3 p m m -- right
-  , V3 p p m
-  , V3 p m p
-  , V3 p p p -- up
-  , V3 m p p
-  , V3 p p m
-  , V3 m p m -- back
-  , V3 p m m
-  , V3 p p m
-  , V3 m m m -- left
-  , V3 m p m
-  , V3 m m p
-  , V3 m p p
+  [ V3 p p p, -- front
+    V3 p m p,
+    V3 m p p,
+    V3 m m p, -- down
+    V3 m m m,
+    V3 p m p,
+    V3 p m m, -- right
+    V3 p p m,
+    V3 p m p,
+    V3 p p p, -- up
+    V3 m p p,
+    V3 p p m,
+    V3 m p m, -- back
+    V3 p m m,
+    V3 p p m,
+    V3 m m m, -- left
+    V3 m p m,
+    V3 m m p,
+    V3 m p p
   ]
 
+-- | TODO optimise hCube
+hCube :: [V4 GL.GLfloat]
+hCube =
+  (map (v3tov4 m) cube)
+    ++ (map (v3tov4 p) cube)
+    ++ (map (v3tov4' m) cube)
+    ++ (map (v3tov4' p) cube)
+    ++ (map (v3tov4'' m) cube)
+    ++ (map (v3tov4'' p) cube)
+    ++ (map (v3tov4''' m) cube)
+    ++ (map (v3tov4''' p) cube)
+
 --------------------------------------------------------------------------------
 -- Elm-like data structures
 --------------------------------------------------------------------------------
+
 -- | update function
 update :: Float -> Model -> Model
 update dt model =
-  updateVelocity dt
-  $ updateAcceleration dt
-  $ updateSpeed dt
-  $ updateCameraAngle dt model
+  updateVelocity dt $
+    updateAcceleration dt $
+      updateSpeed dt $
+        updateCameraAngle dt model
 
 updateSpeed :: Float -> Model -> Model
 updateSpeed dt model =
-  if elem GLFW.Key'T model.keys then
-  model
-    { camera =
-        model.camera
-          { jumpStrength = model.camera.jumpStrength * 1.1
-          , strafeStrength = model.camera.strafeStrength * 1.1
-          }
-    }
-  else if elem GLFW.Key'G model.keys then
-  model
-    { camera =
-        model.camera
-          { jumpStrength = model.camera.jumpStrength * 0.99
-          , strafeStrength = model.camera.strafeStrength * 0.99
-          }
-    }
-  else model
+  if elem GLFW.Key'T model.keys
+    then
+      model
+        { camera =
+            model.camera
+              { jumpStrength = model.camera.jumpStrength * 1.1,
+                strafeStrength = model.camera.strafeStrength * 1.1
+              }
+        }
+    else
+      if elem GLFW.Key'G model.keys
+        then
+          model
+            { camera =
+                model.camera
+                  { jumpStrength = model.camera.jumpStrength * 0.99,
+                    strafeStrength = model.camera.strafeStrength * 0.99
+                  }
+            }
+        else model
 
 updateAcceleration :: Float -> Model -> Model
 updateAcceleration dt model =
@@ -186,42 +217,47 @@ updateAcceleration dt model =
       camVel' = friction * (model.camera.camVel + movement' + jump)
       aboveGround = (model.camera.camPos + dt L.*^ camVel') ^. _y > 0
    in if (elem GLFW.Key'Space model.keys) && (model.camera.hasJumped == False)
-        then updateAcceleration dt
-               $ model
-                   { camera =
-                       model.camera
-                         { airTime = dt
-                         , camVel =
-                             model.camera.camVel
-                               + (V3 0 model.camera.jumpStrength 0)
-                         , hasJumped = True
-                         }
-                   }
-        else if aboveGround
-               then model
-                      { camera =
-                          model.camera
-                            { airTime = model.camera.airTime + dt
-                            , camVel = camVel'
-                            , hasJumped = aboveGround
-                            }
+        then
+          updateAcceleration dt $
+            model
+              { camera =
+                  model.camera
+                    { airTime = dt,
+                      camVel =
+                        model.camera.camVel
+                          + (V3 0 model.camera.jumpStrength 0),
+                      hasJumped = True
+                    }
+              }
+        else
+          if aboveGround
+            then
+              model
+                { camera =
+                    model.camera
+                      { airTime = model.camera.airTime + dt,
+                        camVel = camVel',
+                        hasJumped = aboveGround
                       }
-               else model
-                      { camera =
-                          model.camera
-                            { airTime = 0
-                            , camVel = camVel' * (V3 1 0 1)
-                            , camPos = model.camera.camPos * (V3 1 0 1)
-                            , hasJumped = aboveGround
-                            }
+                }
+            else
+              model
+                { camera =
+                    model.camera
+                      { airTime = 0,
+                        camVel = camVel' * (V3 1 0 1),
+                        camPos = model.camera.camPos * (V3 1 0 1),
+                        hasJumped = aboveGround
                       }
+                }
 
 updateVelocity :: Float -> Model -> Model
 updateVelocity dt model =
   model
     { camera =
         model.camera
-          {camPos = model.camera.camPos + dt L.*^ model.camera.camVel}
+          { camPos = model.camera.camPos + dt L.*^ model.camera.camVel
+          }
     }
 
 updateCameraAngle :: Float -> Model -> Model
@@ -242,8 +278,8 @@ updateCameraAngle dt model =
         model.camera.camYaw
           + scaleFactor * (double2Float $ fst model.cursorDeltaPos)
    in model
-        { cursorDeltaPos = (0, 0)
-        , camera = model.camera {camPitch = newPitch'', camYaw = newYaw}
+        { cursorDeltaPos = (0, 0),
+          camera = model.camera {camPitch = newPitch'', camYaw = newYaw}
         }
 
 -- | views the model
@@ -269,13 +305,15 @@ view window model = do
       projectionMatrix =
         L.perspective 1.2 (fromIntegral w / fromIntegral h) 0.01 1000
   viewGLMatrix <-
-    GL.newMatrix GL.RowMajor $ toGLMatrix viewMatrix :: IO
-      (GL.GLmatrix GL.GLfloat)
+    GL.newMatrix GL.RowMajor $ toGLMatrix viewMatrix ::
+      IO
+        (GL.GLmatrix GL.GLfloat)
   viewLocation <- GL.get $ GL.uniformLocation model.program "u_view"
   GL.uniform viewLocation $= viewGLMatrix
   projectionGLMatrix <-
-    GL.newMatrix GL.RowMajor $ toGLMatrix projectionMatrix :: IO
-      (GL.GLmatrix GL.GLfloat)
+    GL.newMatrix GL.RowMajor $ toGLMatrix projectionMatrix ::
+      IO
+        (GL.GLmatrix GL.GLfloat)
   projectionLocation <- GL.get $ GL.uniformLocation model.program "u_projection"
   GL.uniform projectionLocation $= projectionGLMatrix
   -- draw objects; returns IO []