From 54b7cbd4144e6cf4b801ab960595a158e14ec606 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Amedeo=20Moln=C3=A1r?= <amedeo.molnar@cyberus-technology.de>
Date: Tue, 17 Dec 2024 12:00:51 +0100
Subject: [PATCH] make client move around on the map

---
 src-client/Client/Graphics.hs              |  2 +-
 src-server/Server/Communication/Handler.hs | 38 ++++++++++++++++++++--
 src-server/Server/Util.hs                  |  2 +-
 3 files changed, 38 insertions(+), 4 deletions(-)

diff --git a/src-client/Client/Graphics.hs b/src-client/Client/Graphics.hs
index 78d24d9..76b6940 100644
--- a/src-client/Client/Graphics.hs
+++ b/src-client/Client/Graphics.hs
@@ -84,7 +84,7 @@ castRay
   -> (Float, Float) -- screen dimensions
   -> Float          -- Ray length
 castRay wizard (row, col) (x, y) (width, height) =
-  let direction = angle (wizardRot wizard - pi / 2 - hFOV / 2 + x * hFOV / width)
+  let direction = angle (wizardRot wizard - hFOV / 2 + x * hFOV / width)
       invdir@(V2 invDirCol invDirRow) = (1 /) <$> direction
       wStep@(V2 wStepCol wStepRow) = wizardPos wizard - (fromIntegral . floor <$> wizardPos wizard)
       ulCol = col - 1
diff --git a/src-server/Server/Communication/Handler.hs b/src-server/Server/Communication/Handler.hs
index 1ad61aa..15917a6 100644
--- a/src-server/Server/Communication/Handler.hs
+++ b/src-server/Server/Communication/Handler.hs
@@ -17,6 +17,8 @@ import Data.Time
 
 import Data.UUID.V4
 
+import Linear (angle, perp)
+
 import System.Random (randomRIO)
 
 -- internal imports
@@ -132,8 +134,40 @@ handleMessage stateContainer readerContainer msg = do
                 mPlayer
             )
             mclient
-        -- ClientAction act -> do
-        --   let mclient = find (\c -> csUUID c == Just clientId) socks
+        ClientAction act -> do
+          players <- STM.atomically $ STM.readTMVar (scPlayers stateContainer)
+          mPlayer <- STM.atomically $ do
+            pure $ find (\p -> playerId p == clientId) players
+          maybe
+            (pure ())
+            (\player -> do
+              let wiz = playerWizard player
+                  rotStep = pi / 18
+                  newRot = wizardRot wiz + case act of
+                    TurnLeft  -> -rotStep
+                    TurnRight -> rotStep
+                    _         -> 0
+                  newPos = wizardPos wiz + ((0.25 *) <$>
+                    case act of
+                      StepForward  -> -(angle newRot)
+                      StepBackward -> angle newRot
+                      StrifeRight  -> perp (angle newRot)
+                      StrifeLeft   -> -(perp (angle newRot))
+                      _            -> 0
+                    )
+                  newWiz = wiz
+                    { wizardRot = newRot
+                    , wizardPos = newPos
+                    }
+                  newPlayer = player
+                    { playerWizard = newWiz
+                    }
+                  otherPlayers = filter (\p -> playerId p /= clientId) players
+                  newPlayers = newPlayer : otherPlayers
+              void $ STM.atomically $ STM.swapTMVar (scPlayers stateContainer) newPlayers
+              sendUpdate curLevel stateContainer (rcMap readerContainer) player
+            )
+            mPlayer
         x -> logPrintIO (rcLogLevel readerContainer) Verbose ("Unhandled message: " <> show x)
 
 -- | handle received messages
diff --git a/src-server/Server/Util.hs b/src-server/Server/Util.hs
index e874041..34b382e 100644
--- a/src-server/Server/Util.hs
+++ b/src-server/Server/Util.hs
@@ -30,7 +30,7 @@ newWizard
 newWizard pos rot =
   Wizard
     { wizardWands   = []
-    , wizardRot     = rot
+    , wizardRot     = 0
     , wizardPos     = pos
     , wizardMana    = 100
     , wizardHealth  = 100