AI refactor

2021-05-07 16:50:59 +02:00
parent 436043b169
commit 1aa59cc205
16 changed files with 295 additions and 340 deletions
@@ -30,20 +30,11 @@ import System.Random
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map as M

-moveForwardSpeed 
-    :: Float    -- ^ Speed
-    -> Int      -- ^ Creature id
-    -> World 
-    -> World
-moveForwardSpeed x n w = over (creatures . ix n . crPos) (+.+ p) w
-  where 
-    p = (*.*) x $ unitVectorAtAngle $ _crDir $ _creatures w IM.! n
-
 crStrafeLeft
    :: Float    -- ^ Speed
    -> Creature 
    -> Creature
-crStrafeLeft speed cr = stepForward s2 $ over crPos (+.+ p) cr
+crStrafeLeft speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
  where 
    p =  (*.*) s2 $ unitVectorAtAngle $ (_crDir cr + pi/2)
    equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
@@ -53,42 +44,12 @@ crStrafeRight
    :: Float    -- ^ Speed
    -> Creature 
    -> Creature
-crStrafeRight speed cr = stepForward s2 $ over crPos (+.+ p) cr
+crStrafeRight speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
  where 
    p =  (*.*) s2 $ unitVectorAtAngle $ (_crDir cr - pi/2)
    equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
    s2 = (speed * equipFactor)

-crMvForward 
-    :: Float    -- ^ Speed
-    -> Creature 
-    -> Creature
-crMvForward speed cr = over crPos (+.+ p) cr
-  where 
-    p =  (*.*) (speed * equipFactor) $ unitVectorAtAngle $ _crDir cr
-    equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
-
-crMvBy 
-    :: Point2   -- ^ Movement translation vector
-    -> Creature 
-    -> Creature
-crMvBy p' cr = stepForward (magV p) $ over crPos (+.+ p) cr
-  where 
-    p =  (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
-    equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
-    aimingFactor | (_posture $ _crStance cr) == Aiming
-                      = fromMaybe 1 $ it ^? itAimingSpeed
-                 | otherwise = 1
-    it = _crInv cr IM.! _crInvSel cr
-
-stepForward 
-    :: Float    -- ^ Speed
-    -> Creature 
-    -> Creature
-stepForward speed cr = over (crStance . carriage) f cr
-  where 
-    f (w@Walking {}) = w {_stepToAdd = ceiling speed}
-    f s = s


 turnTo 
@@ -233,32 +194,7 @@ turnToward p n w
  where 
    cr          = _creatures w IM.! n
    dirToTarget = argV (p -.- _crPos cr)
-
-{- Move a creature forward in the direction it is facing. -}
-moveForward 
-    :: Int      -- ^ Creature id
-    -> World 
-    -> World
-moveForward n w = over (creatures . ix n . crPos) (+.+ p) w
-  where 
-    p = unitVectorAtAngle $ _crDir $ _creatures w IM.! n
-
-{- Move a creature forward, faster if it is facing a target point -}
-moveToward 
-    :: Point2   -- ^ Target point
-    -> Int      -- ^ Creature id
-    -> World 
-    -> World
-moveToward p n w
-    | angle < 10 = moveForwardSpeed 0.1 n w
-    | angle < 20 = moveForwardSpeed 0.02 n w
-    | angle < 40 = moveForwardSpeed 0.01 n w
-    | otherwise  = w
-  where 
-    angle  = errorAngleVV 5 (p -.- curPos) (unitVectorAtAngle (_crDir (_creatures w IM.! n)))
-    curPos = _crPos (_creatures w IM.! n)
-
-{- Translate a creature. -}
+{- | Translate a creature. -}
 moveBy 
    :: Int      -- ^ Creature id
    -> Point2   -- ^ Translation
@@ -280,7 +216,7 @@ reloadWeapon cid w =
                                            $ set ( itRef . wpReloadState) rT w
        _                          -> Nothing

-{- Start reloading if clip is empty. -}
+{- | Start reloading if clip is empty. -}
 crAutoReload :: Creature -> Creature
 crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
    Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT)
@@ -290,7 +226,7 @@ crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
    reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
    maxA    = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo

-{- Teleport a creature to the mouse position -}
+{- | Teleport a creature to the mouse position -}
 blinkAction 
    :: Int      -- ^ Creature id
    -> World 
@@ -334,10 +270,7 @@ turnBy
    -> World 
    -> World
 turnBy a n = over (creatures . ix n . crDir) (+ a)
