Add file, fix lamp doDamage space leak

src/Dodge/AIs.hs

@@ -1,8 +1,6 @@
 module Dodge.AIs 
-    ( twitchMissAI
+    ( launcherAI
-    , launcherAI
     , chargeAI
-    , sniperAI
     , dodgeAI
     , spawnerAI
     ) where
@@ -888,108 +886,6 @@ circleClockwiseAI inRange outRange w (f,g) cr =
                        | otherwise
                             -> ( (f,g) , replaceImpulse [AimAt p (i-1)] $ strafeCloseSlow p cr)
 
-twitchMissAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
-twitchMissAI inRange outRange w (f,g) cr = 
-    let cpos = _crPos cr
-        yposl = ypos +.+ 25 *.* normalizeV (vNormal (cpos -.- ypos))
-        yposr = ypos -.- 25 *.* normalizeV (vNormal (cpos -.- ypos))
-        yposoff = evalState (takeOne [yposl,yposr]) $ _randGen w
-        cid  = _crID cr
-        ypos = _crPos $ you w
-        wp   = _crInv cr IM.! _crInvSel cr
-        fireRate = fromMaybe 0 $ wp ^? itUseRate
-        noAmmo = 0 == _wpLoadedAmmo wp
-        strafeCloseSlow p | errorAngleVV 22 (p -.- cpos)
-                                          (unitVectorAtAngle (_crDir cr)) < 0.1
-                                      =  crTurnTowardSpeed 0.01 p . crMvForward closeDist
-                          | otherwise
-                                      =  crTurnAndStrafeIn inOrOut 0.05 p
-                where inOrOut | dist p cpos < inRange = -1
-                              | dist p cpos < outRange = 0
-                              | otherwise         = 1
-                      closeDist | dist p cpos < inRange = -1
-                                | dist p cpos < outRange = 0
-                                | otherwise        = 1
-        replaceGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ tail gs)
-        addGoal newImpulses     = Just . over (crState . goals) (\gs -> newImpulses ++ gs)
-        replaceImpulse newActions 
-            = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
-        addImpulse newActions 
-            = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
-        (t,g') = randomR (fireRate+10,fireRate+15) g
-        retreatPs = sortBy (compare `on` dist cpos) $ map f $ nRaysRad 8 400
-            where f p = fromMaybe (ypos +.+ p) $ fmap fst
-                            $ reflectPointWalls ypos (ypos +.+ p) (wallsAlongLine ypos (ypos +.+ p) w)
-        retreatP' = cpos +.+ 300 *.* (cpos -.- ypos)
-        retreatP'' = fromMaybe retreatP' $ fmap fst
-                                         $ reflectPointWalls ypos retreatP' 
-                                         $ wallsAlongLine ypos retreatP' w
-        retreatP = head $ sortBy (compare `on` (\p -> dist p ypos < 300)) $ retreatP'' : retreatPs
-        fireActions = [TurnToward yposoff, Fire, TurnTo ypos, WaitFor t
-                      ,Fire,Fire,Reload,ImpulseID 0 (WaitFor 20),MakeJudgement]
-        fleeActions = [MoveToFor retreatP 50,MakeJudgement]
-    in  --if _crHP cr <= 0 then killCr w f cr else
-    case head $ _goals $ _crState cr of
-        [] -> ((f,g), replaceGoal [] cr)
-        (MakeJudgement:_) 
-            | not (canSeeFire cpos ypos w) -> ((f,g),replaceImpulse [] cr)
-            | dist cpos ypos > 400 -> ((f,g), replaceImpulse [MoveToFor ypos 20] cr)
-            | dist cpos ypos < 150 -> ((f,g'),replaceImpulse fleeActions $ crMvBy (3,0) cr)
-            | otherwise -> ((f,g'),replaceImpulse fireActions cr)
-        (ImpulseID i (WaitFor x):gls)
-                       | x == 0    -> ( (f ,g' ),  replaceImpulse [] cr )
-                       | otherwise -> ( (f ,g' ),  replaceImpulse [ImpulseID i (WaitFor (x-1))]
-                                                    $ strafeCloseSlow ypos cr )
-        (WaitFor x:gls)| x == 0    -> ( (f ,g' ),  replaceImpulse [] cr )
-                       | otherwise -> ( (f ,g' ),  replaceImpulse [WaitFor (x-1)] cr )
-        (MoveToFor p x:gls) 
-                       | x == 0 -> ( (f, g') , replaceImpulse [] cr)
-                       | dist p cpos < 10 -> ( (f , g') , replaceImpulse [] cr)
-                       | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
-                                   -> ( (f , g')
-                                      , replaceImpulse [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.5 p cr  )
-                       | otherwise -> ( (f , g')
-                                      , replaceImpulse [MoveToFor p (x-1)] $ crMvForward 3
-                                                                          $ crTurnTowardSpeed 0.05 p cr )
-        (PathTo p:_)   
-            | canSeeFire cpos ypos w -> ((f,g),replaceGoal [[MakeJudgement]] cr)
-            | dist p cpos < 10 -> ( (f , g') , replaceImpulse [] cr )
-            | hasLOS cpos p w -> ( (f , g') , addImpulse [MoveToFor p 50] cr )
-            | otherwise -> case pointTowardsImpulse cpos p w of
-                             Just q -> ( (f , g') , addImpulse [MoveToFor q 50] cr )
-                             _      -> ( (f , g') , replaceImpulse [] cr            )
-        (Fire:gls) -> ( (tryUseItem cid . f , g' )
-                      , replaceImpulse [] cr
-                      )
-        (Reload:gls)   | _wpReloadState wp == 0 -> ( (f , g') , replaceImpulse [] cr )
-                       | canSeeFireVisionAny cid (_yourID w) w 
-                            -> ( (f , g')
-                               , Just $ strafeCloseSlow ypos cr
-                               )  -- no longer chase if see you when reloading
-                                                    --  $ replaceImpulse [] w
-                       | otherwise -> ( (f , g) , Just cr)
-        (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w
-                            -> ( ( f , g')
-                               , addGoal [[MakeJudgement]] cr
-                               )
-                       | dist cpos p > 10
-                            -> ( (f,g) , addGoal [[PathTo p]] cr)
-                       | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
-                            -> ( (f,g)   
-                               ,Just $ crTurnTowardSpeed 0.05 p' cr)
-                       | otherwise -> ( (f,g) ,Just cr)
-        (InitGuard :_) -> ( (f,g)
-                          ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
-                          )
-        (TurnToward p:_) 
-            | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 2
-                -> ( (f,g') , Just . crTurnTowardSpeed 0.2 p $ cr)
-            | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 0.2
-                -> ( (f,g') , Just . crTurnTowardSpeed 0.1 p $ cr)
-            | otherwise
-                -> ( (f,g') , replaceImpulse [] . crTurnTo p $ cr)
-        (TurnTo p:_) -> ( (f,g') , replaceImpulse [] . crTurnTo p $ cr)
-
 closeToRangeAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
 closeToRangeAI inRange outRange w (f,g) cr = 
     let cpos = _crPos cr
@@ -1208,86 +1104,6 @@ suppressShooterAI w (f,g) cr =
                        | otherwise
                             -> ( (f,g) , replaceImpulse [AimAt p (i-1)] $ turnCloseSlow p cr)
 
-
-sniperAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
-sniperAI w (f,g) cr = 
-    let cpos = _crPos cr
-        cid  = _crID cr
-        ypos = _crPos $ you w
-        wp   = _crInv cr IM.! _crInvSel cr
-        (aimtime,g1) = randomR (80,120) g
-        noAmmo = 0 == _wpLoadedAmmo wp
-        turnCloseSlow p 
-            | errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4
-                                    =  crTurnTowardSpeed 0.01 p
-            | otherwise =  crTurnTowardSpeed 0.05 p
-        replaceGoal newImpulses = Just . over (crState . goals) (\gs -> newImpulses ++ tail gs)
-        addGoal newImpulses     = Just . over (crState . goals) (\gs -> newImpulses ++ gs)
-        replaceImpulse newActions 
-            = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
-        addImpulse newActions 
-            = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
-    in case head $ _goals $ _crState cr of
-        []  | canSeeFire cpos ypos w -> ( ( f , g1 ) , replaceGoal [[AimAt ypos aimtime]] cr)
-            | otherwise              -> ( ( f , g ) , replaceGoal [] cr)
-        (WaitFor x:gls)
-            | canSeeFire cpos ypos w -> ( ( f , g1 ) , replaceGoal [[AimAt ypos aimtime]] cr)
-            | x == 0    -> ( (f ,g ),  replaceImpulse [] cr )
-            | otherwise -> ( (f ,g ),  replaceImpulse [WaitFor (x-1)] cr )
-        (MoveToFor p x:gls) 
-            | canSeeFire cpos ypos w -> ( (f , g1) , replaceGoal [[AimAt ypos aimtime]] cr)
-            | x == 0    -> ( (f , g) , replaceImpulse [] cr)
-            | dist p cpos < 1 -> ( (f , g) , replaceImpulse [] cr)
-            | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 -> 
-                ( (f , g) , replaceImpulse [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr  )
-            | otherwise -> 
-                ( (f , g) 
-                , replaceImpulse [MoveToFor p (x-1)] $ crMvForward 2 $ crTurnTowardSpeed 0.05 p cr )
-        (PathTo p:_)   
-            | dist p cpos < 1 -> ( (f , g) , replaceImpulse [] cr )
-            | hasLOS cpos p w -> ( (f , g) , addImpulse [MoveToFor p 100] cr )
-            | otherwise -> case pointTowardsImpulse cpos p w of
-                Just q -> ( (f , g) , addImpulse [MoveToFor q 100] cr )
-                _      -> ( (f , g) , replaceImpulse [] cr            )
-        (FireAt p:gls) 
-            | noAmmo -> ( (tryUseItem cid . f , g ) , replaceGoal [[Reload ,WaitFor 50 ]] cr)
-            | canSeeFireVisionAll cid (_yourID w) w -> 
-                ( (tryUseItem cid . f , g) , replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr)
-            | pathToPointFireable cid p w -> 
-                ( (tryUseItem cid . f , g) , Just $ turnCloseSlow p cr)
-            | otherwise -> 
-                ( (f , g) , replaceGoal [[WaitFor 50 ]] cr)
-        (Reload:gls)   
-            | _wpReloadState wp == 0 -> ( (f , g) , replaceImpulse [] cr )
-            | canSeeFireVisionAny cid (_yourID w) w -> 
-                ( (f , g) , Just $ turnCloseSlow ypos cr) 
-            | otherwise -> ( (f , g) , Just cr)
-        (Search i:gls) | i == 0 -> ( (f , g) , replaceImpulse [] cr)
-                       | otherwise 
-                            -> ( ( f , g1)
-                               , replaceImpulse [ PathTo (randomPointXStepsFrom 3 cpos w)
-                                               , Search (i-1)
-                                               ] cr
-                                )
-        (Guard p p':_) | canSeeFireVision cid (_yourID w) w
-                            -> ( ( f , g1)
-                               , addGoal [[AimAt ypos (2*aimtime)]] cr
-                               )
-                       | dist cpos p > 1
-                            -> ( (f,g) , addGoal [[PathTo p]] cr)
-                       | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
-                            -> ( (f,g)   
-                               ,Just $ crTurnTowardSpeed 0.05 p' cr)
-                       | otherwise -> ( (f,g) ,Just cr)
-        (InitGuard :_) -> ( (f,g)
-                          ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
-                          )
-        (AimAt p i:_)  | i == 0 -> ( (f,g) , replaceImpulse [FireAt p] cr )
-                       | canSeeFireVision cid (_yourID w) w
-                            -> ( (f,g) , replaceImpulse [AimAt ypos (i-1)] $ crTurnTowardSpeed 0.2 p cr)
-                       | otherwise
-                            -> ( (f,g) , replaceImpulse [AimAt p (i-1)] $ turnCloseSlow p cr)
-        
 errorNormalizeVAI :: Point2 -> Point2
 errorNormalizeVAI (0,0) = error "problem with function: errorNormalizeVAI in DodgeAIs"
 errorNormalizeVAI p = normalizeV p

src/Dodge/Creature.hs

@@ -111,7 +111,26 @@ miniGunCrit = defaultCreature
 longCrit :: Creature
 longCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate sniperAI
+--    , _crUpdate = stateUpdate sniperAI
+    , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
+        [ performActions
+        , watchUpdateStrat
+            [ (crHasTargetLOS, aimThenShootStrat 0)
+            , (crAwayFromPost, goToPostStrat)
+            ]
+        , basicPerceptionUpdate [0]
+        , doStrategyActions
+        , reloadOverrideNoHolster
+        , targetYouWhenCognizant
+        , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+            $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait
+        ]
+    , _crActionPlan = ActionPlan
+        { _crImpulse    = []
+        , _crAction     = []
+        , _crStrategy   = StrategyActions WatchAndWait [StartSentinelPost]
+        , _crGoal       = []
+        }
     , _crInv = IM.fromList [(0,longGun),(1,medkit 100)]
     , _crInvSel = 0
     , _crRad = 10
@@ -130,7 +149,8 @@ multGunCrit = defaultCreature
     , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
         [ performActions
         , watchUpdateStrat
-            [ (crHasTargetLOS, shootFirstMiss 0)
+            [ (not . crSafeDistFromTarg 150 , fleeTime 5)
+            , (crHasTargetLOS, shootFirstMiss 0)
             , (crAwayFromPost, goToPostStrat)
             ]
         , basicPerceptionUpdate [0]
@@ -196,7 +216,7 @@ autoCrit = defaultCreature
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
         , _crAction     = []
-        , _crStrategy   = StrategyActions [StartSentinelPost] WatchAndWait
+        , _crStrategy   = StrategyActions WatchAndWait [StartSentinelPost]
         , _crGoal       = []
         }
     , _crInv = IM.fromList [(0,autoGun),(1,medkit 100)]

src/Dodge/Creature/Action.hs

@@ -50,8 +50,6 @@ crStrafeRight speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
     equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
     s2 = (speed * equipFactor)
 
-
-
 turnTo 
     :: Point2   -- ^ Target point
     -> Int      -- ^ Creature id

src/Dodge/Creature/Action/Flee.hs

@@ -0,0 +1,25 @@
+module Dodge.Creature.Action.Flee
+    where
+import Dodge.Data
+import Geometry
+
+import Data.List
+import Data.Maybe
+
+retreatPointForFrom
+    :: Float -> World -> Creature -> Point2 -> Maybe Point2
+retreatPointForFrom d w cr p 
+    = listToMaybe
+    .  sortOn (dist cpos) 
+    $ divideCircle 10 p d
+  where
+    cpos = _crPos cr
+--    = head $ sortBy (compare `on` (\p -> dist p ypos < 300)) $ retreatP'' : retreatPs
+--  where
+--    retreatPs = sortBy (compare `on` dist cpos) $ map f $ nRaysRad 8 400
+--        where f p = fromMaybe (ypos +.+ p) $ fmap fst
+--                        $ reflectPointWalls ypos (ypos +.+ p) (wallsAlongLine ypos (ypos +.+ p) w)
+--    retreatP' = cpos +.+ 300 *.* (cpos -.- ypos)
+--    retreatP'' = fromMaybe retreatP' $ fmap fst
+--                                     $ reflectPointWalls ypos retreatP' 
+--                                     $ wallsAlongLine ypos retreatP' w

src/Dodge/Creature/ActionRat.hs

@@ -1,15 +1,18 @@
 module Dodge.Creature.ActionRat
     ( shootTargetWithStrat
+    , aimThenShootStrat 
     , suppressShootTarget
     , suppress
     , shootAdvance
     , shootFirstMiss
     , doStrategyActions
     , reloadOverride
+    , reloadOverrideNoHolster
     , shootAdvanceStrat
     , watchUpdateStrat
     , goToPostStrat
     , overrideInternal
+    , fleeTime
     )
     where
 import Dodge.Data
@@ -63,16 +66,16 @@ suppress w cr tcr as
     | otherwise = as
 
 shootFirstMiss :: Int -> World -> Creature -> Strategy
-shootFirstMiss tcid w cr = StrategyActions acs (ShootAt tcid)
+shootFirstMiss tcid w cr = StrategyActions (ShootAt tcid) acs 
   where
     acs = 
         [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction))
           `DoActionThen`
-          LeadTarget (10,50)
+          LeadTarget (30,50)
           `DoActionThen`
           advanceShoot
           `DoActionThen`
-          LeadTarget (50,0)
+          LeadTarget (0,0)
           `DoActionThen`
           (advanceShoot `DoActionWhileThen` lostest
           $ DoReplicateThen advanceShoot 75
@@ -82,36 +85,59 @@ shootFirstMiss tcid w cr = StrategyActions acs (ShootAt tcid)
     lostest (w,cr') = canSee (_crID cr') tcid w 
     advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
     
+fleeTime :: Int -> World -> Creature -> Strategy
+fleeTime t w cr = StrategyActions Flee
+    [ UseTargetCID FleeFrom `DoReplicateThen` t
+            $ DoImpulses [ChangeStrategy WatchAndWait]
+    ]
+
+aimThenShootStrat :: Int -> World -> Creature -> Strategy
+aimThenShootStrat tcid _ _ = StrategyActions (ShootAt tcid)
+    [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction))
+      `DoActionThen`
+        50
+       `WaitThen` 
+        DoImpulses [UseItem, ChangeStrategy WatchAndWait]
+    , AimAtCloseSlow 
+        { _targetID = tcid
+        , _targetSeenAt = (0,0) -- hack
+        , _aimSpeed = 0.2
+        , _slowAimSpeed = 0.01
+        , _slowAimAngle = pi/8
+        }
+    ]
+  where
+    lostest (w,cr') = canSee (_crID cr') tcid w 
+    advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
 
 shootAdvanceStrat :: Int -> World -> Creature -> Strategy
-shootAdvanceStrat tcid _ _ = StrategyActions acs (ShootAt tcid)
+shootAdvanceStrat tcid _ _ = StrategyActions (ShootAt tcid)
+    [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction))
+      `DoActionThen`
+      (DoActionWhileThen advanceShoot lostest
+      . DoReplicateThen advanceShoot 75
+      $ DoImpulses [ChangeStrategy WatchAndWait]
+      )
+    , AimAtCloseSlow 
+        { _targetID = tcid
+        , _targetSeenAt = (0,0) -- hack
+        , _aimSpeed = 0.2
+        , _slowAimSpeed = 0.01
+        , _slowAimAngle = pi/8
+        }
+    ]
   where
-    acs = 
-        [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction))
-          `DoActionThen`
-          (DoActionWhileThen advanceShoot lostest
-          . DoReplicateThen advanceShoot 75
-          $ DoImpulses [ChangeStrategy WatchAndWait]
-          )
-        , AimAtCloseSlow 
-            { _targetID = tcid
-            , _targetSeenAt = (0,0) -- hack
-            , _aimSpeed = 0.2
-            , _slowAimSpeed = 0.01
-            , _slowAimAngle = pi/8
-            }
-        ]
     lostest (w,cr') = canSee (_crID cr') tcid w 
     advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
 
 goToPostStrat :: World -> Creature -> Strategy
 goToPostStrat w cr = case find sentinelGoal $ _crGoal $ _crActionPlan cr of
-    Just (SentinelAt p _) -> StrategyActions 
+    Just (SentinelAt p _) -> StrategyActions (GetTo p)
         [DoActionThen (WaitThen 150 holsterIfAiming)
             $ DoActionThen (PathTo p) 
             NoAction
        --     $ DoImpulses [ChangeStrategy WatchAndWait]
-        ] $ GetTo p 
+        ]
     _ -> WatchAndWait
   where
     sentinelGoal (SentinelAt p dir) = True
@@ -160,7 +186,7 @@ applyNewStrategies
     -> Creature
     -> Creature
 applyNewStrategies w cr = case cr ^? crActionPlan . crStrategy of
-    Just (StrategyActions acs strat) -> cr & crActionPlan . crAction .~ acs
+    Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs
         & crActionPlan . crStrategy .~ strat
     otherwise -> cr
 
@@ -169,7 +195,7 @@ doStrategyActions
     -> Creature
     -> Creature
 doStrategyActions w cr = case cr ^? crActionPlan . crStrategy of
-    Just (StrategyActions acs strat) -> cr & crActionPlan . crAction .~ acs
+    Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs
         & crActionPlan . crStrategy .~ strat
     otherwise -> cr
 
@@ -187,7 +213,7 @@ reloadOverride
 reloadOverride _ cr
     | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 
             && cr ^. crStance . posture == Aiming
-        = cr & crActionPlan . crStrategy .~ StrategyActions reloadActions Reload
+        = cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions
     | otherwise = cr
   where
     reloadActions = 
@@ -195,6 +221,20 @@ reloadOverride _ cr
         , WaitThen 1 $ DoActionWhileThen NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait])
         ]
 
+reloadOverrideNoHolster
+    :: World
+    -> Creature
+    -> Creature
+reloadOverrideNoHolster _ cr
+    | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 
+            && cr ^. crStance . posture == Aiming
+        = cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions
+    | otherwise = cr
+  where
+    reloadActions = 
+        [ DoActionWhileThen NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait])
+        ]
+
 watchUpdateStrat 
     :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ]
     -> World

src/Dodge/Creature/Inanimate.hs

@@ -28,6 +28,7 @@ lamp = defaultInanimate
     , _crHP = 100
     , _crPict = \ _ -> onLayer CrLayer $ color white $ circleSolid 3
     , _crRad = 3
+    , _crMass = 3
     }
 
 initialiseLamp :: CRUpdate
@@ -37,7 +38,20 @@ initialiseLamp w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLam
     addLS = over lightSources (IM.insert i (lightAt (_crPos cr) i))
 
 updateLamp :: Int -> CRUpdate
-updateLamp i = unrandUpdate handleLS internalUpdate
+updateLamp i w (f,g) cr = ((handleLS . f, g), internalUpdate)
+  where
+    handleLS w'
+        | _crHP cr < 0 = explosionFlashAt cPos 
+                        $ mkSoundBreakGlass cPos w' & lightSources %~ IM.delete i
+        | otherwise    = w' & lightSources . ix i . lsPos .~ cPos
+      where
+        cPos = _crPos cr
+    internalUpdate 
+        | _crHP cr < 0 = Nothing
+        | otherwise    = fmap doDamage $ Just cr
+
+updateLamp' :: Int -> CRUpdate
+updateLamp' i = unrandUpdate handleLS internalUpdate
   where
     handleLS cr w 
         | _crHP cr < 0 = explosionFlashAt cPos 

src/Dodge/Creature/Rationality.hs

@@ -147,6 +147,12 @@ performAction cr w ac = case ac of
         Just tcid -> let tcr = _creatures w IM.! tcid
             in ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
         _  -> ([], Nothing)
+    FleeFrom cid -> case w ^? creatures . ix cid of
+        Just tcr -> ([MoveForward 3, TurnToward ((2 *.* _crPos cr) -.- _crPos tcr) (pi/4)], Nothing)
+        _ -> ([], Nothing)
+    UseTargetCID f -> case cr ^? crTarget . _Just of
+        Just tcid -> performAction cr w (f tcid)
+        _ -> ([],Nothing)
     _ -> ([], Nothing)
   where
     cpos = _crPos cr 

src/Dodge/Creature/State.hs

@@ -79,22 +79,24 @@ dropByState cr w = foldr (copyItemToFloor cr) w is
 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.
 -}
 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) (take 20 . (dams :) )
+doDamage cr = set (crState . crDamage) [] 
-                                            damagedCr
+    $ over (crState . crPastDamage) (f . take 20 . (dams :) ) damagedCr
   where 
+    f l = seq (forceSpine l) l
     dams = _crDamage $ _crState cr
-    startHP = _crHP cr
     damagedCr = snd $ (_crApplyDamage cr) dams cr
-    afterHP = _crHP damagedCr
-    hpLost = startHP - afterHP  -- note this can be negative 
 
 sumDamage :: Creature -> DamageType -> Int -> Int
 sumDamage cr dm x = x + _dmAmount dm

src/Dodge/Creature/Test.hs

@@ -42,6 +42,11 @@ crHasTargetLOS (w,cr) = case cr ^? crTarget . _Just of
     Just i -> crCanSeeCID i (w,cr) 
     Nothing -> False
 
+crSafeDistFromTarg :: Float -> (World,Creature) -> Bool
+crSafeDistFromTarg d (w,cr) = case cr ^? crTarget . _Just of
+    Just i -> dist (_crPos cr) (_crPos $ _creatures w IM.! i) > d
+    Nothing -> True
+
 crStratConMatches :: Strategy -> (World,Creature) -> Bool
 crStratConMatches strat (_,cr) = eqConstr strat (_crStrategy $ _crActionPlan cr)
 

src/Dodge/Creature/Update.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 module Dodge.Creature.Update
   where
 import Dodge.Data
@@ -7,6 +8,9 @@ import System.Random
 
 type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
 
-unrandUpdate :: (Creature -> World -> World) -> (Creature -> Maybe Creature)
+unrandUpdate 
+    :: (Creature -> World -> World) 
+    -> (Creature -> Maybe Creature)
     -> CRUpdate
+{-# INLINE unrandUpdate #-}
 unrandUpdate h cF w (f,g) cr = ( ( h cr . f , g) , cF cr )

src/Dodge/Data.hs

@@ -478,6 +478,8 @@ data Impulse
     | AddGoal Goal
     | ArbitraryCreatureImpulse (World -> Creature -> Creature) 
 --  deriving (Eq,Ord,Show)
+infixr 9 `WaitThen`
+infixr 9 `DoActionThen`
 data Action
     = Attack 
         {_attackTargetID :: Int}
@@ -560,6 +562,9 @@ data Action
         }
     | NoAction
     | StartSentinelPost
+    | UseTargetCID
+        {_useTargetCID :: Int -> Action
+        }
   deriving (Generic)
 --  deriving (Eq,Ord,Show)
 data Strategy
@@ -570,9 +575,10 @@ data Strategy
     | ShootAt Int
     | FollowImpulses
     | WatchAndWait
-    | StrategyActions [Action] Strategy
+    | StrategyActions Strategy [Action]
     | GetTo Point2
     | Reload
+    | Flee
   deriving (Generic)
 --  deriving (Eq,Ord,Show)
 data Goal

src/Dodge/Render/Picture.hs

@@ -45,7 +45,10 @@ customMouseCursor w =
     $ pictures [ line [(-5,0),(5,0)] , line [(0,-5),(0,5)] ]
 
 testPic :: World -> [Picture]
-testPic w = [blank]
+testPic w = 
+    [ setDepth (-1) . translate 0 0.8
+        . scale 0.001 0.001 . text . show . length . IM.elems . IM.filter ( (== 3) . _crRad ) $ _creatures w
+    ]
 
 crDraw :: Creature -> Picture
 crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c)

src/Dodge/WallCreatureCollisions.hs

@@ -39,7 +39,7 @@ colCrWall w c
 -- -- probably best to push check pushing through walls before creature springs
 
 -- the amount to push creatures out from walls, extra to their radius
-wallBuffer = 3
+wallBuffer = 0
 
 -- the following tests whether or not a point is on a wall, and if so pushes it
 -- out from the wall
@@ -49,7 +49,7 @@ collideWalls rad cp1 walls cp2 = case (listToMaybe.mapMaybe (pushOutFromWall rad
     Nothing -> cp2
     Just cp3 -> case (listToMaybe.reverse.mapMaybe (pushOutFromWall rad cp3)) walls of
         Nothing -> cp3
-        Just cp4 -> cp1
+        Just cp4 -> 0.5 *.* (cp4 +.+ cp1)
 
 -- pushes a point out from a list of walls
 -- if multiple new points occur, chooses the one closest to the orignal point