-- | This module provides combinators for centering other widgets.
module Brick.Widgets.Center
  ( -- * Centering horizontally
    hCenter
  , hCenterWith
  , hCenterLayer
  -- * Centering vertically
  , vCenter
  , vCenterWith
  , vCenterLayer
  -- * Centering both horizontally and vertically
  , center
  , centerWith
  , centerLayer
  -- * Centering about an arbitrary origin
  , centerAbout
  )
where

import Lens.Micro ((^.), (&), (.~), to)
import Data.Maybe (fromMaybe)
import Graphics.Vty (imageWidth, imageHeight, horizCat, charFill, vertCat,
                    translateX, translateY)

import Brick.Types
import Brick.Widgets.Core

-- | Center the specified widget horizontally. Consumes all available
-- horizontal space.
hCenter :: Widget n -> Widget n
hCenter :: Widget n -> Widget n
hCenter = Maybe Char -> Widget n -> Widget n
forall n. Maybe Char -> Widget n -> Widget n
hCenterWith Maybe Char
forall a. Maybe a
Nothing

-- | Center the specified widget horizontally using a Vty image
-- translation. Consumes all available horizontal space. Unlike hCenter,
-- this does not fill the surrounding space so it is suitable for use
-- as a layer. Layers underneath this widget will be visible in regions
-- surrounding the centered widget.
hCenterLayer :: Widget n -> Widget n
hCenterLayer :: Widget n -> Widget n
hCenterLayer Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
        Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
        let rWidth :: Int
rWidth = Result n
resultResult 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. Lens' (Result n) Image
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
            leftPaddingAmount :: Int
leftPaddingAmount = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (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. Lens' (Context n) Int
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rWidth) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
            paddedImage :: Image
paddedImage = Int -> Image -> Image
translateX Int
leftPaddingAmount (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$ Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL
            off :: Location
off = (Int, Int) -> Location
Location (Int
leftPaddingAmount, Int
0)
        if Int
leftPaddingAmount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
            Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result else
            Result n -> RenderM n (Result n)
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
$ Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addResultOffset Location
off
                   (Result n -> Result n) -> Result n -> Result n
forall a b. (a -> b) -> a -> b
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
paddedImage

-- | Center the specified widget horizontally. Consumes all available
-- horizontal space. Uses the specified character to fill in the space
-- to either side of the centered widget (defaults to space).
hCenterWith :: Maybe Char -> Widget n -> Widget n
hCenterWith :: Maybe Char -> Widget n -> Widget n
hCenterWith Maybe Char
mChar Widget n
p =
    let ch :: Char
ch = Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' Maybe Char
mChar
    in Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
p) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
           Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
           Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
           let rWidth :: Int
rWidth = Result n
resultResult 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. Lens' (Result n) Image
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
               rHeight :: Int
rHeight = Result n
resultResult 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. Lens' (Result n) Image
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
               remainder :: Int
remainder = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ 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. Lens' (Context n) Int
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
leftPaddingAmount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
               leftPaddingAmount :: Int
leftPaddingAmount = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (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. Lens' (Context n) Int
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rWidth) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
               rightPaddingAmount :: Int
rightPaddingAmount = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
leftPaddingAmount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
remainder
               leftPadding :: Image
leftPadding = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill (Context n
cContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) Attr
attrL) Char
ch Int
leftPaddingAmount Int
rHeight
               rightPadding :: Image
rightPadding = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill (Context n
cContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) Attr
attrL) Char
ch Int
rightPaddingAmount Int
rHeight
               paddedImage :: Image
paddedImage = [Image] -> Image
horizCat [ Image
leftPadding
                                      , Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL
                                      , Image
rightPadding
                                      ]
               off :: Location
off = (Int, Int) -> Location
Location (Int
leftPaddingAmount, Int
0)
           if Int
leftPaddingAmount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
rightPaddingAmount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
               Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result else
               Result n -> RenderM n (Result n)
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
$ Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addResultOffset Location
off
                      (Result n -> Result n) -> Result n -> Result n
forall a b. (a -> b) -> a -> b
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
paddedImage

-- | Center a widget vertically.  Consumes all vertical space.
vCenter :: Widget n -> Widget n
vCenter :: Widget n -> Widget n
vCenter = Maybe Char -> Widget n -> Widget n
forall n. Maybe Char -> Widget n -> Widget n
vCenterWith Maybe Char
forall a. Maybe a
Nothing

-- | Center the specified widget vertically using a Vty image
-- translation. Consumes all available vertical space. Unlike vCenter,
-- this does not fill the surrounding space so it is suitable for use
-- as a layer. Layers underneath this widget will be visible in regions
-- surrounding the centered widget.
vCenterLayer :: Widget n -> Widget n
vCenterLayer :: Widget n -> Widget n
vCenterLayer Widget n
p =
    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
