Commit before trying to remove reified impulses

2025-10-15 14:19:38 +01:00
parent a0c4d62018
commit f9bcac915f
7 changed files with 147 additions and 452 deletions
@@ -1,307 +0,0 @@
-module Dodge.Creature 
-    ( module Dodge.Creature
-    , module Dodge.Creature.Inanimate
-    )
-  where
-- imports {{{
-import Dodge.Data.Creature
-import Dodge.AIs
-import Dodge.CreatureState
-import Dodge.Default
-import Dodge.Base
-import Dodge.Item.Weapon
-import Dodge.Item.Consumable
-import Dodge.WorldEvent.Cloud
-import Dodge.Creature.YourControl
-import Dodge.Creature.Inanimate
-
-import Picture
-import Geometry
-
-import Data.List
-import Data.Char
-import Data.Maybe
-import Data.Function
-import Data.Graph.Inductive.Graph
-import Data.Graph.Inductive.PatriciaTree
-import Codec.BMP
-import qualified Data.ByteString as B
-import Control.Lens
-import Control.Applicative
-import Control.Monad.State
-import Control.Monad
-import System.Random
-import qualified Data.Set as S
-import qualified IntMapHelp as IM
-import qualified Data.Map as M
-import Foreign.ForeignPtr
-import Control.Concurrent
-
-colouredEnemy col = color col $ circleSolid 10, circLine 10
-
-spawnerCrit :: Creature
-spawnerCrit = defaultCreature
-    { _crUpdate = stateUpdate $ spawnerAI chaseCrit
-    , _crHP = 300
-    , _crPict = enemyPict blue
-    , _crState = defaultState {_goals = [[WaitFor 0]]
-                            }
-    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
-    }
-smallChaseCrit :: Creature
-smallChaseCrit = defaultCreature
-    { _crUpdate = stateUpdate chaseAI
-    , _crHP = 1
-    , _crRad = 4
-    , _crPict = enemyPict green
-    , _crState = defaultState {_goals = [[Wait]]
-                            ,_faction = ChaseCritters}
-    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
-    , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 4
-    }
-chaseCrit :: Creature
-chaseCrit = defaultCreature
-    { _crUpdate = stateUpdate chaseAI
-    , _crHP = 300
-    , _crPict = enemyPict green
-    , _crState = defaultState {_goals = [[Wait]]
-                            ,_faction = ChaseCritters}
-    , _crInv = IM.empty 
-    }
-armourChaseCrit :: Creature
-armourChaseCrit = defaultCreature
-    { _crUpdate = stateUpdate chaseAI
-    , _crHP = 300
-    , _crPict = enemyPict green
-    , _crState = defaultState {_goals = [[Wait]]}
-    , _crInv = IM.fromList [(0,frontArmour)]
-    }
-miniGunCrit :: Creature
-miniGunCrit = defaultCreature
-    { _crPict = enemyPict red
-    , _crUpdate = stateUpdate  miniAI
-    , _crInv = IM.fromList [(0,miniGun)]
-    , _crInvSel = 0
-    , _crRad = 10
-    , _crState = defaultState {_goals = [[InitGuard]]}
-    , _crHP = 500
-    }
-longCrit :: Creature
-longCrit = defaultCreature
-    { _crPict = enemyPict red
-    , _crUpdate = stateUpdate sniperAI
-    , _crInv = IM.fromList [(0,longGun),(1,medkit 100)]
-    , _crInvSel = 0
-    , _crRad = 10
-    , _crState = defaultState {_goals = [[InitGuard]]}
-    , _crHP = 300
-    }
-multGunCrit :: Creature
-multGunCrit = defaultCreature
-    { _crPict = enemyPict red
-    , _crUpdate = stateUpdate (twitchMissAI 300 350)
-    , _crInv = IM.fromList [(0,multGun),(1,medkit 100)]
-    , _crInvSel = 0
-    , _crRad = 10
-    , _crState = defaultState {_goals = [[InitGuard]]}
-    , _crHP = 300
-    }
-launcherCrit :: Creature
-launcherCrit = defaultCreature
-    { _crPict = enemyPict red
-    , _crUpdate = stateUpdate (launcherAI 150 200)
-    , _crInv = IM.fromList [(0,launcher),(1,medkit 100)]
-    , _crInvSel = 0
-    , _crRad = 10
-    , _crState = defaultState {_goals = [[Init]]}
-    , _crHP = 300
-    }
-spreadGunCrit :: Creature
-spreadGunCrit = defaultCreature
-    { _crPict = enemyPict red
-    , _crUpdate = stateUpdate chargeAI
-    , _crInv = IM.fromList [(0,spreadGun),(1,medkit 100)]
-    , _crInvSel = 0
-    , _crRad = 10
-    , _crState = defaultState {_goals = [[Init]]}
-    , _crHP = 300
-    }
-pistolCrit :: Creature
-pistolCrit = defaultCreature
-    { _crPict = enemyPict red
-    , _crUpdate = stateUpdate (dodgeAI 150 200)
-    , _crInv = IM.fromList [(0,pistol),(1,medkit 100)]
-    , _crInvSel = 0
-    , _crRad = 10
-    , _crState = defaultState {_goals = [[InitGuard]]}
-    , _crHP = 500
-    }
-autoCrit :: Creature
-autoCrit = defaultCreature
-    { _crPict = enemyPict red
-    --, _crUpdate =  checkDeadStopSound n . shooterFootsteps n . makeStateAI autoShooterAI n
-    , _crUpdate = stateUpdate  basicShooterAI
-    --, _crUpdate = shooterFootsteps n . makeStateAI autoShooterAI n
-    , _crInv = IM.fromList [(0,autoGun),(1,medkit 100)]
-    , _crInvSel = 0
-    , _crRad = 10
-    --, _crState = ShooterWait
-    , _crState = defaultState {_goals = [[InitGuard]]}
-    , _crHP = 300
-    }
-addArmour :: Creature -> Creature
-addArmour = over crInv insarmour
-    where insarmour xs = IM.insert i frontArmour xs
-            where i = newKey xs
-
-equipOnTop :: (Creature -> Picture) -> Creature -> Picture
-equipOnTop f cr = onLayer CrLayer (f cr) <> drawEquipment cr
-
-drawEquipment :: Creature -> Picture
-drawEquipment cr = foldMap f $ IM.toList (_crInv cr)
-    where f (i,it) = case it ^? itEquipPict of
-                        Just g -> g cr i
-                        _      -> blank
-
-frontArmouredPict = const $ fold [ color (greyN 0.8) $ circleSolid 20
-                             , color red $ circLine 20
-                             ]
-
--packCrits :: (Int -> World -> World) -> [Int] -> [Creature]
--packCrits ai is = [(defaultCreature i)
--    { _crPos = (150,10+20*fromIntegral i)
--    , _crPict = swarmPict
--    , _crUpdate = ai i
--    --, _crUpdate = swarmAI is i
--    , _crRad = 3
--    , _crHP = 1
--    , _crMass = 2
--    }
--    | i <- is]
-
--queenBeeCrit :: Int -> Creature
--queenBeeCrit cID = (defaultCreature cID)
--    { _crRad = 20
--    , _crCorpse = color (greyN 0.5) $ circleSolid 20
--    , _crPict = const $ pictures [color black $ circSolid 20
--                         ,color yellow $ circLine 20
--                         ]
--    , _crUpdate = checkDead cID . makeStateAI queenBeeAI cID
--    , _crState = QueenBee 0 20
--    , _crMass = 20
--    }
-
--antCrit :: Int -> Creature
--antCrit cID = (defaultCreature cID)
--    { _crPos = (0,100 + 3 * fromIntegral cID)
--    , _crUpdate = checkDead cID . makeStateAI (antAI 2) cID
--    , _crState = AntMove 50
--    , _crPict = antPic
--    , _crRad = 3
--    , _crHP = 1
--    , _crMass = 2
--    , _crCorpse = color (greyN 0.5) $ circSolid 3
--    }
--    where i = evalState (state (randomR (1::Int,100))) (mkStdGen cID)
--antPic = const $ pictures [ translate (-1) 0 $ circleSolid 2
--                  , translate (2) 0 $ circleSolid 1
--                  , translate (1) 0 $ circleSolid 1
--                  , line [(3,3),(-3,-3)]
--                  , line [(-3,3),(3,-3)]
--                  , line [(0,-3),(0,3)]
--                  ]
-
-flamerPict = const $ pictures [color (light $ light $ light $ dim blue) $ circleSolid 10, circLine 10]
-
-
-
-goalPict cr = let r = _crRad cr in case _crState cr of
-    CrSt {_goals = gls ,_crDamage = crDam } 
--            | crDam > _crHP cr -> color white $ circleSolid r
-            | otherwise        -> case head gls of
-                        [] -> sizeColEnemy r white
-                        (MoveToFor p i:_) -> dImpulses $ sizeColEnemy r green
-                        (WaitFor x:_) -> dImpulses $ sizeColEnemy r yellow
-                        (FireAt p:_) -> dImpulses $ sizeColEnemy r red
-                        (Reload:_) -> dImpulses $ sizeColEnemy r orange
-                        (PathTo p:_) -> dImpulses $ sizeColEnemy r cyan
-                        (SubPathTo p i _:_) -> dImpulses $ sizeColEnemy r blue
-                        (Search i:_) -> dImpulses $ sizeColEnemy r black
-                        _ -> dImpulses $ sizeColEnemy r magenta
-                    where dImpulses p = pictures [p, rotate (0 - _crDir cr) $ scale 0.1 0.1 $ color white $ text $ show gls]
-    _                  -> sizeColEnemy r (light $ dim green)
-
-startCr :: Creature
-startCr = defaultCreature
-    { _crPos = (0,0)
-    , _crOldPos = (0,0)
-    , _crDir = 0
-    , _crID = 0
-    , _crPict = basicCrPict $ greyN 0.8
-                
-    , _crUpdate = stateUpdate yourControl
-    , _crRad = 10
-    , _crMass = 10
-    , _crHP = 10000
-    , _crMaxHP = 1500
-    , _crInv = IM.fromList (zip [0..20] 
-<<<<<<< HEAD:src/Dodge/Creature.hs
-         (
-          [pistol,autoGun,launcher,lasGun,grenade
-          ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher
-          ,longGun
-          ,hvAutoGun
-          ,teslaGun
-          ,latchkey 0
-          ,miniGun
-          ,medkit 50
-          ,bezierGun
-          ,poisonSprayer
-          ,blinkGun
-          ,frontArmour
-          ] 
-          ++ repeat NoItem)) 
-         -- startInv
-=======
-                           ([pistol,flameGrenade, teslaGrenade, autoGun,launcher,flameLauncher, poisonLauncher, teslaLauncher, lasGun,grenade
-                            ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher
-                            ,longGun
-                            ,hvAutoGun
-                            ,teslaGun
-                            ,latchkey 0
-                            ,miniGun
-                            ,medkit 50
-                            ,bezierGun
-                            ,poisonSprayer
-                            ,blinkGun
-                            ] 
-                            ++ repeat NoItem)) 
-                          -- startInv
->>>>>>> testing:src/Dodge/Critters.hs
-    , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]
-    }
-
-smokeGenGun = effectGun "smoke" $ \_ -> spawnSmokeAtCursor
-
-enemyPict :: Color -> Creature -> Picture
-enemyPict col = equipOnTop $ sizeEnemy (light $ light $ light $ light col)
-
-sizeEnemy col cr 
-    | pdam > 200      = color red $ circleSolid $ _crRad cr
-    | pdam > 100      = color white $ circleSolid $ _crRad cr
-    | mod pdam 2 == 1 = color white $ circleSolid $ _crRad cr
-    | otherwise       = pictures [color col $ circleSolid $ _crRad cr
-                                 , circLine $ _crRad cr ]
-    where pdam = _crPastDamage $ _crState cr
-
-sizeColEnemy r col = pictures [color col $ circleSolid r, circLine r]
-
-basicCrPict :: Color -> Creature -> Picture
-basicCrPict col cr = pictures [ onLayer CrLayer naked , drawEquipment cr]
-    where naked | pdam > 200      = color red $ circleSolid $ _crRad cr
-                | pdam > 100      = color white $ circleSolid $ _crRad cr
-                | mod pdam 2 == 1 = color white $ circleSolid $ _crRad cr
-                -- | crDam > _crHP cr && odd (crDam - _crHP cr)
-                --     = [color white $ circleSolid $ _crRad cr]
-                | otherwise        =  pictures [color col $ circleSolid $ _crRad cr, circLine $ _crRad cr]
-          pdam = _crPastDamage $ _crState cr
@@ -54,10 +54,7 @@ blinkDistortions sp ep = cWorld . lWorld . distortions .++~ distortionBulge
 {- | Teleport a creature to the mouse position.
 Can go through walls, if ending up in wall does big damage.
 -}
-unsafeBlinkAction ::
-    Creature ->
-    World ->
-    World
+unsafeBlinkAction :: Creature -> World -> World
 unsafeBlinkAction cr w
    | success =
        soundMultiFrom [TeleSound 0, TeleSound 1] mwp teleS Nothing
@@ -86,10 +83,7 @@ blinkShockwave ::
 blinkShockwave i p = makeShockwaveAt [i] (p `v2z` 20) 60 1 2 cyan

 -- | Like a blink action, but no ingoing distortion
-blinkActionFail ::
-    Creature ->
-    World ->
-    World
+blinkActionFail :: Creature -> World -> World
 blinkActionFail cr w =
    w
        & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
@@ -1,6 +1,4 @@
-module Dodge.Creature.AutoCrit (
-    autoCrit,
-) where
+module Dodge.Creature.AutoCrit ( autoCrit) where

 --import Dodge.Item.Held.Cane
 --import Control.Lens
@@ -13,25 +13,24 @@ module Dodge.Creature.ReaderUpdate (
    setViewPos,
 ) where

-import Linear
-import Dodge.Creature.Vocalization
-import Dodge.Creature.Radius
-import RandomHelp
-import Dodge.Creature.Perception
-import qualified IntMapHelp as IM
-import Data.List (sortOn)
 import Control.Applicative
-import LensHelp
 import Control.Monad
 import Data.Bifunctor
+import Data.List (sortOn)
 import Data.Maybe
 import Dodge.Base
--import Dodge.Creature.Volition
+import Dodge.Creature.Perception
+import Dodge.Creature.Radius
+import Dodge.Creature.Vocalization
 import Dodge.Data.CreatureEffect
 import Dodge.Data.World
 import Dodge.Zoning.Creature
 import FoldableHelp
 import Geometry
+import qualified IntMapHelp as IM
+import LensHelp
+import Linear
+import RandomHelp

 overrideMeleeCloseTarget :: Creature -> Creature
 overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
@@ -43,12 +42,15 @@ tryMeleeAttack cr tcr
        && dist tpos cpos < crRad (cr ^. crType) + crRad (tcr ^. crType) + 5
        && abs (_crDir cr - argV (tpos -.- cpos)) < pi / 4 =
        cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr]
