Skip to content

Commit

Permalink
Add scrollbar space allocation control
Browse files Browse the repository at this point in the history 
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.
  • Loading branch information
@jtdaugherty
jtdaugherty committed Sep 1, 2023
1 parent 2776b3c commit 324b5ad
Show file tree
Hide file tree
Showing 3 changed files with 97 additions and 43 deletions.
34 changes: 27 additions & 7 deletions programs/ViewportScrollbarsDemo.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@ import Brick.Widgets.Core
, withVScrollBars
, withHScrollBars
, withHScrollBarRenderer
, withVScrollBarRenderer
, withVScrollBarHandles
, withHScrollBarHandles
, withClickableHScrollBars
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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" <>
Expand All @@ -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] ])
]

Expand Down
26 changes: 18 additions & 8 deletions src/Brick/Types/Internal.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
80 changes: 52 additions & 28 deletions src/Brick/Widgets/Core.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1298,6 +1298,7 @@ verticalScrollbarRenderer =
, renderScrollbarTrough = fill ' '
, renderScrollbarHandleBefore = str "^"
, renderScrollbarHandleAfter = str "v"
, scrollbarAllocation = 1
}

-- | Enable horizontal scroll bars on all viewports in the specified
Expand Down Expand Up @@ -1356,6 +1357,7 @@ horizontalScrollbarRenderer =
, renderScrollbarTrough = fill ' '
, renderScrollbarHandleBefore = str "<"
, renderScrollbarHandleAfter = str ">"
, scrollbarAllocation = 1
}

-- | Render the specified widget in a named viewport with the
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -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.
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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]
Expand All @@ -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.
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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]
Expand Down

0 comments on commit 324b5ad

Please sign in to comment.