Allow pausable reloads with discrete progess steps

src/Dodge/Data/LoadAction.hs

@@ -5,9 +5,10 @@ import Sound.Data
 import Dodge.Item.Data
 import Control.Lens
 data LoadAction
-    = Eject  {_actionTime :: Int, _actionSound :: SoundID}
+    = LoadEject  {_actionTime :: Int, _actionSound :: SoundID}
-    | Insert {_actionTime :: Int, _actionSound :: SoundID, _insertMax :: Maybe Int }
+    | LoadInsert {_actionTime :: Int, _actionSound :: SoundID}
-    | Prime  {_actionTime :: Int, _actionSound :: SoundID}
+    | LoadAdd    {_actionTime :: Int, _actionSound :: SoundID, _insertMax :: Int }
+    | LoadPrime  {_actionTime :: Int, _actionSound :: SoundID}
   deriving (Eq,Ord,Show)
 data InvSel = InvSel {_iselPos :: Int, _iselAction :: InvSelAction }
 data InvSelAction

src/Dodge/Event/Keyboard.hs

@@ -87,7 +87,7 @@ handlePressedKeyInGame scode w = case scode of
     ScancodeP       -> pauseGame $ escapeMap w
     ScancodeF       -> youDropItem w
     ScancodeM       -> toggleMap w
-    ScancodeR       -> crStartReloading (you w) w
+    ScancodeR       -> crToggleReloading (you w) w
     ScancodeT       -> testEvent w
     ScancodeX       -> w & hud . hudElement %~ toggleTweakInv
     ScancodeC       -> toggleCombineInv w

src/Dodge/Item/Display.hs

@@ -55,14 +55,14 @@ showSelectedConsumption cr ic = case ic of
 
 showReloadProgress :: Creature -> ItemConsumption -> String
 showReloadProgress cr ic = case cr ^?! crInvSel . iselAction of
-    ReloadAction i la _ -> show i ++ showLoadActionType la
+    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
+        Just la -> show (_actionTime la) ++ showLoadActionType la (_laLoaded ic)
 
 showLoadProgress :: Int -> Maybe [LoadAction] -> String
 showLoadProgress x mlas = case mlas ^? _Just . ix 0 of
-    Just la -> show (_actionTime la) ++ showLoadActionType la
+    Just la -> show (_actionTime la) ++ showLoadActionType la x
     Nothing -> show x
 
 showConsumption :: ItemConsumption -> String
@@ -71,11 +71,12 @@ showConsumption ic = case ic of
     am@ChargeableAmmo{} -> show $ _wpCharge am
     x@ItemItselfConsumable{} -> show (_icAmount x)
     NoConsumption -> ""
