Commit before moving button press events from events into your control

src/Dodge/Creature.hs

@@ -236,6 +236,9 @@ inventoryX c = case c of
         , makeTypeCraftNum 5 STATICMODULE
         ]
     'H' -> [ shatterGun ]
+    'I' -> [ makeTypeCraft TELEPORTMODULE
+           , makeTypeCraftNum 2 MICROCHIP 
+           ]
     _ -> []
 
 testInventory :: IM.IntMap Item

src/Dodge/Data.hs

@@ -165,7 +165,7 @@ data World = World
     , _rewindWorlds         :: [World]
     , _timeFlow             :: TimeFlowStatus
     , _worldClock           :: Int
-    , _doubleMouseHammer    :: HammerPosition
+    , _hammers              :: M.Map WorldHammer HammerPosition
     , _backspaceTimer       :: Int
     , _genParams            :: GenParams
     , _genPlacements        :: IM.IntMap [(Placement,Int)]
@@ -174,6 +174,10 @@ data World = World
     , _testFloat            :: Float
     , _wSelect              :: (Point2,Point2)
     }
+data WorldHammer
+    = SubInvHam
+    | DoubleMouseHam
+  deriving (Eq,Ord,Show,Enum,Bounded)
 
 newtype GenParams = GenParams
     { _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape)

src/Dodge/Data/Zoning.hs

@@ -10,6 +10,7 @@ data Zoning t a = Zoning
     { _znObjects    :: IM.IntMap (IM.IntMap (t a))
     , _znSize       :: Float
     , _znFunc       :: Float -> a -> StreamOf Int2
+--    , _znInsert     :: a -> t a -> t a
     }
 
 makeLenses ''Zoning

src/Dodge/Default/World.hs

@@ -102,7 +102,7 @@ defaultWorld = World
     , _maybeWorld = Nothing'
     , _rewindWorlds = []
     , _timeFlow = NormalTimeFlow
-    , _doubleMouseHammer = HammerUp
+    , _hammers = defaultWorldHammers
     , _backspaceTimer = 0
     , _genParams = GenParams M.empty
     , _genPlacements = IM.empty
@@ -113,6 +113,8 @@ defaultWorld = World
     , _boundDist = (100,-100,100,-100)
     , _wSelect      = (0,0)
     }
+defaultWorldHammers :: M.Map WorldHammer HammerPosition
+defaultWorldHammers = M.fromSet (const HammerUp) $ S.fromList [minBound.. maxBound]
 youLight :: TempLightSource
 youLight = TLS 
     { _tlsParam = LSParam

src/Dodge/Floor.hs

@@ -45,13 +45,13 @@ initialAnoTree = OnwardList
     , 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/Hammer.hs

@@ -3,6 +3,5 @@ import Dodge.Item.Data
 
 moveHammerUp :: HammerPosition -> HammerPosition
 moveHammerUp HammerDown     = HammerReleased
-moveHammerUp HammerReleased = HammerUp
+moveHammerUp _              = HammerUp
-moveHammerUp HammerUp       = HammerUp
 

src/Dodge/Update.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {- |
 Module      : Dodge.Update
 Description : Simulation update
@@ -60,7 +61,7 @@ functionalUpdate cfig w = checkEndGame
     . (worldClock +~ 1)
     . updateWorldSelect
     . doRewind
-    . (doubleMouseHammer %~ moveHammerUp)
+    . (hammers . each %~ moveHammerUp)
     . updateDistortions
     . updateCreatureSoundPositions
     . ppEvents
@@ -146,9 +147,11 @@ doRewind w = case _maybeWorld w of
     Nothing' -> w  & timeFlow .~ NormalTimeFlow
 
 zoneCreatures :: World -> World
-zoneCreatures w = w & crZoning %~ \zn ->
+zoneCreatures w = w 
-    foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr)) 
+    & crZoning . znObjects .~ mempty
-        (zn & znObjects .~ mempty) (_creatures w)
+    & crZoning %~ \zn ->
+        foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr)) 
+            zn (_creatures w)
 
 updateCreatureSoundPositions :: World -> World
 updateCreatureSoundPositions w = M.foldlWithKey' insertSound w 
@@ -286,16 +289,17 @@ ppEvents :: World -> World
 ppEvents w = IM.foldl' (flip $ \pp -> _ppEvent pp pp) w $ _pressPlates w
 
 updateSeenWalls :: World -> World
-updateSeenWalls w = runIdentity $ S.fold_ f w id (S.map (_wlID . snd) $ allVisibleWalls w)
+updateSeenWalls w = runIdentity $ S.fold_ markWallSeen w id (S.map (_wlID . snd) $ allVisibleWalls w)
-  where 
-    f w' i -- = w' & walls . ix i . wlSeen .~ True -- this is much simpler, but leaks
-        = w' { _walls = IM.adjust mw i $ _walls w' }
-    mw wl = wl {_wlSeen = True}
-
---markWallSeen :: World -> Wall -> World
---markWallSeen w wl = w { _walls = IM.adjust mw (_wlID wl) $ _walls w }
 --  where 
---    mw wl' = wl' {_wlSeen = True}
+--    f w' !i -- = w' & walls . ix i . wlSeen .~ True 
+--        = w' { _walls = IM.adjust mw i $ _walls w' }
+--    mw wl = wl {_wlSeen = True}
+
+markWallSeen :: World -> Int -> World
+markWallSeen !w !i = w { _walls = IM.adjust markSeen i $ _walls w }
+
+markSeen :: Wall -> Wall
+markSeen wl = wl {_wlSeen = True}
 
 checkEndGame :: World -> World
 checkEndGame w = case _deathDelay w of

src/Dodge/Update/UsingInput.hs

@@ -17,19 +17,33 @@ updateUsingInput w = case _hudElement $ _hud w of
     DisplayInventory {} -> updatePressedButtons      (_mouseButtons w) w
     DisplayCarte        -> updatePressedButtonsCarte (_mouseButtons w) w
 
+-- ugly check for subinventory inventory hammer, this should change
 updatePressedButtons :: M.Map MouseButton Bool -> World -> World
 updatePressedButtons pkeys w
+    | ButtonLeft `M.member` pkeys && 
+        (inSubInv || w ^?! hammers . ix SubInvHam /= HammerUp)
+                = undefined --w & hammers . ix SubInvHam .~ HammerDown
+    | otherwise = updatePressedButtons' pkeys w
+  where
+    inSubInv = case _hudElement (_hud w) of
+        DisplayInventory NoSubInventory -> False
+        DisplayInventory _ -> True
+        _ -> False
+
+updatePressedButtons' :: M.Map MouseButton Bool -> World -> World
+updatePressedButtons' pkeys w 
     | isDown ButtonLeft && isDown ButtonRight && inTopInv 
-        = useItem (you w) w & doubleMouseHammer .~ HammerDown
+        = useItem (you w) w & hammers . ix DoubleMouseHam .~ HammerDown
     | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame)
-            && _doubleMouseHammer w == HammerUp
+            && w ^?! hammers . ix DoubleMouseHam == HammerUp
         = useLeftItem (_yourID w) w
     | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame)
-        = w & doubleMouseHammer .~ HammerDown
+        = w & hammers . ix DoubleMouseHam .~ HammerDown
     | isDown ButtonRight && inTopInv = w
     | isDown ButtonMiddle 
         = w & cameraRot     -~ rotation
             & clickMousePos .~ _mousePos w 
+    | isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown
     | otherwise = w
   where 
     inTopInv = case _hudElement (_hud w) of