start to redo cam

1 files changed, 71 insertions, 15 deletions

diff --git a/src/Game/Main.hs b/src/Game/Main.hs
index 6211f2f..89cab32 100644
--- a/src/Game/Main.hs
+++ b/src/Game/Main.hs
@@ -14,6 +14,7 @@ import Game.LoadShaders
 import Control.Concurrent    (threadDelay)
 import Control.Monad         (when)
 import Data.IORef            (IORef, modifyIORef', newIORef, readIORef, writeIORef)
+import Data.List             (delete, nub)
 import Foreign.Marshal.Array (withArray)
 import Foreign.Ptr           (nullPtr, plusPtr)
 import Foreign.Storable      (sizeOf, Storable)
@@ -59,8 +60,14 @@ main = do
             (V3 0 0 3)
             (V3 0 0 0)
             (V3 0 1 0)
+            (V3 0 0 0)
           )
           program
+          []
+          (WorldProperties
+            600
+            300
+          )
   modelRef <- newIORef model
 
   -- add key callback with io ref to model
@@ -235,33 +242,72 @@ loop window update view modelRef = do
 
 -- | update function
 update :: Model -> Model
-update model = model
+update model =
+  updateVelocity
+    $ updateAcceleration
+        model
+
+updateAcceleration :: Model -> Model
+updateAcceleration model = model
+
+updateVelocity :: Model -> Model
+updateVelocity model = model
+  
 
 -- | updates given a keypress. escape case is probably caught by GLFW in the
 -- handler function itself
 updateKeyPressed :: GLFW.Key -> Model -> Model
 updateKeyPressed
   key
+  (Model
+    objects
+    camera
+    program
+    keys
+    wprops
+  ) =
+  Model
+    objects
+    camera
+    program
+    (nub $ key:keys)
+    wprops
+
+-- | updates given a keyrelease. escape case is probably caught by GLFW in the
+-- handler function itself
+updateKeyReleased :: GLFW.Key -> Model -> Model
+updateKeyReleased
+  key
+  (Model
+    objects
+    camera
+    program
+    keys
+    wprops
+  ) =
+  Model
+    objects
+    camera
+    program
+    (delete key keys)
+    wprops
+
+-- | views the model
+view :: GLFW.Window -> Model -> IO ()
+view
+  window
   (model@(Model
     objects
     (Camera
-      (V3 cPx cPy cPz)
-      (V3 cTx cTy cTz)
+      camPos
+      camTarget
       camUp
+      velocity
     )
     program
-  )) =
-  let dP = 0.2 in
-    case key of
-      GLFW.Key'W -> Model objects (Camera (V3 cPx cPy (cPz - dP)) (V3 cTx cTy (cTz - dP)) camUp) program
-      GLFW.Key'S -> Model objects (Camera (V3 cPx cPy (cPz + dP)) (V3 cTx cTy (cTz + dP)) camUp) program
-      GLFW.Key'A -> Model objects (Camera (V3 (cPx - dP) cPy cPz) (V3 (cTx - dP) cTy cTz) camUp) program
-      GLFW.Key'D -> Model objects (Camera (V3 (cPx + dP) cPy cPz) (V3 (cTx + dP) cTy cTz) camUp) program
-      _ -> model
-
--- | views the model
-view :: GLFW.Window -> Model -> IO ()
-view window (model@(Model objects (Camera camPos camTarget camUp) program)) = do
+    _
+    _
+  )) = do
   -- fit viewport to window
   (w, h) <- GLFW.getFramebufferSize window
   GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
@@ -311,6 +357,8 @@ data Model =
     [Object]
     Camera
     GL.Program
+    [GLFW.Key]
+    WorldProperties
 
 -- | camera
 data Camera =
@@ -318,6 +366,12 @@ data Camera =
     (V3 Float) -- ^ camera location
     (V3 Float) -- ^ camera target
     (V3 Float) -- ^ camera up vector
+    (V3 Float) -- ^ velocity
+
+data WorldProperties =
+  WorldProperties
+    Float -- ^ gravity `g`
+    Float -- ^ floor friction
 
 -- | draws objects
 drawObjects :: [Object] -> IO ([Object])
@@ -348,4 +402,6 @@ keyPressed _ window GLFW.Key'Escape _ GLFW.KeyState'Pressed _ =
   shutdownWindow window
 keyPressed (Just modelRef) window key _ GLFW.KeyState'Pressed _ =
   modifyIORef' modelRef $ updateKeyPressed key
+keyPressed (Just modelRef) window key _ GLFW.KeyState'Released _ =
+  modifyIORef' modelRef $ updateKeyReleased key
 keyPressed _ _ _ _ _ _ = return ()