Add file, fix lamp doDamage space leak

2021-05-12 20:48:55 +02:00
parent ead87af3c1
commit 9b3fbba393
13 changed files with 165 additions and 226 deletions
@@ -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
@@ -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)]
@@ -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
@@ -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
@@ -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
@@ -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 
@@ -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 
@@ -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 :) )
-                                            damagedCr
+doDamage cr = set (crState . crDamage) [] 
+    $ 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
@@ -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)

@@ -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 )
@@ -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
@@ -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)
@@ -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