Attempt to simplify attachment process

2024-10-01 15:34:53 +01:00
parent cb461963f0
commit fa4e117f93
4 changed files with 114 additions and 51 deletions
@@ -279,7 +279,7 @@ testInventory =

 stackedInventory :: [Item]
 stackedInventory =
-    [ launcher
+    [ torch
    , remoteScreen
    , megaShellMag
    , targetingScope TARGETLASER
@@ -18,6 +18,13 @@ import Dodge.Item.Orientation
 import LensHelp
 import ListHelp

+useBreakL' :: [(ItemStructuralFunction, ComposeLinkType)] -> [(ItemStructuralFunction, ComposeLinkType)] 
+    -> LinkTest ItemLink
+useBreakL' x y = useBreakListsLinkTest (map (uncurry noa) x) (map (uncurry noa) y)
+  where
+    noa x y = (x, ILink y orientAttachment)
+    
+
 useBreakListsLinkTest :: [(ItemStructuralFunction, a)] -> [(ItemStructuralFunction, a)] -> LinkTest a
 useBreakListsLinkTest llist rlist = LTest ltest rtest
  where
@@ -30,34 +37,58 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest
        (_, linktype) <- safeHead xs
        return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id

+itemToBreakLists :: Item 
+    -> ([(ItemStructuralFunction, ComposeLinkType)] , [(ItemStructuralFunction, ComposeLinkType)])
+itemToBreakLists itm = case itm ^. itType of
+    HELD {} -> 
+            ( map
+                (\(i, a) -> (AmmoMagSF a,AmmoInLink i a))
+                (IM.toList $ itm ^. itUse . heldAmmoTypes)
+            ,
+            [(WeaponTargetingSF,WeaponTargetingLink), (WeaponScopeSF,WeaponScopeLink)]
+            )
+    AMMOMAG {} -> fromMaybe ([],[]) $ do
+        atype <- itm ^? itUse . amagType
+        return 
+            ([ (AmmoModifierSF atype, AmmoModLink)
+            , (AmmoTargetingSF atype, AmmoTargetingLink)
+            , (AmmoPayloadSF atype, AmmoPayloadLink)
+            , (AmmoEffectSF atype, AmmoEffectLink)
+            , (RemoteScreenSF, RemoteScreenLink)
+            ],[])
+    TARGETING{} -> ([(AugmentedHUDSF,AugmentedHUDLink)],[])
+    _ -> ([],[])
+
+itemToFunction :: Item -> ItemStructuralFunction
+itemToFunction itm = case itm ^. itType of
+    HELD {} -> WeaponPlatformSF
+    AMMOMAG {} -> maybe UncomposableIsolateSF AmmoMagSF $ itm ^? itUse . amagType
+    ATTACH REMOTESCREEN -> RemoteScreenSF
+    ATTACH BULLETSYNTHESIZER -> AmmoModifierSF BulletAmmo
+    ATTACH ZOOMSCOPE -> WeaponScopeSF
+    ATTACH HOMINGMODULE -> AmmoTargetingSF ProjectileAmmo
+    ATTACH AUGMENTEDHUD -> AugmentedHUDSF
+    BULLETMOD BulletModTrajectory{} -> AmmoTargetingSF BulletAmmo
+    BULLETMOD BulletModPayload{} -> AmmoPayloadSF BulletAmmo
+    BULLETMOD BulletModEffect{} -> AmmoEffectSF BulletAmmo
+    TARGETING{} -> WeaponTargetingSF
+    _ -> UncomposableIsolateSF
+
+simplePCI :: Item -> PartiallyComposedItem ItemLink
+simplePCI itm = (itm, itemToFunction itm, uncurry useBreakL' $ itemToBreakLists itm)
+
 basePartiallyComposedItem' :: Item -> PartiallyComposedItem ItemLink
 basePartiallyComposedItem' itm = case itm ^. itType of
-    HELD _ ->
-        ( itm
-        , WeaponPlatformSF
-        , useBreakListsLinkTest
-            ( map
-                (\(i, a) -> noa (AmmoMagSF a) (AmmoInLink i a))
-                (IM.toList $ itm ^. itUse . heldAmmoTypes)
-            )
-            [noa WeaponTargetingSF WeaponTargetingLink, noa WeaponScopeSF WeaponScopeLink]
-        )
-    AMMOMAG _ -> ammoComposedItem' itm
-    TARGETING{} -> (itm, WeaponTargetingSF, useBreakListsLinkTest [noa AugmentedHUDSF AugmentedHUDLink] [])
-    ATTACH ZOOMSCOPE -> nolinks WeaponScopeSF
-    ATTACH HOMINGMODULE -> nolinks $ AmmoTargetingSF ProjectileAmmo
-    ATTACH AUGMENTEDHUD -> nolinks AugmentedHUDSF
-    BULLETMOD BulletModTrajectory{} -> nolinks $ AmmoTargetingSF BulletAmmo
-    BULLETMOD BulletModPayload{} -> nolinks $ AmmoPayloadSF BulletAmmo
-    BULLETMOD BulletModEffect{} -> nolinks $ AmmoEffectSF BulletAmmo
-    ATTACH REMOTESCREEN -> nolinks RemoteScreenSF
-    ATTACH BULLETSYNTHESIZER -> (itm, AmmoModifierSF BulletAmmo, LTest (const Nothing) (const Nothing))
-    LEFT{} -> isolate
-    EQUIP{} -> isolate
-    CONSUMABLE{} -> isolate
-    CRAFT{} -> isolate
+--    AMMOMAG _ -> ammoComposedItem' itm
+--    TARGETING{} -> (itm, WeaponTargetingSF, useBreakListsLinkTest [noa AugmentedHUDSF AugmentedHUDLink] [])
+--    ATTACH REMOTESCREEN -> nolinks RemoteScreenSF
+--    ATTACH BULLETSYNTHESIZER -> (itm, AmmoModifierSF BulletAmmo, LTest (const Nothing) (const Nothing))
+--    LEFT{} -> isolate
+--    EQUIP{} -> isolate
+--    CONSUMABLE{} -> isolate
+--    CRAFT{} -> isolate
+    _ -> simplePCI itm
  where
-    --    _ ->

    noa x y = (x, ILink y orientAttachment)
    nolinks x = (itm, x, LTest (const Nothing) (const Nothing))