module Reflex.Vty.Widget.Box where
import Control.Monad.Fix (MonadFix)
import Data.Default
import Data.Text (Text)
import qualified Data.Text as T
import Graphics.Vty (Image)
import qualified Graphics.Vty as V
import Reflex
import Reflex.Vty.Widget
import Reflex.Vty.Widget.Text
hRule :: (HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => BoxStyle -> m ()
hRule :: BoxStyle -> m ()
hRule BoxStyle
boxStyle = Behavior t Char -> m ()
forall k (t :: k) (m :: * -> *).
(HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) =>
Behavior t Char -> m ()
fill (Behavior t Char -> m ()) -> Behavior t Char -> m ()
forall a b. (a -> b) -> a -> b
$ Char -> Behavior t Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BoxStyle -> Char
_boxStyle_s BoxStyle
boxStyle)
data BoxStyle = BoxStyle
{ BoxStyle -> Char
_boxStyle_nw :: Char
, BoxStyle -> Char
_boxStyle_n :: Char
, BoxStyle -> Char
_boxStyle_ne :: Char
, BoxStyle -> Char
_boxStyle_e :: Char
, BoxStyle -> Char
_boxStyle_se :: Char
, BoxStyle -> Char
_boxStyle_s :: Char
, BoxStyle -> Char
_boxStyle_sw :: Char
, BoxStyle -> Char
_boxStyle_w :: Char
}
instance Default BoxStyle where
def :: BoxStyle
def = BoxStyle
singleBoxStyle
hyphenBoxStyle :: BoxStyle
hyphenBoxStyle :: BoxStyle
hyphenBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle Char
'-' Char
'-' Char
'-' Char
'|' Char
'-' Char
'-' Char
'-' Char
'|'
singleBoxStyle :: BoxStyle
singleBoxStyle :: BoxStyle
singleBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle Char
'┌' Char
'─' Char
'┐' Char
'│' Char
'┘' Char
'─' Char
'└' Char
'│'
thickBoxStyle :: BoxStyle
thickBoxStyle :: BoxStyle
thickBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle Char
'┏' Char
'━' Char
'┓' Char
'┃' Char
'┛' Char
'━' Char
'┗' Char
'┃'
doubleBoxStyle :: BoxStyle
doubleBoxStyle :: BoxStyle
doubleBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle Char
'╔' Char
'═' Char
'╗' Char
'║' Char
'╝' Char
'═' Char
'╚' Char
'║'
roundedBoxStyle :: BoxStyle
roundedBoxStyle :: BoxStyle
roundedBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle Char
'╭' Char
'─' Char
'╮' Char
'│' Char
'╯' Char
'─' Char
'╰' Char
'│'
boxTitle :: (MonadFix m, MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m)
=> Behavior t BoxStyle
-> Behavior t Text
-> m a
-> m a
boxTitle :: Behavior t BoxStyle -> Behavior t Text -> m a -> m a
boxTitle Behavior t BoxStyle
boxStyle Behavior t Text
title m a
child = do
Dynamic t Int
dh <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayHeight
Dynamic t Int
dw <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
Behavior t Attr
bt <- m (Behavior t Attr)
forall k (t :: k) (m :: * -> *).
HasTheme t m =>
m (Behavior t Attr)
theme
let boxReg :: Dynamic t Region
boxReg = Int -> Int -> Int -> Int -> Region
Region Int
0 Int
0 (Int -> Int -> Region)
-> Dynamic t Int -> Dynamic t (Int -> Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
dw Dynamic t (Int -> Region) -> Dynamic t Int -> Dynamic t Region
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int
dh
innerReg :: Dynamic t Region
innerReg = Int -> Int -> Int -> Int -> Region
Region Int
1 Int
1 (Int -> Int -> Region)
-> Dynamic t Int -> Dynamic t (Int -> Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
2 (Int -> Int) -> Dynamic t Int -> Dynamic t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
dw) Dynamic t (Int -> Region) -> Dynamic t Int -> Dynamic t Region
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
2 (Int -> Int) -> Dynamic t Int -> Dynamic t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
dh)
Behavior t [Image] -> m ()
forall k (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages (Attr -> Text -> BoxStyle -> Region -> [Image]
boxImages (Attr -> Text -> BoxStyle -> Region -> [Image])
-> Behavior t Attr
-> Behavior t (Text -> BoxStyle -> Region -> [Image])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t Attr
bt Behavior t (Text -> BoxStyle -> Region -> [Image])
-> Behavior t Text -> Behavior t (BoxStyle -> Region -> [Image])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t Text
title Behavior t (BoxStyle -> Region -> [Image])
-> Behavior t BoxStyle -> Behavior t (Region -> [Image])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t BoxStyle
boxStyle Behavior t (Region -> [Image])
-> Behavior t Region -> Behavior t [Image]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Region -> Behavior t Region
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Region
boxReg)
Behavior t [Image] -> m ()
forall k (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages (Behavior t Region
-> Behavior t Attr
-> (Region -> Attr -> [Image])
-> Behavior t [Image]
forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 (Dynamic t Region -> Behavior t Region
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Region
innerReg) Behavior t Attr
bt (\Region
r Attr
attr -> [Attr -> Region -> Image
regionBlankImage Attr
attr Region
r]))
Dynamic t Region -> Dynamic t Bool -> m a -> m a
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasImageWriter t m,
HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Region -> Dynamic t Bool -> m a -> m a
pane Dynamic t Region
innerReg (Bool -> Dynamic t Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) m a
child
where
boxImages :: V.Attr -> Text -> BoxStyle -> Region -> [Image]
boxImages :: Attr -> Text -> BoxStyle -> Region -> [Image]
boxImages Attr
attr Text
title' BoxStyle
style (Region Int
left Int
top Int
width Int
height) =
let right :: Int
right = Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
bottom :: Int
bottom = Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
sides :: [Image]
sides =
[ Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
top (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
Attr -> Text -> Image
V.text' Attr
attr (Text -> Image) -> Text -> Image
forall a b. (a -> b) -> a -> b
$
Text -> Char -> Int -> Text
centerText Text
title' (BoxStyle -> Char
_boxStyle_n BoxStyle
style) (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
, Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
right (Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
1 (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
attr (BoxStyle -> Char
_boxStyle_e BoxStyle
style) Int
1 (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
, Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
bottom (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
attr (BoxStyle -> Char
_boxStyle_s BoxStyle
style) (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
1
, Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
left (Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
1 (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
attr (BoxStyle -> Char
_boxStyle_w BoxStyle
style) Int
1 (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
]
corners :: [Image]
corners =
[ Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
left Int
top Int
1 Int
1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
Attr -> Char -> Image
V.char Attr
attr (BoxStyle -> Char
_boxStyle_nw BoxStyle
style)
, Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
right Int
top Int
1 Int
1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
Attr -> Char -> Image
V.char Attr
attr (BoxStyle -> Char
_boxStyle_ne BoxStyle
style)
, Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
right Int
bottom Int
1 Int
1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
Attr -> Char -> Image
V.char Attr
attr (BoxStyle -> Char
_boxStyle_se BoxStyle
style)
, Region -> Image -> Image
withinImage (Int -> Int -> Int -> Int -> Region
Region Int
left Int
bottom Int
1 Int
1) (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$
Attr -> Char -> Image
V.char Attr
attr (BoxStyle -> Char
_boxStyle_sw BoxStyle
style)
]
in [Image]
sides [Image] -> [Image] -> [Image]
forall a. [a] -> [a] -> [a]
++ if Int
width Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Int
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then [Image]
corners else []
centerText
:: T.Text
-> Char
-> Int
-> T.Text
centerText :: Text -> Char -> Int -> Text
centerText Text
t Char
c Int
l = if Int
lt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l
then Text
t
else Text
left Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
right
where
lt :: Int
lt = Text -> Int
T.length Text
t
delta :: Int
delta = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lt
mkHalf :: Int -> Text
mkHalf Int
n = Int -> Text -> Text
T.replicate (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Char -> Text
T.singleton Char
c)
left :: Text
left = Int -> Text
mkHalf (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
right :: Text
right = Int -> Text
mkHalf Int
delta
box :: (MonadFix m, MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m)
=> Behavior t BoxStyle
-> m a
-> m a
box :: Behavior t BoxStyle -> m a -> m a
box Behavior t BoxStyle
boxStyle = Behavior t BoxStyle -> Behavior t Text -> m a -> m a
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
HasImageWriter t m, HasInput t m, HasFocusReader t m,
HasTheme t m) =>
Behavior t BoxStyle -> Behavior t Text -> m a -> m a
boxTitle Behavior t BoxStyle
boxStyle Behavior t Text
forall a. Monoid a => a
mempty
boxStatic
:: (MonadFix m, MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasFocusReader t m, HasTheme t m)
=> BoxStyle
-> m a
-> m a
boxStatic :: BoxStyle -> m a -> m a
boxStatic = Behavior t BoxStyle -> m a -> m a
forall k (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
HasImageWriter t m, HasInput t m, HasFocusReader t m,
HasTheme t m) =>
Behavior t BoxStyle -> m a -> m a
box (Behavior t BoxStyle -> m a -> m a)
-> (BoxStyle -> Behavior t BoxStyle) -> BoxStyle -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoxStyle -> Behavior t BoxStyle
forall (f :: * -> *) a. Applicative f => a -> f a
pure