Allow for more complex item composition

ghcidOutput

@@ -1,10 +1,65 @@
-/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:(26,17)-(29,5): warning: [-Wunused-top-binds]
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:39:1-9: warning: [-Wunused-top-binds]
-    Defined but not used: data constructor ‘LinkTest’
+    Defined but not used: ‘cisToItem’
    |
-26 | data LinkTest = LinkTest 
+39 | cisToItem (x, _, _, _) = x
-   |                 ^^^^^^^^^...
+   | ^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:(32,19)-(37,5): warning: [-Wunused-top-binds]
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:43:10-12: warning: [-Wunused-matches]
-    Defined but not used: data constructor ‘LinkUpdate’
+    Defined but not used: ‘hit’
    |
-32 | data LinkUpdate = LinkUpdate
+43 |     HELD hit -> (itm, WeaponPlatformSF, useBreakListsLinkTest 
-   |                   ^^^^^^^^^^...
+   |          ^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:52:1-16: warning: [-Wunused-top-binds]
+    Defined but not used: ‘baseComposedItem’
+   |
+52 | baseComposedItem ibt itm = case ibt of
+   | ^^^^^^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:63:1-16: warning: [-Wunused-top-binds]
+    Defined but not used: ‘heldComposedItem’
+   |
+63 | heldComposedItem itm hit = case hit of
+   | ^^^^^^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:74:1-16: warning: [-Wunused-top-binds]
+    Defined but not used: ‘ammoComposedItem’
+   |
+74 | ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
+   | ^^^^^^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:79:1-7: warning: [-Wunused-top-binds]
+    Defined but not used: ‘baseCIS’
+   |
+79 | baseCIS itm =
+   | ^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:99:1-19: warning: [-Wunused-top-binds]
+    Defined but not used: ‘leftIsParentCombine’
+   |
+99 | leftIsParentCombine (LDT (itm, p, lc, rc) lt rt) t'@(LDT (_, p', _, _) _ _) = do
+   | ^^^^^^^^^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:106:1-20: warning: [-Wunused-top-binds]
+    Defined but not used: ‘rightIsParentCombine’
+    |
+106 | rightIsParentCombine t'@(LDT (_, p', _, _) _ _) (LDT (itm, p, lc, rc) lt rt) = do
+    | ^^^^^^^^^^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:138:1-6: warning: [-Wunused-top-binds]
+    Defined but not used: ‘invLDT’
+    |
+138 | invLDT =
+    | ^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:161:1-10: warning: [-Wunused-top-binds]
+    Defined but not used: ‘invRootMap’
+    |
+161 | invRootMap = foldMap (dtToIntMapWithRoot (^?! _1 . itLocation . ilInvID) . ldtToDT) . invLDT
+    | ^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:175:1-6: warning: [-Wunused-top-binds]
+    Defined but not used: ‘invAdj’
+    |
+175 | invAdj im = do
+    | ^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:199:1-11: warning: [-Wunused-top-binds]
+    Defined but not used: ‘invIndentIM’
+    |
+199 | invIndentIM = IM.fromAscList . zip [0 ..] . reverse . map (over _1 cisToItem) . concatMap ldtToIndentList . invLDT
+    | ^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:206:1-8: warning: [-Wunused-top-binds]
+    Defined but not used: ‘invTrees’
+    |
+206 | invTrees = IM.unions . map (ldtToIM getindex) . map (fmap cisToItem) . invLDT
+    | ^^^^^^^^

src/Dodge/Creature/Impulse/UseItem.hs

@@ -27,7 +27,7 @@ useRootItem :: Int -> World -> World
 useRootItem crid w = fromMaybe w $ do
         cr <- w ^? cWorld . lWorld . creatures . ix crid
         itRef <- cr ^? crManipulation . manObject . imRootItem
-        it <- invTrees (_crInv cr) ^? ix itRef
+        it <- invTrees' (_crInv cr) ^? ix itRef
         return $
             itemEffect cr it w
                 & worldEventFlags . at InventoryChange ?~ ()
@@ -115,7 +115,7 @@ useItemLeftClick' :: Creature -> World -> World
 useItemLeftClick' cr' w = fromMaybe w $ do
     cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
     itRef <- cr ^? crManipulation . manObject . imSelectedItem
-    it <- invTrees (_crInv cr) ^? ix itRef
+    it <- invTrees' (_crInv cr) ^? ix itRef
     return $
         itemEffect cr it w
             & worldEventFlags . at InventoryChange ?~ ()

src/Dodge/Data/ComposedItem.hs

@@ -9,6 +9,8 @@ import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
 import Dodge.Data.Item.Use.Consumption.Ammo
+-- it would be nice not to have to import the following...
+import Dodge.Data.Item
 
 data ComposeLinkType 
     = AmmoInLink Int AmmoType
@@ -21,10 +23,11 @@ data ComposeLinkType
 data ItemStructuralFunction
     = WeaponPlatformSF
     | WeaponScopeSF
-    | WeaponBarrelAttachmentSF
+    | WeaponTargetingSF
-    | AmmoMagazineSF
+    | AmmoMagSF
     | RemoteScreenSF
     | UncomposableIsolateSF
+    | AmmoModifierSF AmmoType
     deriving (Eq,Ord,Show,Read)
 
 data ComposedItem = WeaponCI
@@ -36,6 +39,22 @@ data ComposedItem = WeaponCI
     | RocketRemoteScreenCI
     deriving (Eq,Ord,Show,Read)
 
+type PartiallyComposedItem = (Item, ItemStructuralFunction, LinkTest)
+
+data LinkTest = LinkTest
+    { _tryLeftLink :: PartiallyComposedItem -> Maybe LinkUpdate
+    , _tryRightLink :: PartiallyComposedItem -> Maybe LinkUpdate
+    }
+
+data LinkUpdate = LinkUpdate
+    { _luLinkType :: ComposeLinkType
+    , _luParentUpdate :: PartiallyComposedItem -> PartiallyComposedItem
+    , _luChildUpdate :: PartiallyComposedItem -> PartiallyComposedItem
+    }
+
+
+makeLenses ''LinkTest
+makeLenses ''LinkUpdate
 makeLenses ''ComposedItem
 deriveJSON defaultOptions ''ComposedItem
 deriveJSON defaultOptions ''ComposeLinkType

