Delete cruft, add Reader monad to some internal ai

src/Dodge/Creature/AI.hs

@@ -1,11 +0,0 @@
-module Dodge.Creature.AI
-    where
-import Dodge.Data
-
-import Control.Lens
-import System.Random
-
-insectAI 
-    :: ( World -> StdGen -> Creature -> (World -> World, StdGen, Creature) )
-    -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
-insectAI = undefined

src/Dodge/Creature/AI/Data.hs

@@ -1,12 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Creature.AI.Data
-    where
-import Dodge.Creature.State.Data
-import Dodge.Creature.Impulse.Data
-
-import Control.Lens
-data Intelligence
-    = Zombie { _crImpulse :: Impulse }
-    | Inanimate
-

src/Dodge/Creature/Action.hs

@@ -1,6 +1,5 @@
 {- | Actions performed by creatures within the world
  -}
-{-# LANGUAGE BangPatterns #-}
 module Dodge.Creature.Action 
     ( module Dodge.Creature.Action
     , module Dodge.Creature.Action.UseItem
@@ -36,9 +35,9 @@ crStrafeLeft
     -> Creature
 crStrafeLeft speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
   where 
-    p =  (*.*) s2 $ unitVectorAtAngle $ (_crDir cr + pi/2)
+    p = s2 *.* unitVectorAtAngle (_crDir cr + pi/2)
     equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
-    s2 = (speed * equipFactor)
+    s2 = speed * equipFactor
 
 crStrafeRight 
     :: Float    -- ^ Speed
@@ -46,9 +45,9 @@ crStrafeRight
     -> Creature
 crStrafeRight speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
   where 
-    p =  (*.*) s2 $ unitVectorAtAngle $ (_crDir cr - pi/2)
+    p =  s2 *.* unitVectorAtAngle (_crDir cr - pi/2)
     equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
-    s2 = (speed * equipFactor)
+    s2 = speed * equipFactor
 
 turnTo 
     :: Point2   -- ^ Target point
@@ -239,7 +238,7 @@ blinkAction n w
     cp = _crPos $ _creatures w IM.! n
     p2 = reflectPointWalls 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)
+    p3 = maybe p1 ((\p -> moveAmountToward p r cp) . fst) p2
 
 blinkShockwave 
     :: Int      -- ^ Blinking creature ID.
@@ -317,7 +316,6 @@ pickUpItem cid flit w = case maybeInvSlot of
     updateItLocation invid w' = case _itID it of 
         Nothing -> w'
         Just j  -> w' & itemPositions . ix j .~ InInv 0 invid
-
 {- | 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. -}
@@ -329,25 +327,24 @@ 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
+    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
-
+crMvForward speed = crMvBy (speed,0)
 
 advanceStepCounter
     :: Float    -- ^ Speed
     -> Creature 
     -> Creature
-advanceStepCounter speed cr = over (crStance . carriage) f cr
+advanceStepCounter speed = crStance . carriage %~ f
   where 
-    f (w@Walking {}) = w {_stepToAdd = ceiling speed}
+    f w@Walking{} = w{_stepToAdd = ceiling speed}
     f s = s
 
 creatureTurn :: Float -> Creature -> Creature

src/Dodge/Creature/Action/Movement.hs

@@ -9,7 +9,7 @@ import Control.Lens
 strafeTo :: Float -> Point2 -> Int -> World -> World
 strafeTo speed targPos cid w = over (creatures . ix cid . crPos) (+.+ q) w
     where q =  (*.*) (speed * equipFactor * wpFactor) 
-                      $ safeNormalizeV $ (targPos -.- _crPos cr)
+                      $ safeNormalizeV $ targPos -.- _crPos cr
           equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! cid
           cr = _creatures w IM.! cid
           wpFactor = _itAimingSpeed (_crInv cr IM.! _crInvSel cr)

src/Dodge/Creature/Action/UseItem.hs

@@ -7,10 +7,13 @@ import Dodge.Inventory
 import qualified Data.IntMap as IM
 
 import Control.Lens
-import Data.Maybe (fromMaybe)
+import Data.Maybe (maybe)
 
 useItem :: Int -> World -> World
-useItem n w = equippedItemEffect n w
+useItem n w = itemEffect n it w
+  where 
+    c = _creatures w IM.! n
+    it = _crInv c IM.! _crInvSel c
 
 crUseItem :: Creature -> World -> World
 --crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr)
