Refactor, try to limit dependencies

2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
@@ -1,31 +1,32 @@
-{- | Functions updating a creature in a Reader World environment -}
-module Dodge.Creature.ReaderUpdate
-    ( doStrategyActions
-    , setTargetMv
-    , targetYouWhenCognizant
-    , overrideMeleeCloseTarget
-    , watchUpdateStrat
-    , reloadOverride
-    , overrideInternal
-    , searchIfDamaged
-    , goToTarget
-    , flockACC
-    , chaseCritMv
-    , setMvPos
-    , setViewPos
-    ) where
+-- | Functions updating a creature in a Reader World environment
+module Dodge.Creature.ReaderUpdate (
+    doStrategyActions,
+    setTargetMv,
+    targetYouWhenCognizant,
+    overrideMeleeCloseTarget,
+    watchUpdateStrat,
+    reloadOverride,
+    overrideInternal,
+    searchIfDamaged,
+    goToTarget,
+    flockACC,
+    chaseCritMv,
+    setMvPos,
+    setViewPos,
+) where
+
+import Control.Applicative
+import Control.Lens
+import Data.Bifunctor
+import Data.Maybe
+import Dodge.Base
+import Dodge.Creature.Volition
+import Dodge.Data.CreatureEffect
+import Dodge.Data.World
 import Dodge.Zoning.Creature
 import FoldableHelp
-import Dodge.Data
-import Dodge.Creature.Volition
-import Dodge.Base
 import Geometry
-
 import qualified IntMapHelp as IM
-import Control.Lens
-import Control.Applicative
-import Data.Maybe
-import Data.Bifunctor

 overrideMeleeCloseTarget :: Creature -> Creature
 overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
@@ -33,9 +34,9 @@ overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crInten
 tryMeleeAttack :: Creature -> Creature -> Creature
 tryMeleeAttack cr tcr
    | _crMeleeCooldown cr == 0
-        && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5 
-        && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4
-                = cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr]
+        && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5
+        && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi / 4 =
+        cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr]
    | otherwise = cr
  where
    cpos = _crPos cr
@@ -49,8 +50,10 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
        if hasLOSIndirect (_crPos cr) tpos w
            then Just tpos
            else Nothing
-    mpos = mtpos 
-        <|> _mvToPoint int 
+    mpos =
+        mtpos
+            <|> _mvToPoint int
+
 --        <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)

 setViewPos :: Creature -> Creature
@@ -58,44 +61,54 @@ setViewPos cr = cr & crIntention . viewPoint %~ (<|> mpos)
  where
    mpos = listToMaybe (_soundsToInvestigate $ _crMemory cr)

-setTargetMv :: (World -> Creature -> Maybe Creature)    -- ^ Function for determining target
-    -> World -> Creature -> Creature 
-setTargetMv targFunc w cr = maybe 
-    cr 
-    (\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg)
-    (targFunc w cr)
+setTargetMv ::
+    -- | Function for determining target
+    (World -> Creature -> Maybe Creature) ->
+    World ->
+    Creature ->
+    Creature
+setTargetMv targFunc w cr =
+    maybe
+        cr
+        (\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg)
+        (targFunc w cr)

 -- ugly
 flockACC :: World -> Creature -> Creature
 flockACC w cr = case cr ^? crIntention . targetCr . _Just of
    Nothing -> cr
-    Just tcr -> 
+    Just tcr ->
        let tpos = _crPos tcr
            cpos = _crPos cr
