Move towards displaying tree links in inventory

src/Dodge/Combine.hs

@@ -18,8 +18,6 @@ import Dodge.Data.Universe
 import Dodge.Item.Display
 import Dodge.Item.InventoryColor
 import Dodge.Item.SlotsTaken
---import Dodge.Data.World
---import Dodge.Item.Amount
 import Dodge.Module
 import qualified IntMapHelp as IM
 import SimpleTrie

src/Dodge/DoubleTree.hs

@@ -1,6 +1,7 @@
 module Dodge.DoubleTree where
 
 import Dodge.Data.DoubleTree
+import qualified Data.IntMap.Strict as IM
 
 ldtToDT :: LabelDoubleTree b a -> DoubleTree a
 ldtToDT (LDT x l r) = DT x (map (ldtToDT . snd) l) (map (ldtToDT . snd) r)
@@ -18,6 +19,18 @@ dtIL nt (DT x l r) = map doindent (concat (headMap (dtIL DTBottomNode) (dtIL DTM
   where
     doindent (a,b,c) = (a,b+1,c)
 
+dtToAdjacency :: (a -> Int) -> DoubleTree a -> IM.IntMap [Int]
+dtToAdjacency f (DT x l r) = IM.insert (f x) (map g l <> map g r) 
+    . IM.unions $ map (dtToAdjacency f) $ l <> r
+  where 
+    g = f . _dtValue
+
+dtToUpDownAdj :: (a -> Int) -> DoubleTree a -> IM.IntMap ([Int],[Int])
+dtToUpDownAdj f (DT x l r) = IM.insert (f x) (map g l , map g r) 
+    . IM.unions $ map (dtToUpDownAdj f) $ l <> r
+  where 
+    g = f . _dtValue
+
 ldtToIndentList :: LabelDoubleTree b a -> [(a,Int,LabelDoubleTreeNodeType b)]
 ldtToIndentList = ldtIL LDTRootNode
 

src/Dodge/Item/Grammar.hs

@@ -84,8 +84,11 @@ invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType ComposedItemStructu
 invLDT = joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems .
     fmap (singleLDT . baseCIS)
 
-invIndentIM' :: IM.IntMap Item -> IM.IntMap (Item,Int, ())
-invIndentIM' = fmap (\x -> (x,0,()))
+invAdj :: IM.IntMap Item -> IM.IntMap ([Int],[Int])
+invAdj = IM.unions . fmap (dtToUpDownAdj getid . ldtToDT) . invLDT
+  where
+    getid (itm, _,_,_) = fromMaybe (error "invAdj attempt to find item not in inventory") $
+        itm ^? itLocation . ipInvID
 
 invIndentIM :: IM.IntMap Item -> IM.IntMap (Item,Int, LabelDoubleTreeNodeType ComposeLinkType )
 invIndentIM = IM.fromAscList . zip [0..] . reverse . map (over _1 cisToItem) . concatMap ldtToIndentList . invLDT

src/Dodge/Render/Connectors.hs

@@ -2,9 +2,13 @@ module Dodge.Render.Connectors
     ( zConnect
     , zConnectCol
     , lConnect
+    , lConnectMulti
     ) where
+import FoldableHelp
 import Picture
 import Geometry
+import Control.Lens
+import Linear.V2
 
 zConnect :: Point2 -> Point2 -> Picture
 zConnect (V2 x y) (V2 a b) = line $ map toV2
@@ -29,3 +33,10 @@ lConnect sp@(V2 _ y) ep@(V2 x _) = line
     , V2 x y
     , ep
     ]
+
+lConnectMulti :: [Point2] -> Point2 -> Picture
+lConnectMulti sps (V2 x y) = line [V2 x ymin,V2 x ymax] <>
+    foldMap f sps
+  where
+    (Just ymin,Just ymax) = minAndMax $ y : map (^._y) sps
+    f (V2 x' y') = line [V2 x' y',V2 x y']

src/Dodge/Render/HUD.hs

@@ -3,6 +3,7 @@ module Dodge.Render.HUD (
     drawHUD,
 ) where
 
+import Dodge.Item.Grammar
 import Dodge.Inventory.RBList
 import Control.Lens
 import Control.Monad
@@ -56,7 +57,12 @@ drawHP cfig =
         . (^?! cWorld . lWorld . creatures . ix 0 . crHP)
 
 drawInventory :: SelectionSections () -> World -> Configuration -> Picture
-drawInventory sss = drawSelectionSections sss . invDisplayParams
+drawInventory sss w cfig = drawSelectionSections sss (invDisplayParams w) cfig
+    <> iextra
+  where
+    iextra = fromMaybe mempty $ do
+        inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
+        return $ inventoryExtra cfig (invAdj inv) (fmap (^._2) $ invIndentIM inv)
 
 drawSubInventory :: SubInventory -> Configuration -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
@@ -177,6 +183,9 @@ examineInventoryExtra mtweaki cfig = fromMaybe mempty $ do
             translate subInvX (-71) $
                 listCursorChooseBorderScale 0 1 [North, South, West] tweaki 0 white 10 1
 
+inventoryExtra :: Configuration -> IM.IntMap ([Int],[Int]) -> IM.IntMap Int -> Picture
+inventoryExtra = undefined
+
 combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
 combineInventoryExtra sss cfig w = fromMaybe mempty $ do
     (i, j) <- sss ^? sssExtra . sssSelPos . _Just

src/FoldableHelp.hs

@@ -10,6 +10,7 @@ module FoldableHelp
     , ssfold
     , minOn
     , module Data.Foldable
+    , minAndMax
     )
     where
 import Data.Foldable
@@ -105,3 +106,5 @@ ssfold :: Foldable t => (a -> Bool) -> (a -> b -> a) -> a -> t b -> a
 {-# INLINABLE ssfold #-}
 ssfold p f a0 xs = foldr (\x g a -> if p a then a else g (f a x)) id xs a0
 
+minAndMax :: (Foldable t,Ord a) => t a -> (Maybe a,Maybe a)
+minAndMax = L.fold ((,) <$> L.minimum <*> L.maximum)