From eb7c4a8067fc6cfa61d155c06d4528a72e92fc9e Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Sun, 6 Jun 2021 16:33:25 +0200
Subject: [PATCH] Slow your turn when moving and not aiming

---
 src/Dodge/Creature/Action/Movement.hs | 37 ++++++++++++++++++++++++---
 src/Dodge/Creature/YourControl.hs     |  5 +++-
 src/Dodge/WorldEvent/Explosion.hs     |  4 +--
 3 files changed, 40 insertions(+), 6 deletions(-)

diff --git a/src/Dodge/Creature/Action/Movement.hs b/src/Dodge/Creature/Action/Movement.hs
index ea1227ff3..f81a3a59f 100644
--- a/src/Dodge/Creature/Action/Movement.hs
+++ b/src/Dodge/Creature/Action/Movement.hs
@@ -8,12 +8,11 @@ import Geometry
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
-
 {- | Creature attempts to moves under its own steam.
 The idea is that this may or may not work, depending on the status of the creature. 
 For now, though, this cannot fail. -}
-crMvBy 
-    :: Point2   -- ^ Movement translation vector
+crMvBy
+    :: Point2   -- ^ Movement translation vector, will be made relative to creature direction
     -> Creature 
     -> Creature
 crMvBy p' cr = advanceStepCounter (magV p) $ over crPos (+.+ p) cr
@@ -28,6 +27,22 @@ crMvBy p' cr = advanceStepCounter (magV p) $ over crPos (+.+ p) cr
         | otherwise = 1
     it = _crInv cr IM.! _crInvSel cr
 
+crMvAbsolute
+    :: Point2   -- ^ Movement translation vector
+    -> Creature 
+    -> Creature
+crMvAbsolute p' cr = advanceStepCounter (magV p) $ over crPos (+.+ p) cr
+  where 
+    p =  (*.*) (equipFactor * aimingFactor) p'
+    equipFactor 
+        | _posture (_crStance cr) == Aiming 
+                    = product $ map equipAimSpeed $ IM.elems $ _crInv cr
+        | otherwise = product $ map equipSpeed $ IM.elems $ _crInv cr
+    aimingFactor 
+        | _posture (_crStance cr) == Aiming = fromMaybe 1 $ it ^? itAimingSpeed
+        | otherwise = 1
+    it = _crInv cr IM.! _crInvSel cr
+
 crMvForward 
     :: Float    -- ^ Speed
     -> Creature 
@@ -46,6 +61,7 @@ advanceStepCounter speed = crStance . carriage %~ f
 creatureTurn :: Float -> Creature -> Creature
 creatureTurn a = crDir +~ a
 
+
 creatureTurnTo :: Point2 -> Creature -> Creature
 creatureTurnTo p cr 
     | vToTarg == (0,0)  = cr -- this should deal with the angleVV error
@@ -54,6 +70,21 @@ creatureTurnTo p cr
     vToTarg = p -.- _crPos cr
     dirToTarget = argV vToTarg
 
+creatureTurnTowardDir 
+    :: Float -- ^ Angle
+    -> Float -- ^ Turn speed
+    -> Creature
+    -> Creature
+creatureTurnTowardDir a turnSpeed cr 
+    | vToTarg == (0,0) = cr -- this should deal with the angleVV error
+    | errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
+                                        = cr & crDir .~ dirToTarget
+    | isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) = cr & crDir +~ turnSpeed
+    | otherwise                         = cr & crDir -~ turnSpeed
+  where
+    vToTarg = rotateV a (1,0)
+    dirToTarget = argV vToTarg
+
 creatureTurnToward :: Point2 -> Float -> Creature -> Creature
 creatureTurnToward p turnSpeed cr 
     | vToTarg == (0,0) = cr -- this should deal with the angleVV error
diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs
index 4c1f6148c..8e5922301 100644
--- a/src/Dodge/Creature/YourControl.hs
+++ b/src/Dodge/Creature/YourControl.hs
@@ -34,11 +34,14 @@ wasdWithAiming
     -> Creature
 wasdWithAiming w speed i cr
     | isAiming = set crDir mouseDir $ crMvBy (speed *.* mov) cr
-    | isMoving = crMvForward speed $ over crDir (`fromMaybe` dir) cr
+    | isMoving = crMvAbsolute (speed *.* movAbs) $ turnAction cr
+   -- | isMoving = crMvForward speed $ over crDir (`fromMaybe` dir) cr
     | otherwise = cr
   where 
     (mov',dir') = wasdComp (view keys w) w
     dir = fmap (_cameraRot w +) dir'
+    turnAction cr' = maybe cr (\d -> creatureTurnTowardDir d 0.2 cr') dir
+    movAbs = rotateV (_cameraRot w) mov'
     mov = rotateV (negate $ _crDir cr - _cameraRot w) mov'
     isAiming    = _posture (_crStance cr) == Aiming
     isMoving    = mov' /= (0,0)
diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs
index daccf73d4..713b82eb5 100644
--- a/src/Dodge/WorldEvent/Explosion.hs
+++ b/src/Dodge/WorldEvent/Explosion.hs
@@ -17,7 +17,7 @@ import Control.Monad.State
 import Data.List
 --import Data.Maybe
 import System.Random
-import qualified Data.IntMap.Strict as IM
+--import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
 makePoisonExplosionAt 
@@ -36,7 +36,7 @@ makeTeslaExplosionAt
     :: Point2   -- ^ Position
     -> World 
     -> World
-makeTeslaExplosionAt pos w = undefined
+makeTeslaExplosionAt pos w = undefined pos w
 --     soundOncePos grenadeBang pos $ foldr ($) w listOfFunctions -- a bit shorter
 --  where 
 --    xs = randomRs (0, 2*pi) $ _randGen w