-            isFarACC cr' = _crGroup cr' == _crGroup cr 
-                && _crID cr' /= _crID cr
-                && dist (_crPos cr') tpos > dist cpos tpos
-            macr = safeMinimumOn (dist cpos . _crPos) 
-                . filter isFarACC 
-                $ crsNearCirc cpos 50 w
-            in case macr of
-                Nothing  -> cr
+            isFarACC cr' =
+                _crGroup cr' == _crGroup cr
+                    && _crID cr' /= _crID cr
+                    && dist (_crPos cr') tpos > dist cpos tpos
+            macr =
+                safeMinimumOn (dist cpos . _crPos)
+                    . filter isFarACC
+                    $ crsNearCirc cpos 50 w
+         in case macr of
+                Nothing -> cr
                Just acr ->
                    let r = _crRad acr + _crRad cr + 10
                        horDir = normalizeV (vNormal (cpos -.- tpos))
-                        horShift = if isLHS tpos cpos (_crPos acr)
-                            then r *.* horDir
-                            else negate r *.* horDir
-                    in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
+                        horShift =
+                            if isLHS tpos cpos (_crPos acr)
+                                then r *.* horDir
+                                else negate r *.* horDir
+                     in cr & crIntention . mvToPoint ?~ tpos +.+ horShift

 chaseCritMv :: World -> Creature -> Creature
 chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
    StrategyActions _ _ -> cr
    WarningCry -> cr
    _ -> case cr ^? crIntention . mvToPoint . _Just of
-        Just p | dist (_crPos cr) p > _crRad cr -> cr & crActionPlan . apAction .~ [PathTo p]
-            | otherwise -> cr & crActionPlan . apAction .~ [bfsThenReturn 500]
-                & crIntention . mvToPoint .~ Nothing
+        Just p
+            | dist (_crPos cr) p > _crRad cr -> cr & crActionPlan . apAction .~ [PathTo p]
+            | otherwise ->
+                cr & crActionPlan . apAction .~ [bfsThenReturn 500]
+                    & crIntention . mvToPoint .~ Nothing
        _ -> viewTarget w cr

 goToTarget :: World -> Creature -> Creature
@@ -105,45 +118,51 @@ goToTarget w cr =
        _ -> viewTarget w cr

 lookAroundSelf :: Action
-lookAroundSelf = UseSelf CrTurnAround -- $ \cr -> TurnToPoint (_crPos cr -.- 10 *.* unitVectorAtAngle (_crDir cr))
+lookAroundSelf = UseSelf CrTurnAround

 viewTarget :: World -> Creature -> Creature
 viewTarget w cr = do
    case cr ^? crIntention . viewPoint . _Just of
-        Just p | hasLOSIndirect p (_crPos cr) w -> cr'
-                    & crActionPlan . apAction %~ replaceNullWith 
-                        (TurnToPoint p 
-                            `DoActionThen` 40 `WaitThen` lookAroundSelf
-                            `DoActionThen` 20 `WaitThen` lookAroundSelf
-                        )
+        Just p
+            | hasLOSIndirect p (_crPos cr) w ->
+                cr'
+                    & crActionPlan . apAction
+                        %~ replaceNullWith
+                            ( TurnToPoint p
+                                `DoActionThen` 40 `WaitThen` lookAroundSelf
+                                `DoActionThen` 20 `WaitThen` lookAroundSelf
+                            )
                    & crIntention . viewPoint .~ Nothing
-               | otherwise -> cr' & crActionPlan . apAction %~ replaceNullWith (PathTo p)
-        Nothing -> cr-- & crPerception . crAwakeLevel .~ Lethargic
+            | otherwise -> cr' & crActionPlan . apAction %~ replaceNullWith (PathTo p)
+        Nothing -> cr -- & crPerception . crAwakeLevel .~ Lethargic
  where
    cr' = cr & crPerception . cpVigilance .~ Vigilant

 replaceNullWith :: a -> [a] -> [a]
 replaceNullWith x [] = [x]
 replaceNullWith _ xs = xs
-    
+
 doStrategyActions :: Creature -> Creature
 doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
-    Just (StrategyActions strat acs) -> cr 
-        & crActionPlan . apAction .~ acs
-        & crActionPlan . apStrategy .~ strat
+    Just (StrategyActions strat acs) ->
+        cr
+            & crActionPlan . apAction .~ acs
+            & crActionPlan . apStrategy .~ strat
    _ -> cr

 reloadOverride :: Creature -> Creature
 reloadOverride cr
-    | cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded == Just 0 
-            && cr ^. crStance . posture == Aiming
-        = cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
+    | cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded == Just 0
+        && cr ^. crStance . posture == Aiming =
+        cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
    | otherwise = cr
  where
-    reloadActions = 
+    reloadActions =
        [ holsterWeapon
-        , 1 `WaitThen` 
-            DoActionWhileInterrupt NoAction (WdCrBlfromCrBl CrIsReloading) 
+        , 1
+            `WaitThen` DoActionWhileInterrupt
+                NoAction
+                (WdCrBlfromCrBl CrIsReloading)
                (DoImpulses [ChangeStrategy WatchAndWait])
        ]

@@ -152,42 +171,47 @@ overrideInternal test update cr
    | test cr = update cr
    | otherwise = cr

-watchUpdateStrat
-    :: [ (World -> Creature -> Bool, World -> Creature -> Strategy) ]
-    -> World
-    -> Creature
-    -> Creature
+watchUpdateStrat ::
+    [(World -> Creature -> Bool, World -> Creature -> Strategy)] ->
+    World ->
+    Creature ->
+    Creature
 watchUpdateStrat fs w cr = case cr ^? crActionPlan . apStrategy of
-    Just WatchAndWait -> cr 
-        & crActionPlan . apStrategy .~ listGuard (map (first uncurry) fs, \_ _ -> WatchAndWait) (w, cr) w cr
+    Just WatchAndWait ->
+        cr
+            & crActionPlan . apStrategy .~ listGuard (map (first uncurry) fs, \_ _ -> WatchAndWait) (w, cr) w cr
    _ -> cr

-listGuard :: ([(a -> Bool, b)] , b) -> a -> b
-listGuard ( (test,y):ps, z ) x
+listGuard :: ([(a -> Bool, b)], b) -> a -> b
+listGuard ((test, y) : ps, z) x
    | test x = y
    | otherwise = listGuard (ps, z) x
-listGuard (_,z) _ = z
+listGuard (_, z) _ = z

 targetYouWhenCognizant :: World -> Creature -> Creature
 targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
-- so this caused a space leak: be careful with ?~
-- consider changing targeted creature to be just an index
-    Just (Cognizant _)  -> _creatures (_cWorld w) IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
-    _                   -> cr & crIntention . targetCr .~ Nothing
+    -- so this caused a space leak: be careful with ?~
+    -- consider changing targeted creature to be just an index
+    Just (Cognizant _) -> _creatures (_cWorld w) IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
+    _ -> cr & crIntention . targetCr .~ Nothing

 searchIfDamaged :: Creature -> Creature
 searchIfDamaged cr
    | _crPastDamage cr > 0 = case _apStrategy (_crActionPlan cr) of
-        WatchAndWait -> cr & crPerception . cpVigilance .~ Vigilant
-            & crActionPlan . apStrategy .~ StrategyActions LookAround 
-                [TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr))
-                `DoActionThen` 40 `WaitThen` bfsThenReturn 500
-                ]
+        WatchAndWait ->
+            cr & crPerception . cpVigilance .~ Vigilant
+                & crActionPlan . apStrategy
+                    .~ StrategyActions
+                        LookAround
+                        [ TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr))
+                            `DoActionThen` 40 `WaitThen` bfsThenReturn 500
+                        ]
        _ -> cr
    | otherwise = cr

 bfsThenReturn :: Int -> Action
 bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)
+
 --    theaction
 --  where
 --    theaction cr w = fromMaybe NoAction $ do
@@ -195,5 +219,3 @@ bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)
 --        let as = take 20 $ map PathTo $ bfsNodePoints n w
 --        return $ DoReplicate t $
 --            foldr DoActionThen NoAction as
-        
-