@@ -24,18 +27,12 @@ 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      -- ^ Creature id (I am almost certain)
     -> Item 
     -> World 
     -> World
-itemEffect n (Consumable {_cnEffect=eff }) w = fromMaybe w $ rmSelectedInvItem n <$> eff n w
-itemEffect n (Weapon {_wpFire=eff}) w = eff n w
-itemEffect n (Throwable {_twFire = eff}) w = eff n w
+itemEffect n Consumable{_cnEffect=eff } w = maybe w (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

src/Dodge/Creature/ActionRat.hs

@@ -20,7 +20,6 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.Base.Collide
 import Dodge.Creature.ChooseTarget
-import Dodge.Creature.Rationality.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.Test
 import Geometry
@@ -216,7 +215,7 @@ applyNewStrategies
 applyNewStrategies w cr = case cr ^? crActionPlan . crStrategy of
     Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs
         & crActionPlan . crStrategy .~ strat
-    otherwise -> cr
+    _ -> cr
 
 doStrategyActions
     :: World
@@ -225,7 +224,7 @@ doStrategyActions
 doStrategyActions w cr = case cr ^? crActionPlan . crStrategy of
     Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs
         & crActionPlan . crStrategy .~ strat
-    otherwise -> cr
+    _ -> cr
 
 updateShoot
     :: World
@@ -270,7 +269,7 @@ watchUpdateStrat
     -> Creature
 watchUpdateStrat fs w cr = case cr ^? crActionPlan . crStrategy of
     Just WatchAndWait -> cr 
-        & crActionPlan . crStrategy .~ listGuard (fs, (\_ _ -> WatchAndWait)) (w, cr) w cr
+        & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr
     _ -> cr
 
 listGuard :: ([(a -> Bool, b)] , b) -> a -> b

src/Dodge/Creature/AlertLevel.hs

@@ -3,11 +3,12 @@ module Dodge.Creature.AlertLevel
     where
 import Dodge.Data
 import Dodge.Creature.AlertLevel.Data
-import Dodge.Base.Collide
+import Dodge.Base
+--import Dodge.Base.Collide
 
 import Control.Lens
+import Control.Monad.Reader
 import qualified Data.IntMap.Strict as IM
-
 {- | Ties together (currently) an awareness and attention update -}
 basicPerceptionUpdate
     :: [Int]    -- ^ List of creature ids that may direct attention and awareness
@@ -15,13 +16,20 @@ basicPerceptionUpdate
     -> Creature
     -> Creature
 basicPerceptionUpdate is w cr 
-    = basicAwarenessUpdate w $ 
-        basicAttentionUpdate is w cr
+    = basicAwarenessUpdate w $ basicAttentionUpdate is w cr
+
+basicPerceptionUpdateR
+    :: [Int]    -- ^ List of creature ids that may direct attention and awareness
+    -> Creature
+    -> Reader World Creature
+basicPerceptionUpdateR is cr = reader $ \w ->
+    basicAwarenessUpdate w $ basicAttentionUpdate is w cr
+
 {- | Update a creatures awareness based upon the creatures current direction
  of attention -}
 basicAwarenessUpdate 
     :: World -> Creature -> Creature
-basicAwarenessUpdate w cr = case _crAttentionDir cr of
+basicAwarenessUpdate _ cr = case _crAttentionDir cr of
     AttentiveTo is -> cr & crAwarenessLevel %~ updateAwareness is
     Fixated i -> cr & crAwarenessLevel 
         %~ ( IM.insert i (Cognizant 100) . IM.mapMaybe decreaseAwareness)
@@ -54,4 +62,4 @@ basicAttentionUpdate
     -> Creature
     -> Creature
 basicAttentionUpdate cids w cr = cr & crAttentionDir .~
-    AttentiveTo (filter (\cid -> canSee (_crID cr) cid w) cids)
+    AttentiveTo (forceList $ filter (\cid -> canSee (_crID cr) cid w) cids)

src/Dodge/Creature/AlertLevel/Data.hs

@@ -1,5 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
 module Dodge.Creature.AlertLevel.Data
     where
+import Control.Lens
 
 data AwakeLevel
     = Comatose
@@ -9,9 +12,11 @@ data AwakeLevel
     | Overstrung
 
 data AttentionDir
-    = AttentiveTo [Int]
-    | Fixated  Int
+    = AttentiveTo {_unAttentiveTo :: [Int]}
+    | Fixated {_unFixated :: Int }
 
 data AwarenessLevel
     = AwarenessInt Int
     | Cognizant Int
+
+makeLenses ''AttentionDir

src/Dodge/Creature/Data.hs

@@ -1,5 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Creature.Data
-  where
-import Control.Lens

src/Dodge/Creature/Impulse/Data.hs

@@ -1,58 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Creature.Impulse.Data
-    where
-import Dodge.Creature.Stance.Data
-import Geometry.Data
-
-import Control.Lens
-data Impulse 
-    = 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
-    | ImpulseID Int Impulse
-    | AtRange Float
-    | AtRanges Float Float
-    | RepeatAction Int Impulse
-    | MakeJudgement
-    | SetPosture Posture
-  deriving (Eq,Show)

src/Dodge/Creature/ImpulseRat.hs

@@ -4,23 +4,22 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.Creature.ChooseTarget
 import Dodge.Creature.State.Data
-import Dodge.Creature.Rationality.Data
 import Geometry
 
 import qualified Data.IntMap as IM
 import Control.Lens
+import Control.Monad.Reader
 
 encircle :: Creature -> IM.IntMap Creature -> Creature -> Point2
 encircle tcr crs cr 
     | length crs <= 1 = ypos
-    | otherwise       = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 30) ) *.* safeNormalizeV (cpos -.- cenp)
+    | otherwise       = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
   where 
     cpos = _crPos cr
     ypos = _crPos tcr
     f x = 150 * sigmoid (x-10)
     cenp = (1 / fromIntegral (length crs)) *.* foldr1 (+.+) (map _crPos $ IM.elems crs)
 
