Tweak scrolling, particularly zooming

src/Dodge/Data/Item/HeldScroll.hs

@@ -15,11 +15,6 @@ data HeldScroll
     | HeldScrollZoom
     | HeldScrollCharMode
         {_hsCharMode :: Seq.Seq Char}
-    | HeldScrollInt
-        { _hsInt :: Int
-        , _hsMaxInt :: Int
-        }
-    | HeldScrollTime
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''HeldScroll

src/Dodge/HeldScroll.hs

@@ -14,21 +14,11 @@ import Dodge.Item.Weapon.ZoomScope
 doHeldScroll :: HeldScroll -> Float -> Creature -> World -> World
 doHeldScroll hs = case hs of
     HeldScrollDoNothing -> const . const id
-    HeldScrollZoom -> overYourItem zoomLongGun
+    HeldScrollZoom -> overYourItem (const . zoomLongGun)
     HeldScrollCharMode{} -> overYourItem $ \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
-    HeldScrollTime -> doScrollTime
-    HeldScrollInt{} -> undefined
   where
     overYourItem f x cr w = w & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ f x cr
 
-doScrollTime :: Float -> Creature -> World -> World
-doScrollTime _ _ w = 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/Item/Display.hs

@@ -108,7 +108,6 @@ maybeWarmupStatus it = case it ^? itUse . heldDelay . warmMax of
 maybeModeStatus :: Item -> Maybe String
 maybeModeStatus it = case it ^? itUse . heldScroll of
     Just HeldScrollCharMode{_hsCharMode = (c :<| _)} -> Just [' ', c]
-    Just HeldScrollInt{_hsInt = i} -> Just $ show i
     _ -> Nothing
 
 maybeRateStatus :: Item -> Maybe String

src/Dodge/Item/Weapon/ZoomScope.hs

@@ -1,11 +1,19 @@
 module Dodge.Item.Weapon.ZoomScope where
 
-import Dodge.Data.Creature
+import Dodge.Data.Item
 import LensHelp
 -- should be possible without the creature
 
-zoomLongGun :: Float -> Creature -> Item -> Item
-zoomLongGun x _
-    | x > 0 = itScope . scopeZoomChange %~ (max 15 . (+ 4))
-    | x < 0 = itScope . scopeZoomChange %~ (min (-15) . subtract 4)
+zoomLongGun :: Float -> Item -> Item
+zoomLongGun x
+    | x > 0 = itScope . scopeZoomChange %~ (max 0 . (+ xi))
+    | x < 0 = itScope . scopeZoomChange %~ (min 0 . (+ xi))
     | otherwise = id
+  where
+    xi  | x > 2 = 20
+        | x > 1 = 4
+        | x > 0 = 1
+        | x < -2 = - 20
+        | x < -1 = - 4
+        | x < -0 = - 1
+        | otherwise = 0

src/Dodge/TestString.hs

@@ -1,5 +1,6 @@
 module Dodge.TestString where
 
+import Dodge.Base.You
 import Control.Lens
 import Dodge.Data.Universe
 --import Data.Maybe
@@ -8,8 +9,18 @@ import Dodge.Data.Universe
 --import qualified IntMapHelp as IM
 testStringInit :: Universe -> [String]
 testStringInit u = 
-     [  showTimeFlow $ u ^. uvWorld . cWorld . timeFlow
+     [ show $ u ^. uvWorld . input . scrollAmount 
+    , maybe mempty show mit
+     , maybe mempty (show . f) mit
+     , maybe mempty show mit'
+     , maybe mempty show mit''
     ]
+  where
+    f x = 1/ (x *2) ** (40/39)
+    ycr = you (u ^. uvWorld)
+    mit = ycr ^? crInv . ix (crSel ycr) . itScope . scopeZoom
+    mit' = ycr ^? crInv . ix (crSel ycr) . itScope . scopePos
+    mit'' = ycr ^? crInv . ix (crSel ycr) . itScope . scopeZoomChange
 
 showTimeFlow :: TimeFlowStatus -> String
 showTimeFlow tfs = case tfs of

src/Dodge/Update.hs

@@ -330,8 +330,12 @@ menuWheelStep i u = fromMaybe u $ do
         then Just newu
         else Just $ menuWheelStep i newu
 
+--updateWheelEvents :: World -> World
+--updateWheelEvents w = foldr ($) w (replicate (abs y) (updateWheelEvent (signum y)))
+--  where
+--    y = w ^. input . scrollAmount
 updateWheelEvents :: World -> World
-updateWheelEvents w = foldr ($) w (replicate (abs y) (updateWheelEvent (signum y)))
+updateWheelEvents w = updateWheelEvent y w
   where
     y = w ^. input . scrollAmount
 

src/Dodge/Update/Camera.hs

@@ -84,16 +84,12 @@ moveZoomCamera cfig theinput cr campos =
 
 updateScopeZoom :: World -> World
 updateScopeZoom w
-    | SDL.ButtonRight `M.member` _mouseButtons (_input w) = over wppointer (doScopeZoom mp) w
-    | otherwise =
-        w
-            & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0))
-                . itScope
-            %~ updateScope
+    | SDL.ButtonRight `M.member` _mouseButtons (_input w) = w & wppointer %~ doScopeZoom mp
+    | otherwise = w & wppointer %~ resetscope
   where
     wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0)) . itScope
-    updateScope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
-    updateScope otherAtt = otherAtt
+    resetscope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
+    resetscope otherAtt = otherAtt
     mp = rotateV (w ^. cWorld . camPos . camRot) $ _mousePos (_input w)
 
 doScopeZoom :: Point2 -> Scope -> Scope
@@ -117,23 +113,25 @@ zoomInLongGun mousep sc
         sc
             & scopePos .+.+~ (1 - zoomSpeed) / newzoom *.* mousep
             & scopeZoom %~ (/ zoomSpeed)
-            & decreaseScopeZoomChange
+            & scopeZoomChange -~ 1
     | otherwise = sc & scopeZoomChange .~ 0
   where
-    decreaseScopeZoomChange = scopeZoomChange -~ 1
     Just currentZoom = sc ^? scopeZoom
     newzoom = (sc ^?! scopeZoom) / zoomSpeed
 
 zoomOutLongGun :: Scope -> Scope
 zoomOutLongGun sc
-    | currentZoom > 0.5 =
+    | currentzoom > 0.5 =
         sc
-            --        & scopePos .+.+~ ((1*zoomSpeed-1)) / currentZoom *.* mousep
+            & scopePos %~ (\p -> p +.+ (zoomSpeed-1) / currentzoom *.* p)
+--            & scopePos .*.*~ 1 - ((newzoom * 2) ** zoomSpeed)
             & scopeZoom *~ zoomSpeed
             & scopeZoomChange +~ 1
     | otherwise = sc & scopeZoomChange .~ 0
+        & scopePos .~ V2 0 0
   where
-    Just currentZoom = sc ^? scopeZoom
+    Just currentzoom = sc ^? scopeZoom
+    --newzoom = (sc ^?! scopeZoom) / zoomSpeed
 
 ifConfigWallRotate :: Configuration -> World -> World
 ifConfigWallRotate cfig w