-            & crActionPlan . apAction .~ [DoReplicate 10 NoAction `DoActionThen` DoImpulses 
-                [ChangeStrategy (CloseToMelee $ _crID tcr)] ]
+            & crActionPlan . apAction
+                .~ [ DoReplicate 10 NoAction
+                        `DoActionThen` DoImpulses
+                            [ChangeStrategy (CloseToMelee $ _crID tcr)]
+                   ]
            & crActionPlan . apStrategy .~ MeleeStrike
    | otherwise = cr
  where
-    cpos = cr  ^. crPos . _xy
+    cpos = cr ^. crPos . _xy
    tpos = tcr ^. crPos . _xy

 setMvPos :: World -> Creature -> Creature
@@ -92,7 +94,7 @@ flockACC w cr = case cr ^? crIntention . targetCr . _Just of
    Nothing -> cr
    Just tcr ->
        let tpos = tcr ^. crPos . _xy
-            cpos = cr  ^. crPos . _xy
+            cpos = cr ^. crPos . _xy
            isFarACC cr' =
                _crGroup cr' == _crGroup cr
                    && _crID cr' /= _crID cr
@@ -117,19 +119,25 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
    StrategyActions _ _ -> cr
    WarningCry -> cr
    MeleeStrike -> cr
-    CloseToMelee cid | Just 0 == (cr ^? crVocalization . vcCoolDown)
-        -> cr & crActionPlan . apAction 
-                .:~ ImpulsesList ( [Bark soundid] : replicate numjits [RandomImpulse thejitter]
-                    ++  [[ChangeStrategy (CloseToMelee cid)]])
-            & crVocalization . vcCoolDown .~ 10
-            & crActionPlan . apStrategy .~ WarningCry
+    CloseToMelee cid
+        | Just 0 == (cr ^? crVocalization . vcCoolDown) ->
+            cr
+                & crActionPlan . apAction
+                    .:~ ImpulsesList
+                        ( [Bark soundid] :
+                          replicate numjits [RandomImpulse thejitter]
+                            ++ [[ChangeStrategy (CloseToMelee cid)]]
+                        )
+                & crVocalization . vcCoolDown .~ 10
+                & crActionPlan . apStrategy .~ WarningCry
      where
        thejitter = RandImpulseCircMove 3
        soundid = evalState (takeOne (crWarningSounds cr)) (_randGen w)
        numjits = fst $ randomR (15, 25) (_randGen w)
    _ -> case cr ^? crIntention . mvToPoint . _Just of
        Just p
