mirror of
https://github.com/ilyakooo0/reflex-vty.git
synced 2024-11-25 18:11:31 +03:00
theme box usage
This commit is contained in:
parent
214bfb18fd
commit
9862dfb4e1
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user