diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index a1f3ee7c9..8861ca005 100644 --- a/src/Dodge/Creature/State.hs +++ b/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 | _laReloadState am == Nothing' -> w + ActiveClear | am ^? laTransfer . transferTime == Just 0 -> stopSoundFrom (CrReloadSound cid) 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{} | _laReloadState am == Nothing' -> w + 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 NoConsumption {} -> w diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index a37da9fd0..fa89f5bb3 100644 --- a/src/Dodge/Creature/Test.hs +++ b/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 - Just t -> t > 0 +crIsReloading cr = case cr ^? crStance . posture of + Just Reloading -> True _ -> False crCanSeeCr :: Creature -> (World, Creature) -> Bool diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 82f1a2ca3..e58642502 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 38653e8c1..f5d5fb243 100644 --- a/src/Dodge/Data.hs +++ b/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 - , _laMax :: Int + { _laType :: AmmoType + , _laMax :: Int , _laLoaded :: Int - , _laReloadTime :: Int - , _laReloadState :: Maybe' Int - , _laReloadType :: ReloadType + , _laReloadTime :: Int + , _laTransfer :: TransferState + , _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 diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index cf12b276d..3e11d6d9d 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -15,11 +15,11 @@ import Control.Lens defaultAmmo :: ItemConsumption defaultAmmo = LoadableAmmo - { _laType = GenericAmmo - , _laMax = 15 - , _laLoaded = 0 + { _laType = GenericAmmo + , _laMax = 15 + , _laLoaded = 0 , _laReloadTime = 40 - , _laReloadState = Nothing' + , _laTransfer = NoTransfer , _laReloadType = ActiveClear } diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 9f9e7092c..555546a08 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/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 diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index 66e51c365..e28809885 100644 --- a/src/Dodge/Item/Display.hs +++ b/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 - Nothing' -> show (_laLoaded am) - Just' x -> show x ++ "R" ++ show (_laLoaded am) + Just am@LoadableAmmo{} -> case _laTransfer am of + NoTransfer -> 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 -> "" diff --git a/src/Dodge/Item/Weapon/AmmoParams.hs b/src/Dodge/Item/Weapon/AmmoParams.hs index 61c03a748..dca4514ac 100644 --- a/src/Dodge/Item/Weapon/AmmoParams.hs +++ b/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 - | _laReloadState (_itConsumption it) == Nothing' = _laLoaded (_itConsumption it) - | otherwise = 0 +loadedAmmo = _laLoaded . _itConsumption +-- | _laTransfer (_itConsumption it) == NoTransfer = _laLoaded (_itConsumption it) +-- | otherwise = 0 fractionLoadedAmmo :: Item -> Float fractionLoadedAmmo it = fromIntegral (loadedAmmo it) / fromIntegral (itmaxammo it) diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index a69712bbc..77dd3be7a 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/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 - Just' rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo) - Nothing' -> 1 + | otherwise = case _laTransfer wpammo of + Transfer _ rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo) + NoTransfer -> 1 col = mixColors reloadFrac (1-reloadFrac) blue red diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 8cff05c27..bf53c737f 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/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 - firstFire = _laReloadState (_itConsumption item) == Nothing' && _rateTime (_useDelay (_itUse item)) == 0 + repeatFire = _laTransfer (_itConsumption item) == NoTransfer && _rateTime (_useDelay (_itUse item)) == 1 + 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 diff --git a/src/Dodge/Reloading.hs b/src/Dodge/Reloading.hs index 4cc878c02..67baf0ce2 100644 --- a/src/Dodge/Reloading.hs +++ b/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 -startReloadingWeapon cr = creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) %%~ - icTryStartReloading +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 --- TODO clean this up, rethink datatypes -icTryStartReloading :: Item -> Maybe Item -icTryStartReloading it = do - am <- it ^? itConsumption - amloaded <- am ^? laLoaded - ammax <- am ^? laMax - rstate <- am ^? laReloadState - if amloaded < ammax && rstate == Nothing' - then Just $ it - & itConsumption . laReloadState .~ Just' (_laReloadTime am) - & if _laReloadType am == ActiveClear - then itConsumption . laLoaded .~ 0 - else id - else Nothing + +---- TODO clean this up, rethink datatypes +--icTryStartReloading :: Item -> Maybe Item +--icTryStartReloading it = do +-- am <- it ^? itConsumption +-- amloaded <- am ^? laLoaded +-- ammax <- am ^? laMax +-- rstate <- am ^? laReloadState +-- if amloaded < ammax && rstate == Nothing' +-- then Just $ it +-- & itConsumption . laReloadState .~ Just' (_laReloadTime am) +-- & if _laReloadType am == ActiveClear +-- then itConsumption . laLoaded .~ 0 +-- 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 - Just 0 -> cr & crInv . ix isel %~ loadItem - Just _ -> cr & crInv . ix isel . itConsumption . laReloadState . _Just' %~ decreaseToZero - Nothing -> cr +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 + _ -> cr where isel = _crInvSel cr -loadItem :: Item -> Item -loadItem it = case _laReloadType itcon of - 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 +loadItem :: Int -> Item -> Item +loadItem x = itConsumption %~ (set laTransfer NoTransfer . (laLoaded +~ x)) --{- | Start reloading if clip is empty. -} --crAutoReload :: Creature -> Creature