Add debug to copy to clipboard any clicked-on creature

src/Dodge/Creature/Action.hs

@@ -84,7 +84,7 @@ performAction cr w ac = case ac of
 --    DoActions acs ->
 --        let (imps, newAcs) = foldMap (performAction cr w) acs
 --         in (imps, newAcs)
-    StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], NoAction)
+--    StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], NoAction)
     PathTo p a -> performPathTo a cr w p
     EvadeAim -> tryEvadeSideways cr w
     TurnToPoint p -> performTurnToA cr p

src/Dodge/Creature/ArmourChase.hs

@@ -24,7 +24,7 @@ flockArmourChaseCrit =
             ActionPlan
                 { _apAction = NoAction
                 , _apStrategy = FollowImpulses
-                , _apGoal = [Kill 0]
+                , _apGoal = Kill 0
                 }
         , _crGroup = ShieldGroup
 --        , _crMvType = defaultChaseMvType

src/Dodge/Creature/Impulse.hs

@@ -64,7 +64,7 @@ followImpulse cid w = \case
     MakeSound sid -> soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing w
     DropItem -> undefined
     ChangeStrategy strat -> crup $ crActionPlan . apStrategy .~ strat
-    AddGoal gl -> crup $ crActionPlan . apGoal .:~ gl
+--    AddGoal gl -> crup $ crActionPlan . apGoal .:~ gl
     ImpulseUseTarget f -> fromMaybe w $ do
         i <- cr ^? crIntention . targetCr . _Just
         tcr <- w ^? cWorld . lWorld . creatures . ix i

