Simplify item composition structure

2025-06-26 21:07:11 +01:00
parent 758c0aeec8
commit 377900662a
9 changed files with 195 additions and 208 deletions
@@ -50,7 +50,7 @@ gadgetEffect pt loc
    | UseHeld{} <- loc ^. locLDT . ldtValue . _1 . itUse =
        heldEffect
            pt
-            (bimap _iatType (^. _1) (loc ^. locLDT))
+            (bimap id (^. _1) (loc ^. locLDT))
    | DROPPER x <- loc ^. locLDT . ldtValue . _1 . itType
      , Just i <- loc ^? locLDT . ldtValue . _1 . itUse . uInt
      , pt == InitialPress =
@@ -60,23 +60,23 @@ gadgetEffect pt loc
        useInventoryPath pt i x loc
    | otherwise = const id

-heldEffect :: PressType -> LabelDoubleTree CLinkType Item -> Creature -> World -> World
+heldEffect :: PressType -> LabelDoubleTree ItemLink Item -> Creature -> World -> World
 heldEffect = useTimeCheck . hammerCheck heldEffectMuzzles

-heldEffectNoHammerCheck :: LabelDoubleTree CLinkType Item -> Creature -> World -> World
+heldEffectNoHammerCheck :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
 heldEffectNoHammerCheck = useTimeCheck heldEffectMuzzles

 type ChainEffect =
-    (LabelDoubleTree CLinkType Item -> Creature -> World -> World) ->
-    LabelDoubleTree CLinkType Item ->
+    (LabelDoubleTree ItemLink Item -> Creature -> World -> World) ->
+    LabelDoubleTree ItemLink Item ->
    Creature ->
    World ->
    World

 hammerCheck ::
-    (LabelDoubleTree CLinkType Item -> Creature -> World -> World) ->
+    (LabelDoubleTree ItemLink Item -> Creature -> World -> World) ->
    PressType ->
-    LabelDoubleTree CLinkType Item ->
+    LabelDoubleTree ItemLink Item ->
    Creature ->
    World ->
    World
@@ -142,7 +142,7 @@ useTimeCheck f item cr w = case useDelay $ item ^. ldtValue of
    -- will have problems elsewhere also
    itRef = item ^?! ldtValue . itLocation . ilInvID

-heldEffectMuzzles :: LabelDoubleTree CLinkType Item -> Creature -> World -> World
+heldEffectMuzzles :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
 heldEffectMuzzles t cr w =
    setusetime . doHeldUseEffect t cr
        . uncurry (applyCME (_ldtValue t) cr)
@@ -336,7 +336,7 @@ vgunMuzzles i =
            --            <*> ZipList [0 .. i -1]
        )

-doHeldUseEffect :: LabelDoubleTree CLinkType Item -> Creature -> World -> World
+doHeldUseEffect :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
 doHeldUseEffect t cr w = case t ^. ldtValue . itType of
    HELD (VOLLEYGUN j) -> case itm ^? itParams . unfiredBarrels of
        Just [_] -> fromMaybe w $ do
@@ -677,9 +677,9 @@ heldTorqueAmount = \case

 -- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
 loadMuzzle ::
-    LabelDoubleTree CLinkType Item ->
+    LabelDoubleTree ItemLink Item ->
    Muzzle ->
-    (LabelDoubleTree CLinkType Item, Maybe (Muzzle, Int, LabelDoubleTree CLinkType Item))
+    (LabelDoubleTree ItemLink Item, Maybe (Muzzle, Int, LabelDoubleTree ItemLink Item))
 loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
    --    guard $ mz ^? mzFrame == t ^? ldtValue . itUse . heldFrame
    let as = _mzAmmoSlot mz
@@ -697,7 +697,7 @@ loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
        , Just (mz, usedammo, mag)
        )

-makeMuzzleFlare :: Muzzle -> LabelDoubleTree CLinkType Item -> Creature -> World -> World
+makeMuzzleFlare :: Muzzle -> LabelDoubleTree ItemLink Item -> Creature -> World -> World
 makeMuzzleFlare mz itmtree cr = case mz ^. mzFlareType of
    NoFlare -> id
    BasicFlare -> basicMuzFlare pos dir
@@ -746,13 +746,13 @@ flareCircleAt col alphax tranv =
            )

 -- previous phaseV parameters: 0.2, 1, 5
-getLaserPhaseV :: LabelDoubleTree CLinkType Item -> Float
+getLaserPhaseV :: LabelDoubleTree ItemLink Item -> Float
 getLaserPhaseV = const 1

-getLaserDamage :: LabelDoubleTree CLinkType Item -> LaserType
+getLaserDamage :: LabelDoubleTree ItemLink Item -> LaserType
 getLaserDamage = const (DamageLaser 11)

-getLaserColor :: LabelDoubleTree CLinkType Item -> Color
+getLaserColor :: LabelDoubleTree ItemLink Item -> Color
 getLaserColor = const yellow

 basicMuzFlare :: Point2 -> Float -> World -> World
@@ -762,15 +762,15 @@ basicMuzFlare pos dir =
        . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
        . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir

-isAmmoIntLink :: Int -> CLinkType -> Bool
+isAmmoIntLink :: Int -> ItemLink -> Bool
 isAmmoIntLink i (AmmoInLink j _) = i == j
 isAmmoIntLink _ _ = False

 useLoadedAmmo ::
-    LabelDoubleTree CLinkType Item ->
+    LabelDoubleTree ItemLink Item ->
    Creature ->
    (Bool, World) ->
-    Maybe (Muzzle, Int, LabelDoubleTree CLinkType Item) ->
+    Maybe (Muzzle, Int, LabelDoubleTree ItemLink Item) ->
    (Bool, World)
 useLoadedAmmo _ _ (cme, w) Nothing = (cme, w)
 useLoadedAmmo itmtree cr (_, w) (Just (mz, x, magtree)) = (,) True $
@@ -808,7 +808,7 @@ useLoadedAmmo itmtree cr (_, w) (Just (mz, x, magtree)) = (,) True $

 getAttachedSFLink ::
    ItemStructuralFunction ->
-    LabelDoubleTree CLinkType Item ->
+    LabelDoubleTree ItemLink Item ->
    Maybe (NewInt ItmInt)
 getAttachedSFLink sf = (^? ldtRight . folding (lookup (SFLink sf)) . ldtValue . itID)

@@ -869,7 +869,7 @@ tractorBeamAt pos outpos dir power =
    d = unitVectorAtAngle dir * power

 creatureShootLaser ::
-    LabelDoubleTree CLinkType Item ->
+    LabelDoubleTree ItemLink Item ->
    Creature ->
    Muzzle ->
    World ->
@@ -925,7 +925,7 @@ removeAmmoFromMag x mid cr = fromMaybe id $ do
            . _Just
            -~ x

-getBulletType :: LabelDoubleTree CLinkType Item -> Maybe Bullet
+getBulletType :: LabelDoubleTree ItemLink Item -> Maybe Bullet
 getBulletType magtree =
    --magtree ^? ldtValue . itConsumables . magParams . ampBullet
    (magtree ^? ldtValue >>= magAmmoParams >>= (^? ampBullet))
@@ -979,9 +979,9 @@ magAmmoParams itm = case itm ^. itType of
 --        _ -> 0

 shootBullet ::
-    LabelDoubleTree CLinkType Item ->
+    LabelDoubleTree ItemLink Item ->
    Creature ->
-    (Muzzle, Int, LabelDoubleTree CLinkType Item) ->
+    (Muzzle, Int, LabelDoubleTree ItemLink Item) ->
    World ->
    World
 shootBullet itmtree cr (mz, x, magtree) w = fromMaybe w $ do
@@ -1266,8 +1266,8 @@ shootTeslaArc itm cr mz w =
    dir = _crDir cr + mrot

 determineProjectileTracking ::
-    LabelDoubleTree CLinkType Item ->
-    LabelDoubleTree CLinkType Item ->
+    LabelDoubleTree ItemLink Item ->
+    LabelDoubleTree ItemLink Item ->
    RocketHoming
 determineProjectileTracking magtree itmtree =
    fromMaybe NoHoming $
@@ -1283,8 +1283,8 @@ determineProjectileTracking magtree itmtree =
        return $ HomeUsingTargeting (targetingtree ^. ldtValue . itID)

 createProjectileR ::
-    LabelDoubleTree CLinkType Item ->
-    LabelDoubleTree CLinkType Item ->
+    LabelDoubleTree ItemLink Item ->
+    LabelDoubleTree ItemLink Item ->
    Muzzle ->
    Creature ->
    World ->
@@ -1302,7 +1302,7 @@ createProjectileR itmtree magtree =
        | isJust $ lookup SmokeReducerLink (magtree ^. ldtLeft) = Just ReducedRocketSmoke
        | otherwise = Nothing

-getPJStabiliser :: LabelDoubleTree CLinkType Item -> Maybe PJStabiliser
+getPJStabiliser :: LabelDoubleTree ItemLink Item -> Maybe PJStabiliser
 getPJStabiliser ldt = case lookup ProjectileStabiliserLink (ldt ^. ldtRight) of
    Just ldt' -> case ldt' ^? ldtValue . itType . ibtAttach of
        Just GIMBAL -> Just StabOrthReduce
@@ -1310,7 +1310,7 @@ getPJStabiliser ldt = case lookup ProjectileStabiliserLink (ldt ^. ldtRight) of
        _ -> Nothing
    _ -> Nothing

-getGrenadeHitEffect :: LabelDoubleTree CLinkType Item -> GrenadeHitEffect
+getGrenadeHitEffect :: LabelDoubleTree ItemLink Item -> GrenadeHitEffect
 getGrenadeHitEffect t = case lookup GrenadeHitEffectLink (t ^. ldtRight) of
    Just ldt' -> case ldt' ^? ldtValue . itType of
        Just STICKYMOD -> GStick
@@ -1319,7 +1319,7 @@ getGrenadeHitEffect t = case lookup GrenadeHitEffectLink (t ^. ldtRight) of

 createProjectile ::
    ProjectileType ->
-    LabelDoubleTree CLinkType Item ->
+    LabelDoubleTree ItemLink Item ->
    Maybe PJStabiliser ->
    Muzzle ->
    Creature ->