draw multiple sets of points, debug features

flake.nix

@@ -11,17 +11,11 @@
     pkgs = nixpkgs.legacyPackages.${system};
   in {
     packages.${system} = {
-      default =
-        pkgs.haskell.packages.ghc912.callCabal2nix "hs-game" ./. {
-        };
+      default = pkgs.haskellPackages.callCabal2nix "hs-game" ./. {};
     };
     devShells.${system} = {
       default = pkgs.mkShell {
         packages = [
-          # dev stuff
-          pkgs.haskellPackages.ghcide
-          pkgs.haskellPackages.ormolu
-
           pkgs.cabal-install
           pkgs.libGL
           pkgs.xorg.libX11

hs-game.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               hs-game
-version:            0.5.0
+version:            0.4.0
 -- synopsis:
 -- description:
 homepage:           https://git.mtgmonkey.net/Andromeda/hs-game

src/Game/Internal.hs

@@ -1,28 +1,28 @@
-{-# LANGUAGE DisambiguateRecordFields #-}
-{-# LANGUAGE MultilineStrings #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, 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
+  ( cursorPosHandler
+  , drawObjects
+  , initResources
+  , keyPressed
+  , loop
+  , resizeWindow
+  , shutdownWindow
+  , updateCursorPos
+  , updateKeyPressed
+  , updateKeyReleased
+  ) where
+
+import Game.Internal.LoadShaders
+import Game.Internal.Types
 
 import Control.Concurrent (threadDelay)
 import Control.Monad (when)
@@ -32,35 +32,29 @@ import Foreign.Marshal.Array (withArray)
 import Foreign.Ptr (nullPtr, plusPtr)
 import Foreign.Storable (Storable, sizeOf)
 import GHC.Float (double2Float)
-import Game.Internal.LoadShaders
-import Game.Internal.Types
-import Graphics.Rendering.OpenGL (($=))
+
 import qualified Graphics.Rendering.OpenGL as GL
+import Graphics.Rendering.OpenGL (($=))
 import qualified Graphics.UI.GLFW as GLFW
-import Linear (V3 (..), V4 (..))
+
+import Linear (V3(..))
 
 --------------------------------------------------------------------------------
 -- Shader creation and object initialisation
 --------------------------------------------------------------------------------
-
-initResources :: [V4 GL.GLfloat] -> IO (Object, GL.Program)
-initResources arr = do
-  object <-
-    createObject arr 4 GL.Triangles (GL.AttribLocation 0)
-
-  -- compile shader program
+-- | loads models, shaders
+initResources :: [[V3 GL.GLfloat]] -> IO ([Object], GL.Program)
+initResources arrays = do
+  -- create objects
+  objects <- listIOsToIOlist [ createObject arr 3 GL.TriangleStrip | arr <- arrays ] []
+  -- load shaders
   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
-
-  -- alpha
-  GL.blend $= GL.Enabled
-  GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
-
-  return (object, program)
+  return (objects, program)
 
 listIOsToIOlist :: [IO a] -> [a] -> IO [a]
 listIOsToIOlist [] out = return out
@@ -72,89 +66,34 @@ listIOsToIOlist (io : ios) out = do
 -- v_ varying
 -- u_ uniform
 -- o_ fragment shader output
-
+-- | vertex shader
 vertShader :: String
 vertShader =
-  """
-  #version 330 core
-
-  layout (location = 0) in vec4 a_vPos;
-
-  uniform mat4 u_view;
-  uniform mat4 u_projection;
-  uniform vec4 u_cam;
-
-  out vec3 v_pos;
-  out float v_w;
-  out float v_alpha;
-
-  vec3 orthoFrom4d(vec4 point)
-  {
-    return point.xyz;
-  }
-
-  // creates a simple 3d coordinate from a 4d
-  vec3 projectFrom4d(vec4 point)
-  {
-    // TODO don't do camera ops in shader, prefer linear algebra
-    // also use a reasonable projection for god's sake
-    vec4 view = abs(u_cam - point);
-    float perspective = 1.0 / abs(u_cam.w - view.w);
-
-    return perspective * (point.xyz);
-  }
-
-  void main()
-  {
-    vec3 vPos = orthoFrom4d(a_vPos);
-
-    // TODO don't set constant inside of shader :/
-    float wHorizon = 3;
-    float alpha = (wHorizon - abs(u_cam.w - a_vPos.w)) / wHorizon;
-
-    // cull invisible things
-    if (alpha < -1) {
-      gl_Position = vec4(0.0);
-      alpha = 0.0;
-    } else {
-      alpha = max(alpha, 0.0);
-      gl_Position = u_projection * u_view * vec4(vPos, 1.0);
-    }
-
-    v_pos = vPos;
-    v_w = a_vPos.w;
-    v_alpha = alpha;
-  }
-  """
+  "#version 330 core\n"
+    ++ "layout (location = 0) in vec3 a_vPos;\n"
+    ++ "uniform mat4 u_view;\n"
+    ++ "uniform mat4 u_projection;\n"
+    ++ "out vec3 v_pos;\n"
+    ++ "void main()\n"
+    ++ "{\n"
+    ++ "  gl_Position = u_projection * u_view * vec4(a_vPos.xyz, 1.0);\n"
+    ++ "  v_pos = a_vPos;\n"
+    ++ "}"
 
+-- | fragment shader
 fragShader :: String
 fragShader =
-  """
-  #version 330 core
-
-  uniform vec4 u_cam;
-
-  out vec4 o_vColor;
-
-  in vec3 v_pos;
-  in float v_w;
-  in float v_alpha;
-
-  void main()
-  {
-    // the normal vector of the face
-    // yoinked from https://stackoverflow.com/questions/14980712/how-to-get-flat-normals-on-a-cube/14981446#14981446
-    vec3 norm = normalize(cross(dFdx(v_pos), dFdy(v_pos)));
-
-    // creates a color based on the normal direction
-    o_vColor = vec4((0.5 + 0.5 * norm) / 2, v_alpha);
-  }
-  """
+  "#version 330 core\n"
+    ++ "out vec4 o_vColor;\n"
+    ++ "in vec3 v_pos;\n"
+    ++ "void main()\n"
+    ++ "{\n"
+    ++ "  o_vColor = vec4(0.5 + 0.5 * normalize(v_pos), 1);\n"
+    ++ "}"
 
 --------------------------------------------------------------------------------
 -- Objects
 --------------------------------------------------------------------------------
-
 -- | calculates the size in memory of an array
 sizeOfArray :: (Storable a, Num b) => [a] -> b
 sizeOfArray [] = 0
@@ -162,11 +101,11 @@ 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
@@ -176,45 +115,37 @@ 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 ->
-  GL.AttribLocation ->
-  IO Object
-createObject array numComponents primitiveMode attrLocation = do
+     Storable (a GL.GLfloat)
+  => [a GL.GLfloat]
+  -> GL.NumComponents
+  -> GL.PrimitiveMode
+  -> IO Object
+createObject array numComponents primitiveMode = do
   -- vao for object
   vao <- GL.genObjectName
   GL.bindVertexArrayObject $= Just vao
   -- vbo for vertices
-  _ <- createVBO array numComponents attrLocation
+  _ <- createVBO array numComponents $ GL.AttribLocation 0
   return (Object vao (fromIntegral $ length array) numComponents primitiveMode)
 
 --------------------------------------------------------------------------------
 -- Elm-like data structures
 --------------------------------------------------------------------------------
-
 -- | gameloop
 loop ::
-  -- | window to display on
-  GLFW.Window ->
-  -- | dt
-  Float ->
-  -- | update function
-  (Float -> Model -> Model) ->
-  -- | view function
-  (GLFW.Window -> Model -> IO ()) ->
-  -- | model
-  IORef Model ->
-  IO ()
+     GLFW.Window -- ^ window to display on
+  -> Float -- ^ dt
+  -> (Float -> Model -> Model) -- ^ update function
+  -> (GLFW.Window -> Model -> IO ()) -- ^ view function
+  -> IORef Model -- ^ model
+  -> IO ()
 loop window dt update view modelRef = do
   -- start frame timer
   Just frameStart <- GLFW.getTime
@@ -252,10 +183,9 @@ 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)}
 
@@ -270,7 +200,6 @@ drawObjects ((Object vao numVertices _ primitiveMode) : objects) = do
 --------------------------------------------------------------------------------
 -- interrupts
 --------------------------------------------------------------------------------
-
 -- | shuts down GLFW
 shutdownWindow :: GLFW.WindowCloseCallback
 shutdownWindow window = do

src/Game/Internal/LoadShaders.hs

@@ -1,7 +1,4 @@
 --------------------------------------------------------------------------------
-
---------------------------------------------------------------------------------
-
 -- |
 -- Module      :  LoadShaders
 -- Copyright   :  (c) Sven Panne 2013
@@ -13,12 +10,13 @@
 --
 -- 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
@@ -26,15 +24,14 @@ import qualified Data.ByteString as B
 import Graphics.Rendering.OpenGL
 
 --------------------------------------------------------------------------------
-
 -- | The source of the shader source code.
 data ShaderSource
-  = -- | 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
+  = 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'.
   deriving (Eq, Ord, Show)
 
 getSource :: ShaderSource -> IO B.ByteString
@@ -43,14 +40,12 @@ 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
@@ -77,12 +72,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)

src/Game/Internal/Types.hs

@@ -1,79 +1,69 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE NamedFieldPuns, 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, keys, program, 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 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)
+  { 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)
 
 -- | 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,
-    -- | 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],
-    program :: GL.Program,
-    wprop :: WorldProperties
-  }
-  deriving (Show)
+  { 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)
 
 -- | smart constructor for Model
 mkModel :: Camera -> [Object] -> GL.Program -> WorldProperties -> Model
