-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Swarm.TUI.Border
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Special border drawing functions that can include labels in more
-- places than just the top center.
module Swarm.TUI.Border (
  -- * Horizontal border labels
  HBorderLabels,
  plainHBorder,
  leftLabel,
  centerLabel,
  rightLabel,

  -- * Rectangular border labels
  BorderLabels,
  plainBorder,
  topLabels,
  bottomLabels,

  -- * Border-drawing functions
  hBorderWithLabels,
  borderWithLabels,
) where

import Brick
import Brick.Widgets.Border
import Control.Lens (makeLenses, to, (^.))
import Data.Function ((&))
import Graphics.Vty qualified as V

-- | Labels for a horizontal border, with optional left, middle, and
--   right labels.
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)
  }

-- | A plain horizontal border with no labels.
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

-- | Labels for a rectangular border, with optional left, middle, and
--   right labels on the top and bottom.
data BorderLabels n = BorderLabels
  { forall n. BorderLabels n -> HBorderLabels n
_topLabels :: HBorderLabels n
  , forall n. BorderLabels n -> HBorderLabels n
_bottomLabels :: HBorderLabels n
  }

-- | A plain rectangular border with no labels.
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

-- | Draw a horizontal border with three optional labels.  The left
--   label (if present) will be placed two units away from the left
--   end of the border, and the right label will be placed two units
--   away from the right end.  The center label, if present, will
--   always be centered in the border overall, regardless of the width
--   of the left and right labels.  This ensures that when the labels
--   change width, they do not cause the other labels to wiggle.
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

    -- Figure out how wide the whole border is supposed to be
    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

        -- Get the widths of the labels
        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)

    -- Now render the border with labels.
    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)
        , -- We calculate the specific width of border between the left
          -- and center labels needed to ensure that the center label is
          -- in the right place.  Note, using (cw + 1) `div` 2, as
          -- opposed to cw `div` 2, means that the placement of the
          -- center label will be left-biased: if it does not fit
          -- exactly at the center it will be placed just to the left of
          -- center.
          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)
        , -- The border between center and right greedily fills up any
          -- remaining width.
          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
        ]

-- | Put a rectangular border around the specified widget with the
--   specified label widgets placed around the border.
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