Commit mid add time scroll

src/Dodge/Clock.hs

@@ -11,5 +11,5 @@ clockCycle :: Int -> V.Vector a -> World -> a
 clockCycle tPeriod xs w = xs V.! i
   where
     l = V.length xs
-    t = (w ^. cWorld . cwTime . worldClock) `mod` (l * tPeriod)
+    t = (w ^. cwTime . worldClock) `mod` (l * tPeriod)
     i = t `div` tPeriod

src/Dodge/Creature/Impulse/UseItem.hs

@@ -30,7 +30,8 @@ useItem cr' w = fromMaybe (f w) $ do
 itemEffect :: Creature -> Item -> World -> World
 itemEffect cr it w = case it ^. itUse of
     HeldUse{_heldUse = eff, _heldMods = usemods} ->
-        hammerTest $ tryReload cr it w $ foldl' (&) (useHeld eff) (reverse $ useMod usemods) it cr
+        hammerTest $ tryReload cr it w $ foldl' (&) (useHeld eff) (useMod usemods) it cr
+        --hammerTest $ tryReload cr it w $ foldl' (&) (useHeld eff) (reverse $ useMod usemods) it cr
     LeftUse{} -> doequipmentchange
     EquipUse{} -> doequipmentchange
     -- ConsumeUse will cause problems if the item is not selected

src/Dodge/Data/CWorld.hs

@@ -114,18 +114,7 @@ data CWCam = CWCam
     , _cwcBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
     }
 
---deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
 data CWorld = CWorld
-    --{ _cameraCenter :: Point2
-    --, _cameraRot :: Float
-    --, _cameraZoom :: Float -- smaller values zoom out
-    --, _itemZoom :: Float
-    --, _defaultZoom :: Float
-    --, _cameraViewFrom :: Point2
-    --, _viewDistance :: Float
-    --, _boundBox :: [Point2]
-    --, _boundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
     { _cwCam :: CWCam
     , _creatures :: IM.IntMap Creature
     , _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
@@ -186,19 +175,12 @@ data CWorld = CWorld
     , _seenLocations :: IM.IntMap (WdP2, String)
     , _selLocation :: Int
     , _distortions :: [Distortion]
-    , _cwTime :: CWTime
     , _cwGen :: CWGen
     }
 
 --deriving (Eq, Show, Read) --, Generic)
 --h--deriving (Eq, Show, Read) --Generic, Flat)
 
-data CWTime = CWTime
-    { _maybeWorld :: Maybe' CWorld
-    , _rewindWorlds :: [CWorld]
-    , _worldClock :: Int
-    , _deathDelay :: Maybe Int
-    }
 
 --deriving (Eq, Show, Read) --, Generic)
 --h--deriving (Eq, Show, Read) --Generic, Flat)
@@ -226,13 +208,12 @@ makeLenses ''CWorld
 makeLenses ''WorldBeams
 makeLenses ''CWCam
 makeLenses ''CWGen
-makeLenses ''CWTime
 concat
     <$> mapM
         (deriveJSON defaultOptions)
         [ ''WorldBeams
         , ''CWCam
         , ''CWGen
-        , ''CWTime
+--        , ''CWTime
         , ''CWorld
         ]

src/Dodge/Data/Item/HeldScroll.hs

@@ -19,6 +19,7 @@ data HeldScroll
         { _hsInt :: Int
         , _hsMaxInt :: Int
         }
+    | HeldScrollTime
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''HeldScroll

src/Dodge/Data/Item/HeldUse.hs

@@ -10,7 +10,7 @@ import Data.Aeson.TH
 import Dodge.Data.CamouflageStatus
 import Dodge.Data.Item.Combine
 
-data HeldUse
+data Huse
     = HeldDoNothing
     | HeldUseAmmoParams
     | HeldOverNozzlesUseGasParams
@@ -94,5 +94,5 @@ data HeldMod
 deriveJSON defaultOptions ''Cuse
 deriveJSON defaultOptions ''HeldMod
 deriveJSON defaultOptions ''Euse
-deriveJSON defaultOptions ''HeldUse
+deriveJSON defaultOptions ''Huse
 deriveJSON defaultOptions ''Luse

src/Dodge/Data/Item/Use.hs

@@ -25,7 +25,7 @@ import Dodge.Data.Item.HeldDelay
 
 data ItemUse
     = HeldUse
