{-# LANGUAGE TemplateHaskell #-}
module Swarm.TUI.Border (
HBorderLabels,
plainHBorder,
leftLabel,
centerLabel,
rightLabel,
BorderLabels,
plainBorder,
topLabels,
bottomLabels,
hBorderWithLabels,
borderWithLabels,
) where
import Brick
import Brick.Widgets.Border
import Control.Lens (makeLenses, to, (^.))
import Data.Function ((&))
import Graphics.Vty qualified as V
data HBorderLabels n = HBorderLabels
{ forall n. HBorderLabels n -> Maybe (Widget n)
_leftLabel :: Maybe (Widget n)
, forall n. HBorderLabels n -> Maybe (Widget n)
_centerLabel :: Maybe (Widget n)
, forall n. HBorderLabels n -> Maybe (Widget n)
_rightLabel :: Maybe (Widget n)
}
plainHBorder :: HBorderLabels n
plainHBorder :: forall n. HBorderLabels n
plainHBorder = forall n.
Maybe (Widget n)
-> Maybe (Widget n) -> Maybe (Widget n) -> HBorderLabels n
HBorderLabels forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
data BorderLabels n = BorderLabels
{ forall n. BorderLabels n -> HBorderLabels n
_topLabels :: HBorderLabels n
, forall n. BorderLabels n -> HBorderLabels n
_bottomLabels :: HBorderLabels n
}
plainBorder :: BorderLabels n
plainBorder :: forall n. BorderLabels n
plainBorder = forall n. HBorderLabels n -> HBorderLabels n -> BorderLabels n
BorderLabels forall n. HBorderLabels n
plainHBorder forall n. HBorderLabels n
plainHBorder
makeLenses ''HBorderLabels
makeLenses ''BorderLabels
hBorderWithLabels ::
HBorderLabels n -> Widget n
hBorderWithLabels :: forall n. HBorderLabels n -> Widget n
hBorderWithLabels (HBorderLabels Maybe (Widget n)
l Maybe (Widget n)
c Maybe (Widget n)
r) =
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
let renderLabel :: Maybe (Widget n) -> RenderM n (Result n)
renderLabel = forall n. Widget n -> RenderM n (Result n)
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall n. Widget n
emptyWidget (forall n. Int -> Widget n -> Widget n
vLimit Int
1)
Result n
rl <- forall {n}. Maybe (Widget n) -> RenderM n (Result n)
renderLabel Maybe (Widget n)
l
Result n
rc <- forall {n}. Maybe (Widget n) -> RenderM n (Result n)
renderLabel Maybe (Widget n)
c
Result n
rr <- forall {n}. Maybe (Widget n) -> RenderM n (Result n)
renderLabel Maybe (Widget n)
r
Context n
ctx <- forall n. RenderM n (Context n)
getContext
let w :: Int
w = Context n
ctx forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Context n) Int
availWidthL
lw :: Int
lw = Image -> Int
V.imageWidth (forall n. Result n -> Image
image Result n
rl)
cw :: Int
cw = Image -> Int
V.imageWidth (forall n. Result n -> Image
image Result n
rc)
forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$
forall n. [Widget n] -> Widget n
hBox
[ forall n. Int -> Widget n -> Widget n
hLimit Int
2 forall n. Widget n
hBorder
, forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (forall (m :: * -> *) a. Monad m => a -> m a
return Result n
rl)
,
forall n. Int -> Widget n -> Widget n
hLimit (Int
w forall a. Integral a => a -> a -> a
`div` Int
2 forall a. Num a => a -> a -> a
- Int
2 forall a. Num a => a -> a -> a
- Int
lw forall a. Num a => a -> a -> a
- (Int
cw forall a. Num a => a -> a -> a
+ Int
1) forall a. Integral a => a -> a -> a
`div` Int
2) forall n. Widget n
hBorder
, forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (forall (m :: * -> *) a. Monad m => a -> m a
return Result n
rc)
,
forall n. Widget n
hBorder
, forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (forall (m :: * -> *) a. Monad m => a -> m a
return Result n
rr)
, forall n. Int -> Widget n -> Widget n
hLimit Int
2 forall n. Widget n
hBorder
]
borderWithLabels :: BorderLabels n -> Widget n -> Widget n
borderWithLabels :: forall n. BorderLabels n -> Widget n -> Widget n
borderWithLabels BorderLabels n
labels Widget n
wrapped =
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (forall n. Widget n -> Size
hSize Widget n
wrapped) (forall n. Widget n -> Size
vSize Widget n
wrapped) forall a b. (a -> b) -> a -> b
$ do
Context n
c <- forall n. RenderM n (Context n)
getContext
Result n
middleResult <-
Widget n
wrapped
forall a b. a -> (a -> b) -> b
& forall n. Int -> Widget n -> Widget n
vLimit (Context n
c forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Context n) Int
availHeightL forall a. Num a => a -> a -> a
- Int
2)
forall a b. a -> (a -> b) -> b
& forall n. Int -> Widget n -> Widget n
hLimit (Context n
c forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Context n) Int
availWidthL forall a. Num a => a -> a -> a
- Int
2)
forall a b. a -> (a -> b) -> b
& forall n. Widget n -> RenderM n (Result n)
render
let tl :: Widget n
tl = forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
False Bool
True)
tr :: Widget n
tr = forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
True Bool
False)
bl :: Widget n
bl = forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
False Bool
True)
br :: Widget n
br = forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
True Bool
False)
top :: Widget n
top = forall n. Widget n
tl forall n. Widget n -> Widget n -> Widget n
<+> forall n. HBorderLabels n -> Widget n
hBorderWithLabels (BorderLabels n
labels forall s a. s -> Getting a s a -> a
^. forall n. Lens' (BorderLabels n) (HBorderLabels n)
topLabels) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n
tr
bottom :: Widget n
bottom = forall n. Widget n
bl forall n. Widget n -> Widget n -> Widget n
<+> forall n. HBorderLabels n -> Widget n
hBorderWithLabels (BorderLabels n
labels forall s a. s -> Getting a s a -> a
^. forall n. Lens' (BorderLabels n) (HBorderLabels n)
bottomLabels) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n
br
middle :: Widget n
middle = forall n. Widget n
vBorder forall n. Widget n -> Widget n -> Widget n
<+> forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (forall (m :: * -> *) a. Monad m => a -> m a
return Result n
middleResult) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n
vBorder
total :: Widget n
total = Widget n
top forall n. Widget n -> Widget n -> Widget n
<=> Widget n
middle forall n. Widget n -> Widget n -> Widget n
<=> Widget n
bottom
Widget n
total
forall a b. a -> (a -> b) -> b
& forall n. Int -> Widget n -> Widget n
vLimit (Result n
middleResult forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Result n) Image
imageL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Image -> Int
V.imageHeight forall a. Num a => a -> a -> a
+ Int
2)
forall a b. a -> (a -> b) -> b
& forall n. Int -> Widget n -> Widget n
hLimit (Result n
middleResult forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Result n) Image
imageL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Image -> Int
V.imageWidth forall a. Num a => a -> a -> a
+ Int
2)
forall a b. a -> (a -> b) -> b
& forall n. Widget n -> RenderM n (Result n)
render