Assorted changes, cleanup menu selection text

src/Dodge/Base/Collide.hs

@@ -79,7 +79,7 @@ pointHitsWalls p1 p2
 collidePointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 collidePointWalkable p1 p2 ws 
     = any (isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
-    $ IM.filter (fromMaybe True . (^? wlPathable)) ws
+    $ IM.filter (not . fromMaybe True . (^? wlPathable)) ws
 
 --furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
 --furthestPointWalkable p1 p2 ws 
@@ -179,7 +179,8 @@ hasLOSIndirect p1 p2 w = case collidePointIndirect' p1 p2 $ wallsAlongLine p1 p2
 isWalkable :: Point2 -> Point2 -> World -> Bool
 isWalkable p1 p2 w = not 
     $ collidePointWalkable p1 p2 
-    $ wallsAlongLine p1 p2 w
+    $ _walls w
+--    $ wallsAlongLine p1 p2 w
 
 canSee :: Int -> Int -> World -> Bool
 canSee i j w = hasLOS p1 p2 w

src/Dodge/Base/Coordinate.hs

@@ -14,11 +14,10 @@ worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTransla
  - These have to be scaled according to the size of the window to get actual screen positions.
  - This allows for line thicknesses etc to correspond to pixel sizes.-}
 worldPosToScreen :: World -> Point2 -> Point2
-worldPosToScreen w = doRotate . doZoom . doTranslate
+worldPosToScreen w 
-  where
+    = rotateV (negate $ _cameraRot w) 
-    doTranslate p       = p -.- _cameraCenter w
+    . (_cameraZoom w *.*)
-    doZoom p            = _cameraZoom w *.* p
+    . (-.- _cameraCenter w)
-    doRotate p          = rotateV (negate $ _cameraRot w) p
 {- | Transform coordinates from the map position to screen
 coordinates.  -}
 cartePosToScreen :: Configuration -> World -> Point2 -> Point2

src/Dodge/Config/Data.hs

@@ -22,6 +22,7 @@ data Configuration = Configuration
     , _debug_noclip         :: Bool
     , _debug_cr_status      :: Bool
     , _debug_cr_awareness   :: Bool
+    , _debug_mouse_position :: Bool
     , _debug_view_boundaries :: Bool
     , _debug_view_clip_bounds :: RoomClipping
     , _debug_pathing        :: Bool
@@ -66,6 +67,7 @@ defaultConfig = Configuration
     , _debug_show_sound           = False
     , _debug_seconds_frame  = True
     , _debug_noclip         = False
+    , _debug_mouse_position = False
     , _debug_cr_status      = False
     , _debug_cr_awareness   = False
     , _debug_view_boundaries = False

src/Dodge/Creature/Action.hs

@@ -18,6 +18,7 @@ module Dodge.Creature.Action
     )
     where
 import Dodge.Inventory.Add
+--import Dodge.ShortShow
 import Dodge.Path
 import Dodge.Default
 import Dodge.WallCreatureCollisions
@@ -65,14 +66,27 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
 performPathTo :: Creature -> World -> Point2 -> OutAction
 performPathTo cr w p
     | dist cpos p < 5 = ([], Nothing)
-    | hasLOS cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p))
+    | isWalkable cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p))
-    | otherwise       = case pointTowardsImpulse cpos p w of
+    | otherwise = case pointTowardsImpulse p cpos w of
-        Just q -> ([MvTurnToward q,MvForward,RandomTurn jit] , Just (PathTo p))
+        Just q -> ([MvTurnToward q
+                ,MvForward
+                ,RandomTurn jit
+                ,ArbitraryImpulseEffect . const 
+                    $ debugPicture .~ drawPathList cpos p w
+                ] 
+            , Just (PathTo p))
         _ -> ([],Nothing)
   where
     cpos = _crPos cr
     jit = _mvTurnJit $ _crMvType cr
 
+drawPathList :: Point2 -> Point2 -> World -> Picture
+drawPathList x y w = case makePathBetweenPs x y w of
+    Nothing -> setLayer DebugLayer $ color red $ line [x,y]
+    Just [] -> setLayer DebugLayer $ color green $ line [x,y]
+    Just as -> setLayer DebugLayer $ color orange (line as)
+                        <> color blue (line [head as,x]) <> color yellow (line [last as, y])
+
 performTurnToA :: Creature -> Point2 -> OutAction
 performTurnToA cr p
     | angleVV cdirv dirv < 0.1 = ([], Nothing)

src/Dodge/Creature/ChaseCrit.hs

