From ffdfaa41c0871ea95e53fc9956929fdee29059c2 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 3 Jul 2022 15:07:55 +0100 Subject: [PATCH] Cleanup creatures somewhat, fix LOS to LOSIndirect --- src/Dodge/Creature.hs | 20 ++++------------- src/Dodge/Creature/Action.hs | 6 +++--- src/Dodge/Creature/ArmourChase.hs | 8 +++---- src/Dodge/Creature/AutoCrit.hs | 6 ------ src/Dodge/Creature/Boid.hs | 12 +++++------ src/Dodge/Creature/Impulse.hs | 8 +++---- src/Dodge/Creature/LauncherCrit.hs | 8 +------ src/Dodge/Creature/LtAutoCrit.hs | 8 +------ src/Dodge/Creature/Perception.hs | 4 ++-- src/Dodge/Creature/PistolCrit.hs | 8 +------ src/Dodge/Creature/ReaderUpdate.hs | 30 +++++++++++++------------- src/Dodge/Creature/SentinelAI.hs | 4 ++-- src/Dodge/Creature/SpreadGunCrit.hs | 8 +------ src/Dodge/Creature/Strategy.hs | 2 +- src/Dodge/Creature/Test.hs | 4 ++-- src/Dodge/Data.hs | 8 +++---- src/Dodge/Default.hs | 2 +- src/Dodge/Floor.hs | 16 +++++++------- src/Dodge/Initialisation.hs | 2 +- src/Dodge/Path.hs | 2 +- src/Dodge/Placement/Instance/Turret.hs | 2 +- src/Dodge/Render/InfoBox.hs | 6 +++--- src/Dodge/Render/ShapePicture.hs | 22 ++++++++++++------- src/Dodge/Zone/Update.hs | 1 + 24 files changed, 81 insertions(+), 116 deletions(-) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 620a3d49d..5d21e67e7 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -68,12 +68,6 @@ miniGunCrit :: Creature miniGunCrit = defaultCreature { _crPict = basicCrPict , _crUpdate = defaultImpulsive [sentinelFireType (const shootTillEmpty)] - , _crActionPlan = ActionPlan - { _crImpulse = [] - , _crAction = [] - , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] - , _crGoal = [] - } -- , _crInv = IM.fromList [(0,autoRifle & itConsumption . ammoLoaded .~ 1000)] , _crInv = IM.fromList [(0,miniGunX 3)] -- , _crInv = IM.fromList [(0,autoRifle)] @@ -89,10 +83,10 @@ longCrit = defaultCreature -- , _crUpdate = stateUpdate sniperAI , _crUpdate = defaultImpulsive [sentinelFireType $ const shootTillEmpty] , _crActionPlan = ActionPlan - { _crImpulse = [] - , _crAction = [] - , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] - , _crGoal = [] + { _apImpulse = [] + , _apAction = [] + , _apStrategy = StrategyActions WatchAndWait [StartSentinelPost] + , _apGoal = [] } , _crInv = IM.fromList [(0,sniperRifle),(1,medkit 100)] , _crRad = 10 @@ -120,12 +114,6 @@ multGunCrit = defaultCreature ) ] ] - , _crActionPlan = ActionPlan - { _crImpulse = [] - , _crAction = [] - , _crStrategy = WatchAndWait - , _crGoal = [] - } } & crSkin . skinUpper .~ light4 red where diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 866548d26..8af8ae5a8 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -48,10 +48,10 @@ import Data.List (findIndex) --import qualified Data.Map as M performActions :: World -> Creature -> Creature performActions w cr = cr - & crActionPlan . crImpulse .~ concat iss - & crActionPlan . crAction .~ catMaybes mayas + & crActionPlan . apImpulse .~ concat iss + & crActionPlan . apAction .~ catMaybes mayas where - (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction + (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . apAction type OutAction = ( [Impulse] , Maybe Action ) diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs index 7ace21a17..076db3f2d 100644 --- a/src/Dodge/Creature/ArmourChase.hs +++ b/src/Dodge/Creature/ArmourChase.hs @@ -42,10 +42,10 @@ flockArmourChaseCrit = defaultCreature ,(1,medkit 200) ] , _crActionPlan = ActionPlan - {_crImpulse = [] - ,_crAction = [] - ,_crStrategy = FollowImpulses - ,_crGoal = [Kill 0] + {_apImpulse = [] + ,_apAction = [] + ,_apStrategy = FollowImpulses + ,_apGoal = [Kill 0] } , _crMeleeCooldown = 0 , _crGroup = ShieldGroup diff --git a/src/Dodge/Creature/AutoCrit.hs b/src/Dodge/Creature/AutoCrit.hs index 40c6a8359..7d546cb59 100644 --- a/src/Dodge/Creature/AutoCrit.hs +++ b/src/Dodge/Creature/AutoCrit.hs @@ -24,12 +24,6 @@ autoCrit :: Creature autoCrit = defaultCreature { _crPict = basicCrPict , _crUpdate = defaultImpulsive [sentinelAI] - , _crActionPlan = ActionPlan - { _crImpulse = [] - , _crAction = [] - , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] - , _crGoal = [] - } , _crInv = IM.fromList [(0,autoGun),(1,medkit 100)] , _crRad = 10 , _crHP = 300 diff --git a/src/Dodge/Creature/Boid.hs b/src/Dodge/Creature/Boid.hs index 6c1349417..7b24261e3 100644 --- a/src/Dodge/Creature/Boid.hs +++ b/src/Dodge/Creature/Boid.hs @@ -198,7 +198,7 @@ flockPointTarget -> Creature flockPointTarget f targFunc w cr = case targFunc cr w of Nothing -> cr - Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg + Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg where is = _swarm $ _crGroup cr crs = IM.restrictKeys (_creatures w) is @@ -211,7 +211,7 @@ flockToPointUsing -> Reader World Creature flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of Nothing -> cr - Just tcr -> cr & crActionPlan . crImpulse .~ mvf ptarg cr tcr + Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr where cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr) ptarg = pf tcr cenp cr @@ -223,7 +223,7 @@ flockToPointUsing' -> Creature flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of Nothing -> cr - Just tcr -> cr & crActionPlan . crImpulse .~ mvf ptarg cr tcr + Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr where cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr) ptarg = pf tcr cenp cr @@ -235,7 +235,7 @@ flockFunc -> Reader World Creature flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of Nothing -> cr - Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg + Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg where cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr) p = f crTarg cenp cr @@ -247,7 +247,7 @@ flockCenterFunc -> Reader World Creature flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of Nothing -> cr - Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg + Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg where cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr) p = f crTarg cenp cr @@ -259,7 +259,7 @@ flockPointTargetR -> Reader World Creature flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of Nothing -> cr - Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg + Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg where is = _swarm $ _crGroup cr crs = IM.restrictKeys (_creatures w) is diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 465c106a1..c60e7e113 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -41,10 +41,10 @@ impulsiveAI f cr w = followImpulses w $ f w cr followThenClearImpulses :: Creature -> World -> World -followThenClearImpulses = impulsiveAIBeforeAfter (const id) (const $ crActionPlan . crImpulse .~ []) +followThenClearImpulses = impulsiveAIBeforeAfter (const id) (const $ crActionPlan . apImpulse .~ []) followImpulses :: World -> Creature -> (World -> World, Creature) -followImpulses w cr = foldr f (id, cr) (_crImpulse $ _crActionPlan cr) +followImpulses w cr = foldr f (id, cr) (_apImpulse $ _crActionPlan cr) where f imp (theupdate,cr') = first (. theupdate) $ followImpulse cr' w imp @@ -67,8 +67,8 @@ followImpulse cr w imp = case imp of RandomTurn a -> (randGen .~ snd (rr a), creatureTurn (fst $ rr a) cr) MakeSound sid -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr ) DropItem -> undefined - ChangeStrategy strat -> crup $ cr & crActionPlan . crStrategy .~ strat - AddGoal gl -> crup $ cr & crActionPlan . crGoal .:~ gl + ChangeStrategy strat -> crup $ cr & crActionPlan . apStrategy .~ strat + AddGoal gl -> crup $ cr & crActionPlan . apGoal .:~ gl ArbitraryImpulseFunction f -> crup $ f w cr ArbitraryImpulse f -> followImpulse cr w (f cr w) ArbitraryImpulseEffect f -> (f cr, cr) diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index ec1941290..f3512f66a 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -37,14 +37,8 @@ launcherCrit = defaultCreature , targetYouWhenCognizant , const $ overrideInternal (\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr) - (crActionPlan . crStrategy .~ WatchAndWait) + (crActionPlan . apStrategy .~ WatchAndWait) ] - , _crActionPlan = ActionPlan - { _crImpulse = [] - , _crAction = [] - , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] - , _crGoal = [] - } , _crInv = IM.fromList [(0,launcher)] , _crRad = 10 , _crState = defaultState diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index 9760547cd..788aec9f9 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -41,14 +41,8 @@ ltAutoCrit = defaultCreature , targetYouWhenCognizant , const $ overrideInternal (\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr) - (crActionPlan . crStrategy .~ WatchAndWait) + (crActionPlan . apStrategy .~ WatchAndWait) ] - , _crActionPlan = ActionPlan - { _crImpulse = [] - , _crAction = [] - , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] - , _crGoal = [] - } , _crInv = IM.fromList [(0,autoPistol),(1,medkit 100)] , _crRad = 10 , _crHP = 500 diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 9ccd9e70d..839089880 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/src/Dodge/Creature/Perception.hs @@ -50,7 +50,7 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of return $ Move p maybeBark | becomesCognizant = case vocalizationTest cr of - Just sid -> crActionPlan . crAction .~ + Just sid -> crActionPlan . apAction .~ [ImpulsesList [[Bark sid] ,[RandomImpulse thejitter] @@ -85,7 +85,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of && cr ^? crVocalization . vcCoolDown == Just 0 = let soundid = evalState (takeOne (_vcWarnings (_crVocalization cr))) (_randGen w) numjits = fst $ randomR (15,25) (_randGen w) - in crActionPlan . crStrategy .~ StrategyActions WarningCry + in crActionPlan . apStrategy .~ StrategyActions WarningCry [ImpulsesList ([Bark soundid]: replicate numjits [RandomImpulse thejitter]++ [[ChangeStrategy $ CloseToMelee 0] ]) , AimAt 0 (_crPos $ _creatures w IM.! 0) diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index 294e5ecc3..88bdfcb32 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -38,14 +38,8 @@ pistolCrit = defaultCreature , targetYouWhenCognizant , const $ overrideInternal (\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr) - (crActionPlan . crStrategy .~ WatchAndWait) + (crActionPlan . apStrategy .~ WatchAndWait) ] - , _crActionPlan = ActionPlan - { _crImpulse = [] - , _crAction = [] - , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] - , _crGoal = [] - } , _crInv = IM.fromList [(0,pistol),(1,medkit 100)] , _crRad = 10 , _crHP = 500 diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 0e1d1e6c3..9794b435b 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -37,7 +37,7 @@ 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 . crImpulse .~ [Melee $ _crID tcr] + = cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr] | otherwise = cr where cpos = _crPos cr @@ -48,7 +48,7 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos int = _crIntention cr mtpos = do tpos <- _crPos <$> _targetCr int - if hasLOS (_crPos cr) tpos w + if hasLOSIndirect (_crPos cr) tpos w then Just tpos else Nothing mpos = mtpos @@ -89,26 +89,26 @@ flockACC w cr = case cr ^? crIntention . targetCr . _Just of in cr & crIntention . mvToPoint ?~ tpos +.+ horShift chaseCritMv :: World -> Creature -> Creature -chaseCritMv w cr = case _crStrategy (_crActionPlan cr) of +chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of StrategyActions _ _ -> cr WarningCry -> cr _ -> case cr ^? crIntention . mvToPoint . _Just of - Just p -> cr & crActionPlan . crAction .~ [PathTo p] + Just p -> cr & crActionPlan . apAction .~ [PathTo p] _ -> viewTarget w cr goToTarget :: World -> Creature -> Creature goToTarget w cr = case cr ^? crIntention . mvToPoint . _Just of - Just p -> cr & crActionPlan . crAction .~ [PathTo p] + Just p -> cr & crActionPlan . apAction .~ [PathTo p] _ -> viewTarget w cr viewTarget :: World -> Creature -> Creature viewTarget w cr = do case cr ^? crIntention . viewPoint . _Just of Just p | hasLOSIndirect p (_crPos cr) w -> cr' - & crActionPlan . crAction %~ replaceNullWith (TurnToA p) + & crActionPlan . apAction %~ replaceNullWith (TurnToA p) & crIntention . viewPoint .~ Nothing - | otherwise -> cr' & crActionPlan . crAction %~ replaceNullWith (PathTo p) + | otherwise -> cr' & crActionPlan . apAction %~ replaceNullWith (PathTo p) Nothing -> cr-- & crPerception . crAwakeLevel .~ Lethargic where cr' = cr & crPerception . cpVigilance .~ Vigilant @@ -118,16 +118,16 @@ replaceNullWith x [] = [x] replaceNullWith _ xs = xs doStrategyActions :: Creature -> Creature -doStrategyActions cr = case cr ^? crActionPlan . crStrategy of - Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs - & crActionPlan . crStrategy .~ strat +doStrategyActions cr = case cr ^? crActionPlan . apStrategy of + Just (StrategyActions strat acs) -> cr & crActionPlan . apAction .~ acs + & crActionPlan . apStrategy .~ strat _ -> cr reloadOverride :: Creature -> Creature reloadOverride cr | cr ^? crInv . ix (crSel cr) . itConsumption . laLoaded == Just 0 && cr ^. crStance . posture == Aiming - = cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions + = cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions | otherwise = cr where reloadActions = @@ -147,9 +147,9 @@ watchUpdateStrat -> World -> Creature -> Creature -watchUpdateStrat fs w cr = case cr ^? crActionPlan . crStrategy of +watchUpdateStrat fs w cr = case cr ^? crActionPlan . apStrategy of Just WatchAndWait -> cr - & crActionPlan . crStrategy .~ listGuard (map (first uncurry) fs, \_ _ -> WatchAndWait) (w, cr) w cr + & crActionPlan . apStrategy .~ listGuard (map (first uncurry) fs, \_ _ -> WatchAndWait) (w, cr) w cr _ -> cr listGuard :: ([(a -> Bool, b)] , b) -> a -> b @@ -167,8 +167,8 @@ targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of turnIfDamaged :: Creature -> Creature turnIfDamaged cr - | _crPastDamage cr > 0 = case _crStrategy (_crActionPlan cr) of + | _crPastDamage cr > 0 = case _apStrategy (_crActionPlan cr) of WatchAndWait -> cr & crPerception . cpVigilance .~ Vigilant - & crActionPlan . crStrategy .~ StrategyActions LookAround [TurnToA (_crPos cr -.- unitVectorAtAngle (_crDir cr))] + & crActionPlan . apStrategy .~ StrategyActions LookAround [TurnToA (_crPos cr -.- unitVectorAtAngle (_crDir cr))] _ -> cr | otherwise = cr diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs index 06686285c..dedffd604 100644 --- a/src/Dodge/Creature/SentinelAI.hs +++ b/src/Dodge/Creature/SentinelAI.hs @@ -62,7 +62,7 @@ sentinelFireType f = chainCreatureUpdates , targetYouWhenCognizant , const $ overrideInternal (\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr) - (crActionPlan . crStrategy .~ WatchAndWait) + (crActionPlan . apStrategy .~ WatchAndWait) ] where drawwp = DoActionIfElse NoAction (const crIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction)) @@ -85,7 +85,7 @@ sentinelExtraWatchUpdate xs = chainCreatureUpdates , targetYouWhenCognizant , const $ overrideInternal (\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr) - (crActionPlan . crStrategy .~ WatchAndWait) + (crActionPlan . apStrategy .~ WatchAndWait) ] --shootAtAdvance :: Int -> [Action] diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index 8cf33d404..aa9cc6edc 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -43,14 +43,8 @@ spreadGunCrit = defaultCreature ,targetYouWhenCognizant ,const $ overrideInternal (\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr) - (\ cr -> cr & crActionPlan . crStrategy .~ WatchAndWait) + (\ cr -> cr & crActionPlan . apStrategy .~ WatchAndWait) ] - , _crActionPlan = ActionPlan - { _crImpulse = [] - , _crAction = [] - , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] - , _crGoal = [] - } , _crInv = IM.fromList [(0,bangStick 6),(1,medkit 100)] , _crRad = 10 , _crHP = 500 diff --git a/src/Dodge/Creature/Strategy.hs b/src/Dodge/Creature/Strategy.hs index c40e9050e..846a638db 100644 --- a/src/Dodge/Creature/Strategy.hs +++ b/src/Dodge/Creature/Strategy.hs @@ -9,7 +9,7 @@ import Dodge.Creature.Volition import Data.List goToPostStrat :: Creature -> Strategy -goToPostStrat cr = case find sentinelGoal $ _crGoal $ _crActionPlan cr of +goToPostStrat cr = case find sentinelGoal $ _apGoal $ _crActionPlan cr of Just (SentinelAt p _) -> StrategyActions (GetTo p) [DoActionThen (WaitThen 150 holsterIfAiming) $ DoActionThen (PathTo p) diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index ab3cc4da7..10dc6bb63 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -64,10 +64,10 @@ crSafeDistFromTarg d cr = case cr ^? crIntention . targetCr . _Just of Nothing -> True crStratConMatches :: Strategy -> Creature -> Bool -crStratConMatches strat cr = eqConstr strat (_crStrategy $ _crActionPlan cr) +crStratConMatches strat cr = eqConstr strat (_apStrategy $ _crActionPlan cr) crAwayFromPost :: Creature -> Bool -crAwayFromPost cr = case find sentinelGoal . _crGoal $ _crActionPlan cr of +crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of Just (SentinelAt p _) -> dist p (_crPos cr) > 15 _ -> False where diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 46ba3b1c5..01891dc87 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -1059,10 +1059,10 @@ data PushSource = PushesItself data ActionPlan = Inanimate | ActionPlan - {_crImpulse :: [Impulse] - ,_crAction :: [Action] - ,_crStrategy :: Strategy - ,_crGoal :: [Goal] + {_apImpulse :: [Impulse] + ,_apAction :: [Action] + ,_apStrategy :: Strategy + ,_apGoal :: [Goal] } data Impulse = Move Point2 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index a723abcaa..eba8b9496 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -62,7 +62,7 @@ defaultCreature = Creature ,_strideLength = yourDefaultStrideLength } , _crVocalization = Mute - , _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper] + , _crActionPlan = ActionPlan [] [] (StrategyActions WatchAndWait [StartSentinelPost]) [LiveLongAndProsper] , _crPerception = defaultPerceptionState , _crMemory = defaultCreatureMemory , _crMeleeCooldown = 0 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 393c1a8c1..a89644065 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -42,16 +42,16 @@ initialAnoTree = OnwardList $ intersperse (AnTree corDoor) [ IntAnno $ AnTree . startRoom , AnRoom $ return airlock0 + , AnRoom $ roomCCrits 1 , AnRoom slowDoorRoom --- , AnRoom $ roomCCrits 10 , AnTree firstBreather --- , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward --- ] --- ---extraAnoList :: [Annotation] ---extraAnoList = ----- , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor]) --- [ AnRoom $ roomCCrits 10 + , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward + ] + +extraAnoList :: [Annotation] +extraAnoList = +-- , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor]) + [ AnRoom $ roomCCrits 10 , AnRoom $ roomCCrits 10 , AnTree $ tToBTree "spawners" <$> spawnerRoom , AnRoom pistolerRoom diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index bc9c5530e..9f2026838 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -41,6 +41,6 @@ initialWorld = defaultWorld } testStringInit :: Configuration -> World -> [String] -testStringInit _ w = [show $ _boundDist w] +testStringInit _ _ = [] --testStringInit = map (show . _drStatus) . IM.elems . _doors --testStringInit = const . const [] diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index 80bc19838..44545cc01 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -54,7 +54,7 @@ makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2] makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween a b w pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2 -pointTowardsImpulse a b w = find (flip (isWalkable a) w) =<< makePathBetweenPs a b w +pointTowardsImpulse a b w = (find (flip (isWalkable a) w) . reverse) =<< makePathBetweenPs a b w ------ continues a walk from a list of points, without repetitions ------ supposes that the list is non-empty diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index 876376190..83499e056 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -93,7 +93,7 @@ updateTurret rotSpeed mc w | _tuFireTime (_mcType mc) > 0 = fromMaybe id $ do cid <- _tuMCrID (_mcType mc) - return $ creatures . ix cid . crActionPlan . crImpulse .~ [UseItem] + return $ creatures . ix cid . crActionPlan . apImpulse .~ [UseItem] | otherwise = id mcid = _mcID mc ypos = _crPos $ you w diff --git a/src/Dodge/Render/InfoBox.hs b/src/Dodge/Render/InfoBox.hs index bcb9dc033..175167e74 100644 --- a/src/Dodge/Render/InfoBox.hs +++ b/src/Dodge/Render/InfoBox.hs @@ -13,9 +13,9 @@ import Geometry --import Data.Maybe renderInfoListAt :: Float -> Float -> Configuration -> World -> (Point2,[String]) -> Picture -renderInfoListAt x y cfig w (p,ss) = renderListAt x y cfig (zip ss (repeat yellow)) - <> winScale cfig (color yellow $ lConnect (V2 (x-hw) (hh-25-y)) (worldPosToScreen w p)) - <> listCursorNSW x y cfig 0 yellow 19 (length ss) +renderInfoListAt x y cfig w (p,ss) = renderListAt x y cfig (zip ss (repeat white)) + <> winScale cfig (color white $ lConnect (V2 (x-hw) (hh-25-y)) (worldPosToScreen w p)) + <> listCursorNSW x y cfig 0 white 19 (length ss) where hw = halfWidth cfig hh = halfHeight cfig diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 3629065b8..7243a6895 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -25,6 +25,7 @@ import ShapePicture import Picture import Sound.Data import Geometry.ConvexPoly +import ShortShow --import Dodge.Base.Collide --import Data.Foldable @@ -36,6 +37,7 @@ import Data.Maybe import qualified Streaming.Prelude as S import qualified Data.Graph.Inductive as FGL import qualified Data.Set as Set +import Padding -- TODO only filter out shapes outside the range of the furthest shown light source worldSPic :: Configuration -> World -> SPic @@ -79,7 +81,7 @@ extraPics cfig w = pictures (_decorations w) <> concatMapPic clDraw (_clouds w ) <> concatMapPic ppDraw (_pressPlates w ) <> viewClipBounds cfig w --- <> debugDraw cfig w + <> debugDraw cfig w debugDraw :: Configuration -> World -> Picture {-# INLINE debugDraw #-} @@ -126,6 +128,7 @@ drawPathBetween w = setLayer DebugLayer $ color rose (foldMap (arrowPath . mapMaybe nodepos) nodelist) <> foldMap (color green . arrow sp) (nodepos =<< walkableNodeNear w sp) <> foldMap (color cyan . flip arrow ep) (nodepos =<< walkableNodeNear w ep) + <> foldMap (color orange . arrow sp) (pointTowardsImpulse sp ep w) where nodepos = (`getNodePos` w) nodelist = makePathBetween sp ep w @@ -309,16 +312,16 @@ drawPathing cfig w = setLayer DebugLayer crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2,[String]) crDisplayInfo cfig w cr --- | _crID cr == 0 = Nothing + | _crID cr == 0 = Nothing | crOnScreen = Just (_crPos cr, catMaybes -- [fmap show $ ap ^? crGoal - [ fmap show $ cr ^? crHP - , fmap show $ ap ^? crStrategy - , fmap show $ cr ^? crPos - , fmap show $ cr ^? crPerception . cpVigilance + [ fpreShow "crHP" $ cr ^? crHP + , fpreShow "crStrategy" $ ap ^? apStrategy + , fmap (("crPos....." ++) . shortShow) $ cr ^? crPos + , fpreShow "cpVigilance" $ cr ^? crPerception . cpVigilance -- , fmap show $ cr ^? crOldPos - , fmap show $ ap ^? crAction - , fmap show $ ap ^? crImpulse + , fpreShow "crAction" $ ap ^? apAction + , fpreShow "crImpulse" $ ap ^? apImpulse ] ) | otherwise = Nothing @@ -326,6 +329,9 @@ crDisplayInfo cfig w cr ap = _crActionPlan cr crOnScreen = pointOnScreen cfig w $ _crPos cr +fpreShow :: (Show a,Functor f) => String -> f a -> f String +fpreShow str = fmap (((rightPad 7 '.'str ++ "...") ++) . show) + drawCrInfo :: Configuration -> World -> Picture drawCrInfo cfig w = setLayer FixedCoordLayer $ renderInfoListsAt (2*hw - 400) 0 cfig w diff --git a/src/Dodge/Zone/Update.hs b/src/Dodge/Zone/Update.hs index c3fdba974..3b8cc4b7e 100644 --- a/src/Dodge/Zone/Update.hs +++ b/src/Dodge/Zone/Update.hs @@ -20,6 +20,7 @@ insertInZoneWith -> t a -- ^ Value to insert -> Zoning t a -> Zoning t a +{-# INLINE insertInZoneWith #-} insertInZoneWith (V2 x y) fun obj = over znObjects $ IM.insertWith f x $ IM.singleton y obj where f _ = IM.insertWith fun y obj