diff --git a/appDodge/Main.hs b/appDodge/Main.hs index db137511e..5558fc62f 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -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 diff --git a/src/Dodge/Data/CWorld.hs b/src/Dodge/Data/CWorld.hs index 4a8d18b16..a7a1b19af 100644 --- a/src/Dodge/Data/CWorld.hs +++ b/src/Dodge/Data/CWorld.hs @@ -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 ] diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index 01823c5df..5af719f83 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 0edccc73c..a4ff77725 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -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 diff --git a/src/Dodge/Luse.hs b/src/Dodge/Luse.hs index 55d829480..496e6090f 100644 --- a/src/Dodge/Luse.hs +++ b/src/Dodge/Luse.hs @@ -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 } diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 523dcdb9a..64aa017dd 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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