@@ -82,40 +72,29 @@ mkModel camera objects program wprop =
 
 -- | camera
 data Camera = Camera
-  { -- | position in world space
-    camPos :: V4 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)
+  { 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)
 
 -- | smart constructor for Camera
 mkCamera ::
-  V4 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
@@ -131,14 +110,10 @@ mkCamera camPos camPitch camYaw camReference camVel mouseSensitivity strafeStren
 
 -- | physical properties of the world
 data WorldProperties = WorldProperties
-  { -- | gravity `g`
-    g :: Float,
-    -- | scale factor for floor friction
-    friction :: Float,
-    -- | global up vector
-    up :: V3 Float
-  }
-  deriving (Show)
+  { g :: Float -- ^ gravity `g`
+  , friction :: Float -- ^ scale factor for floor friction
+  , up :: V3 Float -- ^ global up vector
+  } deriving (Show)
 
 -- | smart constructor for WorldProperties
 mkWorldProperties :: Float -> Float -> V3 Float -> WorldProperties

src/Main.hs

@@ -1,29 +1,30 @@
-{-# LANGUAGE DisambiguateRecordFields #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, 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
+  ( main
+  ) where
+
+import Game.Internal
+import Game.Internal.Types
 
 import Control.Lens ((^.))
 import Data.IORef (newIORef)
 import GHC.Float (double2Float)
-import Game.Internal
-import Game.Internal.Types
-import Graphics.Rendering.OpenGL (($=))
+
 import qualified Graphics.Rendering.OpenGL as GL
+import Graphics.Rendering.OpenGL (($=))
 import qualified Graphics.UI.GLFW as GLFW
-import Linear (V3 (..), V4 (..), (*^), _w, _xyz, _y)
+
 import qualified Linear as L
+import Linear (V3(..), _y)
 
 -- | Main function runs game
 main :: IO ()
@@ -36,7 +37,6 @@ main = do
   GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core
   -- MSAA
   GLFW.windowHint $ GLFW.WindowHint'Samples $ Just 8
-  -- alpha
   -- create window
   monitor <- GLFW.getPrimaryMonitor
   Just window <- GLFW.createWindow 256 256 "hs-game" monitor Nothing
@@ -47,22 +47,13 @@ main = do
   GLFW.setKeyCallback window $ Just (keyPressed Nothing)
   GLFW.setCursorInputMode window GLFW.CursorInputMode'Hidden
   GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing)
