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@(Model + (Model objects - (Camera - (V3 cPx cPy cPz) - (V3 cTx cTy cTz) - camUp - ) + camera 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 + 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 camPos camTarget camUp) program)) = do +view + window + (model@(Model + objects + (Camera + camPos + camTarget + camUp + velocity + ) + program + _ + _ + )) = 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 ()