From e9b4e2d34af8f0ea4a54d8d093108cdfdc68757c Mon Sep 17 00:00:00 2001 From: mtgmonkey Date: Sat, 13 Dec 2025 19:22:42 +0100 Subject: Cabal; non-Nix support --- .gitignore | 2 + CHANGELOG.md | 21 +++++ README.md | 41 ++++++---- flake.nix | 113 ++++++++++++-------------- hs-game.cabal | 38 +++++++++ package.nix | 39 --------- src/Game.hs | 223 --------------------------------------------------- src/Game/Internal.hs | 2 +- src/Main.hs | 223 +++++++++++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 363 insertions(+), 339 deletions(-) create mode 100644 .gitignore create mode 100644 hs-game.cabal delete mode 100644 package.nix delete mode 100644 src/Game.hs create mode 100644 src/Main.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..bd4112d --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +dist-newstyle +result diff --git a/CHANGELOG.md b/CHANGELOG.md index afb9ca7..5db8649 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,27 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - use `Double` rather than `FLoat` for internal calculations - `cursorPos`, `dt` natively `Double` already +## [0.3.0] - 2025-12-08 + +### Added + +- Cabal build system +- `.gitignore` against build artifacts + +### Changed + +- versioning using the [PVP standard](https://pvp.haskell.org/), though it will remain SemVer compliant + - SemVer version A.B.C will become PVP version A.B.C.0 +- `README.md` overhauled to reflect new build system + +### Fixed + +- a couple non-impactful typos + +### Removed + +- `Game` module -> moved to `Main` + ## [0.2.1] - 2025-12-08 ### Changed diff --git a/README.md b/README.md index 9c5c051..c3065c4 100644 --- a/README.md +++ b/README.md @@ -1,21 +1,30 @@ -to run: +see CHANGELOG.md -```bash -git clone https://git.mtgmonkey.net/Andromeda/hs-game -cd hs-game -nix run -``` +to run without nix: +- get build tools: + - with apt: `apt install cabal-install ghc git` +- get source code: `git clone https://git.mtgmonkey.net/Andromeda/hs-game --depth 1; cd hs-game` +- get dependencies + - with apt on x86-64: `apt install g++-x86-64_linux-gnu libgl-dev libx11-dev libxi-dev libxrandr-dev libxxf86vm-dev libxcursor-dev libxinerama-dev libglu1-mesa-dev` +- run with `cabal run` or build with `cabal build` -to release: - -```bash -nix build .#release -``` +to run with nix: +`nix run git+https://git.mtgmonkey.net/Andromeda/hs-game` -to debug build: +to enter nix development shell: +`nix develop git+https://git.mtgmonkey.net/Andromeda/hs-game` -```bash -nix build .#debug -``` +build tested on +- nix +- Kubuntu 25.10 -todo moved to CHANGELOG.md +to release: +- update CHANGELOG.md with new version +- update version in hs-game.cabal +- update version in flake.nix +- check that it builds +- `git add -A` +- `git status` make sure there aren't random files +- `git status -v` make sure all additions are in CHANGELOG.md +- double check that flake, .cabal, and CHANGELOG.md all have the same version +- release diff --git a/flake.nix b/flake.nix index 6468b28..90a80c5 100644 --- a/flake.nix +++ b/flake.nix @@ -2,70 +2,63 @@ inputs = { nixpkgs.url = "nixpkgs/nixpkgs-unstable"; }; - outputs = {nixpkgs, ...}: let + outputs = { + nixpkgs, + self, + ... + }: let + versionString = "0.3.0"; + package = { + mkDerivation, + base, + bytestring, + GLFW-b, + lens, + lib, + linear, + OpenGL, + }: + mkDerivation { + pname = "hs-game"; + version = versionString; + src = ./.; + isLibrary = false; + isExecutable = true; + executableHaskellDepends = [ + base + bytestring + GLFW-b + lens + linear + OpenGL + ]; + homepage = "https://git.mtgmonkey.net/Andromeda/hs-game"; + license = lib.licenses.bsd3; + mainProgram = "hs-game"; + }; system = "x86_64-linux"; pkgs = nixpkgs.legacyPackages.${system}; - debugGhcOptions = pkgs.lib.concatStringsSep " " (debugGhcFlags ++ commonGhcFlags); - debugGhcFlags = [ - "-O0" - "-Wall" - "-Widentities" - "-Wincomplete-record-updates" - "-Wincomplete-uni-patterns" - # "-Wmissing-export-lists" - "-Wmissing-home-modules" - "-Wpartial-fields" - "-Wredundant-constraints" - "-threaded" - "-rtsopts" - "-with-rtsopts=-N" - "-main-is Game" - ]; - haddockOptions = pkgs.lib.concatStringsSep " " haddockFlags; - haddockFlags = [ - "--html" - "--odir docs" - "--optghc=-i./src" - "src/Game.hs" - ]; - releaseGhcOptions = pkgs.lib.concatStringsSep " " (releaseGhcFlags ++ commonGhcFlags); - releaseGhcFlags = [ - "-O2" - "-threaded" - "-rtsopts" - "-with-rtsopts=-N" - "-main-is Game" - ]; - noHaddockOptions = ""; - commonGhcFlags = [ - "-i./src" - ]; - ghcPackages = p: [ - p.GLFW-b - p.linear - p.OpenGL - ]; in { packages.${system} = { - debug = pkgs.callPackage ./package.nix { - ghcOptions = debugGhcOptions; - haddockOptions = noHaddockOptions; - inherit ghcPackages; - }; - release = pkgs.callPackage ./package.nix { - ghcOptions = releaseGhcOptions; - haddockOptions = noHaddockOptions; - inherit ghcPackages; - }; - docs = pkgs.callPackage ./package.nix { - ghcOptions = "--version"; - inherit haddockOptions; - inherit ghcPackages; - }; - default = pkgs.callPackage ./package.nix { - ghcOptions = releaseGhcOptions; - inherit haddockOptions; - inherit ghcPackages; + default = + pkgs.haskellPackages.callPackage package {}; + }; + devShells.${system} = { + default = pkgs.mkShell { + packages = [ + pkgs.cabal-install + pkgs.libGL + pkgs.xorg.libX11 + pkgs.xorg.libXi + pkgs.xorg.libXrandr + pkgs.xorg.libXxf86vm + pkgs.xorg.libXcursor + pkgs.xorg.libXinerama + pkgs.libGLU + ]; + inputsFrom = [ + self.packages.${system}.default + ]; }; }; }; diff --git a/hs-game.cabal b/hs-game.cabal new file mode 100644 index 0000000..c38218a --- /dev/null +++ b/hs-game.cabal @@ -0,0 +1,38 @@ +cabal-version: 3.0 +name: hs-game +version: 0.3.0 +-- synopsis: +-- description: +homepage: https://git.mtgmonkey.net/Andromeda/hs-game +license: BSD-3-Clause +license-file: LICENSE +author: andromeda +maintainer: @andromeda:tchncs.de +-- copyright: +category: Game +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +common warnings + ghc-options: -Wall + +common optimizations + ghc-options: -O2 + +executable hs-game + import: optimizations + main-is: Main.hs + other-modules: + Game.Internal, + Game.Internal.LoadShaders, + Game.Internal.Types + -- other-extensions: + build-depends: + base >= 4.18, + bytestring >= 0.12, + GLFW-b >= 3.3, + lens >= 5.3, + linear >= 1.23, + OpenGL >= 3.0, + hs-source-dirs: src diff --git a/package.nix b/package.nix deleted file mode 100644 index 1b6f738..0000000 --- a/package.nix +++ /dev/null @@ -1,39 +0,0 @@ -{ - haskellPackages, - lib, - stdenv, - ghcOptions, - haddockOptions, - ghcPackages, - ... -}: -stdenv.mkDerivation { - pname = "hs-game"; - version = "0.1.0"; - src = ./.; - nativeBuildInputs = [ - (haskellPackages.ghcWithPackages ghcPackages) - ]; - buildInputs = [ - ]; - configurePhase = '' - ''; - buildPhase = '' - touch Main - ghc ${ghcOptions} ./src/Game.hs -o ./Main - mkdir ./docs - haddock ${haddockOptions} - ''; - installPhase = '' - mkdir -p $out/bin - cp ./Main $out/bin/hs-game - cp ./docs $out/docs -r - ''; - - meta = { - homepage = "https://mtgmonkey.net"; - license = lib.licenses.bsd3; - mainProgram = "hs-game"; - platforms = ["x86_64-linux"]; - }; -} diff --git a/src/Game.hs b/src/Game.hs deleted file mode 100644 index f120a6f..0000000 --- a/src/Game.hs +++ /dev/null @@ -1,223 +0,0 @@ -{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, OverloadedRecordDot #-} -{- | - - Module : Game - - Description : runs game - - Copyright : 2025 Andromeda - - License : BSD 3-clause - - Maintainer : Matrix @Andromeda:tchncs.de - - Stability : Experimental - -} -module Game (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 diff --git a/src/Game/Internal.hs b/src/Game/Internal.hs index 61832a9..3461d27 100644 --- a/src/Game/Internal.hs +++ b/src/Game/Internal.hs @@ -208,7 +208,7 @@ applyToTuples f (x, y) (a, b) = (f x a, f y b) updateCursorPos :: Double -> Double -> Model -> Model updateCursorPos x y model = let - pyth = (((fst model.cursorPos) - x) ** 2 + ((snd model.cursorPos - y)) ** 2) ** 0.5 + pyth = (((fst model.cursorPos) - x) ** 2 + ((snd model.cursorPos) - y) ** 2) ** 0.5 in if pyth < 16 then model 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 -- cgit v1.3.1