From 324b5adfbd8a0b7f345c5aeda0d95c5c11e1b280 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 1 Sep 2023 09:36:12 -0700 Subject: [PATCH 1/6] 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 | 34 ++++++++++--- src/Brick/Types/Internal.hs | 26 +++++++--- src/Brick/Widgets/Core.hs | 80 +++++++++++++++++++----------- 3 files changed, 97 insertions(+), 43 deletions(-) diff --git a/programs/ViewportScrollbarsDemo.hs b/programs/ViewportScrollbarsDemo.hs index bf8cbd2..a3868d4 100644 --- a/programs/ViewportScrollbarsDemo.hs +++ b/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] ]) ] diff --git a/src/Brick/Types/Internal.hs b/src/Brick/Types/Internal.hs index a82b177..c1e5532 100644 --- a/src/Brick/Types/Internal.hs +++ b/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 = diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs index 39ce427..ef030f9 100644 --- a/src/Brick/Widgets/Core.hs +++ b/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] From c1aa33098bd14e24dd8ef59757ded9422ea6aa61 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 1 Sep 2023 10:02:56 -0700 Subject: [PATCH 2/6] ViewportScrollbarsDemo.hs: nit --- programs/ViewportScrollbarsDemo.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/programs/ViewportScrollbarsDemo.hs b/programs/ViewportScrollbarsDemo.hs index a3868d4..bb2dadd 100644 --- a/programs/ViewportScrollbarsDemo.hs +++ b/programs/ViewportScrollbarsDemo.hs @@ -125,6 +125,7 @@ appEvent (T.VtyEvent (V.EvKey V.KDown [])) = M.vScrollBy vp2Scroll 1 appEvent (T.VtyEvent (V.EvKey V.KUp [])) = M.vScrollBy vp2Scroll (-1) appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt appEvent (T.MouseDown (SBClick el n) _ _ _) = do + lastClickedElement .= Just (el, n) case n of VP1 -> do let vp = M.viewportScroll VP1 @@ -144,8 +145,6 @@ appEvent (T.MouseDown (SBClick el n) _ _ _) = do T.SBBar -> return () _ -> return () - - lastClickedElement .= Just (el, n) appEvent _ = return () theme :: AttrMap From 0c92c0dd740262d39bb9fab7603c225892faf6b4 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 1 Sep 2023 10:08:10 -0700 Subject: [PATCH 3/6] Core: haddock edits --- src/Brick/Widgets/Core.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs index ef030f9..477d0f2 100644 --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -1613,7 +1613,7 @@ maybeClick :: (Ord n) maybeClick _ Nothing _ w = w maybeClick n (Just f) el w = clickable (f el n) w --- | Build a vertical scroll bar using the specified render and +-- | Build a vertical scroll bar using the specified renderer and -- settings. -- -- You probably don't want to use this directly; instead, @@ -1625,7 +1625,10 @@ verticalScrollbar :: (Ord n) => ScrollbarRenderer n -- ^ The renderer to use. -> VScrollBarOrientation - -- ^ The scroll bar orientation. + -- ^ The scroll bar orientation. The orientation + -- governs how additional padding is added to + -- the scroll bar if it is smaller than it space + -- allocation according to 'scrollbarAllocation'. -> n -- ^ The viewport name associated with this scroll -- bar. @@ -1721,7 +1724,7 @@ verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight = render sb --- | Build a horizontal scroll bar using the specified render and +-- | Build a horizontal scroll bar using the specified renderer and -- settings. -- -- You probably don't want to use this directly; instead, use @@ -1733,7 +1736,10 @@ horizontalScrollbar :: (Ord n) => ScrollbarRenderer n -- ^ The renderer to use. -> HScrollBarOrientation - -- ^ The scroll bar orientation. + -- ^ The scroll bar orientation. The orientation + -- governs how additional padding is added to + -- the scroll bar if it is smaller than it space + -- allocation according to 'scrollbarAllocation'. -> n -- ^ The viewport name associated with this scroll -- bar. From 480e59cbe8180f148d3b135404f777bd41ee25bd Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 1 Sep 2023 10:09:21 -0700 Subject: [PATCH 4/6] Core: haddock edits --- src/Brick/Widgets/Core.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs index 477d0f2..9470e7b 100644 --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -1669,7 +1669,9 @@ verticalScrollbar' :: (Ord n) -- ^ The viewport name associated with this scroll -- bar. -> Maybe (ClickableScrollbarElement -> n -> n) - -- ^ Constructor for clickable scroll bar element names. + -- ^ Constructor for clickable scroll bar element + -- names. Will be given the element name and the + -- viewport name. -> Int -- ^ The total viewport height in effect. -> Int @@ -1745,7 +1747,8 @@ horizontalScrollbar :: (Ord n) -- bar. -> Maybe (ClickableScrollbarElement -> n -> n) -- ^ Constructor for clickable scroll bar element - -- names. + -- names. Will be given the element name and the + -- viewport name. -> Bool -- ^ Whether to show handles. -> Int From 6b7195cf6e5bc95f9f3f588b0ec68103c0c5cd6d Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 1 Sep 2023 10:19:48 -0700 Subject: [PATCH 5/6] Split up ScrollbarRenderer type into vertical and horizontal versions This change helps users avoid undesirable behavior by accidentally using the wrong type of renderer to draw a scroll bar. This change: * Splits up the ScrollbarRenderer type into two new types, VScrollbarRenderer and HScrollbarRenderer, with nearly identical fields except that each field now has some 'V' or 'H' in it. * Renames 'scrollbarAllocation' to 'scrollbar(Height|Width)Allocation' depending on the renderer type. * Updates the Core API to take values of the new renderer types as appropriate. * Updates the types of the default renderers. * Updates the demo program that uses the custom renderers. --- programs/ViewportScrollbarsDemo.hs | 31 +++++---- src/Brick/Types.hs | 3 +- src/Brick/Types/Internal.hs | 106 ++++++++++++++++++----------- src/Brick/Widgets/Core.hs | 98 +++++++++++++------------- 4 files changed, 134 insertions(+), 104 deletions(-) diff --git a/programs/ViewportScrollbarsDemo.hs b/programs/ViewportScrollbarsDemo.hs index bb2dadd..01d385e 100644 --- a/programs/ViewportScrollbarsDemo.hs +++ b/programs/ViewportScrollbarsDemo.hs @@ -46,28 +46,29 @@ import Brick.Widgets.Core , withHScrollBarHandles , withClickableHScrollBars , withClickableVScrollBars - , ScrollbarRenderer(..) + , VScrollbarRenderer(..) + , HScrollbarRenderer(..) , scrollbarAttr , scrollbarHandleAttr ) -customHScrollbars :: ScrollbarRenderer n +customHScrollbars :: HScrollbarRenderer n customHScrollbars = - ScrollbarRenderer { renderScrollbar = vLimit 1 $ fill '^' - , renderScrollbarTrough = vLimit 1 $ fill ' ' - , renderScrollbarHandleBefore = str "<<" - , renderScrollbarHandleAfter = str ">>" - , scrollbarAllocation = 2 - } + HScrollbarRenderer { renderHScrollbar = vLimit 1 $ fill '^' + , renderHScrollbarTrough = vLimit 1 $ fill ' ' + , renderHScrollbarHandleBefore = str "<<" + , renderHScrollbarHandleAfter = str ">>" + , scrollbarHeightAllocation = 2 + } -customVScrollbars :: ScrollbarRenderer n +customVScrollbars :: VScrollbarRenderer n customVScrollbars = - ScrollbarRenderer { renderScrollbar = C.hCenter $ hLimit 1 $ fill '*' - , renderScrollbarTrough = fill ' ' - , renderScrollbarHandleBefore = C.hCenter $ str "-^-" - , renderScrollbarHandleAfter = C.hCenter $ str "-v-" - , scrollbarAllocation = 5 - } + VScrollbarRenderer { renderVScrollbar = C.hCenter $ hLimit 1 $ fill '*' + , renderVScrollbarTrough = fill ' ' + , renderVScrollbarHandleBefore = C.hCenter $ str "-^-" + , renderVScrollbarHandleAfter = C.hCenter $ str "-v-" + , scrollbarWidthAllocation = 5 + } data Name = VP1 | VP2 | SBClick T.ClickableScrollbarElement Name deriving (Ord, Show, Eq) diff --git a/src/Brick/Types.hs b/src/Brick/Types.hs index 64e965c..07d8473 100644 --- a/src/Brick/Types.hs +++ b/src/Brick/Types.hs @@ -22,7 +22,8 @@ module Brick.Types , vpContentSize , VScrollBarOrientation(..) , HScrollBarOrientation(..) - , ScrollbarRenderer(..) + , VScrollbarRenderer(..) + , HScrollbarRenderer(..) , ClickableScrollbarElement(..) -- * Event-handling types and functions diff --git a/src/Brick/Types/Internal.hs b/src/Brick/Types/Internal.hs index c1e5532..e69e163 100644 --- a/src/Brick/Types/Internal.hs +++ b/src/Brick/Types/Internal.hs @@ -22,7 +22,8 @@ module Brick.Types.Internal , cursorLocationVisibleL , VScrollBarOrientation(..) , HScrollBarOrientation(..) - , ScrollbarRenderer(..) + , VScrollbarRenderer(..) + , HScrollbarRenderer(..) , ClickableScrollbarElement(..) , Context(..) , ctxAttrMapL @@ -165,43 +166,68 @@ data VScrollBarOrientation = OnLeft | OnRight data HScrollBarOrientation = OnBottom | OnTop deriving (Show, Eq) --- | A scroll bar renderer. -data ScrollbarRenderer n = - ScrollbarRenderer { renderScrollbar :: Widget n - -- ^ How to render the body of the scroll bar. - -- This should provide a widget that expands in - -- whatever direction(s) this renderer will be - -- used for. So, for example, if this was used to - -- render vertical scroll bars, this widget would - -- need to be one that expands vertically such as - -- @fill@. The same goes for the trough widget. - , renderScrollbarTrough :: Widget n - -- ^ How to render the "trough" of the scroll bar - -- (the area to either side of the scroll bar - -- 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 - -- 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. - } +-- | A vertical scroll bar renderer. +data VScrollbarRenderer n = + VScrollbarRenderer { renderVScrollbar :: Widget n + -- ^ How to render the body of the scroll bar. + -- This should provide a widget that expands in + -- whatever direction(s) this renderer will be + -- used for. So, for example, this widget would + -- need to be one that expands vertically such as + -- @fill@. The same goes for the trough widget. + , renderVScrollbarTrough :: Widget n + -- ^ How to render the "trough" of the scroll bar + -- (the area to either side of the scroll bar + -- body). This should expand as described in the + -- documentation for the scroll bar field. + , renderVScrollbarHandleBefore :: Widget n + -- ^ How to render the handle that appears at + -- the top or left of the scrollbar. The result + -- will be allowed to be at most one row high. + , renderVScrollbarHandleAfter :: 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 row high. + , scrollbarWidthAllocation :: Int + -- ^ The number of columns 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. + } + +-- | A horizontal scroll bar renderer. +data HScrollbarRenderer n = + HScrollbarRenderer { renderHScrollbar :: Widget n + -- ^ How to render the body of the scroll bar. + -- This should provide a widget that expands + -- in whatever direction(s) this renderer will + -- be used for. So, for example, this widget + -- would need to be one that expands horizontally + -- such as @fill@. The same goes for the trough + -- widget. + , renderHScrollbarTrough :: Widget n + -- ^ How to render the "trough" of the scroll bar + -- (the area to either side of the scroll bar + -- body). This should expand as described in the + -- documentation for the scroll bar field. + , renderHScrollbarHandleBefore :: Widget n + -- ^ How to render the handle that appears at the + -- top or left of the scrollbar. The result will + -- be allowed to be at most one column wide. + , renderHScrollbarHandleAfter :: 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. + , scrollbarHeightAllocation :: Int + -- ^ The number of rows 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 = VR { vrPosition :: Location @@ -415,9 +441,9 @@ data Context n = , ctxAttrMap :: AttrMap , ctxDynBorders :: Bool , ctxVScrollBarOrientation :: Maybe VScrollBarOrientation - , ctxVScrollBarRenderer :: Maybe (ScrollbarRenderer n) + , ctxVScrollBarRenderer :: Maybe (VScrollbarRenderer n) , ctxHScrollBarOrientation :: Maybe HScrollBarOrientation - , ctxHScrollBarRenderer :: Maybe (ScrollbarRenderer n) + , ctxHScrollBarRenderer :: Maybe (HScrollbarRenderer n) , ctxVScrollBarShowHandles :: Bool , ctxHScrollBarShowHandles :: Bool , ctxVScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n) diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs index 9470e7b..fc70347 100644 --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -101,7 +101,8 @@ module Brick.Widgets.Core , withHScrollBarHandles , withVScrollBarRenderer , withHScrollBarRenderer - , ScrollbarRenderer(..) + , VScrollbarRenderer(..) + , HScrollbarRenderer(..) , verticalScrollbarRenderer , horizontalScrollbarRenderer , scrollbarAttr @@ -1285,21 +1286,21 @@ withVScrollBarHandles w = -- | Render vertical viewport scroll bars in the specified widget with -- the specified renderer. This is only needed if you want to override -- the use of the default renderer, 'verticalScrollbarRenderer'. -withVScrollBarRenderer :: ScrollbarRenderer n -> Widget n -> Widget n +withVScrollBarRenderer :: VScrollbarRenderer n -> Widget n -> Widget n withVScrollBarRenderer r w = Widget (hSize w) (vSize w) $ withReaderT (ctxVScrollBarRendererL .~ Just r) (render w) -- | The default renderer for vertical viewport scroll bars. Override -- with 'withVScrollBarRenderer'. -verticalScrollbarRenderer :: ScrollbarRenderer n +verticalScrollbarRenderer :: VScrollbarRenderer n verticalScrollbarRenderer = - ScrollbarRenderer { renderScrollbar = fill '█' - , renderScrollbarTrough = fill ' ' - , renderScrollbarHandleBefore = str "^" - , renderScrollbarHandleAfter = str "v" - , scrollbarAllocation = 1 - } + VScrollbarRenderer { renderVScrollbar = fill '█' + , renderVScrollbarTrough = fill ' ' + , renderVScrollbarHandleBefore = str "^" + , renderVScrollbarHandleAfter = str "v" + , scrollbarWidthAllocation = 1 + } -- | Enable horizontal scroll bars on all viewports in the specified -- widget and draw them with the specified orientation. @@ -1344,21 +1345,21 @@ withHScrollBarHandles w = -- | Render horizontal viewport scroll bars in the specified widget with -- the specified renderer. This is only needed if you want to override -- the use of the default renderer, 'horizontalScrollbarRenderer'. -withHScrollBarRenderer :: ScrollbarRenderer n -> Widget n -> Widget n +withHScrollBarRenderer :: HScrollbarRenderer n -> Widget n -> Widget n withHScrollBarRenderer r w = Widget (hSize w) (vSize w) $ withReaderT (ctxHScrollBarRendererL .~ Just r) (render w) -- | The default renderer for horizontal viewport scroll bars. Override -- with 'withHScrollBarRenderer'. -horizontalScrollbarRenderer :: ScrollbarRenderer n +horizontalScrollbarRenderer :: HScrollbarRenderer n horizontalScrollbarRenderer = - ScrollbarRenderer { renderScrollbar = fill '█' - , renderScrollbarTrough = fill ' ' - , renderScrollbarHandleBefore = str "<" - , renderScrollbarHandleAfter = str ">" - , scrollbarAllocation = 1 - } + HScrollbarRenderer { renderHScrollbar = fill '█' + , renderHScrollbarTrough = fill ' ' + , renderHScrollbarHandleBefore = str "<" + , renderHScrollbarHandleAfter = str ">" + , scrollbarHeightAllocation = 1 + } -- | Render the specified widget in a named viewport with the -- specified type. This permits widgets to be scrolled without being @@ -1375,11 +1376,11 @@ horizontalScrollbarRenderer = -- don't like the appearance of the resulting scroll bars (defaults: -- 'verticalScrollbarRenderer' and 'horizontalScrollbarRenderer'), -- you can customize how they are drawn by making your own --- 'ScrollbarRenderer' and using 'withVScrollBarRenderer' and/or --- 'withHScrollBarRenderer'. Note that when you enable scrollbars, the --- content of your viewport will lose one column of available space if --- vertical scroll bars are enabled and one row of available space if --- horizontal scroll bars are enabled. +-- 'VScrollbarRenderer' or 'HScrollbarRenderer' and using +-- 'withVScrollBarRenderer' and/or 'withHScrollBarRenderer'. Note that +-- when you enable scrollbars, the content of your viewport will lose +-- one column of available space if vertical scroll bars are enabled and +-- one row of available space if horizontal scroll bars are enabled. -- -- If a viewport receives more than one visibility request, then the -- visibility requests are merged with the inner visibility request @@ -1443,8 +1444,8 @@ viewport vpname typ p = newSize = (newWidth, newHeight) newWidth = c^.availWidthL - vSBWidth newHeight = c^.availHeightL - hSBHeight - vSBWidth = maybe 0 (const $ scrollbarAllocation vsRenderer) vsOrientation - hSBHeight = maybe 0 (const $ scrollbarAllocation hsRenderer) hsOrientation + vSBWidth = maybe 0 (const $ scrollbarWidthAllocation vsRenderer) vsOrientation + hSBHeight = maybe 0 (const $ scrollbarHeightAllocation hsRenderer) hsOrientation doInsert (Just vp) = Just $ vp & vpSize .~ newSize doInsert Nothing = Just newVp @@ -1622,13 +1623,13 @@ maybeClick n (Just f) el w = clickable (f el n) w -- render a scroll bar of your own, you can do so outside the @viewport@ -- context. verticalScrollbar :: (Ord n) - => ScrollbarRenderer n + => VScrollbarRenderer n -- ^ The renderer to use. -> VScrollBarOrientation -- ^ The scroll bar orientation. The orientation -- governs how additional padding is added to -- the scroll bar if it is smaller than it space - -- allocation according to 'scrollbarAllocation'. + -- allocation according to 'scrollbarWidthAllocation'. -> n -- ^ The viewport name associated with this scroll -- bar. @@ -1644,16 +1645,16 @@ verticalScrollbar :: (Ord n) -- ^ The total viewport content height. -> Widget n verticalScrollbar vsRenderer o n constr showHandles vpHeight vOffset contentHeight = - hLimit (scrollbarAllocation vsRenderer) $ + hLimit (scrollbarWidthAllocation vsRenderer) $ applyPadding $ if showHandles then vBox [ vLimit 1 $ maybeClick n constr SBHandleBefore $ - withDefAttr scrollbarHandleAttr $ renderScrollbarHandleBefore vsRenderer + withDefAttr scrollbarHandleAttr $ renderVScrollbarHandleBefore vsRenderer , sbBody , vLimit 1 $ maybeClick n constr SBHandleAfter $ - withDefAttr scrollbarHandleAttr $ renderScrollbarHandleAfter vsRenderer + withDefAttr scrollbarHandleAttr $ renderVScrollbarHandleAfter vsRenderer ] else sbBody where @@ -1663,7 +1664,7 @@ verticalScrollbar vsRenderer o n constr showHandles vpHeight vOffset contentHeig OnRight -> padLeft Max verticalScrollbar' :: (Ord n) - => ScrollbarRenderer n + => VScrollbarRenderer n -- ^ The renderer to use. -> n -- ^ The viewport name associated with this scroll @@ -1680,7 +1681,7 @@ verticalScrollbar' :: (Ord n) -- ^ The total viewport content height. -> Widget n verticalScrollbar' vsRenderer _ _ vpHeight _ 0 = - vLimit vpHeight $ renderScrollbarTrough vsRenderer + vLimit vpHeight $ renderVScrollbarTrough vsRenderer verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight = Widget Fixed Greedy $ do c <- getContext @@ -1712,16 +1713,16 @@ verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight = sbAbove = maybeClick n constr SBTroughBefore $ withDefAttr scrollbarTroughAttr $ vLimit sbOffset $ - renderScrollbarTrough vsRenderer + renderVScrollbarTrough vsRenderer sbBelow = maybeClick n constr SBTroughAfter $ withDefAttr scrollbarTroughAttr $ vLimit (ctxHeight - (sbOffset + sbSize)) $ - renderScrollbarTrough vsRenderer + renderVScrollbarTrough vsRenderer sbMiddle = maybeClick n constr SBBar $ - withDefAttr scrollbarAttr $ vLimit sbSize $ renderScrollbar vsRenderer + withDefAttr scrollbarAttr $ vLimit sbSize $ renderVScrollbar vsRenderer sb = if sbSize == ctxHeight then vLimit sbSize $ - renderScrollbarTrough vsRenderer + renderVScrollbarTrough vsRenderer else vBox [sbAbove, sbMiddle, sbBelow] render sb @@ -1735,13 +1736,14 @@ verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight = -- render a scroll bar of your own, you can do so outside the @viewport@ -- context. horizontalScrollbar :: (Ord n) - => ScrollbarRenderer n + => HScrollbarRenderer n -- ^ The renderer to use. -> HScrollBarOrientation -- ^ The scroll bar orientation. The orientation - -- governs how additional padding is added to - -- the scroll bar if it is smaller than it space - -- allocation according to 'scrollbarAllocation'. + -- governs how additional padding is added + -- to the scroll bar if it is smaller + -- than it space allocation according to + -- 'scrollbarHeightAllocation'. -> n -- ^ The viewport name associated with this scroll -- bar. @@ -1759,16 +1761,16 @@ horizontalScrollbar :: (Ord n) -- ^ The total viewport content width. -> Widget n horizontalScrollbar hsRenderer o n constr showHandles vpWidth hOffset contentWidth = - vLimit (scrollbarAllocation hsRenderer) $ + vLimit (scrollbarHeightAllocation hsRenderer) $ applyPadding $ if showHandles then hBox [ hLimit 1 $ maybeClick n constr SBHandleBefore $ - withDefAttr scrollbarHandleAttr $ renderScrollbarHandleBefore hsRenderer + withDefAttr scrollbarHandleAttr $ renderHScrollbarHandleBefore hsRenderer , sbBody , hLimit 1 $ maybeClick n constr SBHandleAfter $ - withDefAttr scrollbarHandleAttr $ renderScrollbarHandleAfter hsRenderer + withDefAttr scrollbarHandleAttr $ renderHScrollbarHandleAfter hsRenderer ] else sbBody where @@ -1778,7 +1780,7 @@ horizontalScrollbar hsRenderer o n constr showHandles vpWidth hOffset contentWid OnBottom -> padTop Max horizontalScrollbar' :: (Ord n) - => ScrollbarRenderer n + => HScrollbarRenderer n -- ^ The renderer to use. -> n -- ^ The viewport name associated with this scroll @@ -1794,7 +1796,7 @@ horizontalScrollbar' :: (Ord n) -- ^ The total viewport content width. -> Widget n horizontalScrollbar' hsRenderer _ _ vpWidth _ 0 = - hLimit vpWidth $ renderScrollbarTrough hsRenderer + hLimit vpWidth $ renderHScrollbarTrough hsRenderer horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth = Widget Greedy Fixed $ do c <- getContext @@ -1825,16 +1827,16 @@ horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth = sbLeft = maybeClick n constr SBTroughBefore $ withDefAttr scrollbarTroughAttr $ hLimit sbOffset $ - renderScrollbarTrough hsRenderer + renderHScrollbarTrough hsRenderer sbRight = maybeClick n constr SBTroughAfter $ withDefAttr scrollbarTroughAttr $ hLimit (ctxWidth - (sbOffset + sbSize)) $ - renderScrollbarTrough hsRenderer + renderHScrollbarTrough hsRenderer sbMiddle = maybeClick n constr SBBar $ - withDefAttr scrollbarAttr $ hLimit sbSize $ renderScrollbar hsRenderer + withDefAttr scrollbarAttr $ hLimit sbSize $ renderHScrollbar hsRenderer sb = if sbSize == ctxWidth then hLimit sbSize $ - renderScrollbarTrough hsRenderer + renderHScrollbarTrough hsRenderer else hBox [sbLeft, sbMiddle, sbRight] render sb From 245044cc1292f18bf89b42f6913d837e3e62c3dc Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Sat, 2 Sep 2023 10:16:18 -0700 Subject: [PATCH 6/6] Bump version, update changelog --- CHANGELOG.md | 29 +++++++++++++++++++++++++++++ brick.cabal | 2 +- 2 files changed, 30 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d07894b..f7ce2c5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,35 @@ Brick changelog --------------- +1.10 +---- + +API changes: +* The `ScrollbarRenderer` type got split up into vertical and horizontal + versions, `VScrollbarRenderer` and `HScrollbarRenderer`, respectively. + Their fields are nearly identical to the original `ScrollbarRenderer` + fields except that many fields now have a `V` or `H` in them as + appropriate. As part of this change, the various `Brick.Widgets.Core` + functions that deal with the renderers got their types updated, and + the types of the default scroll bar renderers changed, too. +* The scroll bar renderers now have a field to control how much space + is allocated to a scroll bar. Previously, all scroll bars were + assumed to be exactly one row in height or one column in width. 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. + As part of this change, `VScrollbarRenderer` got a field called + `scrollbarWidthAllocation` and `HScrollbarRenderer` got a field called + `scrollbarHeightAllocation`. The fields specify the height (for + horizontal scroll bars) or width (for vertical ones) of the region + in which the bar is rendered, allowing 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) as desired. If + the widgets take up less space, padding is added between the scroll + bar and the viewport contents to pad the scroll bar to take up the + specified allocation. + 1.9 --- diff --git a/brick.cabal b/brick.cabal index d49d945..6a5a4af 100644 --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 1.9 +version: 1.10 synopsis: A declarative terminal user interface library description: Write terminal user interfaces (TUIs) painlessly with 'brick'! You