-
 lineOrth :: Creature -> IM.IntMap Creature -> Creature -> Point2
 lineOrth tcr crs cr = p
   where 
@@ -64,6 +63,19 @@ spreadOut ycr crs cr = p
         | dist ypos cpos > 90 = 1
         | otherwise = 1.5
 
+swarmUsingCenter
+    :: (Creature -> Point2 -> Creature -> Creature) 
+    -> (Point2 -> Creature -> Creature)
+    -> World
+    -> Creature
+    -> Creature
+swarmUsingCenter updT upd w cr = case _crTarget cr of
+    Nothing -> upd cenp cr
+    Just tcr -> updT tcr cenp cr
+  where
+    cid = _crID cr
+    cenp = _crGroupCenter $ _creatureGroups w IM.! (_crGroupID $ _crGroup $ _creatures w IM.! cid)
+
 flockChaseTarget
     :: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target
     -> (IM.IntMap Creature -> Creature -> Creature) -- ^ Update without target
@@ -100,17 +112,52 @@ chaseTarget targFunc w cr = case targFunc cr w of
     Nothing -> cr
     Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg
 
+chaseTargetR
+    :: (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -> Creature 
+    -> Reader World Creature 
+chaseTargetR targFunc cr = reader $ \w ->  case targFunc cr w of
+    Nothing -> cr
+    Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg
+
+
+overrideMeleeCloseTarget :: World -> Creature -> Creature
+overrideMeleeCloseTarget w cr = case _crTarget cr of
+    Nothing -> cr
+    Just tcr
+        | _crMeleeCooldown cr == Just 0
+            && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5 
+            && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4
+            -> cr & crActionPlan . crStrategy .~ StrategyActions MeleeStrike [DoImpulses [Melee (_crID tcr)]]
+        | otherwise -> cr
+  where
+    cpos = _crPos cr
+
+overrideMeleeCloseTargetR 
+    :: Creature 
+    -> Reader World Creature
+overrideMeleeCloseTargetR cr = reader $ \w  -> case _crTarget cr of
+    Nothing -> cr
+    Just tcr
+        | _crMeleeCooldown cr == Just 0
+            && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5 
+            && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4
+            -> cr & crActionPlan . crStrategy .~ StrategyActions MeleeStrike [DoImpulses [Melee (_crID tcr)]]
+        | otherwise -> cr
+  where
+    cpos = _crPos cr
+
 chaseTarg' :: Point2 -> Creature -> Creature -> [Impulse]
 chaseTarg' p cr crT
     | dist tpos cpos < combinedRad + 5 
-            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+            && 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
+            && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
         = [ TurnToward tpos 0.05 ]
-    | abs ((_crDir cr) - argV (p -.- cpos)) < pi/4
-                = [MoveForward 2.5 , TurnToward p 0.2, RandomTurn 0.2 ]
+    | abs (_crDir cr - argV (p -.- cpos)) < pi/4
+                = [MoveForward 2.5 , TurnToward p 0.2 , RandomTurn 0.2 ]
     | otherwise = [MoveForward 2.5 , TurnToward p 0.05, RandomTurn 0.2 ]
   where
     cpos = _crPos cr
@@ -120,13 +167,9 @@ chaseTarg' p cr crT
 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)]
