Tweak scrolling, move onto reloading

2023-01-07 23:50:54 +00:00
parent d4122b2d6f
commit f8d9b54586
7 changed files with 27 additions and 35 deletions
@@ -8,7 +8,6 @@ module Dodge.Data.Item.Use.Consumption.LoadAction where
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import Dodge.Data.Hammer
 import Sound.Data

 data LoadAction
@@ -25,7 +24,7 @@ data InvSel

 data InvSelAction
    = NoInvSelAction
-    | ReloadAction {_actionProgress :: Int, _reloadAction :: LoadAction, _actionHammer :: HammerType}
+    | ReloadAction {_actionProgress :: Int, _reloadAction :: LoadAction}
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 data LeftInvSel = LeftInvSel
@@ -14,7 +14,7 @@ import Dodge.Item.Weapon.ZoomScope
 doHeldScroll :: HeldScroll -> Float -> Creature -> World -> World
 doHeldScroll hs = case hs of
    HeldScrollDoNothing -> const . const id
-    HeldScrollZoom -> overYourItem (const . zoomLongGun)
+    HeldScrollZoom -> overYourItem (const . setZoomScopeChange)
    HeldScrollCharMode{} -> overYourItem $ \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
  where
    overYourItem f x cr w = w & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ f x cr
@@ -66,7 +66,7 @@ showAutoRechargeProgress lc = case lc of

 showReloadProgress :: Creature -> HeldConsumption -> String
 showReloadProgress cr ic = case cr ^? crInvSel . iselAction of
-    Just (ReloadAction i la _) -> show i ++ showLoadActionType la (_laLoaded ic)
+    Just (ReloadAction i la) -> show i ++ showLoadActionType la (_laLoaded ic)
    _ -> case ic ^? laProgress . _Just . ix 0 of
        Nothing -> show $ _laLoaded ic
        Just la -> show (_actionTime la) ++ showLoadActionType la (_laLoaded ic)
@@ -4,16 +4,16 @@ import Dodge.Data.Item
 import LensHelp
 -- should be possible without the creature

-zoomLongGun :: Float -> Item -> Item
-zoomLongGun x
+setZoomScopeChange :: Float -> Item -> Item
+setZoomScopeChange 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 > 1 = 10
        | x > 0 = 1
        | x < -2 = - 20
-        | x < -1 = - 4
+        | x < -1 = - 10
        | x < -0 = - 1
        | otherwise = 0
@@ -7,7 +7,6 @@ module Dodge.Reloading (

 import Control.Lens
 import Dodge.Data.Creature
-import Dodge.Hammer

 crCancelReloading :: Creature -> Creature
 crCancelReloading cr =
@@ -17,14 +16,12 @@ crCancelReloading cr =

 stepReloading :: Creature -> Creature
 stepReloading cr = case cr ^?! crInvSel . iselAction of
-    ReloadAction _ _ (HasHammer HammerUp) -> cr & crInvSel . iselAction .~ NoInvSelAction
-    ReloadAction x la _
+--    ReloadAction _ _ (HasHammer HammerUp) -> cr & crInvSel . iselAction .~ NoInvSelAction
+    ReloadAction x la
        | x > 0 ->
            cr & crInvSel . iselAction . actionProgress -~ 1
-                & crInvSel . iselAction . actionHammer . hammerPosition %~ moveHammerUp
        | otherwise ->
            cr
-                & crInvSel . iselAction . actionHammer . hammerPosition %~ moveHammerUp
                & crInv . ix (crSel cr) . itUse . heldConsumption %~ doLoadAction la
                & crInv . ix (crSel cr) . itUse . heldConsumption %~ rotateActionProgress
                & tryNextLoadAction
@@ -59,7 +56,7 @@ startLoading ic cr = case ic ^? laProgress . _Just . ix 0 of
                & crInv . ix (crSel cr) . itUse . heldConsumption . laProgress ?~ (la : las)

 startLoadingStep :: LoadAction -> Creature -> Creature
-startLoadingStep la cr = cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la NoHammer
+startLoadingStep la cr = cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la

 rotateActionProgress :: HeldConsumption -> HeldConsumption
 rotateActionProgress ic = case ic ^? laProgress . _Just of
@@ -335,9 +335,7 @@ menuWheelStep i u = fromMaybe u $ do
 --  where
 --    y = w ^. input . scrollAmount
 updateWheelEvents :: World -> World
-updateWheelEvents w = updateWheelEvent y w
-  where
-    y = w ^. input . scrollAmount
+updateWheelEvents w = updateWheelEvent (w ^. input . scrollAmount) w

 advanceScrollAmount :: Universe -> Universe
 advanceScrollAmount u =
@@ -351,18 +349,13 @@ updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. lWorld
 --updatePastWorlds w = w & pastWorlds .~ []

 moveHammersUp :: Universe -> Universe
--moveHammersUp = uvWorld . hammers .~ M.empty
 moveHammersUp = uvWorld . input . hammers %~ M.map moveHammerUp

--moveHammersUp = uvWorld . hammers . each %~ (moveHammerUp $!)
--moveHammersUp = uvWorld %~ ( (hammers . each %~ (moveHammerUp $!)) $!)
--moveHammersUp uv = uv { _uvWorld = w' }
--  where
--    w = _uvWorld uv
--    w' = w {_hammers = fmap moveHammerUp (_hammers w)}
-
 doWorldEvents :: World -> World
-doWorldEvents w = foldl' (flip doWdWd) (w & cWorld . lWorld . worldEvents .~ []) (w ^. cWorld . lWorld . worldEvents)
+doWorldEvents w = foldl' 
+    (flip doWdWd) 
+    (w & cWorld . lWorld . worldEvents .~ []) 
+    (w ^. cWorld . lWorld . worldEvents)

 updateLasers :: World -> World
 updateLasers w =
@@ -95,12 +95,18 @@ updateScopeZoom w
 doScopeZoom :: Point2 -> Scope -> Scope
 doScopeZoom mp sc = case sc ^? scopeZoomChange of
    Just x
-        | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc
-        | x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) sc
-        | x > 0 -> (zoomInLongGun mp) sc
-        | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc
-        | x < -5 -> (zoomOutLongGun . zoomOutLongGun) sc
-        | x < 0 ->  zoomOutLongGun sc
+        | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) $ sc
+            & scopeZoomChange -~ 2
+        | x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) $ sc
+            & scopeZoomChange -~ 1
+        | x > 0 -> zoomInLongGun mp $ sc
+            & scopeZoomChange -~ 1
+        | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) $ sc
+            & scopeZoomChange +~ 2
+        | x < -5 -> (zoomOutLongGun . zoomOutLongGun) $ sc
+            & scopeZoomChange +~ 1
+        | x < 0 ->  zoomOutLongGun $ sc
+            & scopeZoomChange +~ 1
        | otherwise -> sc
    _ -> sc

@@ -113,7 +119,6 @@ zoomInLongGun mousep sc
        sc
            & scopePos .+.+~ (1 - zoomSpeed) / newzoom *.* mousep
            & scopeZoom %~ (/ zoomSpeed)
-            & scopeZoomChange -~ 1
    | otherwise = sc & scopeZoomChange .~ 0
  where
    Just currentZoom = sc ^? scopeZoom
@@ -126,7 +131,6 @@ zoomOutLongGun sc
            & 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
@@ -204,7 +208,6 @@ setViewDistance cfig w =
    w & camViewDistance
        .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. camZoom)

-
 farWallDistDirection :: Point2 -> World -> Maybe (Float, Float, Float, Float)
 farWallDistDirection p w =
    boundPoints $