Add dependencies

2021-09-05 23:58:50 +01:00
parent 86311c5d41
commit 4d3c0ae38f
5 changed files with 295 additions and 0 deletions
@@ -0,0 +1,114 @@
+module Dodge.Creature.Impulse.Movement
+    where
+import Dodge.Data
+import Dodge.Creature.Stance.Data
+import Dodge.Item.Data
+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, will be made relative to creature direction
+    -> Creature 
+    -> Creature
+crMvBy p' cr = advanceStepCounter (magV p) cr
+    & crPos %~ (+.+ p)
+    & crMvDir .~ argV p
+  where 
+    p =  (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) 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
+
+crMvAbsolute
+    :: Point2   -- ^ Movement translation vector
+    -> Creature 
+    -> Creature
+crMvAbsolute p' cr = advanceStepCounter (magV p) cr
+    & crPos %~ (+.+ p)
+    & crMvDir .~ argV p
+  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 
+    -> Creature
+crMvForward speed = crMvBy (V2 speed 0)
+
+advanceStepCounter
+    :: Float    -- ^ Speed
+    -> Creature 
+    -> Creature
+advanceStepCounter speed cr = cr & crStance . carriage %~ f
+  where 
+    --stnce = _crStance cr
+    f car = case car of
+        Standing -> f (Walking 0 RightForward)
+        Walking i ff -> Walking (i + ceiling speed) ff
+        _ -> car
+
+creatureTurn :: Float -> Creature -> Creature
+creatureTurn a = crDir +~ a
+
+creatureTurnTo :: Point2 -> Creature -> Creature
+creatureTurnTo p cr 
+    | vToTarg == V2 0 0 = cr -- this should deal with the angleVV error
+    | otherwise         = cr & crDir .~ dirToTarget
+  where
+    vToTarg = p -.- _crPos cr
+    dirToTarget = argV vToTarg
+
+creatureTurnTowardDir 
+    :: Float -- ^ Angle
+    -> Float -- ^ Turn speed
+    -> Creature
+    -> Creature
+creatureTurnTowardDir a turnSpeed cr 
+    | vToTarg == V2 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 (V2 1 0)
+    dirToTarget = argV vToTarg
+
+creatureTurnToward :: Point2 -> Float -> Creature -> Creature
+creatureTurnToward p turnSpeed cr 
+    | vToTarg == V2 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 = p -.- _crPos cr
+    dirToTarget = argV vToTarg
+
+{- | Speed modifier of an item when not aiming. -}
+equipSpeed :: Item -> Float
+equipSpeed _ = 1
+{- | Speed modifier of an item when aiming. -}
+equipAimSpeed :: Item -> Float
+equipAimSpeed NoItem = 1
+equipAimSpeed it 
+    | _itIdentity it == FrontArmour = 0.5
+    | _itIdentity it == FlameShield = 0.5
+    | otherwise                     = 1