Allow for different item drops on creature death

2021-04-25 02:16:31 +02:00
parent 94ff3d6593
commit 30736997c3
19 changed files with 336 additions and 229 deletions
@@ -0,0 +1,310 @@
+{- Actions performed by creatures within the world
+ -}
+{-# LANGUAGE BangPatterns #-}
+module Dodge.Creature.Action 
+    ( module Dodge.Creature.Action
+    , useItem
+    , tryUseItem
+    )
+    where
+import Dodge.Creature.Action.UseItem
+import Dodge.WorldEvent.Shockwave
+import Dodge.Data
+import Dodge.Base
+import Dodge.SoundLogic
+import Dodge.WorldEvent
+import Dodge.Inventory
+import Dodge.LightSources
+import Geometry
+import Picture
+
+import Control.Lens
+import Control.Monad
+import Control.Applicative
+import Data.Maybe
+import Data.List
+import System.Random
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Map as M
+
+moveForwardSpeed :: Float -> Int -> World -> World
+moveForwardSpeed x n w = over (creatures . ix n . crPos) (+.+ p) w
+    where p = (*.*) x $ unitVectorAtAngle $ _crDir $ _creatures w IM.! n
+
+mvForward :: Float -> Int -> World -> World
+mvForward speed cid w = stepForward cid speed $ over (creatures . ix cid . crPos) (+.+ p) w
+    where p =  (*.*) (speed * equipFactor) $ unitVectorAtAngle $ _crDir $ _creatures w IM.! cid
+          equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! cid
+
+crStrafeLeft :: Float -> Creature -> Creature
+crStrafeLeft speed cr = stepForward' s2 $ over crPos (+.+ p) cr
+    where p =  (*.*) s2 $ unitVectorAtAngle $ (_crDir cr + pi/2)
+          equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
+          s2 = (speed * equipFactor)
+crStrafeRight :: Float -> Creature -> Creature
+crStrafeRight speed cr = stepForward' 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 -> 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 -> 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 $ _stance $ _crState cr) == Aiming
+                            = fromMaybe 1 $ it ^? itAimingSpeed
+                       | otherwise = 1
+          it = _crInv cr IM.! _crInvSel cr
+
+stepForward :: Int -> Float -> World -> World
+stepForward cid speed = over (creatures . ix cid . crState . stance . carriage) f
+    where f (w@Walking {}) = w {_stepToAdd = ceiling speed}
+          f s = s
+
+stepForward' :: Float -> Creature -> Creature
+stepForward' speed cr = over (crState . stance . carriage) f cr
+    where f (w@Walking {}) = w {_stepToAdd = ceiling speed}
+          f s = s
+
+equipSpeed NoItem = 1
+equipSpeed it | _itIdentity it == FrontArmour = 0.75
+              | _itIdentity it == FlameShield = 0.75
+              | otherwise                     = 1
+
+turnTo :: Point2 -> Int -> World -> World
+turnTo p n w = set (creatures . ix n . crDir) dirToTarget w
+    where cr = _creatures w IM.! n
+          dirToTarget = argV (p -.- _crPos cr)
+
+turnToward :: Point2 -> Int -> World -> World
+turnToward p n w | isLeftOfA dirToTarget (_crDir cr)
+                             = f $ over (creatures . ix n . crDir) 
+                                        (normalizeAngle . (+ (0.03 + r*m))) w
+                 | otherwise = f $ over (creatures . ix n . crDir) 
+                                        (\x->normalizeAngle (x - (0.03 + r*m))) w
+                    where cr          = _creatures w IM.! n
+                          dirToTarget = argV (p -.- _crPos cr)
+                          (r,g)       = randomR (-0.1,0.1) (_randGen w)
+                          m           = diffAngles dirToTarget (_crDir cr)
+                          f           = set randGen g
+
+turnTowardAngle :: Float -> Int -> World -> World
+turnTowardAngle a n w 
+    | isLeftOfA a (_crDir cr) = f $ over (creatures . ix n . crDir) 
+                                        (normalizeAngle . (+ (0.03 + r*m))) w
+    | otherwise = f $ over (creatures . ix n . crDir) 
+                                        (\x->normalizeAngle (x - (0.03 + r*m))) w
+                    where cr          = _creatures w IM.! n
+                          (r,g)       = randomR (-0.1,0.1) (_randGen w)
+                          m           = diffAngles a (_crDir cr)
+                          f           = set randGen g
+
+turnToward'' :: Float -> Point2 -> Int -> World -> World
+turnToward'' turnSpeed p n w 
+    | isLeftOfA dirToTarget (_crDir cr)
+                = f $ over (creatures . ix n . crDir) (normalizeAngle. (+ (turnSpeed + r))) w
+    | otherwise = f $ over (creatures . ix n . crDir) (\x->normalizeAngle (x - (turnSpeed + r))) w
+                    where cr          = _creatures w IM.! n
+                          dirToTarget = argV (p -.- _crPos cr)
+                          (r,g)       = randomR (-0.1,0.1) (_randGen w)
+                          f           = set randGen g
+
+crTurnAndStrafeIn :: Float -> Float -> Point2 -> Creature -> Creature
+crTurnAndStrafeIn strafeSpeed turnSpeed p cr
+    | vToTarg == (0,0) = cr -- this should deal with the angleVV error
+    | errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
+                = set crDir dirToTarget cr
+    | isLeftOfA dirToTarget (_crDir cr)
+                = over crDir (normalizeAngle . (+ turnAmount ))
+                      $ crStrafeLeft strafeSpeed cr
+    | otherwise = over crDir (\x->normalizeAngle (x - turnAmount))
+                      $ crStrafeRight strafeSpeed cr
+                    where vToTarg = p -.- _crPos cr
+                          dirToTarget = argV vToTarg
+                          turnAmount  = turnSpeed
+
+crTurnTo :: Point2 -> Creature -> Creature
+crTurnTo p cr = set crDir dirToTarget cr
+    where dirToTarget = argV (p -.- _crPos cr)
+
+crTurnTowardSpeed :: Float -> Point2 -> Creature -> Creature
+crTurnTowardSpeed turnSpeed p cr
+    | vToTarg == (0,0) = cr -- this should deal with the angleVV error
+    | errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
+                = set crDir dirToTarget cr
+    | isLeftOfA dirToTarget (_crDir cr)
+                = over crDir (normalizeAngle . (+ turnAmount )) cr
+    | otherwise = over crDir (\x->normalizeAngle (x - turnAmount)) cr
+                    where vToTarg = p -.- _crPos cr
+                          dirToTarget = argV vToTarg
+                          turnAmount  = turnSpeed
+
+turnTowardSpeed :: Float -> Point2 -> Int -> World -> World
+turnTowardSpeed turnSpeed p n w 
+    | vToTarg == (0,0) = w -- this should deal with the angleVV error
+    | errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
+                = set (creatures . ix n . crDir) dirToTarget w
+    | isLeftOfA dirToTarget (_crDir cr)
+                = over (creatures . ix n . crDir) (normalizeAngle . (+ turnAmount )) w
+    | otherwise = over (creatures . ix n . crDir) (\x->normalizeAngle (x - turnAmount)) w
+                    where cr          = _creatures w IM.! n
+                          vToTarg = p -.- _crPos cr
+                          dirToTarget = argV vToTarg
+                          turnAmount  = turnSpeed
+
+turnLRS :: Int -> World -> World
+turnLRS n w = f $ over (creatures . ix n . crDir) (+ (fromIntegral r * pi / 2)) w
+    where (r,g) = randomR (negate 1::Int,1) (_randGen w)
+          f     = set randGen g
+
+turnToward' :: Point2 -> Int -> World -> World
+turnToward' p n w | isLeftOfA dirToTarget (_crDir cr)
+                              = over (creatures . ix n . crDir) (+ 0.03) w
+                  | otherwise = over (creatures . ix n . crDir) (\x-> x - 0.03) w
+                    where cr          = _creatures w IM.! n
+                          dirToTarget = argV (p -.- _crPos cr)
+
+overturnToward :: Point2 -> Int -> World -> World
+overturnToward  p n w 
+                | isLeftOfA dirToTarget (_crDir cr)
+                            = over (creatures . ix n . crDir) (normalizeAngle. (+ 0.03 )) w
+                | otherwise = over (creatures . ix n . crDir) (\x->normalizeAngle (x - 0.03 )) w
+                    where cr          = _creatures w IM.! n
+                          dirToTarget = argV (p -.- _crPos cr)
+
+moveForward :: Int -> World -> World
+moveForward n w = over (creatures . ix n . crPos) (+.+ p) w
+    where p = unitVectorAtAngle $ _crDir $ _creatures w IM.! n
+
+moveToward :: Point2 -> Int -> 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)
+
+moveBy :: Int -> Point2 -> World -> World
+moveBy n v = over (creatures . ix n . crPos) (+.+ v)
+
+reloadWeapon :: Int -> World -> Maybe World
+reloadWeapon cid w = 
+    let cr = _creatures w IM.! cid
+        it = _crInv cr IM.! _crInvSel cr
+        itRef = creatures . ix cid . crInv . ix (_crInvSel cr)
+    in case it of 
+        Weapon {_wpMaxAmmo=maxA,_wpLoadedAmmo=lA,_wpReloadState=rS,_wpReloadTime=rT} 
+            | lA < maxA && rS == 0 -> Just $ set ( itRef . wpLoadedAmmo) maxA
+                                            $ set ( itRef . wpReloadState) rT w
+        _                          -> Nothing
+
+crAutoReload :: Creature -> Creature
+crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
+        Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT)
+                     & crInv . ix (_crInvSel cr) . wpLoadedAmmo  %~ (`fromMaybe` maxA)
+        _      -> cr
+    where reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
+          maxA    = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo
+
+blinkAction :: Int -> World -> World
+blinkAction n w = soundOnce teleSound $ set (creatures . ix n . crPos) p3
+                    $ blinkShockwave n p3
+                    $ inverseShockwaveAt cp 40 2 2 2 
+                        w
+    where   p1 = _cameraCenter w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
+            cp = _crPos $ _creatures w IM.! n
+            p2 = collidePointWalls cp p1 $ wallsAlongLine cp p1 w
+            r  = 1.5 * _crRad (_creatures w IM.! n)
+            p3 = fromMaybe p1 (fmap ((\p -> moveAmountToward p r cp) . fst) p2)
+
+blinkShockwave 
+    :: Int      -- ^ Blinking creature ID.
+    -> Point2 
+    -> World 
+    -> World
+blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan 
+
+moveAmountToward :: Point2 -> Float -> Point2 -> Point2
+moveAmountToward p1 am p2
+    = p1 +.+ am *.* errorNormalizeV 44 (p2 -.- p1)
+
+facePointAI :: Point2 -> Int -> World -> World
+facePointAI p n w = set (creatures . ix n . crDir) 
+                        (argV (p -.- _crPos (_creatures w IM.! n)) )
+                        w
+
+reverseDir :: Int -> World -> World
+reverseDir n = over (creatures . ix n . crDir) (+ pi)
+
+turnBy :: Float -> Int -> World -> World
+turnBy a n = over (creatures . ix n . crDir) (+ a)
+
+{- 
+Get your creature to drop the item under the cursor.
+-}
+youDropItem :: World -> World
+youDropItem w = case yourItem w of
+    NoItem -> w
+    it -> rmSelectedInvItem (_yourID w) $ over floorItems (IM.insert flid theflit)
+                            $ updateLocation
+                            $ soundOnce putDownSound 
+                            $ set randGen g w
+      where (rot, g) = randomR (-pi,pi) $ _randGen w
+            offset = _crRad (you w) *.* unitVectorAtAngle rot
+            updateLocation w = case it ^? itID of
+                                  Just (Just i)  -> w & itemPositions . ix i .~ OnFloor flid
+                                  _ -> w
+            flid = newKey $ _floorItems w
+            theflit = FlIt {_flIt = set itAmount 1 it
+                            ,_flItPos = offset +.+ _crPos (you w)
+                            ,_flItRot = rot
+                            ,_flItID = flid}
+
+{- Drop an item silently. -}
+dropItem 
+    :: Int      -- ^ Creature id
+    -> Int      -- ^ Inventory position
+    -> World 
+    -> World
+dropItem cid i w = case _crInv cr IM.! i of
+    NoItem -> w
+    it -> rmInvItem cid i 
+        . over floorItems (IM.insert flid theflit)
+        . updateLocation
+        $ set randGen g w
+      where 
+        (rot, g) = randomR (-pi,pi) $ _randGen w
+        offset = _crRad cr *.* unitVectorAtAngle rot
+        updateLocation w = case it ^? itID of
+            Just (Just i)  -> w & itemPositions . ix i .~ OnFloor flid
+            _ -> w
+        flid = newKey $ _floorItems w
+        theflit = FlIt 
+            {_flIt = set itAmount 1 it
+            ,_flItPos = offset +.+ _crPos cr
+            ,_flItRot = rot
+            ,_flItID = flid
+            }
+  where 
+    cr = _creatures w IM.! cid
+
+pickUpItem' :: FloorItem -> World -> World
+pickUpItem' flit w = case maybeInvSlot of
+    Nothing -> w
+    Just i  -> soundOnce pickUpSound
+               $ updateItLocation i
+               $ w & floorItems %~ IM.delete (_flItID flit)
+                   & creatures . ix 0 . crInv . ix i %~ addItem it
+    where 
+        it = _flIt flit
+        maybeInvSlot = checkInvSlotsYou it w
+        updateItLocation invid w' 
+            = case _itID it of Nothing -> w'
+                               Just j  -> w' & itemPositions . ix j .~ InInv 0 invid
+
@@ -0,0 +1,35 @@
+module Dodge.Creature.Action.UseItem
+    where
+import Dodge.Data
+
+import Dodge.Inventory
+
+import qualified Data.IntMap as IM
+
+import Control.Lens
+import Data.Maybe (fromMaybe)
+
+useItem :: Int -> World -> World
+useItem n w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
+                            Just HammerUp -> equippedItemEffect n $ setHammerDown w
+                            Just NoHammer -> equippedItemEffect n w
+                            _             -> setHammerDown w
+    where 
+        cr = _creatures w IM.! n
+        setHammerDown = creatures . ix n . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
+
+tryUseItem :: Int -> World -> World
+tryUseItem cid w = case w ^? creatures . ix cid of
+    Just cr -> itemEffect cid (_crInv cr IM.! _crInvSel cr) w
+    Nothing -> w
+
+equippedItemEffect :: Int -> World -> World
+equippedItemEffect n w = itemEffect n it w
+    where c = (_creatures w IM.! n)
+          it = _crInv c IM.! _crInvSel c
+
+itemEffect :: Int -> Item -> World -> World
+itemEffect n (Consumable {_cnEffect=eff }) w = fromMaybe w $ fmap (rmSelectedInvItem n) $ eff n w
+itemEffect n (Weapon {_wpFire=eff}) w = eff n w
+itemEffect n (Throwable {_twFire = eff}) w = eff n w
+itemEffect _ _ w = w
@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Creature.Data
+  where
+import Control.Lens
@@ -5,7 +5,7 @@ import Dodge.SoundLogic
 import Dodge.RandomHelp
 import Dodge.WorldEvent
 import Dodge.WallCreatureCollisions
-import Dodge.CreatureAction
+import Dodge.Creature.Action
 import Geometry
 import Picture

@@ -13,7 +13,7 @@ import Data.List
 import Data.Char
 import Data.Maybe
 import Data.Function
-import Data.Graph.Inductive.Graph
+--import Data.Graph.Inductive.Graph
 import Data.Graph.Inductive.PatriciaTree
 import Data.Graph.Inductive.Query.SP
 import Codec.BMP
@@ -37,32 +37,73 @@ type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World
 -- the whole of this update cycle could do with a rethink, it is becoming
 -- convoluted
 stateUpdate :: CRUpdate -> CRUpdate
-stateUpdate u w (f,g) cr = let (cr', g'') = updateMovement g cr 
-                           in case u w (f,g'') cr' of
-        ((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . dropifdead . f'
+stateUpdate u w (f,g) cr = 
+    let (cr', g'') = updateMovement g cr 
+    in case u w (f,g'') cr' of
+        ((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . deathEff . f'
                                 , g')
                               , fmap (updateReloadCounter . reducePastDamage . doDamage) 
                                      $ crOrCorpse =<< maybeCr
                               )
-    where   
-        crOrCorpse cr | cr ^. crHP > 0 = Just cr
-                      | otherwise      = Nothing
-        dropifdead | cr ^.crHP > 0 = id
-                   | otherwise = stopSoundFrom (CrWeaponSound (_crID cr)) 
-                                    . over decorations addCorpse 
-                                    . insertIt
-        crBeforeDeath = colCrWall w $ cr
-        addCorpse = insertNewKey $ uncurry translate (_crOldPos cr) 
-                                 $ rotate (_crDir cr)
-                                 (_crCorpse cr)
-        maybeIt = evalState (maybeTakeOne $ IM.elems (_crInv cr)) (_randGen w)
-        insertIt = case maybeIt of 
--                      Just it -> createItemAt (offset +.+ _crPos crBeforeDeath) 
-                      Just it -> createItemAt (offset +.+ _crOldPos cr) 
-                                              (FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0})
-                      Nothing -> id
+  where   
+    crOrCorpse cr | cr ^. crHP > 0 = Just cr
+                  | otherwise      = Nothing
+    deathEff | cr ^.crHP > 0 = id
+             | otherwise = stopSoundFrom (CrWeaponSound (_crID cr)) 
+                                . over decorations addCorpse 
+                                . dropByState cr
+    crBeforeDeath = colCrWall w $ cr
+    addCorpse = insertNewKey $ uncurry translate (_crOldPos cr) 
+                             $ rotate (_crDir cr)
+                             (_crCorpse cr)
+--    maybeIt = evalState (maybeTakeOne $ IM.elems (_crInv cr)) (_randGen w)
+--    insertIt = case maybeIt of 
+--                  Just it -> createItemAt (offset +.+ _crOldPos cr) 
+--                                          (FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0})
+--                  Nothing -> id
+--    offset = _crRad cr *.* unitVectorAtAngle rot
+--    (rot,_) = randomR (-pi,pi) g
+
+-- | Drop items accoring to the creature state.
+dropByState :: Creature -> World -> World
+dropByState cr w = foldr (copyItemToFloor cr) w is
+  where
+    is :: [Int]
+    is = case cr ^. crState . crDropsOnDeath of
+        DropAll -> IM.keys $ _crInv cr
+        DropSpecific xs -> xs
+        DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
+
+{- Copy an inventory item to the floor. -}
+copyItemToFloor 
+    :: Creature
+    -> Int      -- ^ Inventory position
+    -> World 
+    -> 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
+      where 
+        (rot, g) = randomR (-pi,pi) $ _randGen w
        offset = _crRad cr *.* unitVectorAtAngle rot
-        (rot,_) = randomR (-pi,pi) g
+        updateLocation w = case it ^? itID of
+            Just (Just i)  -> w & itemPositions . ix i .~ OnFloor flid
+            _ -> w
+        flid = newKey $ _floorItems w
+        theflit = FlIt 
+            {_flIt = set itAmount 1 it
+            ,_flItPos = offset +.+ _crPos cr
+            ,_flItRot = rot
+            ,_flItID = flid
+            }
+
+createItemAt :: Point2 -> FloorItem -> World -> World
+createItemAt p it w = over floorItems (IM.insert i (set flItPos p 
+                                                    $ set flItID i it)) w
+    where i = newKey (_floorItems w)
+

 setOldPos :: Creature -> Creature
 setOldPos cr = set crOldPos (_crPos cr) cr
@@ -183,11 +224,6 @@ decreaseToZero :: Int -> Int
 decreaseToZero x | x > 0     = x - 1
                 | otherwise = 0

-
--comb :: (StdGen -> Creature -> World -> World) -> (StdGen -> Creature -> Maybe Creature)
--            -> CRUpdate
--comb 
-
 onDeath :: (Creature -> World -> World) -> CRUpdate -> CRUpdate
 onDeath h u w (f,g) cr 
    | _crHP cr > 0 = u w (f,g) cr
@@ -0,0 +1,95 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Creature.State.Data
+  where
+import Geometry
+
+import Control.Lens
+
+data ItemDropType
+    = DropAll
+    | DropAmount Int
+    | DropSpecific [Int]
+
+data CrSpState 
+    = Barrel { _piercedPoints :: [Point2]}
+    | GenCr
+  deriving (Eq,Show,Ord)
+data Goal 
+    = MoveTo Point2
+    | MoveToFor Point2 Int
+    | MoveFire Point2 Point2
+    | PathTo Point2
+    | PathAlong [Point2]
+    | SubPathTo Point2 Int Point2
+    | Wait
+    | WaitFor Int
+    | WaitForID Int Int
+    | FireAt Point2
+    | FireAtID Int Point2
+    | Fire
+    | Reload
+    | IncreaseAlert Int
+    | Guard Point2 Point2
+    | Search Int
+    | SearchNear Point2
+    | AimAt Point2 Int
+    | InitGuard
+    | Init
+    | MeleeAttack Int
+    | InitTrackYou
+    | TrackYou
+    | Track Int
+    | TrackFor Int Int
+    | TurnByFor Float Int
+    | TurnTo Point2
+    | TurnToward Point2
+    | TurnTowardAngle Float
+    | StrafeLeftAround Int Point2
+    | StrafeRightAround Int Point2
+    | StrafeLeftFor Int
+    | StrafeRightFor Int
+    | StrafeLeftForSpeed Int Float
+    | StrafeRightForSpeed Int Float
+    | StrafeLeftFire
+    | StrafeRightFire
+    | MoveForwardFor Int
+    | MoveForwardFire
+    | MoveBackwardFor Int
+    | MoveByFor Point2 Int
+    | MoveBackwardFire
+    | GoalID Int Goal
+    | AtRange Float
+    | AtRanges Float Float
+    | RepeatAction Int Goal
+    | MakeJudgement
+    | SetPosture Posture
+  deriving (Eq,Show)
+data Stance = Stance 
+    {_carriage :: Carriage
+    ,_posture  :: Posture
+    }
+  deriving (Eq,Show)
+data Carriage 
+    = Walking { _stepCycle :: Int, _stepToAdd :: Int }
+    | Standing
+    | Floating
+    | Boosting Point2
+  deriving (Eq,Show)
+data Posture = Aiming | AtEase
+  deriving (Eq,Show)
+data Mind = ZombieMind | HumanMind
+    deriving (Eq,Show)
+data Faction 
+    = GenericFaction Int
+    | ZombieFaction
+    | EncircleFlock
+    | ChaseCritters
+    | SpawnedBy Int
+    | NoFaction
+  deriving (Eq,Show)
+
+makeLenses ''CrSpState
+makeLenses ''Goal
+makeLenses ''Carriage
+makeLenses ''Posture
@@ -3,7 +3,7 @@ module Dodge.Creature.YourControl

 import Dodge.Data
 import Dodge.Base
-import Dodge.CreatureAction
+import Dodge.Creature.Action
 import Dodge.Creature.State
 import Dodge.Update.UsingInput
 import Dodge.Config.KeyConfig