-    | dist tpos cpos < combinedRad + 5 
-            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+            && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
         = [ TurnToward tpos 0.05 ]
-    | abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+    | 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
@@ -146,13 +189,13 @@ impulseShootAtTarget targFunc w cr = case targFunc cr w of
 impulseShootAtTarg :: Creature -> Creature -> [Impulse]
 impulseShootAtTarg cr crT
     | dist tpos cpos < combinedRad + 5 
-            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+            && 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
+            && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
         = [ TurnToward tpos 0.05 ]
-    | abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+    | 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

src/Dodge/Creature/Inanimate.hs

@@ -6,7 +6,6 @@ module Dodge.Creature.Inanimate
 import Dodge.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
-import Dodge.Creature.Impulse.Data
 import Dodge.Base
 import Dodge.Picture.Layer
 import Dodge.Default
@@ -59,8 +58,7 @@ barrel = defaultInanimate
         , color (greyN 0.5) $ circleSolid 8
         ]
     , _crState = defaultState 
-        {_goals = [[Wait]]
-        ,_crSpState = Barrel []
+        {_crSpState = Barrel []
         }
     , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
     }
@@ -74,8 +72,7 @@ explosiveBarrel = defaultInanimate
         , color orange $ circleSolid 10
         ]
     , _crState = defaultState 
-        {_goals = [[Wait]]
-        ,_crSpState = Barrel []
+        {_crSpState = Barrel []
         }
     , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
     ,_crApplyDamage = \_ c -> (id, c)

src/Dodge/Creature/LauncherCrit.hs

@@ -52,7 +52,7 @@ launcherCrit = defaultCreature
     }
 
 retreatFire :: Action
-retreatFire = ImpulsesList ( [ [ UseItem ] ] ++ replicate 20 [ Turn 0.16 ])
+retreatFire = ImpulsesList ( [ UseItem ] : replicate 20 [ Turn 0.16 ])
     `DoActionThen`
     HolsterWeapon
     `DoActionThen`
@@ -60,7 +60,7 @@ retreatFire = ImpulsesList ( [ [ UseItem ] ] ++ replicate 20 [ Turn 0.16 ])
     `DoActionThen`
     DrawWeapon
     `DoActionThen`
-    ImpulsesList ( [[UseItem]] ++ replicate 20 [ Turn $ negate 0.16 ] )
+    ImpulsesList ( [UseItem] : replicate 20 [ Turn $ negate 0.16 ] )
     `DoActionThen`
     HolsterWeapon
     `DoActionThen`

src/Dodge/Creature/LtAutoCrit.hs

@@ -72,4 +72,4 @@ chooseMovement cr w
     tcr = _creatures w IM.! 0
     p = _crPos tcr
     v = vNormal $ p -.- cpos
-    p' = p +.+ 0.5 *.* (v -.- 20 *.* (normalizeV v))
+    p' = p +.+ 0.5 *.* (v -.- 20 *.* normalizeV v)

src/Dodge/Creature/Picture.hs

@@ -33,17 +33,17 @@ basicCrPict col cr = pictures
         | 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
+    pdam = sum $ concatMap (map _dmAmount) pastDams
     col' = light . light . light $ light col
     bluntDam :: Maybe Point2
     bluntDam = find isBluntDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
     bluntScale = case fmap argV bluntDam of
         Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
         _   -> id
-    isBluntDam (Blunt {}) = True
+    isBluntDam Blunt{} = True
     isBluntDam _ = False
     piercingDam = find isPiercingDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
-    isPiercingDam (Piercing {}) = True
+    isPiercingDam Piercing{} = True
     isPiercingDam _ = False
     piercingMod = case fmap argV piercingDam of
         Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)

src/Dodge/Creature/PistolCrit.hs

@@ -93,8 +93,8 @@ chooseMovement' cr w = takeOneWeighted [chargeProb,retreatProb,strafeProb,strafe
         3
         `DoReplicate`
         ImpulsesList (replicate 9 [Move (0,-3)] ++ [[Move (0,-3),UseItem]])