-  (object, program) <-
-    initResources $
-      concat
-        ( [hCube]
-            ++ [map (\v -> (V4 a 0 0 a) + (rotate4 0 1 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]]
-            ++ [map (\v -> (V4 a 2 0 a) + (rotate4 0 2 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]]
-            ++ [map (\v -> (V4 a 4 0 a) + (rotate4 0 3 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]]
-            ++ [map (\v -> (V4 a (-2) 0 a) + (rotate4 1 0 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]]
-            ++ [map (\v -> (V4 a (-4) 0 a) + (rotate4 2 0 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]]
-            ++ [map (\v -> (V4 a (-6) 0 a) + (rotate4 3 0 (a * g90 / 24) v)) hCube | a <- take 1000 [0, 2 ..]]
-        )
-
+  (objects, program) <- initResources
+    [ map (+ V3 a 0 0) cube | a <- take 100 [0,2..]]
+  -- init model
   let model =
         mkModel
           (mkCamera
-              (V4 0 0 3 0) -- camPos
+             (V3 0 0 3) -- camPos
              0 -- pitch
              0 -- yaw
              (V3 0 0 (-1)) -- reference vector
@@ -71,7 +62,7 @@ main = do
              16 -- strafe strength
              12 -- jump strength
            )
-          [object]
+          objects
           program
           (mkWorldProperties 2 0.16 (V3 0 1 0))
   modelRef <- newIORef model
@@ -83,150 +74,83 @@ main = do
 --------------------------------------------------------------------------------
 -- Arrays
 --------------------------------------------------------------------------------
+top :: [V3 GL.GLfloat]
+top =
+  [ 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
+  ]
+front :: [V3 GL.GLfloat]
+front =
+  [ V3 p p 0
+  , V3 p m 0
+  , V3 m p 0
+  , V3 m m 0
+  ]
 
 m = (0 - p)
-
 p = 0.5
 
-g90 = pi / 2
-
-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
-
-rotate :: V3 GL.GLfloat -> GL.GLfloat -> V3 GL.GLfloat -> V3 GL.GLfloat
-rotate axis angle point = L.fromQuaternion (L.axisAngle axis angle) L.!* point
-
-rotate4 :: Int -> Int -> GL.GLfloat -> V4 GL.GLfloat -> V4 GL.GLfloat
-rotate4 i0 i1 angle (V4 x y z w) =
-  let coords = [x, y, z, w]
-      cos' = cos angle
-      sin' = sin angle
-      xi = coords !! i0
-      xj = coords !! i1
-      coords' =
-        [ if k == i0
-            then cos' * xi - sin' * xj
-            else
-              if k == i1
-                then sin' * xi + cos' * xj
-                else coords !! k
-        | k <- [0 .. 3]
-        ]
-   in V4 (coords' !! 0) (coords' !! 1) (coords' !! 2) (coords' !! 3)
-
-cycle3r :: V3 GL.GLfloat -> V3 GL.GLfloat
-cycle3r (V3 a b c) = V3 c a b
-
-cycle3l :: V3 GL.GLfloat -> V3 GL.GLfloat
-cycle3l (V3 a b c) = V3 b c a
-
-face :: [V3 GL.GLfloat]
-face =
-  [ V3 m m 0,
-    V3 p m 0,
-    V3 m p 0,
-    V3 m p 0,
-    V3 p m 0,
-    V3 p p 0
-  ]
-
--- | cube, side length 1, centered on 0 0 0
+-- TODO optimise cube
+-- | cube vertices
 cube :: [V3 GL.GLfloat]
 cube =
-  concatMap
-    ( \faceSpec ->
-        map
-          (\v -> (rotate (fst faceSpec) g90 v) L.^+^ (rotate (fst faceSpec) g90 (snd faceSpec)))
-          face
-    )
-    [ (V3 0 0 1, V3 0 0 p),
-      (V3 0 1 0, V3 0 0 p),
-      (V3 1 0 0, V3 0 0 p),
-      (V3 0 0 (-1), V3 0 0 m), -- no clue
-      (V3 0 (-1) 0, V3 0 0 p),
-      (V3 (-1) 0 0, V3 0 0 p)
-    ]
-
-hCube :: [V4 GL.GLfloat]
-hCube =
-  concatMap
-    ( \(w, i0, i1) ->
-        map
-          (rotate4 i0 i1 g90 . v3tov4 w)
-          cube
-    )
-    [ (p, 3, 0),
-      (p, 0, 3),
-      (p, 1, 3),
-      (p, 2, 3),
-      (m, 3, 0),
-      (m, 0, 3),
-      (m, 1, 3),
-      (m, 2, 3)
+  [ 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
   ]
 
 --------------------------------------------------------------------------------
 -- Elm-like data structures
 --------------------------------------------------------------------------------
-
 -- | update function
 update :: Float -> Model -> Model
 update dt model =
-  updateW dt $
-    updateVelocity dt $
-      updateAcceleration dt $
-        updateSpeed dt $
-          updateCameraAngle dt model
-
-updateW :: Float -> Model -> Model
-updateW dt model =
-  if elem GLFW.Key'R model.keys
-    then
-      model
-        { camera =
-            model.camera
-              { camPos = model.camera.camPos + (V4 0 0 0 (dt * dt * model.camera.strafeStrength))
-              }
-        }
-    else
-      if elem GLFW.Key'F model.keys
-        then
-          model
-            { camera =
-                model.camera
-                  { camPos = model.camera.camPos - (V4 0 0 0 (dt * dt * model.camera.strafeStrength))
-                  }
-            }
-        else 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
+  if elem GLFW.Key'T model.keys then
   model
     { camera =
         model.camera
-              { jumpStrength = model.camera.jumpStrength * 1.1,
-                strafeStrength = model.camera.strafeStrength * 1.1
+          { jumpStrength = model.camera.jumpStrength * 1.1
+          , strafeStrength = model.camera.strafeStrength * 1.1
           }
     }
-    else
-      if elem GLFW.Key'G model.keys
-        then
+  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
+          { jumpStrength = model.camera.jumpStrength * 0.99
+          , strafeStrength = model.camera.strafeStrength * 0.99
           }
     }
   else model
@@ -260,39 +184,35 @@ updateAcceleration dt model =
           then V3 0 (0 - model.wprop.g * model.camera.airTime) 0
           else V3 0 0 0
       camVel' = friction * (model.camera.camVel + movement' + jump)
-      aboveGround = ((model.camera.camPos ^. _xyz) + dt L.*^ camVel') ^. _y > 0
+      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
+        then updateAcceleration dt
+               $ model
                    { camera =
                        model.camera
-                    { airTime = dt,
-                      camVel =
+                         { airTime = dt
+                         , camVel =
                              model.camera.camVel
-                          + (V3 0 model.camera.jumpStrength 0),
-                      hasJumped = True
+                               + (V3 0 model.camera.jumpStrength 0)
+                         , hasJumped = True
                          }
                    }
-        else
-          if aboveGround
-            then
-              model
+        else if aboveGround
+               then model
                       { camera =
                           model.camera
-                      { airTime = model.camera.airTime + dt,
-                        camVel = camVel',
-                        hasJumped = aboveGround
+                            { airTime = model.camera.airTime + dt
+                            , camVel = camVel'
+                            , hasJumped = aboveGround
                             }
                       }
-            else
-              model
+               else model
                       { camera =
                           model.camera
-                      { airTime = 0,
-                        camVel = camVel' * (V3 1 0 1),
-                        camPos = model.camera.camPos * (V4 1 0 1 1),
-                        hasJumped = aboveGround
+                            { airTime = 0
+                            , camVel = camVel' * (V3 1 0 1)
+                            , camPos = model.camera.camPos * (V3 1 0 1)
+                            , hasJumped = aboveGround
                             }
                       }
 
@@ -301,8 +221,7 @@ updateVelocity dt model =
   model
     { camera =
         model.camera
-          { camPos = V4 1 1 1 (model.camera.camPos ^. _w) * (L.point $ (model.camera.camPos ^. _xyz) + dt L.*^ model.camera.camVel)
-          }
+          {camPos = model.camera.camPos + dt L.*^ model.camera.camVel}
     }
 
 updateCameraAngle :: Float -> Model -> Model
@@ -323,8 +242,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
@@ -344,37 +263,21 @@ view window model = do
       forward = V3 (cos pitch * sin yaw) (sin pitch) (cos pitch * cos yaw)
       viewMatrix =
         L.lookAt
-          (model.camera.camPos ^. _xyz)
-          ((model.camera.camPos ^. _xyz) - forward)
+          model.camera.camPos
+          (model.camera.camPos - forward)
           model.wprop.up
       projectionMatrix =
         L.perspective 1.2 (fromIntegral w / fromIntegral h) 0.01 1000
-
   viewGLMatrix <-
-    GL.newMatrix GL.RowMajor $ toGLMatrix viewMatrix ::
-      IO
+    GL.newMatrix GL.RowMajor $ toGLMatrix viewMatrix :: IO
       (GL.GLmatrix GL.GLfloat)
-
-  -- load 3d view matrix
   viewLocation <- GL.get $ GL.uniformLocation model.program "u_view"
   GL.uniform viewLocation $= viewGLMatrix
-
   projectionGLMatrix <-
-    GL.newMatrix GL.RowMajor $ toGLMatrix projectionMatrix ::
-      IO
+    GL.newMatrix GL.RowMajor $ toGLMatrix projectionMatrix :: IO
       (GL.GLmatrix GL.GLfloat)
-
-  -- load 3d projection matrix
   projectionLocation <- GL.get $ GL.uniformLocation model.program "u_projection"
   GL.uniform projectionLocation $= projectionGLMatrix
-
-  let camx = (\(V4 x _ _ _) -> x) model.camera.camPos
-      camy = (\(V4 _ y _ _) -> y) model.camera.camPos
-      camz = (\(V4 _ _ z _) -> z) model.camera.camPos
-      camw = (\(V4 _ _ _ w) -> w) model.camera.camPos
-  camWLocation <- GL.get $ GL.uniformLocation model.program "u_cam"
-  GL.uniform camWLocation $= GL.Vector4 camx camy camz camw
-
   -- draw objects; returns IO []
   _ <- drawObjects model.objects
   -- swap to current buffer