Refactor ai

src/Dodge/Creature/Rationality.hs

@@ -6,6 +6,7 @@ import Dodge.Creature.Rationality.Data
 import Dodge.Creature.Action
 import Dodge.Creature.Action.UseItem
 import Dodge.Creature.State.Data
+import Dodge.Creature.Stance.Data
 import Dodge.SoundLogic
 import Geometry
 
@@ -14,6 +15,8 @@ import qualified Data.IntMap.Strict as IM
 import System.Random
 import Control.Lens
 
+-- Alternatives would probably be a very good fit for actions...
+
 composeInternalAIs 
     :: [World -> Creature -> Creature]
     -> World
@@ -39,7 +42,7 @@ followImpulses w (f,g) cr
     $ foldr 
         (\imp (f' , cr') -> let (f'', cr'') = followImpulse imp w cr' in (f'' . f', cr''))
         (f, cr) 
-        (_crImpulse $ _crRationality cr)
+        (_crImpulse $ _crActionPlan cr)
   where
     g' = snd $ next g
 
@@ -53,14 +56,20 @@ followImpulse imp w cr = case imp of
     MoveForward x  -> (id, crMvForward x cr)
     Turn a  -> (id, creatureTurn a cr)
     TurnToward p a -> (id, creatureTurnToward p a cr)
---    UseItem -> (crUseItem cr, cr)
+    TurnTo p -> (id, creatureTurnTo p cr)
+    ChangePosture post -> (id, cr & crStance . posture .~ post)
+    UseItem -> (crUseItem cr, cr)
     SwitchToItem i -> (id, cr & crInvSel .~ i)
     Melee crID -> 
         (hitCr crID
         , crMvBy (10 *.* normalizeV (posFromID crID -.- cpos)) $ cr & crMeleeCooldown ?~ 20) -- randomise cooldown?
     RandomTurn a -> (id, creatureTurn (rr a) cr)
-    _ -> (id , cr)
+    MakeSound sid -> ( soundOnceOrigin sid (CrSound (_crID cr)) (_crPos cr) , cr )
     DropItem -> undefined
+    ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat)
+    AddGoal gl -> (id, cr & crActionPlan . crGoal %~ (gl :) )
+    ArbitraryCreatureImpulse f -> (id, f w cr)
+    _ -> (id , cr)
   where
     cpos = _crPos cr
     posFromID cid = _crPos $ _creatures w IM.! cid
@@ -78,10 +87,10 @@ actionUpdateAI actF w c = performActions w $ actF w c
 
 performActions :: World -> Creature -> Creature
 performActions w cr = cr
-    & crRationality . crImpulse .~ concat iss
-    & crRationality . crAction .~ catMaybes mayas
+    & crActionPlan . crImpulse .~ concat iss
+    & crActionPlan . crAction .~ catMaybes mayas
   where
-    (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crRationality . crAction
+    (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction
 
 {- | Performing an action means that a creature has some impulses for a frame, and
  updates or deletes the action itself. -}
@@ -91,9 +100,9 @@ performAction
     -> Action
     -> ( [Impulse] , Maybe Action )
 performAction cr w ac = case ac of
-    ShootTillEmpty -> case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
-        Just x | x > 0  -> ( [UseItem] , Just ShootTillEmpty )
-        _               -> ( []        , Nothing )
+    ShootTillEmpty -> case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
+        Just x | x == 0  -> ( [UseItem] , Just ShootTillEmpty )
+        _                -> ( []        , Just (WaitThen 20 HolsterWeapon) )
     AimAtCloseSlow tcid p speed slowSpeed a
         | canSee (_crID cr) tcid w && safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a 
             -> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
@@ -104,9 +113,41 @@ performAction cr w ac = case ac of
         | otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
       where
         tpos = _crPos (_creatures w IM.! tcid)
+    WaitThen 0 newAc -> ([] , Just newAc)
+    WaitThen t newAc -> ([] , Just (WaitThen (t-1) newAc))
     ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss)
     ImpulsesList _  -> ([], Nothing)
+    DoImpulses imps -> (imps, Nothing)
+    DrawWeapon -> ([ChangePosture Aiming, MakeSound pickUpSound] , Nothing)
+    HolsterWeapon -> ([ChangePosture AtEase, MakeSound putDownSound] , Nothing)
+    DoActionThen ac ac' -> case performAction cr w ac of
+        (imps , Just ac'') -> (imps, Just (DoActionThen ac'' ac'))
+        (imps , Nothing  ) -> (imps, Just ac')
+    DoActionWhile ac f 
+        | f (w,cr) -> (fst $ performAction cr w ac, Just $ DoActionWhile ac f)
+        | otherwise -> ([], Nothing)               
+    DoActionIfElse ac f ac'
+        | f (w,cr)      -> performAction cr w ac
+        | otherwise -> performAction cr w ac'
+    DoActionWhileThen ac f ac'
+        | f (w,cr)       -> (fst $ performAction cr w ac, Just $ DoActionWhileThen ac f ac')
+        | otherwise -> performAction cr w ac'
+    DoReplicateThen ac 0 ac' -> performAction cr w ac'
+    DoReplicateThen ac t ac' -> (fst $ performAction cr w ac, Just $ DoReplicateThen ac (t-1) ac')
+    DoActions [] -> ([], Nothing)
+    DoActions acs -> 
+        let (imps, newAcs) = unzip $ map (performAction cr w) acs
+        in (concat imps, Just . DoActions $ catMaybes newAcs)
+    StartSentinelPost -> ([AddGoal $ SentinelAt (_crPos cr) (_crDir cr)], Nothing)
+    PathTo p
+        | dist cpos p < 5 -> ([], Nothing)
+        | hasLOS cpos p w -> ([TurnToward p (pi/4),MoveForward 3] , Just (PathTo p))
+        | otherwise -> ([], Nothing)
+    LeadTarget p -> case cr ^? crTarget . _Just of
+        Just tcid -> let tcr = _creatures w IM.! tcid
+            in ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
+        _  -> ([], Nothing)
+    _ -> ([], Nothing)
   where
     cpos = _crPos cr 
     cdir = _crDir cr
-