Add scrollbar space allocation control

This change is motivated by a desire to be able to control how scroll
bars are rendered adjacent to viewport contents. It isn't always
desirable to render them right up against the contents; sometimes,
spacing would be nice between the bar and contents, for example. In
general, we want users to be able to control more aspects of how scroll
bars are drawn. This change is a step in that direction. This change
won't affect any users who are using the default scroll bar renderers.

This change:

* Adds a new field to ScrollbarRenderer, scrollbarAllocation :: Int,
  which specifies the height (for horizontal scroll bars) or width (for
  vertical ones) of the region in which the bar is rendered. This allows
  scroll bar element widgets to take up more than one row in height (for
  horizontal scroll bars) or more than one column in width (for vertical
  ones).

* Updates the scroll bar rendering logic to clamp scroll bar handles to
  one row in height (for vertical scroll bars) or one column in width
  (for horizontal ones) since we need to be able to assume the size
  of the handles when computing the size of the scroll bar and trough
  regions.

* Updates programs/ViewportScrollbarsDemo.hs to demonstrate the use of
  the new allocation feature to draw a vertical scroll bar that takes up
  more than one column in various ways.

programs/ViewportScrollbarsDemo.hs

@@ -41,6 +41,7 @@ import Brick.Widgets.Core
   , withVScrollBars
   , withHScrollBars
   , withHScrollBarRenderer
+  , withVScrollBarRenderer
   , withVScrollBarHandles
   , withHScrollBarHandles
   , withClickableHScrollBars
@@ -50,12 +51,22 @@ import Brick.Widgets.Core
   , scrollbarHandleAttr
   )
 
-customScrollbars :: ScrollbarRenderer n
-customScrollbars =
-    ScrollbarRenderer { renderScrollbar = fill '^'
-                      , renderScrollbarTrough = fill ' '
+customHScrollbars :: ScrollbarRenderer n
+customHScrollbars =
+    ScrollbarRenderer { renderScrollbar = vLimit 1 $ fill '^'
+                      , renderScrollbarTrough = vLimit 1 $ fill ' '
                       , renderScrollbarHandleBefore = str "<<"
                       , renderScrollbarHandleAfter = str ">>"
+                      , scrollbarAllocation = 2
+                      }
+
+customVScrollbars :: ScrollbarRenderer n
+customVScrollbars =
+    ScrollbarRenderer { renderScrollbar = C.hCenter $ hLimit 1 $ fill '*'
+                      , renderScrollbarTrough = fill ' '
+                      , renderScrollbarHandleBefore = C.hCenter $ str "-^-"
+                      , renderScrollbarHandleAfter = C.hCenter $ str "-v-"
+                      , scrollbarAllocation = 5
                       }
 
 data Name = VP1 | VP2 | SBClick T.ClickableScrollbarElement Name
@@ -68,7 +79,7 @@ makeLenses ''St
 drawUi :: St -> [Widget Name]
 drawUi st = [ui]
     where
-        ui = C.center $ hLimit 70 $ vLimit 21 $
+        ui = C.center $ hLimit 80 $ vLimit 21 $
              (vBox [ pair
                    , C.hCenter (str "Last clicked scroll bar element:")
                    , str $ show $ _lastClickedElement st
@@ -77,7 +88,7 @@ drawUi st = [ui]
                       B.border $
                       withClickableHScrollBars SBClick $
                       withHScrollBars OnBottom $
-                      withHScrollBarRenderer customScrollbars $
+                      withHScrollBarRenderer customHScrollbars $
                       withHScrollBarHandles $
                       viewport VP1 Horizontal $
                       str $ "Press left and right arrow keys to scroll this viewport.\n" <>
@@ -86,9 +97,18 @@ drawUi st = [ui]
                     , B.border $
                       withClickableVScrollBars SBClick $
                       withVScrollBars OnLeft $
+                      withVScrollBarRenderer customVScrollbars $
                       withVScrollBarHandles $
                       viewport VP2 Both $
-                      vBox $ str "Press ctrl-arrow keys to scroll this viewport horizontally and vertically."
+                      vBox $
+                      (str $ unlines $
+                       [ "Press up and down arrow keys to"
+                       , "scroll this viewport vertically."
+                       , "This viewport uses a custom"
+                       , "scroll bar renderer with"
+                       , "a larger space allocation and"
+                       , "even more fancy rendering."
+                       ])
                       : (str <$> [ "Line " <> show i | i <- [2..55::Int] ])
                     ]
 

src/Brick/Types/Internal.hs

@@ -181,16 +181,26 @@ data ScrollbarRenderer n =
                       -- body). This should expand as described in the
                       -- documentation for the scroll bar field.
                       , renderScrollbarHandleBefore :: Widget n
-                      -- ^ How to render the handle that appears at the
-                      -- top or left of the scrollbar. The result should
-                      -- be at most one row high for horizontal handles
-                      -- and one column wide for vertical handles.
-                      , renderScrollbarHandleAfter :: Widget n
                       -- ^ How to render the handle that appears at
-                      -- the bottom or right of the scrollbar. The
-                      -- result should be at most one row high for
-                      -- horizontal handles and one column wide for
+                      -- the top or left of the scrollbar. The result
+                      -- will be allowed to be at most one column wide
+                      -- for horizontal handles and one row high for
                       -- vertical handles.
+                      , renderScrollbarHandleAfter :: Widget n
+                      -- ^ How to render the handle that appears at the
+                      -- bottom or right of the scrollbar. The result
+                      -- will be allowed to be at most one column wide
+                      -- for horizontal handles and one row high for
+                      -- vertical handles.
+                      , scrollbarAllocation :: Int
+                      -- ^ The number of rows (for a horizontal
+                      -- scrollbar) or columns (for a vertical
+                      -- scrollbar) that will be allocated to the scroll
+                      -- bar. This determines how much space the widgets
+                      -- of the scroll bar elements can take up. If they
+                      -- use less than this amount, padding will be
+                      -- applied between the scroll bar and the viewport
+                      -- contents.
                       }
 
 data VisibilityRequest =

