Cleanup creatures somewhat, fix LOS to LOSIndirect

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    = []
+        { _apImpulse    = []
-        , _crAction     = []
+        , _apAction     = []
-        , _crStrategy   = StrategyActions WatchAndWait [StartSentinelPost]
+        , _apStrategy   = StrategyActions WatchAndWait [StartSentinelPost]
-        , _crGoal       = []
+        , _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

@@ -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 . apImpulse .~ concat iss
-    & crActionPlan . crAction .~ catMaybes mayas
+    & 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

@@ -42,10 +42,10 @@ flockArmourChaseCrit = defaultCreature
         ,(1,medkit 200)
         ]
     , _crActionPlan = ActionPlan
-        {_crImpulse     = []
+        {_apImpulse     = []
-        ,_crAction      = []
+        ,_apAction      = []
-        ,_crStrategy    = FollowImpulses
+        ,_apStrategy    = FollowImpulses
-        ,_crGoal        = [Kill 0]
+        ,_apGoal        = [Kill 0]
         }
     , _crMeleeCooldown = 0
     , _crGroup = ShieldGroup

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

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

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
+    ChangeStrategy strat    -> crup $ cr & crActionPlan . apStrategy .~ strat
-    AddGoal gl      -> crup $ cr & crActionPlan . crGoal .:~ gl 
+    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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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
+doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
-    Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs
+    Just (StrategyActions strat acs) -> cr & crActionPlan . apAction .~ acs
-        & crActionPlan . crStrategy .~ strat
+        & 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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -1059,10 +1059,10 @@ data PushSource = PushesItself
 data ActionPlan
     = Inanimate
     | ActionPlan
-        {_crImpulse     :: [Impulse]
+        {_apImpulse     :: [Impulse]
-        ,_crAction      :: [Action]
+        ,_apAction      :: [Action]
-        ,_crStrategy    :: Strategy
+        ,_apStrategy    :: Strategy
-        ,_crGoal        :: [Goal]
+        ,_apGoal        :: [Goal]
         }
 data Impulse
     = Move Point2

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

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
+    , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
---    ]
+    ]
---
+
---extraAnoList :: [Annotation]
+extraAnoList :: [Annotation]
---extraAnoList =
+extraAnoList =
-----     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
+--     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
---    [ AnRoom $ roomCCrits 10
+    [ AnRoom $ roomCCrits 10
     , AnRoom $ roomCCrits 10
     , AnTree $ tToBTree "spawners" <$> spawnerRoom
     , AnRoom pistolerRoom

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 [] 

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

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

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))
+renderInfoListAt x y cfig w (p,ss) = renderListAt x y cfig (zip ss (repeat white))
-    <> winScale cfig (color yellow $ lConnect (V2 (x-hw) (hh-25-y)) (worldPosToScreen w p))
+    <> winScale cfig (color white $ lConnect (V2 (x-hw) (hh-25-y)) (worldPosToScreen w p))
-    <> listCursorNSW x y cfig 0 yellow 19 (length ss)
+    <> listCursorNSW x y cfig 0 white 19 (length ss)
   where
     hw = halfWidth cfig
     hh = halfHeight cfig

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
+        [ fpreShow "crHP" $ cr ^? crHP
-        , fmap show $ ap ^? crStrategy
+        , fpreShow "crStrategy" $ ap ^? apStrategy
-        , fmap show $ cr ^? crPos
+        , fmap (("crPos....." ++) . shortShow) $ cr ^? crPos
-        , fmap show $ cr ^? crPerception . cpVigilance
+        , fpreShow "cpVigilance" $ cr ^? crPerception . cpVigilance
 --        , fmap show $ cr ^? crOldPos
-        , fmap show $ ap ^? crAction
+        , fpreShow "crAction" $ ap ^? apAction
-        , fmap show $ ap ^? crImpulse
+        , 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

@@ -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