@@ -35,9 +35,9 @@ chaseCrit = defaultCreature
         , performActions
         , const overrideMeleeCloseTarget
         , const setViewPos
-        , const setMvPos
+        , setMvPos
-        , goToTarget
+        , chaseCritMv
-        , perceptionUpdate [0]
+        , chaseCritPerceptionUpdate [0]
         , targetYouWhenCognizant
         , const (crMeleeCooldown %~ max 0 . subtract 1)
         ]
@@ -47,12 +47,5 @@ chaseCrit = defaultCreature
     , _crMeleeCooldown = 0
     , _crFaction = ColorFaction green
     , _crVocalization = Vocalization seagullChatterS 50 0
-    , _crMvType = ChaseMvType
+    , _crMvType = defaultChaseMvType
-        { _mvSpeed = 3
-        , _mvTurnRad = f
-        , _mvTurnJit = 0.2
-        }
     }
-  where
-    f x | x > pi / 4 = 0.2
-        | otherwise  = 0.05

src/Dodge/Creature/Impulse.hs

@@ -67,6 +67,7 @@ followImpulse cr w imp = case imp of
     AddGoal gl      -> crup $ cr & crActionPlan . crGoal .:~ gl 
     ArbitraryImpulseFunction f  -> crup $ f w cr
     ArbitraryImpulse f  -> followImpulse cr w (f cr w) 
+    ArbitraryImpulseEffect f -> (f cr, cr)
     ImpulseUseTargetCID f   -> case cr ^? crIntention . targetCr . _Just of
         Just tcr -> followImpulse cr w (f $ _crID tcr)
         _        -> crup cr

src/Dodge/Creature/Perception.hs

@@ -1,11 +1,13 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Creature.Perception
     ( perceptionUpdate
+    , chaseCritPerceptionUpdate
     , newSounds
     ) where
 import Dodge.Data
 import Dodge.Creature.Vocalization
 import Dodge.Base.Collide
+import Dodge.RandomHelp
 --import Dodge.SoundLogic
 import Geometry.Vector
 --import Geometry.Data
@@ -13,6 +15,7 @@ import Geometry.Data
 import Sound.Data
 --import StrictHelp
 
+import Control.Monad.State
 import Data.Maybe
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
@@ -25,10 +28,16 @@ perceptionUpdate
     -> Creature
 perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate . basicAttentionUpdate is w
 
+chaseCritPerceptionUpdate :: [Int] -> World -> Creature -> Creature
+chaseCritPerceptionUpdate is w = 
+    rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w
+
 {- | Update a creatures awareness based upon the creatures' current direction
  of attention -}
 basicAwarenessUpdate :: Creature -> Creature
 basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
+    Fixated i -> cr & crPerception . crAwarenessLevel 
+        %~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
     AttentiveTo is -> cr 
         & crPerception . crAwarenessLevel 
             %~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
@@ -41,8 +50,29 @@ basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of
             Just sid -> crActionPlan . crImpulse .~ [Bark sid]
             Nothing -> id
                    | otherwise = id
-    Fixated i       -> cr & crPerception . crAwarenessLevel 
+
-                         %~ ( IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
+chaseCritAwarenessUpdate :: World -> Creature -> Creature
+chaseCritAwarenessUpdate w cr = case _crAttentionDir $ _crPerception cr of
+    Fixated i -> cr & crPerception . crAwarenessLevel 
+        %~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
+    AttentiveTo is -> cr 
+        & crPerception . crAwarenessLevel 
+            %~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
+        & maybeBark
+      where
+        oldAwareness = _crAwarenessLevel $ _crPerception cr
+        newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
+        becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
+        randBool = takeOne [False,True] & evalState $ _randGen w
+        maybeBark  
+            | becomesCognizant && randBool = 
+                crActionPlan . crStrategy .~ StrategyActions WarningCry 
+                    [DoImpulses [Bark $ fromJust $ vocalizationTest cr]
+                        `DoActionThen` 20 
+                        `WaitThen` DoImpulses [ChangeStrategy $ CloseToMelee 0]
+                    , AimAt 0 (_crPos $ _creatures w IM.! 0)
+                    ]
+            | otherwise = id
 
 cogRaised :: AwarenessLevel -> AwarenessLevel -> AwarenessLevel
 cogRaised Suspicious{} Cognizant{} = Cognizant 100
@@ -76,7 +106,7 @@ basicAttentionUpdate
     -> Creature
     -> Creature
 basicAttentionUpdate cids w cr = cr & crPerception . crAttentionDir .~
-        AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
+    AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
 
 newExtraAwareness 
     :: Creature -- ^ source creature
@@ -110,7 +140,13 @@ newSounds = mapMaybe f . M.elems . _playingSounds
 
 rememberSounds :: World -> Creature -> Creature
 rememberSounds w cr = cr 
-    & crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) (newSounds w))
+    & crMemory . soundsToInvestigate .~ closesounds
+    & awakeupdate
+  where
+    awakeupdate | null closesounds = id
+        | otherwise = crPerception . crAwakeLevel .~ Vigilant
+    closesounds = map fst (filter (soundIsClose cr) (newSounds w))
+    
 
 soundIsClose :: Creature -> (Point2,Float) -> Bool
 soundIsClose cr (pos,vol) = vol > (_auDist . _crAudition $ _crPerception cr) (dist pos (_crPos cr))

src/Dodge/Creature/ReaderUpdate.hs

@@ -9,6 +9,7 @@ module Dodge.Creature.ReaderUpdate
     , overrideInternal
     , goToTarget
     , flockACC
+    , chaseCritMv
     , setMvPos
     , setViewPos
     ) where
@@ -38,11 +39,16 @@ tryMeleeAttack cr tcr
   where
     cpos = _crPos cr
 
-setMvPos :: Creature -> Creature
+setMvPos :: World -> Creature -> Creature
-setMvPos cr = cr & crIntention . mvToPoint .~ mpos
+setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
   where
     int = _crIntention cr
-    mpos = (_crPos <$> _targetCr int) 
+    mtpos = do
+        tpos <- _crPos <$> _targetCr int
+        if hasLOS (_crPos cr) tpos w
+            then Just tpos
+            else Nothing
+    mpos = mtpos 
         <|> _mvToPoint int 
 --        <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
 
@@ -80,6 +86,14 @@ flockACC w cr = case cr ^? crIntention . targetCr . _Just of
                             else negate r *.* horDir
                     in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
 
+chaseCritMv :: World -> Creature -> Creature
+chaseCritMv w cr = case _crStrategy (_crActionPlan cr) of
+    StrategyActions _ _ -> cr
+    WarningCry -> cr
+    _ -> case cr ^? crIntention . mvToPoint . _Just of
+        Just p -> cr & crActionPlan . crAction .~ [PathTo p]
+        _ -> viewTarget w cr
+
 goToTarget :: World -> Creature -> Creature
 goToTarget w cr =
     case cr ^? crIntention . mvToPoint . _Just of

src/Dodge/Creature/State.hs

@@ -129,25 +129,27 @@ movementSideEff cr w
     (randAng,_) = randomR (0,2*pi) $ _randGen w
 
 heldItemUpdate :: Int -> Item -> Item
-heldItemUpdate invid = (itIsHeld .~ True) . invItemUpdate invid
+heldItemUpdate invid = (itUse %~ useUpdate) . (itIsHeld .~ True) . (itInvPos ?~ invid)
 
 invItemUpdate :: Int -> Item -> Item
-invItemUpdate invid = (itUse %~ useupdate) . (itIsHeld .~ False) . (itInvPos ?~ invid)
+invItemUpdate invid = (itUse %~ useUpdate) . (itIsHeld .~ False) . (itInvPos ?~ invid)
-  where
+
-    useupdate = (useHammer . hammerPosition %~ moveHammerUp)
+useUpdate :: ItemUse -> ItemUse
+useUpdate = (useHammer . hammerPosition %~ moveHammerUp)
         . (useDelay . warmTime %~ decreaseToZero)
         . (useDelay . rateTime %~ decreaseToZero)
 
+useEquipment :: Creature -> Int -> World -> World
+useEquipment cr i = _eqUse (_itUse $ _crInv cr IM.! i) cr i
+
 invSideEff :: Creature -> World -> World
 invSideEff cr w = weaponReloadSounds cr 
-    . flip (IS.foldr useeq) (_crInvEquipped cr)
+    . flip (IS.foldr $ useEquipment cr) (_crInvEquipped cr)
---    . doHeldItemTargeting cr
     $ IM.foldrWithKey f w (_crInv cr)
   where 
-    useeq i = _eqUse (_itUse $ _crInv cr IM.! i) cr i
+    f i it w' = doitemupdate w' & case it ^? itEffect . itInvEffect of
-    f i it w' = case it ^? itEffect . itInvEffect of
+        Nothing -> id
-        Nothing -> w' & doitemupdate
+        Just g  -> g (heldItemUpdate i it) cr -- this is done twice!
-        Just g  -> g (_itEffect it) cr i w' & doitemupdate
       where
         doitemupdate
             | i == _crInvSel cr = doItemTargeting i cr . (itpointer %~ heldItemUpdate i) 

