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:
parent
5d132b91c5
commit
235620d8c1
1 changed files with 27 additions and 8 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue