summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs276
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 []
generated by cgit v1.3.1 (git 2.54.0) at 2026-09-04 02:34:17 +0000