src/Dodge/DisplayInventory.hs

@@ -116,7 +116,7 @@ updateDisplaySections w cfig sss =
     --invitems' = MIM.merge MIM.dropMissing MIM.dropMissing (MIM.zipWithMatched $ const addindent) indents $ IM.mapWithKey (invSelectionItem cr) inv
     invitems' = IM.mapWithKey (invSelectionItem cr) inv
     cr = you w
-    inv = invIndentIM  $ _crInv (you w)
+    inv = invIndentIM'  $ _crInv (you w)
     --indents = indentInv inv
     --inv = indentInv $ _crInv (you w)
     nfreeslots = crNumFreeSlots cr

src/Dodge/Inventory/Location.hs

@@ -20,10 +20,11 @@ import Control.Applicative
 -- assumes all item locations inside the items are correct
 tryGetRootAttachedFromInvID :: Int -> IM.IntMap Item -> Maybe (Int, IS.IntSet)
 tryGetRootAttachedFromInvID invid im = do
-    let imroots = invRootMap im
+    let imroots = invRootMap' im
         theroot = fromMaybe invid $ imroots ^? ix invid . _1 . _Just
     t <- imroots ^? ix theroot . _2
-    return (theroot, foldMap (IS.singleton . (^?! _1 . itLocation . ilInvID)) t)
+    --return (theroot, foldMap (IS.singleton . (^?! _1 . itLocation . ilInvID)) t)
+    return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID)) t)
 
 
  -- this assumes the creature inventory is well formed, specifically the

src/Dodge/Item/Grammar.hs

@@ -1,43 +1,52 @@
-module Dodge.Item.Grammar
+module Dodge.Item.Grammar (
-    (invTrees
+    invTrees',
-    , invIndentIM
+    invIndentIM',
-    , invAdj'
+    invAdj',
-    , invRootMap
+    invRootMap',
-    )
+) where
-    where
+
 import Control.Applicative
-import Data.Maybe
-import ListHelp
-import Dodge.Data.Item
-import Dodge.Data.DoubleTree
-import Dodge.Data.ComposedItem
 --import TreeHelp
+
+import LensHelp
 import qualified Data.IntMap.Strict as IM
-import Control.Lens
+import Data.Maybe
+import Dodge.Data.ComposedItem
+import Dodge.Data.DoubleTree
+import Dodge.Data.Item
 import Dodge.DoubleTree
+import ListHelp
 
-type ComposedItemStructure 
+type ComposedItemStructure =
-    = (Item,ComposedItem,[(ComposeLinkType,ComposedItem)], [(ComposeLinkType,ComposedItem)])
+    (Item, ComposedItem, [(ComposeLinkType, ComposedItem)], [(ComposeLinkType, ComposedItem)])
+type CIL = (ComposedItem, [(ComposeLinkType, ComposedItem)], [(ComposeLinkType, ComposedItem)])
 
-type PartiallyComposedItem = (Item,ItemStructuralFunction,LinkTest)
+useBreakListsLinkTest :: [(ItemStructuralFunction,ComposeLinkType)]
-
+    -> [(ItemStructuralFunction,ComposeLinkType)]
-type CIL = (ComposedItem,[(ComposeLinkType,ComposedItem)], [(ComposeLinkType,ComposedItem)])
+    -> LinkTest
-
+useBreakListsLinkTest llist rlist = LinkTest ltest rtest
-data LinkTest = LinkTest 
+  where
-    { _tryLeftLink :: PartiallyComposedItem -> Maybe LinkUpdate
+    ltest (_,sf,_) = do
-    , _tryRightLink :: PartiallyComposedItem -> Maybe LinkUpdate
+        let xs = dropWhile ((/= sf) . fst) llist
-    }
+        (_,linktype) <- safeHead xs
-
+        return $ LinkUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) id
--- may want to upgrade the children's possible links as well, but this is not obvious
+    rtest (_,sf,_) = do
-data LinkUpdate = LinkUpdate
+        let xs = dropWhile ((/= sf) . fst) rlist
-    { _luLinkType :: ComposeLinkType
+        (_,linktype) <- safeHead xs
-    , _luNewLinkTest :: LinkTest
+        return $ LinkUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
-    , _luParentUpdate :: (Item,PartiallyComposedItem) -> (Item,PartiallyComposedItem)
-    , _luChildUpdate :: (Item,PartiallyComposedItem) -> (Item,PartiallyComposedItem)
-    }
 
 cisToItem :: ComposedItemStructure -> Item
-cisToItem (x,_,_,_) = x
+cisToItem (x, _, _, _) = x
+
+basePartiallyComposedItem :: Item -> PartiallyComposedItem
+basePartiallyComposedItem itm = case itm ^. itType . iyBase of
+    HELD hit -> (itm, WeaponPlatformSF, useBreakListsLinkTest 
+        []
+        [(WeaponTargetingSF,WeaponTargetingLink), (WeaponScopeSF,WeaponScopeLink)]
+        )
+    ATTACH (TARGETATTACH{}) -> (itm,WeaponTargetingSF, LinkTest (const Nothing) (const Nothing))
+    _ -> (itm,UncomposableIsolateSF, LinkTest (const Nothing) (const Nothing))
+    --AMMOMAG _ -> ammoComposedItem' itm
 
 baseComposedItem :: ItemBaseType -> Item -> CIL
 baseComposedItem ibt itm = case ibt of
@@ -52,61 +61,88 @@ baseComposedItem ibt itm = case ibt of
 
 heldComposedItem :: Item -> HeldItemType -> CIL
 heldComposedItem itm hit = case hit of
