Continue removal of LDTs

This commit is contained in:
2025-07-11 00:24:38 +01:00
parent 8597f2bcc0
commit e5eff32ce3
2 changed files with 93 additions and 106 deletions
+62 -74
View File
@@ -129,7 +129,7 @@ heldEffectMuzzles :: LocationLDT ItemLink OItem -> Creature -> World -> World
heldEffectMuzzles loc cr w =
setusetime . doHeldUseEffect t cr
. uncurry (applyCME loc cr)
. foldl' (useLoadedAmmo loc cr) (False, w)
. foldl' (useLoadedAmmo (locLDTToLocDT loc) cr) (False, w)
$ loadedmuzzles
where
t = loc ^. locLDT
@@ -759,52 +759,55 @@ isAmmoIntLink i (AmmoMagSF j _) = i == j
isAmmoIntLink _ _ = False
useLoadedAmmo ::
LocationLDT ItemLink OItem ->
LocationDT OItem ->
Creature ->
(Bool, World) ->
Maybe (Muzzle, Int, LDTree ItemLink OItem) ->
(Bool, World)
useLoadedAmmo _ _ (cme, w) Nothing = (cme, w)
useLoadedAmmo loc cr (_, w) (Just (mz, x, magtree)) = (,) True $
removeAmmoFromMag x mid cr . makeMuzzleFlare mz (locLDTToLocDT loc) cr $ case _mzEffect mz of
MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
MuzzleLaser -> creatureShootLaser (locLDTToLocDT loc) cr mz w
removeAmmoFromMag x mid cr . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
MuzzleShootBullet -> shootBullets loc cr (mz, x, (ldtToDT magtree)) w
MuzzleLaser -> creatureShootLaser loc cr mz w
MuzzleTesla -> shootTeslaArc loc cr mz w
MuzzleTractor -> shootTractorBeam cr w
MuzzleRLauncher -> createProjectileR loc magtree mz cr w
MuzzleGLauncher ->
createProjectile
(itmtree ^. ldtValue . _3)
(itmtree ^. dtValue . _3)
(Grenade (getGrenadeHitEffect $ itmtree))
magtree
(getPJStabiliser $ itmtree)
mz
cr
w
MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz (itm ^. _1) cr w
MuzzleShatter -> shootShatter (itm ^. _1) cr w
MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm cr w
MuzzleShatter -> shootShatter itm cr w
MuzzleDetector ->
itemDetectorEffect
(itm ^. _1)
(getAttachedSFLink MapperSF $ fmap (^. _1) itmtree)
(getAttachedSFLink ARHUDSF $ fmap (^. _1) itmtree)
itm
(getAttachedSFLink MapperSF itmtree)
(getAttachedSFLink ARHUDSF itmtree)
cr
w
MuzzleBlink -> unsafeBlinkAction cr w
MuzzleUnsafeBlink -> blinkActionMousePos cr w
MuzzleRewind -> useRewindGun (itm ^. _1 . itID) w
MuzzleStopper -> useStopWatch (itm ^. _1) cr w
MuzzleScroller -> useTimeScrollGun (itm ^. _1) cr w
MuzzleRewind -> useRewindGun (itm ^. itID) w
MuzzleStopper -> useStopWatch itm cr w
MuzzleScroller -> useTimeScrollGun itm cr w
where
itmtree = loc ^. locLDT
itmtree = loc ^. locDT
mid = magtree ^? ldtValue . _1 . itLocation . ilInvID
itm = itmtree ^. ldtValue
itm = itmtree ^. dtValue . _1
getAttachedSFLink ::
ItemStructuralFunction ->
LDTree ItemLink Item ->
DTree OItem ->
Maybe (NewInt ItmInt)
getAttachedSFLink sf = (^? ldtRight . folding (lookup (SFLink sf)) . ldtValue . itID)
getAttachedSFLink sf = (^? dtRight . folding (find f) . dtValue . _1 . itID)
where
f :: DTree OItem -> Bool
f x = x ^. dtValue . _2 == sf
itemDetectorEffect ::
Item ->
@@ -925,33 +928,24 @@ removeAmmoFromMag x mid cr = fromMaybe id $ do
. _Just
-~ x
getBulletType :: LDTree ItemLink OItem -> Maybe Bullet
getBulletType :: DTree OItem -> Maybe Bullet
getBulletType magtree =
--magtree ^? ldtValue . itConsumables . magParams . ampBullet
-- (magAmmoParams (magtree ^. ldtValue . _1) ^? _Just . ampBullet)
(magtree ^? ldtValue . _1 . to magAmmoParams . _Just . ampBullet)
-- <&> buTrajectory .~ btraj
(magtree ^? dtValue . _1 . to magAmmoParams . _Just . ampBullet)
<&> buPayload .~ bpayload
<&> buEffect .~ beffect
where
-- btraj = fromMaybe BasicBulletTrajectory $ do
-- targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these?
-- tp <- targetingtree ^? ldtValue . itTargeting . itTgPos . _Just
-- attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft)
-- bt <- attree ^? ldtValue . itUse . ubMod . bmTrajectory
-- return $ getBulletTrajectory mz (itmtree ^. ldtValue) bt tp cr w
bpayload = fromMaybe (BulPlain 100) $ do
attree <- find ispayload (magtree ^. ldtLeft)
attree ^? _2 . ldtValue . _1 . itUse . ubMod . bmPayload
ispayload :: (ItemLink,LDTree ItemLink OItem) -> Bool
ispayload y = case y ^. _2 . ldtValue . _2 of
attree <- find ispayload (magtree ^. dtLeft)
attree ^? dtValue . _1 . itUse . ubMod . bmPayload
ispayload :: (DTree OItem) -> Bool
ispayload y = case y ^. dtValue . _2 of
AmmoPayloadSF {} -> True
_ -> False
beffect = fromMaybe DestroyBullet $ do
attree <- find isammoeffect (magtree ^. ldtLeft)
attree ^? _2 . ldtValue . _1 . itUse . ubMod . bmEffect
isammoeffect :: (ItemLink,LDTree ItemLink OItem) -> Bool
isammoeffect y = case y ^. _2 . ldtValue . _2 of
attree <- find isammoeffect (magtree ^. dtLeft)
attree ^? dtValue . _1 . itUse . ubMod . bmEffect
isammoeffect :: (DTree OItem) -> Bool
isammoeffect y = case y ^. dtValue . _2 of
AmmoEffectSF {} -> True
_ -> False
@@ -988,22 +982,22 @@ magAmmoParams itm = case itm ^. itType of
-- _ -> 0
shootBullets ::
LocationLDT ItemLink OItem ->
LocationDT OItem ->
Creature ->
(Muzzle, Int, LDTree ItemLink OItem) ->
(Muzzle, Int, DTree OItem) ->
World ->
World
shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do
thebullet <- getBulletType $ magtree
return $ foldl' (&) w (replicate x (shootBullet thebullet loc cr mz))
shootBullet :: Bullet -> LocationLDT ItemLink OItem -> Creature -> Muzzle -> World -> World
shootBullet :: Bullet -> LocationDT OItem -> Creature -> Muzzle -> World -> World
shootBullet bu loc cr mz w = makeBullet bu itm bulpos dir . (randGen .~ g) $ w
where
(V3 x y _, q) =
locOrient (locLDTToLocDT loc) cr
locOrient loc cr
`Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
itm = loc ^. locLDT . ldtValue . _1
itm = loc ^. locDT . dtValue . _1
bulpos = _crPos cr + rotateV (_crDir cr) (V2 x y)
(a, g) = randomR (- inacc, inacc) $ _randGen w
dir = _crDir cr + Q.qToAng q + a
@@ -1124,19 +1118,13 @@ mcUseHeld hit = case hit of
LASER -> mcShootLaser
_ -> mcShootAuto
useGasParams ::
Maybe Int ->
Muzzle ->
LocationLDT ItemLink OItem ->
Creature ->
World ->
World
useGasParams :: Maybe Int -> Muzzle -> LocationDT OItem -> Creature -> World -> World
useGasParams mmagid mz loc cr w =
w
& createGas gastype pressure pos dir cr
& randGen .~ g'
where
itm = loc ^. locLDT . ldtValue . _1
itm = loc ^. locDT . dtValue . _1
(pressure, g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
gastype = fromMaybe (error "cannot find gas ammo") $ do
magid <- mmagid
@@ -1144,7 +1132,7 @@ useGasParams mmagid mz loc cr w =
fueltype <- cr ^? crInv . ix magid >>= magAmmoParams >>= (^? ampCreateGas)
gasType hit fueltype
(V3 x y _, q) =
locOrient (locLDTToLocDT loc) cr
locOrient loc cr
`Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
-- (moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
pos = _crPos cr + rotateV (_crDir cr) (V2 x y)
@@ -1230,18 +1218,18 @@ mcShootAuto itm mc w
dir = mc ^?! mcType . _McTurret . tuDir
-- | assumes that the item is held
shootTeslaArc :: LocationLDT ItemLink OItem -> Creature -> Muzzle -> World -> World
shootTeslaArc :: LocationDT OItem -> Creature -> Muzzle -> World -> World
shootTeslaArc loc cr mz w =
w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itParams .~ ip
& soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2)
where
-- use items item location instead
-- itRef = cr ^?! crManipulation . manObject . imRootSelectedItem -- unsafe!! TODO change
itm = loc ^. locLDT . ldtValue . _1
itm = loc ^. locDT . dtValue . _1
invid = itm ^?! itLocation . ilInvID
(w', ip) = makeTeslaArc (itm ^. itParams) pos dir w
(V3 x y _, q) =
locOrient (locLDTToLocDT loc) cr
locOrient loc cr
`Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
pos = _crPos cr + rotateV (_crDir cr) (V2 x y)
dir = _crDir cr + Q.qToAng q
@@ -1250,7 +1238,7 @@ shootTeslaArc loc cr mz w =
i -> fst . randomR (- i, i) $ _randGen w
determineProjectileTracking :: LDTree ItemLink OItem
-> LDTree ItemLink OItem -> RocketHoming
-> DTree OItem -> RocketHoming
determineProjectileTracking magtree itmtree =
fromMaybe NoHoming $
finddronecontrols <|> findexternaltracking
@@ -1261,8 +1249,8 @@ determineProjectileTracking magtree itmtree =
return $ HomeUsingRemoteScreen (screen ^. _2 . ldtValue . _1 . itID)
findexternaltracking = do
_ <- find isammotargeting (magtree ^. ldtLeft)
targetingtree <- find isweapontargeting (itmtree ^. ldtRight)
return $ HomeUsingTargeting (targetingtree ^. _2 . ldtValue . _1 . itID)
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
RemoteScreenSF {} -> True
@@ -1275,13 +1263,13 @@ determineProjectileTracking magtree itmtree =
isammotargeting x = case x ^. _2 . ldtValue . _2 of
AmmoTargetingSF {} -> True
_ -> False
isweapontargeting :: (ItemLink,LDTree ItemLink OItem) -> Bool
isweapontargeting x = case x ^. _2 . ldtValue . _2 of
isweapontargeting :: (DTree OItem) -> Bool
isweapontargeting x = case x ^. dtValue . _2 of
WeaponTargetingSF {} -> True
_ -> False
createProjectileR ::
LocationLDT ItemLink OItem ->
LocationDT OItem ->
LDTree ItemLink OItem ->
Muzzle ->
Creature ->
@@ -1289,15 +1277,15 @@ createProjectileR ::
World
createProjectileR loc magtree =
createProjectile
(loc ^. locLDT . ldtValue . _3)
(loc ^. locDT . dtValue . _3)
( Rocket
(determineProjectileTracking ( magtree) $ itmtree)
(determineProjectileTracking ( magtree) $ itmtree)
smoke
)
magtree
(getPJStabiliser itmtree)
(getPJStabiliser itmtree)
where
itmtree = loc ^. locLDT
itmtree = loc ^. locDT
smoke
| isJust $ find issmokereducer (magtree ^. ldtLeft) = Just ReducedRocketSmoke
| otherwise = Nothing
@@ -1306,28 +1294,28 @@ createProjectileR loc magtree =
SmokeReducerSF {} -> True
_ -> False
getPJStabiliser :: LDTree ItemLink OItem -> Maybe PJStabiliser
getPJStabiliser ldt = case find isprojstab (ldt ^. ldtRight) of
Just ldt' -> case ldt' ^? _2 . ldtValue . _1 . itType . ibtAttach of
getPJStabiliser :: DTree OItem -> Maybe PJStabiliser
getPJStabiliser ldt = case find isprojstab (ldt ^. dtRight) of
Just ldt' -> case ldt' ^? dtValue . _1 . itType . ibtAttach of
Just GIMBAL -> Just StabOrthReduce
Just GYROSCOPE -> Just StabSpinIncrease
_ -> Nothing
_ -> Nothing
where
isprojstab :: (ItemLink,LDTree ItemLink OItem) -> Bool
isprojstab y = case y ^. _2 . ldtValue . _2 of
isprojstab :: (DTree OItem) -> Bool
isprojstab y = case y ^.dtValue . _2 of
ProjectileStabiliserSF {} -> True
_ -> False
getGrenadeHitEffect :: LDTree ItemLink OItem -> GrenadeHitEffect
getGrenadeHitEffect t = case find isghiteff (t ^. ldtRight) of
Just ldt' -> case ldt' ^? _2 . ldtValue . _1 . itType of
getGrenadeHitEffect :: DTree OItem -> GrenadeHitEffect
getGrenadeHitEffect t = case find isghiteff (t ^. dtRight) of
Just ldt' -> case ldt' ^? dtValue . _1 . itType of
Just STICKYMOD -> GStick
_ -> GBounce 2
_ -> GBounce 2
where
isghiteff :: (ItemLink,LDTree ItemLink OItem) -> Bool
isghiteff y = case y ^. _2 . ldtValue . _2 of
isghiteff :: (DTree OItem) -> Bool
isghiteff y = case y ^. dtValue . _2 of
GrenadeHitEffectSF {} -> True
_ -> False