-        { _heldUse :: HeldUse
+        { _heldUse :: Huse
         , _heldDelay :: UseDelay
         , _heldMods :: HeldMod
         , _heldHammer :: HammerPosition

src/Dodge/Data/World.hs

@@ -23,6 +23,7 @@ import Dodge.Data.SoundOrigin
 import Geometry.Data
 import SDL (MouseButton, Scancode)
 import Sound.Data
+import MaybeHelp
 import System.Random
 
 data World = World
@@ -44,12 +45,14 @@ data World = World
     , _backspaceTimer :: Int
     , _timeFlow :: TimeFlowStatus
     , _rbOptions :: RightButtonOptions
+    , _cwTime :: CWTime
     }
 
 data TimeFlowStatus
     = RewindingNow
     | RewindingLastFrame
     | NormalTimeFlow
+    | ScrollTimeFlow
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data WorldHammer
@@ -57,4 +60,13 @@ data WorldHammer
     | DoubleMouseHam
     deriving (Eq, Ord, Show, Read, Enum, Bounded)
 
+data CWTime = CWTime
+    { _maybeWorld :: Maybe' CWorld
+    , _rewindWorlds :: [CWorld]
+    , _futureWorlds :: [CWorld]
+    , _worldClock :: Int
+    , _deathDelay :: Maybe Int
+    }
+
 makeLenses ''World
+makeLenses ''CWTime

src/Dodge/Default/World.hs

@@ -32,6 +32,7 @@ defaultWorld =
         , _backspaceTimer = 0
         , _timeFlow = NormalTimeFlow
         , _rbOptions = NoRightButtonOptions
+        , _cwTime = defaultCWTime
         }
 
 defaultCWGen :: CWGen
@@ -125,7 +126,6 @@ defaultCWorld =
         , _selLocation = 0
         , _foregroundShapes = mempty
         , _distortions = []
-        , _cwTime = defaultCWTime
         }
 
 defaultCWTime :: CWTime
@@ -134,6 +134,7 @@ defaultCWTime =
         { _worldClock = 0
         , _maybeWorld = Nothing'
         , _rewindWorlds = []
+        , _futureWorlds = []
         , _deathDelay = Nothing
         }
 

src/Dodge/Event.hs

@@ -107,7 +107,7 @@ wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
         | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of
             (_, EquipOptions{}) -> scrollRBOption y w
             (Nothing, _) -> closeObjScrollDir y w
-            (Just f, _) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
+            (Just f, _) -> doHeldScroll f y (you w) w
         | lbDown -> w & cWorld . cwCam . cwcZoom +~ y
         | invKeyDown -> changeSwapInvSel yi w
         | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w

src/Dodge/HeldScroll.hs

@@ -2,19 +2,33 @@ module Dodge.HeldScroll (
     doHeldScroll,
 ) where
 
+import Dodge.Base.You
 import Control.Lens hiding ((<|), (|>))
 import Data.Sequence
 import Dodge.Data.Creature
+import Dodge.Data.World
 import Dodge.Item.Weapon.ZoomScope
+import LensHelp hiding ((|>), (<|))
 -- should be able to just import data.item
 
-doHeldScroll :: HeldScroll -> Float -> Creature -> Item -> Item
+doHeldScroll :: HeldScroll -> Float -> Creature -> World -> World
 doHeldScroll hs = case hs of
     HeldScrollDoNothing -> const . const id
-    HeldScrollZoom -> zoomLongGun
+    HeldScrollZoom -> overYourItem zoomLongGun
-    HeldScrollCharMode{} -> \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
+    HeldScrollCharMode{} -> overYourItem $ \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
+    HeldScrollTime -> doScrollTime
     HeldScrollInt{} -> undefined
+  where
+    overYourItem f x cr w = w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ f x cr
 
