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

Render nodes using new WidgetTree

Browse source
This commit is contained in:
Joscha 2020-02-09 09:48:21 +00:00
parent 4c63b96ae5
commit 6036ff4c77
3 changed files with 34 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

5
client/Main.hs
View file

@ -1,5 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
module Main where module Main where
import Brick import Brick
@ -14,6 +12,7 @@ import Forest.Api
import Forest.Client.NodeEditor import Forest.Client.NodeEditor
import Forest.Client.ResourceName import Forest.Client.ResourceName
import Forest.Client.Tree import Forest.Client.Tree
import Forest.Client.WidgetTree
import Forest.Node import Forest.Node
import Forest.Util import Forest.Util
@ -49,7 +48,7 @@ newClientState node = ClientState
} }
clientDraw :: ClientState -> [Widget ResourceName] clientDraw :: ClientState -> [Widget ResourceName]
clientDraw cs = [renderTree (csEditor cs) (csTree cs)] clientDraw cs = [renderTree boxDrawingBranching (csEditor cs) (csTree cs)]
clientHandleEvent :: ClientState -> BrickEvent ResourceName () -> EventM ResourceName (Next ClientState) clientHandleEvent :: ClientState -> BrickEvent ResourceName () -> EventM ResourceName (Next ClientState)
clientHandleEvent cs (VtyEvent (Vty.EvKey (Vty.KChar 'q') [])) = halt cs clientHandleEvent cs (VtyEvent (Vty.EvKey (Vty.KChar 'q') [])) = halt cs

56
src/Forest/Client/Node.hs
View file

@ -2,7 +2,7 @@
module Forest.Client.Node module Forest.Client.Node
( DrawState(..) ( DrawState(..)
, renderNode , nodeToTree
) where ) where
import Brick import Brick
@ -11,6 +11,7 @@ import qualified Data.Set as Set
import Forest.Client.NodeEditor import Forest.Client.NodeEditor
import Forest.Client.ResourceName import Forest.Client.ResourceName
import Forest.Client.WidgetTree
import Forest.Node import Forest.Node
data DrawState = DrawState data DrawState = DrawState
@ -19,44 +20,39 @@ data DrawState = DrawState
, dsUnfolded :: Set.Set Path , dsUnfolded :: Set.Set Path
} }
isFocused :: DrawState -> Bool
isFocused ds = (isLocalPath <$> dsFocused ds) == Just True
narrowDrawState :: NodeId -> DrawState -> DrawState narrowDrawState :: NodeId -> DrawState -> DrawState
narrowDrawState nodeId ds = ds narrowDrawState nodeId ds = ds
{ dsUnfolded = narrowSet nodeId $ dsUnfolded ds { dsUnfolded = narrowSet nodeId $ dsUnfolded ds
, dsFocused = narrowPath nodeId =<< dsFocused ds , dsFocused = narrowPath nodeId =<< dsFocused ds
} }
indent :: Widget n -> Widget n nodeToWidget :: Bool -> Node -> Widget ResourceName
indent = (txt "│ " <+>) nodeToWidget focused node =
let nodeWidget = txt $ nodeText node
expandStyle = if null (nodeChildren node) then "noexpand" else "expand"
focusStyle = if focused then "focus" else "nofocus"
in withAttr focusStyle $ withAttr expandStyle nodeWidget
drawSubnode :: NodeId -> DrawState -> Node -> Widget ResourceName subnodeToTree :: NodeId -> DrawState -> Node -> WidgetTree ResourceName
drawSubnode nodeId ds node = subnodeToTree nodeId ds node =
let newDs = narrowDrawState nodeId ds let newDs = narrowDrawState nodeId ds
in indent $ renderNode newDs node in nodeToTree newDs node
drawSubnodes :: DrawState -> Map.Map NodeId Node -> Widget ResourceName subnodesToTrees :: DrawState -> Map.Map NodeId Node -> [WidgetTree ResourceName]
drawSubnodes ds nodes = vBox $ subnodesToTrees ds nodes =
map (\(nodeId, node) -> drawSubnode nodeId ds node) $ map (\(nodeId, node) -> subnodeToTree nodeId ds node) $
Map.toAscList nodes Map.toAscList nodes
isFocused :: DrawState -> Bool nodeToTree :: DrawState -> Node -> WidgetTree ResourceName
isFocused ds = (isLocalPath <$> dsFocused ds) == Just True nodeToTree ds node = case dsEditor ds of
Nothing -> WidgetTree nodeWidget subnodeWidgets
drawNodeWithoutEditor :: DrawState -> Node -> Widget ResourceName Just ed
drawNodeWithoutEditor ds node | asReply ed -> WidgetTree nodeWidget (subnodeWidgets ++ [WidgetTree (renderNodeEditor ed) []])
| isFocused ds = withAttr "focused" nodeWidget <=> subnodesWidget | otherwise -> WidgetTree (renderNodeEditor ed) subnodeWidgets
| otherwise = nodeWidget <=> subnodesWidget
where where
nodeWidget = txt $ nodeText node focused = isFocused ds
subnodesWidget = drawSubnodes ds $ nodeChildren node nodeWidget = nodeToWidget focused node
subnodeWidgets = subnodesToTrees ds $ nodeChildren node
drawNodeWithEditor :: NodeEditor -> DrawState -> Node -> Widget ResourceName
drawNodeWithEditor ed ds node
| asReply ed = drawNodeWithoutEditor ds node <=> indent (renderNodeEditor ed)
| otherwise = renderNodeEditor ed <=> drawSubnodes ds (nodeChildren node)
renderNode :: DrawState -> Node -> Widget ResourceName
renderNode ds node
| isFocused ds = case dsEditor ds of
Nothing -> drawNodeWithoutEditor ds node
Just ed -> drawNodeWithEditor ed ds node
| otherwise = drawNodeWithoutEditor ds node

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

@ -14,6 +14,7 @@ import qualified Data.Set as Set
import Forest.Client.Node import Forest.Client.Node
import Forest.Client.NodeEditor import Forest.Client.NodeEditor
import Forest.Client.ResourceName import Forest.Client.ResourceName
import Forest.Client.WidgetTree
import Forest.Node import Forest.Node
data Tree = Tree data Tree = Tree
@ -29,12 +30,13 @@ newTree node = Tree
, treeUnfolded = Set.empty , treeUnfolded = Set.empty
} }
renderTree :: Maybe NodeEditor -> Tree -> Widget ResourceName renderTree :: IndentOptions -> Maybe NodeEditor -> Tree -> Widget ResourceName
renderTree maybeEditor tree = renderNode drawState $ treeNode tree renderTree opts maybeEditor tree =
renderWidgetTree opts $ nodeToTree drawState $ treeNode tree
where where
drawState = DrawState drawState = DrawState
{ dsEditor = maybeEditor { dsEditor = maybeEditor
, dsFocused = Just $ treeFocused tree , dsFocused = Just $ treeFocused tree
, dsUnfolded = treeUnfolded tree , dsUnfolded = treeUnfolded tree
} }