Center: add layer-friendly centering functions centerLayer, hCenterLayer, and vCenterLayer, use in Dialog

src/Brick/Widgets/Center.hs

@@ -3,12 +3,15 @@ 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
   )
@@ -16,7 +19,8 @@ where
 
 import Lens.Micro ((^.), (&), (.~), to)
 import Data.Maybe (fromMaybe)
-import Graphics.Vty (imageWidth, imageHeight, horizCat, charFill, vertCat)
+import Graphics.Vty (imageWidth, imageHeight, horizCat, charFill, vertCat,
+                    translateX, translateY)
 
 import Brick.Types
 import Brick.Widgets.Core
@@ -26,6 +30,25 @@ import Brick.Widgets.Core
 hCenter :: Widget n -> Widget n
 hCenter = hCenterWith 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 p =
+    Widget Greedy (vSize p) $ do
+        result <- render p
+        c <- getContext
+        let rWidth = result^.imageL.to imageWidth
+            leftPaddingAmount = max 0 $ (c^.availWidthL - rWidth) `div` 2
+            paddedImage = translateX leftPaddingAmount $ result^.imageL
+            off = Location (leftPaddingAmount, 0)
+        if leftPaddingAmount == 0 then
+            return result else
+            return $ addResultOffset off
+                   $ result & imageL .~ 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).
@@ -56,6 +79,25 @@ hCenterWith mChar p =
 vCenter :: Widget n -> Widget n
 vCenter = vCenterWith 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 p =
+    Widget (hSize p) Greedy $ do
+        result <- render p
+        c <- getContext
+        let rHeight = result^.imageL.to imageHeight
+            topPaddingAmount = max 0 $ (c^.availHeightL - rHeight) `div` 2
+            paddedImage = translateY topPaddingAmount $ result^.imageL
+            off = Location (0, topPaddingAmount)
+        if topPaddingAmount == 0 then
+            return result else
+            return $ addResultOffset off
+                   $ result & imageL .~ 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).
@@ -93,6 +135,14 @@ center = centerWith Nothing
 centerWith :: Maybe Char -> Widget n -> Widget n
 centerWith c = vCenterWith c . hCenterWith 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 = vCenterLayer . hCenterLayer
+
 -- | Center the widget horizontally and vertically about the specified
 -- origin.
 centerAbout :: Location -> Widget n -> Widget n

src/Brick/Widgets/Dialog.hs

@@ -113,7 +113,7 @@ renderDialog d body =
                          mkButton <$> (zip [0..] (d^.dialogButtonsL))
 
         doBorder = maybe border borderWithLabel (str <$> d^.dialogTitleL)
-    in center $
+    in centerLayer $
        withDefAttr dialogAttr $
        hLimit (d^.dialogWidthL) $
        doBorder $