-            | dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) -> cr & crActionPlan . apAction .~ [PathTo p]
+            | dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
+                cr & crActionPlan . apAction .~ [PathTo p]
            | otherwise ->
                cr & crActionPlan . apAction .~ [bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]]
                    & crActionPlan . apStrategy .~ WatchAndWait
@@ -151,12 +159,13 @@ viewTarget w cr = case cr ^? crIntention . viewPoint . _Just of
            cr
                & crActionPlan . apAction
                    .~ [TurnToPoint p]
--                    %~ replaceNullWith
--                        ( TurnToPoint p
--                        )
+                --                    %~ replaceNullWith
+                --                        ( TurnToPoint p
+                --                        )
                & crIntention . viewPoint .~ Nothing
                & crActionPlan . apStrategy .~ Investigate
-        | otherwise -> cr & crActionPlan . apAction %~ replaceNullWith (PathTo p)
+        | otherwise ->
+            cr & crActionPlan . apAction %~ replaceNullWith (PathTo p)
                & crActionPlan . apStrategy .~ Investigate
    Nothing -> cr

@@ -198,8 +207,10 @@ 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 _) -> (w ^?! cWorld . lWorld . creatures . ix 0) `seq` 
-        cr & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0)
+    Just (Cognizant _) ->
+        (w ^?! cWorld . lWorld . creatures . ix 0)
+            `seq` cr
+            & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0)
            & crPerception . cpVigilance .~ Vigilant
    _ -> cr & crIntention . targetCr .~ Nothing

@@ -85,9 +85,7 @@ data Action
        { _targetID :: Int
        , _targetSeenAt :: Point2
        }
-    | PathTo
-        { _pathToPoint :: Point2
-        }
+    | PathTo { _pathToPoint :: Point2 }
    | TurnToPoint
        { _turnToPoint :: Point2
        }
@@ -89,6 +89,7 @@ drawCrInfo u = foldMap f . IM.elems $ w ^. cWorld . lWorld . creatures
                    , g show "cpVigilance" $ cr ^? crPerception . cpVigilance
                    , g show "crAction" $ cr ^? crActionPlan . apAction
                    , g show "crImpulse" $ cr ^? crActionPlan . apImpulse
+                    , g show "crName" $ cr ^? crName
                    ]
    setclip s u'' = fromMaybe u'' $ do
        guard (SDL.ButtonLeft `M.member` (u'' ^. uvWorld . input . mouseButtons))