Make lasGun have multiple functions when attached differently

src/Dodge/Item/Draw.hs

@@ -24,7 +24,7 @@ itemEquipPict cr itmtree = case itm ^. itUse of
         epos <- cr ^? crInvEquipped . ix i
         return $ equipPosition epos cr attachpos (itemSPic itm)
   where
-    itm = itmtree ^. ldtValue . _1
+    itm = itmtree ^. ldtValue . cItem
 
 equipPosition :: EquipPosition -> Creature -> Point3 -> SPic -> SPic
 equipPosition epos cr p sh = case epos of

src/Dodge/Item/Draw/SPic.hs

@@ -20,7 +20,7 @@ import Shape
 import ShapePicture
 
 itemTreeSPic :: LabelDoubleTree ItemLink ComposedItem -> SPic
-itemTreeSPic (LDT (itm, _) l r) =
+itemTreeSPic (LDT (CItem itm _) l r) =
     itemSPic itm
         <> foldMap (itemRotTreeSPic itm) (l <> r)
 
@@ -28,7 +28,7 @@ itemRotTreeSPic :: Item -> (ItemLink, LabelDoubleTree ItemLink ComposedItem) ->
 itemRotTreeSPic par (il, t) = translateSP p . overPosSP (Q.rotate q) $ itemTreeSPic t
   where
     (p, q) = _iatOrient il par (_iatType il) itm
-    itm = t ^. ldtValue . _1
+    itm = t ^. ldtValue . cItem
 
 itemSPic :: Item -> SPic
 itemSPic it = case it ^. itType of

src/Dodge/Item/Grammar.hs

@@ -19,13 +19,14 @@ 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)
+useBreakL :: [(ItemStructuralFunction, ComposeLinkType)] -> [(ItemStructuralFunction, ComposeLinkType)] 
+    -> LinkTest
+useBreakL x y = useBreakListsLinkTest (map (uncurry noa) x) (map (uncurry noa) y)
   where
     noa a b = (a, ILink b orientAttachment)
 
-useBreakListsLinkTest :: [(ItemStructuralFunction, a)] -> [(ItemStructuralFunction, a)] -> LinkTest a
+useBreakListsLinkTest :: [(ItemStructuralFunction, ItemLink)] 
+    -> [(ItemStructuralFunction, ItemLink)] -> LinkTest
 useBreakListsLinkTest llist rlist = LTest ltest rtest
   where
     ltest (_, sf, _) = do
@@ -79,27 +80,41 @@ itemToFunction itm = case itm ^. itType of
     TARGETING{} -> WeaponTargetingSF
     _ -> UncomposableIsolateSF
 
-simplePCI :: Item -> PartiallyComposedItem ItemLink
+simplePCI :: Item -> PartiallyComposedItem
 simplePCI itm = case _itType itm of
-    HELD LASGUN -> (itm, WeaponScopeSF, uncurry useBreakL' $ itemToBreakLists itm)
-    _ -> (itm, itemToFunction itm, uncurry useBreakL' $ itemToBreakLists itm)
+    HELD LASGUN -> (itm, WeaponScopeSF, laserLinkTest itm)
+    _ -> (itm, itemToFunction itm, uncurry useBreakL $ itemToBreakLists itm)
 
-itemLinkTestLeft :: Item -> PartiallyComposedItem (LinkTest ItemLink) -> Maybe (LinkUpdate ItemLink)
-itemLinkTestLeft itm pci = Nothing
+laserLinkTest :: Item -> LinkTest
+laserLinkTest itm = LTest (llleft itm) (llright itm)
 
-basePartiallyComposedItem' :: Item -> PartiallyComposedItem ItemLink
-basePartiallyComposedItem' itm = simplePCI itm
+llleft :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
+llleft itm pci = _tryLeftLink (uncurry useBreakL $ itemToBreakLists itm) pci
+
+llright :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
+llright itm pci = case pci ^. _1 . itType of
+    CRAFT TRANSFORMER -> Just (toLasgunUpdate itm)
+    _ -> _tryRightLink (uncurry useBreakL $ itemToBreakLists itm) pci
+
+toLasgunUpdate :: Item -> LinkUpdate
+toLasgunUpdate itm = LUpdate (ILink FunctionChangeLink orientAttachment)
+    (\(par,_,_) -> (par,WeaponPlatformSF,uncurry useBreakL $ itemToBreakLists itm))
+    (\(chi,_,up) -> (chi,FunctionChangeSF,up))
+
+--itemLinkTestLeft :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
+--itemLinkTestLeft itm = _tryLeftLink $
+--    uncurry useBreakL $ itemToBreakLists itm
 
 type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
 
-leftIsParentCombine :: LDTComb (PartiallyComposedItem a) a
+leftIsParentCombine :: LDTComb PartiallyComposedItem ItemLink
 leftIsParentCombine ltree rtree = do
     lu <- (ltree ^. ldtValue . _3 . tryRightLink) (rtree ^. ldtValue)
     return $
         ltree & ldtValue %~ (lu ^. luParentUpdate)
             & ldtRight %~ (++ [(lu ^. luLinkType, rtree & ldtValue %~ (lu ^. luChildUpdate))])
 
-rightIsParentCombine :: LDTComb (PartiallyComposedItem a) a
+rightIsParentCombine :: LDTComb PartiallyComposedItem ItemLink
 rightIsParentCombine ltree rtree = do
     lu <- (rtree ^. ldtValue . _3 . tryLeftLink) (ltree ^. ldtValue)
     return $
@@ -131,10 +146,10 @@ joinItemsInList f xs = snd $ h (xs, [])
         Nothing -> h (ys, y : z : zs)
         Just w -> h (w : ys, zs)
 
-invLDT :: IM.IntMap Item -> [LabelDoubleTree ItemLink (PartiallyComposedItem ItemLink)]
+invLDT :: IM.IntMap Item -> [LabelDoubleTree ItemLink PartiallyComposedItem]
 invLDT =
     joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems
-        . fmap (singleLDT . basePartiallyComposedItem')
+        . fmap (singleLDT . simplePCI)
 
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
@@ -180,7 +195,7 @@ invTrees' = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . map (fmap (\(x,
 
 -- returns an intmap with trees for root items, indexed by inventory position
 invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink ComposedItem)
-invRootTrees = IM.fromAscList . reverse . map (getid . fmap (\(x, y, _) ->  (x, y))) . invLDT
+invRootTrees = IM.fromAscList . reverse . map (getid . fmap (\(x, y, _) ->  CItem x y)) . invLDT
   where
     getid :: LabelDoubleTree ItemLink ComposedItem -> (Int,LabelDoubleTree ItemLink ComposedItem)
-    getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
+    getid t = (t ^?! ldtValue . cItem . itLocation . ilInvID, t)