+doScrollTime :: Float -> Creature -> World -> World
+doScrollTime x _ w
+    | x > 0 = case _futureWorlds $ _cwTime w of
+        (w':ws) -> w -- & cWorld .~ w' 
+            -- & cwTime . futureWorlds %~ tail
+            -- & cwTime . rewindWorlds .:~ _cWorld w
+        _ -> w
+    | otherwise = w
 cycleSignum :: Float -> Seq a -> Seq a
 cycleSignum x
     | x > 0 = cycleL

src/Dodge/HeldUse.hs

@@ -359,7 +359,7 @@ mcUseHeld hit = case hit of
     LASGUN -> mcShootLaser
     _ -> \_ _ -> id
 
-useHeld :: HeldUse -> Item -> Creature -> World -> World
+useHeld :: Huse -> Item -> Creature -> World -> World
 useHeld hu = case hu of
     HeldDoNothing -> const $ const id
     HeldUseAmmoParams -> useAmmoParams

src/Dodge/ItEffect.hs

@@ -26,10 +26,10 @@ onOffEff f g it
 rewindEffect :: Item -> Creature -> World -> World
 rewindEffect itm cr w
     | Just invid == _crLeftInvSel cr =
-        w & cWorld . cwTime . rewindWorlds %~ (take maxcharge . (cw :))
+        w & cwTime . rewindWorlds %~ (take maxcharge . (cw :))
-            & ptrWpCharge .~ length (w ^. cWorld . cwTime . rewindWorlds)
+            & ptrWpCharge .~ length (w ^. cwTime . rewindWorlds)
     | otherwise =
-        w & cWorld . cwTime . rewindWorlds .~ []
+        w & cwTime . rewindWorlds .~ []
             & ptrWpCharge .~ 0
   where
     invid = _ipInvID $ _itLocation itm
@@ -37,7 +37,6 @@ rewindEffect itm cr w
     maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
     cw =
         _cWorld w
-            & cwTime . rewindWorlds .~ []
 
 --resetAttachmentEffect :: Item -> Creature -> World -> World
 --resetAttachmentEffect itm cr w

src/Dodge/Item/Weapon/TriggerType.hs

@@ -459,7 +459,7 @@ withTempLight time rad col eff item cr =
 
 modClock :: Int -> ChainEffect -> ChainEffect
 modClock n chainEff eff it cr w
-    | (w ^. cWorld . cwTime . worldClock) `mod` n == 0 = chainEff eff it cr w
+    | (w ^. cwTime . worldClock) `mod` n == 0 = chainEff eff it cr w
     | otherwise = eff it cr w
 
 withMuzFlareI :: ChainEffect

src/Dodge/Item/Weapon/Utility.hs

@@ -14,6 +14,10 @@ import Picture
 import Shape
 import ShapePicture
 
+timeScrollGun :: Item
+timeScrollGun =
+    defaultHeldItem
+
 rewindGun :: Item
 rewindGun =
     defaultLeftItem

src/Dodge/Luse.hs

@@ -20,19 +20,13 @@ useL lu = case lu of
     LBoost -> boostSelfL 10
 
 useRewindGun :: Item -> Creature -> World -> World
-useRewindGun _ _ w = case w ^. cWorld . cwTime . rewindWorlds of
+useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
-    [w'] -> rewindusing w' [w']
+    [w'] -> w & cwTime . maybeWorld .~ Just' w'
-    (w' : ws) -> rewindusing w' ws
+    (w' : ws) -> w
+            & cwTime . maybeWorld
+                .~ Just' w'
+            & cwTime . rewindWorlds .~ ws
     _ -> w
-  where
-    rewindusing :: CWorld -> [CWorld] -> World
-    rewindusing w' ws =
-        w
-            & cWorld . cwTime . maybeWorld
-                .~ Just'
-                    ( w'
-                        & cwTime . rewindWorlds .~ ws
-                    )
 
 -- be careful changing this around; potential problems include updating the
 -- creature but using the old crInvSel value

src/Dodge/Update.hs

@@ -87,7 +87,7 @@ functionalUpdate w =
     checkEndGame
         --    . updateRandGen
         . over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held
-        . over uvWorld (cWorld . cwTime . worldClock +~ 1)
+        . over uvWorld (cwTime . worldClock +~ 1)
         . over uvWorld updateWorldSelect
         . over uvWorld doRewind
 --        . over uvWorld (hammers . each %~ moveHammerUp)
@@ -231,7 +231,7 @@ setOldPos cr =
 --updateRandGen = randGen %~ (snd . (uniform :: StdGen -> (Int,StdGen)))
 
 doRewind :: World -> World
-doRewind w = case w ^. cWorld . cwTime .  maybeWorld of
+doRewind w = case w ^. cwTime .  maybeWorld of
     Just' cw ->
         w & cWorld .~ cw
             & timeFlow .~ RewindingLastFrame
@@ -457,13 +457,13 @@ markSeen :: Wall -> Wall
 markSeen wl = wl{_wlSeen = True}
 
 checkEndGame :: Universe -> Universe
-checkEndGame uv = case w ^. cWorld . cwTime . deathDelay of
+checkEndGame uv = case w ^. cwTime . deathDelay of
     Just x
         | x < 0 ->
             uv & uvScreenLayers .~ [gameOverMenu]
-                & uvWorld . cWorld . cwTime . deathDelay .~ Nothing
+                & uvWorld . cwTime . deathDelay .~ Nothing
-    Just _ -> uv & uvWorld . cWorld . cwTime . deathDelay . _Just -~ 1
+    Just _ -> uv & uvWorld . cwTime . deathDelay . _Just -~ 1
-    _ | _crHP (you w) < 1 -> uv & uvWorld . cWorld . cwTime . deathDelay ?~ 50
+    _ | _crHP (you w) < 1 -> uv & uvWorld . cwTime . deathDelay ?~ 50
     _ -> uv
   where
     w = _uvWorld uv

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -53,7 +53,7 @@ aStaticBall p =
             , _ebPos = p
             , _ebWidth = 3
             , _ebTimer = 20
-            , _ebEff = (ELECTRICAL, 1)
+            , _ebEff = (ELECTRICAL, 10)
             , _ebZ = 20
             , _ebRot = 0
             }