{-# LANGUAGE OverloadedStrings #-}
module Brick.Widgets.Border
(
border
, borderWithLabel
, hBorder
, hBorderWithLabel
, vBorder
, borderElem
, borderAttr
, hBorderAttr
, vBorderAttr
, joinableBorder
)
where
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import Lens.Micro ((^.), (&), (.~), to)
import Graphics.Vty (imageHeight, imageWidth)
import Brick.AttrMap
import Brick.Types
import Brick.Widgets.Core
import Brick.Widgets.Border.Style (BorderStyle(..))
import Brick.Widgets.Internal (renderDynBorder)
import Data.IMap (Run(..))
import qualified Brick.BorderMap as BM
borderAttr :: AttrName
borderAttr :: AttrName
borderAttr = String -> AttrName
attrName String
"border"
hBorderAttr :: AttrName
hBorderAttr :: AttrName
hBorderAttr = AttrName
borderAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"horizontal"
vBorderAttr :: AttrName
vBorderAttr :: AttrName
vBorderAttr = AttrName
borderAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"vertical"
borderElem :: (BorderStyle -> Char) -> Widget n
borderElem :: forall n. (BorderStyle -> Char) -> Widget n
borderElem BorderStyle -> Char
f =
Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
BorderStyle
bs <- Context n -> BorderStyle
forall n. Context n -> BorderStyle
ctxBorderStyle (Context n -> BorderStyle)
-> ReaderT (Context n) (State (RenderState n)) (Context n)
-> ReaderT (Context n) (State (RenderState n)) BorderStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Context n) (State (RenderState n)) (Context n)
forall n. RenderM n (Context n)
getContext
Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
borderAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str [BorderStyle -> Char
f BorderStyle
bs]
border :: Widget n -> Widget n
border :: forall n. Widget n -> Widget n
border = Maybe (Widget n) -> Widget n -> Widget n
forall n. Maybe (Widget n) -> Widget n -> Widget n
border_ Maybe (Widget n)
forall a. Maybe a
Nothing
borderWithLabel :: Widget n
-> Widget n
-> Widget n
borderWithLabel :: forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget n
label = Maybe (Widget n) -> Widget n -> Widget n
forall n. Maybe (Widget n) -> Widget n -> Widget n
border_ (Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just Widget n
label)
border_ :: Maybe (Widget n) -> Widget n -> Widget n
border_ :: forall n. Maybe (Widget n) -> Widget n -> Widget n
border_ Maybe (Widget n)
label Widget n
wrapped =
Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
wrapped) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
wrapped) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
Result n
middleResult <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit (Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
(Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit (Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
(Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n
wrapped
let tl :: Widget n
tl = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
False Bool
True)
tr :: Widget n
tr = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
True Bool
False)
bl :: Widget n
bl = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
False Bool
True)
br :: Widget n
br = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
True Bool
False)
top :: Widget n
top = Widget n
forall {n}. Widget n
tl Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n -> (Widget n -> Widget n) -> Maybe (Widget n) -> Widget n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget n
forall {n}. Widget n
hBorder Widget n -> Widget n
forall n. Widget n -> Widget n
hBorderWithLabel Maybe (Widget n)
label Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall {n}. Widget n
tr
bottom :: Widget n
bottom = Widget n
forall {n}. Widget n
bl Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall {n}. Widget n
hBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall {n}. Widget n
br
middle :: Widget n
middle = Widget n
forall {n}. Widget n
vBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
middleResult) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall {n}. Widget n
vBorder
total :: Widget n
total = Widget n
top Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
middle Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall {n}. Widget n
bottom
Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit (Result n
middleResultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
(Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit (Result n
middleResultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
(Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n
total
hBorder :: Widget n
hBorder :: forall {n}. Widget n
hBorder =
AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
borderAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Context n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
let bs :: BorderStyle
bs = Context n -> BorderStyle
forall n. Context n -> BorderStyle
ctxBorderStyle Context n
ctx
w :: Int
w = Context n -> Int
forall n. Context n -> Int
availWidth Context n
ctx
DynBorder
db <- Edges Bool -> RenderM n DynBorder
forall n. Edges Bool -> RenderM n DynBorder
dynBorderFromDirections (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
False Bool
True Bool
True)
let dynBorders :: BorderMap DynBorder
dynBorders = Location
-> Run DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
forall a. Location -> Run a -> BorderMap a -> BorderMap a
BM.insertH Location
forall a. Monoid a => a
mempty (Int -> DynBorder -> Run DynBorder
forall a. Int -> a -> Run a
Run Int
w DynBorder
db)
(BorderMap DynBorder -> BorderMap DynBorder)
-> BorderMap DynBorder -> BorderMap DynBorder
forall a b. (a -> b) -> a -> b
$ Edges Int -> BorderMap DynBorder
forall a. Edges Int -> BorderMap a
BM.emptyCoordinates (Int -> Int -> Int -> Int -> Edges Int
forall a. a -> a -> a -> a -> Edges a
Edges Int
0 Int
0 Int
0 (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
forall n.
BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
setDynBorders BorderMap DynBorder
dynBorders (RenderM n (Result n) -> RenderM n (Result n))
-> RenderM n (Result n) -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
hBorderAttr
(Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Char -> Widget n
forall n. Char -> Widget n
fill (BorderStyle -> Char
bsHorizontal BorderStyle
bs)
hBorderWithLabel :: Widget n
-> Widget n
hBorderWithLabel :: forall n. Widget n -> Widget n
hBorderWithLabel Widget n
label =
Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Result n
res <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 Widget n
label
Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [Widget n
forall {n}. Widget n
hBorder, Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
res), Widget n
forall {n}. Widget n
hBorder]
vBorder :: Widget n
vBorder :: forall {n}. Widget n
vBorder =
AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
borderAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Greedy (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Context n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
let bs :: BorderStyle
bs = Context n -> BorderStyle
forall n. Context n -> BorderStyle
ctxBorderStyle Context n
ctx
h :: Int
h = Context n -> Int
forall n. Context n -> Int
availHeight Context n
ctx
DynBorder
db <- Edges Bool -> RenderM n DynBorder
forall n. Edges Bool -> RenderM n DynBorder
dynBorderFromDirections (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
True Bool
False Bool
False)
let dynBorders :: BorderMap DynBorder
dynBorders = Location
-> Run DynBorder -> BorderMap DynBorder -> BorderMap DynBorder
forall a. Location -> Run a -> BorderMap a -> BorderMap a
BM.insertV Location
forall a. Monoid a => a
mempty (Int -> DynBorder -> Run DynBorder
forall a. Int -> a -> Run a
Run Int
h DynBorder
db)
(BorderMap DynBorder -> BorderMap DynBorder)
-> BorderMap DynBorder -> BorderMap DynBorder
forall a b. (a -> b) -> a -> b
$ Edges Int -> BorderMap DynBorder
forall a. Edges Int -> BorderMap a
BM.emptyCoordinates (Int -> Int -> Int -> Int -> Edges Int
forall a. a -> a -> a -> a -> Edges a
Edges Int
0 (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0 Int
0)
BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
forall n.
BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
setDynBorders BorderMap DynBorder
dynBorders (RenderM n (Result n) -> RenderM n (Result n))
-> RenderM n (Result n) -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
vBorderAttr
(Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Char -> Widget n
forall n. Char -> Widget n
fill (BorderStyle -> Char
bsVertical BorderStyle
bs)
dynBorderFromDirections :: Edges Bool -> RenderM n DynBorder
dynBorderFromDirections :: forall n. Edges Bool -> RenderM n DynBorder
dynBorderFromDirections Edges Bool
dirs = do
Context n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
DynBorder -> RenderM n DynBorder
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return DynBorder
{ dbStyle :: BorderStyle
dbStyle = Context n -> BorderStyle
forall n. Context n -> BorderStyle
ctxBorderStyle Context n
ctx
, dbAttr :: Attr
dbAttr = AttrName -> AttrMap -> Attr
attrMapLookup (Context n -> AttrName
forall n. Context n -> AttrName
ctxAttrName Context n
ctx) (Context n -> AttrMap
forall n. Context n -> AttrMap
ctxAttrMap Context n
ctx)
, dbSegments :: Edges BorderSegment
dbSegments = (\Bool
draw -> Bool -> Bool -> Bool -> BorderSegment
BorderSegment Bool
True Bool
draw Bool
draw) (Bool -> BorderSegment) -> Edges Bool -> Edges BorderSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Edges Bool
dirs
}
setDynBorders :: BM.BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
setDynBorders :: forall n.
BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
setDynBorders BorderMap DynBorder
newBorders RenderM n (Result n)
act = do
Bool
dyn <- Context n -> Bool
forall n. Context n -> Bool
ctxDynBorders (Context n -> Bool)
-> ReaderT (Context n) (State (RenderState n)) (Context n)
-> ReaderT (Context n) (State (RenderState n)) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Context n) (State (RenderState n)) (Context n)
forall n. RenderM n (Context n)
getContext
Result n
res <- RenderM n (Result n)
act
Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result n -> RenderM n (Result n))
-> Result n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ if Bool
dyn
then Result n
res Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (BorderMap DynBorder -> Identity (BorderMap DynBorder))
-> Result n -> Identity (Result n)
forall n (f :: * -> *).
Functor f =>
(BorderMap DynBorder -> f (BorderMap DynBorder))
-> Result n -> f (Result n)
bordersL ((BorderMap DynBorder -> Identity (BorderMap DynBorder))
-> Result n -> Identity (Result n))
-> BorderMap DynBorder -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BorderMap DynBorder
newBorders
else Result n
res
joinableBorder :: Edges Bool -> Widget n
joinableBorder :: forall n. Edges Bool -> Widget n
joinableBorder Edges Bool
dirs = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
borderAttr (Widget n -> Widget n)
-> (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n)
-> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
DynBorder
db <- Edges Bool -> RenderM n DynBorder
forall n. Edges Bool -> RenderM n DynBorder
dynBorderFromDirections Edges Bool
dirs
BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
forall n.
BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)
setDynBorders
(Location -> DynBorder -> BorderMap DynBorder
forall a. Location -> a -> BorderMap a
BM.singleton Location
forall a. Monoid a => a
mempty DynBorder
db)
(Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Image -> Widget n
forall n. Image -> Widget n
raw (DynBorder -> Image
renderDynBorder DynBorder
db)))