diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 276 |
1 files changed, 157 insertions, 119 deletions
diff --git a/src/Main.hs b/src/Main.hs index 6dec8ad..2786f86 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,30 +1,29 @@ -{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, OverloadedRecordDot #-} +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE 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 - -import Game.Internal -import Game.Internal.Types + ( main, + ) +where import Control.Lens ((^.)) import Data.IORef (newIORef) import GHC.Float (double2Float) - -import qualified Graphics.Rendering.OpenGL as GL +import Game.Internal +import Game.Internal.Types import Graphics.Rendering.OpenGL (($=)) +import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.UI.GLFW as GLFW - +import Linear (V3 (..), V4 (..), _y) import qualified Linear as L -import Linear (V3(..), _y) -- | Main function runs game main :: IO () @@ -47,21 +46,23 @@ main = do GLFW.setKeyCallback window $ Just (keyPressed Nothing) GLFW.setCursorInputMode window GLFW.CursorInputMode'Hidden GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing) - (objects, program) <- initResources - [ map (+ V3 a 0 0) cube | a <- take 100 [0,2..]] - -- init model + (objects, program) <- + initResources $ + -- [map (v3tov4 0) $ map (+ V3 a 0 0) cube | a <- take 100 [0, 2 ..]] + [hCube] + let model = mkModel - (mkCamera - (V3 0 0 3) -- camPos - 0 -- pitch - 0 -- yaw - (V3 0 0 (-1)) -- reference vector - (V3 0 0 0) -- velocity - 2 -- mouse sensitivity - 16 -- strafe strength - 12 -- jump strength - ) + ( mkCamera + (V3 0 0 3) -- camPos + 0 -- pitch + 0 -- yaw + (V3 0 0 (-1)) -- reference vector + (V3 0 0 0) -- velocity + 2 -- mouse sensitivity + 16 -- strafe strength + 12 -- jump strength + ) objects program (mkWorldProperties 2 0.16 (V3 0 1 0)) @@ -76,84 +77,114 @@ main = do -------------------------------------------------------------------------------- top :: [V3 GL.GLfloat] top = - [ V3 p 0 p - , V3 p 0 m - , V3 m 0 p - , V3 m 0 m + [ 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 + [ 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 + [ V3 p p 0, + V3 p m 0, + V3 m p 0, + V3 m m 0 ] m = (0 - p) + p = 0.5 --- TODO optimise cube --- | cube vertices +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 + +-- | TODO optimise cube cube :: [V3 GL.GLfloat] cube = - [ 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 + [ 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 ] +-- | TODO optimise hCube +hCube :: [V4 GL.GLfloat] +hCube = + (map (v3tov4 m) cube) + ++ (map (v3tov4 p) cube) + ++ (map (v3tov4' m) cube) + ++ (map (v3tov4' p) cube) + ++ (map (v3tov4'' m) cube) + ++ (map (v3tov4'' p) cube) + ++ (map (v3tov4''' m) cube) + ++ (map (v3tov4''' p) cube) + -------------------------------------------------------------------------------- -- Elm-like data structures -------------------------------------------------------------------------------- + -- | update function update :: Float -> Model -> Model update dt model = - updateVelocity dt - $ updateAcceleration dt - $ updateSpeed dt - $ updateCameraAngle dt 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 - model - { camera = - model.camera - { jumpStrength = model.camera.jumpStrength * 1.1 - , strafeStrength = model.camera.strafeStrength * 1.1 - } - } - 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 - } - } - else model + if elem GLFW.Key'T model.keys + then + model + { camera = + model.camera + { jumpStrength = model.camera.jumpStrength * 1.1, + strafeStrength = model.camera.strafeStrength * 1.1 + } + } + 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 + } + } + else model updateAcceleration :: Float -> Model -> Model updateAcceleration dt model = @@ -186,42 +217,47 @@ updateAcceleration dt model = camVel' = friction * (model.camera.camVel + movement' + jump) 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 - { camera = - model.camera - { airTime = dt - , camVel = - model.camera.camVel - + (V3 0 model.camera.jumpStrength 0) - , hasJumped = True - } - } - else if aboveGround - then model - { camera = - model.camera - { airTime = model.camera.airTime + dt - , camVel = camVel' - , hasJumped = aboveGround - } + then + updateAcceleration dt $ + model + { camera = + model.camera + { airTime = dt, + camVel = + model.camera.camVel + + (V3 0 model.camera.jumpStrength 0), + hasJumped = True + } + } + else + if aboveGround + then + model + { camera = + model.camera + { airTime = model.camera.airTime + dt, + camVel = camVel', + hasJumped = aboveGround } - else model - { camera = - model.camera - { airTime = 0 - , camVel = camVel' * (V3 1 0 1) - , camPos = model.camera.camPos * (V3 1 0 1) - , hasJumped = aboveGround - } + } + else + model + { camera = + model.camera + { airTime = 0, + camVel = camVel' * (V3 1 0 1), + camPos = model.camera.camPos * (V3 1 0 1), + hasJumped = aboveGround } + } updateVelocity :: Float -> Model -> Model updateVelocity dt model = model { camera = model.camera - {camPos = model.camera.camPos + dt L.*^ model.camera.camVel} + { camPos = model.camera.camPos + dt L.*^ model.camera.camVel + } } updateCameraAngle :: Float -> Model -> Model @@ -242,8 +278,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 @@ -269,13 +305,15 @@ view window model = do projectionMatrix = L.perspective 1.2 (fromIntegral w / fromIntegral h) 0.01 1000 viewGLMatrix <- - GL.newMatrix GL.RowMajor $ toGLMatrix viewMatrix :: IO - (GL.GLmatrix GL.GLfloat) + GL.newMatrix GL.RowMajor $ toGLMatrix viewMatrix :: + IO + (GL.GLmatrix GL.GLfloat) viewLocation <- GL.get $ GL.uniformLocation model.program "u_view" GL.uniform viewLocation $= viewGLMatrix projectionGLMatrix <- - GL.newMatrix GL.RowMajor $ toGLMatrix projectionMatrix :: IO - (GL.GLmatrix GL.GLfloat) + GL.newMatrix GL.RowMajor $ toGLMatrix projectionMatrix :: + IO + (GL.GLmatrix GL.GLfloat) projectionLocation <- GL.get $ GL.uniformLocation model.program "u_projection" GL.uniform projectionLocation $= projectionGLMatrix -- draw objects; returns IO [] |