-
-{- 
-Get your creature to drop the item under the cursor.
-}
+{- | Get your creature to drop the item under the cursor.  -}
 youDropItem :: World -> World
 youDropItem w = case yourItem w of
    NoItem -> w
@@ -345,8 +278,7 @@ youDropItem w = case yourItem w of
        . copyItemToFloor (you w) (_crInvSel $ you w)
        $ soundOnce putDownSound 
        w
-
-{- Copy an inventory item to the floor. -}
+{- | Copy an inventory item to the floor. -}
 copyItemToFloor 
    :: Creature
    -> Int      -- ^ Inventory position
@@ -354,9 +286,7 @@ copyItemToFloor
    -> World
 copyItemToFloor cr i w = case _crInv cr IM.! i of
    NoItem  -> w
-    it      -> over floorItems (IM.insert flid theflit)
-        . updateLocation
-        $ set randGen g w
+    it      -> over floorItems (IM.insert flid theflit) . updateLocation $ set randGen g w
      where 
        (rot, g) = randomR (-pi,pi) $ _randGen w
        offset = (_crRad cr + 2) *.* unitVectorAtAngle rot
@@ -370,16 +300,19 @@ copyItemToFloor cr i w = case _crInv cr IM.! i of
            ,_flItRot = rot
            ,_flItID = flid
            }
-
-{- Pick up a specific item. -}
-pickUpItem :: FloorItem -> World -> World
-pickUpItem flit w = case maybeInvSlot of
+{- | Pick up a specific item. -}
+pickUpItem 
+    :: Int  -- ^ Creature id
+    -> FloorItem 
+    -> World 
+    -> World
+pickUpItem cid flit w = case maybeInvSlot of
    Nothing -> w
    Just i  -> w
        & soundOnce pickUpSound
        & updateItLocation i
        & floorItems                      %~ IM.delete (_flItID flit)
-        & creatures . ix 0 . crInv . ix i %~ addItem it
+        & creatures . ix cid . crInv . ix i %~ addItem it
  where 
    it = _flIt flit
    maybeInvSlot = checkInvSlotsYou it w
@@ -387,12 +320,48 @@ pickUpItem flit w = case maybeInvSlot of
        Nothing -> w'
        Just j  -> w' & itemPositions . ix j .~ InInv 0 invid

