Allow for indentation of individual selection items

src/Dodge/Data/DoubleTree.hs

@@ -10,6 +10,12 @@ import Data.Aeson
 import Data.Aeson.TH
 import Data.Bifunctor
 
+data DoubleTreeNodeType
+    = DTRootNode
+    | DTTopNode
+    | DTMidAboveNode
+    | DTMidBelowNode
+    | DTBottomNode
 
 data DoubleTree a = DT {_dtValue :: a,_dtLeft :: [DoubleTree a],_dtRight :: [DoubleTree a]}
     deriving (Eq,Ord,Show,Read)
@@ -21,6 +27,9 @@ data LabelDoubleTree b a = LDT {_ldtValue :: a, _ldtLeft :: [(b,LabelDoubleTree
 instance Functor DoubleTree where
     fmap f (DT x l r) = DT (f x) (fmap (fmap f) l) (fmap (fmap f) r)
 
+instance Foldable DoubleTree where
+    foldMap f (DT x l r) = foldMap (foldMap f) l <> f x <> foldMap (foldMap f) r
+
 instance Functor (LabelDoubleTree b) where
     fmap f (LDT x l r) = LDT (f x) (fmap (second $ fmap f) l) (fmap (second $ fmap f) r)
 

src/Dodge/Data/SelectionList.hs

@@ -5,7 +5,6 @@
 
 module Dodge.Data.SelectionList where
 
-import Dodge.Data.DoubleTree
 import Color
 import Control.Lens
 import Data.IntMap.Strict (IntMap)
@@ -62,16 +61,6 @@ data SelectionSection a = SelectionSection
     , _ssIndent :: Int
     , _ssDescriptor :: String
     }
-    |
-    SelectionTreeSection
-    { _stsItems :: DoubleTree (SelectionItem a)
-    , _ssCursor :: Maybe SectionCursor
-    , _ssMinSize :: Int
-    , _ssOffset :: Int
-    , _ssShownItems :: [Picture]
-    , _ssIndent :: Int
-    , _ssDescriptor :: String
-    }
 
 
 data SelectionWidth

src/Dodge/DisplayInventory.hs

@@ -9,6 +9,7 @@ module Dodge.DisplayInventory (
     updateCombinePositioning,
 ) where
 
+import Dodge.Data.DoubleTree
 import Control.Monad
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntMap.Merge.Strict as MIM
@@ -113,11 +114,12 @@ updateDisplaySections w cfig sss =
     coitems' =
         IM.fromDistinctAscList . zip [0 ..] $
             map closeObjectToSelectionItem (w ^. hud . closeObjects)
-    invitems' = MIM.merge MIM.dropMissing MIM.dropMissing (MIM.zipWithMatched $ const addindent) indents $ IM.mapWithKey (invSelectionItem cr) inv
+    --invitems' = MIM.merge MIM.dropMissing MIM.dropMissing (MIM.zipWithMatched $ const addindent) indents $ IM.mapWithKey (invSelectionItem cr) inv
+    invitems' = IM.mapWithKey (invSelectionItem cr) inv
     addindent x y = y & siPictures %~ map (x ++)
     cr = you w
     inv = _crInv (you w)
-    indents = indentInv inv
+    --indents = indentInv inv
     --inv = indentInv $ _crInv (you w)
     nfreeslots = crNumFreeSlots cr
     filtpair i itms filtdescription =
@@ -231,7 +233,6 @@ updateSection sis mcsel availablelines ss =
                     length allstrings - availablelines
             _ -> oldoffset
     tweakfirst (x : xs)
-        --        -- a| offset > 0 = xtra "<<<" : map h xs
         | offset > 0 =
             translate 0 (-100) (color moreupcolor $ text (theindent ++ replicate 15 '^')) :
             map h xs
@@ -241,38 +242,24 @@ updateSection sis mcsel availablelines ss =
     shownitems
         | length shownstrings > availablelines =
             tweakfirst (take (availablelines - 1) shownstrings)
-                -- ++ [xtra ">>>"]
                 ++ [translate 0 100 . color moredowncolor . textVMirror $ theindent ++ replicate 15 '^']
         | otherwise = tweakfirst shownstrings
     moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1
-    allstrings :: [(Color, Picture)]
---    allstrings = IM.elems $ overlapSelectionItems $ IM.elems sis
     allstrings = listSelectionColorPicture sis
     shownstrings = drop offset allstrings
     h (_, str) = translate (fromIntegral (_ssIndent ss) * 100) 0 str
     theindent = replicate (_ssIndent ss) ' '
-    --xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
+
+displaySelectionSection :: SelectionSection a -> Picture
+displaySelectionSection ss = undefined
 
 listSelectionColorPicture :: Foldable t => t (SelectionItem a) -> [(Color,Picture)]
 listSelectionColorPicture  = foldMap f
   where
     f si = map g (_siPictures si)
       where 
-        g str = (_siColor si,color (_siColor si) $ text str)
-
---overlapSelectionItems :: [SelectionItem a] -> IM.IntMap (Color, Picture)
---overlapSelectionItems = go 0
---  where
---    go _ [] = mempty
---    go i (si : xs) = doinsert $ go (i + _siHeight si) xs
---      where
---        thecol = _siColor si
---        doinsert m =
---            ifoldr
---                (\j str -> IM.insertWith ihelp (i + j) (thecol,color thecol (text str)))
---                m
---                (_siPictures si)
---        ihelp (_,x) (col,y) = ( col, x<>y)
+        indent = 100 * fromIntegral (_siOffX si)
+        g str = (_siColor si,translate indent 0 .  color (_siColor si) $ text str)
 
 enterCombineInv :: Configuration -> World -> World
 enterCombineInv cfig w =

src/Dodge/Item/Grammar.hs

@@ -12,6 +12,7 @@ import Dodge.Data.ComposedItem
 --import TreeHelp
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
+import Dodge.DoubleTree
 
 type PCI = (ComposedItem, [ComposedItem], [ComposedItem])
 
@@ -107,15 +108,6 @@ joinItemsInList f xs = snd $ h (xs,[])
         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)
@@ -151,10 +143,10 @@ 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)
+--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)
 
 --invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType PCI'']
 invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType PCI'']

src/Dodge/Render/List.hs

@@ -12,6 +12,7 @@ module Dodge.Render.List (
     listCursorChooseBorderScale,
 ) where
 
+import Dodge.Data.DoubleTree
 import Dodge.SelectionSections
 import Data.Maybe
 import Dodge.Base.Window
@@ -75,6 +76,9 @@ getLDPWidth ldps = case _ldpWidth ldps of
 drawListYoff :: Int -> [Picture] -> Picture
 drawListYoff = drawListYgapScaleYoff 0 1
 
+drawTreeYgapScaleYoff :: Float -> Float -> Int -> DoubleTree [Picture] -> Picture
+drawTreeYgapScaleYoff ygap s i = undefined
+
 drawListYgapScaleYoff :: Float -> Float -> Int -> [Picture] -> Picture
 drawListYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s 0) [i ..]
 
@@ -96,7 +100,7 @@ selSecDrawCursor xsize ldp sss = fromMaybe mempty $ do
             (ldp ^. ldpScale)
             (ldp ^. ldpCursorSides)
             yint
-            xint
+            (xint + _siOffX si)
             (_siColor si)
             xsize
             (_siHeight si)

src/Picture/Base.hs

@@ -189,6 +189,7 @@ stackText :: [String] -> Picture
 {-# INLINE stackText #-}
 stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..]
 
+-- character size 100 x 200, no gaps between
 text :: String -> Picture
 {-# INLINE text #-}
 text = drawText 0