diff --git a/CHANGELOG.md b/CHANGELOG.md --- 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/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,7 +13,7 @@ Under the hood, this library builds upon [vty](http://hackage.haskell.org/package/vty), so some knowledge of Vty -will be helpful in using this library. +will be necessary to use this library. Example ------- @@ -94,6 +94,7 @@ | [`haradict`](https://github.com/srhoulam/haradict) | A TUI Arabic dictionary powered by [ElixirFM](https://github.com/otakar-smrz/elixir-fm) | | [`Giter`](https://gitlab.com/refaelsh/giter) | A UI wrapper around Git CLI inspired by [Magit](https://magit.vc/). | | [`Brickudoku`](https://github.com/Thecentury/brickudoku) | A hybrid of Tetris and Sudoku | +| [`timeloop`](https://github.com/cdupont/timeloop) | A time-travelling demonstrator | These third-party packages also extend `brick`: @@ -129,7 +130,7 @@ * [The official brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst) * [Haddock documentation](https://hackage.haskell.org/package/brick) -* [Demo programs](https://github.com/jtdaugherty/brick/blob/master/programs) ([Screenshots](https://github.com/jtdaugherty/brick/blob/master/docs/programs-screenshots.md)) +* [Demo programs](https://github.com/jtdaugherty/brick/blob/master/programs) * [FAQ](https://github.com/jtdaugherty/brick/blob/master/FAQ.md) Feature Overview @@ -205,7 +206,12 @@ codebase. - Please adjust or provide Haddock and/or user guide documentation relevant to any changes you make. - - New commits should be `-Wall` clean. + - Please ensure that commits are `-Wall` clean. + - Please ensure that each commit makes a single, logical, isolated + change as much as possible. + - Please do not submit changes that your linter told you to make. I + will probably decline them. Relatedly: please do not submit changes + that change only style without changing functionality. - Please do NOT include package version changes in your patches. Package version changes are only done at release time when the full scope of a release's changes can be evaluated to determine the diff --git a/brick.cabal b/brick.cabal --- 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 @@ -32,7 +32,7 @@ license-file: LICENSE author: Jonathan Daugherty maintainer: Jonathan Daugherty -copyright: (c) Jonathan Daugherty 2015-2022 +copyright: (c) Jonathan Daugherty 2015-2023 category: Graphics build-type: Simple cabal-version: 1.18 @@ -44,31 +44,7 @@ docs/guide.rst, docs/snake-demo.gif, CHANGELOG.md, - programs/custom_keys.ini, - docs/programs-screenshots.md, - docs/programs-screenshots/brick-attr-demo.png, - docs/programs-screenshots/brick-border-demo.png, - docs/programs-screenshots/brick-cache-demo.png, - docs/programs-screenshots/brick-custom-event-demo.png, - docs/programs-screenshots/brick-dialog-demo.png, - docs/programs-screenshots/brick-dynamic-border-demo.png, - docs/programs-screenshots/brick-edit-demo.png, - docs/programs-screenshots/brick-file-browser-demo.png, - docs/programs-screenshots/brick-fill-demo.png, - docs/programs-screenshots/brick-form-demo.png, - docs/programs-screenshots/brick-hello-world-demo.png, - docs/programs-screenshots/brick-layer-demo.png, - docs/programs-screenshots/brick-list-demo.png, - docs/programs-screenshots/brick-list-vi-demo.png, - docs/programs-screenshots/brick-mouse-demo.png, - docs/programs-screenshots/brick-padding-demo.png, - docs/programs-screenshots/brick-progressbar-demo.png, - docs/programs-screenshots/brick-readme-demo.png, - docs/programs-screenshots/brick-suspend-resume-demo.png, - docs/programs-screenshots/brick-text-wrap-demo.png, - docs/programs-screenshots/brick-theme-demo.png, - docs/programs-screenshots/brick-viewport-scroll-demo.png, - docs/programs-screenshots/brick-visibility-demo.png + programs/custom_keys.ini Source-Repository head type: git diff --git a/docs/programs-screenshots.md b/docs/programs-screenshots.md deleted file mode 100644 --- a/docs/programs-screenshots.md +++ /dev/null @@ -1,70 +0,0 @@ -# Demo program screenshots - -## [AttrDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/AttrDemo.hs) -![attr demo](./programs-screenshots/brick-attr-demo.png) - -## [BorderDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/BorderDemo.hs) -![border demo](./programs-screenshots/brick-border-demo.png) - -## [CacheDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/CacheDemo.hs) -![cache demo](./programs-screenshots/brick-cache-demo.png) - -## [CustomEventDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/CustomEventDemo.hs) -![custom-event demo](./programs-screenshots/brick-custom-event-demo.png) - -## [DialogDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/DialogDemo.hs) -![dialog demo](./programs-screenshots/brick-dialog-demo.png) - -## [DynamicBorderDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/DynamicBorderDemo.hs) -![dynamic-border demo](./programs-screenshots/brick-dynamic-border-demo.png) - -## [EditDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/EditDemo.hs) -![edit demo](./programs-screenshots/brick-edit-demo.png) - -## [FileBrowserDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/FileBrowserDemo.hs) -![file-browser demo](./programs-screenshots/brick-file-browser-demo.png) - -## [FillDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/FillDemo.hs) -![fill demo](./programs-screenshots/brick-fill-demo.png) - -## [FormDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/FormDemo.hs) -![form demo](./programs-screenshots/brick-form-demo.png) - -## [HelloWorldDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/HelloWorldDemo.hs) -![hello-world demo](./programs-screenshots/brick-hello-world-demo.png) - -## [LayerDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/LayerDemo.hs) -![layer demo](./programs-screenshots/brick-layer-demo.png) - -## [ListDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ListDemo.hs) -![list demo](./programs-screenshots/brick-list-demo.png) - -## [ListViDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ListViDemo.hs) -![list-vi demo](./programs-screenshots/brick-list-vi-demo.png) - -## [MouseDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/MouseDemo.hs) -![mouse demo](./programs-screenshots/brick-mouse-demo.png) - -## [PaddingDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/PaddingDemo.hs) -![padding demo](./programs-screenshots/brick-padding-demo.png) - -## [ProgressBarDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ProgressBarDemo.hs) -![progressbar demo](./programs-screenshots/brick-progressbar-demo.png) - -## [ReadmeDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ReadmeDemo.hs) -![readme demo](./programs-screenshots/brick-readme-demo.png) - -## [SuspendAndResumeDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/SuspendAndResumeDemo.hs) -![suspend-resume demo](./programs-screenshots/brick-suspend-resume-demo.png) - -## [TextWrapDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/TextWrapDemo.hs) -![text-wrap demo](./programs-screenshots/brick-text-wrap-demo.png) - -## [ThemeDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ThemeDemo.hs) -![theme demo](./programs-screenshots/brick-theme-demo.png) - -## [ViewportScrollDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ViewportScrollDemo.hs) -![viewport-scroll demo](./programs-screenshots/brick-viewport-scroll-demo.png) - -## [VisibilityDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/VisibilityDemo.hs) -![visibility demo](./programs-screenshots/brick-visibility-demo.png) diff --git a/docs/programs-screenshots/brick-attr-demo.png b/docs/programs-screenshots/brick-attr-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-attr-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-border-demo.png b/docs/programs-screenshots/brick-border-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-border-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-cache-demo.png b/docs/programs-screenshots/brick-cache-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-cache-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-custom-event-demo.png b/docs/programs-screenshots/brick-custom-event-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-custom-event-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-dialog-demo.png b/docs/programs-screenshots/brick-dialog-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-dialog-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-dynamic-border-demo.png b/docs/programs-screenshots/brick-dynamic-border-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-dynamic-border-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-edit-demo.png b/docs/programs-screenshots/brick-edit-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-edit-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-file-browser-demo.png b/docs/programs-screenshots/brick-file-browser-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-file-browser-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-fill-demo.png b/docs/programs-screenshots/brick-fill-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-fill-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-form-demo.png b/docs/programs-screenshots/brick-form-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-form-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-hello-world-demo.png b/docs/programs-screenshots/brick-hello-world-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-hello-world-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-layer-demo.png b/docs/programs-screenshots/brick-layer-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-layer-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-list-demo.png b/docs/programs-screenshots/brick-list-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-list-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-list-vi-demo.png b/docs/programs-screenshots/brick-list-vi-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-list-vi-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-mouse-demo.png b/docs/programs-screenshots/brick-mouse-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-mouse-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-padding-demo.png b/docs/programs-screenshots/brick-padding-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-padding-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-progressbar-demo.png b/docs/programs-screenshots/brick-progressbar-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-progressbar-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-readme-demo.png b/docs/programs-screenshots/brick-readme-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-readme-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-suspend-resume-demo.png b/docs/programs-screenshots/brick-suspend-resume-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-suspend-resume-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-text-wrap-demo.png b/docs/programs-screenshots/brick-text-wrap-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-text-wrap-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-theme-demo.png b/docs/programs-screenshots/brick-theme-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-theme-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-viewport-scroll-demo.png b/docs/programs-screenshots/brick-viewport-scroll-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-viewport-scroll-demo.png and /dev/null differ diff --git a/docs/programs-screenshots/brick-visibility-demo.png b/docs/programs-screenshots/brick-visibility-demo.png deleted file mode 100644 Binary files a/docs/programs-screenshots/brick-visibility-demo.png and /dev/null differ diff --git a/programs/BorderDemo.hs b/programs/BorderDemo.hs --- a/programs/BorderDemo.hs +++ b/programs/BorderDemo.hs @@ -16,16 +16,17 @@ ( Widget ) import Brick.Widgets.Core - ( (<=>) - , (<+>) + ( (<+>) , withAttr , vLimit , hLimit , hBox + , vBox , updateAttrMap , withBorderStyle , txt , str + , padLeftRight ) import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B @@ -65,13 +66,14 @@ B.borderWithLabel (str "label") $ vLimit 5 $ C.vCenter $ - txt $ " " <> styleName <> " style " + padLeftRight 2 $ + txt $ styleName <> " style" titleAttr :: A.AttrName titleAttr = A.attrName "title" -borderMappings :: [(A.AttrName, V.Attr)] -borderMappings = +attrs :: [(A.AttrName, V.Attr)] +attrs = [ (B.borderAttr, V.yellow `on` V.black) , (B.vBorderAttr, fg V.cyan) , (B.hBorderAttr, fg V.magenta) @@ -80,7 +82,7 @@ colorDemo :: Widget () colorDemo = - updateAttrMap (A.applyAttrMappings borderMappings) $ + updateAttrMap (A.applyAttrMappings attrs) $ B.borderWithLabel (withAttr titleAttr $ str "title") $ hLimit 20 $ vLimit 5 $ @@ -89,13 +91,14 @@ ui :: Widget () ui = - hBox borderDemos - <=> B.hBorder - <=> colorDemo - <=> B.hBorderWithLabel (str "horizontal border label") - <=> (C.center (str "Left of vertical border") - <+> B.vBorder - <+> C.center (str "Right of vertical border")) + vBox [ hBox borderDemos + , B.hBorder + , colorDemo + , B.hBorderWithLabel (str "horizontal border label") + , (C.center (str "Left of vertical border") + <+> B.vBorder + <+> C.center (str "Right of vertical border")) + ] main :: IO () main = M.simpleMain ui diff --git a/programs/ThemeDemo.hs b/programs/ThemeDemo.hs --- a/programs/ThemeDemo.hs +++ b/programs/ThemeDemo.hs @@ -71,7 +71,7 @@ , appStartEvent = return () , appAttrMap = \s -> -- Note that in practice this is not ideal: we don't want - -- to build an attribute from a theme every time this is + -- to build an attribute map from a theme every time this is -- invoked, because it gets invoked once per redraw. Instead -- we'd build the attribute map at startup and store it in -- the application state. Here I just use themeToAttrMap to diff --git a/programs/ViewportScrollbarsDemo.hs b/programs/ViewportScrollbarsDemo.hs --- a/programs/ViewportScrollbarsDemo.hs +++ b/programs/ViewportScrollbarsDemo.hs @@ -41,23 +41,35 @@ , withVScrollBars , withHScrollBars , withHScrollBarRenderer + , withVScrollBarRenderer , withVScrollBarHandles , withHScrollBarHandles , withClickableHScrollBars , withClickableVScrollBars - , ScrollbarRenderer(..) + , VScrollbarRenderer(..) + , HScrollbarRenderer(..) , scrollbarAttr , scrollbarHandleAttr ) -customScrollbars :: ScrollbarRenderer n -customScrollbars = - ScrollbarRenderer { renderScrollbar = fill '^' - , renderScrollbarTrough = fill ' ' - , renderScrollbarHandleBefore = str "<<" - , renderScrollbarHandleAfter = str ">>" - } +customHScrollbars :: HScrollbarRenderer n +customHScrollbars = + HScrollbarRenderer { renderHScrollbar = vLimit 1 $ fill '^' + , renderHScrollbarTrough = vLimit 1 $ fill ' ' + , renderHScrollbarHandleBefore = str "<<" + , renderHScrollbarHandleAfter = str ">>" + , scrollbarHeightAllocation = 2 + } +customVScrollbars :: VScrollbarRenderer n +customVScrollbars = + 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) @@ -68,7 +80,7 @@ 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 +89,7 @@ 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 +98,18 @@ , 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] ]) ] @@ -105,6 +126,7 @@ 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 @@ -124,8 +146,6 @@ T.SBBar -> return () _ -> return () - - lastClickedElement .= Just (el, n) appEvent _ = return () theme :: AttrMap diff --git a/src/Brick/Types.hs b/src/Brick/Types.hs --- a/src/Brick/Types.hs +++ b/src/Brick/Types.hs @@ -22,7 +22,8 @@ , 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 --- a/src/Brick/Types/Internal.hs +++ b/src/Brick/Types/Internal.hs @@ -22,7 +22,8 @@ , cursorLocationVisibleL , VScrollBarOrientation(..) , HScrollBarOrientation(..) - , ScrollbarRenderer(..) + , VScrollbarRenderer(..) + , HScrollbarRenderer(..) , ClickableScrollbarElement(..) , Context(..) , ctxAttrMapL @@ -165,34 +166,69 @@ 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 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 - -- vertical handles. - } +-- | 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 , vrSize :: DisplayRegion @@ -405,9 +441,9 @@ , 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 --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -101,7 +101,8 @@ , withHScrollBarHandles , withVScrollBarRenderer , withHScrollBarRenderer - , ScrollbarRenderer(..) + , VScrollbarRenderer(..) + , HScrollbarRenderer(..) , verticalScrollbarRenderer , horizontalScrollbarRenderer , scrollbarAttr @@ -1285,20 +1286,21 @@ -- | 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" - } + 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. @@ -1343,20 +1345,21 @@ -- | 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 ">" - } + 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 @@ -1373,11 +1376,11 @@ -- 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 @@ -1441,8 +1444,8 @@ 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 $ scrollbarWidthAllocation vsRenderer) vsOrientation + hSBHeight = maybe 0 (const $ scrollbarHeightAllocation hsRenderer) hsOrientation doInsert (Just vp) = Just $ vp & vpSize .~ newSize doInsert Nothing = Just newVp @@ -1542,7 +1545,8 @@ 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 +1559,8 @@ addHScrollbar = case hsOrientation of Nothing -> id Just orientation -> - let sb = horizontalScrollbar hsRenderer vpname + let sb = horizontalScrollbar hsRenderer orientation + vpname hsbClickableConstr showHHandles (vpFinal^.vpSize._1) @@ -1609,7 +1614,7 @@ 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, @@ -1618,8 +1623,13 @@ -- 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 'scrollbarWidthAllocation'. -> n -- ^ The viewport name associated with this scroll -- bar. @@ -1634,24 +1644,35 @@ -> 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 (scrollbarWidthAllocation vsRenderer) $ + applyPadding $ + if showHandles + then vBox [ vLimit 1 $ + maybeClick n constr SBHandleBefore $ + withDefAttr scrollbarHandleAttr $ renderVScrollbarHandleBefore vsRenderer + , sbBody + , vLimit 1 $ + maybeClick n constr SBHandleAfter $ + withDefAttr scrollbarHandleAttr $ renderVScrollbarHandleAfter 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 + => VScrollbarRenderer n -- ^ The renderer to use. -> 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 @@ -1660,7 +1681,7 @@ -- ^ The total viewport content height. -> Widget n verticalScrollbar' vsRenderer _ _ vpHeight _ 0 = - hLimit 1 $ vLimit vpHeight $ renderScrollbarTrough vsRenderer + vLimit vpHeight $ renderVScrollbarTrough vsRenderer verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight = Widget Fixed Greedy $ do c <- getContext @@ -1692,22 +1713,21 @@ 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 = hLimit 1 $ - if sbSize == ctxHeight + sb = if sbSize == ctxHeight then vLimit sbSize $ - renderScrollbarTrough vsRenderer + renderVScrollbarTrough vsRenderer else vBox [sbAbove, sbMiddle, sbBelow] 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 @@ -1716,14 +1736,21 @@ -- 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 + -- 'scrollbarHeightAllocation'. -> n -- ^ The viewport name associated with this scroll -- 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 @@ -1733,18 +1760,27 @@ -> 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 (scrollbarHeightAllocation hsRenderer) $ + applyPadding $ + if showHandles + then hBox [ hLimit 1 $ + maybeClick n constr SBHandleBefore $ + withDefAttr scrollbarHandleAttr $ renderHScrollbarHandleBefore hsRenderer + , sbBody + , hLimit 1 $ + maybeClick n constr SBHandleAfter $ + withDefAttr scrollbarHandleAttr $ renderHScrollbarHandleAfter 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 + => HScrollbarRenderer n -- ^ The renderer to use. -> n -- ^ The viewport name associated with this scroll @@ -1760,7 +1796,7 @@ -- ^ The total viewport content width. -> Widget n horizontalScrollbar' hsRenderer _ _ vpWidth _ 0 = - vLimit 1 $ hLimit vpWidth $ renderScrollbarTrough hsRenderer + hLimit vpWidth $ renderHScrollbarTrough hsRenderer horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth = Widget Greedy Fixed $ do c <- getContext @@ -1791,17 +1827,16 @@ 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 = vLimit 1 $ - if sbSize == ctxWidth + sb = if sbSize == ctxWidth then hLimit sbSize $ - renderScrollbarTrough hsRenderer + renderHScrollbarTrough hsRenderer else hBox [sbLeft, sbMiddle, sbRight] render sb