Files
loop/src/Dodge/Reloading.hs
T

96 lines
3.8 KiB
Haskell

module Dodge.Reloading (
crCancelReloading,
crToggleReloading,
stepReloading,
tryStartLoading,
) where
import Dodge.Data.Item.Use.Consumption.LoadAction
import Control.Lens
import Dodge.Data.Creature
import Data.Maybe
crCancelReloading :: Creature -> Creature
crCancelReloading cr =
cr
& updateProgress
& crInvSel . isel . iselAction .~ NoInvSelAction
where
updateProgress = case crSel cr of
SelItem i _ -> crInv . ix i . itUse . heldConsumption . laProgress %~ const Nothing
_ -> id
stepReloading :: Creature -> Creature
stepReloading cr = case cr ^?! crInvSel . isel of
SelItem i (ReloadAction x la)
| x > 0 ->
cr & crInvSel . isel . iselAction . actionProgress -~ 1
| otherwise ->
cr
& crInv . ix i . itUse . heldConsumption %~ doLoadAction la
& crInv . ix i . itUse . heldConsumption %~ rotateActionProgress
& tryNextLoadAction
_ -> cr
tryNextLoadAction :: Creature -> Creature
tryNextLoadAction cr = case cr ^? crInvSel . isel of
Just (SelItem i _) -> case cr ^? crInv . ix i . itUse . heldConsumption . laProgress . _Just . ix 0 of
Nothing -> cr & crInvSel . isel . iselAction .~ NoInvSelAction
Just la ->
cr & crInvSel . isel . iselAction . actionProgress .~ _actionTime la
& crInvSel . isel . iselAction . reloadAction .~ la
_ -> cr
crToggleReloading :: Creature -> Creature
crToggleReloading cr = case cr ^? crInvSel . isel . iselAction of
Just ReloadAction{} -> cr & crInvSel . isel . iselAction .~ NoInvSelAction
_ -> cr & tryStartLoading
tryStartLoading :: Creature -> Creature
tryStartLoading cr = fromMaybe cr $ do
i <- cr ^? crInvSel . isel . ispItem
hc <- cr ^? crInv . ix i . itUse . heldConsumption
return $ startLoading hc cr
startLoading :: HeldConsumption -> Creature -> Creature
startLoading ic cr = case ic ^? laProgress . _Just . ix 0 of
Just la -> cr & startLoadingStep la
Nothing -> case ic ^? laCycle of
Nothing -> cr
Just [] -> error "item has empty load cycle"
Just _ | _laLoaded ic >= _laMax ic -> cr
Just (la : las) -> fromMaybe (error "item loading error") $ do
i <- cr ^? crInvSel . isel . ispItem
return $ cr & startLoadingStep la
& crInv . ix i . itUse . heldConsumption . laProgress ?~ (la : las)
startLoadingStep :: LoadAction -> Creature -> Creature
startLoadingStep la cr = cr & crInvSel . isel . iselAction .~ ReloadAction (_actionTime la) la
rotateActionProgress :: HeldConsumption -> HeldConsumption
rotateActionProgress ic = case ic ^? laProgress . _Just of
Just (_ : la : las) -> ic & laProgress . _Just .~ (la : las)
_ | _laLoaded ic < _laMax ic -> ic & laProgress ?~ _laCycle ic
_ -> ic & laProgress .~ Nothing
doLoadAction :: LoadAction -> HeldConsumption -> HeldConsumption
doLoadAction la ic = case la of
LoadEject{} -> ic & laLoaded .~ 0 & laPrimed .~ False
LoadInsert{} -> ic & laLoaded .~ _laMax ic
LoadAdd{_insertMax = x} ->
ic & laLoaded +~ min x (_laMax ic - _laLoaded ic)
LoadPrime{} -> ic & laPrimed .~ True
--{- | Start reloading if clip is empty. -}
--crAutoReload :: Creature -> Creature
--crAutoReload cr = case cr ^? ptrItConsumption' . ammoLoaded of
-- Just 0 | _posture (_crStance cr) /= Aiming
-- -> cr & ptrItConsumption . reloadState .~ strictify reloadT
-- & ptrItConsumption . ammoLoaded %~ (`fromMaybe` maxA)
-- _ -> cr
-- where
-- ptrItConsumption = crInv . ix (_crInvSel cr) . itConsumption
-- ptrItConsumption' = crInv . ix (_crInvSel cr) . itConsumption
-- reloadT = cr ^? ptrItConsumption' . reloadTime
-- maxA = fmap itMaxAmmo $ cr ^? crInv . ix (_crInvSel cr)