src/Dodge/Data.hs

@@ -21,6 +21,7 @@ module Dodge.Data
     , module Dodge.Item.Data
     , module Dodge.Config.Data
     ) where
+import Dodge.ShortShow
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.Perception.Data
@@ -100,6 +101,7 @@ data World = World
     , _floorTiles           :: [(Point3,Point3)]
     , _randGen              :: StdGen
     , _testString           :: World -> [String]
+    , _debugPicture         :: Picture
     , _modifications        :: IM.IntMap Modification
     , _yourID               :: Int
     , _worldEvents          :: World -> World
@@ -197,14 +199,14 @@ data MenuOption
     = Toggle
         { _moKey    :: Scancode
         , _moEff    :: Universe -> IO (Maybe Universe)
-        , _moString :: Universe -> String
+        , _moString :: Universe -> Either String (String,String)
         }
     | Toggle2
         { _moKey1   :: Scancode
         , _moEff1   :: Universe -> IO (Maybe Universe)
         , _moKey2   :: Scancode
         , _moEff2   :: Universe -> IO (Maybe Universe)
-        , _moString :: Universe -> String
+        , _moString :: Universe -> Either String (String,String)
         }
     | InvisibleToggle
         { _moKey    :: Scancode
@@ -308,12 +310,7 @@ data Intention = Intention
 data CrMvType 
     = NoMvType
     | MvWalking { _mvSpeed :: Float }
-    | ChaseMvType
+    | CrMvType
-        { _mvSpeed   :: Float
-        , _mvTurnRad :: Float -> Float
-        , _mvTurnJit :: Float
-        }
-    | AimMvType
         { _mvSpeed      :: Float
         , _mvTurnRad    :: Float -> Float
         , _mvTurnJit    :: Float
@@ -478,27 +475,24 @@ data ReloadType
 -- I believe this is called every frame, not sure when though
 data ItEffect 
     = NoItEffect
-    | ItSimpleInvEffect 
+--    | ItSimpleInvEffect 
-        {_itInvEffect       :: ItEffect -> Creature -> Int -> World -> World
+--        {_itInvEffect       :: Item -> Creature -> World -> World
-                -- the Int is the items inventory position
+--        }
-        }
     | ItInvEffect 
-        {_itInvEffect       :: ItEffect -> Creature -> Int -> World -> World
+        {_itInvEffect       :: Item -> Creature -> World -> World
-                -- the Int is the items inventory position
         ,_itEffectCounter   :: Int
         }
     | ItRewindEffect
-        {_itInvEffect       :: ItEffect -> Creature -> Int -> World -> World
+        {_itInvEffect       :: Item -> Creature -> World -> World
         ,_itStoredWorlds    :: [World]
         }
     | ItEffect 
-        {_itInvEffect       :: ItEffect -> Creature -> Int -> World -> World 
+        {_itInvEffect       :: Item -> Creature -> World -> World 
         ,_itFloorEffect     :: Int -> World -> World 
         ,_itEffectCounter   :: Int
         }
     | ItInvEffectID
-        {_itInvEffect       :: ItEffect -> Creature -> Int -> World -> World
+        {_itInvEffect       :: Item -> Creature -> World -> World
-                -- the Int is the items inventory position
         ,_itEffectID   :: Maybe Int
         }
 data IntID a = IntID Int a
@@ -932,6 +926,7 @@ data Impulse
     | AddGoal Goal
     | ArbitraryImpulseFunction (World -> Creature -> Creature) 
     | ArbitraryImpulse (Creature -> World -> Impulse) 
+    | ArbitraryImpulseEffect (Creature -> World -> World) 
     | ImpulseUseTargetCID
         {_impulseUseTargetCID :: Int -> Impulse
         }
@@ -943,14 +938,14 @@ data Impulse
         }
 instance Show Impulse where
     show imp = case imp of
-        Move p -> "Move "++show p
+        Move p -> "Move "++shortPoint2 p
         MoveForward f -> "MoveForward "++ show f
         Turn f -> "Turn "++show f
         RandomTurn f -> "RandomTurn "++show f
-        TurnToward p f -> "TurnToward "++show p++show f
+        TurnToward p f -> "TurnToward "++shortPoint2 p++show f
-        MvTurnToward p -> "MvTurnToward "++show p
+        MvTurnToward p -> "MvTurnToward "++shortPoint2 p
         MvForward -> "MvForward"
-        TurnTo p -> "TurnTo "++show p
+        TurnTo p -> "TurnTo "++shortPoint2 p
         UseItem -> "UseItem"
         SwitchToItem i -> "SwitchToItem "++show i
         DropItem -> "DropItem"
@@ -962,6 +957,7 @@ instance Show Impulse where
         AddGoal g -> "AddGoal " ++ show g
         ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction"
         ArbitraryImpulse {}  -> "ArbitraryImpulse"
+        ArbitraryImpulseEffect {}  -> "ArbitraryImpulseEffect"
         ImpulseUseTargetCID {} -> "ImpulseUseTargetCID"
         ImpulseUseTarget {} -> "ImpulseUseTarget"
         ImpulseUseAheadPos {} -> "ImpulseUseAheadPos"
@@ -1067,13 +1063,13 @@ instance Show Action where
         AimAt
           {_targetID     = tid
           ,_targetSeenAt = p
-          } -> "AimAt tid:"++show tid++" seenAt:"++show p
+          } -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p
         PathTo 
           {_pathToPoint = p
-          } -> "PathTo:"++show p
+          } -> "PathTo:"++shortPoint2 p
         TurnToA
           {_turnToAPoint = p
-          } -> "TurnToA:"++show p
+          } -> "TurnToA:"++shortPoint2 p
 ----      | PickupItem 
 ----          {_pickupItemID :: Int
 ----          }
@@ -1161,6 +1157,8 @@ data Strategy
     | ShootAt Int
     | FollowImpulses
     | WatchAndWait
+    | WarningCry
+    | CloseToMelee Int
     | StrategyActions Strategy [Action]
     | GetTo Point2
     | Reload

src/Dodge/Default.hs

@@ -101,16 +101,19 @@ defaultIntention = Intention
     , _viewPoint    = Nothing
     }
 defaultChaseMvType :: CrMvType
-defaultChaseMvType = ChaseMvType
+defaultChaseMvType = CrMvType
     { _mvSpeed = 3
     , _mvTurnRad = f
     , _mvTurnJit = 0.2
+    , _mvAimSpeed   = g
     }
   where
+    g x | x > pi/8  = 0.2
+        | otherwise = 0.01
     f x | x > pi / 4 = 0.2
         | otherwise  = 0.05
 defaultAimMvType :: CrMvType
-defaultAimMvType = AimMvType
+defaultAimMvType = CrMvType
     { _mvSpeed      = 3
     , _mvTurnRad    = const 0.2
     , _mvTurnJit    = 0.05

src/Dodge/Default/World.hs

@@ -52,6 +52,7 @@ defaultWorld = World
     , _randGen = mkStdGen 2
     , _mousePos = V2 0 0
     , _testString = const []
+    , _debugPicture = mempty
     , _yourID = 0
     , _worldEvents = id
     , _delayedEvents = []

src/Dodge/Item/Equipment.hs

@@ -14,6 +14,7 @@ import Shape
 import qualified IntMapHelp as IM
 import LensHelp
 
+import Data.Maybe
 magShield :: Item
 magShield = defaultEquipment
     { _itType = MAGSHIELD
@@ -98,9 +99,11 @@ effectOnEquip f = ItInvEffectID
     , _itEffectID = Nothing
     }
   where
-    g f' _ cr invid w 
+    g f' itm cr w 
         | _crInvSel cr == invid = f' cr (_crInv (_creatures w IM.! _crID cr) IM.! invid) w
         | otherwise = w
+      where
+        invid = fromJust $ _itInvPos itm
 
 shieldWall :: Int -> Wall
 shieldWall crid = defaultWall
@@ -156,9 +159,11 @@ effectOnOffEquip f f' = ItInvEffectID
     , _itEffectID = Nothing
     }
   where
-    g _ cr invid w 
+    g itm cr w 
         | _crInvSel cr == invid = f  cr invid w
         | otherwise             = f' cr invid w
+      where
+        invid = fromJust $ _itInvPos itm
 
 {- | Increases speed, reduces friction, cannot only move forwards. -}
 jetPack :: Item

src/Dodge/Item/Weapon/Booster.hs

@@ -123,8 +123,10 @@ boosterGun = defaultGun
 resetAttachmentID :: ItEffect
 resetAttachmentID = ItInvEffect f 0
   where
-    f iteff cr invid w 
+    f itm cr w 
         | _itEffectCounter iteff < 0 = w & pointToIt . itAttachment .~ NoItAttachment
         | otherwise = w & pointToIt . itEffect . itEffectCounter -~ 1
       where
+        iteff = _itEffect itm
+        invid = fromJust $ _itInvPos itm
         pointToIt = creatures . ix (_crID cr) . crInv . ix invid

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -35,22 +35,25 @@ import qualified SDL
 autoRadarEffect :: ItEffect
 autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
   where 
-    f :: Int -> ItEffect -> Creature -> Int -> World -> World
+    f :: Int -> Item -> Creature -> World -> World
-    f 0 _ cr i w = aRadarPulse cr w 
+    f 0 itm cr w = aRadarPulse cr w 
-        & creatures . ix (_crID cr) . crInv . ix i 
+        & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
                                      . itEffect . itInvEffect .~ f 100
-    f t _ cr i w = w 
+    f t itm cr w = w 
-        & creatures . ix (_crID cr) . crInv . ix i 
+        & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm)
                                      . itEffect . itInvEffect .~ f (t-1)
 {- | Automatically send out sonar pulses that detect creatures.  -}
 autoSonarEffect :: ItEffect
-autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
+autoSonarEffect = ItInvEffect {_itInvEffect = f ,_itEffectCounter = 50 }
   where 
-    f :: Int -> ItEffect -> Creature -> Int -> World -> World
+    f :: Item -> Creature -> World -> World
-    f 0 _ cr i w = aSonarPulse cr w 
+    f itm cr w 
-        & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f 140
+        | _itEffectCounter (_itEffect itm) == 0 = aSonarPulse cr w 
-    f t _ cr i w = w 
+            & decreasecounter
-        & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1)
+        | otherwise = decreasecounter w
+      where
+        decreasecounter = creatures . ix (_crID cr) . crInv 
+            . ix (fromJust $ _itInvPos itm) . itEffect . itEffectCounter %~ (\i -> (i - 1) `mod` 50)
 
 defaultTargeting :: Targeting
 defaultTargeting = Targeting

src/Dodge/Item/Weapon/Grenade.hs

@@ -119,7 +119,9 @@ throwGrenade thePayload cr w = setWp $ removePict $ over props addG w
 throwArmReset :: Int -> ItEffect
 throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
   where 
-    f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i
+    f itm cr = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i
+      where
+        i = fromJust $ _itInvPos itm
     counterDown it 
         | _itEffectCounter (_itEffect it) == 0 = it 
             & itUse . useHammer . hammerPosition .~ HammerUp 

