Fold together useDelay and itemTriggerType

This commit is contained in:
2025-07-03 22:25:32 +01:00
parent 8a00450e3f
commit a207073846
12 changed files with 404 additions and 365 deletions
+95 -73
View File
@@ -4,7 +4,7 @@
module Dodge.HeldUse (
gadgetEffect,
heldEffectNoHammerCheck,
heldEffect,
mcUseHeld,
heldEffectMuzzles,
) where
@@ -23,13 +23,11 @@ import Dodge.Creature.Radius
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Data.Muzzle
import Dodge.Data.UseDelay
import Dodge.Data.World
import Dodge.Gas
import Dodge.Inventory.Lock
import Dodge.Inventory.Path
import Dodge.Item.HeldOffset
import Dodge.Item.UseDelay
import Dodge.Item.Weapon.Bullet
import Dodge.Item.Weapon.Shatter
import Dodge.Projectile.Create
@@ -61,17 +59,8 @@ gadgetEffect pt loc
| otherwise = const id
heldEffect :: PressType -> LDTree ItemLink OItem -> Creature -> World -> World
heldEffect = useTimeCheck . hammerCheck heldEffectMuzzles
heldEffectNoHammerCheck :: LDTree ItemLink OItem -> Creature -> World -> World
heldEffectNoHammerCheck = useTimeCheck heldEffectMuzzles
type ChainEffect =
(LDTree ItemLink OItem -> Creature -> World -> World) ->
LDTree ItemLink OItem ->
Creature ->
World ->
World
heldEffect = hammerCheck heldEffectMuzzles
--heldEffect = useTimeCheck . hammerCheck heldEffectMuzzles
hammerCheck ::
(LDTree ItemLink OItem -> Creature -> World -> World) ->
@@ -80,25 +69,54 @@ hammerCheck ::
Creature ->
World ->
World
hammerCheck f pt it cr w
| BurstTrigger is <- itemTriggerType (it ^. ldtValue . _1)
, pt == InitialPress =
w & f it cr & cWorld . lWorld . delayedEvents .++~ map g is
| BurstTrigger{} <- itemTriggerType (it ^. ldtValue . _1) = w
| VolleyGunTrigger i <- itemTriggerType (it ^. ldtValue . _1)
, pt == InitialPress =
let (is, gen) = getVolleyBurst i (w ^. randGen)
in w & f it cr
& cWorld . lWorld . delayedEvents .++~ map g is
& randGen .~ gen
| VolleyGunTrigger{} <- itemTriggerType (it ^. ldtValue . _1) = w
| t <- itemTriggerType (it ^. ldtValue . _1)
, t == HammerTrigger || t == AlwaysSingleTrigger
hammerCheck f pt it cr w = case itemTriggerType $ it ^. ldtValue . _1 of
WarmUpNoDelay wm
| _wTime (_itParams $ _ldtValue $ fmap (^. _1) it) < wm ->
w & setwarming
& soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ it ^. ldtValue . _1 . itType) (Just 2)
& cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
WarmUpNoDelay{} -> f it cr w & setwarming
WarmUpCoolDown ws _ _
| _wTime (_itParams $ _ldtValue $ fmap (^. _1) it) < ws ->
w & setwarming
& soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ it ^. ldtValue . _1 . itType) (Just 2)
& cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
WarmUpCoolDown _ cs _
| _wTime (_itParams $ _ldtValue $ fmap (^. _1) it) < cs ->
f it cr w & setwarming
& cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
WarmUpCoolDown{} -> w & setwarming
BurstTrigger is t
| w ^. cWorld . lWorld . lClock - t > timelastused
, pt == InitialPress ->
w & f it cr & cWorld . lWorld . delayedEvents .++~ map g is
BurstTrigger{} -> w
VolleyGunTrigger i t
| w ^. cWorld . lWorld . lClock - t > timelastused
, pt == InitialPress ->
let (is, gen) = getVolleyBurst i (w ^. randGen)
in w & f it cr
& cWorld . lWorld . delayedEvents .++~ map g is
& randGen .~ gen
VolleyGunTrigger{} -> w
HammerTrigger t
| w ^. cWorld . lWorld . lClock - t > timelastused
, isNothing $ lookup MakeAutoLink (it ^. ldtRight)
, pt /= InitialPress =
w
| otherwise = f it cr w
, pt == InitialPress ->
f it cr w
AutoTrigger t
| w ^. cWorld . lWorld . lClock - t > timelastused ->
f it cr w
_ -> w
where
cid = _crID cr
-- the following is unsafe, but if ilInvID isn't correctly set we probably
-- will have problems elsewhere also
itRef = it ^?! ldtValue . _1 . itLocation . ilInvID
setwarming =
cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . isWarming
%~ const True
timelastused = it ^. ldtValue . _1 . itTimeLastUsed
g x = (x, WdWdBurstFireRepetition (_crID cr) (it ^?! ldtValue . _1 . itLocation . ilInvID))
getVolleyBurst :: (Random a, RandomGen b, Num a) => Int -> b -> ([a], b)
@@ -109,38 +127,44 @@ getVolleyBurst i g =
{- | Applies a world effect after an item use cooldown check.
input buffering?
-}
useTimeCheck :: ChainEffect
useTimeCheck f item cr w = case useDelay $ item ^. ldtValue . _1 of
FixedRate rate
| w ^. cWorld . lWorld . lClock - rate > lastused -> f item cr w
-- note that the time last used must be updated later in the chain!
FixedRate{} -> w
WarmUpNoDelay wm
| _wTime (_itParams $ _ldtValue $ fmap (^. _1) item) < wm ->
w & setwarming
& soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ item ^. ldtValue . _1 . itType) (Just 2)
& cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
WarmUpNoDelay{} -> f item cr w & setwarming
WarmUpCoolDown ws _ _
| _wTime (_itParams $ _ldtValue $ fmap (^. _1) item) < ws ->
w & setwarming
& soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ item ^. ldtValue . _1 . itType) (Just 2)
& cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
WarmUpCoolDown _ cs _
| _wTime (_itParams $ _ldtValue $ fmap (^. _1) item) < cs ->
f item cr w & setwarming
& cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
WarmUpCoolDown{} -> w & setwarming
NoDelay -> f item cr w
where
lastused = item ^. ldtValue . _1 . itTimeLastUsed
cid = _crID cr
setwarming =
cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . isWarming
%~ const True
-- the following is unsafe, but if ilInvID isn't correctly set we probably
-- will have problems elsewhere also
itRef = item ^?! ldtValue . _1 . itLocation . ilInvID
useTimeCheck ::
(LDTree ItemLink OItem -> Creature -> World -> World) ->
LDTree ItemLink OItem ->
Creature ->
World ->
World
useTimeCheck f item cr w = w
-- case useDelay $ item ^. ldtValue . _1 of
-- FixedRate rate
-- | w ^. cWorld . lWorld . lClock - rate > lastused -> f item cr w
-- -- note that the time last used must be updated later in the chain!
-- FixedRate{} -> w
-- WarmUpNoDelay wm
-- | _wTime (_itParams $ _ldtValue $ fmap (^. _1) item) < wm ->
-- w & setwarming
-- & soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ item ^. ldtValue . _1 . itType) (Just 2)
-- & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
-- WarmUpNoDelay{} -> f item cr w & setwarming
-- WarmUpCoolDown ws _ _
-- | _wTime (_itParams $ _ldtValue $ fmap (^. _1) item) < ws ->
-- w & setwarming
-- & soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ item ^. ldtValue . _1 . itType) (Just 2)
-- & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
-- WarmUpCoolDown _ cs _
-- | _wTime (_itParams $ _ldtValue $ fmap (^. _1) item) < cs ->
-- f item cr w & setwarming
-- & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
-- WarmUpCoolDown{} -> w & setwarming
-- NoDelay -> f item cr w
-- where
-- lastused = item ^. ldtValue . _1 . itTimeLastUsed
-- cid = _crID cr
-- setwarming =
-- cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . isWarming
-- %~ const True
-- -- the following is unsafe, but if ilInvID isn't correctly set we probably
-- -- will have problems elsewhere also
-- itRef = item ^?! ldtValue . _1 . itLocation . ilInvID
heldEffectMuzzles :: LDTree ItemLink OItem -> Creature -> World -> World
heldEffectMuzzles t cr w =
@@ -422,7 +446,7 @@ applyCME itm cr cme
-- the above is quite hacky for now
_ -> failsound
where
coolstart = fromMaybe 0 $ useDelay itm ^? coolStart
coolstart = fromMaybe 0 $ itemTriggerType itm ^? coolStart
itid = itm ^?! itLocation . ilInvID -- unsafe
spush = maybe 0 itemSidePush $ itm ^? itType . ibtHeld
failsound w = case w ^? input . mouseButtons . ix SDL.ButtonLeft of
@@ -775,7 +799,7 @@ useLoadedAmmo ::
useLoadedAmmo _ _ (cme, w) Nothing = (cme, w)
useLoadedAmmo itmtree cr (_, w) (Just (mz, x, magtree)) = (,) True $
removeAmmoFromMag x mid cr . makeMuzzleFlare mz itmtree cr $ case _mzEffect mz of
MuzzleShootBullet -> shootBullet itmtree cr (mz, x, magtree) w
MuzzleShootBullet -> shootBullets itmtree cr (mz, x, magtree) w
MuzzleLaser -> creatureShootLaser itmtree cr mz w
MuzzleTesla -> shootTeslaArc itm cr mz w
MuzzleTractor -> shootTractorBeam cr w
@@ -980,18 +1004,18 @@ magAmmoParams itm = case itm ^. itType of
-- Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
-- _ -> 0
shootBullet ::
shootBullets ::
LDTree ItemLink OItem ->
Creature ->
(Muzzle, Int, LDTree ItemLink OItem) ->
World ->
World
shootBullet itmtree cr (mz, x, magtree) w = fromMaybe w $ do
shootBullets itmtree cr (mz, x, magtree) w = fromMaybe w $ do
thebullet <- getBulletType $ fmap (^. _1) magtree
return $ foldl' (&) w (replicate x (makeBullet' thebullet (itmtree ^. ldtValue . _1) cr mz))
return $ foldl' (&) w (replicate x (shootBullet thebullet (itmtree ^. ldtValue . _1) cr mz))
makeBullet' :: Bullet -> Item -> Creature -> Muzzle -> World -> World
makeBullet' bu itm cr mz w = makeBullet bu itm bulpos dir . (randGen .~ g) $ w
shootBullet :: Bullet -> Item -> Creature -> Muzzle -> World -> World
shootBullet bu itm cr mz w = makeBullet bu itm bulpos dir . (randGen .~ g) $ w
where
bulpos = _crPos cr + rotateV (_crDir cr) moff
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz)
@@ -1002,8 +1026,6 @@ makeBullet' bu itm cr mz w = makeBullet bu itm bulpos dir . (randGen .~ g) $ w
Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
_ -> 0
-- & makeMuzzleSmoke mz itm cr
itemRandomOffset :: HeldItemType -> Float
itemRandomOffset = \case
BANGSTICK{} -> 0
@@ -1238,7 +1260,7 @@ mcShootLaser _ mc =
mcShootAuto :: Item -> Machine -> World -> World
mcShootAuto itm mc w
| Just (FixedRate rate) <- useDelay <$> mc ^? mcType . mctTurret . tuWeapon -- . itUse . heldDelay
| Just (AutoTrigger rate) <- itemTriggerType <$> mc ^? mcType . mctTurret . tuWeapon -- . itUse . heldDelay
, w ^. cWorld . lWorld . lClock - rate > lastused =
w
& cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon