Major item refactor, still broken

This commit is contained in:
2025-08-24 19:34:09 +01:00
parent 22b4be440a
commit 94f6d5c630
62 changed files with 820 additions and 805 deletions
+53 -60
View File
@@ -1,6 +1,6 @@
{-# LANGUAGE TupleSections #-}
{-# OPTIONS -Wno-incomplete-uni-patterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
module Dodge.HeldUse (
gadgetEffect,
@@ -102,7 +102,7 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
in w & f loc cr
& cWorld . lWorld . delayedEvents .++~ map g is
& randGen .~ gen
HammerTrigger t | timetest t , pt == 0 -> f loc cr w
HammerTrigger t | timetest t, pt == 0 -> f loc cr w
SemiAutoTrigger t
| timetest t
, pt < w ^. cWorld . lWorld . lClock - timelastused ->
@@ -117,7 +117,7 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
-- the following is unsafe, but if ilInvID isn't correctly set we probably
-- will have problems elsewhere also
invid = it ^?! itLocation . ilInvID
itmset = cWorld . lWorld . creatures . ix cid . crInv . ix invid
itmset = cWorld . lWorld . items . ix (it ^. itID . unNInt)
setwarming = itmset . itParams . isWarming %~ const True
timelastused = it ^. itTimeLastUsed
g x = (x, WdWdBurstFireRepetition (_crID cr) invid)
@@ -129,7 +129,7 @@ getVolleyBurst i g =
heldEffectMuzzles :: LocationDT OItem -> Creature -> World -> World
heldEffectMuzzles loc cr w =
setusetime
setusetime
. doHeldUseEffect t cr
. uncurry (applyCME loc cr)
$ bw
@@ -137,9 +137,9 @@ heldEffectMuzzles loc cr w =
t = loc ^. locDT
bw = foldl' (loadMuzzle loc cr) (False, w) (locMuzzles loc)
setusetime =
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itTimeLastUsed
cWorld . lWorld . items . ix itid . itTimeLastUsed
.~ w ^. cWorld . lWorld . lClock
itid = t ^?! dtValue . _1 . itLocation . ilInvID
itid = t ^?! dtValue . _1 . itID . unNInt
locMuzzles :: LocationDT OItem -> [Muzzle]
locMuzzles loc
@@ -196,7 +196,7 @@ heldItemMuzzles = \case
& ix 0 . mzFlareType .~ NoLightFlare
& ix (i `div` 2) . mzFlareType .~ BasicFlare
& ix (i -1) . mzFlareType .~ NoLightFlare
PISTOL -> [Muzzle (V2 10 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
PISTOL -> [Muzzle (V2 10 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
MACHINEPISTOL -> [Muzzle (V2 10 0) 0 0.3 maguse1 MiniGunFlare MuzzleShootBullet 0]
AUTOPISTOL -> [Muzzle (V2 10 0) 0 0 maguse1 BasicFlare MuzzleShootBullet 0]
SMG -> [Muzzle (V2 20 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
@@ -341,26 +341,20 @@ vgunMuzzles i =
)
doHeldUseEffect :: DTree OItem -> Creature -> World -> World
doHeldUseEffect t cr w = case t ^. dtValue . _1 . itType of
doHeldUseEffect t _ w = case t ^. dtValue . _1 . itType of
HELD (VOLLEYGUN j) -> case itm ^? itParams . unfiredBarrels of
Just [_] -> fromMaybe w $ do
let (is, g) = runState (shuffle [0 .. j -1]) $ w ^. randGen
i <- itm ^? itLocation . ilInvID
return $
w
& randGen .~ g
& crinvset . ix i . itParams . unfiredBarrels %~ const is
Just (_ : _ : _) -> fromMaybe w $ do
i <- itm ^? itLocation . ilInvID
return $ w & crinvset . ix i . itParams . unfiredBarrels %~ tail
& crinvset . itParams . unfiredBarrels %~ const is
Just (_ : _ : _) -> w & crinvset . itParams . unfiredBarrels %~ tail
_ -> w
HELD ALTERIFLE -> fromMaybe w $ do
i <- t ^? dtValue . _1 . itLocation . ilInvID
return $
w & crinvset . ix i . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
HELD ALTERIFLE -> w & crinvset . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
_ -> w
where
crinvset = cWorld . lWorld . creatures . ix (_crID cr) . crInv
crinvset = cWorld . lWorld . items . ix (itm ^. itID . unNInt)
itm = t ^. dtValue . _1
-- should probably unify failure with time use check in some way...
@@ -637,8 +631,8 @@ loadMuzzle loc cr (b, w) mz = maybe (b, w) (True,) $ do
find
((== PulseBallSF) . (^. dtValue . _2))
(loc ^. locDT . dtLeft)
mid <- mag ^? dtValue . _1 . itLocation . ilInvID
availableammo <- w ^? cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix mid . itConsumables . _Just
mid <- mag ^? dtValue . _1 . itID . unNInt
availableammo <- w ^? cWorld . lWorld . items . ix mid . itConsumables . _Just
let usedammo = case as ^?! aps of
UseUpTo x -> min x availableammo
UseExactly x
@@ -719,12 +713,12 @@ isAmmoIntLink i sf = Just i == sf ^? amsfLink
useLoadedAmmo ::
LocationDT OItem ->
Creature ->
Muzzle ->
Muzzle ->
Maybe (Int, DTree OItem) ->
World ->
World
useLoadedAmmo loc cr mz m w =
removeAmmoFromMag m cr . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
useLoadedAmmo loc cr mz m w =
removeAmmoFromMag m . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
MuzzleLaser -> creatureShootLaser loc cr mz w
MuzzlePulseLaser -> creatureShootPulseLaser loc cr mz w
@@ -741,7 +735,7 @@ useLoadedAmmo loc cr mz m w =
mz
cr
w
MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm cr w
MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm w
MuzzleShatter -> shootShatter itm cr w
MuzzleDetector ->
itemDetectorEffect
@@ -782,17 +776,15 @@ itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
f CREATUREDETECTOR = OTCreature
f WALLDETECTOR = OTWall
walkNozzle :: Muzzle -> Item -> Creature -> World -> World
walkNozzle mz itm cr w = fromMaybe w $ do
invid <- itm ^? itLocation . ilInvID
return $
w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv
. ix invid
. itParams
. nzAngle
%~ f
& randGen .~ g
walkNozzle :: Muzzle -> Item -> World -> World
walkNozzle mz itm w =
w
& cWorld . lWorld . items
. ix (itm ^. itID . unNInt)
. itParams
. nzAngle
%~ f
& randGen .~ g
where
nz = _mzEffect mz
(walkamount, g) = randomR (- aspeed, aspeed) (_randGen w)
@@ -927,14 +919,12 @@ shootPulseBall p dir w =
i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
--removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
removeAmmoFromMag :: Maybe (Int, DTree OItem) -> Creature -> World -> World
removeAmmoFromMag m cr = fromMaybe id $ do
removeAmmoFromMag :: Maybe (Int, DTree OItem) -> World -> World
removeAmmoFromMag m = fromMaybe id $ do
(x, magtree) <- m
magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
magid <- magtree ^? dtValue . _1 . itID . unNInt
return $
cWorld . lWorld . creatures
. ix (_crID cr)
. crInv
cWorld . lWorld . items
. ix magid
. itConsumables
. _Just
@@ -1139,7 +1129,7 @@ useGasParams mmagid mz loc cr w =
gastype = fromMaybe (error "cannot find gas ammo") $ do
magid <- mmagid
hit <- itm ^? itType . ibtHeld
fueltype <- cr ^? crInv . ix magid >>= magAmmoParams >>= (^? ampCreateGas)
fueltype <- cr ^? crInv . ix magid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= magAmmoParams >>= (^? ampCreateGas)
gasType hit fueltype
(V3 x y _, q) =
locOrient loc cr
@@ -1224,11 +1214,11 @@ mcShootAuto itm mc w
-- | assumes that the item is held
shootTeslaArc :: LocationDT OItem -> Creature -> Muzzle -> World -> World
shootTeslaArc loc cr mz w =
w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itParams .~ ip
w' & cWorld . lWorld . items . ix itid . itParams .~ ip
& soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2)
where
itm = loc ^. locDT . dtValue . _1
invid = itm ^?! itLocation . ilInvID
itid = itm ^. itID . unNInt
(w', ip) = makeTeslaArc (itm ^. itParams) pos dir w
(V3 x y _, q) =
locOrient loc cr
@@ -1328,22 +1318,25 @@ createProjectile ::
Creature ->
World ->
World
createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do
magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
ammoitem <- cr ^? crInv . ix magid
let rdetonate =
(^. dtValue . _1 . itID)
<$> find isrdet (magtree ^. dtLeft)
rscreen =
(^. dtValue . _1 . itID)
<$> find isrscreen (magtree ^. dtLeft)
aparams <-
((magtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
-- <|> ammoitem ^? itConsumables . magParams . ampPayload
<|> magAmmoParams ammoitem ^? _Just . ampPayload
return $
createShell x rdetonate rscreen stab pjtype aparams muz cr
. startthesound
createProjectile x pjtype magtree stab muz cr w =
w
& ( fromMaybe failsound $ do
magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
ammoitem <- cr ^? crInv . ix magid >>= \k -> w ^? cWorld . lWorld . items . ix k
let rdetonate =
(^. dtValue . _1 . itID)
<$> find isrdet (magtree ^. dtLeft)
rscreen =
(^. dtValue . _1 . itID)
<$> find isrscreen (magtree ^. dtLeft)
aparams <-
((magtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
-- <|> ammoitem ^? itConsumables . magParams . ampPayload
<|> magAmmoParams ammoitem ^? _Just . ampPayload
return $
createShell x rdetonate rscreen stab pjtype aparams muz cr
. startthesound
)
where
isrdet :: DTree OItem -> Bool
isrdet y = case y ^. dtValue . _2 of