Work on time scrolling

appDodge/Main.hs

@@ -105,9 +105,9 @@ updateRenderSplit u = do
     return $! updateUniverse u
 
 playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound)
-playSoundUnlessRewinding u
+playSoundUnlessRewinding u = case w ^. timeFlow of
-    | _timeFlow w == RewindingNow = return M.empty
+    NormalTimeFlow -> playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w)
-    | otherwise = playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w)
+    _ -> return M.empty
   where
     w = _uvWorld u
 

src/Dodge/Data/Item/Combine.hs

@@ -110,6 +110,7 @@ data EquipItemType
 data LeftItemType
     = BOOSTER
     | REWINDER
+    | TIMESCROLLER
     | BLINKER
     | BLINKERUNSAFE
     | SHRINKER

src/Dodge/Data/Item/Effect.hs

@@ -19,8 +19,8 @@ data ItEffect = ItEffect
 
 data ItInvEffect
     = NoInvEffect
-    | RewindEffect
+    | ChargeIfEquipped
-    | TimeScrollEffect
+    | ChargeIfInInventory
     | EffectIfHeld ItInvEffect ItInvEffect
     | CreateHeldLight
     | CreateShieldWall

src/Dodge/Data/Item/HeldUse.hs

@@ -47,6 +47,7 @@ data Euse
 data Luse
     = LDoNothing
     | LRewind
+    | LTimeScroll
     | LShrink
     | LBlink
     | LUnsafeBlink

src/Dodge/Data/World.hs

@@ -55,8 +55,12 @@ data TimeFlowStatus
     | RewindingLastFrame
     | NormalTimeFlow
     | ScrollTimeFlow
-        { _scrollSmoothing :: Int }
+        { _scrollSmoothing :: Int 
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+        , _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

@@ -137,7 +137,6 @@ defaultCWTime =
         , _maybeWorld = Nothing'
         , _pastWorlds = []
         , _pastWorldsNum = 0
-        , _futureWorlds = []
         , _deathDelay = Nothing
         }
 

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
+    ChargeIfEquipped -> chargeIfEquipped
-    TimeScrollEffect -> timeScrollEffect
+    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 :: Item -> Creature -> World -> World
-timeScrollEffect _ _ w = w & timeFlow .~ ScrollTimeFlow 0
+--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

@@ -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

@@ -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
+    defaultLeftItem
-        & itEffect . ieWhileAiming .~ TimeScrollEffect
+        & 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 .~
+        & itUse
-            (defaultLeftUse
+            .~ ( 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

@@ -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

@@ -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,6 +60,7 @@ 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
@@ -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
+doTimeScroll smoothing w = case w ^. scrollAmount of
-    x | x > 1 -> (foldr ($) w $ replicate x scrollTimeBack) & timeFlow . scrollSmoothing .~ 20
+    x | x > 1 -> w & scrollTimeBack & timeFlow . scrollSmoothing .~ 20
-    x | x > 0 -> foldr ($) w $ replicate x scrollTimeBack
+    x | x > 0 -> w & scrollTimeBack & timeFlow . scrollSmoothing %~ max 0
-    x | x < (-1) -> (foldr ($) w $ replicate x scrollTimeForward) & timeFlow . scrollSmoothing .~ negate 20
+    x | x < (-1) -> w & scrollTimeForward & timeFlow . scrollSmoothing .~ negate 20
-    x | x < 0 -> foldr ($) w $ replicate (negate x) scrollTimeForward
+    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,20 +105,33 @@ 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
+    Just cw -> case w ^?! timeFlow . reverseAmount of
-        & cwTime . futureWorlds .:~ _cWorld w
+        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
+    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)
@@ -186,7 +190,8 @@ functionalUpdate w = checkEndGame
         $ over uvWorld updatePastWorlds w
 
 advanceScrollAmount :: Universe -> Universe
-advanceScrollAmount u = u 
+advanceScrollAmount u =
+    u
         & uvWorld . previousScrollAmount .~ _scrollAmount (_uvWorld u)
         & uvWorld . scrollAmount .~ 0
 
@@ -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,13 +231,17 @@ 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
+    (Just False, Nothing) ->
+        w & lLine . _1 .~ mwp
             & lrLine . _1 .~ mwp
-    (Just True, Nothing) -> w & lLine . _2 .~ mwp
+    (Just True, Nothing) ->
+        w & lLine . _2 .~ mwp
             & lrLine . _1 .~ mwp
-    (Nothing,Just False) -> w & rLine . _1 .~ mwp
+    (Nothing, Just False) ->
+        w & rLine . _1 .~ mwp
             & lrLine . _2 .~ mwp
-    (Nothing,Just True) -> w & rLine . _2 .~ mwp
+    (Nothing, Just True) ->
+        w & rLine . _2 .~ mwp
             & lrLine . _2 .~ mwp
     _ -> w
   where

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 =