Garmelon/forest
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[client] Grey out tree lines

Browse source
This commit is contained in:
Joscha 2020-02-24 00:20:37 +00:00
parent 6359555db6
commit 901a1c4bce
2 changed files with 12 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

7
src/Forest/Client.hs
View file

@ -124,9 +124,10 @@ clientHandleEvent cs _ = continue cs
clientAttrMap :: AttrMap clientAttrMap :: AttrMap
clientAttrMap = attrMap Vty.defAttr clientAttrMap = attrMap Vty.defAttr
[ ("expand", Vty.currentAttr `Vty.withStyle` Vty.bold `Vty.withForeColor` Vty.yellow) [ ("expand", Vty.defAttr `Vty.withStyle` Vty.bold `Vty.withForeColor` Vty.yellow)
, ("focus", Vty.currentAttr `Vty.withBackColor` Vty.blue) , ("focus", Vty.defAttr `Vty.withBackColor` Vty.blue)
, ("flags", Vty.currentAttr `Vty.withForeColor` Vty.brightBlack) , ("flags", Vty.defAttr `Vty.withForeColor` Vty.brightBlack)
, (treeLineAttr, Vty.defAttr `Vty.withForeColor` Vty.brightBlack)
] ]
clientApp :: App ClientState Event ResourceName clientApp :: App ClientState Event ResourceName

10
src/Forest/Client/WidgetTree.hs
View file

@ -3,6 +3,7 @@
module Forest.Client.WidgetTree module Forest.Client.WidgetTree
( WidgetTree(..) ( WidgetTree(..)
, renderWidgetTree , renderWidgetTree
, treeLineAttr
, IndentOptions(..) , IndentOptions(..)
, boxDrawingBranching , boxDrawingBranching
, boxDrawingLine , boxDrawingLine
@ -15,6 +16,7 @@ import Brick.BorderMap
import Control.Monad.Trans.Reader import Control.Monad.Trans.Reader
import qualified Data.Text as T import qualified Data.Text as T
import qualified Graphics.Vty as Vty import qualified Graphics.Vty as Vty
import Lens.Micro
data WidgetTree n = WidgetTree (Widget n) [WidgetTree n] data WidgetTree n = WidgetTree (Widget n) [WidgetTree n]
@ -50,9 +52,10 @@ indentWith firstLine otherLines wrapped = Widget
renderWidget = do renderWidget = do
context <- ask context <- ask
result <- render $ hLimit (availWidth context - maxWidth) wrapped result <- render $ hLimit (availWidth context - maxWidth) wrapped
let resultHeight = Vty.imageHeight $ image result let attribute = attrMapLookup treeLineAttr $ context ^. ctxAttrMapL
resultHeight = Vty.imageHeight $ image result
textLines = firstLine : replicate (resultHeight - 1) otherLines textLines = firstLine : replicate (resultHeight - 1) otherLines
leftImage = Vty.vertCat $ map (Vty.text' Vty.defAttr) textLines leftImage = Vty.vertCat $ map (Vty.text' attribute) textLines
newImage = leftImage Vty.<|> image result newImage = leftImage Vty.<|> image result
newResult = offsetResult (Location (maxWidth, 0)) $ result{image=newImage} newResult = offsetResult (Location (maxWidth, 0)) $ result{image=newImage}
pure newResult pure newResult
@ -68,6 +71,9 @@ renderWidgetTree :: IndentOptions -> WidgetTree n -> Widget n
renderWidgetTree opts (WidgetTree node children) = renderWidgetTree opts (WidgetTree node children) =
node <=> indent opts (map (renderWidgetTree opts) children) node <=> indent opts (map (renderWidgetTree opts) children)
treeLineAttr :: AttrName
treeLineAttr = "treeLine"
-- | These options control how a tree is rendered. For more information on how -- | These options control how a tree is rendered. For more information on how
-- the various options are used, try rendering a tree with 'boxDrawingBranhing' -- the various options are used, try rendering a tree with 'boxDrawingBranhing'
-- and inspect the results. -- and inspect the results.