start to redo cam
This commit is contained in:
@@ -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 ()
|
||||
|
||||
Reference in New Issue
Block a user