Attempt to simplify attachment process

ghcidOutput

@@ -1,14 +1,46 @@
-/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:26:1-22: warning: [-Wunused-top-binds]
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:25:9: warning: [-Wname-shadowing]
+    This binding for ‘x’ shadows the existing binding
+      bound at /home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:23:12
+   |
+25 |     noa x y = (x, ILink y orientAttachment)
+   |         ^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:25:11: warning: [-Wname-shadowing]
+    This binding for ‘y’ shadows the existing binding
+      bound at /home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:23:14
+   |
+25 |     noa x y = (x, ILink y orientAttachment)
+   |           ^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:93:5-7: warning: [-Wunused-local-binds]
+    Defined but not used: ‘noa’
+   |
+93 |     noa x y = (x, ILink y orientAttachment)
+   |     ^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:94:5-11: warning: [-Wunused-local-binds]
+    Defined but not used: ‘nolinks’
+   |
+94 |     nolinks x = (itm, x, LTest (const Nothing) (const Nothing))
+   |     ^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:95:5-11: warning: [-Wunused-local-binds]
+    Defined but not used: ‘isolate’
+   |
+95 |     isolate = (itm, UncomposableIsolateSF, LTest (const Nothing) (const Nothing))
+   |     ^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:98:1-17: warning: [-Wunused-top-binds]
+    Defined but not used: ‘ammoComposedItem'’
+   |
+98 | ammoComposedItem' itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
+   | ^^^^^^^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:26:1: warning: [-Wunused-top-binds]
     Defined but not used: ‘heldItemRelativeOrient’
    |
 26 | heldItemRelativeOrient itm cr (p,q)
    | ^^^^^^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:44:5-9: warning: [-Wunused-local-binds]
+/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:44:5: warning: [-Wunused-local-binds]
     Defined but not used: ‘handD’
    |
 44 |     handD = 15
    |     ^^^^^
-/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:44:13-14: warning: [-Wtype-defaults]
+/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:44:13: warning: [-Wtype-defaults]
     • Defaulting the following constraint to type ‘Integer’
         Num p0 arising from the literal ‘15’
     • In the expression: 15
@@ -33,7 +65,7 @@
    |
 44 |     handD = 15
    |             ^^
-/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:45:5-11: warning: [-Wunused-local-binds]
+/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:45:5: warning: [-Wunused-local-binds]
     Defined but not used: ‘handPos’
    |
 45 |     handPos = case cr ^? crStance . carriage of
@@ -60,7 +92,7 @@
    |
 53 |     f i = 0.1 * fromIntegral (sLen - i) / fromIntegral sLen
    |     ^
-/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:54:5-8: warning: [-Wunused-local-binds]
+/home/justin/Haskell/loop/src/Dodge/Item/HeldOffset.hs:54:5: warning: [-Wunused-local-binds]
     Defined but not used: ‘sLen’
    |
 54 |     sLen = _strideLength $ _crStance cr

src/Dodge/Creature.hs

@@ -279,7 +279,7 @@ testInventory =
 
 stackedInventory :: [Item]
 stackedInventory =
