justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup creatures somewhat, fix LOS to LOSIndirect

Browse Source
This commit is contained in:
justin
2022-07-03 15:07:55 +01:00
parent b43ec42a2e
commit ffdfaa41c0
24 changed files with 81 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+4 -16
View File
@@ -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
src/Dodge/Creature/Action.hs
+3 -3
View File
@@ -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 )
src/Dodge/Creature/ArmourChase.hs
+4 -4
View File
@@ -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
src/Dodge/Creature/AutoCrit.hs
-6
View File
@@ -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
src/Dodge/Creature/Boid.hs
+6 -6
View File
@@ -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
src/Dodge/Creature/Impulse.hs
+4 -4
View File
@@ -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)
src/Dodge/Creature/LauncherCrit.hs
+1 -7
View File
@@ -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
src/Dodge/Creature/LtAutoCrit.hs
+1 -7
View File
@@ -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
src/Dodge/Creature/Perception.hs
+2 -2
View File
@@ -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)
src/Dodge/Creature/PistolCrit.hs
+1 -7
View File
@@ -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
src/Dodge/Creature/ReaderUpdate.hs
+15 -15
View File
@@ -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
src/Dodge/Creature/SentinelAI.hs
+2 -2
View File
@@ -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]
src/Dodge/Creature/SpreadGunCrit.hs
+1 -7
View File
@@ -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
src/Dodge/Creature/Strategy.hs
+1 -1
View File
@@ -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)
src/Dodge/Creature/Test.hs
+2 -2
View File
@@ -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
src/Dodge/Data.hs
+4 -4
View File
@@ -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
src/Dodge/Default.hs
+1 -1
View File
@@ -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
src/Dodge/Floor.hs
+8 -8
View File
@@ -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
src/Dodge/Initialisation.hs
+1 -1
View File
@@ -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 []
src/Dodge/Path.hs
+1 -1
View File
@@ -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
src/Dodge/Placement/Instance/Turret.hs
+1 -1
View File
@@ -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
src/Dodge/Render/InfoBox.hs
+3 -3
View File
@@ -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
src/Dodge/Render/ShapePicture.hs
+14 -8
View File
@@ -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
src/Dodge/Zone/Update.hs
+1
View File
@@ -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