From 35f2992fe4642fb994ce81de1ce905402d16c06f Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 27 Oct 2022 10:23:52 +0100 Subject: [PATCH] Work on time scrolling --- appDodge/Main.hs | 6 +- src/Dodge/Data/Item/Combine.hs | 1 + src/Dodge/Data/Item/Effect.hs | 4 +- src/Dodge/Data/Item/HeldUse.hs | 1 + src/Dodge/Data/World.hs | 9 ++- src/Dodge/Default/World.hs | 1 - src/Dodge/ItEffect.hs | 47 +++++++++------- src/Dodge/Item.hs | 1 + src/Dodge/Item/Weapon/Utility.hs | 33 +++++++---- src/Dodge/Luse.hs | 9 +++ src/Dodge/Update.hs | 94 ++++++++++++++++++-------------- src/Dodge/Update/UsingInput.hs | 4 +- 12 files changed, 127 insertions(+), 83 deletions(-) diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 065e46e87..cad797d80 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -105,9 +105,9 @@ updateRenderSplit u = do return $! updateUniverse u playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound) -playSoundUnlessRewinding u - | _timeFlow w == RewindingNow = return M.empty - | otherwise = playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w) +playSoundUnlessRewinding u = case w ^. timeFlow of + NormalTimeFlow -> playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w) + _ -> return M.empty where w = _uvWorld u diff --git a/src/Dodge/Data/Item/Combine.hs b/src/Dodge/Data/Item/Combine.hs index 602109937..cdf0024a1 100644 --- a/src/Dodge/Data/Item/Combine.hs +++ b/src/Dodge/Data/Item/Combine.hs @@ -110,6 +110,7 @@ data EquipItemType data LeftItemType = BOOSTER | REWINDER + | TIMESCROLLER | BLINKER | BLINKERUNSAFE | SHRINKER diff --git a/src/Dodge/Data/Item/Effect.hs b/src/Dodge/Data/Item/Effect.hs index ba06cdaad..d0e1bc10d 100644 --- a/src/Dodge/Data/Item/Effect.hs +++ b/src/Dodge/Data/Item/Effect.hs @@ -19,8 +19,8 @@ data ItEffect = ItEffect data ItInvEffect = NoInvEffect - | RewindEffect - | TimeScrollEffect + | ChargeIfEquipped + | ChargeIfInInventory | EffectIfHeld ItInvEffect ItInvEffect | CreateHeldLight | CreateShieldWall diff --git a/src/Dodge/Data/Item/HeldUse.hs b/src/Dodge/Data/Item/HeldUse.hs index 751eaea2e..98c93804c 100644 --- a/src/Dodge/Data/Item/HeldUse.hs +++ b/src/Dodge/Data/Item/HeldUse.hs @@ -47,6 +47,7 @@ data Euse data Luse = LDoNothing | LRewind + | LTimeScroll | LShrink | LBlink | LUnsafeBlink diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index 4a9ee0933..996039fa9 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -55,8 +55,12 @@ data TimeFlowStatus | RewindingLastFrame | NormalTimeFlow | ScrollTimeFlow - { _scrollSmoothing :: Int } - deriving (Eq, Ord, Show, Read) --Generic, Flat) + { _scrollSmoothing :: Int + , _reverseAmount :: Int + , _futureWorlds :: [CWorld] + , _scrollItemLocation :: Int + } +-- deriving (Eq, Ord, Show, Read) --Generic, Flat) data WorldHammer = SubInvHam @@ -67,7 +71,6 @@ data CWTime = CWTime { _maybeWorld :: Maybe' CWorld , _pastWorlds :: [CWorld] , _pastWorldsNum :: Int - , _futureWorlds :: [CWorld] , _worldClock :: Int , _deathDelay :: Maybe Int } diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 18e860de2..de6556870 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -137,7 +137,6 @@ defaultCWTime = , _maybeWorld = Nothing' , _pastWorlds = [] , _pastWorldsNum = 0 - , _futureWorlds = [] , _deathDelay = Nothing } diff --git a/src/Dodge/ItEffect.hs b/src/Dodge/ItEffect.hs index bba026198..628cce341 100644 --- a/src/Dodge/ItEffect.hs +++ b/src/Dodge/ItEffect.hs @@ -8,8 +8,8 @@ import Dodge.LightSource.Torch doInvEffect :: ItInvEffect -> Item -> Creature -> World -> World doInvEffect iie = case iie of NoInvEffect -> const $ const id - RewindEffect -> rewindEffect - TimeScrollEffect -> timeScrollEffect + ChargeIfEquipped -> chargeIfEquipped + ChargeIfInInventory -> chargeIfInInventory EffectIfHeld f g -> onOffEff f g CreateHeldLight -> createHeldLight CreateShieldWall -> createShieldWall @@ -24,24 +24,33 @@ onOffEff f g it | _itIsHeld it = doInvEffect f it | otherwise = doInvEffect g it -timeScrollEffect :: Item -> Creature -> World -> World -timeScrollEffect _ _ w = w & timeFlow .~ ScrollTimeFlow 0 +--timeScrollEffect :: Item -> Creature -> World -> World +--timeScrollEffect itm _ w = w & timeFlow .~ ScrollTimeFlow +-- { _scrollSmoothing = 0 +-- , _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge +-- , _futureWorlds = [] +-- } + +chargeIfInInventory :: Item -> Creature -> World -> World +chargeIfInInventory itm cr w = + w & ptrWpCharge %~ (min maxcharge . (+ 1)) + where + invid = _ipInvID $ _itLocation itm + ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge + maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge + + +chargeIfEquipped :: Item -> Creature -> World -> World +chargeIfEquipped itm cr w + | Just invid == _crLeftInvSel cr = + w & ptrWpCharge %~ (min maxcharge . (+ 1)) + | otherwise = + w & ptrWpCharge .~ 0 + where + invid = _ipInvID $ _itLocation itm + ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge + maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge -rewindEffect :: Item -> Creature -> World -> World -rewindEffect _ _ w = w ---rewindEffect itm cr w = --- | Just invid == _crLeftInvSel cr = --- w & cwTime . rewindWorlds %~ (take maxcharge . (cw :)) --- & ptrWpCharge .~ length (w ^. cwTime . rewindWorlds) --- | otherwise = --- w & cwTime . rewindWorlds .~ [] --- & ptrWpCharge .~ 0 --- where --- invid = _ipInvID $ _itLocation itm --- ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge --- maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge --- cw = --- _cWorld w --resetAttachmentEffect :: Item -> Creature -> World -> World --resetAttachmentEffect itm cr w diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index db67591d8..2e2391a26 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -49,6 +49,7 @@ itemFromLeftType :: LeftItemType -> Item itemFromLeftType lt = case lt of BOOSTER -> boosterGun REWINDER -> rewindGun + TIMESCROLLER -> timeScrollGun BLINKER -> blinkGun BLINKERUNSAFE -> unsafeBlinkGun SHRINKER -> shrinkGun diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index e16193042..2f3fbb324 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -1,11 +1,11 @@ module Dodge.Item.Weapon.Utility where -import Dodge.Default.Item.Use import Control.Lens import Data.Maybe import Dodge.Base.Coordinate import Dodge.Data.World import Dodge.Default +--import Dodge.Default.Item.Use import Dodge.Wall.ForceField import Dodge.Wall.Move import Geometry @@ -16,23 +16,35 @@ import ShapePicture timeScrollGun :: Item timeScrollGun = - defaultHeldItem - & itEffect . ieWhileAiming .~ TimeScrollEffect + defaultLeftItem + & itUse + .~ ( defaultLeftUse + & leftUse .~ LTimeScroll + & equipEffect . eeSite .~ GoesOnWrist + ) + & itInvColor .~ cyan + & itEffect . ieInv .~ ChargeIfInInventory + & itType . iyBase .~ LEFT TIMESCROLLER + & itUse . leftConsumption + .~ ChargeableAmmo + { _wpMaxCharge = 100 + , _wpCharge = 0 + } rewindGun :: Item rewindGun = defaultLeftItem - & itUse .~ - (defaultLeftUse - & leftUse .~ LRewind --useRewindGun - & equipEffect . eeSite .~ GoesOnWrist - ) + & itUse + .~ ( defaultLeftUse + & leftUse .~ LRewind --useRewindGun + & equipEffect . eeSite .~ GoesOnWrist + ) & itInvColor .~ cyan - & itEffect . ieInv .~ RewindEffect + & itEffect . ieInv .~ ChargeIfEquipped & itType . iyBase .~ LEFT REWINDER & itUse . leftConsumption .~ ChargeableAmmo - { _wpMaxCharge = 250 + { _wpMaxCharge = 100 , _wpCharge = 0 } @@ -66,7 +78,6 @@ unsafeBlinkGun = & itUse . leftUse .~ LUnsafeBlink --hammerCheckL (shootL $ const unsafeBlinkAction) & itUse . equipEffect . eeViewDist ?~ 400 - -- I believe because the targeting returns to nothing straight after you release -- the rmb, it is possible for this to do nothing -- TODO investigate more and fix diff --git a/src/Dodge/Luse.hs b/src/Dodge/Luse.hs index 0cb214444..7e26e3c87 100644 --- a/src/Dodge/Luse.hs +++ b/src/Dodge/Luse.hs @@ -14,11 +14,20 @@ useL :: Luse -> Item -> Creature -> World -> World useL lu = case lu of LDoNothing -> const $ const id LRewind -> useRewindGun + LTimeScroll -> useTimeScrollGun LShrink -> hammerCheckL useShrinkGun LBlink -> hammerCheckL (shootL $ const blinkActionMousePos) LUnsafeBlink -> hammerCheckL (shootL $ const unsafeBlinkAction) LBoost -> boostSelfL 10 +useTimeScrollGun :: Item -> Creature -> World -> World +useTimeScrollGun itm _ w = w & timeFlow .~ ScrollTimeFlow + { _scrollSmoothing = 0 + , _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge + , _futureWorlds = [] + , _scrollItemLocation = _itID itm + } + useRewindGun :: Item -> Creature -> World -> World useRewindGun _ _ w = w --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 37b3178cd..5497c0f92 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -6,7 +6,6 @@ Description : Simulation update -} module Dodge.Update (updateUniverse) where -import StrictHelp import Color --import Dodge.Zone @@ -28,6 +27,7 @@ import Dodge.Flame import Dodge.Flare import Dodge.Hammer import Dodge.Inventory +import Dodge.Item.Location import Dodge.Laser.Update import Dodge.LightSource.Update import Dodge.LinearShockwave.Update @@ -60,10 +60,11 @@ import LensHelp --import MaybeHelp import SDL import Sound.Data +import StrictHelp {- For most menus the only way to change the world is using event handling. -} updateUniverse :: Universe -> Universe -updateUniverse u +updateUniverse u | concurrentblocking = u | otherwise = case _uvScreenLayers u of (OptionScreen{_scOptionFlag = GameOverOptions} : _) -> @@ -88,25 +89,15 @@ functionalUpdate'' = advanceScrollAmount . functionalUpdate' functionalUpdate' :: Universe -> Universe functionalUpdate' u = case u ^. uvWorld . timeFlow of NormalTimeFlow -> functionalUpdate u - ScrollTimeFlow smoothing -> over uvWorld (doTimeScroll smoothing) u + ScrollTimeFlow smoothing _ _ _ -> over uvWorld (doTimeScroll smoothing) u _ -> u -timeScrollAmount :: World -> Int -timeScrollAmount w - | x == 0 = 0 - | x > 0 && y > 0 = x * y - | x < 0 && y < 0 = negate (x * y) - | otherwise = x - where - x = w ^. scrollAmount - y = w ^. previousScrollAmount - doTimeScroll :: Int -> World -> World -doTimeScroll smoothing w = case timeScrollAmount w of - x | x > 1 -> (foldr ($) w $ replicate x scrollTimeBack) & timeFlow . scrollSmoothing .~ 20 - x | x > 0 -> foldr ($) w $ replicate x scrollTimeBack - x | x < (-1) -> (foldr ($) w $ replicate x scrollTimeForward) & timeFlow . scrollSmoothing .~ negate 20 - x | x < 0 -> foldr ($) w $ replicate (negate x) scrollTimeForward +doTimeScroll smoothing w = case w ^. scrollAmount of + x | x > 1 -> w & scrollTimeBack & timeFlow . scrollSmoothing .~ 20 + x | x > 0 -> w & scrollTimeBack & timeFlow . scrollSmoothing %~ max 0 + x | x < (-1) -> w & scrollTimeForward & timeFlow . scrollSmoothing .~ negate 20 + x | x < 0 -> w & scrollTimeForward & timeFlow . scrollSmoothing %~ min 0 _ | smoothing > 0 -> scrollTimeBack w & timeFlow . scrollSmoothing -~ 1 _ | smoothing < 0 -> scrollTimeForward w & timeFlow . scrollSmoothing +~ 1 _ -> w @@ -114,28 +105,41 @@ doTimeScroll smoothing w = case timeScrollAmount w of scrollTimeBack :: World -> World scrollTimeBack w = case w ^? cwTime . pastWorlds . _head of Nothing -> w - Just cw -> w & cwTime . pastWorlds %~ tail - & cwTime . futureWorlds .:~ _cWorld w - & cWorld .~ cw + Just cw -> case w ^?! timeFlow . reverseAmount of + x | x > 0 -> + w & cwTime . pastWorlds %~ tail + & timeFlow . futureWorlds .:~ _cWorld w + & timeFlow . reverseAmount -~ 1 + & cWorld .~ cw + & pointerToItemLocation (w ^?! cWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ (x -1) + _ -> w + where + i = w ^?! timeFlow . scrollItemLocation scrollTimeForward :: World -> World -scrollTimeForward w = case w ^? cwTime . futureWorlds . _head of +scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of Nothing -> w - Just cw -> w & cwTime . futureWorlds %~ tail - & cwTime . pastWorlds .:~ _cWorld w - & cWorld .~ cw + Just cw -> + w & timeFlow . futureWorlds %~ tail + & cwTime . pastWorlds .:~ _cWorld w + & cWorld .~ cw + & timeFlow . reverseAmount +~ 1 + & pointerToItemLocation (w ^?! cWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge +~ 1 + where + i = w ^?! timeFlow . scrollItemLocation -- | The update step. functionalUpdate :: Universe -> Universe -functionalUpdate w = checkEndGame +functionalUpdate w = + checkEndGame -- . updateRandGen . over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held . over uvWorld (cwTime . worldClock +~ 1) . over uvWorld updateWorldSelect --- . over uvWorld doRewind --- . over uvWorld (hammers . each %~ moveHammerUp) --- . over (uvWorld . hammers . each) moveHammerUp --- . over uvWorld (hammers %~ fmap moveHammerUp) + -- . over uvWorld doRewind + -- . over uvWorld (hammers . each %~ moveHammerUp) + -- . over (uvWorld . hammers . each) moveHammerUp + -- . over uvWorld (hammers %~ fmap moveHammerUp) . moveHammersUp . over uvWorld updateDistortions . over uvWorld updateCreatureSoundPositions @@ -182,13 +186,14 @@ functionalUpdate w = checkEndGame . over uvWorld updateTerminal . over uvWorld updateRBList . updateBounds -- where should this go? next to update camera? - . over uvWorld updateCloseObjects + . over uvWorld updateCloseObjects $ over uvWorld updatePastWorlds w advanceScrollAmount :: Universe -> Universe -advanceScrollAmount u = u - & uvWorld . previousScrollAmount .~ _scrollAmount (_uvWorld u) - & uvWorld . scrollAmount .~ 0 +advanceScrollAmount u = + u + & uvWorld . previousScrollAmount .~ _scrollAmount (_uvWorld u) + & uvWorld . scrollAmount .~ 0 updatePastWorlds :: World -> World updatePastWorlds w = w & cwTime . pastWorlds %~ (forceFoldable . take 100 . (_cWorld w :)) @@ -196,6 +201,7 @@ updatePastWorlds w = w & cwTime . pastWorlds %~ (forceFoldable . take 100 . (_cW moveHammersUp :: Universe -> Universe --moveHammersUp = uvWorld . hammers .~ M.empty moveHammersUp = uvWorld . hammers %~ M.map moveHammerUp + --moveHammersUp = uvWorld . hammers . each %~ (moveHammerUp $!) --moveHammersUp = uvWorld %~ ( (hammers . each %~ (moveHammerUp $!)) $!) --moveHammersUp uv = uv { _uvWorld = w' } @@ -225,14 +231,18 @@ zoneClouds w = updateWorldSelect :: World -> World updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mouseButtons . ix ButtonRight) of - (Just False, Nothing) -> w & lLine . _1 .~ mwp - & lrLine . _1 .~ mwp - (Just True, Nothing) -> w & lLine . _2 .~ mwp - & lrLine . _1 .~ mwp - (Nothing,Just False) -> w & rLine . _1 .~ mwp - & lrLine . _2 .~ mwp - (Nothing,Just True) -> w & rLine . _2 .~ mwp - & lrLine . _2 .~ mwp + (Just False, Nothing) -> + w & lLine . _1 .~ mwp + & lrLine . _1 .~ mwp + (Just True, Nothing) -> + w & lLine . _2 .~ mwp + & lrLine . _1 .~ mwp + (Nothing, Just False) -> + w & rLine . _1 .~ mwp + & lrLine . _2 .~ mwp + (Nothing, Just True) -> + w & rLine . _2 .~ mwp + & lrLine . _2 .~ mwp _ -> w where mwp = mouseWorldPos w diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 9f6b68002..587211abf 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -53,10 +53,10 @@ pressedMBEffectsNoInventory :: M.Map MouseButton Bool -> World -> World pressedMBEffectsNoInventory pkeys w | isDown ButtonLeft && isDown ButtonRight && inTopInv = useItem (you w) w & hammers . ix DoubleMouseHam .~ HammerDown - | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame) + | isDown ButtonLeft && inTopInv && w ^?! hammers . ix DoubleMouseHam == HammerUp = useLeftItem (_yourID (_cWorld w)) w - | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame) = + | isDown ButtonLeft && inTopInv = w & hammers . ix DoubleMouseHam .~ HammerDown | isDown ButtonRight && inTopInv = w | isDown ButtonMiddle =