Make reloading based upon creature stance

src/Dodge/Creature/State.hs

@@ -232,14 +232,14 @@ doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
 weaponReloadSounds :: Creature -> World -> World
 weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of
     Just am@LoadableAmmo{} -> case _laReloadType am of
-        PassiveReload stype | Just' (_laReloadTime am) == _laReloadState am 
+        PassiveReload stype | Just (_laReloadTime am) == am ^? laTransfer . transferTime
                                         -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w
         PassiveReload _ -> w 
-        ActiveClear | _laReloadState am == Just' 0 -> stopSoundFrom (CrReloadSound cid) w
+        ActiveClear | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) w
-        ActiveClear | _laReloadState am == Nothing' -> w
+        ActiveClear | _laTransfer am == NoTransfer -> w
         ActiveClear -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
-        ActivePartial{} | _laReloadState am == Just' 0 -> stopSoundFrom (CrReloadSound cid) w
+        ActivePartial{} | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) w
-        ActivePartial{} | _laReloadState am == Nothing' -> w
+        ActivePartial{} | _laTransfer am == NoTransfer -> w
         ActivePartial{} -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w
     Just ChargeableAmmo {} -> w
     Just NoConsumption {} -> w

src/Dodge/Creature/Test.hs

@@ -24,8 +24,8 @@ onBoth :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c
 onBoth f g h x = f (g x) (h x)
 
 crIsReloading :: Creature -> Bool
-crIsReloading cr = case cr ^? crInv . ix (_crInvSel cr) . itConsumption . laReloadState . _Just' of
+crIsReloading cr = case cr ^? crStance . posture of
-    Just t -> t > 0
+    Just Reloading -> True
     _ -> False
 
 crCanSeeCr :: Creature -> (World, Creature) -> Bool

src/Dodge/Creature/YourControl.hs

@@ -13,7 +13,7 @@ import Control.Lens
 import qualified SDL
 import qualified Data.Set as S
 --import qualified Data.IntMap.Strict as IM
-import Data.Maybe
+--import Data.Maybe
 {- | The AI equivalent for your control. -}
 yourControl :: Creature -> World -> World
 yourControl cr w 
@@ -72,9 +72,9 @@ wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys
 {- | Set posture according to mouse presses. -}
 mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
 mouseActionsCr pkeys cr
-    | reloading = cr & crStance . posture .~ Reloading
+    | _posture (_crStance cr) == Reloading = cr
     | rbPressed = cr & crStance . posture .~ Aiming
     | otherwise = cr & crStance . posture .~ AtEase
   where 
-    reloading = isJust $ cr ^? crInv . ix (_crInvSel cr) . itConsumption . laReloadState . _Just'
+--    reloading = isJust $ cr ^? crInv . ix (_crInvSel cr) . itConsumption . laReloadState . _Just'
     rbPressed = SDL.ButtonRight `S.member` pkeys

src/Dodge/Data.hs

@@ -482,14 +482,19 @@ data Equipment = Equipment
 _itUseAimStance :: Item -> AimStance
 _itUseAimStance = _aimStance . _useAim . _itUse
 
+data TransferState
+    = Transfer { _transferAmount :: Int , _transferTime :: Int}
+    | NoTransfer
+  deriving (Eq,Ord,Show)
+
 data ItemConsumption
     = LoadableAmmo
-        { _laType  :: AmmoType
+        { _laType       :: AmmoType
-        , _laMax   :: Int
+        , _laMax        :: Int
         , _laLoaded     :: Int
-        , _laReloadTime     :: Int
+        , _laReloadTime :: Int
-        , _laReloadState    :: Maybe' Int
+        , _laTransfer   :: TransferState
-        , _laReloadType     :: ReloadType
+        , _laReloadType :: ReloadType
         }
     | ChargeableAmmo
         { _wpMaxCharge  :: Int
@@ -549,7 +554,7 @@ data ItemPortage
 
 data ReloadType 
     = ActiveClear
-    | ActivePartial Int
+    | ActivePartial {_partialReloadAmount :: Int}
     | PassiveReload SoundID
   deriving Eq
 
@@ -1476,6 +1481,7 @@ makeLenses ''ItEffect
 makeLenses ''FloorItem
 makeLenses ''ItemConsumption
 makeLenses ''AmmoType
+makeLenses ''TransferState
 makeLenses ''TweakParam
 makeLenses ''Prop
 makeLenses ''Modification

src/Dodge/Default/Weapon.hs

@@ -15,11 +15,11 @@ import Control.Lens
 
 defaultAmmo :: ItemConsumption
 defaultAmmo = LoadableAmmo 
-    { _laType = GenericAmmo
+    { _laType       = GenericAmmo
-    , _laMax = 15
+    , _laMax        = 15
-    , _laLoaded = 0
+    , _laLoaded     = 0
     , _laReloadTime = 40
-    , _laReloadState = Nothing'
+    , _laTransfer   = NoTransfer
     , _laReloadType = ActiveClear
     }
 

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       -> fromMaybe w $ startReloadingWeapon (you w) w
+    ScancodeR       -> fromMaybe w $ tryStartReloading (you w) w
     ScancodeT       -> testEvent w
     ScancodeX       -> w & hud . hudElement %~ toggleTweakInv
     ScancodeC       -> toggleCombineInv w

src/Dodge/Item/Display.hs

@@ -21,9 +21,9 @@ itemDisplay it = Prelude.take (itSlotsTaken it) $
   where 
     thename  = show . _iyBase $ _itType it
     thenumber = case it ^? itConsumption of
-        Just am@LoadableAmmo{} -> case _laReloadState am of 
+        Just am@LoadableAmmo{} -> case _laTransfer am of 
-            Nothing' -> show (_laLoaded am)
+            NoTransfer -> show (_laLoaded am)
-            Just' x  -> show x ++ "R" ++ show (_laLoaded am)
+            Transfer _ time  -> show time ++ "R" ++ show (_laLoaded am)
         Just am@ChargeableAmmo{} -> show $ _wpCharge am
         Just x@ItemItselfConsumable{} -> show (_icAmount x)
         Just NoConsumption -> ""

src/Dodge/Item/Weapon/AmmoParams.hs

@@ -66,11 +66,11 @@ useAmmoParams vfact it cr w = w & instantParticles .:~ aBulAt
             return $ \pt -> pt 
                 & ptVel .~ bf (fromIntegral $ _ptTimer pt - 1) -.- bf (fromIntegral $ _ptTimer pt)
 
--- this shouldn't really be used
+---- this shouldn't really be used
 loadedAmmo :: Item -> Int
-loadedAmmo it
+loadedAmmo = _laLoaded . _itConsumption
-    | _laReloadState (_itConsumption it) == Nothing' = _laLoaded (_itConsumption it)
+--    | _laTransfer (_itConsumption it) == NoTransfer = _laLoaded (_itConsumption it)
-    | otherwise = 0
+--    | otherwise = 0
 
 fractionLoadedAmmo :: Item -> Float
 fractionLoadedAmmo it = fromIntegral (loadedAmmo it) / fromIntegral (itmaxammo it)

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -208,7 +208,7 @@ targetLaserUpdate it cr w t
     wpammo = _itConsumption it
     reloadFrac 
         | _laLoaded wpammo == 0 = 1
-        | otherwise = case _laReloadState wpammo of
+        | otherwise = case _laTransfer wpammo of
-            Just' rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo)
+            Transfer _ rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo)
-            Nothing' -> 1
+            NoTransfer -> 1
     col = mixColors reloadFrac (1-reloadFrac) blue red

src/Dodge/Item/Weapon/TriggerType.hs

@@ -125,7 +125,7 @@ withThickSmokeI eff item cr w = eff item cr
 -- fire.
 ammoCheckI :: ChainEffect
 ammoCheckI eff item cr w
-    | _laLoaded (_itConsumption item) <= 0 = fromMaybe w (startReloadingWeapon cr w)
+    | _laLoaded (_itConsumption item) <= 0 = w -- fromMaybe w (startReloadingWeapon cr w)
 --    | _reloadState (_itConsumption item) /= Nothing' = w 
     | otherwise = eff item cr $ w & creatures . ix (_crID cr) %~ crStopReloading
 
@@ -133,7 +133,7 @@ ammoCheckI eff item cr w
 -- hammer is down?
 ammoHammerCheck :: ChainEffect
 ammoHammerCheck eff it cr w
-    | _laLoaded (_itConsumption it) <= 0 = fromMaybe w (startReloadingWeapon cr w)
+    | _laLoaded (_itConsumption it) <= 0 = w -- fromMaybe w (startReloadingWeapon cr w)
         & setHammerDown
     | otherwise = case it ^? itUse . useHammer . hammerPosition of
         Just HammerUp -> eff it cr $ setHammerDown w & creatures . ix (_crID cr) %~ crStopReloading
@@ -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 = _laReloadState (_itConsumption item) == Nothing' && _rateTime (_useDelay (_itUse item)) == 1 
+    repeatFire = _laTransfer (_itConsumption item) == NoTransfer && _rateTime (_useDelay (_itUse item)) == 1 
-    firstFire  = _laReloadState (_itConsumption item) == Nothing' && _rateTime (_useDelay (_itUse item)) == 0 
+    firstFire  = _laTransfer (_itConsumption item) == NoTransfer && _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
-    | _laReloadState (_itConsumption item) /= Nothing' = w
+    | _laTransfer (_itConsumption item) /= NoTransfer = w
     | curWarmUp < maxWarmUp = w
         & pointerToItem . itUse . useDelay . warmTime +~ 2
         & soundContinue (CrWeaponSound cid 0) (_crPos cr) soundID (Just 2)
@@ -317,16 +317,16 @@ ammoUseCheck f item cr w
     | fireCondition = f item cr w & pointerToItem %~
         ( itUseAmmo 1
         . (itUse . useDelay . rateTime .~ _rateMax ( _useDelay (_itUse item)) ))
-    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
+--    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
     | otherwise = w
   where 
     cid = _crID cr
     itRef = _crInvSel cr
     pointerToItem = creatures . ix cid . crInv . ix itRef
-    fireCondition = _laReloadState (_itConsumption item) == Nothing'
+    fireCondition = _laTransfer (_itConsumption item) == NoTransfer
         && _rateTime (_useDelay (_itUse item)) == 0
         && _laLoaded (_itConsumption item) > 0
-    reloadCondition = _laLoaded (_itConsumption item) == 0
+--    reloadCondition = _laLoaded (_itConsumption item) == 0
 {- | Applies a world effect after a hammer position check.
 Arbitrary inventory position. -}
 hammerCheckL
@@ -353,16 +353,16 @@ shootL f item cr w
     | fireCondition = f item cr w & pointerToItem %~
         ( itUseAmmo 1
         . (itUse . useDelay . rateTime .~ _rateMax (_useDelay (_itUse item))) )
-    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
+--    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
     | otherwise = w
   where 
     cid = _crID cr
     invid = fromJust $ _itInvPos item
     pointerToItem = creatures . ix cid . crInv . ix invid
-    fireCondition = _laReloadState (_itConsumption item) == Nothing'
+    fireCondition = _laTransfer (_itConsumption item) == NoTransfer
         && _rateTime (_useDelay (_itUse item)) == 0
         && _laLoaded (_itConsumption item) > 0
-    reloadCondition = _laLoaded (_itConsumption item) == 0
+--    reloadCondition = _laLoaded (_itConsumption item) == 0
 withItem :: (Item -> ChainEffect) -> ChainEffect
 withItem g f it = g it f it
 withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect

src/Dodge/Reloading.hs

@@ -1,6 +1,6 @@
 module Dodge.Reloading 
     ( stepReloading
-    , startReloadingWeapon
+    , tryStartReloading
     , crStopReloading
     ) where
 import Dodge.Data
@@ -9,49 +9,57 @@ import Dodge.Base.Arithmetic
 
 import Control.Lens
 
-startReloadingWeapon :: Creature -> World -> Maybe World
+tryStartReloading :: Creature -> World -> Maybe World
-startReloadingWeapon cr = creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) %%~
+tryStartReloading cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of
-    icTryStartReloading
+    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
 
--- TODO clean this up, rethink datatypes
+
-icTryStartReloading :: Item -> Maybe Item
+---- TODO clean this up, rethink datatypes
-icTryStartReloading it = do
+--icTryStartReloading :: Item -> Maybe Item
-    am          <- it ^? itConsumption
+--icTryStartReloading it = do
-    amloaded    <- am ^? laLoaded
+--    am          <- it ^? itConsumption
-    ammax       <- am ^? laMax
+--    amloaded    <- am ^? laLoaded
-    rstate      <- am ^? laReloadState
+--    ammax       <- am ^? laMax
-    if amloaded < ammax && rstate == Nothing'
+--    rstate      <- am ^? laReloadState
-        then Just $ it 
+--    if amloaded < ammax && rstate == Nothing'
-                & itConsumption . laReloadState .~ Just' (_laReloadTime am)
+--        then Just $ it 
-                & if _laReloadType am == ActiveClear 
+--                & itConsumption . laReloadState .~ Just' (_laReloadTime am)
-                    then itConsumption . laLoaded .~ 0 
+--                & if _laReloadType am == ActiveClear 
-                    else id
+--                    then itConsumption . laLoaded .~ 0 
-        else Nothing
+--                    else id
+--        else Nothing
 
 crStopReloading :: Creature -> Creature
-crStopReloading cr = cr & crInv . ix (_crInvSel cr) . itConsumption . laReloadState .~ Nothing'
+crStopReloading cr = cr & crStance . posture .~ AtEase
 
 -- ugly TODO cleanup
 stepReloading :: Creature -> Creature
-stepReloading cr = case cr ^? crInv . ix isel . itConsumption . laReloadState . _Just' of
+stepReloading cr = case cr ^? crInv . ix isel . itConsumption . laTransfer of
-    Just 0 -> cr & crInv . ix isel %~ loadItem
+    Just (Transfer x 0) -> cr 
-    Just _ -> cr & crInv . ix isel . itConsumption . laReloadState . _Just' %~ decreaseToZero
+        & crInv . ix isel %~ loadItem x
-    Nothing -> cr
+        & crStance . posture .~ AtEase
+    Just Transfer {} -> cr 
+        & crInv . ix isel . itConsumption . laTransfer . transferTime %~ decreaseToZero
+    _ -> cr
   where 
     isel = _crInvSel cr 
 
-loadItem :: Item -> Item
+loadItem :: Int -> Item -> Item
-loadItem it = case _laReloadType itcon of
+loadItem x = itConsumption %~ (set laTransfer NoTransfer . (laLoaded +~ x))
-    ActivePartial x 
-        | x + _laLoaded itcon < itMaxAmmo -> it & itConsumption . laLoaded %~ (+ x)
-            & itConsumption . laReloadState .~ Just' (_laReloadTime itcon)
-        | otherwise -> it & itConsumption . laLoaded .~ itMaxAmmo
-            & itConsumption . laReloadState .~ Nothing'
-    _ -> it & itConsumption . laLoaded .~ itMaxAmmo
-        & itConsumption . laReloadState .~ Nothing'
-  where
-    itcon = _itConsumption it
-    itMaxAmmo = _laMax itcon
 
 --{- | Start reloading if clip is empty. -}
 --crAutoReload :: Creature -> Creature