-{- | A creature attempts to move under its own steam.
+{- | 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. -}
-creatureMove :: Point2 -> Creature -> Creature
-creatureMove p = crPos %~ (+.+ p)
+crMvBy 
+    :: Point2   -- ^ Movement translation vector
+    -> Creature 
+    -> Creature
+crMvBy p' cr = advanceStepCounter (magV p) $ over crPos (+.+ p) cr
+  where 
+    p =  (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
+    equipFactor = 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 cr = crMvBy (speed,0) cr
+
+
+advanceStepCounter
+    :: Float    -- ^ Speed
+    -> Creature 
+    -> Creature
+advanceStepCounter speed cr = over (crStance . carriage) f cr
+  where 
+    f (w@Walking {}) = w {_stepToAdd = ceiling speed}
+    f s = s

 creatureTurn :: Float -> Creature -> Creature
 creatureTurn a = crDir +~ a

+creatureTurnToward :: Point2 -> Float -> Creature -> Creature
+creatureTurnToward p turnSpeed cr 
+    | vToTarg == (0,0) = cr -- this should deal with the angleVV error
+    | errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
+                                        = cr & crDir .~ dirToTarget
+    | isLeftOfA dirToTarget (_crDir cr) = cr & crDir +~ turnSpeed
+    | otherwise                         = cr & crDir -~ turnSpeed
+  where
+    vToTarg = p -.- _crPos cr
+    dirToTarget = argV vToTarg
@@ -0,0 +1,25 @@
+module Dodge.Creature.ActionRat
+    where
+import Dodge.Data
+import Dodge.Base.Collide
+import Dodge.Creature.ChooseTarget
+import Dodge.Creature.Rationality.Data
+import Geometry
+
+import Data.List
+import Control.Lens
+
+{- | Action update for a simple shooting creature -}
+shootAtTarget
+    :: (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -> World 
+    -> Creature 
+    -> Creature 
+shootAtTarget targFunc w cr = case targFunc cr w of
+    Nothing -> cr
+    Just crTarg -> cr & crRationality . crAction %~ shootAtTarg w cr crTarg
+
+shootAtTarg :: World -> Creature -> Creature -> [Action] -> [Action]
+shootAtTarg w cr tcr as
+    | canSee (_crID cr) (_crID tcr) w = nub (ShootTillEmpty : as)
+    | otherwise     = as
@@ -5,21 +5,55 @@ import Dodge.Creature.ChooseTarget
 import Dodge.Creature.Rationality.Data
 import Geometry

-chaseImpulse'
+import Control.Lens
+
+chaseTarget
    :: (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
-    -> Creature 
    -> World 
-    -> [Impulse]
-chaseImpulse' targFunc cr w = case targFunc cr w of
-    Nothing -> []
-    Just crTarg -> chaseTarg cr crTarg
+    -> Creature 
+    -> Creature 
+chaseTarget targFunc w cr = case targFunc cr w of
+    Nothing -> cr
+    Just crTarg -> cr & crRationality . crImpulse .~ chaseTarg cr crTarg

 chaseTarg :: Creature -> Creature -> [Impulse]
 chaseTarg cr crT
    | dist tpos cpos < combinedRad + 5 
            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+            && _crMeleeCooldown cr == Just 0
        = [Melee (_crID crT)]
-    | otherwise = [MoveForward 3 , TurnToward 0.05 tpos]
+    | dist tpos cpos < combinedRad + 5 
+            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+        = [ TurnToward tpos 0.05 ]
+    | abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+                = [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ]
+    | otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ]
+  where
+    cpos = _crPos cr
+    tpos = _crPos crT
+    combinedRad = _crRad cr + _crRad crT
+
+impulseShootAtTarget
+    :: (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -> World 
+    -> Creature 
+    -> Creature 
+impulseShootAtTarget targFunc w cr = case targFunc cr w of
+    Nothing -> cr
+    Just crTarg -> cr & crRationality . crImpulse .~ impulseShootAtTarg cr crTarg
+
+impulseShootAtTarg :: Creature -> Creature -> [Impulse]
+impulseShootAtTarg cr crT
+    | dist tpos cpos < combinedRad + 5 
+            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+            && _crMeleeCooldown cr == Just 0
+        = [Melee (_crID crT)]
+    | dist tpos cpos < combinedRad + 5 
+            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+        = [ TurnToward tpos 0.05 ]
+    | abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+                = [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ]
+    | otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ]
  where
    cpos = _crPos cr
    tpos = _crPos crT
@@ -22,8 +22,9 @@ basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked
  where 
    cdir = _crDir cr
    naked 
+        | strikeMelee   = color white $ circleSolid $ _crRad cr
        | pdam > 200    = color red $ circleSolid $ _crRad cr
-        | pdam > 100    = color white $ circleSolid $ _crRad cr
+        | pdam > 99     = color white $ circleSolid $ _crRad cr
        | otherwise     = pictures [color col' $ circleSolid $ _crRad cr, circLine $ _crRad cr]
    pastDams = _crPastDamage $ _crState cr
    pdam = sum $ concatMap (map _dmAmount) $ pastDams
@@ -41,6 +42,9 @@ basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked
    piercingMod = case fmap argV piercingDam of
        Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
        _   -> id
+    strikeMelee = case _crMeleeCooldown cr of
+        Nothing -> False
+        Just x  -> x > 5

 drawEquipment 
    :: Creature 
@@ -1,33 +1,105 @@
 module Dodge.Creature.Rationality
    where
 import Dodge.Data
+import Dodge.Base.Collide
 import Dodge.Creature.Rationality.Data
 import Dodge.Creature.Action
 import Dodge.Creature.Action.UseItem
+import Dodge.Creature.State.Data
+import Dodge.SoundLogic
+import Geometry

+import Data.Maybe
+import qualified Data.IntMap.Strict as IM
 import System.Random
 import Control.Lens

 impulsiveAI 
-    :: (Impulse -> World -> Creature -> (World -> World, Creature))
-    -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
-impulsiveAI impulseFunc w (f,g) cr
-    = (\(f''' ,cr) -> ((f''',g),Just cr))
-    $ foldr 
-        (\imp (f' , cr') -> let (f'', cr'') = impulseFunc imp w cr' in (f'' . f', cr''))
-        (id, cr) 
-        (_crImpulse $ _crRationality cr)
+    :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
+    -> World 
+    -> (World -> World,StdGen) 
+    -> Creature 
+    -> ((World -> World,StdGen), Maybe Creature)
+impulsiveAI impF w (f,g) = followImpulses w (f,g) . impF w

-applyBasicImpulse
+followImpulses 
+    :: World 
+    -> (World -> World,StdGen) 
+    -> Creature 
+    -> ((World -> World,StdGen), Maybe Creature)
+followImpulses w (f,g) cr
+    = (\(f''' ,cr) -> ((f''',g'),Just cr))
+    $ foldr 
+        (\imp (f' , cr') -> let (f'', cr'') = followImpulse imp w cr' in (f'' . f', cr''))
+        (f, cr) 
+        (_crImpulse $ _crRationality cr)
+  where
+    g' = snd $ next g
+
+followImpulse
    :: Impulse
    -> World
    -> Creature
    -> (World -> World , Creature)
-applyBasicImpulse imp w cr = case imp of
-    Move p  -> (id, creatureMove p cr)
+followImpulse imp w cr = case imp of
+    Move p  -> (id, crMvBy p cr)
+    MoveForward x  -> (id, crMvForward x cr)
    Turn a  -> (id, creatureTurn a cr)
+    TurnToward p a -> (id, creatureTurnToward p a cr)
    UseItem -> (crUseItem cr, cr)
    SwitchToItem i -> (id, cr & crInvSel .~ i)
-    _ -> (id, cr)
+    Melee crID -> 
+        (hitCr crID
+        , crMvBy (10 *.* normalizeV (posFromID crID -.- cpos)) $ cr & crMeleeCooldown ?~ 20) -- randomise cooldown?
+    RandomTurn a -> (id, creatureTurn (rr a) cr)
+    _ -> (id , cr)
    DropItem -> undefined
+  where
+    cpos = _crPos cr
+    posFromID cid = _crPos $ _creatures w IM.! cid
+    rr a = fst $ randomR (-a,a) $ _randGen w
+    hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
+        . soundOnce (fromIntegral hitSound)
+    addDam i dams = (( Blunt 100 cpos (posFromID i) (posFromID i) ) : dams )
+
+actionUpdateAI
+    :: (World -> Creature -> Creature) -- ^ the function updating the actions
+    -> World
+    -> Creature
+    -> Creature
+actionUpdateAI actF w c = performActions w $ actF w c
+
+performActions :: World -> Creature -> Creature
+performActions w cr = cr
+    & crRationality . crImpulse .~ concat iss
+    & crRationality . crAction .~ catMaybes mayas
+  where
+    (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crRationality . crAction
+
+{- | Performing an action means that a creature has some impulses for a frame, and
+ updates or deletes the action itself. -}
+performAction 
+    :: Creature
+    -> World
+    -> Action
+    -> ( [Impulse] , Maybe Action )
+performAction cr w ac = case ac of
+    ShootTillEmpty -> case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
+        Just x | x > 0  -> ( [UseItem] , Just ShootTillEmpty )
+        _               -> ( []        , Nothing )
+    AimAtCloseSlow tcid p speed slowSpeed a
+        | canSee (_crID cr) tcid w && abs (normalizeAngle $ cdir - argV (tpos -.- cpos)) < a 
+            -> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
+        | canSee (_crID cr) tcid w
+            -> ([TurnToward tpos speed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
+        | abs (normalizeAngle (cdir - (argV (p -.- cpos)))) < a
+            -> ([TurnToward p slowSpeed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
+        | otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
+      where
+        tpos = _crPos (_creatures w IM.! tcid)
+    ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss)
+    ImpulsesList _  -> ([], Nothing)
+  where
+    cpos = _crPos cr 
+    cdir = _crDir cr
    
@@ -12,18 +12,19 @@ data Rationality
        {_crImpulse :: [Impulse] }
    | ActionRat
        {_crImpulse :: [Impulse]
-        ,_crAction  :: Action
+        ,_crAction  :: [Action]
        }
    | StrategyRat
        {_crImpulse     :: [Impulse]
-        ,_crAction      :: Action
+        ,_crAction      :: [Action]
        ,_crStrategy    :: Strategy
        }
 data Impulse
    = Move Point2
    | MoveForward Float
    | Turn Float
-    | TurnToward Float Point2
+    | RandomTurn Float
+    | TurnToward Point2 Float
    | UseItem
    | SwitchToItem Int
    | DropItem
@@ -33,9 +34,18 @@ data Impulse
    | UseIntrinsicAbility
    | Melee Int
    | ChangePosture Posture
+  deriving (Eq,Ord,Show)

 data Action
    = Attack Int
+    | AimAtCloseSlow 
+        {_targetID :: Int 
+        ,_targetSeenAt :: Point2 
+        ,_aimSpeed :: Float 
+        ,_slowAimSpeed :: Float
+        ,_slowAimAngle :: Float
+        }
+    | MeleeAttack Point2 Int
    | PathTo Point2
    | FleeFrom Int
    | HealSelf
@@ -44,6 +54,9 @@ data Action
    | SearchFor Int
    | Search
    | PickupItem Int
+    | ShootTillEmpty
+    | ImpulsesList [[Impulse]]
+  deriving (Eq,Ord,Show)

 data Strategy
    = Flank Int
@@ -18,7 +18,7 @@ data Carriage
    | Boosting Point2
  deriving (Eq,Show)
 data Posture = Aiming | AtEase
-  deriving (Eq,Show)
+  deriving (Eq,Ord,Show)

 makeLenses ''Stance
 makeLenses ''Carriage
@@ -36,6 +36,9 @@ import Control.Concurrent
  
 type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)

+meleeCooldown :: CRUpdate -> CRUpdate
+meleeCooldown u w (f,g) cr = u w (f,g) $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
+
 -- | The movement is updated before the ai in order to correctly set the oldpos.
 -- the whole of this update cycle could do with a rethink, it is becoming
 -- convoluted
@@ -20,62 +20,32 @@ import System.Random

 yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
 yourControl w (f,g) cr = ( (updateUsingInput . f, g)
-                         , Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr
+                         , Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
                         )
  where 
-    strafeSpeed = _varMovementSpeedModifier w * equipFactor * fromMaybe 1 (yourItem w ^? itAimingSpeed)
    speed = _varMovementSpeedModifier w * equipFactor
    equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0

 {-
 Turns key presses into creature movement.
 -}
-wasdWithAiming :: World -> Float -> Float -> Int -> Creature -> Creature
-wasdWithAiming w speed aimSpeed i cr
-    | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming
-            && diffAngles mouseDir (argV mov) < pi/2
-        -- = over crPos (+.+ (speed *.* mov)) 
-        = over crPos (+.+ (speed *.* unitVectorAtAngle mouseDir)) 
-          . set crDir mouseDir 
-          $ set (crStance . carriage) (Boosting mov)
-          cr
-    | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving && isAiming
-        = set crDir mouseDir 
-          $ set (crStance . carriage) Floating
-          cr
-    | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving
-        = over crPos (+.+ (speed *.* mov)) 
-          . over crDir (flip fromMaybe dir) 
-          $ set (crStance . carriage) (Boosting mov)
-          cr
-    | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isAiming
-        = set (crStance . carriage) Floating
-          $ set crDir mouseDir 
-          cr
-    |  any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
-        = set (crStance . carriage) Floating
-          cr
+wasdWithAiming :: World -> Float -> Int -> Creature -> Creature
+wasdWithAiming w speed i cr
    | isAiming
-        = stepForward aimSpeed
-          $ over crPos (+.+ (aimSpeed *.* mov)) 
-          $ set crDir mouseDir 
-          $ set (crStance . carriage) (Walking 0 0)
+        = set crDir mouseDir 
+        $ crMvBy (speed *.* mov)
          cr
    | isMoving
-        = stepForward speed
-          $ over crPos (+.+ (speed *.* mov)) 
-          $ over crDir (`fromMaybe` dir) 
-          $ set (crStance . carriage) (Walking 0 0)
+        = crMvForward speed -- controls the base speed
+        $ over crDir (`fromMaybe` dir) 
          cr
-    | otherwise
-        = over crDir (`fromMaybe` dir) 
-          $ set (crStance . carriage) Standing
-                        cr
+    | otherwise = cr
  where 
    (mov',dir') = wasdComp (view keys w) w
-    (mov,dir)   = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir')
-    isMoving    = mov' /= (0,0)
+    dir = fmap (_cameraRot w +) dir'
+    mov = rotateV (negate $ _crDir cr) mov'
    isAiming    = _posture (_crStance cr) == Aiming
+    isMoving    = mov' /= (0,0)
    mouseDir = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
                              . itAttachment of
        Just (Just ItScope{_scopePos = p}) -> normalizeAngle $ argV
@@ -97,12 +67,12 @@ wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks
    where f (0,0) = ((0,0), Nothing)
          f p     = (errorNormalizeV 46 p, Just $ argV p)

+{- | Set posture according to mouse presses. -}
 mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
-mouseActionsCr keys cr 
-    | rbPressed 
-        = set ( crStance . posture) Aiming cr
-    | otherwise
-        = set ( crStance . posture) AtEase cr
-    where lbPressed = SDL.ButtonLeft `S.member` keys
-          rbPressed = SDL.ButtonRight `S.member` keys
+mouseActionsCr keys 
+    | rbPressed = crStance . posture .~ Aiming
+    | otherwise = crStance . posture .~ AtEase
+  where 
+    lbPressed = SDL.ButtonLeft  `S.member` keys
+    rbPressed = SDL.ButtonRight `S.member` keys