module Graphics.Vty.Widgets.Base
( (<++>)
, (<-->)
, hBox
, vBox
, hFill
, vFill
, hLimit
, vLimit
)
where
import GHC.Word ( Word )
import Graphics.Vty.Widgets.Rendering
( Widget(..)
, Render
, renderImg
, renderMany
, renderWidth
, renderHeight
, Orientation(..)
, withHeight
, withWidth
)
import Graphics.Vty
( DisplayRegion
, Attr
, char_fill
, region_width
, region_height
)
vFill :: Attr -> Char -> Widget
vFill att c = Widget {
growHorizontal = False
, growVertical = True
, primaryAttribute = att
, withAttribute = flip vFill c
, render = \s -> renderImg $ char_fill att c (region_width s)
(region_height s)
}
hFill :: Attr -> Char -> Int -> Widget
hFill att c h = Widget {
growHorizontal = True
, growVertical = False
, primaryAttribute = att
, withAttribute = \att' -> hFill att' c h
, render = \s -> renderImg $ char_fill att c (region_width s)
(toEnum h)
}
box :: Orientation -> Widget -> Widget -> Widget
box o a b = Widget {
growHorizontal = growHorizontal a || growHorizontal b
, growVertical = growVertical a || growVertical b
, withAttribute =
\att ->
box o (withAttribute a att) (withAttribute b att)
, primaryAttribute = primaryAttribute a
, render =
\s -> case o of
Vertical ->
renderBox s (a, b) o growVertical region_height
renderHeight withHeight
Horizontal ->
renderBox s (a, b) o growHorizontal region_width
renderWidth withWidth
}
renderBox :: DisplayRegion
-> (Widget, Widget)
-> Orientation
-> (Widget -> Bool)
-> (DisplayRegion -> Word)
-> (Render -> Word)
-> (DisplayRegion -> Word -> DisplayRegion)
-> Render
renderBox s (first, second) orientation grow regDimension renderDimension withDim =
renderMany orientation ws
where
ws = case (grow first, grow second) of
(True, True) -> renderHalves
(False, _) -> renderOrdered first second
(_, False) -> let [a, b] = renderOrdered second first
in [b, a]
renderHalves = let half = s `withDim` div (regDimension s) 2
half' = if regDimension s `mod` 2 == 0
then half
else half `withDim` (regDimension half + 1)
in [ render first half
, render second half' ]
renderOrdered a b = let renderedA = render a s
renderedB = render b s'
remaining = regDimension s renderDimension renderedA
s' = s `withDim` remaining
in if renderDimension renderedA >= regDimension s
then [renderedA]
else [renderedA, renderedB]
hBox :: Widget -> Widget -> Widget
hBox = box Horizontal
(<++>) :: Widget -> Widget -> Widget
(<++>) = hBox
vBox :: Widget -> Widget -> Widget
vBox = box Vertical
(<-->) :: Widget -> Widget -> Widget
(<-->) = vBox
hLimit :: Int -> Widget -> Widget
hLimit maxWidth w = w { growHorizontal = False
, render = restrictedRender
}
where
restrictedRender sz =
if region_width sz < fromIntegral maxWidth
then render w sz
else render w $ sz `withWidth` fromIntegral maxWidth
vLimit :: Int -> Widget -> Widget
vLimit maxHeight w = w { growVertical = False
, render = restrictedRender
}
where
restrictedRender sz =
if region_height sz < fromIntegral maxHeight
then render w sz
else render w $ sz `withHeight` fromIntegral maxHeight