-    _ -> (WeaponCI, map f ats, 
+    _ ->
-        [(WeaponTargetingLink,WeaponTargetingCI),(WeaponScopeLink,WeaponScopeCI)])
+        ( WeaponCI
+        , map f ats
+        , [(WeaponTargetingLink, WeaponTargetingCI), (WeaponScopeLink, WeaponScopeCI)]
+        )
   where
     ats = maybe [] IM.toList $ itm ^? itUse . heldAmmoTypes
-    f (i,atype) = (AmmoInLink i atype,AmmoCI atype)
+    f (i, atype) = (AmmoInLink i atype, AmmoCI atype)
 
 ammoComposedItem :: Item -> CIL
 ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
     atype <- itm ^? itUse . amagType
-    return (AmmoCI atype, [(AmmoModLink,AmmoModifierCI atype)], [])
+    return (AmmoCI atype, [(AmmoModLink, AmmoModifierCI atype)], [])
 
 baseCIS :: Item -> ComposedItemStructure
-baseCIS itm = let (a,b,c) = baseComposedItem (itm ^. itType . iyBase) itm
+baseCIS itm =
+    let (a, b, c) = baseComposedItem (itm ^. itType . iyBase) itm
      in (itm, a, b, c)
 
 type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
 
+leftIsParentCombine' :: LDTComb PartiallyComposedItem ComposeLinkType
+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 ComposeLinkType
+rightIsParentCombine' ltree rtree = do
+    lu <- (rtree ^. ldtValue . _3 . tryLeftLink) (ltree ^. ldtValue)
+    return $ rtree & ldtValue %~ (lu ^. luParentUpdate)
+        & ldtLeft .:~ (lu ^. luLinkType, ltree & ldtValue %~ (lu ^. luChildUpdate))
+
 -- the following imposes a strict ordering on the possible attachments
 leftIsParentCombine :: LDTComb ComposedItemStructure ComposeLinkType
-leftIsParentCombine (LDT (itm,p,lc,rc) lt rt) t'@(LDT (_,p',_,_) _ _) = do
+leftIsParentCombine (LDT (itm, p, lc, rc) lt rt) t'@(LDT (_, p', _, _) _ _) = do
-    let f (_,x) = p' == x
+    let f (_, x) = p' == x
-        (_,ys) = break f rc
+        (_, ys) = break f rc
-    (linktype,_) <- safeHead ys
+    (linktype, _) <- safeHead ys
-    return $ LDT (itm,p,lc,tail ys) lt (rt ++ [(linktype,t')])
+    return $ LDT (itm, p, lc, tail ys) lt (rt ++ [(linktype, t')])
 
 rightIsParentCombine :: LDTComb ComposedItemStructure ComposeLinkType
-rightIsParentCombine t'@(LDT (_,p',_,_) _ _) (LDT (itm,p,lc,rc) lt rt)  = do
+rightIsParentCombine t'@(LDT (_, p', _, _) _ _) (LDT (itm, p, lc, rc) lt rt) = do
-    let f (_,x) = p' == x
+    let f (_, x) = p' == x
-        (_,ys) = break f lc
+        (_, ys) = break f lc
-    (linktype,_) <- safeHead ys
+    (linktype, _) <- safeHead ys
-    return $ LDT (itm,p,tail ys,rc) ((linktype,t'):lt) rt
+    return $ LDT (itm, p, tail ys, rc) ((linktype, t') : lt) rt
 
-leftRightCombine :: LDTComb a b -> LDTComb a b
+leftRightCombine ::
-    -> LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
+    LDTComb a b ->
-leftRightCombine f f' t1 t2 = f t1 t2
+    LDTComb a b ->
+    LabelDoubleTree b a ->
+    LabelDoubleTree b a ->
+    Maybe (LabelDoubleTree b a)
+leftRightCombine f f' t1 t2 =
+    f t1 t2
         <|> checkdepth t1 t2
   where
     checkdepth t t'@(LDT x ls rs) = fromMaybe (checktop t t') $ do
-        (lab,t'') <- safeHead ls
+        (lab, t'') <- safeHead ls
         tx <- checkdepth t t''
-        return $ Just $ LDT x ((lab,tx):tail ls) rs
+        return $ Just $ LDT x ((lab, tx) : tail ls) rs
     checktop t t' = f' t t'
 
 joinItemsInList :: (a -> a -> Maybe a) -> [a] -> [a]
-joinItemsInList f xs = snd $ h (xs,[])
+joinItemsInList f xs = snd $ h (xs, [])
   where
-    h ([],zs) = ([],zs)
+    h ([], zs) = ([], zs)
-    h ((y:ys), []) = h (ys, [y])
+    h ((y : ys), []) = h (ys, [y])
-    h ((y:ys),(z:zs)) = case f y z of
+    h ((y : ys), (z : zs)) = case f y z of
-        Nothing -> h (ys, (y:z:zs))
+        Nothing -> h (ys, (y : z : zs))
-        Just w -> h ((w:ys),zs)
+        Just w -> h ((w : ys), zs)
 
 invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType ComposedItemStructure]
-invLDT = joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems .
+invLDT =
-    fmap (singleLDT . baseCIS)
+    joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems
+        . fmap (singleLDT . baseCIS)
+
+invLDT' :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType PartiallyComposedItem]
+invLDT' =
+    joinItemsInList (leftRightCombine leftIsParentCombine' rightIsParentCombine') . IM.elems
+        . fmap (singleLDT . basePartiallyComposedItem)
 
 -- this has provoked an error: hopefully it will crop up at some point and get
 -- debugged with suitable info
@@ -117,103 +153,67 @@ invLDT = joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentComb
 --        (error ("invAdj item " ++ show (_itID itm) ++ " location:" ++ show (itm ^? itLocation . ilInvID)) )
 --        $ itm ^? itLocation . ilInvID
 
- -- this assumes the creature inventory is well formed, specifically the
+-- this assumes the creature inventory is well formed, specifically the
- -- location ids
+-- location ids
- -- consider explicitly reseting the inventory ids (but this probably really
+-- consider explicitly reseting the inventory ids (but this probably really
- -- should be done upstream anyway in the actually creature inventory)
+-- should be done upstream anyway in the actually creature inventory)
 invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DoubleTree ComposedItemStructure)
 invRootMap = foldMap (dtToIntMapWithRoot (^?! _1 . itLocation . ilInvID) . ldtToDT) . invLDT
+
+invRootMap' :: IM.IntMap Item -> IM.IntMap (Maybe Int, DoubleTree Item)
+invRootMap' = foldMap (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) . ldtToDT) . invLDT'
+
 --invRootMap = foldMap (dtToRootIntMap g . ldtToDT) . invLDT
 --  where
 --    g = _
 
- -- this assumes the creature inventory is well formed, specifically the
+-- this assumes the creature inventory is well formed, specifically the
- -- location ids
+-- location ids
- -- consider explicitly reseting the inventory ids (but this probably really
+-- consider explicitly reseting the inventory ids (but this probably really
- -- should be done upstream anyway in the actually creature inventory)
+-- should be done upstream anyway in the actually creature inventory)
-invAdj' :: IM.IntMap Item -> Either String (IM.IntMap (Maybe (Int,Int),[Int],[Int]))
+invAdj :: IM.IntMap Item -> Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int]))
-invAdj' im = do
+invAdj im = do
     l <- mapM g $ invLDT im
     return $ IM.unions l
   where
     g = dtToLRAdjEither getid . ldtToDT