-    [ launcher
+    [ torch
     , remoteScreen
     , megaShellMag
     , targetingScope TARGETLASER

src/Dodge/Item/Grammar.hs

@@ -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 _ ->
+--    AMMOMAG _ -> ammoComposedItem' itm
-        ( itm
+--    TARGETING{} -> (itm, WeaponTargetingSF, useBreakListsLinkTest [noa AugmentedHUDSF AugmentedHUDLink] [])
-        , WeaponPlatformSF
+--    ATTACH REMOTESCREEN -> nolinks RemoteScreenSF
-        , useBreakListsLinkTest
+--    ATTACH BULLETSYNTHESIZER -> (itm, AmmoModifierSF BulletAmmo, LTest (const Nothing) (const Nothing))
-            ( map
+--    LEFT{} -> isolate
-                (\(i, a) -> noa (AmmoMagSF a) (AmmoInLink i a))
+--    EQUIP{} -> isolate
-                (IM.toList $ itm ^. itUse . heldAmmoTypes)
+--    CONSUMABLE{} -> isolate
-            )
+--    CRAFT{} -> isolate
-            [noa WeaponTargetingSF WeaponTargetingLink, noa WeaponScopeSF WeaponScopeLink]
+    _ -> simplePCI itm
-        )
-    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
   where
-    --    _ ->
 
     noa x y = (x, ILink y orientAttachment)
     nolinks x = (itm, x, LTest (const Nothing) (const Nothing))

tags

@@ -3382,7 +3382,7 @@ attachOnward'	src/Dodge/Tree/Compose.hs	98;"	f
 attachTree	src/Dodge/Tree/Compose.hs	38;"	f
 attentionViewPoint	src/Dodge/Creature/ReaderUpdate.hs	66;"	f
 attribSize	src/Shader/Compile.hs	306;"	f
-augmentedHUD	src/Dodge/Item/Scope.hs	45;"	f
+augmentedHUD	src/Dodge/Item/Scope.hs	46;"	f
 autoAmr	src/Dodge/Item/Held/Rod.hs	51;"	f
 autoBS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	350;"	f
 autoCrit	src/Dodge/Creature/AutoCrit.hs	13;"	f
@@ -3433,10 +3433,10 @@ basicMachineApplyDamage	src/Dodge/Machine/Damage.hs	6;"	f
 basicMachineUpdate	src/Dodge/Machine.hs	13;"	f
 basicMuzFlare	src/Dodge/HeldUse.hs	166;"	f
 basicTerminal	src/Dodge/Terminal.hs	32;"	f
-battery	src/Dodge/Item/Ammo.hs	72;"	f
+battery	src/Dodge/Item/Ammo.hs	74;"	f
 batteryPack	src/Dodge/Item/Equipment.hs	57;"	f
 belowNumX	src/Dodge/Combine/Graph.hs	76;"	f
-beltMag	src/Dodge/Item/Ammo.hs	40;"	f
+beltMag	src/Dodge/Item/Ammo.hs	42;"	f
 bfsNodePoints	src/Dodge/Path.hs	58;"	f
 bfsThenReturn	src/Dodge/Creature/ReaderUpdate.hs	216;"	f
 bindFBO	src/Render.hs	244;"	f
@@ -3495,10 +3495,10 @@ bufferShaderLayers	src/Shader/Bind.hs	36;"	f
 bulletBeltBracer	src/Dodge/Item/Equipment.hs	82;"	f
 bulletBeltPack	src/Dodge/Item/Equipment.hs	73;"	f
 bulletCombinations	src/Dodge/Combine/Graph.hs	34;"	f
-bulletModule	src/Dodge/Item/Scope.hs	33;"	f
+bulletModule	src/Dodge/Item/Scope.hs	34;"	f
-bulletPayloadModule	src/Dodge/Item/Scope.hs	42;"	f
+bulletPayloadModule	src/Dodge/Item/Scope.hs	43;"	f
-bulletSynthesizer	src/Dodge/Item/Ammo.hs	100;"	f
+bulletSynthesizer	src/Dodge/Item/Ammo.hs	102;"	f
-bulletTargetingModule	src/Dodge/Item/Scope.hs	39;"	f
+bulletTargetingModule	src/Dodge/Item/Scope.hs	40;"	f
 bulletWeapons	src/Dodge/Combine/Combinations.hs	246;"	f
 burstRifle	src/Dodge/Item/Held/Cane.hs	74;"	f
 buzzS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	502;"	f
@@ -3543,7 +3543,7 @@ checkTermDist	src/Dodge/Update.hs	283;"	f
 checkWallLeft	src/Dodge/LevelGen/StaticWalls/Deprecated.hs	29;"	f
 checkWallRight	src/Dodge/LevelGen/StaticWalls.hs	54;"	f
 checkWallRight	src/Dodge/LevelGen/StaticWalls/Deprecated.hs	59;"	f
-chemFuelPouch	src/Dodge/Item/Ammo.hs	86;"	f
+chemFuelPouch	src/Dodge/Item/Ammo.hs	88;"	f
 chooseCursorBorders	src/Dodge/Render/List.hs	126;"	f
 chooseEquipmentPosition	src/Dodge/Inventory/RBList.hs	36;"	f
 chooseFootSound	src/Dodge/Creature/State/WalkCycle.hs	39;"	f
@@ -4132,7 +4132,7 @@ droneLauncher	src/Dodge/Item/Weapon/Drone.hs	11;"	f
 dropByState	src/Dodge/Creature/State.hs	158;"	f
 dropExcept	src/Dodge/Creature/Action.hs	172;"	f
 dropItem	src/Dodge/Creature/Action.hs	177;"	f
-drumMag	src/Dodge/Item/Ammo.hs	34;"	f
+drumMag	src/Dodge/Item/Ammo.hs	36;"	f
 dtIL	src/Dodge/DoubleTree.hs	22;"	f
 dtToAdjRootParent	src/Dodge/DoubleTree.hs	73;"	f
 dtToAdjRootParentEither	src/Dodge/DoubleTree.hs	79;"	f
@@ -4236,7 +4236,7 @@ flatShield	src/Dodge/Item/Held/Utility.hs	9;"	f
 flatShieldEquipSPic	src/Dodge/Item/Draw/SPic.hs	391;"	f
 fleeFrom	src/Dodge/CreatureEffect.hs	120;"	f
 fleeFromTarget	src/Dodge/CreatureEffect.hs	66;"	f
-fletchingModule	src/Dodge/Item/Scope.hs	30;"	f
+fletchingModule	src/Dodge/Item/Scope.hs	31;"	f
 flickerMod	src/Dodge/Placement/Instance/LightSource/Flicker.hs	10;"	f
 flickerUpdate	src/Dodge/Placement/Instance/LightSource/Flicker.hs	24;"	f
 flipSwitch	src/Dodge/Button/Event.hs	21;"	f
@@ -4432,7 +4432,7 @@ hitS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	382;"	f
 holdForm	src/Dodge/Creature/Boid.hs	136;"	f
 holsterWeapon	src/Dodge/Creature/Volition.hs	14;"	f
 homingDrawType	src/Dodge/Projectile/Create.hs	12;"	f
-homingModule	src/Dodge/Item/Scope.hs	27;"	f
+homingModule	src/Dodge/Item/Scope.hs	28;"	f
 horPipe	src/Dodge/Placement/Instance/Pipe.hs	9;"	f
 hotkeyToScancode	src/Dodge/Creature/YourControl.hs	55;"	f
 hotkeyToString	src/Dodge/Inventory/SelectionList.hs	50;"	f
@@ -4723,7 +4723,7 @@ main	bench/Bench.hs	15;"	f
 main	test/Spec.hs	12;"	f
 mainListCursor	src/Dodge/Render/HUD/Carte.hs	51;"	f
 makeArc	src/Picture/Base.hs	157;"	f
-makeAttach	src/Dodge/Item/Attach.hs	5;"	f
+makeAttach	src/Dodge/Item/Attach.hs	10;"	f
 makeBlip	src/Dodge/RadarSweep.hs	51;"	f
 makeBlockDebris	src/Dodge/Block/Debris.hs	28;"	f
 makeBoolOption	src/Dodge/Menu/OptionType.hs	8;"	f
@@ -4817,9 +4817,9 @@ mcTypeUpdate	src/Dodge/Machine/Update.hs	24;"	f
 mcUseHeld	src/Dodge/HeldUse.hs	365;"	f
 mcUseItem	src/Dodge/Machine/Update.hs	61;"	f
 medkit	src/Dodge/Item/Consumable.hs	8;"	f
-megaBattery	src/Dodge/Item/Ammo.hs	67;"	f
+megaBattery	src/Dodge/Item/Ammo.hs	69;"	f
-megaShellMag	src/Dodge/Item/Ammo.hs	47;"	f
+megaShellMag	src/Dodge/Item/Ammo.hs	49;"	f
-megaTinMag	src/Dodge/Item/Ammo.hs	8;"	f
+megaTinMag	src/Dodge/Item/Ammo.hs	10;"	f
 meleeHeadingMove	src/Dodge/Creature/Boid.hs	281;"	f
 memoBoxEdgeIndices	src/Shader/Poke.hs	344;"	f
 memoBoxSurfaces	src/Shader/Poke.hs	278;"	f
@@ -5315,7 +5315,7 @@ reload1S	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	428;"	f
 reloadLevelStart	src/Dodge/Save.hs	71;"	f
 reloadS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	426;"	f
 rememberSounds	src/Dodge/Creature/Perception.hs	177;"	f
-remoteScreen	src/Dodge/Item/Scope.hs	48;"	f
+remoteScreen	src/Dodge/Item/Scope.hs	49;"	f
 remoteShellShape	src/Dodge/Projectile/Draw.hs	42;"	f
 removeAmmoFromMag	src/Dodge/HeldUse.hs	276;"	f
 removeDot	src/ShortShow.hs	30;"	f
@@ -5568,7 +5568,7 @@ shatterGunSPic	src/Dodge/Item/Draw/SPic.hs	246;"	f
 shatterWall	src/Dodge/Item/Weapon/Shatter.hs	26;"	f
 shellCollisionCheck	src/Dodge/Projectile/Update.hs	51;"	f
 shellCollisionEffect	src/Dodge/Projectile/Update.hs	47;"	f
-shellMag	src/Dodge/Item/Ammo.hs	52;"	f
+shellMag	src/Dodge/Item/Ammo.hs	54;"	f
 shellShape	src/Dodge/Projectile/Draw.hs	27;"	f
 shellTrailCloud	src/Dodge/WorldEvent/Cloud.hs	65;"	f
 shieldWall	src/Dodge/Euse.hs	114;"	f
@@ -5791,7 +5791,7 @@ targetYouCognizant	src/Dodge/Creature/ChooseTarget.hs	13;"	f
 targetYouLOS	src/Dodge/Creature/ChooseTarget.hs	7;"	f
 targetYouWhenCognizant	src/Dodge/Creature/ReaderUpdate.hs	194;"	f
 targetYouWhenCognizant	src/Dodge/Creature/SetTarget.hs	9;"	f
-targetingScope	src/Dodge/Item/Scope.hs	22;"	f
+targetingScope	src/Dodge/Item/Scope.hs	23;"	f
 telRoomLev	src/Dodge/Room/Teleport.hs	14;"	f
 teleS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	378;"	f
 teleportModule	src/Dodge/Item/Craftable.hs	31;"	f
@@ -5840,7 +5840,7 @@ tilesToLine	src/Shader/AuxAddition.hs	66;"	f
 timeFlowUpdate	src/Dodge/Update.hs	160;"	f
 timeModule	src/Dodge/Item/Craftable.hs	34;"	f
 timerTLS	src/Dodge/LightSource/Update.hs	22;"	f
-tinMag	src/Dodge/Item/Ammo.hs	13;"	f
+tinMag	src/Dodge/Item/Ammo.hs	15;"	f
 tinitusS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	402;"	f
 titleOptionsMenu	src/Dodge/Menu.hs	99;"	f
 titleOptionsNoWrite	src/Dodge/Menu.hs	102;"	f
@@ -6293,5 +6293,5 @@ zoomFloatingCamera	src/Dodge/Update/Camera.hs	65;"	f
 zoomFromItem	src/Dodge/Update/Camera.hs	213;"	f
 zoomInLongGun	src/Dodge/Update/Camera.hs	157;"	f
 zoomOutLongGun	src/Dodge/Update/Camera.hs	165;"	f
-zoomScope	src/Dodge/Item/Scope.hs	17;"	f
+zoomScope	src/Dodge/Item/Scope.hs	18;"	f
 zoomSpeed	src/Dodge/Update/Camera.hs	154;"	f