Continue refactoring reloading

src/Dodge/Creature/Action.hs

@@ -317,6 +317,5 @@ pickUpItemID cid flid w = pickUpItem cid (_floorItems w IM.! flid) w
 
 {- | Pick up a specific item. -}
 pickUpItem :: Int -> FloorItem -> World -> World
-pickUpItem cid flit w = maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing)
+pickUpItem cid flit w = maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd)
-    . fmap snd
     $ tryPutItemInInv cid flit w

src/Dodge/Creature/Stance/Data.hs

@@ -28,7 +28,9 @@ data FootForward
     | WasRightForward
   deriving
     (Eq,Ord,Show)
-data Posture = Aiming | Reloading | AtEase
+data Posture = Aiming 
+    | Reloading 
+    | AtEase
   deriving 
     (Eq,Ord,Show)
 

src/Dodge/Creature/State.hs

@@ -230,11 +230,9 @@ doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
         in w' & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
 
 weaponReloadSounds :: Creature -> World -> World
-weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of
+weaponReloadSounds cr w = case cr ^? crInvSelAction of
-    Just am@LoadableAmmo{} -> case am ^? laProgress of
+    Just ReloadAction{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
-        Just FinishedLoading -> w -- stopSoundFrom (CrReloadSound cid) w
+    _ -> w
-        Just _ -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
-        Nothing -> w
 --        PassiveReload stype | Just (_laReloadTime am) == am ^? laTransfer . transferTime
 --                                        -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w
 --        PassiveReload _ -> w 
@@ -244,10 +242,10 @@ weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption o
 --        ActivePartial{} | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) w
 --        ActivePartial{} | _laTransfer am == NoTransfer -> w
 --        ActivePartial{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
-    Just ChargeableAmmo {} -> w
+--    Just ChargeableAmmo {} -> w
-    Just NoConsumption {} -> w
+--    Just NoConsumption {} -> w
-    Just ItemItselfConsumable {} -> w
+--    Just ItemItselfConsumable {} -> w
-    Nothing -> w
+--    Nothing -> w
   where 
     cid = _crID cr
 

src/Dodge/Creature/Test.hs

@@ -28,6 +28,9 @@ crIsReloading cr = case cr ^? crStance . posture of
     Just Reloading -> True
     _ -> False
 
+crWeaponReady :: Creature -> Bool
+crWeaponReady cr = isNothing $ cr ^? crInv . ix (_crInvSel cr) . itConsumption . laProgress . _Just
+
 crCanSeeCr :: Creature -> (World, Creature) -> Bool
 crCanSeeCr tcr (w,cr) = hasLOS (_crPos cr) (_crPos tcr) w
 

src/Dodge/Data.hs

@@ -216,9 +216,7 @@ data SubInventory
     | CombineInventory {_combineInvSel :: Maybe Int}
     | InspectInventory
     | LockedInventory
-    | DisplayTerminal 
+    | DisplayTerminal {_termID :: Int }
-        {_termID :: Int
-        }
 --  deriving (Eq,Ord,Show)
 
 data HUD = HUD
@@ -349,6 +347,7 @@ data Creature = Creature
     , _crMaxHP          :: Int
     , _crInv            :: IM.IntMap Item
     , _crInvSel         :: Int
+    , _crInvSelAction   :: InvSelAction
     , _crInvCapacity    :: Int
     , _crInvLock        :: Bool
     , _crInvEquipped    :: IM.IntMap EquipPosition
@@ -488,7 +487,7 @@ data ItemConsumption
         , _laMax        :: Int
         , _laLoaded     :: Int
         , _laCycle      :: [LoadAction]
-        , _laProgress   :: LoadProgress
+        , _laProgress   :: Maybe [LoadAction]
         }
     | ChargeableAmmo
         { _wpMaxCharge  :: Int
@@ -546,22 +545,14 @@ data ItemPortage
     | WornItem
     | NoPortage
 
-data LoadActionProgress = LoadActionProgress
-    { _actionProgress :: Int
-    , _actionType :: LoadAction
-    }
-  deriving (Eq,Ord,Show)
-
-data LoadProgress
-    = InProgress { _lastAction :: Maybe LoadAction, _futureActions :: [LoadActionProgress] }
-    | FinishedLoading
-  deriving (Eq,Ord,Show)
-
 data LoadAction
     = Eject  {_actionTime :: Int}
     | Insert {_actionTime :: Int, _insertMax :: Maybe Int }
     | Prime  {_actionTime :: Int}
   deriving (Eq,Ord,Show)
+data InvSelAction
+    = NoInvSelAction
+    | ReloadAction { _actionProgress :: Int, _reloadAction :: LoadAction }
 
 -- I believe this is called every frame, not sure when though
 data ItEffect 
@@ -1487,8 +1478,7 @@ makeLenses ''FloorItem
 makeLenses ''ItemConsumption
 makeLenses ''AmmoType
 makeLenses ''LoadAction
-makeLenses ''LoadActionProgress
+makeLenses ''InvSelAction
-makeLenses ''LoadProgress
 makeLenses ''TweakParam
 makeLenses ''Prop
 makeLenses ''Modification

src/Dodge/Data/Material.hs

@@ -1,7 +1,7 @@
-{-# LANGUAGE TemplateHaskell #-}
+--{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE DeriveGeneric #-}
+--{-# LANGUAGE DeriveGeneric #-}
 module Dodge.Data.Material where
 data Material = Wood | Dirt | Stone | Glass | Metal | Crystal
   deriving (Eq,Ord,Show,Bounded,Enum)

src/Dodge/Default.hs

@@ -47,6 +47,7 @@ defaultCreature = Creature
     , _crMaxHP  = 150
     , _crInv    = IM.empty
     , _crInvSel = 0
+    , _crInvSelAction = NoInvSelAction
     , _crInvCapacity = 25
     , _crInvLock = False
     , _crInvEquipped = mempty

src/Dodge/Default/Weapon.hs

@@ -20,7 +20,7 @@ defaultLoadable = LoadableAmmo
     , _laMax        = 15
     , _laLoaded     = 0
     , _laCycle      = [Eject 10, Insert 10 Nothing, Prime 10]
-    , _laProgress   = FinishedLoading
+    , _laProgress   = Nothing
     }
 defaultBulletLoadable :: ItemConsumption
 defaultBulletLoadable = defaultLoadable & laAmmoType .~ basicBullet

src/Dodge/Item/Display.hs

@@ -31,14 +31,13 @@ itemDisplay it = Prelude.take (itSlotsTaken it) $
 
 showConsumption :: ItemConsumption -> String
 showConsumption ic = case ic of
-    am@LoadableAmmo{} -> showLoading (_laProgress ic) ++ show (_laLoaded am)
+    am@LoadableAmmo{} -> showLoading ic ++ show (_laLoaded am)
     am@ChargeableAmmo{} -> show $ _wpCharge am
     x@ItemItselfConsumable{} -> show (_icAmount x)
     NoConsumption -> ""
-showLoading :: LoadProgress -> String
+showLoading :: ItemConsumption -> String
-showLoading lt = case lt ^? futureActions . ix 0 of
+showLoading ic = case ic ^? laProgress . _Just . ix 0 of
-    Just lap -> show (_actionTime (_actionType lap) - _actionProgress lap) 
+    Just la -> showLoadActionType la
-        ++ showLoadActionType (_actionType lap)
     Nothing -> ""
 showLoadActionType :: LoadAction -> String
 showLoadActionType la = case la of

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

@@ -154,7 +154,7 @@ smgAfterHamMods =
     ]
 
 pistol :: Item
-pistol = (bangStick 1)
+pistol = bangStick 1
     & itConsumption .~ ( defaultBulletLoadable
         & laMax .~ 15
         & laCycle .~ [Eject 5, Insert 5 Nothing, Prime 5] )

src/Dodge/Item/Weapon/TriggerType.hs

@@ -173,15 +173,15 @@ rateIncAB exeffFirst exeffCont eff item cr w
     itRef = _crInvSel cr
     pointItem = creatures . ix cid . crInv . ix itRef
     currentRate = _rateMax (_useDelay (_itUse item))
-    repeatFire = _laProgress (_itConsumption item) == FinishedLoading && _rateTime (_useDelay (_itUse item)) == 1 
+    repeatFire = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 1 
-    firstFire  = _laProgress (_itConsumption item) == FinishedLoading && _rateTime (_useDelay (_itUse item)) == 0 
+    firstFire  = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 0 
 {- | Apply effect after a warm up.  -}
 -- note this is quite unsafe, requires the item to have the correct delay type
 withWarmUp
     :: SoundID -- ^ warm up sound id
     -> ChainEffect
 withWarmUp soundID f item cr w
-    | _laProgress (_itConsumption item) /= FinishedLoading = w
+    | crWeaponReady cr = w
     | curWarmUp < maxWarmUp = w
         & pointerToItem . itUse . useDelay . warmTime +~ 2
         & soundContinue (CrWeaponSound cid 0) (_crPos cr) soundID (Just 2)
@@ -323,7 +323,7 @@ ammoUseCheck f item cr w
     cid = _crID cr
     itRef = _crInvSel cr
     pointerToItem = creatures . ix cid . crInv . ix itRef
-    fireCondition = _laProgress (_itConsumption item) == FinishedLoading
+    fireCondition = crWeaponReady cr
         && _rateTime (_useDelay (_itUse item)) == 0
         && _laLoaded (_itConsumption item) > 0
 --    reloadCondition = _laLoaded (_itConsumption item) == 0
@@ -359,7 +359,7 @@ shootL f item cr w
     cid = _crID cr
     invid = fromJust $ _itInvPos item
     pointerToItem = creatures . ix cid . crInv . ix invid
-    fireCondition = _laProgress (_itConsumption item) == FinishedLoading
+    fireCondition = crWeaponReady cr
         && _rateTime (_useDelay (_itUse item)) == 0
         && _laLoaded (_itConsumption item) > 0
 --    reloadCondition = _laLoaded (_itConsumption item) == 0

src/Dodge/Reloading.hs

@@ -19,25 +19,53 @@ crStopReloading cr = cr & crStance . posture .~ AtEase
 
 stepReloading :: Creature -> Creature
 stepReloading cr = case _posture (_crStance cr) of
-    Reloading -> fromMaybe (cr & crStance . posture .~ AtEase)
+    Reloading -> fromMaybe 
-        (cr & crInv . ix (_crInvSel cr) . itConsumption %%~ stepReloading')
+        (cr & crStance . posture .~ AtEase)
-    _ -> cr
+        (cr & stepReloading')
+    _ -> cr & crInvSelAction .~ NoInvSelAction
 
-stepReloading' :: ItemConsumption -> Maybe ItemConsumption
+stepReloading' :: Creature -> Maybe Creature
-stepReloading' ic = case _laProgress ic of
+stepReloading' cr = case cr ^?! crInvSelAction of
-    FinishedLoading 
+    ReloadAction x la | x > 0 -> Just $ cr & crInvSelAction . actionProgress -~ 1
-        | _laLoaded ic >= _laMax ic -> Nothing
+        | otherwise -> Just $ cr & completeLoadAction la
-        | otherwise                 -> Just $ ic & laProgress 
+    _ -> tryStartLoading cr
-                .~ InProgress Nothing (map toLoadProgress (_laCycle ic))
-    InProgress _ [] -> Just $ ic & laProgress .~ FinishedLoading
-    InProgress _ (a:_)
-        | _actionProgress a > 0 -> Just $ ic & laProgress . futureActions . ix 0 . actionProgress -~ 1
-        | otherwise -> Just $ ic & doLoadAction (_actionType a)
-            & laProgress . futureActions %~ tail 
-            & laProgress . lastAction ?~ (_actionType a)
 
-toLoadProgress :: LoadAction -> LoadActionProgress
+tryStartLoading :: Creature -> Maybe Creature
-toLoadProgress la = LoadActionProgress (_actionTime la) la
+tryStartLoading cr = case cr ^? crInv . ix (_crInvSel cr) . itConsumption . laProgress of
+    Just Nothing -> Just . continueLoading $ cr 
+        & crInv . ix (_crInvSel cr) . itConsumption %~ setLoadCycle
+    Just (Just _) -> Just . continueLoading $ cr
+    Nothing -> Nothing
+
+setLoadCycle :: ItemConsumption -> ItemConsumption
+setLoadCycle ic = ic & laProgress ?~ _laCycle ic
+
+continueLoading :: Creature -> Creature
+continueLoading cr = case cr ^? crInv . ix (_crInvSel cr) . itConsumption . laProgress . _Just of
+    Just (la:_) -> cr & crInvSelAction .~ ReloadAction (_actionTime la) la
+    _     -> cr & crInvSelAction .~ NoInvSelAction
+        & crInv . ix (_crInvSel cr) . itConsumption . laProgress .~ Nothing
+        & crStance . posture .~ AtEase
+
+completeLoadAction :: LoadAction -> Creature -> Creature
+completeLoadAction la cr = continueLoading $ cr
+    & crInv . ix (_crInvSel cr) . itConsumption . laProgress . _Just %~ tail
+    & crInv . ix (_crInvSel 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