This commit is contained in:
2025-07-12 22:03:21 +01:00
parent a054d433b3
commit 6df7f657bc
2 changed files with 25 additions and 32 deletions
+22 -24
View File
@@ -45,9 +45,7 @@ import Sound.Data
gadgetEffect :: PressType -> LocationDT OItem -> Creature -> World -> World gadgetEffect :: PressType -> LocationDT OItem -> Creature -> World -> World
gadgetEffect pt loc gadgetEffect pt loc
| UseHeld{} <- loc ^. locDT . dtValue . _1 . itUse = | UseHeld{} <- loc ^. locDT . dtValue . _1 . itUse =
heldEffect heldEffect pt loc
pt
loc
| DROPPER x <- loc ^. locDT . dtValue . _1 . itType | DROPPER x <- loc ^. locDT . dtValue . _1 . itType
, Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt , Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt
, pt == InitialPress = , pt == InitialPress =
@@ -98,8 +96,8 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
& randGen .~ gen & randGen .~ gen
HammerTrigger t HammerTrigger t
| w ^. cWorld . lWorld . lClock - t > timelastused | w ^. cWorld . lWorld . lClock - t > timelastused
-- , isNothing $ lookup MakeAutoLink (tree ^. ldtRight) , -- , isNothing $ lookup MakeAutoLink (tree ^. ldtRight)
, pt == InitialPress -> pt == InitialPress ->
f loc cr w f loc cr w
AutoTrigger t AutoTrigger t
| w ^. cWorld . lWorld . lClock - t > timelastused -> | w ^. cWorld . lWorld . lClock - t > timelastused ->
@@ -671,7 +669,7 @@ loadMuzzle ::
loadMuzzle t@(DT _ l _) mz = fromMaybe (t, Nothing) $ do loadMuzzle t@(DT _ l _) mz = fromMaybe (t, Nothing) $ do
let as = _mzAmmoSlot mz let as = _mzAmmoSlot mz
amamount = _mzAmmoPerShot mz amamount = _mzAmmoPerShot mz
(i, mag) <- findWithIx (isAmmoIntLink as . (^. dtValue . _2)) l (i, mag) <- findWithIx (isAmmoIntLink as . (^. dtValue . _2)) l
availableammo <- mag ^. dtValue . _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
@@ -763,7 +761,7 @@ useLoadedAmmo ::
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, 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
@@ -932,14 +930,14 @@ getBulletType magtree =
attree ^? dtValue . _1 . itUse . ubMod . bmPayload attree ^? dtValue . _1 . itUse . ubMod . bmPayload
ispayload :: DTree OItem -> Bool ispayload :: DTree OItem -> Bool
ispayload y = case y ^. dtValue . _2 of ispayload y = case y ^. dtValue . _2 of
AmmoPayloadSF {} -> True AmmoPayloadSF{} -> True
_ -> False _ -> False
beffect = fromMaybe DestroyBullet $ do beffect = fromMaybe DestroyBullet $ do
attree <- find isammoeffect (magtree ^. dtLeft) attree <- find isammoeffect (magtree ^. dtLeft)
attree ^? dtValue . _1 . itUse . ubMod . bmEffect attree ^? dtValue . _1 . itUse . ubMod . bmEffect
isammoeffect :: DTree OItem -> Bool isammoeffect :: DTree OItem -> Bool
isammoeffect y = case y ^. dtValue . _2 of isammoeffect y = case y ^. dtValue . _2 of
AmmoEffectSF {} -> True AmmoEffectSF{} -> True
_ -> False _ -> False
magAmmoParams :: Item -> Maybe AmmoParams magAmmoParams :: Item -> Maybe AmmoParams
@@ -1245,19 +1243,19 @@ determineProjectileTracking magtree itmtree =
return $ HomeUsingTargeting (targetingtree ^. dtValue . _1 . itID) return $ HomeUsingTargeting (targetingtree ^. dtValue . _1 . itID)
isremscreen :: DTree OItem -> Bool isremscreen :: DTree OItem -> Bool
isremscreen x = case x ^. dtValue . _2 of isremscreen x = case x ^. dtValue . _2 of
RemoteScreenSF {} -> True RemoteScreenSF{} -> True
_ -> False _ -> False
isjoystick :: DTree OItem -> Bool isjoystick :: DTree OItem -> Bool
isjoystick x = case x ^. dtValue . _2 of isjoystick x = case x ^. dtValue . _2 of
JoystickSF {} -> True JoystickSF{} -> True
_ -> False _ -> False
isammotargeting :: DTree OItem -> Bool isammotargeting :: DTree OItem -> Bool
isammotargeting x = case x ^. dtValue . _2 of isammotargeting x = case x ^. dtValue . _2 of
AmmoTargetingSF {} -> True AmmoTargetingSF{} -> True
_ -> False _ -> False
isweapontargeting :: DTree OItem -> Bool isweapontargeting :: DTree OItem -> Bool
isweapontargeting x = case x ^. dtValue . _2 of isweapontargeting x = case x ^. dtValue . _2 of
WeaponTargetingSF {} -> True WeaponTargetingSF{} -> True
_ -> False _ -> False
createProjectileR :: createProjectileR ::
@@ -1283,7 +1281,7 @@ createProjectileR loc magtree =
| otherwise = Nothing | otherwise = Nothing
issmokereducer :: DTree OItem -> Bool issmokereducer :: DTree OItem -> Bool
issmokereducer y = case y ^. dtValue . _2 of issmokereducer y = case y ^. dtValue . _2 of
SmokeReducerSF {} -> True SmokeReducerSF{} -> True
_ -> False _ -> False
getPJStabiliser :: DTree OItem -> Maybe PJStabiliser getPJStabiliser :: DTree OItem -> Maybe PJStabiliser
@@ -1295,8 +1293,8 @@ getPJStabiliser ldt = case find isprojstab (ldt ^. dtRight) of
_ -> Nothing _ -> Nothing
where where
isprojstab :: DTree OItem -> Bool isprojstab :: DTree OItem -> Bool
isprojstab y = case y ^.dtValue . _2 of isprojstab y = case y ^. dtValue . _2 of
ProjectileStabiliserSF {} -> True ProjectileStabiliserSF{} -> True
_ -> False _ -> False
getGrenadeHitEffect :: DTree OItem -> GrenadeHitEffect getGrenadeHitEffect :: DTree OItem -> GrenadeHitEffect
@@ -1307,8 +1305,8 @@ getGrenadeHitEffect t = case find isghiteff (t ^. dtRight) of
_ -> GBounce 2 _ -> GBounce 2
where where
isghiteff :: DTree OItem -> Bool isghiteff :: DTree OItem -> Bool
isghiteff y = case y ^. dtValue . _2 of isghiteff y = case y ^. dtValue . _2 of
GrenadeHitEffectSF {} -> True GrenadeHitEffectSF{} -> True
_ -> False _ -> False
createProjectile :: createProjectile ::
@@ -1338,16 +1336,16 @@ createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do
. startthesound . startthesound
where where
isrdet :: DTree OItem -> Bool isrdet :: DTree OItem -> Bool
isrdet y = case y ^. dtValue . _2 of isrdet y = case y ^. dtValue . _2 of
RemoteDetonatorSF {} -> True RemoteDetonatorSF{} -> True
_ -> False _ -> False
isrscreen :: DTree OItem -> Bool isrscreen :: DTree OItem -> Bool
isrscreen y = case y ^. dtValue . _2 of isrscreen y = case y ^. dtValue . _2 of
RemoteScreenSF {} -> True RemoteScreenSF{} -> True
_ -> False _ -> False
isampay :: DTree OItem -> Bool isampay :: DTree OItem -> Bool
isampay y = case y ^. dtValue . _2 of isampay y = case y ^. dtValue . _2 of
AmmoPayloadSF {} -> True AmmoPayloadSF{} -> True
_ -> False _ -> False
-- the sound should be moved to the projectile firing -- the sound should be moved to the projectile firing
+3 -8
View File
@@ -118,8 +118,7 @@ itemToFunction itm = case itm ^. itType of
HELD{} -> case itUseCondition itm of HELD{} -> case itUseCondition itm of
UseableWhenAimed -> HeldPlatformSF UseableWhenAimed -> HeldPlatformSF
_ -> GadgetPlatformSF _ -> GadgetPlatformSF
_ _ | Just amtype <- magAmmoType itm-- ^? itConsumables . magType
| Just amtype <- magAmmoType itm-- ^? itConsumables . magType
, Just _ <- itm ^? itLocation . ilEquipSite . _Just -> , Just _ <- itm ^? itLocation . ilEquipSite . _Just ->
AmmoMagSF 0 amtype AmmoMagSF 0 amtype
AMMOMAG{} -> maybe NoSF (AmmoMagSF 0) $ magAmmoType itm -- ^? itConsumables . magType AMMOMAG{} -> maybe NoSF (AmmoMagSF 0) $ magAmmoType itm -- ^? itConsumables . magType
@@ -161,16 +160,12 @@ type DTComb a = DTree a -> DTree a -> Maybe (DTree a)
leftIsParentCombine :: DTComb CItem leftIsParentCombine :: DTComb CItem
leftIsParentCombine ltree rtree = do leftIsParentCombine ltree rtree = do
let l = rightChildList ltree sf <- find (`S.member` treeToPotentialFunction rtree) (rightChildList ltree)
xs = dropWhile (\s -> not $ S.member s (treeToPotentialFunction rtree)) l
sf <- safeHead xs
return $ ltree & dtRight .:~ ( rtree & dtValue . _2 .~ sf) return $ ltree & dtRight .:~ ( rtree & dtValue . _2 .~ sf)
rightIsParentCombine :: DTComb CItem rightIsParentCombine :: DTComb CItem
rightIsParentCombine ltree rtree = do rightIsParentCombine ltree rtree = do
let l = leftChildList rtree sf <- find (`S.member` treeToPotentialFunction ltree) (leftChildList rtree)
xs = dropWhile (\s -> not $ S.member s (treeToPotentialFunction ltree)) l
sf <- safeHead xs
return $ rtree & dtLeft .:~ ( ltree & dtValue . _2 .~ sf) return $ rtree & dtLeft .:~ ( ltree & dtValue . _2 .~ sf)
leftChildList :: DTree CItem -> [ItemSF] leftChildList :: DTree CItem -> [ItemSF]