src/Dodge/Creature/ReaderUpdate.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
 module Dodge.Creature.ReaderUpdate (
-    doStrategyActions,
     targetYouWhenCognizant,
     overrideMeleeCloseTarget,
     watchUpdateStrat,
@@ -269,14 +268,6 @@ viewTarget w cr = case cr ^? crIntention . viewPoint . _Just of
 --replaceNullWith x [] = [x]
 --replaceNullWith _ xs = xs
 
-doStrategyActions :: Creature -> Creature
-doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
-    Just (SetStrategyAction strat acs) ->
-        cr
-            & crActionPlan . apAction .~ acs
-            & crActionPlan . apStrategy .~ strat
-    _ -> cr
-
 overrideInternal :: (Creature -> Bool) -> (Creature -> Creature) -> Creature -> Creature
 overrideInternal test update cr
     | test cr = update cr
@@ -315,12 +306,7 @@ searchIfDamaged cr
     | _crPain cr > 0
         && _apStrategy (_crActionPlan cr) == WatchAndWait =
         cr & crPerception . cpVigilance .~ Vigilant
-            & crActionPlan . apStrategy
-                .~ SetStrategyAction
-                    LookAround
-                    ( TurnToPoint (cr ^. crPos . _xy -.- unitVectorAtAngle (_crDir cr))
---                        `DoActionThen` 40 `WaitThen` bfsThenReturn 500
-                    )
+            & crActionPlan . apStrategy .~ LookAround
     | otherwise = cr
 
 --bfsThenReturn :: Int -> Action

src/Dodge/Creature/Test.hs

@@ -29,7 +29,6 @@ import Dodge.Creature.Radius
 import Dodge.Data.Equipment.Misc
 import Dodge.Data.AimStance
 import Control.Lens
-import Data.List (find)
 import Data.Maybe
 import Dodge.Base.Collide
 import Dodge.Data.World
@@ -81,12 +80,9 @@ crStratConMatches strat cr = strat == _apStrategy (_crActionPlan cr)
 -- this equality check might be slow...
 
 crAwayFromPost :: Creature -> Bool
-crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
-    Just (SentinelAt p _) -> dist p (cr ^. crPos . _xy) > 15
+crAwayFromPost cr = case _apGoal $ _crActionPlan cr of
+    SentinelAt p _ -> dist p (cr ^. crPos . _xy) > 15
     _ -> False
-  where
-    sentinelGoal (SentinelAt _ _) = True
-    sentinelGoal _ = False
 
 crInAimStance :: AimStance -> Creature -> Bool
 crInAimStance as cr = cr ^? crStance . posture == Just Aiming

src/Dodge/Creature/Update.hs

@@ -161,8 +161,11 @@ updateCalmBee cr cid w
     , x >= 0.5 = w & tocr . crType . beeSlime -~ 0.5
     | Just x <- cr ^? crType . beeSlime 
     , x < 0.5
+    , Just hcr <- gethive
+    , distance (cr ^. crPos . _xy) (hcr ^. crPos . _xy) < 30 
     , Just ReturnToHive <- cr ^? crActionPlan . apStrategy
         = w & tocr . crActionPlan . apStrategy .~ Search
+            & tocr . crActionPlan . apAction .~ NoAction
     | Just hcr <- gethive
     , Just _ <- cr ^? crStance . carriage . mountID
     , Just x <- cr ^? crType . beeSlime 
@@ -180,8 +183,10 @@ updateCalmBee cr cid w
         = w & tocr . crActionPlan . apAction .~ PathTo (hcr ^. crPos . _xy) NoAction
         & tocr . crActionPlan . apStrategy .~ ReturnToHive
     | Nothing <- cr ^? crActionPlan . apStrategy . harvestTarget 
-    ,  Just tcr <- listToMaybe . sortOn (distance cxy . (^. crPos . _xy)) . IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w =
+    ,  xs@(_:_) <- IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w 
+    , (tcr,g') <- runState (takeOne xs) (w ^. randGen) =
          w & tocr . crActionPlan . apStrategy .~ HarvestFrom (tcr ^. crID)
+            & randGen .~ g'
     | Just tid <- cr ^? crStance . carriage . mountID
     , Just SlimeCrit{} <- w ^? cWorld . lWorld . creatures . ix tid . crType = w
         & tocr . crType . beeSlime +~ sspeed
@@ -195,7 +200,8 @@ updateCalmBee cr cid w
         & tocr . crActionPlan . apAction .~ NoAction
     | Just (tcr,_) <- gettarg = w
             & tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
-    | Just (SearchTimed 0) <- cr ^? crActionPlan . apStrategy = w & tocr . crActionPlan . apStrategy .~ Search
+    | Just (SearchTimed 0) <- cr ^? crActionPlan . apStrategy 
+        = w & tocr . crActionPlan . apStrategy .~ ReturnToHive
     | Just PathTo{} <- cr ^? crActionPlan . apAction = w
         & tocr . crActionPlan . apStrategy . searchTimer %~ (max 0 . subtract 1)
     | otherwise = w
@@ -203,7 +209,7 @@ updateCalmBee cr cid w
         & randGen .~ g
         & tocr . crActionPlan . apStrategy .~ SearchTimed 200
   where
-    (p,g) = runState (randOnCirc 150) (w ^. randGen)
+    (p,g) = runState (randOnCirc 200) (w ^. randGen)
     cxy = cr ^. crPos . _xy
     mountshakeoff mid = fromMaybe True $ do
         mcr <- w ^? cWorld . lWorld . creatures . ix mid

src/Dodge/Data/ActionPlan.hs

@@ -17,8 +17,8 @@ data ActionPlan
     | ActionPlan
         { -- _apImpulse :: [Impulse] -- done per frame
          _apAction :: Action -- updated per frame, likely persist across frames
-        , _apStrategy :: Strategy -- current strategy
-        , _apGoal :: [Goal] -- particular ordered goals
+        , _apStrategy :: Strategy
+        , _apGoal :: Goal
         }
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
     deriving (Eq, Ord, Show) --Generic, Flat)
@@ -45,7 +45,7 @@ data Impulse
     | ChangePosture Posture
     | MakeSound SoundID
     | ChangeStrategy Strategy
-    | AddGoal Goal
+--    | AddGoal Goal
     | ImpulseUseTarget { _impulseUseTarget :: CrImp }
     | ImpulseNothing
     | UpdateRandGen
@@ -121,7 +121,7 @@ data Action
         }
     | LeadTarget { _leadTargetBy :: Point2 }
     | NoAction
-    | StartSentinelPost
+--    | StartSentinelPost
 --    | UseSelf { _useSelf :: CrAc }
 --    | ArbitraryAction {_arbitraryAction :: CrWdAc}
 -- | Repeatedly perform impulses alongside a main action until the main action terminates
