Fix widget tree

This fix took way too long. Something like this shouldn't be that difficult, but
it apparently is. :/
This commit is contained in:
Joscha 2020-02-09 21:19:28 +00:00
parent 5d132b91c5
commit 235620d8c1

View file

@ -11,18 +11,34 @@ module Forest.Client.WidgetTree
) where ) where
import Brick import Brick
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
data WidgetTree n = WidgetTree (Widget n) [WidgetTree n] data WidgetTree n = WidgetTree (Widget n) [WidgetTree n]
-- This attempts to properly indent multi-line widgets, though it's kinda hacky. addLoc :: Location -> Location -> Location
-- It seems to work though, so I'm not going to complain (until the first bugs addLoc l1 l2 =
-- appear, that is). let (x1, y1) = loc l1
-- (x2, y2) = loc l2
-- The text strings passed MUST NOT be multiline strings, or this entire in Location (x1 + x2, y1 + y2)
-- function will break.
offsetResult :: Location -> Result n -> Result n
offsetResult offset result = result
{ cursors = map offsetCursor $ cursors result
, visibilityRequests = map offsetVr $ visibilityRequests result
, extents = map offsetExtent $ extents result
, borders = translate offset $ borders result
}
where
offsetCursor c = c{cursorLocation = addLoc offset $ cursorLocation c}
offsetVr vr = vr{vrPosition = addLoc offset $ vrPosition vr}
offsetExtent e = e
{ extentUpperLeft = addLoc offset $ extentUpperLeft e
, extentOffset = addLoc offset $ extentOffset e
}
indentWith :: T.Text -> T.Text -> Widget n -> Widget n indentWith :: T.Text -> T.Text -> Widget n -> Widget n
indentWith firstLine otherLines wrapped = Widget indentWith firstLine otherLines wrapped = Widget
{ hSize = hSize wrapped { hSize = hSize wrapped
@ -35,8 +51,11 @@ indentWith firstLine otherLines wrapped = Widget
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 resultHeight = Vty.imageHeight $ image result
leftText = vBox $ txt firstLine : replicate (resultHeight - 1) (txt otherLines) textLines = firstLine : replicate (resultHeight - 1) otherLines
render $ leftText <+> wrapped leftImage = Vty.vertCat $ map (Vty.text' Vty.defAttr) textLines
newImage = leftImage Vty.<|> image result
newResult = offsetResult (Location (maxWidth, 0)) $ result{image=newImage}
pure newResult
indent :: IndentOptions -> [Widget n] -> Widget n indent :: IndentOptions -> [Widget n] -> Widget n
indent opts widgets = vBox $ reverse $ case reverse widgets of indent opts widgets = vBox $ reverse $ case reverse widgets of