justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Enable overlapping text in selection sections

Browse Source
This commit is contained in:
justin
2023-05-19 13:47:36 +01:00
parent ac87621640
commit 5604d7f1e3
1 changed files with 9 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/DisplayInventory.hs
+9 -7
View File
@@ -240,28 +240,30 @@ updateSection sis mcsel availablelines ss =
++ [translate 0 100 . color moredowncolor . textVMirror $ theindent ++ replicate 15 '^'] ++ [translate 0 100 . color moredowncolor . textVMirror $ theindent ++ replicate 15 '^']
| otherwise = tweakfirst shownstrings | otherwise = tweakfirst shownstrings
moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1 moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1
-- allstrings :: [(Color, String)] allstrings :: [(Color, Picture)]
allstrings = foldMap g sis --allstrings = foldMap g sis
allstrings = IM.elems $ overlapSelectionItems $ IM.elems sis
shownstrings = drop offset allstrings shownstrings = drop offset allstrings
h (col, str) = color col . text $ theindent ++ str --h (col, str) = color col . text $ theindent ++ str
h (col, str) = translate (fromIntegral (_ssIndent ss) * 10) 0 str
theindent = replicate (_ssIndent ss) ' ' theindent = replicate (_ssIndent ss) ' '
--xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss --xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
g si = map (_siColor si,) $ _siPictures si g si = map (_siColor si,) $ _siPictures si
overlapSelectionItems :: [SelectionItem a] -> IM.IntMap (Picture, Color) overlapSelectionItems :: [SelectionItem a] -> IM.IntMap (Color, Picture)
overlapSelectionItems = go 0 overlapSelectionItems = go 0
where where
go :: Int -> [SelectionItem a] -> IM.IntMap (Picture,Color) --go :: Int -> [SelectionItem a] -> IM.IntMap (Picture,Color)
go _ [] = mempty go _ [] = mempty
go i (si : xs) = doinsert $ go (i + _siHeight si) xs go i (si : xs) = doinsert $ go (i + _siHeight si) xs
where where
thecol = _siColor si thecol = _siColor si
doinsert m = doinsert m =
ifoldr ifoldr
(\j str -> IM.insertWith ihelp (i + j + _siOffY si) (color thecol (text str), thecol)) (\j str -> IM.insertWith ihelp (i + j + _siOffY si) (thecol,color thecol (text str)))
m m
(_siPictures si) (_siPictures si)
ihelp (a,_) (b,col) = (a <> b, col) ihelp (_,x) (col,y) = ( col, x<>y)
enterCombineInv :: Configuration -> World -> World enterCombineInv :: Configuration -> World -> World
enterCombineInv cfig w = enterCombineInv cfig w =