Allow to determine new substructural function based on ldt

src/Dodge/Data/ComposedItem.hs

@@ -32,7 +32,8 @@ data ComposeLinkType
     deriving (Eq, Ord, Show, Read)
 
 data ItemStructuralFunction
-    = HeldPlatformSF
+    = UnloadedWeaponSF
+    | HeldPlatformSF
     | EquipmentPlatformSF
     | GadgetPlatformSF
     | WeaponScopeSF

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
+    ltest ldt = do
-        let xs = dropWhile ((/= sf) . fst) llist
+        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
+    rtest ldt = do
-        let xs = dropWhile ((/= sf) . fst) rlist
+        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)
-                [ (AmmoModifierSF atype, AmmoModLink)
               , (AmmoTargetingSF atype, AmmoTargetingLink)
               , (AmmoPayloadSF atype, AmmoPayloadLink)
               , (AmmoEffectSF atype, AmmoEffectLink)
               , (SmokeReducerSF, SmokeReducerLink)
-                ] <> screenanddet
+              ]
+                <> 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 
+structureToPotentialFunction ::
---    :: LabelDoubleTree ComposedItem ItemLink 
+    LabelDoubleTree ItemLink ComposedItem ->
---    -> S.Set ItemStructuralFunction
+    S.Set ItemStructuralFunction
---structureToPotentialFunction _ = mempty
+structureToPotentialFunction = S.singleton . (^. ldtValue . _2)
 
 baseCI :: Item -> ComposedItem
 baseCI itm = (itm, itemToFunction itm, itemBaseConnections itm)

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