Remove most instances of LDTs from item use

This commit is contained in:
2025-07-11 00:45:51 +01:00
parent e5eff32ce3
commit 05ff4651bd
3 changed files with 63 additions and 65 deletions
+2 -2
View File
@@ -12,8 +12,8 @@ import Control.Lens
import Dodge.Data.Item
import Dodge.Data.TriggerType
itemTriggerType :: LocationLDT ItemLink OItem -> TriggerType
itemTriggerType loc = baseItemTriggerType $ loc ^. locLDT . ldtValue . _1
itemTriggerType :: LocationDT OItem -> TriggerType
itemTriggerType loc = baseItemTriggerType $ loc ^. locDT . dtValue . _1
baseItemTriggerType :: Item -> TriggerType
baseItemTriggerType itm = case itm ^. itType of
+59 -62
View File
@@ -48,7 +48,7 @@ gadgetEffect pt loc
| UseHeld{} <- loc ^. locLDT . ldtValue . _1 . itUse =
heldEffect
pt
loc
(locLDTToLocDT loc)
| DROPPER x <- loc ^. locLDT . ldtValue . _1 . itType
, Just i <- loc ^? locLDT . ldtValue . _1 . itUse . uInt
, pt == InitialPress =
@@ -58,19 +58,19 @@ gadgetEffect pt loc
useInventoryPath pt i x loc
| otherwise = const id
heldEffect :: PressType -> LocationLDT ItemLink OItem -> Creature -> World -> World
heldEffect :: PressType -> LocationDT OItem -> Creature -> World -> World
heldEffect = hammerCheck heldEffectMuzzles
hammerCheck ::
(LocationLDT ItemLink OItem -> Creature -> World -> World) ->
(LocationDT OItem -> Creature -> World -> World) ->
PressType ->
LocationLDT ItemLink OItem ->
LocationDT OItem ->
Creature ->
World ->
World
hammerCheck f pt loc cr w = case itemTriggerType loc of
WarmUpNoDelay wm
| _wTime (_itParams $ _ldtValue $ fmap (^. _1) tree) < wm ->
| _wTime (_itParams $ it) < wm ->
w & setwarming
& soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ it ^. itType) (Just 2)
& cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1
@@ -108,8 +108,8 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
NoTrigger -> f loc cr w
_ -> w
where
tree = loc ^. locLDT
it = loc ^. locLDT . ldtValue . _1
tree = loc ^. locDT
it = loc ^. locDT . dtValue . _1
cid = _crID cr
-- the following is unsafe, but if ilInvID isn't correctly set we probably
-- will have problems elsewhere also
@@ -125,19 +125,19 @@ getVolleyBurst i g =
let (is, g') = runState (replicateM (i -1) (state $ randomR (0, 6))) g
in (scanl1 (+) is, g')
heldEffectMuzzles :: LocationLDT ItemLink OItem -> Creature -> World -> World
heldEffectMuzzles :: LocationDT OItem -> Creature -> World -> World
heldEffectMuzzles loc cr w =
setusetime . doHeldUseEffect t cr
. uncurry (applyCME loc cr)
. foldl' (useLoadedAmmo (locLDTToLocDT loc) cr) (False, w)
. foldl' (useLoadedAmmo loc cr) (False, w)
$ loadedmuzzles
where
t = loc ^. locLDT
(_, loadedmuzzles) = mapAccumR loadMuzzle t . itemMuzzles $ t ^. ldtValue . _1
t = loc ^. locDT
(_, loadedmuzzles) = mapAccumR loadMuzzle t . itemMuzzles $ t ^. dtValue . _1
setusetime =
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itTimeLastUsed
.~ w ^. cWorld . lWorld . lClock
itid = t ^?! ldtValue . _1 . itLocation . ilInvID
itid = t ^?! dtValue . _1 . itLocation . ilInvID
itemMuzzles :: Item -> [Muzzle]
itemMuzzles itm = case itm ^. itType of
@@ -323,8 +323,8 @@ vgunMuzzles i =
<*> pure 0
)
doHeldUseEffect :: LDTree ItemLink OItem -> Creature -> World -> World
doHeldUseEffect t cr w = case t ^. ldtValue . _1 . itType of
doHeldUseEffect :: DTree OItem -> Creature -> World -> World
doHeldUseEffect t cr 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
@@ -346,7 +346,7 @@ doHeldUseEffect t cr w = case t ^. ldtValue . _1 . itType of
%~ tail
_ -> w
HELD ALTERIFLE -> fromMaybe w $ do
i <- t ^? ldtValue . _1 . itLocation . ilInvID
i <- t ^? dtValue . _1 . itLocation . ilInvID
return $
w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i
@@ -359,7 +359,7 @@ doHeldUseEffect t cr w = case t ^. ldtValue . _1 . itType of
%~ ((`mod` 2) . (+ 1))
_ -> w
where
itm = t ^. ldtValue . _1
itm = t ^. dtValue . _1
--doHeldUseEffect t cr w = case t ^? ldtValue . itUse . heldUseEffect of
-- Just (RandomiseMuzzleFrames x) -> fromMaybe w $ do
@@ -394,7 +394,7 @@ doHeldUseEffect t cr w = case t ^. ldtValue . _1 . itType of
-- & ldtValue . itUse . heldFrame .~ x
-- should probably unify failure with time use check in some way...
applyCME :: LocationLDT ItemLink OItem -> Creature -> Bool -> World -> World
applyCME :: LocationDT OItem -> Creature -> Bool -> World -> World
applyCME loc cr cme
| cme =
applyInvLock itm cr
@@ -409,7 +409,7 @@ applyCME loc cr cme
-- the above is quite hacky for now
_ -> failsound
where
itm = loc ^. locLDT . ldtValue . _1
itm = loc ^. locDT . dtValue . _1
coolstart = fromMaybe 0 $ baseItemTriggerType itm ^? coolStart
itid = itm ^?! itLocation . ilInvID -- unsafe
spush = maybe 0 itemSidePush $ itm ^? itType . ibtHeld
@@ -493,13 +493,13 @@ applySoundCME itm cr = fromMaybe id $ do
where
cid = _crID cr
applyRecoil :: LocationLDT ItemLink OItem -> Creature -> World -> World
applyRecoil :: LocationDT OItem -> Creature -> World -> World
applyRecoil loc cr =
cWorld . lWorld . creatures . ix (_crID cr) . crPos
+~ rotateV (_crDir cr + Q.qToAng q) (V2 ((- recoilAmount itm) / crMass (_crType cr)) 0)
where
itm = loc ^. locLDT . ldtValue . _1
(_, q) = locOrient (locLDTToLocDT loc) cr
itm = loc ^. locDT . dtValue . _1
(_, q) = locOrient loc cr
recoilAmount :: Item -> Float
recoilAmount itm
@@ -666,17 +666,15 @@ heldTorqueAmount = \case
BLINKER -> 0
BLINKERUNSAFE -> 0
-- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
loadMuzzle ::
LDTree ItemLink OItem ->
DTree OItem ->
Muzzle ->
(LDTree ItemLink OItem, Maybe (Muzzle, Int, LDTree ItemLink OItem))
loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
-- guard $ mz ^? mzFrame == t ^? ldtValue . itUse . heldFrame
(DTree OItem, Maybe (Muzzle, Int, DTree OItem))
loadMuzzle t@(DT _ l _) mz = fromMaybe (t, Nothing) $ do
let as = _mzAmmoSlot mz
amamount = _mzAmmoPerShot mz
(i, (_, mag)) <- findWithIx (isAmmoIntLink as . (^. _2 . ldtValue . _2)) l
availableammo <- mag ^. ldtValue . _1 . itConsumables
(i, ( mag)) <- findWithIx (isAmmoIntLink as . (^. dtValue . _2)) l
availableammo <- mag ^. dtValue . _1 . itConsumables
let usedammo = case amamount of
UseUpTo x -> min x availableammo
UseExactly x
@@ -684,8 +682,8 @@ loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
| otherwise -> 0
guard $ usedammo > 0
return
( t & ldtLeft . ix i . _2 . ldtValue . _1 . itConsumables . _Just -~ usedammo
, Just (mz, usedammo, mag)
( t & dtLeft . ix i . dtValue . _1 . itConsumables . _Just -~ usedammo
, Just (mz, usedammo, (mag))
)
makeMuzzleFlare :: Muzzle -> LocationDT OItem -> Creature -> World -> World
@@ -762,12 +760,12 @@ useLoadedAmmo ::
LocationDT OItem ->
Creature ->
(Bool, World) ->
Maybe (Muzzle, Int, LDTree ItemLink OItem) ->
Maybe (Muzzle, Int, DTree OItem) ->
(Bool, World)
useLoadedAmmo _ _ (cme, w) Nothing = (cme, w)
useLoadedAmmo loc cr (_, w) (Just (mz, x, magtree)) = (,) True $
removeAmmoFromMag x mid cr . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
MuzzleShootBullet -> shootBullets loc cr (mz, x, (ldtToDT magtree)) w
MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
MuzzleLaser -> creatureShootLaser loc cr mz w
MuzzleTesla -> shootTeslaArc loc cr mz w
MuzzleTractor -> shootTractorBeam cr w
@@ -797,7 +795,7 @@ useLoadedAmmo loc cr (_, w) (Just (mz, x, magtree)) = (,) True $
MuzzleScroller -> useTimeScrollGun itm cr w
where
itmtree = loc ^. locDT
mid = magtree ^? ldtValue . _1 . itLocation . ilInvID
mid = magtree ^? dtValue . _1 . itLocation . ilInvID
itm = itmtree ^. dtValue . _1
getAttachedSFLink ::
@@ -1237,30 +1235,29 @@ shootTeslaArc loc cr mz w =
0 -> 0
i -> fst . randomR (- i, i) $ _randGen w
determineProjectileTracking :: LDTree ItemLink OItem
-> DTree OItem -> RocketHoming
determineProjectileTracking :: DTree OItem -> DTree OItem -> RocketHoming
determineProjectileTracking magtree itmtree =
fromMaybe NoHoming $
finddronecontrols <|> findexternaltracking
where
finddronecontrols = do
screen <- find isremscreen (magtree ^. ldtLeft)
_ <- find isjoystick (screen ^. _2 . ldtLeft)
return $ HomeUsingRemoteScreen (screen ^. _2 . ldtValue . _1 . itID)
screen <- find isremscreen (magtree ^. dtLeft)
_ <- find isjoystick (screen ^. dtLeft)
return $ HomeUsingRemoteScreen (screen ^. dtValue . _1 . itID)
findexternaltracking = do
_ <- find isammotargeting (magtree ^. ldtLeft)
_ <- find isammotargeting (magtree ^. dtLeft)
targetingtree <- find isweapontargeting (itmtree ^. dtRight)
return $ HomeUsingTargeting (targetingtree ^. dtValue . _1 . itID)
isremscreen :: (ItemLink,LDTree ItemLink OItem) -> Bool
isremscreen x = case x ^. _2 . ldtValue . _2 of
isremscreen :: (DTree OItem) -> Bool
isremscreen x = case x ^. dtValue . _2 of
RemoteScreenSF {} -> True
_ -> False
isjoystick :: (ItemLink,LDTree ItemLink OItem) -> Bool
isjoystick x = case x ^. _2 . ldtValue . _2 of
isjoystick :: (DTree OItem) -> Bool
isjoystick x = case x ^. dtValue . _2 of
JoystickSF {} -> True
_ -> False
isammotargeting :: (ItemLink,LDTree ItemLink OItem) -> Bool
isammotargeting x = case x ^. _2 . ldtValue . _2 of
isammotargeting :: (DTree OItem) -> Bool
isammotargeting x = case x ^. dtValue . _2 of
AmmoTargetingSF {} -> True
_ -> False
isweapontargeting :: (DTree OItem) -> Bool
@@ -1270,7 +1267,7 @@ determineProjectileTracking magtree itmtree =
createProjectileR ::
LocationDT OItem ->
LDTree ItemLink OItem ->
DTree OItem ->
Muzzle ->
Creature ->
World ->
@@ -1287,10 +1284,10 @@ createProjectileR loc magtree =
where
itmtree = loc ^. locDT
smoke
| isJust $ find issmokereducer (magtree ^. ldtLeft) = Just ReducedRocketSmoke
| isJust $ find issmokereducer (magtree ^. dtLeft) = Just ReducedRocketSmoke
| otherwise = Nothing
issmokereducer :: (ItemLink,LDTree ItemLink OItem) -> Bool
issmokereducer y = case y ^. _2 . ldtValue . _2 of
issmokereducer :: (DTree OItem) -> Bool
issmokereducer y = case y ^. dtValue . _2 of
SmokeReducerSF {} -> True
_ -> False
@@ -1322,39 +1319,39 @@ getGrenadeHitEffect t = case find isghiteff (t ^. dtRight) of
createProjectile ::
(Point3, Q.Quaternion Float) ->
ProjectileType ->
LDTree ItemLink OItem ->
DTree OItem ->
Maybe PJStabiliser ->
Muzzle ->
Creature ->
World ->
World
createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do
magid <- magtree ^? ldtValue . _1 . itLocation . ilInvID
magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
ammoitem <- cr ^? crInv . ix magid
let rdetonate =
(^. _2 . ldtValue . _1 . itID)
<$> find isrdet (magtree ^. ldtLeft)
(^. dtValue . _1 . itID)
<$> find isrdet (magtree ^. dtLeft)
rscreen =
(^. _2 . ldtValue . _1 . itID)
<$> find isrscreen (magtree ^. ldtLeft)
(^. dtValue . _1 . itID)
<$> find isrscreen (magtree ^. dtLeft)
aparams <-
((magtree ^? ldtLeft) >>= find isampay >>= (^? _2 . ldtValue . _1 . itType . ibtAttach . shellPayload))
((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 :: (ItemLink,LDTree ItemLink OItem) -> Bool
isrdet y = case y ^. _2 . ldtValue . _2 of
isrdet :: (DTree OItem) -> Bool
isrdet y = case y ^. dtValue . _2 of
RemoteDetonatorSF {} -> True
_ -> False
isrscreen :: (ItemLink,LDTree ItemLink OItem) -> Bool
isrscreen y = case y ^. _2 . ldtValue . _2 of
isrscreen :: (DTree OItem) -> Bool
isrscreen y = case y ^. dtValue . _2 of
RemoteScreenSF {} -> True
_ -> False
isampay :: (ItemLink,LDTree ItemLink OItem) -> Bool
isampay y = case y ^. _2 . ldtValue . _2 of
isampay :: (DTree OItem) -> Bool
isampay y = case y ^. dtValue . _2 of
AmmoPayloadSF {} -> True
_ -> False
+2 -1
View File
@@ -5,6 +5,7 @@ module Dodge.WorldEffect (
lineOutputTerminal,
) where
import Dodge.DoubleTree
import Dodge.Item.Grammar
import Dodge.Creature.Impulse.UseItem
import Dodge.BlBl
@@ -46,7 +47,7 @@ doWdWd we = case we of
cr <- w ^? cWorld . lWorld . creatures . ix cid
--itree <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
loc <- allInvLocs (cr ^. crInv) ^? ix invid . _2
return $ heldEffectMuzzles loc cr w
return $ heldEffectMuzzles (locLDTToLocDT loc) cr w
accessTerminal :: Maybe Int -> World -> World
accessTerminal mtmid w = fromMaybe w $ do