hypercube, format ig
This commit is contained in:
andromeda
276
src/Main.hs
276
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 []
|
||||
|
||||
Reference in New Issue
Block a user