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

Move past/future worlds outside of serialised data structure

Browse Source
This commit is contained in:
justin
2023-03-25 18:50:42 +00:00
parent 7d96616b91
commit da8a2bad6e
6 changed files with 61 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files
appDodge/Main.hs
+1 -1
View File
@@ -118,7 +118,7 @@ updateRenderSplit win u = do
return $! updateUniverse u
playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound)
playSoundUnlessRewinding u = case w ^. cWorld . timeFlow of
playSoundUnlessRewinding u = case w ^. timeFlow of
NormalTimeFlow -> playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w)
_ -> stopAllSounds >> return M.empty
where
src/Dodge/Data/CWorld.hs
+1 -23
View File
@@ -27,33 +27,12 @@ data CWorld = CWorld
, _cwCamPos :: CamPos
, _cwGen :: CWGen
, _cClock :: Int
, _pastWorlds :: [LWorld]
, _timeFlow :: TimeFlowStatus
, _seenWalls :: IS.IntSet
, _cwTiles :: [Tile]
, _pathGraph :: Gr Point2 PathEdge
, _numberFloorVerxs :: Int
}
data TimeFlowStatus
= DeathTime
{ _deathDelay :: Int }
| NormalTimeFlow
| ScrollTimeFlow
{ _scrollSmoothing :: Int
, _reverseAmount :: Int
, _futureWorlds :: [LWorld]
, _scrollItemLocation :: Int
}
| RewindLeftClick
{ _reverseAmount :: Int
, _scrollItemLocation :: Int
}
| PausedTimeFlow
{ _timeFlowCharge :: Int
, _scrollItemLocation :: Int
}
data CWGen = CWGen
{ _cwgParams :: GenParams
, _cwgWorldBounds :: Bounds
@@ -67,11 +46,10 @@ data CWGen = CWGen
makeLenses ''CWorld
makeLenses ''CWGen
makeLenses ''TimeFlowStatus
concat
<$> mapM
(deriveJSON defaultOptions)
[ ''CWGen
, ''CWorld
, ''TimeFlowStatus
-- , ''TimeFlowStatus
]
src/Dodge/Data/World.hs
+23
View File
@@ -34,6 +34,8 @@ data WorldEventFlag = InventoryChange
data World = World
{ _cWorld :: CWorld
, _pastWorlds :: [LWorld]
, _timeFlow :: TimeFlowStatus
, _randGen :: StdGen
, _toPlaySounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
@@ -50,6 +52,27 @@ data World = World
, _gsZoning :: IntMap (IntMap IntSet)
}
data TimeFlowStatus
= DeathTime
{ _deathDelay :: Int }
| NormalTimeFlow
| ScrollTimeFlow
{ _scrollSmoothing :: Int
, _reverseAmount :: Int
, _futureWorlds :: [LWorld]
, _scrollItemLocation :: Int
}
| RewindLeftClick
{ _reverseAmount :: Int
, _scrollItemLocation :: Int
}
| PausedTimeFlow
{ _timeFlowCharge :: Int
, _scrollItemLocation :: Int
}
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''TimeFlowStatus
makeLenses ''World
src/Dodge/Default/World.hs
+2 -2
View File
@@ -34,6 +34,8 @@ defaultWorld :: World
defaultWorld =
World
{ _cWorld = defaultCWorld
, _pastWorlds = mempty
, _timeFlow = NormalTimeFlow
, _input = defaultInput
, _toPlaySounds = M.empty
, _playingSounds = M.empty
@@ -81,8 +83,6 @@ defaultCWorld =
, _lWorld = defaultLWorld
, _cwGen = defaultCWGen
, _cClock = 0
, _pastWorlds = []
, _timeFlow = NormalTimeFlow
, _seenWalls = mempty
, _pathGraph = Data.Graph.Inductive.Graph.empty
, _cwTiles = mempty
src/Dodge/Luse.hs
+3 -3
View File
@@ -23,14 +23,14 @@ useL lu = case lu of
useStopWatch :: Item -> Creature -> World -> World
useStopWatch itm _ w = w
& cWorld . timeFlow .~ PausedTimeFlow
& timeFlow .~ PausedTimeFlow
{ _timeFlowCharge = itm ^?! itUse . leftConsumption . wpCharge
, _scrollItemLocation = _itID itm
}
useTimeScrollGun :: Item -> Creature -> World -> World
useTimeScrollGun itm _ w = w & cWorld . timeFlow .~ ScrollTimeFlow
useTimeScrollGun itm _ w = w & timeFlow .~ ScrollTimeFlow
{ _scrollSmoothing = 0
, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
, _futureWorlds = []
@@ -40,7 +40,7 @@ useTimeScrollGun itm _ w = w & cWorld . timeFlow .~ ScrollTimeFlow
useRewindGun :: Item -> Creature -> World -> World
useRewindGun itm _ w = w
& cWorld . timeFlow .~ RewindLeftClick
& timeFlow .~ RewindLeftClick
{ _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
, _scrollItemLocation = _itID itm
}
src/Dodge/Update.hs
+31 -30
View File
@@ -129,17 +129,17 @@ updateUniverseMid u = case _uvScreenLayers u of
[] -> timeFlowUpdate u
timeFlowUpdate :: Universe -> Universe
timeFlowUpdate u = case u ^. uvWorld . cWorld . timeFlow of
timeFlowUpdate u = case u ^. uvWorld . timeFlow of
NormalTimeFlow -> functionalUpdate u
ScrollTimeFlow smoothing _ _ _ -> over uvWorld (doTimeScroll smoothing) u
RewindLeftClick 0 _ -> u & uvWorld . cWorld . timeFlow .~ NormalTimeFlow
RewindLeftClick 0 _ -> u & uvWorld . timeFlow .~ NormalTimeFlow
RewindLeftClick _ _ -> over uvWorld scrollTimeBack u -- & uvWorld . cWorld . timeFlow .~ NormalTimeFlow
DeathTime{} -> u
PausedTimeFlow _ itmloc -> over uvWorld (pauseTime itmloc) u
pauseTime :: Int -> World -> World
pauseTime itmloc w
| justPressedButtonLeft || outofcharge = w & cWorld . timeFlow .~ NormalTimeFlow
| justPressedButtonLeft || outofcharge = w & timeFlow .~ NormalTimeFlow
| otherwise = w & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itmloc) . itUse . leftConsumption . wpCharge -~ 1
where
justPressedButtonLeft = w ^? input . mouseButtons . ix ButtonLeft == Just False
@@ -148,48 +148,48 @@ pauseTime itmloc w
doTimeScroll :: Int -> World -> World
doTimeScroll smoothing w = case w ^? input . mouseButtons . ix ButtonLeft of
Just False -> w & cWorld . timeFlow .~ NormalTimeFlow
Just False -> w & timeFlow .~ NormalTimeFlow
_ -> doTimeScroll' smoothing w
doTimeScroll' :: Int -> World -> World
doTimeScroll' smoothing w = case w ^. input . scrollAmount of
x | x > 1 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing .~ 20
x | x > 0 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing %~ max 0
x | x < (-1) -> w & scrollTimeForward & cWorld . timeFlow . scrollSmoothing .~ negate 20
x | x < 0 -> w & scrollTimeForward & cWorld . timeFlow . scrollSmoothing %~ min 0
_ | smoothing > 0 -> scrollTimeBack w & cWorld . timeFlow . scrollSmoothing -~ 1
_ | smoothing < 0 -> scrollTimeForward w & cWorld . timeFlow . scrollSmoothing +~ 1
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
scrollTimeBack :: World -> World
scrollTimeBack w = case w ^? cWorld . pastWorlds . _head of
scrollTimeBack w = case w ^? pastWorlds . _head of
Nothing -> w
Just lw -> case w ^?! cWorld . timeFlow . reverseAmount of
Just lw -> case w ^?! timeFlow . reverseAmount of
x
| x > 0 ->
w & cWorld . pastWorlds %~ tail
& cWorld . timeFlow . futureWorlds .:~ (w ^. cWorld . lWorld)
& cWorld . timeFlow . reverseAmount -~ 1
w & pastWorlds %~ tail
& timeFlow . futureWorlds .:~ (w ^. cWorld . lWorld)
& timeFlow . reverseAmount -~ 1
& cWorld . lWorld .~ lw
& pointituse . leftConsumption . wpCharge .~ (x -1)
& pointituse . leftHammer .~ HammerDown
_ -> w
where
pointituse = pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse
i = w ^?! cWorld . timeFlow . scrollItemLocation
i = w ^?! timeFlow . scrollItemLocation
scrollTimeForward :: World -> World
scrollTimeForward w = case w ^? cWorld . timeFlow . futureWorlds . _head of
scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of
Nothing -> w
Just lw ->
w & cWorld . timeFlow . futureWorlds %~ tail
& cWorld . pastWorlds .:~ (w ^. cWorld . lWorld)
w & timeFlow . futureWorlds %~ tail
& pastWorlds .:~ (w ^. cWorld . lWorld)
& cWorld . lWorld .~ lw
& cWorld . timeFlow . reverseAmount .~ ramount
& timeFlow . reverseAmount .~ ramount
& pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount
where
i = w ^?! cWorld . timeFlow . scrollItemLocation
ramount = (w ^?! cWorld . timeFlow . reverseAmount) + 1
i = w ^?! timeFlow . scrollItemLocation
ramount = (w ^?! timeFlow . reverseAmount) + 1
-- | The update step.
functionalUpdate :: Universe -> Universe
@@ -242,7 +242,7 @@ functionalUpdate w =
. over uvWorld zoneClouds
. over uvWorld zoneCreatures
-- . over uvWorld updateInventorySelectionList
$ over (uvWorld . cWorld) updatePastWorlds w
$ over uvWorld updatePastWorlds w
updateWheelEvents :: World -> World
updateWheelEvents w
@@ -257,8 +257,8 @@ advanceScrollAmount u =
& uvWorld . input . previousScrollAmount .~ _scrollAmount (_input $ _uvWorld u)
& uvWorld . input . scrollAmount .~ 0
updatePastWorlds :: CWorld -> CWorld
updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. lWorld) :))
updatePastWorlds :: World -> World
updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
--updatePastWorlds w = w & pastWorlds .~ []
@@ -354,8 +354,9 @@ setOldPos cr =
-- Nothing' -> w & timeFlow .~ NormalTimeFlow
zoneCreatures :: World -> World
zoneCreatures w = w & crZoning
.~ foldl' (flip zoneCreature) mempty (w ^. cWorld . lWorld . creatures)
zoneCreatures w =
w & crZoning
.~ foldl' (flip zoneCreature) mempty (w ^. cWorld . lWorld . creatures)
-- foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr))
-- zn (_creatures w)
@@ -567,12 +568,12 @@ markWallSeen w i = w & cWorld . seenWalls . at i ?~ ()
--markSeen wl = wl{_wlSeen = True}
checkEndGame :: Universe -> Universe
checkEndGame uv = case w ^? cWorld . timeFlow . deathDelay of
checkEndGame uv = case w ^? timeFlow . deathDelay of
Just x
| x < 0 ->
uv & uvScreenLayers .~ [gameOverMenu uv]
Just _ -> uv & uvWorld . cWorld . timeFlow . deathDelay -~ 1
_ | _crHP (you w) < 1 -> uv & uvWorld . cWorld . timeFlow .~ DeathTime 50
Just _ -> uv & uvWorld . timeFlow . deathDelay -~ 1
_ | _crHP (you w) < 1 -> uv & uvWorld . timeFlow .~ DeathTime 50
_ -> uv
where
w = _uvWorld uv