justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Work on time scrolling

Browse Source
This commit is contained in:
justin
2022-10-27 10:23:52 +01:00
parent 4ffd361f11
commit 35f2992fe4
12 changed files with 127 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files
appDodge/Main.hs
+3 -3
View File
@@ -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
src/Dodge/Data/Item/Combine.hs
+1
View File
@@ -110,6 +110,7 @@ data EquipItemType
data LeftItemType
= BOOSTER
| REWINDER
| TIMESCROLLER
| BLINKER
| BLINKERUNSAFE
| SHRINKER
src/Dodge/Data/Item/Effect.hs
+2 -2
View File
@@ -19,8 +19,8 @@ data ItEffect = ItEffect
data ItInvEffect
= NoInvEffect
| RewindEffect
| TimeScrollEffect
| ChargeIfEquipped
| ChargeIfInInventory
| EffectIfHeld ItInvEffect ItInvEffect
| CreateHeldLight
| CreateShieldWall
src/Dodge/Data/Item/HeldUse.hs
+1
View File
@@ -47,6 +47,7 @@ data Euse
data Luse
= LDoNothing
| LRewind
| LTimeScroll
| LShrink
| LBlink
| LUnsafeBlink
src/Dodge/Data/World.hs
+6 -3
View File
@@ -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
}
src/Dodge/Default/World.hs
-1
View File
@@ -137,7 +137,6 @@ defaultCWTime =
, _maybeWorld = Nothing'
, _pastWorlds = []
, _pastWorldsNum = 0
, _futureWorlds = []
, _deathDelay = Nothing
}
src/Dodge/ItEffect.hs
+28 -19
View File
@@ -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
src/Dodge/Item.hs
+1
View File
@@ -49,6 +49,7 @@ itemFromLeftType :: LeftItemType -> Item
itemFromLeftType lt = case lt of
BOOSTER -> boosterGun
REWINDER -> rewindGun
TIMESCROLLER -> timeScrollGun
BLINKER -> blinkGun
BLINKERUNSAFE -> unsafeBlinkGun
SHRINKER -> shrinkGun
src/Dodge/Item/Weapon/Utility.hs
+22 -11
View File
@@ -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
src/Dodge/Luse.hs
+9
View File
@@ -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
src/Dodge/Update.hs
+52 -42
View File
@@ -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
src/Dodge/Update/UsingInput.hs
+2 -2
View File
@@ -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 =