Compare commits
8 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
73985e298a | ||
|
|
ffc9d08a2d | ||
| 35bd4c1740 | |||
|
|
20ecde081b | ||
|
|
d87e4ba21a | ||
|
|
9e8bafa6e2 | ||
|
|
5585a49393 | ||
|
|
e767a5ee5b |
53
CHANGELOG.md
53
CHANGELOG.md
@@ -6,36 +6,65 @@ All notable changes to this project will be documented in this file.
|
|||||||
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),
|
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),
|
||||||
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
|
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
|
||||||
|
|
||||||
## [Unreleased]
|
## [Eventual]
|
||||||
|
|
||||||
### Added
|
### Added
|
||||||
|
|
||||||
- test suite for non-IO functions
|
- test suite for non-`IO` functions
|
||||||
- debug/release outputs of Nix flake
|
|
||||||
|
|
||||||
### Changed
|
### Changed
|
||||||
|
|
||||||
- use Rotors rather than Quaternions for rotation; easily extended to 4D
|
- use rotors rather than `Linear.Quaternion` for rotation; easily extended to 4D
|
||||||
|
- move `Player` out of `Camera`
|
||||||
|
- configure with `Properties` objects in the Model
|
||||||
|
- use `Double` rather than `FLoat` for internal calculations
|
||||||
|
- `cursorPos`, `dt` natively `Double` already
|
||||||
|
|
||||||
|
## [0.2.1] - 2025-12-08
|
||||||
|
|
||||||
|
### Changed
|
||||||
|
|
||||||
|
- break Git by using it wrong
|
||||||
|
- fix Git (maybe)
|
||||||
|
|
||||||
|
## [0.2.0] - 2025-12-07
|
||||||
|
|
||||||
|
### Added
|
||||||
|
|
||||||
|
- 100% documentation coverage
|
||||||
|
- 4 outputs of Nix flake
|
||||||
|
- `debug`: compiles fast, no docs
|
||||||
|
- `release`: runs fast, no docs
|
||||||
|
- `docs`: only docs
|
||||||
|
- `default`: release binary with docs
|
||||||
|
|
||||||
|
### Changed
|
||||||
|
|
||||||
|
- `initResources` no longer takes a `GLFW.Window` argument
|
||||||
|
- BSD 3-clause license adopted rather than WTFPL
|
||||||
|
- reasoning: More professional, widely recognised, effectively identical
|
||||||
|
- `CHANGELOG.md` has more formatting, namely inline code
|
||||||
|
- clarify a couple entries in the `[0.1.0] - 2025-12-07 Changed` entry
|
||||||
|
|
||||||
### Fixed
|
### Fixed
|
||||||
|
|
||||||
- semantic issues
|
- semantic issues; no warnings are thrown
|
||||||
|
|
||||||
## [0.1.0] - 2025-12-07
|
## [0.1.0] - 2025-12-07
|
||||||
|
|
||||||
### Added
|
### Added
|
||||||
|
|
||||||
- CHANGELOG.md
|
- added `CHANGELOG.md`
|
||||||
- layer correctly drawn objects in the view function
|
- layer correctly drawn objects in `view`
|
||||||
|
|
||||||
### Changed
|
### Changed
|
||||||
|
|
||||||
- 8xMSAA rather than 4xMSAA window hint to improve AA
|
- 8xMSAA rather than 4xMSAA window hint to improve AA
|
||||||
- todo and changelog in CHANGELOG.md rather than README.md
|
- todo and changelog in `CHANGELOG.md` rather than `README.md`
|
||||||
- a nubmer fo functions from Game module now in Game.Internal
|
- a nubmer fo functions from `Game` now in `Game.Internal`
|
||||||
- initResources takes an array of objects to draw rather than hardcoded arrays
|
- `initResources` takes an `[V3 GL.GLfloat]` to draw rather than hardcoded arrays
|
||||||
- square the far plane of the perspective transform
|
- square the distance of the far plane of the perspective transform
|
||||||
- loop function takes delta time
|
- `loop` function takes delta time `dt :: Float`
|
||||||
|
|
||||||
### Fixed
|
### Fixed
|
||||||
|
|
||||||
|
|||||||
11
LICENSE
Normal file
11
LICENSE
Normal file
@@ -0,0 +1,11 @@
|
|||||||
|
Copyright 2025 Andromeda
|
||||||
|
|
||||||
|
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
|
||||||
|
|
||||||
|
1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
|
||||||
|
|
||||||
|
2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
|
||||||
|
|
||||||
|
3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
|
||||||
|
|
||||||
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
14
README.md
14
README.md
@@ -1,7 +1,21 @@
|
|||||||
|
to run:
|
||||||
|
|
||||||
```bash
|
```bash
|
||||||
git clone https://git.mtgmonkey.net/Andromeda/hs-game
|
git clone https://git.mtgmonkey.net/Andromeda/hs-game
|
||||||
cd hs-game
|
cd hs-game
|
||||||
nix run
|
nix run
|
||||||
```
|
```
|
||||||
|
|
||||||
|
to release:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
nix build .#release
|
||||||
|
```
|
||||||
|
|
||||||
|
to debug build:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
nix build .#debug
|
||||||
|
```
|
||||||
|
|
||||||
todo moved to CHANGELOG.md
|
todo moved to CHANGELOG.md
|
||||||
|
|||||||
61
flake.nix
61
flake.nix
@@ -5,9 +5,68 @@
|
|||||||
outputs = {nixpkgs, ...}: let
|
outputs = {nixpkgs, ...}: let
|
||||||
system = "x86_64-linux";
|
system = "x86_64-linux";
|
||||||
pkgs = nixpkgs.legacyPackages.${system};
|
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 {
|
in {
|
||||||
packages.${system} = {
|
packages.${system} = {
|
||||||
default = pkgs.callPackage ./package.nix {};
|
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;
|
||||||
|
};
|
||||||
};
|
};
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
|
|||||||
44
package.nix
44
package.nix
@@ -2,41 +2,13 @@
|
|||||||
haskellPackages,
|
haskellPackages,
|
||||||
lib,
|
lib,
|
||||||
stdenv,
|
stdenv,
|
||||||
|
ghcOptions,
|
||||||
|
haddockOptions,
|
||||||
|
ghcPackages,
|
||||||
...
|
...
|
||||||
}: let
|
}:
|
||||||
ghcExeOptions = lib.concatStringsSep " " ghcFlags;
|
|
||||||
ghcFlags = [
|
|
||||||
"-O"
|
|
||||||
"-Wall"
|
|
||||||
"-Widentities"
|
|
||||||
"-Wincomplete-record-updates"
|
|
||||||
"-Wincomplete-uni-patterns"
|
|
||||||
# "-Wmissing-export-lists"
|
|
||||||
"-Wmissing-home-modules"
|
|
||||||
"-Wpartial-fields"
|
|
||||||
"-Wredundant-constraints"
|
|
||||||
"-threaded"
|
|
||||||
"-rtsopts"
|
|
||||||
"-with-rtsopts=-N"
|
|
||||||
# src
|
|
||||||
"-i./src"
|
|
||||||
"-main-is Game"
|
|
||||||
];
|
|
||||||
haddockOptions = lib.concatStringsSep " " haddockFlags;
|
|
||||||
haddockFlags = [
|
|
||||||
"--html"
|
|
||||||
"--odir docs"
|
|
||||||
"--optghc=-i./src"
|
|
||||||
"src/Game/Main.hs"
|
|
||||||
];
|
|
||||||
ghcPackages = p: [
|
|
||||||
p.GLFW-b
|
|
||||||
p.linear
|
|
||||||
p.OpenGL
|
|
||||||
];
|
|
||||||
in
|
|
||||||
stdenv.mkDerivation {
|
stdenv.mkDerivation {
|
||||||
pname = "haskengl";
|
pname = "hs-game";
|
||||||
version = "0.1.0";
|
version = "0.1.0";
|
||||||
src = ./.;
|
src = ./.;
|
||||||
nativeBuildInputs = [
|
nativeBuildInputs = [
|
||||||
@@ -47,7 +19,9 @@ in
|
|||||||
configurePhase = ''
|
configurePhase = ''
|
||||||
'';
|
'';
|
||||||
buildPhase = ''
|
buildPhase = ''
|
||||||
ghc ${ghcExeOptions} ./src/Game/Main.hs -o ./Main
|
touch Main
|
||||||
|
ghc ${ghcOptions} ./src/Game.hs -o ./Main
|
||||||
|
mkdir ./docs
|
||||||
haddock ${haddockOptions}
|
haddock ${haddockOptions}
|
||||||
'';
|
'';
|
||||||
installPhase = ''
|
installPhase = ''
|
||||||
@@ -58,7 +32,7 @@ in
|
|||||||
|
|
||||||
meta = {
|
meta = {
|
||||||
homepage = "https://mtgmonkey.net";
|
homepage = "https://mtgmonkey.net";
|
||||||
license = lib.licenses.wtfpl;
|
license = lib.licenses.bsd3;
|
||||||
mainProgram = "hs-game";
|
mainProgram = "hs-game";
|
||||||
platforms = ["x86_64-linux"];
|
platforms = ["x86_64-linux"];
|
||||||
};
|
};
|
||||||
|
|||||||
@@ -2,43 +2,31 @@
|
|||||||
{- |
|
{- |
|
||||||
- Module : Game
|
- Module : Game
|
||||||
- Description : runs game
|
- Description : runs game
|
||||||
- Copyright : Andromeda 2025
|
- Copyright : 2025 Andromeda
|
||||||
- License : WTFPL
|
- License : BSD 3-clause
|
||||||
- Maintainer : Matrix @Andromeda:tchncs.de
|
- Maintainer : Matrix @Andromeda:tchncs.de
|
||||||
- Stability : Experimental
|
- Stability : Experimental
|
||||||
-}
|
-}
|
||||||
module Game (main) where
|
module Game (main) where
|
||||||
|
|
||||||
import Game.Internal.LoadShaders
|
|
||||||
import Game.Internal.Types
|
import Game.Internal.Types
|
||||||
import Game.Internal
|
import Game.Internal
|
||||||
|
|
||||||
import Control.Concurrent (threadDelay)
|
import Control.Lens ((^.))
|
||||||
import Control.Lens ((^.), (+~), (&), (%~))
|
import Data.IORef (newIORef)
|
||||||
import Control.Monad (when)
|
import GHC.Float (double2Float)
|
||||||
import Data.Fixed (mod')
|
|
||||||
import Data.IORef (atomicModifyIORef', IORef, modifyIORef', newIORef, readIORef, writeIORef)
|
|
||||||
import Data.List (delete)
|
|
||||||
import Foreign.Marshal.Array (withArray)
|
|
||||||
import Foreign.Ptr (nullPtr, plusPtr)
|
|
||||||
import Foreign.Storable (sizeOf, Storable)
|
|
||||||
import GHC.Float (double2Float, int2Double)
|
|
||||||
|
|
||||||
import qualified Graphics.UI.GLFW as GLFW
|
import qualified Graphics.UI.GLFW as GLFW
|
||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
import Graphics.Rendering.OpenGL as GL (($=))
|
import Graphics.Rendering.OpenGL as GL (($=))
|
||||||
|
|
||||||
import qualified Linear as L
|
import qualified Linear as L
|
||||||
import Linear ( V3(..)
|
import Linear ( V3(..), _y )
|
||||||
, _x
|
|
||||||
, _y
|
|
||||||
, _z
|
|
||||||
)
|
|
||||||
|
|
||||||
-- | Main function runs game
|
-- | Main function runs game
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
GLFW.init
|
_ <- GLFW.init
|
||||||
GLFW.defaultWindowHints
|
GLFW.defaultWindowHints
|
||||||
|
|
||||||
-- OpenGL core >=3.3
|
-- OpenGL core >=3.3
|
||||||
@@ -61,7 +49,7 @@ main = do
|
|||||||
GLFW.setCursorInputMode window GLFW.CursorInputMode'Hidden
|
GLFW.setCursorInputMode window GLFW.CursorInputMode'Hidden
|
||||||
GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing)
|
GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing)
|
||||||
|
|
||||||
(objects, program) <- initResources window testVertices
|
(objects, program) <- initResources testVertices
|
||||||
|
|
||||||
-- init model
|
-- init model
|
||||||
let
|
let
|
||||||
@@ -123,8 +111,6 @@ update dt model =
|
|||||||
updateAcceleration :: Float -> Model -> Model
|
updateAcceleration :: Float -> Model -> Model
|
||||||
updateAcceleration dt model =
|
updateAcceleration dt model =
|
||||||
let
|
let
|
||||||
yaw = (L.rotate (L.axisAngle model.wprop.up model.camera.camYaw) model.camera.camReference)
|
|
||||||
front = L.normalize $ (V3 1 0 1) * (L.rotate (L.axisAngle (L.cross model.wprop.up yaw) model.camera.camPitch) yaw)
|
|
||||||
zp = if elem GLFW.Key'S model.keys then 1 else 0
|
zp = if elem GLFW.Key'S model.keys then 1 else 0
|
||||||
zn = if elem GLFW.Key'W 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
|
xp = if elem GLFW.Key'D model.keys then 1 else 0
|
||||||
@@ -193,12 +179,6 @@ updateCameraAngle dt model =
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | updates given a keypress. escape case is probably caught by GLFW in the
|
|
||||||
-- handler function itself
|
|
||||||
updateKeyPressed :: GLFW.Key -> Model -> Model
|
|
||||||
updateKeyPressed key model =
|
|
||||||
model { keys = key:model.keys }
|
|
||||||
|
|
||||||
-- | views the model
|
-- | views the model
|
||||||
view :: GLFW.Window -> Model -> IO ()
|
view :: GLFW.Window -> Model -> IO ()
|
||||||
view window model = do
|
view window model = do
|
||||||
@@ -233,8 +213,8 @@ view window model = do
|
|||||||
projectionLocation <- GL.get $ GL.uniformLocation model.program "u_projection"
|
projectionLocation <- GL.get $ GL.uniformLocation model.program "u_projection"
|
||||||
GL.uniform projectionLocation $= projectionGLMatrix
|
GL.uniform projectionLocation $= projectionGLMatrix
|
||||||
|
|
||||||
-- draw objects
|
-- draw objects; returns IO []
|
||||||
drawObjects model.objects
|
_ <- drawObjects model.objects
|
||||||
|
|
||||||
-- swap to current buffer
|
-- swap to current buffer
|
||||||
GLFW.swapBuffers window
|
GLFW.swapBuffers window
|
||||||
@@ -1,9 +1,9 @@
|
|||||||
{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, OverloadedRecordDot #-}
|
{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, OverloadedRecordDot #-}
|
||||||
{- |
|
{- |
|
||||||
- Module : Game.Internal
|
- Module : Game.Internal
|
||||||
- Description : 'hidden' functions
|
- Description : internal functions
|
||||||
- Copyright : Andromeda 2025
|
- Copyright : 2025 Andromeda
|
||||||
- License : WTFPL
|
- License : BSD 3-clause
|
||||||
- Maintainer : Matrix @Andromeda:tchncs.de
|
- Maintainer : Matrix @Andromeda:tchncs.de
|
||||||
- Stability : Experimental
|
- Stability : Experimental
|
||||||
-}
|
-}
|
||||||
@@ -25,10 +25,8 @@ import Game.Internal.LoadShaders
|
|||||||
import Game.Internal.Types
|
import Game.Internal.Types
|
||||||
|
|
||||||
import Control.Concurrent (threadDelay)
|
import Control.Concurrent (threadDelay)
|
||||||
import Control.Lens ((^.), (+~), (&), (%~))
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Data.Fixed (mod')
|
import Data.IORef (IORef, modifyIORef', readIORef)
|
||||||
import Data.IORef (atomicModifyIORef', IORef, modifyIORef', newIORef, readIORef, writeIORef)
|
|
||||||
import Data.List (delete)
|
import Data.List (delete)
|
||||||
import Foreign.Marshal.Array (withArray)
|
import Foreign.Marshal.Array (withArray)
|
||||||
import Foreign.Ptr (nullPtr, plusPtr)
|
import Foreign.Ptr (nullPtr, plusPtr)
|
||||||
@@ -39,20 +37,15 @@ import qualified Graphics.UI.GLFW as GLFW
|
|||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
import Graphics.Rendering.OpenGL as GL (($=))
|
import Graphics.Rendering.OpenGL as GL (($=))
|
||||||
|
|
||||||
import qualified Linear as L
|
import Linear (V3(..))
|
||||||
import Linear ( V3(..)
|
|
||||||
, _x
|
|
||||||
, _y
|
|
||||||
, _z
|
|
||||||
)
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Shader creation and object initialisation
|
-- Shader creation and object initialisation
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
-- | loads models, shaders
|
-- | loads models, shaders
|
||||||
initResources :: GLFW.Window -> [V3 GL.GLfloat] -> IO ([Object], GL.Program)
|
initResources :: [V3 GL.GLfloat] -> IO ([Object], GL.Program)
|
||||||
initResources window array = do
|
initResources array = do
|
||||||
-- create objects
|
-- create objects
|
||||||
testObject0 <- createObject (map (+(V3 (-1) (-1) (-1))) array) 3 GL.TriangleStrip
|
testObject0 <- createObject (map (+(V3 (-1) (-1) (-1))) array) 3 GL.TriangleStrip
|
||||||
testObject1 <- createObject (map (+(V3 (1) (1) (1))) array) 3 GL.TriangleStrip
|
testObject1 <- createObject (map (+(V3 (1) (1) (1))) array) 3 GL.TriangleStrip
|
||||||
@@ -151,7 +144,7 @@ createObject array numComponents primitiveMode = do
|
|||||||
GL.bindVertexArrayObject $= Just vao
|
GL.bindVertexArrayObject $= Just vao
|
||||||
|
|
||||||
-- vbo for vertices
|
-- vbo for vertices
|
||||||
createVBO array numComponents $ GL.AttribLocation 0
|
_ <- createVBO array numComponents $ GL.AttribLocation 0
|
||||||
|
|
||||||
return
|
return
|
||||||
(Object
|
(Object
|
||||||
@@ -187,9 +180,9 @@ loop window dt update view modelRef = do
|
|||||||
-- end frame timer, wait the difference between expected and actual
|
-- end frame timer, wait the difference between expected and actual
|
||||||
Just frameEnd <- GLFW.getTime
|
Just frameEnd <- GLFW.getTime
|
||||||
let
|
let
|
||||||
dt = double2Float $ frameEnd - frameStart
|
drawTime = double2Float $ frameEnd - frameStart
|
||||||
target = 1 / 60 :: Float
|
target = 1 / 60 :: Float
|
||||||
when (dt < target) $ threadDelay $ floor $ (target - dt) * 1000000
|
when (drawTime < target) $ threadDelay $ floor $ (target - drawTime) * 1000000
|
||||||
Just frameEnd' <- GLFW.getTime
|
Just frameEnd' <- GLFW.getTime
|
||||||
let
|
let
|
||||||
dt' = double2Float $ frameEnd' - frameStart
|
dt' = double2Float $ frameEnd' - frameStart
|
||||||
@@ -254,9 +247,9 @@ resizeWindow _ _ _ = return ()
|
|||||||
keyPressed :: Maybe (IORef Model) -> GLFW.KeyCallback
|
keyPressed :: Maybe (IORef Model) -> GLFW.KeyCallback
|
||||||
keyPressed _ window GLFW.Key'Escape _ GLFW.KeyState'Pressed _ =
|
keyPressed _ window GLFW.Key'Escape _ GLFW.KeyState'Pressed _ =
|
||||||
shutdownWindow window
|
shutdownWindow window
|
||||||
keyPressed (Just modelRef) window key _ GLFW.KeyState'Pressed _ =
|
keyPressed (Just modelRef) _ key _ GLFW.KeyState'Pressed _ =
|
||||||
modifyIORef' modelRef $ updateKeyPressed key
|
modifyIORef' modelRef $ updateKeyPressed key
|
||||||
keyPressed (Just modelRef) window key _ GLFW.KeyState'Released _ =
|
keyPressed (Just modelRef) _ key _ GLFW.KeyState'Released _ =
|
||||||
modifyIORef' modelRef $ updateKeyReleased key
|
modifyIORef' modelRef $ updateKeyReleased key
|
||||||
keyPressed _ _ _ _ _ _ = return ()
|
keyPressed _ _ _ _ _ _ = return ()
|
||||||
|
|
||||||
|
|||||||
@@ -1,9 +1,9 @@
|
|||||||
{-# LANGUAGE NamedFieldPuns, OverloadedRecordDot #-}
|
{-# LANGUAGE NamedFieldPuns, OverloadedRecordDot #-}
|
||||||
{- |
|
{- |
|
||||||
- Module : Game.Types
|
- Module : Game.Internal.Types
|
||||||
- Description :
|
- Description :
|
||||||
- Copyright : Andromeda 2025
|
- Copyright : 2025 Andromeda
|
||||||
- License : WTFPL
|
- License : BSD 3-clause
|
||||||
- Maintainer : Matrix @Andromeda:tchncs.de
|
- Maintainer : Matrix @Andromeda:tchncs.de
|
||||||
- Stability : Experimental
|
- Stability : Experimental
|
||||||
-}
|
-}
|
||||||
@@ -44,18 +44,19 @@ import qualified Graphics.UI.GLFW as GLFW
|
|||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
import qualified Linear as L
|
import qualified Linear as L
|
||||||
import Linear (Quaternion, V3, V3(..), V4(..))
|
import Linear (V3, V3(..), V4(..))
|
||||||
|
|
||||||
-- | represents a single draw call
|
-- | represents a single draw call
|
||||||
data Object =
|
data Object =
|
||||||
Object
|
Object
|
||||||
{ vao :: GL.VertexArrayObject
|
{ vao :: GL.VertexArrayObject -- ^ vao of vertex buffer
|
||||||
, numIndicies :: GL.NumArrayIndices
|
, numIndicies :: GL.NumArrayIndices -- ^ number of vertices
|
||||||
, numComponents :: GL.NumComponents
|
, numComponents :: GL.NumComponents -- ^ dimensionallity; vec3, vec4, etc.
|
||||||
, primitiveMode :: GL.PrimitiveMode
|
, primitiveMode :: GL.PrimitiveMode -- ^ primitive mode to be drawn with
|
||||||
}
|
}
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
|
-- | converts M44 to a 16array for OpenGL
|
||||||
toGLMatrix :: L.M44 GL.GLfloat -> [GL.GLfloat]
|
toGLMatrix :: L.M44 GL.GLfloat -> [GL.GLfloat]
|
||||||
toGLMatrix
|
toGLMatrix
|
||||||
(V4
|
(V4
|
||||||
@@ -73,34 +74,49 @@ toGLMatrix
|
|||||||
data Model =
|
data Model =
|
||||||
Model
|
Model
|
||||||
{ camera :: Camera
|
{ camera :: Camera
|
||||||
, cursorDeltaPos :: (Double, Double)
|
, cursorDeltaPos :: (Double, Double) -- ^ frame-on-frame delta mouse position
|
||||||
, cursorPos :: (Double, Double)
|
, cursorPos :: (Double, Double) -- ^ current mouse position
|
||||||
, keys :: [GLFW.Key]
|
, keys :: [GLFW.Key] -- ^ currently pressed keys
|
||||||
, objects :: [Object]
|
, objects :: [Object] -- ^ draw calls
|
||||||
, program :: GL.Program
|
, program :: GL.Program -- ^ shader program
|
||||||
, wprop :: WorldProperties
|
, wprop :: WorldProperties
|
||||||
}
|
}
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
mkModel :: Camera -> [Object] -> GL.Program -> WorldProperties -> Model
|
-- | smart constructor for Model
|
||||||
mkModel camera objects program wprop = Model camera (0,0) (0,0) [] objects program wprop
|
mkModel
|
||||||
|
:: Camera
|
||||||
|
-> [Object]
|
||||||
|
-> GL.Program
|
||||||
|
-> WorldProperties
|
||||||
|
-> Model
|
||||||
|
mkModel camera objects program wprop =
|
||||||
|
Model
|
||||||
|
camera
|
||||||
|
(0,0)
|
||||||
|
(0,0)
|
||||||
|
[]
|
||||||
|
objects
|
||||||
|
program
|
||||||
|
wprop
|
||||||
|
|
||||||
-- | camera
|
-- | camera
|
||||||
data Camera =
|
data Camera =
|
||||||
Camera
|
Camera
|
||||||
{ camPos :: V3 Float
|
{ camPos :: V3 Float -- ^ position in world space
|
||||||
, camPitch :: Float
|
, camPitch :: Float -- ^ pitch in radians, up positive
|
||||||
, camYaw :: Float
|
, camYaw :: Float -- ^ yaw in radians, right positive
|
||||||
, camReference :: V3 Float
|
, camReference :: V3 Float -- ^ reference direction; orientation applied to
|
||||||
, camVel :: V3 Float
|
, camVel :: V3 Float -- ^ velocity in world space
|
||||||
, mouseSensitivity :: Float
|
, mouseSensitivity :: Float -- ^ scale factor for mouse movement
|
||||||
, strafeStrength :: Float
|
, strafeStrength :: Float -- ^ scale factor for strafe
|
||||||
, jumpStrength :: Float
|
, jumpStrength :: Float -- ^ scale factor for jump initial velocity
|
||||||
, hasJumped :: Bool
|
, hasJumped :: Bool -- ^ whether the camera still has jumping state
|
||||||
, airTime :: Float
|
, airTime :: Float -- ^ time since jumping state entered in seconds
|
||||||
}
|
}
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
|
-- | smart constructor for Camera
|
||||||
mkCamera
|
mkCamera
|
||||||
:: V3 Float
|
:: V3 Float
|
||||||
-> Float
|
-> Float
|
||||||
@@ -132,14 +148,16 @@ mkCamera
|
|||||||
False
|
False
|
||||||
0
|
0
|
||||||
|
|
||||||
|
-- | physical properties of the world
|
||||||
data WorldProperties =
|
data WorldProperties =
|
||||||
WorldProperties
|
WorldProperties
|
||||||
{ g :: Float -- ^ gravity `g`
|
{ g :: Float -- ^ gravity `g`
|
||||||
, friction :: Float -- ^ floor friction
|
, friction :: Float -- ^ scale factor for floor friction
|
||||||
, up :: V3 Float
|
, up :: V3 Float -- ^ global up vector
|
||||||
}
|
}
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
|
-- | smart constructor for WorldProperties
|
||||||
mkWorldProperties :: Float -> Float -> V3 Float-> WorldProperties
|
mkWorldProperties :: Float -> Float -> V3 Float-> WorldProperties
|
||||||
mkWorldProperties g friction up =
|
mkWorldProperties g friction up =
|
||||||
WorldProperties g friction (L.normalize up)
|
WorldProperties g friction (L.normalize up)
|
||||||
|
|||||||
Reference in New Issue
Block a user