Refactor launcherCrit ai

src/Dodge/AIs.hs

@@ -430,207 +430,6 @@ chargeAI w (f,g) cr =
                                         _      -> ( (f , g') , replaceImpulse [] cr            )
         (Init:_) -> ((f,g), replaceImpulse [] cr)
 
-launcherAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
-launcherAI inRange outRange w (f,g) cr = 
-    let cpos = _crPos cr
-        cid  = _crID cr
-        ypos = _crPos $ you w
-        yposl x = ypos -.- x *.* (vNormal $ normalizeV $ ypos -.- cpos)
-        yposr x = ypos +.+ x *.* (vNormal $ normalizeV $ ypos -.- cpos)
-        (aimtime,g') = randomR (80,120) g
-        (recupTime,_) = randomR (0,50) g
-        wp = _crInv cr IM.! _crInvSel cr
-        noAmmo = 0 == _wpLoadedAmmo wp || _wpReloadState wp /= 0
-        updateSearch = over (crState . goals) f
-            where f (g:_:h:gs) = (g:[PathTo ypos]:h:gs)
-                  f (g:gs) = (g:[PathTo ypos]:gs)
-        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)
-        ts = take 3 $ randomRs (20,25) g
-        retreatActions = SetPosture Aiming 
-                        : Fire
-                        : TurnByFor 0.16 20
-                        : SetPosture AtEase
-                        : MoveByFor (3,0) 18
-                        : SetPosture Aiming
-                        : Fire
-                        : TurnByFor (-0.16) 20
-                        : SetPosture AtEase
-                        : MoveByFor (3,0) 10
-                        : TurnToward ypos
-                        -- : WaitFor 12
-                        -- : Fire
-                        -- : WaitFor 20
-                        : SetPosture Aiming
-                        : Fire
-                        : WaitFor 60
-                        : [SetPosture AtEase]
-        strafeLeftActions = TurnToward (yposr 30) 
-                                : SetPosture Aiming
-                                : (concatMap (\t -> [Fire,MoveByFor (0,3) t]) ts)
-                                    ++ [SetPosture AtEase]
-        strafeRightActions = TurnToward (yposl 30) 
-                                : SetPosture Aiming
-                                : (concatMap (\t -> [Fire,MoveByFor (0,-3) t]) ts)
-                                    ++ [SetPosture AtEase]
-        rota a = cpos +.+ rotateV a (ypos -.- cpos)
-        (a2:a3:a4:a5:_) = evalState (takeOne [[0.1,0.15,0.5,1.5]
-                                             --,[0.1,0.15,0.5,1.5]
-                                            -- ,[0.2,0.3,0.6,1]
-                                            -- ,[0.2,0.3,0.5,0.8]
-                                            -- ,[0.2,0.3,0.5,1]
-                                            -- ,[0.1,0.2,0.5,0.9]
-                                            -- ,[0.1,0.2,0.4,0.7]
-                                            -- ,[0.1,0.2,0.3,0.4]
-                                             ]
-                                    ) g
-        curveLeft = TurnToward (rota $ negate a2)
-                        : SetPosture Aiming
-                        : Fire
-                        : TurnToward (rota $ negate a3)
-                        : WaitFor 20
-                        : Fire
-                        : TurnToward (rota $ negate a4)
-                        : WaitFor 20
-                        : Fire
-                        : TurnToward (rota $ negate a5)
-                        : SetPosture AtEase
-                        : [MoveByFor (-3,0) 40]
-        curveRight = TurnToward (rota a2)
-                        : SetPosture Aiming
-                        : Fire
-                        : TurnToward (rota a3)
-                        : WaitFor 20
-                        : Fire
-                        : TurnToward (rota a4)
-                        : WaitFor 20
-                        : Fire
-                        : TurnToward (rota a5)
-                        : SetPosture AtEase
-                        : [MoveByFor (-3,0) 40]
-        strafeProb :: Float
-        strafeProb | dist cpos ypos > 350 = 40
-                   | otherwise            = 10
-        retreatProb | dist cpos ypos < 100 = 80
-                    | dist cpos ypos < 200 = 40
-                    | otherwise = 0
-        curveLeftProb = 20
-        curveRightProb = 20
-                   --  | dist cpos ypos < 200 = 1
-                   --  | otherwise            = 0
-        fireActions = -- TurnToward ypos : 
-                       (evalState (takeOneWeighted 
-                                           [curveLeftProb,curveRightProb
-                                           ,strafeProb,strafeProb,retreatProb] 
-                                           [curveLeft
-                                           ,curveRight
-                                           ,strafeLeftActions
-                                           ,strafeRightActions
-                                           ,retreatActions
-                                           ]
-                                  ) $ g
-                       )
-    in  --if _crHP cr <= 0 then killCr w f cr else
-    case head $ _goals $ _crState cr of
-        (TurnTo p:_) -> ( (f,g') , replaceImpulse [] . crTurnTo p $ cr)
-        (TurnByFor a 0:_) -> ( (f,g') , replaceImpulse [] . over crDir (+a) $ cr)
-        (TurnByFor a i:_) -> ( (f,g') , replaceImpulse [TurnByFor a (i-1)] . over crDir (+a) $ cr)
-        (SetPosture pture:_) -> ((f,g), replaceImpulse [] $ set (crStance . posture) pture cr)
-        (MoveByFor p 0:_) -> ((f,g'), replaceImpulse [] . crMvBy p $ cr)
-        (MoveByFor p i:_) -> ((f,g'), replaceImpulse [MoveByFor p (i-1)] . crMvBy p $ cr)
-        (Fire:_) | pointHitsWalls cpos (cpos +.+ 40 *.* unitVectorAtAngle (_crDir cr)) 
-                      (wallsAlongLine cpos (cpos +.+ 40 *.* unitVectorAtAngle (_crDir cr)) w) 
-                              -> ((f,g),replaceImpulse [] cr)
-                 | otherwise -> ((tryUseItem cid . f,g'), replaceImpulse [] cr)
-        (ImpulseID i (MoveByFor p 0):_) -> ((f,g'), replaceImpulse [] . crMvBy p $ cr)
-        (ImpulseID i (MoveByFor p x):_) 
-                | canSeeFire cpos (aCrPos i w) w
-                    -> ( (f,g')
-                       , replaceImpulse [ImpulseID i (MoveByFor p (x-1))] 
-                         . crMvBy p
-                         . crTurnTowardSpeed 0.01 (aCrPos i w)
-                         $ cr
-                       )
-                | otherwise
-                    -> ( (f,g')
-                       , replaceImpulse [ImpulseID i (MoveForwardFor (x-1))] 
-                         . crMvBy p
-                         $ cr
-                       )
-        (TurnToward p:_) 
-            | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 2
-                -> ( (f,g')
-                   , Just . crTurnTowardSpeed 0.5 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
-                   )
-        [] | noAmmo -> ( (tryUseItem cid . f, g')
-                       , addImpulse [Reload] cr
-                       )
-           | canSeeFireVisionAny cid (_yourID w) w 
-                -> ( ( f , g' ) 
-                  -- , addImpulse (WaitFor 9:fireActions) 
-                   , addImpulse (WaitFor 9:fireActions) 
-                        $ updateSearch cr
-                   )
-           | otherwise              -> ( ( f , g' )
-                                       , replaceGoal [] cr
-                                       )
-        (WaitFor x:gls)| x == 0    -> ( (f ,g' ),  replaceImpulse [] cr )
-                       | otherwise -> ( (f ,g' ),  replaceImpulse [WaitFor (x-1)] cr )
-        (MoveToFor p x:gls) 
-                       | canSeeFire cpos ypos w -> ( (f , g') 
-                                                   , replaceGoal [[],[PathTo ypos]] cr
-                                                   )
-                       | 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.05 p cr  )
-                       | otherwise -> ( (f , g')
-                                      , replaceImpulse [MoveToFor p (x-1)] $ crMvForward 2 
-                                                                          $ crTurnTowardSpeed 0.05 p cr )
-        (PathTo p:_)   | dist p cpos < 10 -> ( (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            )
-        (Reload:_)   | _wpReloadState wp == 0 -> ( (f , g') , replaceImpulse [WaitFor recupTime] cr )
-                     | canSeeFireVisionAny cid (_yourID w) w 
-                          -> ( (f , g')
-                             , Just $ 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 [[WaitFor aimtime],[PathTo ypos]] 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)
-        (Init :_) -> ( (f,g')
-                          ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr
-                          )
 dodgeAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
 dodgeAI inRange outRange w (f,g) cr = 
     let cpos = _crPos cr

src/Dodge/Creature.hs

@@ -1,6 +1,7 @@
 module Dodge.Creature 
     ( module Dodge.Creature
     , module Dodge.Creature.Inanimate
+    , launcherCrit
     )
   where
 import Dodge.Creature.Stance.Data
@@ -12,6 +13,7 @@ import Dodge.Creature.Rationality.Data
 import Dodge.Creature.AlertLevel
 import Dodge.Creature.SetTarget
 import Dodge.Creature.Test
+import Dodge.Creature.LauncherCrit
 import Dodge.Data
 import Dodge.AIs
 import Dodge.Default
@@ -167,16 +169,6 @@ multGunCrit = defaultCreature
         , _crGoal       = []
         }
     }
-launcherCrit :: Creature
-launcherCrit = defaultCreature
-    { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate (launcherAI 150 200)
-    , _crInv = IM.fromList [(0,launcher)]
-    , _crInvSel = 0
-    , _crRad = 10
-    , _crState = defaultState {_goals = [[Init]]}
-    , _crHP = 300
-    }
 spreadGunCrit :: Creature
 spreadGunCrit = defaultCreature
     { _crPict = basicCrPict red

src/Dodge/Creature/ActionRat.hs

@@ -9,6 +9,7 @@ module Dodge.Creature.ActionRat
     , reloadOverride
     , reloadOverrideNoHolster
     , shootAdvanceStrat
+    , shootMoveStrat
     , watchUpdateStrat
     , goToPostStrat
     , overrideInternal
@@ -110,6 +111,26 @@ aimThenShootStrat tcid _ _ = StrategyActions (ShootAt tcid)
     lostest (w,cr') = canSee (_crID cr') tcid w 
     advanceShoot = ImpulsesList [[UseItem, MoveForward 3]]
 
+shootMoveStrat :: Point2 -> Int -> World -> Creature -> Strategy
+shootMoveStrat moveV 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
+    lostest (w,cr') = canSee (_crID cr') tcid w 
+    advanceShoot = ImpulsesList [[UseItem, Move moveV]]
+
 shootAdvanceStrat :: Int -> World -> Creature -> Strategy
 shootAdvanceStrat tcid _ _ = StrategyActions (ShootAt tcid)
     [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction))

src/Dodge/Creature/Inanimate.hs

@@ -38,20 +38,7 @@ 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 w (f,g) cr = ((handleLS . f, g), internalUpdate)
+updateLamp i = unrandUpdate handleLS 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 
@@ -63,7 +50,6 @@ updateLamp' i = unrandUpdate handleLS internalUpdate
         | _crHP cr < 0 = Nothing
         | otherwise    = Just $ doDamage cr
 
-
 barrel :: Creature
 barrel = defaultInanimate
     { _crUpdate = updateBarrel

src/Dodge/Creature/LauncherCrit.hs

@@ -0,0 +1,82 @@
+module Dodge.Creature.LauncherCrit
+    ( launcherCrit
+    )
+    where
+import Dodge.Data
+import Dodge.Default
+import Dodge.Creature.Picture
+import Dodge.Creature.Test
+import Dodge.Creature.ActionRat
+import Dodge.Creature.ChooseTarget
+import Dodge.Creature.SetTarget
+import Dodge.Creature.Rationality
+import Dodge.Creature.AlertLevel
+import Dodge.Creature.State
+import Dodge.Creature.State.Data
+import Dodge.Item.Weapon
+import Dodge.Item.Consumable
+import Geometry
+import Picture
+
+import qualified Data.IntMap.Strict as IM
+import Control.Lens
+
+launcherCrit :: Creature
+launcherCrit = defaultCreature
+    { _crPict = basicCrPict red
+    , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
+        [ performActions
+        , watchUpdateStrat
+--            [ (crHasTargetLOS, shootMoveStrat (0,3) 0)
+            [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire])
+            , (crAwayFromPost, goToPostStrat)
+            ]
+        , basicPerceptionUpdate [0]
+        , doStrategyActions
+        , reloadOverride
+        , targetYouWhenCognizant
+        , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+            $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait
+        ]
+    , _crActionPlan = ActionPlan
+        { _crImpulse    = []
+        , _crAction     = []
+        , _crStrategy   = StrategyActions WatchAndWait [StartSentinelPost]
+        , _crGoal       = []
+        }
+    , _crInv = IM.fromList [(0,launcher)]
+    , _crInvSel = 0
+    , _crRad = 10
+    , _crState = defaultState
+    , _crHP = 300
+    }
+
+retreatFire :: Action
+retreatFire = ImpulsesList ( [ [ UseItem ] ] ++ replicate 20 [ Turn 0.16 ])
+    `DoActionThen`
+    HolsterWeapon
+    `DoActionThen`
+    ImpulsesList ( replicate 30 [ MoveForward 3 ])
+    `DoActionThen`
+    DrawWeapon
+    `DoActionThen`
+    ImpulsesList ( [[UseItem]] ++ replicate 20 [ Turn $ negate 0.16 ] )
+    `DoActionThen`
+    HolsterWeapon
+    `DoActionThen`
+    ImpulsesList ( replicate 15 [ MoveForward 3 ] )
+    `DoActionThen`
+    DrawWeapon
+    `DoActionThen`
+    ImpulsesList (
+    replicate 100 [UseItem, ImpulseUseTarget $ \tcr -> TurnToward (_crPos tcr) (pi/16) ] )
+    `DoActionThen`
+    20
+    `WaitThen`
+    HolsterWeapon
+    `DoActionThen`
+    ImpulsesList ( replicate 15 [ MoveForward 3 ] )
+    `DoActionThen`
+    DoImpulses [ChangeStrategy WatchAndWait]
+    
+    

src/Dodge/Creature/Rationality.hs

@@ -40,18 +40,18 @@ followImpulses
 followImpulses w (f,g) cr
     = (\(f''' ,cr) -> ((f''',g'),Just cr))
     $ foldr 
-        (\imp (f' , cr') -> let (f'', cr'') = followImpulse imp w cr' in (f'' . f', cr''))
+        (\imp (f' , cr') -> let (f'', cr'') = followImpulse cr' w imp in (f'' . f', cr''))
         (f, cr) 
         (_crImpulse $ _crActionPlan cr)
   where
     g' = snd $ next g
 
 followImpulse
-    :: Impulse
+    :: Creature
     -> World
-    -> Creature
+    -> Impulse
     -> (World -> World , Creature)
-followImpulse imp w cr = case imp of
+followImpulse cr w imp = case imp of
     Move p  -> (id, crMvBy p cr)
     MoveForward x  -> (id, crMvForward x cr)
     Turn a  -> (id, creatureTurn a cr)
@@ -69,6 +69,13 @@ followImpulse imp w cr = case imp of
     ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat)
     AddGoal gl -> (id, cr & crActionPlan . crGoal %~ (gl :) )
     ArbitraryCreatureImpulse f -> (id, f w cr)
+    ImpulseUseTargetCID f -> case cr ^? crTarget . _Just of
+        Just tcid -> followImpulse cr w (f tcid)
+        _ -> (id,cr)
+    ImpulseUseTarget f -> case cr ^? crTarget . _Just of
+        Just tcid -> followImpulse cr w (f $ _creatures w IM.! tcid)
+        _ -> (id,cr)
+    ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
     _ -> (id , cr)
   where
     cpos = _crPos cr
@@ -153,6 +160,7 @@ performAction cr w ac = case ac of
     UseTargetCID f -> case cr ^? crTarget . _Just of
         Just tcid -> performAction cr w (f tcid)
         _ -> ([],Nothing)
+    UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
     _ -> ([], Nothing)
   where
     cpos = _crPos cr 

src/Dodge/Creature/State.hs

@@ -86,7 +86,7 @@ velocity to carry across frames.
 crFriction :: Creature -> Point2 -> Point2
 crFriction cr vel = (0,0)
 
-{- | In order to force a list, apply with seq -}
+{- | In order to force a list, apply with seq. -}
 forceSpine :: [a] -> ()
 forceSpine = foldr (const id) ()
 

src/Dodge/Data.hs

@@ -477,6 +477,15 @@ data Impulse
     | ChangeStrategy Strategy
     | AddGoal Goal
     | ArbitraryCreatureImpulse (World -> Creature -> Creature) 
+    | ImpulseUseTargetCID
+        {_impulseUseTargetCID :: Int -> Impulse
+        }
+    | ImpulseUseTarget
+        {_impulseUseTarget :: Creature -> Impulse
+        }
+    | ImpulseUseAheadPos
+        {_impulseUseAheadPos :: Point2 -> Impulse
+        }
 --  deriving (Eq,Ord,Show)
 infixr 9 `WaitThen`
 infixr 9 `DoActionThen`
@@ -565,6 +574,9 @@ data Action
     | UseTargetCID
         {_useTargetCID :: Int -> Action
         }
+    | UseAheadPos
+        {_useAheadPos :: Point2 -> Action
+        }
   deriving (Generic)
 --  deriving (Eq,Ord,Show)
 data Strategy

src/Dodge/Floor.hs

@@ -50,7 +50,7 @@ roomTreex = do
             [[StartRoom]
             ,[Corridor]
             ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
-                                                 & rmPS %~ (PS (0,-300) 0 (PutCrit multGunCrit) :)
+                                                 & rmPS %~ (PS (0,200) 0 (PutCrit launcherCrit) :)
              ]
             ,[Corridor]
             ,[Corridor]

src/Dodge/Item/Weapon.hs

@@ -711,7 +711,7 @@ moveShell time i cid rot accel w
     hitWl    = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
     thingHit = hitCr <|> hitWl
     spin   = case w ^? creatures . ix cid of
-        Just cr -> min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20
+        Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20
         _ -> 0
     r1 = randInCirc 10 & evalState $ _randGen w
     smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))