Start ai cleanup

src/Dodge/Creature/Action.hs

@@ -1,15 +1,12 @@
 {- | Actions performed by creatures within the world
  -}
 module Dodge.Creature.Action 
-    ( module Dodge.Creature.Action
-    , module Dodge.Creature.Action.UseItem
-    , module Dodge.Creature.Action.Movement
-    )
+--    ( module Dodge.Creature.Action
+--    , module Dodge.Creature.Action.UseItem
+--    , module Dodge.Creature.Action.Movement
+--    )
     where
-import Dodge.Creature.Action.UseItem
-import Dodge.Creature.Action.Movement
 import Dodge.Creature.Stance.Data
---import Dodge.Creature.State.Data
 import Dodge.WorldEvent.Shockwave
 import Dodge.Data
 import Dodge.Base
@@ -30,7 +27,89 @@ import Control.Lens
 import Data.Maybe
 --import Data.List
 import System.Random
+import Control.Monad.Reader
 --import qualified Data.Map as M
+performActions :: World -> Creature -> Creature
+performActions w cr = cr
+    & crActionPlan . crImpulse .~ concat iss
+    & crActionPlan . crAction .~ catMaybes mayas
+  where
+    (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction
+
+performActionsR :: Creature -> Reader World Creature
+performActionsR cr = reader $ \w -> performActions w cr
+
+{- | Performing an action means that a creature has some impulses for a frame, and
+ updates or deletes the action itself. 
+-- doAction -}
+performAction 
+    :: Creature
+    -> World
+    -> Action
+    -> ( [Impulse] , Maybe Action )
+performAction cr w ac = case ac of
+    AimAt tcid p
+        -> ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
+      where
+        canSee' = canSee (_crID cr) tcid w
+        aimSp = case cr ^? crMvType . mvAimSpeed of
+            Just f -> f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
+            Nothing -> error "creature without aiming type"
+        tpos | canSee' = _crPos (_creatures w IM.! tcid)
+             | otherwise = p
+    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)
+    DoActionThen fsta afta -> case performAction cr w fsta of
+        (imps , Just nxta) -> (imps, Just (DoActionThen nxta afta))
+        (imps , Nothing  ) -> (imps, Just afta)
+    DoActionWhile f act -> performAction cr w $ DoActionWhilePartial act f act
+    DoActionWhilePartial partAc f resetAc
+        | f (w,cr) -> case performAction cr w partAc of
+            (imps, Just nxta) -> (imps, Just $ DoActionWhilePartial nxta f resetAc)
+            (imps, Nothing)   -> (imps, Just $ DoActionWhilePartial resetAc f resetAc)
+        | otherwise -> performAction cr w partAc
+    DoActionIf f ifa
+        | f (w,cr) -> performAction cr w ifa
+        | otherwise -> ([],Nothing)
+    DoActionIfElse ifa f elsea
+        | f (w,cr)  -> performAction cr w ifa
+        | otherwise -> performAction cr w elsea
+    DoActionWhileInterrupt repa f afta
+        | f (w,cr)  -> (fst $ performAction cr w repa, Just $ DoActionWhileInterrupt repa f afta)
+        | otherwise -> performAction cr w afta
+    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 -> ([MvTurnToward p,MvForward] , Just (PathTo p))
+        | otherwise       -> ([], Nothing)
+    LeadTarget p -> case cr ^? crTarget . _Just of
+        Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing)
+        _        -> ([], Nothing)
+    UseTarget f -> performAction cr w $ f $ cr ^? crTarget . _Just
+    UseSelf f   -> performAction cr w $ f cr
+    UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
+    UseMvTargetPos f -> performAction cr w $ f $ _crMvTarget cr
+    ArbitraryAction f -> performAction cr w (f cr w)
+    DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
+        (imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac)
+        (imp, _)          -> (sideImp ++ imp, Nothing)
+    DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
+    DoReplicatePartial _   0 pac -> performAction cr w pac
+    DoReplicatePartial sac t pac -> case performAction cr w pac of
+        (imps , Just nac) -> (imps, Just $ DoReplicatePartial sac t nac)
+        (imps , _)        -> (imps, Just $ DoReplicatePartial sac (t-1) sac)
+    NoAction -> ([],Nothing)
+--    _ -> ([], Nothing)
+  where
+    cpos = _crPos cr 
+    cdir = _crDir cr
 
 startReloadingWeapon 
     :: Creature