From 4b8155ae1690f59c8497f8b08bafaf8249361b68 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 29 Jun 2022 12:12:45 +0100 Subject: [PATCH] Commit before moving button press events from events into your control --- src/Dodge/Creature.hs | 3 +++ src/Dodge/Data.hs | 6 +++++- src/Dodge/Data/Zoning.hs | 1 + src/Dodge/Default/World.hs | 4 +++- src/Dodge/Floor.hs | 14 +++++++------- src/Dodge/Hammer.hs | 3 +-- src/Dodge/Update.hs | 30 +++++++++++++++++------------- src/Dodge/Update/UsingInput.hs | 22 ++++++++++++++++++---- 8 files changed, 55 insertions(+), 28 deletions(-) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index ded0eb678..620a3d49d 100644 --- a/src/Dodge/Creature.hs +++ b/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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 88eb9eeb7..b290260d7 100644 --- a/src/Dodge/Data.hs +++ b/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) diff --git a/src/Dodge/Data/Zoning.hs b/src/Dodge/Data/Zoning.hs index 7fb3dfbfe..dc1e8f0c8 100644 --- a/src/Dodge/Data/Zoning.hs +++ b/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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 8690a6fe3..41420c833 100644 --- a/src/Dodge/Default/World.hs +++ b/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 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 1f1fc30a9..393c1a8c1 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -45,13 +45,13 @@ initialAnoTree = OnwardList , 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/Hammer.hs b/src/Dodge/Hammer.hs index ef83f948f..a5d8ceb8b 100644 --- a/src/Dodge/Hammer.hs +++ b/src/Dodge/Hammer.hs @@ -3,6 +3,5 @@ import Dodge.Item.Data moveHammerUp :: HammerPosition -> HammerPosition moveHammerUp HammerDown = HammerReleased -moveHammerUp HammerReleased = HammerUp -moveHammerUp HammerUp = HammerUp +moveHammerUp _ = HammerUp diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index f3573188d..af3ccbf32 100644 --- a/src/Dodge/Update.hs +++ b/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 -> - foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr)) - (zn & znObjects .~ mempty) (_creatures w) +zoneCreatures w = w + & crZoning . znObjects .~ mempty + & 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) - 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} +updateSeenWalls w = runIdentity $ S.fold_ markWallSeen w id (S.map (_wlID . snd) $ allVisibleWalls w) +-- where +-- f w' !i -- = w' & walls . ix i . wlSeen .~ True +-- = 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} +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 diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 192ca72cc..3910a5f7c 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/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 +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