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