src/Dodge/Item/Weapon/Utility.hs

@@ -13,6 +13,7 @@ import qualified IntMapHelp as IM
 import Shape
 import ShapePicture
 
+import Data.Maybe
 --import qualified Data.Map.Strict as M
 import Control.Lens
 
@@ -28,13 +29,14 @@ rewindGun = defaultGun
     , _itEffect = ItRewindEffect rewindEffect []
     , _itUse = defaultlUse {_lUse = \cr invid -> useRewindGun (_crInv cr IM.! invid) cr}
     }
-rewindEffect :: ItEffect -> Creature -> Int -> World -> World
+rewindEffect :: Item -> Creature -> World -> World
-rewindEffect _ cr invid w 
+rewindEffect itm cr w 
     | Just invid == _crLeftInvSel cr = w & rewindWorlds %~ (take maxcharge . (w' : ))
         & ptrWpCharge .~ length (_rewindWorlds w)
     | otherwise = w & rewindWorlds .~ []
         & ptrWpCharge .~ 0
   where
+    invid = fromJust $ _itInvPos itm
     ptrWpCharge = creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge
     maxcharge = _wpMaxCharge . _itConsumption $ _crInv cr IM.! invid
     w' = w & rewindWorlds .~ []

src/Dodge/Menu.hs

@@ -11,6 +11,7 @@ import Dodge.Data
 import Dodge.PreloadData
 import Dodge.Save
 import Dodge.Config.Update
+import Padding
 --import SDL.Internal.Numbered
 --import Preload.Update
 import Dodge.SoundLogic
@@ -33,18 +34,20 @@ pauseMenu :: ScreenLayer
 pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
 pauseMenuOptions :: [MenuOption]
 pauseMenuOptions =
-    [ Toggle ScancodeN (return . Just . startNewGame) (const "NEW LEVEL")
+    [ Toggle ScancodeN (return . Just . startNewGame) (opText "NEW LEVEL")
-    , Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (const "RESTART")
+    , Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
-    , Toggle ScancodeS (pushScreen $ seedStartMenu "START FROM SEED") (const "START FROM SEED")
+    , Toggle ScancodeS (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
-    , Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS")
+    , Toggle ScancodeO (pushScreen optionMenu ) (opText "OPTIONS")
-    , Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS")
+    , Toggle ScancodeC (pushScreen displayControls) (opText "CONTROLS")
     , InvisibleToggle ScancodeEscape (return . const Nothing)
     ]
+  where
+    opText = const . Left
 seedStartMenu :: String -> ScreenLayer
 seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
 seedStartOptions :: [MenuOption]
 seedStartOptions =
-    [ Toggle ScancodeP trySeedFromClipboard (const "PASTE NUMBER FROM CLIPBOARD")
+    [ Toggle ScancodeP trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD")
 --    , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
     ]
 
@@ -64,10 +67,10 @@ optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
 
 optionsOptions :: [MenuOption]
 optionsOptions =
-    [ makeSubmenuOption ScancodeV soundMenu      "VOLUME"
+    [ makeSubmenuOption ScancodeV soundMenu      $ Left "VOLUME"
-    , makeSubmenuOption ScancodeG graphicsMenu   "GRAPHICS"
+    , makeSubmenuOption ScancodeG graphicsMenu   $ Left "GRAPHICS"
-    , makeSubmenuOption ScancodeP gameplayMenu   "GAMEPLAY"
+    , makeSubmenuOption ScancodeP gameplayMenu   $ Left "GAMEPLAY"
-    , makeSubmenuOption ScancodeD debugMenu      "DEBUG OPTIONS"
+    , makeSubmenuOption ScancodeD debugMenu      $ Left "DEBUG OPTIONS"
     ]
 debugMenu :: ScreenLayer
 debugMenu = slTitleOptions
@@ -83,10 +86,11 @@ debugMenuOptions =
     , makeEnumOption ScancodeB debug_view_clip_bounds "SHOW ROOM CLIP" return
     , doption ScancodeP debug_pathing "SHOW PATHING" _debug_pathing
     , doption ScancodeS debug_show_sound     "SHOW VISUAL SOUNDS" _debug_show_sound
+    , doption ScancodeM debug_mouse_position    "SHOW MOUSE POSITION" _debug_mouse_position
     ]
   where
     doption scode l t rec
-        = Toggle scode (return . Just . (config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config w))
+        = Toggle scode (return . Just . (config . l %~ not)) (\w -> Right (t ,show (rec $ _config w)))
 gameplayMenu :: ScreenLayer
 gameplayMenu  = slTitleOptions
     "OPTIONS:GAMEPLAY"
@@ -104,9 +108,9 @@ soundMenu = slTitleOptions
 
 soundMenuOptions :: [MenuOption]
 soundMenuOptions =
-    [ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME:"  _volume_master
+    [ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME"  _volume_master
-    , theoption ScancodeH volume_sound  ScancodeJ "EFFECTS VOLUME:" _volume_sound
+    , theoption ScancodeH volume_sound  ScancodeJ "EFFECTS VOLUME" _volume_sound
-    , theoption ScancodeN volume_music  ScancodeM "MUSIC VOLUME:"   _volume_music
+    , theoption ScancodeN volume_music  ScancodeM "MUSIC VOLUME"   _volume_music
     ]
   where
     theoption scod1 stype scod2 str voltype = Toggle2
@@ -114,7 +118,7 @@ soundMenuOptions =
         (change dec stype)
         scod2
         (change inc stype)
-        (\w -> str ++ show (round $ 10 * voltype (_config w)::Int))
+        (\w -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_config w)::Int)))
     change g vt = return . Just . (config . vt %~ g) . sw
     dec x = max 0 (x - 0.1)
     inc x = min 1 (x + 0.1)

src/Dodge/Menu/OptionType.hs

@@ -7,12 +7,12 @@ import Control.Lens
 makeBoolOption scode lns t = Toggle
     scode 
     (return . Just . (config . lns #%~ not)) 
-    (\u -> t ++ ":" ++ show (u ^# config . lns))
+    (\u -> Right (t , show (u ^# config . lns)))
 
 makeEnumOption scode lns str sideeff = Toggle
     scode
     (\u -> Just <$> sideeff (u & config . lns #%~ cycleEnum) )
-    (\u -> str ++ ":" ++ show (u ^# config . lns))
+    (\u -> Right (str , show (u ^# config . lns)) )
 
 makeSubmenuOption scode submenu t = Toggle scode (pushScreen submenu) (const t)
 

src/Dodge/Path.hs

@@ -30,7 +30,7 @@ makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w)
     walkableNodeNear p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear p
 
 makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
-makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween b a w
+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

src/Dodge/Render/MenuScreen.hs

@@ -54,9 +54,10 @@ drawOptions u title ops footer = pictures $
     , drawFooterText cfig red footer
     ] ++
     zipWith (\s vpos -> placeString (-hw + 50) vpos 0.2 s) 
-        (map (menuOptionToString u) ops') 
+        (map (menuOptionToString u maxOptionLength) ops') 
         [hh-100,hh-150 ..]
   where
+    maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops')
     ops' = filter notInvisible ops
     notInvisible InvisibleToggle {} = False
     notInvisible _ = True
@@ -64,6 +65,11 @@ drawOptions u title ops footer = pictures $
     hw = halfWidth  cfig
     cfig = _config u
 
+optionValueOffset :: Universe -> MenuOption -> Int
+optionValueOffset u mo = case _moString mo u of
+    Left _ -> 0
+    Right (s,_) -> length s
+
 darkenBackground :: Configuration -> Picture
 darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox
 
@@ -87,9 +93,12 @@ drawFooterText cfig col = color col . placeString (-hw + 30) (-hh+10) 0.1
     hh = halfHeight cfig
     hw = halfWidth cfig
 
-menuOptionToString :: Universe -> MenuOption -> String
+menuOptionToString :: Universe -> Int -> MenuOption -> String
-menuOptionToString w mo = theKeys ++ _moString mo w
+menuOptionToString w padAmount mo = theKeys ++ optionText
   where
+    optionText = case _moString mo w of
+        Left s -> s
+        Right (s,t) -> rightPad padAmount '.' s ++ t
     theKeys = case mo of
         Toggle  {_moKey = k} -> stc k : ":"
         Toggle2 {_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"

src/Dodge/Render/ShapePicture.hs

@@ -1,6 +1,7 @@
 module Dodge.Render.ShapePicture
     ( worldSPic
     ) where
+import Dodge.ShortShow
 import Dodge.Config.Data
 import Dodge.Render.InfoBox
 import Dodge.Debug.Picture
@@ -51,11 +52,13 @@ extraPics cfig w = pictures (_decorations w)
     <> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w)
     <> concatMapPic (dbArg _lsPict) (_lightSources w)
     <> testPic w
+    <> _debugPicture w
     <> concatMapPic clDraw (_clouds w      )
     <> concatMapPic ppDraw (_pressPlates w )
     <> soundPics cfig w
     <> viewBoundaries cfig w
     <> viewClipBounds cfig w
+    <> drawMousePosition cfig w
     <> drawPathing cfig w
     <> drawCrInfo cfig w
 
@@ -95,6 +98,19 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
     theScale = 0.15 * f (_soundVolume s * 0.0001)
     f x = 1 - 0.5 * (1 - x)
 
+drawMousePosition :: Configuration -> World -> Picture
+drawMousePosition cfig w
+    | not $ _debug_mouse_position cfig = mempty
+    | otherwise
+        = setLayer FixedCoordLayer . winScale cfig
+            . uncurryV translate p
+            . scale 0.1 0.1
+            . text 
+            $ shortPoint2 mwp 
+  where
+    p = worldPosToScreen w mwp
+    mwp = mouseWorldPos w
+
 drawPathing :: Configuration -> World -> Picture
 drawPathing cfig w
     | _debug_pathing cfig 
@@ -111,9 +127,11 @@ crDisplayInfo cfig w cr
     | _crID cr == 0 = Nothing
     | crOnScreen = Just (_crPos cr, catMaybes
 --        [fmap show $ ap ^? crGoal
---        ,fmap show $ ap ^? crStrategy
+        [fmap show $ cr ^? crHP
-        [fmap show $ cr ^? crPos
+        ,fmap show $ ap ^? crStrategy
-        ,fmap show $ cr ^? crOldPos
+        ,fmap show $ cr ^? crPos
+        ,fmap show $ cr ^? crPerception . crAwakeLevel
+--        ,fmap show $ cr ^? crOldPos
         ,fmap show $ ap ^? crAction
         ,fmap show $ ap ^? crImpulse
         ]
@@ -126,7 +144,7 @@ crDisplayInfo cfig w cr
 drawCrInfo :: Configuration -> World -> Picture
 drawCrInfo cfig w
     | _debug_cr_status cfig = setLayer FixedCoordLayer 
-        $ renderInfoListsAt (2*hw - 200) 0 cfig w
+        $ renderInfoListsAt (2*hw - 400) 0 cfig w
         $ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures w
     | otherwise = mempty
   where