-showLoadActionType :: LoadAction -> String
+showLoadActionType :: LoadAction -> Int -> String
-showLoadActionType la = case la of
+showLoadActionType la x = case la of
-    Eject {}    -> "E"
+    LoadEject   {}  -> "E"
-    Insert {}   -> "L"
+    LoadInsert  {}  -> "L"
-    Prime {}    -> "P"
+    LoadAdd     {}  -> "A" ++ show x
+    LoadPrime   {}  -> "P"
 
 --    & itInvDisplay .~ \it -> head (basicItemDisplay it) : 
 --        ["*FIRERATE:" ++ fromMaybe "" (maybeRateStatus it)

src/Dodge/Item/Weapon/BulletGun/Cane.hs

@@ -149,7 +149,7 @@ repeater :: Item
 repeater = rifle
     & itType . iyModules . at ModRifleMag ?~ EMPTYMODULE
     & itType . iyBase .~ REPEATER
-    & itConsumption . laCycle .~ [loadEject 5, loadInsert 15 ,loadPrime 15]
+    & itConsumption . laCycle .~ [loadEject 20, loadInsert 20 ,loadPrime 20]
     & itConsumption . laMax .~ 15
     & itDimension . dimSPic .~ (\it -> noPic $ baseRifleShape
             <> makeTinClipAt 0 (V3 10 (-2) 0) it

src/Dodge/Reloading.hs

@@ -1,14 +1,13 @@
 module Dodge.Reloading 
     ( crCancelReloading
-    , crStartReloading
+    , crToggleReloading
     , stepReloading
     ) where
 import Dodge.Data
---import Dodge.Base.Arithmetic
+import Dodge.Hammer
---import qualified Data.IntMap.Strict as IM
 
 import Control.Lens
-import Data.Maybe
+--import Data.Maybe
 
 crCancelReloading :: Creature -> Creature
 crCancelReloading cr = cr 
@@ -17,75 +16,58 @@ crCancelReloading cr = cr
 
 stepReloading :: Creature -> Creature
 stepReloading cr = case cr ^?! crInvSel . iselAction of
+    ReloadAction _ _  (HasHammer HammerUp) -> cr & crInvSel . iselAction .~ NoInvSelAction
     ReloadAction x la _
         | x > 0     -> cr & crInvSel . iselAction . actionProgress -~ 1
-        | otherwise -> cr & completeLoadAction la
+            & crInvSel . iselAction . actionHammer . hammerPosition %~ moveHammerUp
+        | otherwise -> cr 
+            & crInvSel . iselAction . actionHammer . hammerPosition %~ moveHammerUp
+            & crInv . ix (crSel cr) . itConsumption %~ doLoadAction la
+            & crInv . ix (crSel cr) . itConsumption %~ rotateActionProgress
+            & tryNextLoadAction
     _ -> cr
 
-crStartReloading :: Creature -> World -> World
+tryNextLoadAction :: Creature -> Creature
-crStartReloading cr w = fromMaybe w $ w
+tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProgress . _Just . ix 0 of
-    & creatures . ix (_crID cr) %%~ tryStartLoading
+    Nothing -> cr & crInvSel . iselAction .~ NoInvSelAction
+    Just la -> cr & crInvSel . iselAction . actionProgress .~ _actionTime la
+        & crInvSel . iselAction . reloadAction .~ la
 
-tryStartLoading :: Creature -> Maybe Creature
-tryStartLoading cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProgress of
-    Just Nothing -> Just . startLoadAction $ cr
-        & crInv . ix (crSel cr) . itConsumption %~ setLoadCycle
-    Just (Just (a:_)) -> Just . startNextLoadAction a $ cr
-    Just (Just []) -> Nothing
-    _ -> Nothing
---    Just (Just _) -> Just . continueLoading $ cr
---    Nothing -> Nothing
 
-startLoadAction :: Creature -> Creature
+crToggleReloading :: Creature -> World -> World
-startLoadAction cr = continueLoading $ cr 
+crToggleReloading cr w = case cr ^?! crInvSel . iselAction of
-    & crInvSel . iselAction .~ ReloadAction (_actionTime la) la NoHammer
+    ReloadAction {} -> w & creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction
+    _ -> w & creatures . ix (_crID cr) %~ tryStartLoading
+
+tryStartLoading :: Creature -> Creature
+tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of
+    Just la -> cr & startLoadAction la
+    Nothing -> case ic ^? laCycle of
+        Nothing -> cr
+        Just [] -> error ("item has empty load cycle" ++ show (cr ^?! crInv . ix (crSel cr) . itType))
+        Just (la:las) -> cr & startLoadAction la
+            & crInv . ix (crSel cr) . itConsumption . laProgress ?~ (la:las)
   where
-    la = cr ^?! crInv . ix (crSel cr) . itConsumption . laProgress . _Just . ix 0
+    ic = cr ^?! crInv . ix (crSel cr) . itConsumption
 
-setLoadCycle :: ItemConsumption -> ItemConsumption
+startLoadAction :: LoadAction -> Creature -> Creature
-setLoadCycle ic = ic & laProgress ?~ _laCycle ic
+startLoadAction la cr = cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la NoHammer
 
-startNextLoadAction :: LoadAction -> Creature -> Creature
-startNextLoadAction la cr = cr
-    & crInvSel . iselAction .~ ReloadAction (_actionTime la) la NoHammer
 
-continueLoading :: Creature -> Creature
+rotateActionProgress :: ItemConsumption -> ItemConsumption
-continueLoading cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProgress . _Just of
+rotateActionProgress ic = case ic ^? laProgress . _Just of
-    Just (la:_) -> cr & crInvSel . iselAction . reloadAction .~ la
+    Just (_:la:las) -> ic & laProgress . _Just .~ (la:las)
-        & crInvSel . iselAction . actionProgress .~ _actionTime la
+    _ | _laLoaded ic < _laMax ic -> ic & laProgress ?~ _laCycle ic
-    Just [] -> case cr ^?! crInv . ix (crSel cr) . itConsumption of
+    _ -> ic & laProgress .~ Nothing
-        ic | _laLoaded ic < _laMax ic -> continueLoading $ cr
-            & crInv . ix (crSel cr) . itConsumption . laProgress ?~ _laCycle ic 
-        _ -> cr & crInvSel . iselAction .~ NoInvSelAction
-        & crInv . ix (crSel cr) . itConsumption . laProgress .~ Nothing
-    _     -> cr & crInvSel . iselAction .~ NoInvSelAction
-        & crInv . ix (crSel cr) . itConsumption . laProgress .~ Nothing
-
-completeLoadAction :: LoadAction -> Creature -> Creature
-completeLoadAction la cr = continueLoading $ cr
-    & crInv . ix (crSel cr) . itConsumption . laProgress . _Just %~ tail
-    & crInv . ix (crSel cr) . itConsumption %~ doLoadAction la
     
 
---    Just LoadFinished 
---        | _laLoaded ic >= _laMax ic -> Nothing
---        | otherwise                 -> Just $ ic & laProgress 
---                .~ LoadUnderway (_actionTime (head (_laCycle ic))) (_laCycle ic)
---    Just (LoadUnderway _ []) -> Just $ ic & laProgress .~ LoadFinished
---    Just (LoadUnderway t (a:_))
---        | t > 0 -> Just $ ic & laProgress . actionProgress -~ 1
---        | otherwise -> Just $ ic & doLoadAction a
---            & laProgress . futureActions %~ tail 
---            & laProgress . actionProgress .~ _actionTime a
---    Just (LoadPaused (a:as))    -> Just $ ic & laProgress .~ LoadUnderway (_actionTime a) (a:as)
---    Just (LoadPaused [])        -> Just $ ic & laProgress .~ LoadFinished
---    Nothing -> Nothing
-
 doLoadAction :: LoadAction -> ItemConsumption -> ItemConsumption
 doLoadAction la ic = case la of
-    Eject {}  -> ic & laLoaded .~ 0
+    LoadEject {}    -> ic & laLoaded .~ 0
-    Insert {_insertMax = mx} -> ic & laLoaded +~ maybe id min mx (_laMax ic - _laLoaded ic)
+    LoadInsert {}   -> ic & laLoaded .~ _laMax ic
-    Prime {} -> ic
+    LoadAdd   {_insertMax = x}
+                    -> ic & laLoaded +~ min x (_laMax ic - _laLoaded ic)
+    LoadPrime {}    -> ic
     
 --{- | Start reloading if clip is empty. -}
 --crAutoReload :: Creature -> Creature

src/Dodge/Reloading/Action.hs

@@ -3,13 +3,13 @@ import Dodge.SoundLogic.ExternallyGeneratedSounds
 import Dodge.Data.LoadAction
 
 loadInsert :: Int -> LoadAction
-loadInsert x = Insert x insertS Nothing
+loadInsert x = LoadInsert x insertS
 
 loadPartialInsert :: Int -> Int -> LoadAction
-loadPartialInsert x y = Insert x insertOneS (Just y)
+loadPartialInsert x y = LoadAdd x insertOneS y
 
 loadEject :: Int -> LoadAction
-loadEject x = Eject x ejectS
+loadEject x = LoadEject x ejectS
 
 loadPrime :: Int -> LoadAction
-loadPrime x = Prime x primeS
+loadPrime x = LoadPrime x primeS