Work on time scrolling

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