@@ -145,11 +145,8 @@ data Strategy
     | LookAround
     | Wander
     | CloseToMelee {_meleeTarget :: Int}
-    | SetStrategyAction Strategy Action
     | GetTo Point2
---    | Reload
     | Flee
---    | MeleeStrike
     | Search
     | SearchTimed {_searchTimer :: Int}
     | ReturnToHive

src/Dodge/Data/Config.hs

@@ -109,6 +109,7 @@ data DebugBool
     | Show_mouse_click_pos
     | Muzzle_positions
     | Show_cr_hitboxes
+    | Clipboard_cr
     deriving (Eq, Ord, Bounded, Enum, Show)
 
 data ResFactor = DoubleRes | FullRes | HalfRes | QuarterRes | EighthRes | SixteenthRes

src/Dodge/Debug.hs

@@ -2,6 +2,8 @@
 
 module Dodge.Debug (debugEvents, drawDebug) where
 
+import Dodge.Base.Coordinate
+import Dodge.Zoning.Creature
 import Dodge.Creature.Radius
 import Geometry.Data
 import Dodge.Render.Label
@@ -25,6 +27,7 @@ import Picture.Base
 import qualified SDL
 import System.Hclip
 import Text.Read
+import Data.List (sortOn)
 
 debugEvents :: Universe -> Universe
 debugEvents u = case dbools ^. at Display_debug of
@@ -83,6 +86,14 @@ debugEvent' = \case
     Debug_put -> id
     Muzzle_positions -> id
     Show_cr_hitboxes -> id
+    Clipboard_cr -> clipboardCr
+
+clipboardCr :: Universe -> Universe
+clipboardCr u = fromMaybe u $ do
+    guard (u ^. uvWorld . input . mouseButtons . at SDL.ButtonLeft == Just 0)
+    return $ u & uvIOEffects %~ (\m u' -> setClipboard s >> m u')
+  where
+    s = unlines . prettyShort $ closestCrToMouse $ u ^. uvWorld
 
 debugItem :: DebugBool -> Universe -> Maybe [DebugItem]
 debugItem = \case
@@ -120,6 +131,7 @@ debugItem = \case
     Debug_put -> debugPutItems
     Muzzle_positions -> mempty
     Show_cr_hitboxes -> mempty
+    Clipboard_cr -> mempty
 
 debugGet :: Universe -> [String]
 debugGet u = foldMap getPretty $ u ^. uvWorld . cWorld . lWorld . shockwaves
@@ -291,6 +303,13 @@ drawDebug u = \case
     Show_mouse_click_pos -> mempty
     Muzzle_positions -> showMuzzlePositions u
     Show_cr_hitboxes -> foldMap drawCreatureRad (u ^. uvWorld . cWorld . lWorld . creatures)
+    Clipboard_cr -> foldMap drawCreatureRad (closestCrToMouse $ u^.uvWorld)
+
+closestCrToMouse :: World -> Maybe Creature
+closestCrToMouse w = listToMaybe . sortOn (distance mwp . (^. crPos . _xy))
+        $ crsNearPoint mwp w
+  where
+    mwp = mouseWorldPos (w^.input) (w^.wCam)
 
 drawCreatureRad :: Creature -> Picture
 drawCreatureRad cr = setLayer DebugLayer

src/Dodge/Default/Creature.hs

@@ -43,7 +43,7 @@ defaultCreature =
                 , _posture = AtEase
                 }
         , _crVocalization = VocReady
-        , _crActionPlan = ActionPlan NoAction (SetStrategyAction WatchAndWait StartSentinelPost) [LiveLongAndProsper]
+        , _crActionPlan = ActionPlan NoAction WatchAndWait LiveLongAndProsper
         , _crPerception = defaultPerceptionState
         , _crMemory = defaultCreatureMemory
         , _crFaction = NoFaction

src/Dodge/Humanoid.hs

@@ -10,39 +10,34 @@ import LensHelp
 
 updateChaseCrit :: Int -> World -> World
 updateChaseCrit cid w = w
