From f66ebf9f4143254a38c6aa9e88ac492417c563cf Mon Sep 17 00:00:00 2001
From: magic_rb <richard@brezak.sk>
Date: Tue, 2 Apr 2024 16:19:55 +0200
Subject: [PATCH] Extend `PlayerComponent` and add `playerSystem`

Signed-off-by: magic_rb <richard@brezak.sk>
---
 rpg/rpg.cabal               |  1 +
 rpg/src/Component/Player.hs | 11 ++++++-----
 rpg/src/Executables/Pong.hs |  4 ++--
 rpg/src/Executables/RPG.hs  | 17 ++++-------------
 rpg/src/System/Player.hs    | 37 +++++++++++++++++++++++++++++++++++++
 5 files changed, 50 insertions(+), 20 deletions(-)
 create mode 100644 rpg/src/System/Player.hs

diff --git a/rpg/rpg.cabal b/rpg/rpg.cabal
index 15c8fc3..fc95435 100644
--- a/rpg/rpg.cabal
+++ b/rpg/rpg.cabal
@@ -48,6 +48,7 @@ library
       Stores.SparseSet
       System.OpenGLRenderer
       System.Physics
+      System.Player
       System.RaylibRenderer
       System.Renderer
       TH
diff --git a/rpg/src/Component/Player.hs b/rpg/src/Component/Player.hs
index 8799975..9630f8f 100644
--- a/rpg/src/Component/Player.hs
+++ b/rpg/src/Component/Player.hs
@@ -1,11 +1,12 @@
 {-# LANGUAGE TypeFamilies #-}
 
-module Component.Player (PlayerComponent(..)) where
+module Component.Player (PlayerComponent (..)) where
 
 import Apecs.Effectful
 
-data PlayerComponent
-  = Player
-  {}
-  deriving Show
+data PlayerComponent = Player
+  { speed :: Float
+  , active :: Bool
+  }
+  deriving (Show)
 instance Component PlayerComponent where type Storage PlayerComponent = Map PlayerComponent
diff --git a/rpg/src/Executables/Pong.hs b/rpg/src/Executables/Pong.hs
index 9e0877a..d0cc789 100644
--- a/rpg/src/Executables/Pong.hs
+++ b/rpg/src/Executables/Pong.hs
@@ -126,7 +126,7 @@ initialise = do
 
   player1Entity <-
     AE.newEntity @World
-      ( Player
+      ( Player 1.0 True
       , Position $ V2 (-10) 0
       , Box RL.white (V2 0 0) (V2 0.5 2)
       , AABB (V2 0.5 2) (V2 0 0)
@@ -140,7 +140,7 @@ initialise = do
 
   player2Entity <-
     AE.newEntity @World
-      ( Player
+      ( Player 1.0 True
       , Position $ V2 10 0
       , Box RL.white (V2 0 0) (V2 0.5 2)
       , AABB (V2 0.5 2) (V2 0 0)
diff --git a/rpg/src/Executables/RPG.hs b/rpg/src/Executables/RPG.hs
index 95742bd..dfab2a9 100644
--- a/rpg/src/Executables/RPG.hs
+++ b/rpg/src/Executables/RPG.hs
@@ -37,6 +37,7 @@ import Linear.V2
 import Noise.Perlin
 import Raylib.Types qualified as RL
 import Raylib.Util.Colors qualified as RL
+import System.Player
 import System.RaylibRenderer
 import System.Renderer
 import World
@@ -72,7 +73,7 @@ spawnPlayer
   -> Eff es AE.Entity
 spawnPlayer color =
   AE.newEntity @LocalWorld
-    ( Player
+    ( Player 0.1 True
     , Position $ V2 0 2
     , Camera 10 (0, 0)
     , AABB (V2 0.8 0.8) (V2 0 0)
@@ -163,18 +164,8 @@ runGame = interpret \_ eff ->
   case eff of
     GameInput -> do
       playerEntity <- gets @GameState (\s -> s.playerEntity)
-      -- AE.modify @LocalWorld @(Maybe (TagComponent Int)) @(TagComponent Int) playerEntity \case
-      --   Just (Tag n) -> Tag (n + 1)
-      --   Nothing -> Tag 0
-      -- AE.get @LocalWorld @(TagComponent Int) playerEntity >>= unsafeEff_ . print
-      playerMovement @LocalWorld
-        playerEntity
-        ( RL.KeyA
-        , RL.KeyD
-        , RL.KeyW
-        , RL.KeyS
-        )
-        0.1
+
+      playerSystem @LocalWorld
 
       cameraEntity <- gets @GameState (\s -> s.cameraEntity)
 
diff --git a/rpg/src/System/Player.hs b/rpg/src/System/Player.hs
new file mode 100644
index 0000000..afc8365
--- /dev/null
+++ b/rpg/src/System/Player.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE IncoherentInstances #-}
+
+module System.Player (playerSystem) where
+
+import Apecs.Effectful qualified as AE
+import Common
+import Component.Player
+import Component.Velocity
+import Data.Functor ((<&>))
+import Effectful
+import Linear (normalize)
+import Linear.V2 (V2 (..))
+import Raylib.Types qualified as RL
+import System.Renderer (Renderer, isKeyDown)
+
+playerSystem
+  :: forall w es. (AE.ECS w :> es, AE.Get w PlayerComponent, AE.Set w VelocityComponent, Renderer :> es) => Eff es ()
+playerSystem = do
+  let
+    left = RL.KeyA
+    right = RL.KeyD
+    down = RL.KeyS
+    up = RL.KeyW
+  directions <-
+    mapM
+      (\tuple -> fst tuple <&> (,snd tuple))
+      [ (isKeyDown left, V2 (-1.0) 0)
+      , (isKeyDown right, V2 1.0 0)
+      , (isKeyDown down, V2 0 1.0)
+      , (isKeyDown up, V2 0 (-1.0))
+      ]
+  AE.cmapIf @w @(PlayerComponent) @(VelocityComponent) @(PlayerComponent)
+    (const True)
+    \(player) ->
+      let movement = foldl (+) (V2 0 0) $ map snd $ filter fst directions
+       in Velocity (normalize movement * pure player.speed)