-    yposl = ypos -.- 100 *.* (vNormal $ normalizeV $ ypos -.- cpos)
-    yposr = ypos +.+ 100 *.* (vNormal $ normalizeV $ ypos -.- cpos)
+    yposl = ypos -.- 100 *.* vNormal (normalizeV $ ypos -.- cpos)
+    yposr = ypos +.+ 100 *.* vNormal (normalizeV $ ypos -.- cpos)
 
 retreatActions :: Creature -> Creature -> Action
 retreatActions tcr cr = 

src/Dodge/Creature/Rationality.hs

@@ -2,7 +2,6 @@ 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
@@ -14,6 +13,7 @@ import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import System.Random
 import Control.Lens
+import Control.Monad.Reader
 
 -- Alternatives would probably be a very good fit for actions...
 
@@ -24,6 +24,14 @@ composeInternalAIs
     -> Creature
 composeInternalAIs fs w c = foldr ($ w) c fs
 
+impulsiveAIR
+    :: (Creature -> Reader World Creature)
+    -> World
+    -> (World -> World, StdGen)
+    -> Creature
+    -> ((World -> World, StdGen) , Maybe Creature)
+impulsiveAIR impf w (f,g) cr = followImpulses w (f,g) . ($ w) . runReader . impf $ cr
+
 impulsiveAI 
     :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
     -> World 
@@ -84,7 +92,7 @@ followImpulse cr w imp = case imp of
     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 )
+    addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams 
 
 actionUpdateAI
     :: (World -> Creature -> Creature) -- ^ the function updating the actions
@@ -93,6 +101,24 @@ actionUpdateAI
     -> Creature
 actionUpdateAI actF w c = performActions w $ actF w c
 
+performActionR :: Creature -> Reader World Creature
+performActionR cr = reader $ \w -> performActions w cr
+
+watchUpdateStratR
+    :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ]
+    -> Creature
+    -> Reader World Creature
+watchUpdateStratR fs cr = case cr ^? crActionPlan . crStrategy of
+    Just WatchAndWait -> reader $ \w -> cr 
+        & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr
+    _ -> reader $ \_ -> cr
+
+listGuard :: ([(a -> Bool, b)] , b) -> a -> b
+listGuard ( (test,y):ps, z ) x
+    | test x = y
+    | otherwise = listGuard (ps, z) x
+listGuard (_,z) _ = z
+
 performActions :: World -> Creature -> Creature
 performActions w cr = cr
     & crActionPlan . crImpulse .~ concat iss

src/Dodge/Creature/Rationality/Data.hs

@@ -1,8 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Creature.Rationality.Data
-    where
-import Dodge.Creature.Stance.Data
-import Geometry.Data
-
-import Control.Lens

src/Dodge/Creature/SetTarget.hs

@@ -8,10 +8,11 @@ import Dodge.Creature.AlertLevel.Data
 
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
+{- | Assumes that you are id 0: if creature is cognizant of you, sets you as target -}
 targetYouWhenCognizant
     :: World
     -> Creature
     -> Creature
 targetYouWhenCognizant w cr = case cr ^? crAwarenessLevel . ix 0 of
-    Just (Cognizant _)  -> cr & crTarget .~ Just (_creatures w IM.! 0)
+    Just (Cognizant _)  -> cr & crTarget ?~ _creatures w IM.! 0
     _                   -> cr & crTarget .~ Nothing

src/Dodge/Creature/State.hs

@@ -2,7 +2,6 @@ module Dodge.Creature.State where
 import Dodge.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
-import Dodge.Data
 import Dodge.Base
 import Dodge.SoundLogic
 import Dodge.RandomHelp
@@ -16,16 +15,11 @@ import Data.List
 import Data.Char
 import Data.Maybe
 import Data.Function
---import Data.Graph.Inductive.Graph
-import Data.Graph.Inductive.PatriciaTree
-import Data.Graph.Inductive.Query.SP
-import Codec.BMP
-import qualified Data.ByteString as B
 import Control.Lens
 import Control.Applicative
 import Control.Monad.State
 import Control.Monad
-import qualified SDL as SDL
+import qualified SDL
 import qualified SDL.Mixer as Mix
 import System.Random
 import qualified Data.Set as S
@@ -38,7 +32,6 @@ type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World
 
 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
