diff --git a/flake.lock b/flake.lock index d67a73d..692dbc6 100644 --- a/flake.lock +++ b/flake.lock @@ -2,11 +2,11 @@ "nodes": { "nixpkgs": { "locked": { - "lastModified": 1668949648, - "narHash": "sha256-SKsffSzdY5NNd1kiajeg/ClFgJegSZys6liAQmL1lXw=", + "lastModified": 1693659171, + "narHash": "sha256-m7eU04u5IeU6NZMc68VjozcQf6vFUY3HfMHu6yCPLg0=", "owner": "nixos", "repo": "nixpkgs", - "rev": "8181233059a8caf6f7bde1172c042a42883ecb56", + "rev": "818441a0cfa929adb5979c4674840aff587c053b", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index c547bba..af55064 100644 --- a/flake.nix +++ b/flake.nix @@ -3,23 +3,15 @@ nixpkgs.url = "github:nixos/nixpkgs"; }; outputs = { self, nixpkgs }: - let pkgs = nixpkgs.legacyPackages.x86_64-linux.haskellPackages.override { - overrides = self: super: { - h-raylib = nixpkgs.legacyPackages.x86_64-linux.haskell.lib.overrideCabal super.h-raylib { - version = "4.5.0.5"; - sha256 = "sha256-PmDnnaN+RgVf6JetsVc/ko9HBY2xSU3KQQT/MZblU5Q="; - }; - }; - }; + let pkgs = nixpkgs.legacyPackages.x86_64-linux.haskellPackages; in rec { packages.x86_64-linux = { default = pkgs.callCabal2nix "notakto" ./. {}; }; - apps.default = { type = "app"; program = packages.default; }; devShell.x86_64-linux = pkgs.shellFor { packages = p: [ packages.x86_64-linux.default ]; withHoogle = true; - buildInputs = with pkgs; [ + nativeBuildInputs = with pkgs; [ haskell-language-server ghcid cabal-install diff --git a/src/lib/Lib.hs b/src/lib/Lib.hs index 6b3f220..d9186da 100644 --- a/src/lib/Lib.hs +++ b/src/lib/Lib.hs @@ -2,15 +2,18 @@ module Lib (main) where +import Control.Applicative (liftA2) import Control.Monad (forM_, unless, when) -import Foreign.C.Types (CFloat(..)) import Apecs -import qualified Raylib as RL -import qualified Raylib.Constants as RL +import qualified Raylib.Core as RL +import qualified Raylib.Core.Models as RL import qualified Raylib.Types as RL -import Raylib.Types (Vector3 (..)) +import qualified Raylib.Util as RL +import qualified Raylib.Util.Camera as RL +import Raylib.Types (Vector2 (..), Vector3 (..)) +import Raylib.Util.Math import Rendering import Types @@ -19,19 +22,23 @@ import Util -------------------------------------------------------------------------------- main :: IO () -main = initWorld >>= runSystem (initialise >> run >> terminate) +main = initWorld >>= runSystem (do + window <- initialise + run + terminate window) -initialise :: System World () +initialise :: System World RL.WindowResources initialise = do let camera = RL.Camera3D (Vector3 0 1 6) (Vector3 0 1 0) (Vector3 0 1 0) 90 - RL.cameraProjection'perspective + RL.CameraPerspective set global (Camera camera, Red) newGame liftIO $ do - RL.initWindow 1920 1080 "App" + window <- RL.initWindow 1920 1080 "App" RL.setTargetFPS 60 - RL.setCameraMode camera RL.cameraMode'firstPerson + RL.disableCursor + pure window newGame :: System World () @@ -49,8 +56,8 @@ createBoards n = do let x' = (fromIntegral x - (fromIntegral (n - 1) / 2)) * 4.5] -terminate :: System World () -terminate = liftIO RL.closeWindow +terminate :: RL.WindowResources -> System World () +terminate window = liftIO $ RL.closeWindow window run :: System World () @@ -65,8 +72,7 @@ update :: System World () update = do updateCamera handlePlayerAim - - clicked <- liftIO $ RL.isMouseButtonPressed 0 + clicked <- liftIO $ RL.isMouseButtonPressed RL.MouseButtonLeft when clicked $ do handleLeftClick @@ -74,8 +80,27 @@ update = do updateCamera :: System World () updateCamera = do Camera c <- get global - c' <- liftIO $ RL.updateCamera c - set global $ Camera c' + newCam <- liftIO $ do + dt <- RL.getFrameTime + forward <- checkKey RL.KeyW RL.KeyUp + left <- checkKey RL.KeyA RL.KeyLeft + backward <- checkKey RL.KeyS RL.KeyDown + right <- checkKey RL.KeyD RL.KeyRight + Vector2 i j <- RL.getMouseDelta + let speed = 5.0 + turnspeed = 1 + Vector3 x _ z = + (RL.getCameraForward c |* (forward - backward)) |+| + (RL.getCameraRight c |* (right - left)) + c' = RL.cameraMove c $ safeNormalize (Vector3 x 0 z) |* (speed * dt) + c'' = RL.cameraYaw c' (-i * turnspeed * dt) False + pure $ RL.cameraPitch c'' (-j * turnspeed * dt) False False False + set global $ Camera newCam + where checkKey a b = + liftA2 (\x y -> if x || y then 1 else 0) (RL.isKeyDown a) (RL.isKeyDown b) + safeNormalize v + | magnitude v == 0 = v + | otherwise = vectorNormalize v handlePlayerAim :: System World () @@ -84,8 +109,8 @@ handlePlayerAim = do windowHeight <- liftIO RL.getScreenHeight Camera camera <- get global ray <- liftIO $ RL.getMouseRay (RL.Vector2 - (CFloat $ fromIntegral windowWidth / 2) - (CFloat $ fromIntegral windowHeight / 2)) camera + (fromIntegral windowWidth / 2) + (fromIntegral windowHeight / 2)) camera target <- cfoldM (findLookAtTarget ray) NoTarget set global $ Aim ray target @@ -94,14 +119,14 @@ findLookAtTarget :: RL.Ray -> LookAtTarget -> (BoardComponent, PositionComponent, Not DeathComponent, Entity) -> System World LookAtTarget findLookAtTarget ray target (_, Position p, _, e) = do - if RL.rayCollision'hit hitInfo > 0 then + if RL.rayCollision'hit hitInfo then getClosestTarget ray target $ Target e (findCell hitPos) else pure target - where from = addVectors p $ Vector3 (-1.5) (-1.5) (-0.05) - to = addVectors p $ Vector3 1.5 1.5 0.05 + where from = p |+| Vector3 (-1.5) (-1.5) (-0.05) + to = p |+| Vector3 1.5 1.5 0.05 hitInfo = RL.getRayCollisionBox ray $ RL.BoundingBox from to - hitPos = subtractVectors (RL.rayCollision'point hitInfo) p + hitPos = RL.rayCollision'point hitInfo |-| p getClosestTarget :: RL.Ray -> LookAtTarget -> LookAtTarget -> @@ -110,8 +135,8 @@ getClosestTarget ray a@(Target eA _) b@(Target eB _) = do Position posA <- get eA Position posB <- get eB let p = RL.ray'position ray - distA = magnitudeVector $ subtractVectors posA p - distB = magnitudeVector $ subtractVectors posB p + distA = magnitude $ posA |-| p + distB = magnitude $ posB |-| p pure $ if distA <= distB then a else b getClosestTarget _ a NoTarget = pure a getClosestTarget _ NoTarget b = pure b diff --git a/src/lib/Rendering.hs b/src/lib/Rendering.hs index 71e7ee0..1fe81f0 100644 --- a/src/lib/Rendering.hs +++ b/src/lib/Rendering.hs @@ -3,15 +3,16 @@ module Rendering ( ) where import Control.Monad (when) -import Foreign.C.Types (CFloat(..)) import Apecs -import qualified Raylib as RL -import qualified Raylib.Colors as RL -import qualified Raylib.Constants as RL +import qualified Raylib.Core as RL +import qualified Raylib.Core.Text as RL +import qualified Raylib.Core.Models as RL +import qualified Raylib.Util.Colors as RL import qualified Raylib.Types as RL import Raylib.Types (Vector3 (..)) +import Raylib.Util.Math import Types import Util @@ -38,9 +39,8 @@ render = do renderAimRay :: System World () renderAimRay = do (Aim ray _, player) <- get global - let lineStart = addVectors (RL.ray'position ray) (Vector3 0 (-0.05) 0) - lineEnd = addVectors (RL.ray'position ray) $ - multiplyVector (RL.ray'direction ray) 10 + let lineStart = RL.ray'position ray |+| Vector3 0 (-0.05) 0 + lineEnd = RL.ray'position ray |+| (RL.ray'direction ray |* 10) liftIO $ RL.drawLine3D lineStart lineEnd $ playerColour player @@ -55,10 +55,10 @@ renderBoard :: LookAtTarget -> PlayerComponent -> renderBoard target player (b, Position p, e) = do renderCrosses p (b, e) target player liftIO $ do - RL.drawCube (addVectors p $ Vector3 0.5 0 0) t 3 t RL.white - RL.drawCube (addVectors p $ Vector3 (-0.5) 0 0) t 3 t RL.white - RL.drawCube (addVectors p $ Vector3 0 0.5 0) 3 t t RL.white - RL.drawCube (addVectors p $ Vector3 0 (-0.5) 0) 3 t t RL.white + RL.drawCube (p |+| Vector3 0.5 0 0) t 3 t RL.white + RL.drawCube (p |+| Vector3 (-0.5) 0 0) t 3 t RL.white + RL.drawCube (p |+| Vector3 0 0.5 0) 3 t t RL.white + RL.drawCube (p |+| Vector3 0 (-0.5) 0) 3 t t RL.white where t = 0.05 @@ -88,12 +88,12 @@ renderCross _ _ _ Empty False _ = pure () renderCross origin i j (Filled player) _ _ = liftIO $ do RL.drawLine3D (f (-0.4) (-0.4)) (f 0.4 0.4) $ playerColour player RL.drawLine3D (f 0.4 (-0.4)) (f (-0.4) 0.4) $ playerColour player - where center = addVectors origin $ Vector3 (CFloat i) (CFloat j) 0 - f x y = addVectors center $ Vector3 x y 0 + where center = origin |+| Vector3 i j 0 + f x y = center |+| Vector3 x y 0 renderCross origin i j Empty True player = liftIO $ do RL.drawCircle3D center 0.4 (Vector3 0 1 0) 0 $ playerColour player - where center = addVectors origin $ Vector3 (CFloat i) (CFloat j) 0 + where center = origin |+| Vector3 i j 0 playerColour :: PlayerComponent -> RL.Color diff --git a/src/lib/Types.hs b/src/lib/Types.hs index 317c98a..db6e514 100644 --- a/src/lib/Types.hs +++ b/src/lib/Types.hs @@ -37,6 +37,9 @@ data LookAtTarget = NoTarget | Target Entity Int deriving (Show, Eq) -- Components -- ---------------- +newtype CameraLocation = CameraLocation RL.Vector3 deriving (Show, Eq) + + newtype PositionComponent = Position RL.Vector3 deriving (Show, Eq) diff --git a/src/lib/Util.hs b/src/lib/Util.hs index 0aaaccf..34f1ad9 100644 --- a/src/lib/Util.hs +++ b/src/lib/Util.hs @@ -1,16 +1,9 @@ module Util ( destroyEntity, - addVectors, - subtractVectors, - multiplyVector, - multiplyVectors, - magnitudeVector ) where import Apecs -import Foreign.C.Types (CFloat(..)) - import Raylib.Types (Vector3 (..)) import Types @@ -20,36 +13,3 @@ import Types destroyEntity :: Entity -> System World () destroyEntity e = destroy e (Proxy :: Proxy AllComponents) - - -addVectors :: Vector3 -> Vector3 -> Vector3 -addVectors a b = Vector3 - (vector3'x a + vector3'x b) - (vector3'y a + vector3'y b) - (vector3'z a + vector3'z b) - - -subtractVectors :: Vector3 -> Vector3 -> Vector3 -subtractVectors a b = Vector3 - (vector3'x a - vector3'x b) - (vector3'y a - vector3'y b) - (vector3'z a - vector3'z b) - - -multiplyVector :: Vector3 -> Float -> Vector3 -multiplyVector a b = let b' = CFloat b in Vector3 - (vector3'x a * b') - (vector3'y a * b') - (vector3'z a * b') - - -multiplyVectors :: Vector3 -> Vector3 -> Vector3 -multiplyVectors a b = Vector3 - (vector3'x a * vector3'x b) - (vector3'y a * vector3'y b) - (vector3'z a * vector3'z b) - - -magnitudeVector :: Vector3 -> Float -magnitudeVector (Vector3 x y z) = - let CFloat f = sqrt $ (x * x) + (y * y) + (z * z) in f