Files
loop/src/Dodge/Reloading.hs
T

100 lines
4.2 KiB
Haskell

module Dodge.Reloading (
crCancelReloading,
crReload,
stepReloading,
) where
import Control.Lens
import Data.Maybe
import Dodge.Data.Creature
crCancelReloading :: Creature -> Creature
crCancelReloading cr =
cr
& updateProgress
& crManipulation . manObject . inInventory . iselAction .~ NoInvSelAction
where
updateProgress = fromMaybe id $ do
InInventory (SelItem i _) <- cr ^? crManipulation . manObject
return $
crInv . ix (i + 1) . itUse . attachParams . ammoLoadStatus . iaProgress
%~ const Nothing
stepReloading :: Creature -> Creature
stepReloading cr = case cr ^? crManipulation . manObject . inInventory of
Just (SelItem i (ReloadAction x la))
| x > 0 ->
cr & crManipulation . manObject . inInventory . iselAction . actionProgress -~ 1
| otherwise ->
cr
& crInv . ix (i + 1) . itUse . attachParams . ammoLoadStatus %~ doLoadAction la
& crInv . ix (i + 1) . itUse . attachParams . ammoLoadStatus %~ rotateActionProgress
& tryNextLoadAction
_ -> cr
tryNextLoadAction :: Creature -> Creature
tryNextLoadAction cr = case cr ^? crManipulation . manObject . inInventory of
Just (SelItem i _) -> case cr ^? crInv . ix (i + 1) . itUse . attachParams . ammoLoadStatus . iaProgress . _Just . ix 0 of
Nothing -> cr & crManipulation . manObject . inInventory . iselAction .~ NoInvSelAction
Just la ->
cr & crManipulation . manObject . inInventory . iselAction . actionProgress .~ _actionTime la
& crManipulation . manObject . inInventory . iselAction . reloadAction .~ la
_ -> cr
crReload :: Creature -> Creature
crReload cr = case cr ^? crManipulation . manObject . inInventory . iselAction of
Just NoInvSelAction -> cr & tryStartLoading
_ -> cr & crManipulation . manObject . inInventory . iselAction .~ NoInvSelAction
tryStartLoading :: Creature -> Creature
tryStartLoading cr = fromMaybe cr $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
ia <- cr ^? crInv . ix (i + 1) . itUse . attachParams . ammoLoadStatus
return $ startLoading ia cr
-- case as of
-- InternalSource ia -> return $ startLoading ia cr
-- AboveSource -> return cr
startLoading :: InternalAmmo -> Creature -> Creature
startLoading ic cr = case ic ^? iaProgress . _Just . ix 0 of
Just la -> cr & startLoadingStep la
Nothing -> case ic ^. iaCycle of
[] -> error "item has empty load cycle"
_ | _iaLoaded ic >= _iaMax ic -> cr
(la : las) -> fromMaybe (error "item loading error") $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
return $
cr & startLoadingStep la
& crInv . ix i . itUse . attachParams . ammoLoadStatus . iaProgress ?~ (la : las)
startLoadingStep :: LoadAction -> Creature -> Creature
startLoadingStep la cr = cr & crManipulation . manObject . inInventory . iselAction .~ ReloadAction (_actionTime la) la
rotateActionProgress :: InternalAmmo -> InternalAmmo
rotateActionProgress ic = case ic ^. iaProgress of
Just (_ : la : las) -> ic & iaProgress . _Just .~ (la : las)
_ | _iaLoaded ic < _iaMax ic -> ic & iaProgress ?~ _iaCycle ic
_ -> ic & iaProgress .~ Nothing
doLoadAction :: LoadAction -> InternalAmmo -> InternalAmmo
doLoadAction la ic = case la of
LoadEject{} -> ic & iaLoaded .~ 0 & iaPrimed .~ False
LoadInsert{} -> ic & iaLoaded .~ _iaMax ic
LoadAdd{_insertMax = x} ->
ic & iaLoaded +~ min x (_iaMax ic - _iaLoaded ic)
LoadPrime{} -> ic & iaPrimed .~ 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)