Fix various attachment issues involving pulse laser

src/Dodge/Item/Grammar.hs

@@ -40,14 +40,17 @@ itemAboveAttachables (itm,sf) = case (itm ^. itType, sf) of
             <> getAutoSpringLinks itm
             <> extraWeaponLinks itm
     (DETECTOR {}, _) -> [ARHUDSF,TriggerSF,MapperSF]
-    (CRAFT TRANSFORMER, _) ->  [LaserWeaponSF]
+    --(CRAFT TRANSFORMER, _) ->  [LaserWeaponSF]
+    (HELD LASER, _) ->  [TransformerSF]
     (MAPPER, _) -> [ARHUDSF]
     (_, GadgetPlatformSF) -> [TriggerSF, WeaponTargetingSF, WeaponScopeSF]
     _ -> []
 
 itemBelowAttachables :: CItem -> [ItemSF]
 itemBelowAttachables (itm,sf) = case (itm ^. itType, sf) of
-    (HELD LASER, _) -> getAmmoLinks itm <> [PulseBallSF]
+    (HELD LASER, WeaponTargetingSF) -> getAmmoLinks itm
+    (HELD LASER, LaserWeaponSF) -> [PulseBallSF] <> getAmmoLinks itm
+    (HELD LASER, PulseBallSF) -> [PulseBallSF]
     --(HELD LASER, _) -> [PulseBallSF]
     (HELD TORCH, _) -> getAmmoLinks itm
     (ATTACH CAPACITOR, _) -> [AmmoMagSF 0 ElectricalAmmo]
@@ -132,6 +135,7 @@ itemToFunction itm = case itm ^. itType of
     DROPPER{} -> GadgetPlatformSF
     CLICKER{} -> GadgetPlatformSF
     ATTACH CAPACITOR -> CapacitorSF
+    CRAFT TRANSFORMER -> TransformerSF
     _ -> NoSF
 
 treeToPotentialFunction :: DTree CItem -> S.Set ItemSF
@@ -141,11 +145,13 @@ treeToPotentialFunction ldt = case ldt ^. dtValue . _1 . itType of
     ATTACH GYROSCOPE -> S.singleton ProjectileStabiliserSF
     HELD GLAUNCHER -> S.singleton UnderBarrelPlatformSF
     HELD BURSTRIFLE -> S.singleton UnderBarrelPlatformSF
-    HELD LASER -> S.fromList [WeaponTargetingSF,LaserWeaponSF]
+    HELD LASER | sf == WeaponTargetingSF -> S.fromList [WeaponTargetingSF,LaserWeaponSF]
     -- following limits items to ten ammo slots
     _ | AmmoMagSF _ x <- ldt ^. dtValue . _2 -> S.fromList [AmmoMagSF i x | i <- [0..9]]
     ATTACH CAPACITOR -> S.fromList [CapacitorSF,PulseBallSF]
     _ -> S.singleton (ldt ^. dtValue . _2)
+  where
+    sf = ldt ^. dtValue . _2
 
 baseCI :: Item -> CItem
 baseCI itm = (itm, itemToFunction itm)
@@ -155,12 +161,24 @@ type DTComb a = DTree a -> DTree a -> Maybe (DTree a)
 leftIsParentCombine :: DTComb CItem
 leftIsParentCombine ltree rtree = do
     sf <- find (`S.member` treeToPotentialFunction rtree) (rightChildList ltree)
+    let f (itm,psf) = (itm, updateLeftParentSF (itm ^. itType) psf sf)
     return $ ltree & dtRight .:~ ( rtree & dtValue . _2 .~ sf)
+        & dtValue %~ f
+
+updateLeftParentSF :: ItemType -> ItemSF -> ItemSF -> ItemSF
+updateLeftParentSF (HELD LASER) WeaponTargetingSF TransformerSF = LaserWeaponSF
+updateLeftParentSF _ psf _ = psf
 
 rightIsParentCombine :: DTComb CItem
 rightIsParentCombine ltree rtree = do
     sf <- find (`S.member` treeToPotentialFunction ltree) (leftChildList rtree)
+    let f (itm,psf) = (itm, updateRightParentSF (itm ^. itType) psf sf)
     return $ rtree & dtLeft .:~ ( ltree & dtValue . _2 .~ sf)
+        & dtValue %~ f
+
+updateRightParentSF :: ItemType -> ItemSF -> ItemSF -> ItemSF
+updateRightParentSF (HELD LASER) LaserWeaponSF CapacitorSF = PulseLaserSF
+updateRightParentSF _ psf _ = psf
 
 leftChildList :: DTree CItem -> [ItemSF]
 leftChildList t = foldl' f l (reverse $ t ^.. dtLeft . each . dtValue . _2)

src/Dodge/Item/InventoryColor.hs

@@ -1,13 +1,16 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Item.InventoryColor (
     itemInvColor,
 ) where
 
 import Color
-import Control.Lens
 import Dodge.Data.ComposedItem
 
 itemInvColor :: CItem -> Color
-itemInvColor ci = case ci ^. _2 of
+itemInvColor (_,sf) = sfInvColor sf
+
+sfInvColor :: ItemSF -> Color
+sfInvColor = \case
     MapperSF -> white
     GrenadeHitEffectSF -> yellow
     IntroScanSF -> white
@@ -36,8 +39,10 @@ itemInvColor ci = case ci ^. _2 of
     UnderBarrelPlatformSF -> white
     UnderBarrelSlotSF -> white
     LaserWeaponSF -> white
+    PulseLaserSF -> orange
     CapacitorSF -> yellow
     PulseBallSF -> white
+    TransformerSF -> yellow
 
 --ammoTypeColor :: AmmoType -> Color
 --ammoTypeColor = \case