src/Brick/Widgets/Core.hs

@@ -1298,6 +1298,7 @@ verticalScrollbarRenderer =
                       , renderScrollbarTrough = fill ' '
                       , renderScrollbarHandleBefore = str "^"
                       , renderScrollbarHandleAfter = str "v"
+                      , scrollbarAllocation = 1
                       }
 
 -- | Enable horizontal scroll bars on all viewports in the specified
@@ -1356,6 +1357,7 @@ horizontalScrollbarRenderer =
                       , renderScrollbarTrough = fill ' '
                       , renderScrollbarHandleBefore = str "<"
                       , renderScrollbarHandleAfter = str ">"
+                      , scrollbarAllocation = 1
                       }
 
 -- | Render the specified widget in a named viewport with the
@@ -1441,8 +1443,8 @@ viewport vpname typ p =
           newSize = (newWidth, newHeight)
           newWidth = c^.availWidthL - vSBWidth
           newHeight = c^.availHeightL - hSBHeight
-          vSBWidth = maybe 0 (const 1) vsOrientation
-          hSBHeight = maybe 0 (const 1) hsOrientation
+          vSBWidth = maybe 0 (const $ scrollbarAllocation vsRenderer) vsOrientation
+          hSBHeight = maybe 0 (const $ scrollbarAllocation hsRenderer) hsOrientation
           doInsert (Just vp) = Just $ vp & vpSize .~ newSize
           doInsert Nothing = Just newVp
 
@@ -1542,7 +1544,8 @@ viewport vpname typ p =
       let addVScrollbar = case vsOrientation of
               Nothing -> id
               Just orientation ->
-                  let sb = verticalScrollbar vsRenderer vpname
+                  let sb = verticalScrollbar vsRenderer orientation
+                                                        vpname
                                                         vsbClickableConstr
                                                         showVHandles
                                                         (vpFinal^.vpSize._2)
@@ -1555,7 +1558,8 @@ viewport vpname typ p =
           addHScrollbar = case hsOrientation of
               Nothing -> id
               Just orientation ->
-                  let sb = horizontalScrollbar hsRenderer vpname
+                  let sb = horizontalScrollbar hsRenderer orientation
+                                                          vpname
                                                           hsbClickableConstr
                                                           showHHandles
                                                           (vpFinal^.vpSize._1)
@@ -1620,6 +1624,8 @@ maybeClick n (Just f) el w = clickable (f el n) w
 verticalScrollbar :: (Ord n)
                   => ScrollbarRenderer n
                   -- ^ The renderer to use.
+                  -> VScrollBarOrientation
+                  -- ^ The scroll bar orientation.
                   -> n
                   -- ^ The viewport name associated with this scroll
                   -- bar.
@@ -1634,15 +1640,24 @@ verticalScrollbar :: (Ord n)
                   -> Int
                   -- ^ The total viewport content height.
                   -> Widget n
