Work on converting inventory list to tree

src/Dodge/Data/DoubleTree.hs

@@ -13,5 +13,8 @@ import Data.Aeson.TH
 data DoubleTree a = DT {_dtValue :: a,_dtLeft :: [DoubleTree a],_dtRight :: [DoubleTree a]}
     deriving (Eq,Ord,Show,Read)
 
+instance Functor DoubleTree where
+    fmap f (DT x l r) = DT (f x) (fmap (fmap f) l) (fmap (fmap f) r)
+
 makeLenses ''DoubleTree
 deriveJSON defaultOptions ''DoubleTree

src/Dodge/DisplayInventory.hs

@@ -22,6 +22,7 @@ import Dodge.Inventory.CheckSlots
 import Dodge.Inventory.SelectionList
 import Dodge.ListDisplayParams
 import Dodge.SelectionList
+import Dodge.Item.Grammar
 import LensHelp
 import ListHelp
 import Picture.Base
@@ -114,6 +115,7 @@ updateDisplaySections w cfig sss =
     invitems' = IM.mapWithKey (invSelectionItem cr) inv
     cr = you w
     inv = _crInv (you w)
+    --inv = indentInv $ _crInv (you w)
     nfreeslots = crNumFreeSlots cr
     filtpair i itms filtdescription =
         ( (i, filtsis)

src/Dodge/Item/Grammar.hs

@@ -6,17 +6,41 @@ import Dodge.Data.Item
 import Dodge.Data.DoubleTree
 import Dodge.Data.ComposedItem
 import TreeHelp
+import qualified Data.IntMap.Strict as IM
+import Control.Lens
 
 type PCI = (ComposedItem, [ComposedItem])
 
+type PCI' = (Item,ComposedItem, [ComposedItem])
+
+singleDT :: a -> DoubleTree a
+singleDT x = DT x [] []
+
 baseComposedItem :: ItemBaseType -> PCI
 baseComposedItem ibt = case ibt of
     HELD BURSTRIFLE -> (WeaponCI, [BulletAmmoCI])
     AMMOMAG TINMAG -> (BulletAmmoCI, [])
     _ -> (UncomposableCI, [])
 
-joinItems :: DoubleTree PCI -> DoubleTree PCI -> Maybe (DoubleTree PCI)
-joinItems t@(DT (px,cx) ls' rs') s@(DT (py,_) _ _)
+baseCI :: Item -> PCI'
+baseCI itm = let (a,b) = baseComposedItem (itm ^. itType . iyBase)
+  in (itm, a, b)
+
+joinItems :: DoubleTree PCI' -> DoubleTree PCI' -> Maybe (DoubleTree PCI')
+joinItems t@(DT (itm,px,cx) ls' rs') s@(DT (_,py,_) _ _)
+    | py `elem` cx = Just (DT (itm,px, delete py cx) 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:ls) rs
+    checktop a@(DT (_,pa,_) _ _) (DT (itm2,pb,cb) ls rs)
+        | pa `elem` cb = Just (DT (itm2,pb, delete pa cb) (a:ls) rs)
+        | otherwise = Nothing
+
+joinItems' :: DoubleTree PCI -> DoubleTree PCI -> Maybe (DoubleTree PCI)
+joinItems' t@(DT (px,cx) ls' rs') s@(DT (py,_) _ _)
     | py `elem` cx = Just (DT (px, delete py cx) ls' (rs' ++ [s]))
     | otherwise = checkdepth t s
   where
@@ -28,8 +52,8 @@ joinItems t@(DT (px,cx) ls' rs') s@(DT (py,_) _ _)
         | pa `elem` cb = Just (DT (pb, delete pa cb) (a:ls) rs)
         | otherwise = Nothing
 
-joinItems' :: Tree PCI -> Tree PCI -> Maybe (Tree PCI)
-joinItems' t@(Node (px,cx) xs) s@(Node (py,_) _)
+joinItems'' :: Tree PCI -> Tree PCI -> Maybe (Tree PCI)
+joinItems'' t@(Node (px,cx) xs) s@(Node (py,_) _)
 --    | fst y `elem` cx = Just (Node (px, delete y cx) (xs ++ [s]))
     | py `elem` cx = Just (Node (px, delete py cx) (xs ++ [s]))
     | otherwise = checkdepth t s
@@ -50,3 +74,45 @@ joinItemsInList f xs = snd $ h (xs,[])
     h ((y:ys),(z:zs)) = case f y z of
         Nothing -> h (ys, (y:z:zs))
         Just w -> h ((w:ys),zs)
+
+headMap :: (a -> a) -> (a -> a) -> [a] -> [a]
+headMap f g (x:xs) = f x : map g xs
+headMap _ _ [] = []
+
+lastMap :: (a -> a) -> (a -> a) -> [a] -> [a]
+lastMap _ _ [] = []
+lastMap f _ (x:[]) = [f x]
+lastMap f g (x:xs) = g x : lastMap f g xs
+
+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)
+
+flattenDT :: DoubleTree a -> [a]
+flattenDT (DT x l r) = concatMap flattenDT l ++ (x : concatMap flattenDT r)
+
+indentInv :: IM.IntMap Item -> [String]
+indentInv = 
+    concatMap (flattenDT .indentDoubleTreeWith (' ':) ('|':) ('+':) . fmap (const "")) .
+      joinItemsInList joinItems . IM.elems .    fmap (singleDT . baseCI)
+
+--indentInv :: IM.IntMap Item -> [String]
+--indentInv = concat . fmap (flattenDT . indentDoubleTreeWith (' ':) ('|':) ('+':) . fmap const "")
+--    . joinItemsInList joinItems
+--    .  IM.toList . fmap (singleDT . baseComposedItem)