Continue refactor of reloading

src/Dodge/Reloading.hs

@@ -1,32 +1,15 @@
 module Dodge.Reloading 
     ( stepReloading
-    , tryStartReloading
+--    , tryStartReloading
     , crStopReloading
+    , crStartReloading
     ) where
 import Dodge.Data
-import Dodge.Base.Arithmetic
+--import Dodge.Base.Arithmetic
 --import qualified Data.IntMap.Strict as IM
 
 import Control.Lens
-
-tryStartReloading :: Creature -> World -> Maybe World
-tryStartReloading cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of
-    Just LoadableAmmo {_laMax = ma, _laLoaded = la, _laReloadTime = rtime, _laReloadType = rtype, _laTransfer = NoTransfer}
-        | ma > la && rtype == ActiveClear  -> Just $ w & creatures . ix (_crID cr) %~ clearload
-        | ma > la && isActivePartial rtype -> Just $ w & creatures . ix (_crID cr) %~ partialload
-      where
-        isActivePartial ActivePartial {} = True
-        isActivePartial _ = False
-        clearload cr' = cr'
-            & crInv . ix (_crInvSel cr) . itConsumption . laLoaded .~ 0
-            & crInv . ix (_crInvSel cr) . itConsumption . laTransfer .~ Transfer ma rtime
-            & crStance . posture .~ Reloading
-        partialload cr' = cr'
-            & crInv . ix (_crInvSel cr) . itConsumption . laTransfer
-                .~ Transfer (min (ma - la) (_partialReloadAmount rtype)) rtime
-            & crStance . posture .~ Reloading
-    _ -> Nothing
-
+import Data.Maybe
 
 ---- TODO clean this up, rethink datatypes
 --icTryStartReloading :: Item -> Maybe Item
@@ -43,24 +26,51 @@ tryStartReloading cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of
 --                    else id
 --        else Nothing
 
+crStartReloading :: Creature -> World -> World
+crStartReloading cr = creatures . ix (_crID cr) . crStance . posture .~ Reloading
+
 crStopReloading :: Creature -> Creature
 crStopReloading cr = cr & crStance . posture .~ AtEase
 
--- ugly TODO cleanup
+startInsertAmmo :: ItemConsumption -> ItemConsumption
+startInsertAmmo ic = ic & laLoadType . loadProgress .~ Insert intime inamount
+  where
+    intime   = _insertTime (_laLoadType ic)
+    inamount = maybe id min (ic ^? laLoadType . loadAmount) (_laMax ic - _laLoaded ic)
+
+startEjectAmmo :: ItemConsumption -> ItemConsumption
+startEjectAmmo ic = ic & laLoadType . loadProgress .~ Eject (_ejectTime $ _laLoadType ic)
+
+loadAmmo :: Int -> ItemConsumption -> ItemConsumption
+loadAmmo inamount ic = ic 
+    & laLoaded  +~ inamount
+    & laLoadType . loadProgress .~ NoTransfer
+
 stepReloading :: Creature -> Creature
-stepReloading cr = case cr ^? crInv . ix isel . itConsumption . laTransfer of
-    Just (Transfer x 0) -> cr 
-        & crInv . ix isel %~ loadItem x
-        & crStance . posture .~ AtEase
-    Just Transfer {} -> cr 
-        & crInv . ix isel . itConsumption . laTransfer . transferTime %~ decreaseToZero
+stepReloading cr = case _posture (_crStance cr) of
+    Reloading -> fromMaybe (cr & crStance . posture .~ AtEase)
+        (cr & crInv . ix (_crInvSel cr) . itConsumption %%~ stepReloading')
     _ -> cr
-  where 
-    isel = _crInvSel cr 
-
-loadItem :: Int -> Item -> Item
-loadItem x = itConsumption %~ (set laTransfer NoTransfer . (laLoaded +~ x))
 
+stepReloading' :: ItemConsumption -> Maybe ItemConsumption
+stepReloading' ic = do
+    ltype <- ic ^? laLoadType
+    lprog <- ltype ^? loadProgress
+    case lprog of
+        Eject x 
+            | x > 0     -> Just $ ic & laLoadType . loadProgress . ejectProgress -~ 1
+            | otherwise -> Just $ ic & startInsertAmmo
+        Insert x inamount 
+            | x > 0     -> Just $ ic & laLoadType . loadProgress . insertProgress -~ 1
+            | otherwise -> Just $ ic & loadAmmo inamount
+        NoTransfer 
+            | _laLoaded ic >= _laMax ic 
+                        -> Nothing
+            | otherwise -> case ltype of
+                ActiveEject {}      -> Just $ ic & startEjectAmmo
+                ActivePartial {}    -> Just $ ic & startInsertAmmo
+                _                   -> Nothing
+    
 --{- | Start reloading if clip is empty. -}
 --crAutoReload :: Creature -> Creature
 --crAutoReload cr = case cr ^? ptrItConsumption' . ammoLoaded of