@@ -46,11 +39,11 @@ 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 . deathEff . f'
-                                 , g')
-                               , fmap (updateReloadCounter . doDamage . crAutoReload) 
-                                      $ crOrCorpse =<< maybeCr
-                               )
+        ((f',g') , maybeCr) -> 
+            (   (invSideEff cr . movementSideEff cr . deathEff . f'
+                , g')
+            , fmap (updateReloadCounter . doDamage . crAutoReload) $ crOrCorpse =<< maybeCr
+            )
   where   
     crOrCorpse cr 
         | cr ^. crHP > 0 = Just cr
@@ -60,11 +53,11 @@ stateUpdate u w (f,g) cr =
         | 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)
-
+    crBeforeDeath = colCrWall w cr
+    addCorpse = insertNewKey 
+        $ uncurry translate (_crOldPos cr) 
+        $ rotate (_crDir cr)
+        (_crCorpse cr)
 -- | Drop items according to the creature state.
 dropByState :: Creature -> World -> World
 dropByState cr w = foldr (copyItemToFloor cr) w is
@@ -75,10 +68,8 @@ dropByState cr w = foldr (copyItemToFloor cr) w is
         DropSpecific xs -> xs
         DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
 
-
 setOldPos :: Creature -> Creature
 setOldPos cr = set crOldPos (_crPos cr) cr
-
 {- |
 Given a creature and a velocity, applies friction to that creature and evaluates a 
 velocity to carry across frames.
@@ -86,17 +77,12 @@ velocity to carry across frames.
 crFriction :: Creature -> Point2 -> Point2
 crFriction cr vel = (0,0)
 
-{- | In order to force a list, apply with seq. -}
-forceSpine :: [a] -> ()
-forceSpine = foldr (const id) ()
-
 doDamage :: Creature -> Creature
 doDamage cr = set (crState . crDamage) [] 
-    $ over (crState . crPastDamage) (f . take 20 . (dams :) ) damagedCr
+    $ over (crState . crPastDamage) (forceList . take 20 . (dams :) ) damagedCr
   where 
-    f l = seq (forceSpine l) l
     dams = _crDamage $ _crState cr
-    damagedCr = snd $ (_crApplyDamage cr) dams cr
+    damagedCr = snd $ _crApplyDamage cr dams cr
 
 sumDamage :: Creature -> DamageType -> Int -> Int
 sumDamage cr dm x = x + _dmAmount dm
@@ -107,7 +93,7 @@ movementSideEff cr w
         = case cr ^? crStance . carriage of
             Just (Boosting v) 
                 -> makeFlameletTimed 
-                            (oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi))
+                            (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
                             (momentum +.+ 1 *.* rotateV randDir (vInverse v)) 
                             Nothing
                             1
@@ -128,9 +114,6 @@ movementSideEff cr w
     (randDir,g) = randomR (-0.5,0.5) $ _randGen w
     (randAng,_) = randomR (0,2*pi) $ _randGen w
 
-    (v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w
-    (r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[])
-
     crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5
     takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0
                  | crHasMoved && x < 80 && x + y >= 80 = soundMultiFrom footor 23 3 0  
@@ -139,15 +122,16 @@ movementSideEff cr w
 
 invSideEff :: Creature -> World -> World
 invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
-    where f i it w' = case it ^? itEffect . itInvEffect of
-                            Nothing -> w'
-                            Just g  -> g cr i w'
+    where 
+    f i it w' = case it ^? itEffect . itInvEffect of
+        Nothing -> w'
+        Just g  -> g cr i w'
 
 weaponReloadSounds :: Creature -> World -> World
 weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
-    Just (Weapon {_wpReloadState = 0}) -> w
-    Just (Weapon {_wpReloadState = 1}) -> stopSoundFrom (CrReloadSound cid) w
-    Just (Weapon {}) -> soundFrom (CrReloadSound cid) reloadSound (1) 0 w
+    Just Weapon{_wpReloadState = 0} -> w
+    Just Weapon{_wpReloadState = 1} -> stopSoundFrom (CrReloadSound cid) w
+    Just Weapon{} -> soundFrom (CrReloadSound cid) reloadSound 1 0 w
     _ -> w
   where 
     cid = _crID cr
@@ -171,7 +155,7 @@ updateMovement g cr
 isFrictionless :: Creature -> Bool
 isFrictionless cr = case cr ^? crStance . carriage of
     Just (Boosting _) -> True
-    Just (Floating)   -> True
+    Just Floating     -> True
     _                 -> False
 
 updateReloadCounter :: Creature -> Creature
@@ -212,12 +196,11 @@ updateExpBarrel w (f,g) cr
     damages = _crDamage $ _crState cr
     pierceSparks :: [World -> World]
     pierceSparks 
-      = zipWith4 (\p a colid time-> (createBarrelSpark time colid (_crPos cr +.+ p) (a + argV p)) 
-                                          (Just $ _crID cr))
-                            poss as colids times
-    as =  randomRs (-0.7,0.7) $ g
-    colids = randomRs (0,11) $ g
-    times = randomRs (2,5) $ g
+      = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr))
+                            poss as times colids
+    as =  randomRs (-0.7,0.7) g
+    colids = randomRs (0,11) g
+    times = randomRs (2,5) g
     (g',_) = split g
     poss = _piercedPoints $ _crSpState $ _crState cr
     --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
@@ -229,7 +212,7 @@ updateExpBarrel w (f,g) cr
     applyFuseDamage cr = over crHP (\hp -> hp - length (_piercedPoints 
                                                        $ _crSpState $ _crState cr)) 
                                    cr
-    hiss | poss == [] = id
+    hiss | null poss = id
          | otherwise  = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1
     stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
 
@@ -237,14 +220,14 @@ damToExpBarrel :: [DamageType] -> Creature -> Creature
 damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
   where 
     (pierceDam,otherDam) = partition isPierce ds
-    isPierce (Piercing {}) = True
+    isPierce Piercing{} = True
     isPierce _             = False
 
 damToExpBarrel' :: DamageType -> Creature -> Creature
 damToExpBarrel' (Piercing amount sp int ep) cr 
     = over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) 
         $ over crHP (\hp -> hp - div amount 200) cr
