Cabal; non-Nix support

1 files changed, 223 insertions, 0 deletions

diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..2a96e89
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,223 @@
+{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, OverloadedRecordDot #-}
+{- |
+ - 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.Types
+import Game.Internal
+
+import Control.Lens          ((^.))
+import Data.IORef            (newIORef)
+import GHC.Float             (double2Float)
+
+import qualified Graphics.UI.GLFW          as GLFW
+import qualified Graphics.Rendering.OpenGL as GL
+import           Graphics.Rendering.OpenGL as GL (($=))
+
+import qualified Linear as L
+import           Linear      ( V3(..), _y )
+
+-- | Main function runs game
+main :: IO ()
+main = do
+  _ <- GLFW.init
+  GLFW.defaultWindowHints
+
+  -- OpenGL core >=3.3
+  GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor 3
+  GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor 3
+  GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core
+  
+  -- MSAA
+  GLFW.windowHint $ GLFW.WindowHint'Samples $ Just 8
+
+  -- create window
+  monitor <- GLFW.getPrimaryMonitor
+  Just window <- GLFW.createWindow 256 256 "hs-game" monitor Nothing 
+  GLFW.makeContextCurrent $ Just window
+
+  -- add callbacks
+  GLFW.setWindowCloseCallback window $ Just shutdownWindow
+  GLFW.setWindowSizeCallback window $ Just resizeWindow
+  GLFW.setKeyCallback window $ Just (keyPressed Nothing)
+  GLFW.setCursorInputMode window GLFW.CursorInputMode'Hidden
+  GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing)
+
+  (objects, program) <- initResources testVertices
+
+  -- init model
+  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
+        )
+        objects
+        program
+        (mkWorldProperties
+          2
+          0.16
+          (V3 0 1 0)
+        )
+  modelRef <- newIORef model
+
+  -- add callbacks with io ref to model
+  GLFW.setKeyCallback window $ Just $ keyPressed $ Just modelRef
+  GLFW.setCursorPosCallback window $ Just $ cursorPosHandler $ Just modelRef
+
+  loop window 0 update view modelRef
+
+--------------------------------------------------------------------------------
+-- Arrays
+--------------------------------------------------------------------------------
+
+-- | centered unit square
+testVertices :: [V3 GL.GLfloat]
+testVertices =
+  [ V3 (-0.5) (-0.5) 0
+  , V3 0.5    (-0.5) 0
+  , V3 (-0.5) 0.5    0
+  , V3 0.5    0.5    0
+  ]
+
+--------------------------------------------------------------------------------
+-- Elm-like data structures
+--------------------------------------------------------------------------------
+
+-- | update function
+update :: Float -> Model -> Model
+update dt model =
+  updateVelocity
+    dt
+    $ updateAcceleration
+      dt
+      $ updateCameraAngle
+        dt
+        model
+
+updateAcceleration :: Float -> Model -> Model
+updateAcceleration dt model =
+  let
+    zp = if elem GLFW.Key'S model.keys then 1 else 0
+    zn = if elem GLFW.Key'W model.keys then 1 else 0
+    xp = if elem GLFW.Key'D model.keys then 1 else 0
+    xn = if elem GLFW.Key'A model.keys then 1 else 0
+    x = xp - xn
+    z = zp - zn
+    friction = V3 (1 - model.wprop.friction) 1 (1 - model.wprop.friction)
+    movement = L.normalize (V3 x 0 z) L.^* (dt * model.camera.strafeStrength)
+    movement' = L.rotate (L.axisAngle model.wprop.up model.camera.camYaw) movement
+    jump =
+      if model.camera.hasJumped then
+        V3 0 (0 - model.wprop.g * model.camera.airTime) 0
+      else
+        V3 0 0 0
+    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
+            }
+          }
+      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
+      }
+    }
+
+updateCameraAngle :: Float -> Model -> Model
+updateCameraAngle dt model =
+  let
+    scaleFactor = model.camera.mouseSensitivity * dt
+    newPitch = model.camera.camPitch -
+      scaleFactor * (double2Float $ snd model.cursorDeltaPos) -- mouse sensitivity, update pitch
+    newPitch' = if newPitch > 1.56 then 1.56 else newPitch
+    newPitch'' = if newPitch' < (-1.56) then (-1.56) else newPitch'
+    newYaw = model.camera.camYaw +
+      scaleFactor * (double2Float $ fst model.cursorDeltaPos)
+  in
+  model
+    { cursorDeltaPos = (0, 0)
+    , camera = model.camera
+      { camPitch = newPitch''
+      , camYaw = newYaw
+      }
+    }
+
+-- | views the model
+view :: GLFW.Window -> Model -> IO ()
+view window model = do
+  -- fit viewport to window
+  (w, h) <- GLFW.getFramebufferSize window
+  GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
+
+  -- clear screen
+  GL.clearColor $= GL.Color4 1 0 1 1
+  GL.clear [GL.ColorBuffer, GL.DepthBuffer]
+
+  -- depth
+  GL.depthFunc $= Just GL.Less
+
+  -- apply transforms
+  let
+    pitch = model.camera.camPitch
+    yaw = model.camera.camYaw
+    forward = V3 (cos pitch * sin yaw) (sin pitch) (cos pitch * cos yaw)
+    viewMatrix =
+      L.lookAt
+        model.camera.camPos
+        (model.camera.camPos - forward)
+        model.wprop.up
+    projectionMatrix = L.perspective 1.5 (fromIntegral w / fromIntegral h) 0.01 10000
+
+  viewGLMatrix <- 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)
+  projectionLocation <- GL.get $ GL.uniformLocation model.program "u_projection"
+  GL.uniform projectionLocation $= projectionGLMatrix
+
+  -- draw objects; returns IO []
+  _ <- drawObjects model.objects
+
+  -- swap to current buffer
+  GLFW.swapBuffers window
+
+  -- check for interrupts
+  GLFW.pollEvents