p) Size
Greedy (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
        Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
        let rHeight :: Int
rHeight = Result n
resultResult 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. Lens' (Result n) Image
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
            topPaddingAmount :: Int
topPaddingAmount = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (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. Lens' (Context n) Int
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rHeight) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
            paddedImage :: Image
paddedImage = Int -> Image -> Image
translateY Int
topPaddingAmount (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$ Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL
            off :: Location
off = (Int, Int) -> Location
Location (Int
0, Int
topPaddingAmount)
        if Int
topPaddingAmount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
            Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result else
            Result n -> RenderM n (Result n)
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
$ Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addResultOffset Location
off
                   (Result n -> Result n) -> Result n -> Result n
forall a b. (a -> b) -> a -> b
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
paddedImage

-- | Center a widget vertically. Consumes all vertical space. Uses the
-- specified character to fill in the space above and below the centered
-- widget (defaults to space).
vCenterWith :: Maybe Char -> Widget n -> Widget n
vCenterWith :: Maybe Char -> Widget n -> Widget n
vCenterWith Maybe Char
mChar Widget n
p =
    let ch :: Char
ch = Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' Maybe Char
mChar
    in 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
p) Size
Greedy (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
           Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
p
           Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
           let rWidth :: Int
rWidth = Result n
resultResult 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. Lens' (Result n) Image
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
               rHeight :: Int
rHeight = Result n
resultResult 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. Lens' (Result n) Image
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
               remainder :: Int
remainder = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ 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. Lens' (Context n) Int
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
topPaddingAmount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
               topPaddingAmount :: Int
topPaddingAmount = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (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. Lens' (Context n) Int
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rHeight) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
               bottomPaddingAmount :: Int
bottomPaddingAmount = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
topPaddingAmount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
remainder
               topPadding :: Image
topPadding = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill (Context n
cContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) Attr
attrL) Char
ch Int
rWidth Int
topPaddingAmount
               bottomPadding :: Image
bottomPadding = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill (Context n
cContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) Attr
attrL) Char
ch Int
rWidth Int
bottomPaddingAmount
               paddedImage :: Image
paddedImage = [Image] -> Image
vertCat [ Image
topPadding
                                     , Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL
                                     , Image
bottomPadding
                                     ]
               off :: Location
off = (Int, Int) -> Location
Location (Int
0, Int
topPaddingAmount)
           if Int
topPaddingAmount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
bottomPaddingAmount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
               Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result else
               Result n -> RenderM n (Result n)
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
$ Location -> Result n -> Result n
forall n. Location -> Result n -> Result n
addResultOffset Location
off
                      (Result n -> Result n) -> Result n -> Result n
forall a b. (a -> b) -> a -> b
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
paddedImage

-- | Center a widget both vertically and horizontally. Consumes all
-- available vertical and horizontal space.
center :: Widget n -> Widget n
center :: Widget n -> Widget n
center = Maybe Char -> Widget n -> Widget n
forall n. Maybe Char -> Widget n -> Widget n
centerWith Maybe Char
forall a. Maybe a
Nothing

-- | Center a widget both vertically and horizontally. Consumes all
-- available vertical and horizontal space. Uses the specified character
-- to fill in the space around the centered widget (defaults to space).
centerWith :: Maybe Char -> Widget n -> Widget n
centerWith :: Maybe Char -> Widget n -> Widget n
centerWith Maybe Char
c = Maybe Char -> Widget n -> Widget n
forall n. Maybe Char -> Widget n -> Widget n
vCenterWith Maybe Char
c (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> Widget n -> Widget n
forall n. Maybe Char -> Widget n -> Widget n
hCenterWith Maybe Char
c

-- | Center a widget both vertically and horizontally using a Vty image
-- translation. Consumes all available vertical and horizontal space.
-- Unlike center, this does not fill in the surrounding space with a
-- character so it is usable as a layer. Any widget underneath this one
-- will be visible in the region surrounding the centered widget.
centerLayer :: Widget n -> Widget n
centerLayer :: Widget n -> Widget n
centerLayer = Widget n -> Widget n
forall n. Widget n -> Widget n
vCenterLayer (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget n -> Widget n
forall n. Widget n -> Widget n
hCenterLayer

-- | Center the widget horizontally and vertically about the specified
-- origin.
centerAbout :: Location -> Widget n -> Widget n
centerAbout :: Location -> Widget n -> Widget n
centerAbout Location
l Widget n
p =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      -- Compute translation offset so that loc is in the middle of the
      -- rendering area
      Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
      let centerW :: Int
centerW = 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. Lens' (Context n) Int
availWidthL Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
          centerH :: Int
centerH = 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. Lens' (Context n) Int
availHeightL Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
          off :: Location
off = (Int, Int) -> Location
Location ( Int
centerW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Location
lLocation -> Getting Int Location Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Location Int
forall a. TerminalLocation a => Lens' a Int
locationColumnL
                         , Int
centerH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Location
lLocation -> Getting Int Location Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Location Int
forall a. TerminalLocation a => Lens' a Int
locationRowL
                         )
      Result n
result <- 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
$ Location -> Widget n -> Widget n
forall n. Location -> Widget n -> Widget n
translateBy Location
off Widget n
p

      -- Pad the result so it consumes available space
      let rightPaddingAmt :: Int
rightPaddingAmt = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ 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. Lens' (Context n) Int
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Image -> Int
imageWidth (Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL)
          bottomPaddingAmt :: Int
bottomPaddingAmt = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ 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. Lens' (Context n) Int
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Image -> Int
imageHeight (Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL)
          rightPadding :: Image
rightPadding = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill (Context n
cContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) Attr
attrL) Char
' ' Int
rightPaddingAmt (Image -> Int
imageHeight (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL)
          bottomPadding :: Image
bottomPadding = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill (Context n
cContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) Attr
attrL) Char
' ' (Image -> Int
imageWidth (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL) Int
bottomPaddingAmt
          paddedImg :: Image
paddedImg = [Image] -> Image
horizCat [[Image] -> Image
vertCat [Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL, Image
bottomPadding], Image
rightPadding]

      Result n -> RenderM n (Result n)
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
$ Result n
result Result n -> (Result n -> Result n) -> Result n
forall a b. a -> (a -> b) -> b
& (Image -> Identity Image) -> Result n -> Identity (Result n)
forall n. Lens' (Result n) Image
imageL ((Image -> Identity Image) -> Result n -> Identity (Result n))
-> Image -> Result n -> Result n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Image
paddedImg