theme box usage

This commit is contained in:
pdlla 2021-04-11 16:46:58 -07:00
parent 214bfb18fd
commit 9862dfb4e1
2 changed files with 21 additions and 18 deletions

View File

@ -237,9 +237,9 @@ regionSize :: Region -> (Int, Int)
regionSize (Region _ _ w h) = (w, h) regionSize (Region _ _ w h) = (w, h)
-- | Produces an 'Image' that fills a region with space characters -- | Produces an 'Image' that fills a region with space characters
regionBlankImage :: Region -> Image regionBlankImage :: V.Attr -> Region -> Image
regionBlankImage r@(Region _ _ width height) = regionBlankImage attr r@(Region _ _ width height) =
withinImage r $ V.charFill V.defAttr ' ' width height withinImage r $ V.charFill attr ' ' width height
-- | A class for things that know their own display size dimensions -- | A class for things that know their own display size dimensions
class (Reflex t, Monad m) => HasDisplayRegion t m | m -> t where class (Reflex t, Monad m) => HasDisplayRegion t m | m -> t where

View File

@ -54,7 +54,7 @@ roundedBoxStyle :: BoxStyle
roundedBoxStyle = BoxStyle '╭' '─' '╮' '│' '╯' '─' '╰' '│' roundedBoxStyle = BoxStyle '╭' '─' '╮' '│' '╯' '─' '╰' '│'
-- | Draws a titled box in the provided style and a child widget inside of that box -- | Draws a titled box in the provided style and a child widget inside of that box
boxTitle :: (Monad m, Reflex t ,HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m) boxTitle :: (Monad m, Reflex t ,HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m)
=> Behavior t BoxStyle => Behavior t BoxStyle
-> Behavior t Text -> Behavior t Text
-> m a -> m a
@ -62,36 +62,39 @@ boxTitle :: (Monad m, Reflex t ,HasDisplayRegion t m, HasImageWriter t m, HasInp
boxTitle boxStyle title child = do boxTitle boxStyle title child = do
dh <- displayHeight dh <- displayHeight
dw <- displayWidth dw <- displayWidth
bt <- theme
let boxReg = Region 0 0 <$> dw <*> dh let boxReg = Region 0 0 <$> dw <*> dh
innerReg = Region 1 1 <$> (subtract 2 <$> dw) <*> (subtract 2 <$> dh) innerReg = Region 1 1 <$> (subtract 2 <$> dw) <*> (subtract 2 <$> dh)
tellImages (boxImages <$> title <*> boxStyle <*> current boxReg)
tellImages (fmap (\r -> [regionBlankImage r]) (current innerReg)) tellImages (boxImages <$> bt <*> title <*> boxStyle <*> current boxReg)
tellImages (ffor2 (current innerReg) bt (\r attr -> [regionBlankImage attr r]))
pane innerReg (pure True) child pane innerReg (pure True) child
where where
boxImages :: Text -> BoxStyle -> Region -> [Image] boxImages :: V.Attr -> Text -> BoxStyle -> Region -> [Image]
boxImages title' style (Region left top width height) = boxImages attr title' style (Region left top width height) =
let right = left + width - 1 let right = left + width - 1
bottom = top + height - 1 bottom = top + height - 1
sides = sides =
[ withinImage (Region (left + 1) top (width - 2) 1) $ [ withinImage (Region (left + 1) top (width - 2) 1) $
V.text' V.defAttr $ V.text' attr $
hPadText title' (_boxStyle_n style) (width - 2) hPadText title' (_boxStyle_n style) (width - 2)
, withinImage (Region right (top + 1) 1 (height - 2)) $ , withinImage (Region right (top + 1) 1 (height - 2)) $
V.charFill V.defAttr (_boxStyle_e style) 1 (height - 2) V.charFill attr (_boxStyle_e style) 1 (height - 2)
, withinImage (Region (left + 1) bottom (width - 2) 1) $ , withinImage (Region (left + 1) bottom (width - 2) 1) $
V.charFill V.defAttr (_boxStyle_s style) (width - 2) 1 V.charFill attr (_boxStyle_s style) (width - 2) 1
, withinImage (Region left (top + 1) 1 (height - 2)) $ , withinImage (Region left (top + 1) 1 (height - 2)) $
V.charFill V.defAttr (_boxStyle_w style) 1 (height - 2) V.charFill attr (_boxStyle_w style) 1 (height - 2)
] ]
corners = corners =
[ withinImage (Region left top 1 1) $ [ withinImage (Region left top 1 1) $
V.char V.defAttr (_boxStyle_nw style) V.char attr (_boxStyle_nw style)
, withinImage (Region right top 1 1) $ , withinImage (Region right top 1 1) $
V.char V.defAttr (_boxStyle_ne style) V.char attr (_boxStyle_ne style)
, withinImage (Region right bottom 1 1) $ , withinImage (Region right bottom 1 1) $
V.char V.defAttr (_boxStyle_se style) V.char attr (_boxStyle_se style)
, withinImage (Region left bottom 1 1) $ , withinImage (Region left bottom 1 1) $
V.char V.defAttr (_boxStyle_sw style) V.char attr (_boxStyle_sw style)
] ]
in sides ++ if width > 1 && height > 1 then corners else [] in sides ++ if width > 1 && height > 1 then corners else []
hPadText :: T.Text -> Char -> Int -> T.Text hPadText :: T.Text -> Char -> Int -> T.Text
@ -106,7 +109,7 @@ boxTitle boxStyle title child = do
right = mkHalf delta right = mkHalf delta
-- | A box without a title -- | A box without a title
box :: (Monad m, Reflex t, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m) box :: (Monad m, Reflex t, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m)
=> Behavior t BoxStyle => Behavior t BoxStyle
-> m a -> m a
-> m a -> m a
@ -114,7 +117,7 @@ box boxStyle = boxTitle boxStyle mempty
-- | A box whose style is static -- | A box whose style is static
boxStatic boxStatic
:: (Monad m, Reflex t, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m) :: (Monad m, Reflex t, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m)
=> BoxStyle => BoxStyle
-> m a -> m a
-> m a -> m a