-damToExpBarrel' (PoisonDam {}) cr = cr
-damToExpBarrel' (SparkDam {})  cr = cr
-damToExpBarrel' (PushDam {_dmPushBack = v})   cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
+damToExpBarrel' PoisonDam {} cr = cr
+damToExpBarrel' SparkDam {}  cr = cr
+damToExpBarrel' PushDam{_dmPushBack = v} cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
 damToExpBarrel' dt             cr = cr Control.Lens.& crHP -~ _dmAmount dt

src/Dodge/Creature/State/Data.hs

@@ -4,31 +4,25 @@ module Dodge.Creature.State.Data
   where
 import Geometry
 import Dodge.Data.DamageType
-import Dodge.Creature.Impulse.Data
 import Dodge.Creature.Stance.Data
 import Picture.Data
 
 import Control.Lens
 import qualified Data.IntSet as IS
-
 data CreatureState = CrSt 
-    { _goals    :: [[Impulse]]
-    , _crDamage  :: [DamageType]
+    { _crDamage  :: [DamageType]
     , _crPastDamage :: [[DamageType]]
     , _crSpState :: CrSpState
     , _crDropsOnDeath :: CreatureDropType
     }
-
 data CreatureDropType
     = DropAll
     | DropAmount Int
     | DropSpecific [Int]
-
 data CrSpState 
     = Barrel { _piercedPoints :: [Point2]}
     | GenCr
   deriving (Eq,Show,Ord)
-
 data Faction 
     = GenericFaction Int
     | ZombieFaction
@@ -39,11 +33,12 @@ data Faction
     | ColorFaction Color
     | PlayerFaction
   deriving (Eq,Show)
-
 data CrGroup
     = LoneWolf
-    | Swarm { _swarm :: IS.IntSet }
-
+    | Swarm 
+        { _swarm :: IS.IntSet 
+        , _crGroupID :: Int
+        }
+    | CrGroupID { _crGroupID :: Int }
 makeLenses ''CreatureState
 makeLenses ''CrSpState
-makeLenses ''Impulse

src/Dodge/Creature/SwarmCrit.hs

@@ -32,14 +32,15 @@ swarmCrit = defaultCreature
     { _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
         [ flockPointTarget encircle targetYouLOS
         , \ _ -> crMeleeCooldown . _Just %~ (max 0 . subtract 1)
+        , basicPerceptionUpdate [0]
+--        , doStrategyActions
+--        , targetYouWhenCognizant
         ]
     , _crHP = 1
     , _crRad = 2
+    , _crMass = 2
     , _crPict = basicCrPict yellow
-    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
     , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 2
     , _crFaction = ColorFaction yellow
     , _crMeleeCooldown = Just 0
     }
-
-

src/Dodge/Creature/Test.hs

@@ -16,6 +16,7 @@ import Data.List (find)
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
+import Control.Monad.Reader
 
 andTest :: (a -> Bool) -> (a -> Bool) -> a -> Bool
 andTest f g a = f a && g a
@@ -28,31 +29,61 @@ crIsReloading (w,cr) = case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
     Just t -> t > 0
     _ -> False
 
+crIsReloadingR :: Creature -> Reader World Bool
+crIsReloadingR cr = return $ case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
+    Just t -> t > 0
+    _ -> False
+
 crCanSeeCr :: Creature -> (World, Creature) -> Bool
 crCanSeeCr tcr (w,cr) = hasLOS (_crPos cr) (_crPos tcr) w
 
+crCanSeeR :: Creature -> Creature -> Reader World Bool
+crCanSeeR tcr cr = reader $ \w -> hasLOS (_crPos cr) (_crPos tcr) w
+
 crCanSeeCID :: Int -> (World, Creature) -> Bool
 crCanSeeCID cid (w,cr) = hasLOS (_crPos cr) (_crPos $ _creatures w IM.! cid) w
 
+crCanSeeCIDR :: Int -> Creature -> Reader World Bool
+crCanSeeCIDR cid cr = reader $ \w -> hasLOS (_crPos cr) (_crPos $ _creatures w IM.! cid) w
+
 crIsAiming :: (World,Creature) -> Bool
 crIsAiming (_,cr) = _posture (_crStance cr) == Aiming
 
+crIsAimingR :: Creature -> Reader World Bool
+crIsAimingR cr = return $ _posture (_crStance cr) == Aiming
+
 crHasTarget :: (World,Creature) -> Bool
 crHasTarget (_,cr) = isJust $ cr ^? crTarget . _Just
 
+crHasTargetR :: Creature -> Reader World Bool
+crHasTargetR cr = return $ isJust $ cr ^? crTarget . _Just
+
 crHasTargetLOS :: (World,Creature) -> Bool
 crHasTargetLOS (w,cr) = case cr ^? crTarget . _Just of
     Just i -> crCanSeeCr i (w,cr) 
     Nothing -> False
 
+crHasTargetLOSR :: Creature -> Reader World Bool
+crHasTargetLOSR cr = reader $ \w -> case cr ^? crTarget . _Just of
+    Just i -> crCanSeeCr i (w,cr) 
+    Nothing -> False
+
 crSafeDistFromTarg :: Float -> (World,Creature) -> Bool
 crSafeDistFromTarg d (w,cr) = case cr ^? crTarget . _Just of
     Just tcr -> dist (_crPos cr) (_crPos tcr) > d
     Nothing -> True
 
+crSafeDistFromTargR :: Float -> Creature -> Reader World Bool
+crSafeDistFromTargR d cr = reader $ \w -> case cr ^? crTarget . _Just of
+    Just tcr -> dist (_crPos cr) (_crPos tcr) > d
+    Nothing -> True
+
 crStratConMatches :: Strategy -> (World,Creature) -> Bool
 crStratConMatches strat (_,cr) = eqConstr strat (_crStrategy $ _crActionPlan cr)
 
+crStratConMatchesR :: Strategy -> Creature -> Reader World Bool
+crStratConMatchesR strat cr = return $ eqConstr strat (_crStrategy $ _crActionPlan cr)
+
 crAwayFromPost :: (World,Creature) -> Bool
 crAwayFromPost (_,cr) = case find sentinelGoal $ _crGoal $ _crActionPlan cr of
     Just (SentinelAt p dir) -> dist p (_crPos cr) > 15
@@ -60,3 +91,11 @@ crAwayFromPost (_,cr) = case find sentinelGoal $ _crGoal $ _crActionPlan cr of
   where
     sentinelGoal (SentinelAt p dir) = True
     sentinelGoal _ = False
+
+crAwayFromPostR :: Creature -> Reader World Bool
+crAwayFromPostR cr = return $ case find sentinelGoal $ _crGoal $ _crActionPlan cr of
+    Just (SentinelAt p dir) -> dist p (_crPos cr) > 15
+    _ -> False
+  where
+    sentinelGoal (SentinelAt p dir) = True
+    sentinelGoal _ = False

src/Dodge/Creature/Update.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 module Dodge.Creature.Update
   where
 import Dodge.Data