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

Add attribute map and fix drawing

Browse source
This commit is contained in:
Joscha 2020-02-09 10:01:46 +00:00
parent 6036ff4c77
commit 54ec7afa59
2 changed files with 11 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

10
client/Main.hs
View file

@ -1,3 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
module Main where module Main where
import Brick import Brick
@ -54,13 +56,19 @@ clientHandleEvent :: ClientState -> BrickEvent ResourceName () -> EventM Resourc
clientHandleEvent cs (VtyEvent (Vty.EvKey (Vty.KChar 'q') [])) = halt cs clientHandleEvent cs (VtyEvent (Vty.EvKey (Vty.KChar 'q') [])) = halt cs
clientHandleEvent cs _ = continue cs clientHandleEvent cs _ = continue cs
clientAttrMap :: AttrMap
clientAttrMap = attrMap Vty.defAttr
[ ("expand", Vty.currentAttr `Vty.withStyle` Vty.bold `Vty.withForeColor` Vty.yellow)
, ("focus", Vty.currentAttr `Vty.withBackColor` Vty.blue)
]
clientApp :: App ClientState () ResourceName clientApp :: App ClientState () ResourceName
clientApp = App clientApp = App
{ appDraw = clientDraw { appDraw = clientDraw
, appChooseCursor = showFirstCursor , appChooseCursor = showFirstCursor
, appHandleEvent = clientHandleEvent , appHandleEvent = clientHandleEvent
, appStartEvent = pure , appStartEvent = pure
, appAttrMap = const $ attrMap Vty.defAttr [] , appAttrMap = const clientAttrMap
} }
main :: IO () main :: IO ()

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

@ -34,7 +34,7 @@ nodeToWidget focused node =
let nodeWidget = txt $ nodeText node let nodeWidget = txt $ nodeText node
expandStyle = if null (nodeChildren node) then "noexpand" else "expand" expandStyle = if null (nodeChildren node) then "noexpand" else "expand"
focusStyle = if focused then "focus" else "nofocus" focusStyle = if focused then "focus" else "nofocus"
in withAttr focusStyle $ withAttr expandStyle nodeWidget in withDefAttr focusStyle $ withDefAttr expandStyle nodeWidget
subnodeToTree :: NodeId -> DrawState -> Node -> WidgetTree ResourceName subnodeToTree :: NodeId -> DrawState -> Node -> WidgetTree ResourceName
subnodeToTree nodeId ds node = subnodeToTree nodeId ds node =
@ -50,6 +50,7 @@ nodeToTree :: DrawState -> Node -> WidgetTree ResourceName
nodeToTree ds node = case dsEditor ds of nodeToTree ds node = case dsEditor ds of
Nothing -> WidgetTree nodeWidget subnodeWidgets Nothing -> WidgetTree nodeWidget subnodeWidgets
Just ed Just ed
| not focused -> WidgetTree nodeWidget subnodeWidgets
| asReply ed -> WidgetTree nodeWidget (subnodeWidgets ++ [WidgetTree (renderNodeEditor ed) []]) | asReply ed -> WidgetTree nodeWidget (subnodeWidgets ++ [WidgetTree (renderNodeEditor ed) []])
| otherwise -> WidgetTree (renderNodeEditor ed) subnodeWidgets | otherwise -> WidgetTree (renderNodeEditor ed) subnodeWidgets
where where