-verticalScrollbar vsRenderer n constr False vpHeight vOffset contentHeight =
-    verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight
-verticalScrollbar vsRenderer n constr True vpHeight vOffset contentHeight =
-    vBox [ maybeClick n constr SBHandleBefore $
-           hLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleBefore vsRenderer
-         , verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight
-         , maybeClick n constr SBHandleAfter $
-           hLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleAfter vsRenderer
-         ]
+verticalScrollbar vsRenderer o n constr showHandles vpHeight vOffset contentHeight =
+    hLimit (scrollbarAllocation vsRenderer) $
+    applyPadding $
+    if showHandles
+       then vBox [ vLimit 1 $
+                   maybeClick n constr SBHandleBefore $
+                   withDefAttr scrollbarHandleAttr $ renderScrollbarHandleBefore vsRenderer
+                 , sbBody
+                 , vLimit 1 $
+                   maybeClick n constr SBHandleAfter $
+                   withDefAttr scrollbarHandleAttr $ renderScrollbarHandleAfter vsRenderer
+                 ]
+       else sbBody
+    where
+        sbBody = verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight
+        applyPadding = case o of
+            OnLeft -> padRight Max
+            OnRight -> padLeft Max
 
 verticalScrollbar' :: (Ord n)
                    => ScrollbarRenderer n
@@ -1660,7 +1675,7 @@ verticalScrollbar' :: (Ord n)
                    -- ^ The total viewport content height.
                    -> Widget n
 verticalScrollbar' vsRenderer _ _ vpHeight _ 0 =
-    hLimit 1 $ vLimit vpHeight $ renderScrollbarTrough vsRenderer
+    vLimit vpHeight $ renderScrollbarTrough vsRenderer
 verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight =
     Widget Fixed Greedy $ do
         c <- getContext
@@ -1699,8 +1714,7 @@ verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight =
             sbMiddle = maybeClick n constr SBBar $
                        withDefAttr scrollbarAttr $ vLimit sbSize $ renderScrollbar vsRenderer
 
-            sb = hLimit 1 $
-                 if sbSize == ctxHeight
+            sb = if sbSize == ctxHeight
                  then vLimit sbSize $
                       renderScrollbarTrough vsRenderer
                  else vBox [sbAbove, sbMiddle, sbBelow]
@@ -1718,6 +1732,8 @@ verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight =
 horizontalScrollbar :: (Ord n)
                     => ScrollbarRenderer n
                     -- ^ The renderer to use.
+                    -> HScrollBarOrientation
+                    -- ^ The scroll bar orientation.
                     -> n
                     -- ^ The viewport name associated with this scroll
                     -- bar.
@@ -1733,15 +1749,24 @@ horizontalScrollbar :: (Ord n)
                     -> Int
                     -- ^ The total viewport content width.
                     -> Widget n
-horizontalScrollbar hsRenderer n constr False vpWidth hOffset contentWidth =
-    horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth
-horizontalScrollbar hsRenderer n constr True vpWidth hOffset contentWidth =
-    hBox [ maybeClick n constr SBHandleBefore $
-           vLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleBefore hsRenderer
-         , horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth
-         , maybeClick n constr SBHandleAfter $
-           vLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleAfter hsRenderer
-         ]
+horizontalScrollbar hsRenderer o n constr showHandles vpWidth hOffset contentWidth =
+    vLimit (scrollbarAllocation hsRenderer) $
+    applyPadding $
+    if showHandles
+       then hBox [ hLimit 1 $
+                   maybeClick n constr SBHandleBefore $
+                   withDefAttr scrollbarHandleAttr $ renderScrollbarHandleBefore hsRenderer
+                 , sbBody
+                 , hLimit 1 $
+                   maybeClick n constr SBHandleAfter $
+                   withDefAttr scrollbarHandleAttr $ renderScrollbarHandleAfter hsRenderer
+                 ]
+       else sbBody
+    where
+        sbBody = horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth
+        applyPadding = case o of
+            OnTop -> padBottom Max
+            OnBottom -> padTop Max
 
 horizontalScrollbar' :: (Ord n)
                      => ScrollbarRenderer n
@@ -1760,7 +1785,7 @@ horizontalScrollbar' :: (Ord n)
                      -- ^ The total viewport content width.
                      -> Widget n
 horizontalScrollbar' hsRenderer _ _ vpWidth _ 0 =
-    vLimit 1 $ hLimit vpWidth $ renderScrollbarTrough hsRenderer
+    hLimit vpWidth $ renderScrollbarTrough hsRenderer
 horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth =
     Widget Greedy Fixed $ do
         c <- getContext
@@ -1798,8 +1823,7 @@ horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth =
             sbMiddle = maybeClick n constr SBBar $
                        withDefAttr scrollbarAttr $ hLimit sbSize $ renderScrollbar hsRenderer
 
-            sb = vLimit 1 $
-                 if sbSize == ctxWidth
+            sb = if sbSize == ctxWidth
                  then hLimit sbSize $
                       renderScrollbarTrough hsRenderer
                  else hBox [sbLeft, sbMiddle, sbRight]