From 4c9632b3f37fdaf593b8ed9f1167b5c62f3a7f86 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Sun, 29 Dec 2024 21:21:54 +0000
Subject: [PATCH] Allow to determine new substructural function based on ldt

---
 src/Dodge/Data/ComposedItem.hs   |  3 +-
 src/Dodge/Item/Grammar.hs        | 47 +++++++++++++++++++-------------
 src/Dodge/Item/InventoryColor.hs |  1 +
 3 files changed, 31 insertions(+), 20 deletions(-)

diff --git a/src/Dodge/Data/ComposedItem.hs b/src/Dodge/Data/ComposedItem.hs
index b461dbe9e..844ae58d1 100644
--- a/src/Dodge/Data/ComposedItem.hs
+++ b/src/Dodge/Data/ComposedItem.hs
@@ -32,7 +32,8 @@ data ComposeLinkType
     deriving (Eq, Ord, Show, Read)
 
 data ItemStructuralFunction
-    = HeldPlatformSF
+    = UnloadedWeaponSF
+    | HeldPlatformSF
     | EquipmentPlatformSF
     | GadgetPlatformSF
     | WeaponScopeSF
diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs
index a80704ee3..c30635f7f 100644
--- a/src/Dodge/Item/Grammar.hs
+++ b/src/Dodge/Item/Grammar.hs
@@ -10,6 +10,7 @@ module Dodge.Item.Grammar (
 import Control.Applicative
 import qualified Data.IntMap.Strict as IM
 import Data.Maybe
+import qualified Data.Set as S
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Dodge.Data.Item
@@ -17,7 +18,6 @@ import Dodge.DoubleTree
 import Dodge.Item.Orientation
 import LensHelp
 import ListHelp
---import qualified Data.Set as S
 
 tryAttachItems ::
     LabelDoubleTree ItemLink ComposedItem ->
@@ -39,12 +39,18 @@ useBreakListsLinkTest ::
     LinkTest
 useBreakListsLinkTest llist rlist = LTest ltest rtest
   where
-    ltest (LDT (_, sf, _) _ _) = do
-        let xs = dropWhile ((/= sf) . fst) llist
+    ltest ldt = do
+        let xs =
+                dropWhile
+                    ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
+                    llist
         (_, linktype) <- safeHead xs
         return $ LUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) id
-    rtest (LDT (_, sf, _) _ _) = do
-        let xs = dropWhile ((/= sf) . fst) rlist
+    rtest ldt = do
+        let xs =
+                dropWhile
+                    ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
+                    rlist
         (_, linktype) <- safeHead xs
         return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
 
@@ -66,23 +72,25 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
     (_, AmmoMagSF{}) -> fromMaybe ([], []) $ do
         atype <- itm ^? itConsumables . magType
         let screenanddet = case atype of
-                LauncherAmmo -> [ (RemoteScreenSF, RemoteScreenLink) 
+                LauncherAmmo ->
+                    [ (RemoteScreenSF, RemoteScreenLink)
                     , (RemoteDetonatorSF, RemoteDetonatorLink)
                     ]
                 _ -> []
         return
-            (
-                [ (AmmoModifierSF atype, AmmoModLink)
-                , (AmmoTargetingSF atype, AmmoTargetingLink)
-                , (AmmoPayloadSF atype, AmmoPayloadLink)
-                , (AmmoEffectSF atype, AmmoEffectLink)
-                , (SmokeReducerSF, SmokeReducerLink)
-                ] <> screenanddet
+            ( [ (AmmoModifierSF atype, AmmoModLink)
+              , (AmmoTargetingSF atype, AmmoTargetingLink)
+              , (AmmoPayloadSF atype, AmmoPayloadLink)
+              , (AmmoEffectSF atype, AmmoEffectLink)
+              , (SmokeReducerSF, SmokeReducerLink)
+              ]
+                <> screenanddet
             , []
             )
     (_, RemoteScreenSF) ->
         ( [(JoystickSF, JoystickLink)]
-        , [])
+        , []
+        )
     (_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(AugmentedHUDSF, AugmentedHUDLink)], [])
     (ATTACH BULLETSYNTH, _) ->
         ([(AmmoMagSF ElectricalAmmo, AmmoInLink 0 ElectricalAmmo)], [])
@@ -104,6 +112,7 @@ itemToFunction itm = case itm ^. itType of
     HELD LASER -> WeaponTargetingSF
     HELD{} -> case itm ^? itUseCondition of
         Just MustBeHeld -> HeldPlatformSF
+        --Just MustBeHeld -> UnloadedWeaponSF
         _ -> GadgetPlatformSF
     _
         | Just amtype <- itm ^? itConsumables . magType
@@ -118,7 +127,7 @@ itemToFunction itm = case itm ^. itType of
     ATTACH ZOOMSCOPE -> WeaponScopeSF
     ATTACH HOMINGMODULE -> AmmoTargetingSF LauncherAmmo
     ATTACH AUGMENTEDHUD -> AugmentedHUDSF
---    BULLETMOD BulletModTrajectory{} -> AmmoTargetingSF BulletAmmo
+    --    BULLETMOD BulletModTrajectory{} -> AmmoTargetingSF BulletAmmo
     BULLETMOD BulletModPayload{} -> AmmoPayloadSF BulletAmmo
     BULLETMOD BulletModEffect{} -> AmmoEffectSF BulletAmmo
     TARGETING{} -> WeaponTargetingSF
@@ -127,10 +136,10 @@ itemToFunction itm = case itm ^. itType of
     ATTACH SHELLPAYLOAD{} -> AmmoPayloadSF LauncherAmmo
     _ -> NoSF
 
---structureToPotentialFunction 
---    :: LabelDoubleTree ComposedItem ItemLink 
---    -> S.Set ItemStructuralFunction
---structureToPotentialFunction _ = mempty
+structureToPotentialFunction ::
+    LabelDoubleTree ItemLink ComposedItem ->
+    S.Set ItemStructuralFunction
+structureToPotentialFunction = S.singleton . (^. ldtValue . _2)
 
 baseCI :: Item -> ComposedItem
 baseCI itm = (itm, itemToFunction itm, itemBaseConnections itm)
diff --git a/src/Dodge/Item/InventoryColor.hs b/src/Dodge/Item/InventoryColor.hs
index 7a1ab59dc..ff7bccd0b 100644
--- a/src/Dodge/Item/InventoryColor.hs
+++ b/src/Dodge/Item/InventoryColor.hs
@@ -8,6 +8,7 @@ import Dodge.Data.ComposedItem
 
 itemInvColor :: ComposedItem -> Color
 itemInvColor ci = case ci ^. _2 of
+    UnloadedWeaponSF -> mixColorsLinear 0.5 0.5 red white
     HeldPlatformSF -> white
     MakeAutoSF -> white
     EquipmentPlatformSF -> yellow