-    & (tocr %~ doStrategyActions)
-    & (tocr %~ overrideMeleeCloseTarget w)
-    & (tocr %~ setViewPos w)
-    & (tocr %~ setMvPosToTargetCr w)
-    & (tocr %~ chaseCritMv w)
-    & (tocr %~ perceptionUpdate [0] w)
-    & (tocr %~ targetYouWhenCognizant w)
-    & (tocr %~ searchIfDamaged)
-    & (tocr . crType . meleeCooldown %~ max 0 . subtract 1)
-    & (tocr . crVocalization %~ updateVocTimer)
+    & tocr %~ overrideMeleeCloseTarget w
+    & tocr %~ setViewPos w
+    & tocr %~ setMvPosToTargetCr w
+    & tocr %~ chaseCritMv w
+    & tocr %~ perceptionUpdate [0] w
+    & tocr %~ targetYouWhenCognizant w
+    & tocr %~ searchIfDamaged
+    & tocr . crType . meleeCooldown %~ max 0 . subtract 1
+    & tocr . crVocalization %~ updateVocTimer
   where
     tocr = cWorld . lWorld . creatures . ix cid
 
 crabCritInternal :: Int -> World -> World
-crabCritInternal cid w =
-    --    (crVocalization %~ updateVocTimer)
-    (tocr %~ (crType . meleeCooldownL %~ max 0 . subtract 1))
-        . (tocr %~ (crType . meleeCooldownR %~ max 0 . subtract 1))
-        . (tocr %~ (crType . dodgeCooldown %~ max 0 . subtract 1))
-        . (tocr %~ searchIfDamaged)
-        . (tocr %~ targetYouWhenCognizant w)
-        . (tocr %~ perceptionUpdate [0] w)
-        . crabActionUpdate cid
-        . (tocr %~ setMvPosToTargetCr w)
-        . (tocr %~ setViewPos w)
-        --        . overrideMeleeCloseTarget w
-        $ (tocr %~ doStrategyActions) w
+crabCritInternal cid w = w
+    & tocr %~ setViewPos w
+    & tocr %~ setMvPosToTargetCr w
+    & crabActionUpdate cid
+    & tocr %~ perceptionUpdate [0] w
+    & tocr %~ targetYouWhenCognizant w
+    & tocr %~ searchIfDamaged
+    & tocr . crType . dodgeCooldown %~ max 0 . subtract 1
+    & tocr . crType . meleeCooldownR %~ max 0 . subtract 1
+    & tocr . crType . meleeCooldownL %~ max 0 . subtract 1
   where
     tocr = cWorld . lWorld . creatures . ix cid
 
 updateHoverCrit :: Int -> World -> World
 updateHoverCrit cid w = w
-        & tocr %~ doStrategyActions
         & tocr %~ overrideMeleeCloseTarget w
         & tocr %~ setViewPos w
         & tocr %~ setMvPosToTargetCr w
@@ -50,7 +45,7 @@ updateHoverCrit cid w = w
         & tocr %~ perceptionUpdate [0] w
         & tocr %~ targetYouWhenCognizant w
         & tocr %~ searchIfDamaged
-        & tocr . crType . meleeCooldown %~ (max 0 . subtract 1)
+        & tocr . crType . meleeCooldown %~ max 0 . subtract 1
         & tocr . crVocalization %~ updateVocTimer
   where
     tocr = cWorld . lWorld . creatures . ix cid

src/Dodge/TestString.hs

@@ -42,8 +42,13 @@ tocrs :: (IM.IntMap Creature
          -> Universe -> Const (Endo [String]) Universe
 tocrs = uvWorld . cWorld . lWorld . creatures
 
+isBee :: Creature -> Bool
+isBee cr = case cr ^. crType of
+    BeeCrit{} -> True
+    _ -> False
+
 testStringInit :: Universe -> [String]
-testStringInit _ = mempty -- u ^.. tocrs . each . crActionPlan . apStrategy . to show
+testStringInit u = u ^.. tocrs . each . filtered isBee . crActionPlan . apStrategy . to show
 --    u ^.. tocrs . ix 1 . crPos . _xy . to show
 --    <> u ^.. tocrs . ix 1 . crType . slimeCompression . to show
 --    <> u ^.. tocrs . ix 1 . crType . slimeCompression . to norm . to show