start to redo cam

This commit is contained in:
mtgmonkey
2025-12-04 23:25:23 +01:00
parent f0e26d0efe
commit b42579358e

View File

@@ -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 ()