-    getid (itm, _,_,_) = maybe
+    getid (itm, _, _, _) =
-        (Left ("invAdj' item " ++ show ( _itID itm) ++ " location: " ++ show (itm ^? itLocation)) )
+        maybe
-        Right $ itm ^? itLocation . ilInvID
+            (Left ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
+            Right
+            $ itm ^? itLocation . ilInvID
 
-invIndentIM :: IM.IntMap Item -> IM.IntMap (Item,Int, LabelDoubleTreeNodeType ComposeLinkType )
+invAdj' :: IM.IntMap Item -> Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int]))
-invIndentIM = IM.fromAscList . zip [0..] . reverse . map (over _1 cisToItem) . concatMap ldtToIndentList . invLDT
+invAdj' im = do
+    l <- mapM g $ invLDT' im
+    return $ IM.unions l
+  where
+    g = dtToLRAdjEither getid . ldtToDT
+    getid (itm, _, _) =
+        maybe
+            (Left ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
+            Right
+            $ itm ^? itLocation . ilInvID
+
+invIndentIM :: IM.IntMap Item -> IM.IntMap (Item, Int, LabelDoubleTreeNodeType ComposeLinkType)
+invIndentIM = IM.fromAscList . zip [0 ..] . reverse . map (over _1 cisToItem) . concatMap ldtToIndentList . invLDT
+
+invIndentIM' :: IM.IntMap Item -> IM.IntMap (Item, Int, LabelDoubleTreeNodeType ComposeLinkType)
+invIndentIM' = IM.fromAscList . zip [0 ..] . reverse . map (over _1 (^. _1)) 
+    . concatMap ldtToIndentList . invLDT'
 
 invTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ComposeLinkType Item)
 invTrees = IM.unions . map (ldtToIM getindex) . map (fmap cisToItem) . invLDT
   where
     getindex :: Item -> Int
-    getindex i = fromMaybe (error "in invTrees try to get non-inventory item tree") $
+    getindex i =
+        fromMaybe (error "in invTrees try to get non-inventory item tree") $
             i ^? itLocation . ilInvID
 
---indentInv :: IM.IntMap Item -> [String]
+invTrees' :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ComposeLinkType Item)
---indentInv = concat . fmap (flattenDT . indentDoubleTreeWith (' ':) ('|':) ('+':) . fmap const "")
+invTrees' = IM.unions . map (ldtToIM getindex) . map (fmap (^. _1)) . invLDT'
---    . joinItemsInList joinItems
+  where
---    .  IM.toList . fmap (singleDT . baseComposedItem)
+    getindex :: Item -> Int
---
+    getindex i =
---type PCI = (ComposedItem, [ComposedItem], [ComposedItem])
+        fromMaybe (error "in invTrees try to get non-inventory item tree") $
---
+            i ^? itLocation . ilInvID
---type PCI' = (Item,ComposedItem,[ComposedItem], [ComposedItem])
-
---baseComposedItem :: ItemBaseType -> PCI
---baseComposedItem ibt = case ibt of
---    HELD BURSTRIFLE -> (WeaponCI, [BulletAmmoCI], [])
---    AMMOMAG TINMAG -> (BulletAmmoCI, [AmmoModifierCI], [])
---    AMMOMAG DRUMMAG -> (BulletAmmoCI, [AmmoModifierCI], [])
---    ATTACH BULLETSYNTHESIZER -> (AmmoModifierCI, [], [])
---    _ -> (UncomposableCI, [], [])
---
---baseCI :: Item -> PCI'
---baseCI itm = let (a,b,c) = baseComposedItem (itm ^. itType . iyBase)
---  in (itm, a, b, c)
---
---joinItems :: DoubleTree PCI' -> DoubleTree PCI' -> Maybe (DoubleTree PCI')
---joinItems t@(DT (itm,px,lc',rc') ls' rs') s@(DT (_,py,_,_) _ _)
---    | py `elem` rc' = Just (DT (itm,px,lc', delete py rc') ls' (rs' ++ [s]))
---    | otherwise = checkdepth t s
---  where
---    checkdepth a a'@(DT b ls rs) = fromMaybe (checktop a a') $ do
---        c <- safeHead ls
---        d <- checkdepth a c
---        return $ Just $ DT b (d:tail ls) rs
---    checktop a@(DT (_,pa,_,_) _ _) (DT (itm2,pb,lc,rc) ls rs)
---        | pa `elem` lc = Just (DT (itm2,pb, delete pa lc,rc) (a:ls) rs)
---        | otherwise = Nothing
---
---invTree :: IM.IntMap Item -> [String]
---invTree = concatMap (prettyDT (\(itm,_,_,_) -> show (_itType itm))) .
---      joinItemsInList joinItems . IM.elems .    fmap (singleDT . baseCI)
-
---indentInv :: IM.IntMap Item -> IM.IntMap String
---indentInv = IM.fromList . zip [0..] .
---    reverse . concatMap (flattenDT .indentDoubleTreeWith (' ':) ('|':) ('+':) . fmap (const "")) .
---      joinItemsInList joinItems . IM.elems .    fmap (singleDT . baseCI)
---
---indentDoubleTreeWith :: (a -> a) -> (a -> a) -> (a -> a) -> DoubleTree a -> DoubleTree a
---indentDoubleTreeWith f g h (DT x l r) = DT x 
---    (headMap (iDTL f g h) (iDTboth f g h) l)
---    (lastMap (iDTR f g h) (iDTboth f g h) r)
---
---iDTL :: (a -> a) -> (a -> a) -> (a -> a) -> DoubleTree a -> DoubleTree a
---iDTL fspace fline flink (DT x l r) = DT (flink x) 
---    (map (fmap fspace . indentDoubleTreeWith fspace fline flink) l)
---    (map (fmap fline . indentDoubleTreeWith fspace fline flink) r)
---
---iDTR :: (a -> a) -> (a -> a) -> (a -> a) -> DoubleTree a -> DoubleTree a
---iDTR fspace fline flink (DT x l r) = DT (flink x) 
---    (map (fmap fline . indentDoubleTreeWith fspace fline flink) l)
---    (map (fmap fspace . indentDoubleTreeWith fspace fline flink) r)
---
---iDTboth :: (a -> a) -> (a -> a) -> (a -> a) -> DoubleTree a -> DoubleTree a
---iDTboth fspace fline flink (DT x l r) = DT (flink x) 
---    (map (fmap fline . indentDoubleTreeWith fspace fline flink) l)
---    (map (fmap fline . indentDoubleTreeWith fspace fline flink) r)
-
---combineMaybe :: (a -> a -> Maybe b) -> (a -> a -> b -> a) -> a -> a -> Maybe a
---combineMaybe t f x y = fmap (f x y) (t x y)
-

src/Dodge/WorldEffect.hs

@@ -40,7 +40,7 @@ doWdWd we = case we of
         cr <- w ^? cWorld . lWorld . creatures . ix crid
         --it <- getItem itid w
         itRef <- cr ^? crManipulation . manObject . imSelectedItem
-        it <- invTrees (_crInv cr) ^? ix itRef
+        it <- invTrees' (_crInv cr) ^? ix itRef
         return $ doItCrWdWd f it cr w
     WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do
         cr <- w ^? cWorld . lWorld . creatures . ix crid

tags

@@ -72,12 +72,14 @@ Ambush	src/Dodge/Data/ActionPlan.hs	178;"	C
 Ammo	src/Dodge/Data/Ammo.hs	4;"	m
 Ammo	src/Dodge/Data/Item/Use/Consumption/Ammo.hs	6;"	m
 Ammo	src/Dodge/Item/Ammo.hs	1;"	m
-AmmoCI	src/Dodge/Data/ComposedItem.hs	25;"	C
+AmmoCI	src/Dodge/Data/ComposedItem.hs	37;"	C
-AmmoInLink	src/Dodge/Data/ComposedItem.hs	14;"	C
+AmmoInLink	src/Dodge/Data/ComposedItem.hs	16;"	C
+AmmoMagSF	src/Dodge/Data/ComposedItem.hs	27;"	C
 AmmoMagType	src/Dodge/Data/Item/Combine.hs	107;"	t
 AmmoMagUse	src/Dodge/Data/Item/Use.hs	65;"	C
-AmmoModLink	src/Dodge/Data/ComposedItem.hs	15;"	C
+AmmoModLink	src/Dodge/Data/ComposedItem.hs	17;"	C
-AmmoModifierCI	src/Dodge/Data/ComposedItem.hs	24;"	C
+AmmoModifierCI	src/Dodge/Data/ComposedItem.hs	36;"	C
+AmmoModifierSF	src/Dodge/Data/ComposedItem.hs	30;"	C
 AmmoParams	src/Dodge/Data/Item/Use.hs	110;"	t
 AmmoParams	src/Dodge/Item/Weapon/AmmoParams.hs	1;"	m
 AmmoPosition	src/Dodge/Item/AmmoPosition.hs	8;"	t
@@ -444,10 +446,10 @@ CombineInventoryChange	src/Dodge/Data/World.hs	33;"	C
 Common	src/Dodge/Zoning/Common.hs	1;"	m
 Compile	src/Shader/Compile.hs	1;"	m
 Compose	src/Dodge/Tree/Compose.hs	4;"	m
-ComposeLinkType	src/Dodge/Data/ComposedItem.hs	13;"	t
+ComposeLinkType	src/Dodge/Data/ComposedItem.hs	15;"	t
-ComposedItem	src/Dodge/Data/ComposedItem.hs	21;"	t
+ComposedItem	src/Dodge/Data/ComposedItem.hs	33;"	t
 ComposedItem	src/Dodge/Data/ComposedItem.hs	6;"	m
-ComposedItemStructure	src/Dodge/Item/Grammar.hs	19;"	t
+ComposedItemStructure	src/Dodge/Item/Grammar.hs	20;"	t
 Composite	src/Picture/Composite.hs	1;"	m
 ComsSS	src/Dodge/Data/Scenario.hs	98;"	C
 ConcBall	src/Dodge/Data/Bullet.hs	32;"	C
@@ -1301,6 +1303,7 @@ ItemParams	src/Dodge/Data/Item/Params.hs	16;"	t
 ItemParams	src/Dodge/Tesla/ItemParams.hs	1;"	m
 ItemScrollTimeFlow	src/Dodge/Data/World.hs	61;"	C
 ItemSpace	src/Dodge/Inventory/ItemSpace.hs	1;"	m
+ItemStructuralFunction	src/Dodge/Data/ComposedItem.hs	23;"	t
 ItemTweaks	src/Dodge/Data/Item/Tweak.hs	13;"	t
 ItemType	src/Dodge/Combine/Data.hs	12;"	t
 ItemType	src/Dodge/Data/Item/Combine.hs	16;"	t
@@ -1339,7 +1342,7 @@ LBoost	src/Dodge/Data/Item/HeldUse.hs	56;"	C
 LBranches	src/TreeExtra.hs	24;"	C
 LDT	src/Dodge/Data/DoubleTree.hs	39;"	C
 LDTBottomNode	src/Dodge/Data/DoubleTree.hs	27;"	C
-LDTComb	src/Dodge/Item/Grammar.hs	55;"	t
+LDTComb	src/Dodge/Item/Grammar.hs	83;"	t
 LDTMidAboveNode	src/Dodge/Data/DoubleTree.hs	25;"	C
 LDTMidBelowNode	src/Dodge/Data/DoubleTree.hs	26;"	C
 LDTRootNode	src/Dodge/Data/DoubleTree.hs	23;"	C
@@ -1439,6 +1442,8 @@ LinearShockwave	src/Dodge/Data/LinearShockwave.hs	13;"	t
 LinearShockwave	src/Dodge/Data/LinearShockwave.hs	6;"	m
 Link	src/Dodge/Room/Link.hs	6;"	m
 LinkDecoration	src/Dodge/Debug/LinkDecoration.hs	1;"	m
+LinkTest	src/Dodge/Data/ComposedItem.hs	44;"	t
+LinkUpdate	src/Dodge/Data/ComposedItem.hs	49;"	t
 List	src/Dodge/Combine/List.hs	1;"	m
 List	src/Dodge/Render/List.hs	1;"	m
 ListDisplayParams	src/Dodge/Data/SelectionList.hs	18;"	t
@@ -1908,6 +1913,7 @@ ParamMID	src/Dodge/Data/Item/Params.hs	54;"	C
 Parameters	src/Shader/Parameters.hs	1;"	m
 Parameters	src/Shape/Parameters.hs	1;"	m
 Params	src/Dodge/Data/Item/Params.hs	6;"	m
+PartiallyComposedItem	src/Dodge/Data/ComposedItem.hs	42;"	t
 PassKey	src/Dodge/Item/PassKey.hs	1;"	m
 PassthroughLockKeyLists	src/Dodge/Annotation/Data.hs	19;"	C
 Path	src/Dodge/Path.hs	2;"	m
@@ -2149,6 +2155,8 @@ Remote	src/Dodge/Item/Weapon/Remote.hs	1;"	m
 RemoteScope	src/Dodge/Data/Item/Attachment.hs	23;"	C
 RemoteScope	src/Dodge/Data/Item/Scope.hs	23;"	C
 RemoteScope	src/Dodge/Item/Attachment/Data.hs	26;"	C
+RemoteScreenLink	src/Dodge/Data/ComposedItem.hs	20;"	C
+RemoteScreenSF	src/Dodge/Data/ComposedItem.hs	28;"	C
 RemoveCreatureEndo	src/Dodge/RemoveCreatureEndo.hs	3;"	m
 RemoveEquipment	src/Dodge/Data/RightButtonOptions.hs	36;"	C
 RemoveShieldWall	src/Dodge/Data/ItEffect.hs	43;"	C
@@ -2185,8 +2193,7 @@ RightButtonOptions	src/Dodge/Data/RightButtonOptions.hs	6;"	m
 RightForward	src/Dodge/Creature/Stance/Data.hs	35;"	C
 RightForward	src/Dodge/Data/Creature/Stance.hs	33;"	C
 RoadBlock	src/Dodge/Room/RoadBlock.hs	2;"	m
-RocketRemoteScreenCI	src/Dodge/Data/ComposedItem.hs	27;"	C
+RocketRemoteScreenCI	src/Dodge/Data/ComposedItem.hs	39;"	C
-RocketRemoteScreenLink	src/Dodge/Data/ComposedItem.hs	18;"	C
 Rod	src/Dodge/Item/Held/Rod.hs	1;"	m
 Rod	src/Dodge/Item/Weapon/BulletGun/Rod.hs	1;"	m
 Room	src/Dodge/Data/GenWorld.hs	96;"	t
@@ -2717,7 +2724,8 @@ TwoHandUnder	src/Dodge/Data/Item/Use.hs	182;"	C
 Type	src/Dodge/Data/Damage/Type.hs	6;"	m
 Typical	src/Shape/Data.hs	36;"	C
 UPtLayer	src/Dodge/Picture/Layer/Data.hs	16;"	C
-UncomposableCI	src/Dodge/Data/ComposedItem.hs	26;"	C
+UncomposableCI	src/Dodge/Data/ComposedItem.hs	38;"	C
+UncomposableIsolateSF	src/Dodge/Data/ComposedItem.hs	29;"	C
 Uncursed	src/Dodge/Data/Item/CurseStatus.hs	12;"	C
 Uncursed	src/Dodge/Item/Data.hs	8;"	C
 UnderGround	src/Dodge/Data/Scenario.hs	78;"	C
@@ -2877,11 +2885,14 @@ WdWdNegateTrig	src/Dodge/Data/WorldEffect.hs	33;"	C
 WdYouPos	src/Dodge/Data/WorldEffect.hs	41;"	C
 Weapon	src/Dodge/Default/Weapon.hs	1;"	m
 Weapon	src/Dodge/Item/Weapon.hs	2;"	m
-WeaponCI	src/Dodge/Data/ComposedItem.hs	21;"	C
+WeaponCI	src/Dodge/Data/ComposedItem.hs	33;"	C
-WeaponScopeCI	src/Dodge/Data/ComposedItem.hs	22;"	C
+WeaponPlatformSF	src/Dodge/Data/ComposedItem.hs	24;"	C
-WeaponScopeLink	src/Dodge/Data/ComposedItem.hs	16;"	C
+WeaponScopeCI	src/Dodge/Data/ComposedItem.hs	34;"	C
-WeaponTargetingCI	src/Dodge/Data/ComposedItem.hs	23;"	C
+WeaponScopeLink	src/Dodge/Data/ComposedItem.hs	18;"	C
-WeaponTargetingLink	src/Dodge/Data/ComposedItem.hs	17;"	C
+WeaponScopeSF	src/Dodge/Data/ComposedItem.hs	25;"	C
+WeaponTargetingCI	src/Dodge/Data/ComposedItem.hs	35;"	C
+WeaponTargetingLink	src/Dodge/Data/ComposedItem.hs	19;"	C
+WeaponTargetingSF	src/Dodge/Data/ComposedItem.hs	26;"	C
 Weapons	src/Dodge/Item/Held/Weapons.hs	1;"	m
 West	src/Dodge/Data/CardinalPoint.hs	7;"	C
 WinScale	src/Dodge/Base/WinScale.hs	1;"	m
@@ -3604,6 +3615,9 @@ _lsParam	src/Dodge/Data/LightSource.hs	36;"	f
 _lsPict	src/Dodge/Data/LightSource.hs	38;"	f
 _lsPos	src/Dodge/Data/LightSource.hs	28;"	f
 _lsRad	src/Dodge/Data/LightSource.hs	29;"	f
+_luChildUpdate	src/Dodge/Data/ComposedItem.hs	52;"	f
+_luLinkType	src/Dodge/Data/ComposedItem.hs	50;"	f
+_luParentUpdate	src/Dodge/Data/ComposedItem.hs	51;"	f
 _lwID	src/Dodge/Data/LinearShockwave.hs	15;"	f
 _lwPoints	src/Dodge/Data/LinearShockwave.hs	16;"	f
 _lwPos	src/Dodge/Data/LinearShockwave.hs	14;"	f
@@ -4167,6 +4181,8 @@ _tractorBeams	src/Dodge/Data/LWorld.hs	122;"	f
 _trieChildren	src/SimpleTrie.hs	7;"	f
 _trieMVal	src/SimpleTrie.hs	6;"	f
 _triggers	src/Dodge/Data/LWorld.hs	131;"	f
+_tryLeftLink	src/Dodge/Data/ComposedItem.hs	45;"	f
+_tryRightLink	src/Dodge/Data/ComposedItem.hs	46;"	f
 _ttDeathEffect	src/Dodge/Data/Terminal.hs	82;"	f
 _ttTriggerID	src/Dodge/Data/Terminal.hs	81;"	f
 _tuDir	src/Dodge/Data/Machine.hs	61;"	f
@@ -4402,7 +4418,7 @@ allHotkeys	src/Dodge/Creature/YourControl.hs	52;"	f
 allVisibleWalls	src/Dodge/Base/Collide.hs	131;"	f
 alongSegBy	src/Geometry.hs	43;"	f
 ammoCheckI	src/Dodge/Item/Weapon/TriggerType.hs	118;"	f
-ammoComposedItem	src/Dodge/Item/Grammar.hs	46;"	f
+ammoComposedItem	src/Dodge/Item/Grammar.hs	73;"	f
 ammoTweakStrings	src/Dodge/Render/HUD.hs	288;"	f
 amr	src/Dodge/Item/Held/Rod.hs	46;"	f
 amr	src/Dodge/Item/Weapon/BulletGun/Rod.hs	56;"	f
@@ -4530,11 +4546,12 @@ baseAMRShape	src/Dodge/Item/Draw/SPic.hs	444;"	f
 baseBlockPane	src/Dodge/Placement/Instance/Wall.hs	86;"	f
 baseBlockPane	src/Dodge/Placements/Wall.hs	63;"	f
 baseBlockPane	src/Dodge/Room/Placement.hs	93;"	f
-baseCIS	src/Dodge/Item/Grammar.hs	51;"	f
+baseCIS	src/Dodge/Item/Grammar.hs	78;"	f
 baseCaneShape	src/Dodge/Item/Draw/SPic.hs	250;"	f
-baseComposedItem	src/Dodge/Item/Grammar.hs	27;"	f
+baseComposedItem	src/Dodge/Item/Grammar.hs	51;"	f
 baseDebris	src/Dodge/Block/Debris.hs	122;"	f
 baseFloorTileSize	src/Tile.hs	38;"	f
+basePartiallyComposedItem	src/Dodge/Item/Grammar.hs	41;"	f
 baseRifleShape	src/Dodge/Item/Draw/SPic.hs	253;"	f
 baseRodShape	src/Dodge/Item/Draw/SPic.hs	441;"	f
 baseSMGShape	src/Dodge/Item/Draw/SPic.hs	412;"	f
@@ -4717,7 +4734,7 @@ circle	src/Picture/Base.hs	180;"	f
 circleDecoration	src/Dodge/Placement/TopDecoration.hs	56;"	f
 circleSolid	src/Picture/Base.hs	164;"	f
 circleSolidCol	src/Picture/Base.hs	168;"	f
-cisToItem	src/Dodge/Item/Grammar.hs	24;"	f
+cisToItem	src/Dodge/Item/Grammar.hs	38;"	f
 clClSpringVel	src/Dodge/Update.hs	630;"	f
 clZoneSize	src/Dodge/Zone/Size.hs	3;"	f
 clZoneSize	src/Dodge/Zoning/Cloud.hs	21;"	f
@@ -5709,7 +5726,7 @@ healthTest	src/Dodge/Room/LasTurret.hs	93;"	f
 heavyBulDams	src/Dodge/Item/Weapon/Bullet.hs	38;"	f
 heightWallPS	src/Dodge/Placement/Instance/Wall.hs	13;"	f
 heldBounds	src/Dodge/Item/Module.hs	27;"	f
-heldComposedItem	src/Dodge/Item/Grammar.hs	38;"	f
+heldComposedItem	src/Dodge/Item/Grammar.hs	62;"	f
 heldEffect	src/Dodge/HeldUse.hs	44;"	f
 heldInfo	src/Dodge/Item/Info.hs	61;"	f
 heldItemOffset	src/Dodge/Item/HeldOffset.hs	24;"	f
@@ -5823,20 +5840,20 @@ intersectSegsSeg	src/Geometry/Intersect.hs	232;"	f
 intervalList	src/Geometry.hs	315;"	f
 interweave	src/Justify.hs	17;"	f
 intsToPos	src/Dodge/Room/Modify/Girder.hs	160;"	f
-invAdj'	src/Dodge/Item/Grammar.hs	119;"	f
+invAdj'	src/Dodge/Item/Grammar.hs	160;"	f
 invDimColor	src/Dodge/DisplayInventory.hs	140;"	f
 invDimColor	src/Dodge/Inventory/Color.hs	4;"	f
 invDisplayParams	src/Dodge/ListDisplayParams.hs	29;"	f
 invHead	src/Dodge/Render/HUD.hs	296;"	f
-invIndentIM	src/Dodge/Item/Grammar.hs	129;"	f
+invIndentIM	src/Dodge/Item/Grammar.hs	172;"	f
-invLDT	src/Dodge/Item/Grammar.hs	92;"	f
+invLDT	src/Dodge/Item/Grammar.hs	131;"	f
-invRootMap	src/Dodge/Item/Grammar.hs	109;"	f
+invRootMap	src/Dodge/Item/Grammar.hs	149;"	f
 invSelectionItem	src/Dodge/Inventory/SelectionList.hs	35;"	f
 invSelectionItem'	src/Dodge/Inventory/SelectionList.hs	17;"	f
 invShiftPointBy	src/Dodge/ShiftPoint.hs	8;"	f
 invSideEff	src/Dodge/Creature/State.hs	236;"	f
 invSize	src/Dodge/Inventory/CheckSlots.hs	40;"	f
-invTrees	src/Dodge/Item/Grammar.hs	132;"	f
+invTrees	src/Dodge/Item/Grammar.hs	175;"	f
 inventoryExtra	src/Dodge/Render/HUD.hs	189;"	f
 inventoryExtraH	src/Dodge/Render/HUD.hs	193;"	f
 inventoryX	src/Dodge/Creature.hs	115;"	f
@@ -5918,7 +5935,7 @@ jShape	src/Dodge/Placement/Instance/LightSource.hs	86;"	f
 jShape	src/Dodge/Placements/LightSource.hs	43;"	f
 jaggedShape	src/Dodge/Block/Debris.hs	191;"	f
 jetPack	src/Dodge/Item/Equipment.hs	92;"	f
-joinItemsInList	src/Dodge/Item/Grammar.hs	83;"	f
+joinItemsInList	src/Dodge/Item/Grammar.hs	122;"	f
 jps0'	src/Dodge/LevelGen/Data.hs	60;"	f
 jps0'	src/Dodge/LevelGen/PlacementHelper.hs	60;"	f
 jps0PushPS	src/Dodge/LevelGen/Data.hs	63;"	f
@@ -5983,10 +6000,11 @@ ldtToIM	src/Dodge/DoubleTree.hs	90;"	f
 ldtToIndentList	src/Dodge/DoubleTree.hs	93;"	f
 left	src/DoubleStack.hs	16;"	f
 leftInfo	src/Dodge/Item/Info.hs	109;"	f
-leftIsParentCombine	src/Dodge/Item/Grammar.hs	58;"	f
+leftIsParentCombine	src/Dodge/Item/Grammar.hs	92;"	f
+leftIsParentCombine'	src/Dodge/Item/Grammar.hs	85;"	f
 leftItemSPic	src/Dodge/Item/Draw/SPic.hs	72;"	f
 leftPad	src/Padding.hs	14;"	f
-leftRightCombine	src/Dodge/Item/Grammar.hs	72;"	f
+leftRightCombine	src/Dodge/Item/Grammar.hs	106;"	f
 legsSPic	src/Dodge/Item/Draw/SPic.hs	528;"	f
 liShape	src/Dodge/Placement/Instance/LightSource.hs	99;"	f
 liShape	src/Dodge/Placements/LightSource.hs	55;"	f
@@ -6879,7 +6897,7 @@ rhombus	src/Polyhedra.hs	71;"	f
 rifle	src/Dodge/Item/Held/Cane.hs	51;"	f
 rifle	src/Dodge/Item/Weapon/BulletGun/Cane.hs	77;"	f
 right	src/DoubleStack.hs	16;"	f
-rightIsParentCombine	src/Dodge/Item/Grammar.hs	65;"	f
+rightIsParentCombine	src/Dodge/Item/Grammar.hs	99;"	f
 rightPad	src/Padding.hs	22;"	f
 rightPadNoSquash	src/Padding.hs	26;"	f
 rlPosDir	src/Dodge/RoomLink.hs	94;"	f
@@ -7788,6 +7806,7 @@ upperPrismPolyTS	src/Shape.hs	118;"	f
 upperRounded	src/Shape.hs	181;"	f
 upsProjectile	src/Dodge/Projectile/Update.hs	51;"	f
 useAmmoParams	src/Dodge/Item/Weapon/AmmoParams.hs	17;"	f
+useBreakListsLinkTest	src/Dodge/Item/Grammar.hs	24;"	f
 useC	src/Dodge/Cuse.hs	8;"	f
 useC'	src/Dodge/Cuse.hs	13;"	f
 useE	src/Dodge/Euse.hs	24;"	f