{-|
  Description: Drawing boxes in various styles
-}
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

-- | Fill the background with the bottom box style
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)

-- | Defines a set of symbols to use to draw the outlines of boxes
-- C.f. https://en.wikipedia.org/wiki/Box-drawing_character
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

-- | A box style that uses hyphens and pipe characters. Doesn't handle
-- corners very well.
hyphenBoxStyle :: BoxStyle
hyphenBoxStyle :: BoxStyle
hyphenBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle Char
'-' Char
'-' Char
'-' Char
'|' Char
'-' Char
'-' Char
'-' Char
'|'

-- | A single line box style
singleBoxStyle :: BoxStyle
singleBoxStyle :: BoxStyle
singleBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle Char
'┌' Char
'─' Char
'┐' Char
'│' Char
'┘' Char
'─' Char
'└' Char
'│'

-- | A thick single line box style
thickBoxStyle :: BoxStyle
thickBoxStyle :: BoxStyle
thickBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle Char
'┏' Char
'━' Char
'┓' Char
'┃' Char
'┛' Char
'━' Char
'┗' Char
'┃'

-- | A double line box style
doubleBoxStyle :: BoxStyle
doubleBoxStyle :: BoxStyle
doubleBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle Char
'╔' Char
'═' Char
'╗' Char
'║' Char
'╝' Char
'═' Char
'╚' Char
'║'

-- | A single line box style with rounded corners
roundedBoxStyle :: BoxStyle
roundedBoxStyle :: BoxStyle
roundedBoxStyle = Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Char -> BoxStyle
BoxStyle Char
'╭' Char
'─' Char
'╮' Char
'│' Char
'╯' Char
'─' Char
'╰' Char
'│'

-- | Draws a titled box in the provided style and a child widget inside of that box
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 []

-- | Pad text  on the left and right with the given character so that it is
-- centered
centerText
  :: T.Text -- ^ Text to center
  -> Char -- ^ Padding character
  -> Int -- ^ Width
  -> T.Text -- ^ Padded 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

-- | A box without a title
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

-- | A box whose style is static
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