jtdaugherty/brick
1
1
Fork 0
mirror of https://github.com/jtdaugherty/brick.git synced 2024-08-17 11:50:24 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into refactor/vty-crossplatform

Browse Source
This commit is contained in:
Jonathan Daugherty 2023-10-22 19:55:22 -07:00
commit d442145c78
6 changed files with 230 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
CHANGELOG.md
View File

@ -2,6 +2,35 @@
Brick changelog 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 1.9
--- ---

2
brick.cabal
View File

@ -1,5 +1,5 @@
name: brick name: brick
version: 1.9 version: 1.10
synopsis: A declarative terminal user interface library synopsis: A declarative terminal user interface library
description: description:
Write terminal user interfaces (TUIs) painlessly with 'brick'! You Write terminal user interfaces (TUIs) painlessly with 'brick'! You

46
programs/ViewportScrollbarsDemo.hs
View File

@ -42,22 +42,34 @@ import Brick.Widgets.Core
, withVScrollBars , withVScrollBars
, withHScrollBars , withHScrollBars
, withHScrollBarRenderer , withHScrollBarRenderer
, withVScrollBarRenderer
, withVScrollBarHandles , withVScrollBarHandles
, withHScrollBarHandles , withHScrollBarHandles
, withClickableHScrollBars , withClickableHScrollBars
, withClickableVScrollBars , withClickableVScrollBars
, ScrollbarRenderer(..) , VScrollbarRenderer(..)
, HScrollbarRenderer(..)
, scrollbarAttr , scrollbarAttr
, scrollbarHandleAttr , scrollbarHandleAttr
) )
customScrollbars :: ScrollbarRenderer n customHScrollbars :: HScrollbarRenderer n
customScrollbars = customHScrollbars =
ScrollbarRenderer { renderScrollbar = fill '^' HScrollbarRenderer { renderHScrollbar = vLimit 1 $ fill '^'
, renderScrollbarTrough = fill ' ' , renderHScrollbarTrough = vLimit 1 $ fill ' '
, renderScrollbarHandleBefore = str "<<" , renderHScrollbarHandleBefore = str "<<"
, renderScrollbarHandleAfter = 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 data Name = VP1 | VP2 | SBClick T.ClickableScrollbarElement Name
deriving (Ord, Show, Eq) deriving (Ord, Show, Eq)
@ -69,7 +81,7 @@ makeLenses ''St
drawUi :: St -> [Widget Name] drawUi :: St -> [Widget Name]
drawUi st = [ui] drawUi st = [ui]
where where
ui = C.center $ hLimit 70 $ vLimit 21 $ ui = C.center $ hLimit 80 $ vLimit 21 $
(vBox [ pair (vBox [ pair
, C.hCenter (str "Last clicked scroll bar element:") , C.hCenter (str "Last clicked scroll bar element:")
, str $ show $ _lastClickedElement st , str $ show $ _lastClickedElement st
@ -78,7 +90,7 @@ drawUi st = [ui]
B.border $ B.border $
withClickableHScrollBars SBClick $ withClickableHScrollBars SBClick $
withHScrollBars OnBottom $ withHScrollBars OnBottom $
withHScrollBarRenderer customScrollbars $ withHScrollBarRenderer customHScrollbars $
withHScrollBarHandles $ withHScrollBarHandles $
viewport VP1 Horizontal $ viewport VP1 Horizontal $
str $ "Press left and right arrow keys to scroll this viewport.\n" <> str $ "Press left and right arrow keys to scroll this viewport.\n" <>
@ -87,9 +99,18 @@ drawUi st = [ui]
, B.border $ , B.border $
withClickableVScrollBars SBClick $ withClickableVScrollBars SBClick $
withVScrollBars OnLeft $ withVScrollBars OnLeft $
withVScrollBarRenderer customVScrollbars $
withVScrollBarHandles $ withVScrollBarHandles $
viewport VP2 Both $ 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] ]) : (str <$> [ "Line " <> show i | i <- [2..55::Int] ])
] ]
@ -106,6 +127,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.KUp [])) = M.vScrollBy vp2Scroll (-1)
appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt
appEvent (T.MouseDown (SBClick el n) _ _ _) = do appEvent (T.MouseDown (SBClick el n) _ _ _) = do
lastClickedElement .= Just (el, n)
case n of case n of
VP1 -> do VP1 -> do
let vp = M.viewportScroll VP1 let vp = M.viewportScroll VP1
@ -125,8 +147,6 @@ appEvent (T.MouseDown (SBClick el n) _ _ _) = do
T.SBBar -> return () T.SBBar -> return ()
_ -> _ ->
return () return ()
lastClickedElement .= Just (el, n)
appEvent _ = return () appEvent _ = return ()
theme :: AttrMap theme :: AttrMap

3
src/Brick/Types.hs
View File

@ -22,7 +22,8 @@ module Brick.Types
, vpContentSize , vpContentSize
, VScrollBarOrientation(..) , VScrollBarOrientation(..)
, HScrollBarOrientation(..) , HScrollBarOrientation(..)
, ScrollbarRenderer(..) , VScrollbarRenderer(..)
, HScrollbarRenderer(..)
, ClickableScrollbarElement(..) , ClickableScrollbarElement(..)
-- * Event-handling types and functions -- * Event-handling types and functions

96
src/Brick/Types/Internal.hs
View File

@ -22,7 +22,8 @@ module Brick.Types.Internal
, cursorLocationVisibleL , cursorLocationVisibleL
, VScrollBarOrientation(..) , VScrollBarOrientation(..)
, HScrollBarOrientation(..) , HScrollBarOrientation(..)
, ScrollbarRenderer(..) , VScrollbarRenderer(..)
, HScrollbarRenderer(..)
, ClickableScrollbarElement(..) , ClickableScrollbarElement(..)
, Context(..) , Context(..)
, ctxAttrMapL , ctxAttrMapL
@ -165,33 +166,68 @@ data VScrollBarOrientation = OnLeft | OnRight
data HScrollBarOrientation = OnBottom | OnTop data HScrollBarOrientation = OnBottom | OnTop
deriving (Show, Eq) deriving (Show, Eq)
-- | A scroll bar renderer. -- | A vertical scroll bar renderer.
data ScrollbarRenderer n = data VScrollbarRenderer n =
ScrollbarRenderer { renderScrollbar :: Widget n VScrollbarRenderer { renderVScrollbar :: Widget n
-- ^ How to render the body of the scroll bar. -- ^ How to render the body of the scroll bar.
-- This should provide a widget that expands in -- This should provide a widget that expands in
-- whatever direction(s) this renderer will be -- whatever direction(s) this renderer will be
-- used for. So, for example, if this was used to -- used for. So, for example, this widget would
-- render vertical scroll bars, this widget would -- need to be one that expands vertically such as
-- need to be one that expands vertically such as -- @fill@. The same goes for the trough widget.
-- @fill@. The same goes for the trough widget. , renderVScrollbarTrough :: Widget n
, renderScrollbarTrough :: Widget n -- ^ How to render the "trough" of the scroll bar
-- ^ How to render the "trough" of the scroll bar -- (the area to either side of the scroll bar
-- (the area to either side of the scroll bar -- body). This should expand as described in the
-- body). This should expand as described in the -- documentation for the scroll bar field.
-- documentation for the scroll bar field. , renderVScrollbarHandleBefore :: Widget n
, renderScrollbarHandleBefore :: Widget n -- ^ How to render the handle that appears at
-- ^ How to render the handle that appears at the -- the top or left of the scrollbar. The result
-- top or left of the scrollbar. The result should -- will be allowed to be at most one row high.
-- be at most one row high for horizontal handles , renderVScrollbarHandleAfter :: Widget n
-- and one column wide for vertical handles. -- ^ How to render the handle that appears at the
, renderScrollbarHandleAfter :: Widget n -- bottom or right of the scrollbar. The result
-- ^ How to render the handle that appears at -- will be allowed to be at most one row high.
-- the bottom or right of the scrollbar. The , scrollbarWidthAllocation :: Int
-- result should be at most one row high for -- ^ The number of columns that will be allocated
-- horizontal handles and one column wide for -- to the scroll bar. This determines how much
-- vertical handles. -- 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 = data VisibilityRequest =
VR { vrPosition :: Location VR { vrPosition :: Location
@ -405,9 +441,9 @@ data Context n =
, ctxAttrMap :: AttrMap , ctxAttrMap :: AttrMap
, ctxDynBorders :: Bool , ctxDynBorders :: Bool
, ctxVScrollBarOrientation :: Maybe VScrollBarOrientation , ctxVScrollBarOrientation :: Maybe VScrollBarOrientation
, ctxVScrollBarRenderer :: Maybe (ScrollbarRenderer n) , ctxVScrollBarRenderer :: Maybe (VScrollbarRenderer n)
, ctxHScrollBarOrientation :: Maybe HScrollBarOrientation , ctxHScrollBarOrientation :: Maybe HScrollBarOrientation
, ctxHScrollBarRenderer :: Maybe (ScrollbarRenderer n) , ctxHScrollBarRenderer :: Maybe (HScrollbarRenderer n)
, ctxVScrollBarShowHandles :: Bool , ctxVScrollBarShowHandles :: Bool
, ctxHScrollBarShowHandles :: Bool , ctxHScrollBarShowHandles :: Bool
, ctxVScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n) , ctxVScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n)

163
src/Brick/Widgets/Core.hs
View File

@ -101,7 +101,8 @@ module Brick.Widgets.Core
, withHScrollBarHandles , withHScrollBarHandles
, withVScrollBarRenderer , withVScrollBarRenderer
, withHScrollBarRenderer , withHScrollBarRenderer
, ScrollbarRenderer(..) , VScrollbarRenderer(..)
, HScrollbarRenderer(..)
, verticalScrollbarRenderer , verticalScrollbarRenderer
, horizontalScrollbarRenderer , horizontalScrollbarRenderer
, scrollbarAttr , scrollbarAttr
@ -1285,20 +1286,21 @@ withVScrollBarHandles w =
-- | Render vertical viewport scroll bars in the specified widget with -- | Render vertical viewport scroll bars in the specified widget with
-- the specified renderer. This is only needed if you want to override -- the specified renderer. This is only needed if you want to override
-- the use of the default renderer, 'verticalScrollbarRenderer'. -- the use of the default renderer, 'verticalScrollbarRenderer'.
withVScrollBarRenderer :: ScrollbarRenderer n -> Widget n -> Widget n withVScrollBarRenderer :: VScrollbarRenderer n -> Widget n -> Widget n
withVScrollBarRenderer r w = withVScrollBarRenderer r w =
Widget (hSize w) (vSize w) $ Widget (hSize w) (vSize w) $
withReaderT (ctxVScrollBarRendererL .~ Just r) (render w) withReaderT (ctxVScrollBarRendererL .~ Just r) (render w)
-- | The default renderer for vertical viewport scroll bars. Override -- | The default renderer for vertical viewport scroll bars. Override
-- with 'withVScrollBarRenderer'. -- with 'withVScrollBarRenderer'.
verticalScrollbarRenderer :: ScrollbarRenderer n verticalScrollbarRenderer :: VScrollbarRenderer n
verticalScrollbarRenderer = verticalScrollbarRenderer =
ScrollbarRenderer { renderScrollbar = fill '█' VScrollbarRenderer { renderVScrollbar = fill '█'
, renderScrollbarTrough = fill ' ' , renderVScrollbarTrough = fill ' '
, renderScrollbarHandleBefore = str "^" , renderVScrollbarHandleBefore = str "^"
, renderScrollbarHandleAfter = str "v" , renderVScrollbarHandleAfter = str "v"
} , scrollbarWidthAllocation = 1
}
-- | Enable horizontal scroll bars on all viewports in the specified -- | Enable horizontal scroll bars on all viewports in the specified
-- widget and draw them with the specified orientation. -- widget and draw them with the specified orientation.
@ -1343,20 +1345,21 @@ withHScrollBarHandles w =
-- | Render horizontal viewport scroll bars in the specified widget with -- | Render horizontal viewport scroll bars in the specified widget with
-- the specified renderer. This is only needed if you want to override -- the specified renderer. This is only needed if you want to override
-- the use of the default renderer, 'horizontalScrollbarRenderer'. -- the use of the default renderer, 'horizontalScrollbarRenderer'.
withHScrollBarRenderer :: ScrollbarRenderer n -> Widget n -> Widget n withHScrollBarRenderer :: HScrollbarRenderer n -> Widget n -> Widget n
withHScrollBarRenderer r w = withHScrollBarRenderer r w =
Widget (hSize w) (vSize w) $ Widget (hSize w) (vSize w) $
withReaderT (ctxHScrollBarRendererL .~ Just r) (render w) withReaderT (ctxHScrollBarRendererL .~ Just r) (render w)
-- | The default renderer for horizontal viewport scroll bars. Override -- | The default renderer for horizontal viewport scroll bars. Override
-- with 'withHScrollBarRenderer'. -- with 'withHScrollBarRenderer'.
horizontalScrollbarRenderer :: ScrollbarRenderer n horizontalScrollbarRenderer :: HScrollbarRenderer n
horizontalScrollbarRenderer = horizontalScrollbarRenderer =
ScrollbarRenderer { renderScrollbar = fill '█' HScrollbarRenderer { renderHScrollbar = fill '█'
, renderScrollbarTrough = fill ' ' , renderHScrollbarTrough = fill ' '
, renderScrollbarHandleBefore = str "<" , renderHScrollbarHandleBefore = str "<"
, renderScrollbarHandleAfter = str ">" , renderHScrollbarHandleAfter = str ">"
} , scrollbarHeightAllocation = 1
}
-- | Render the specified widget in a named viewport with the -- | Render the specified widget in a named viewport with the
-- specified type. This permits widgets to be scrolled without being -- specified type. This permits widgets to be scrolled without being
@ -1373,11 +1376,11 @@ horizontalScrollbarRenderer =
-- don't like the appearance of the resulting scroll bars (defaults: -- don't like the appearance of the resulting scroll bars (defaults:
-- 'verticalScrollbarRenderer' and 'horizontalScrollbarRenderer'), -- 'verticalScrollbarRenderer' and 'horizontalScrollbarRenderer'),
-- you can customize how they are drawn by making your own -- you can customize how they are drawn by making your own
-- 'ScrollbarRenderer' and using 'withVScrollBarRenderer' and/or -- 'VScrollbarRenderer' or 'HScrollbarRenderer' and using
-- 'withHScrollBarRenderer'. Note that when you enable scrollbars, the -- 'withVScrollBarRenderer' and/or 'withHScrollBarRenderer'. Note that
-- content of your viewport will lose one column of available space if -- when you enable scrollbars, the content of your viewport will lose
-- vertical scroll bars are enabled and one row of available space if -- one column of available space if vertical scroll bars are enabled and
-- horizontal scroll bars are enabled. -- one row of available space if horizontal scroll bars are enabled.
-- --
-- If a viewport receives more than one visibility request, then the -- If a viewport receives more than one visibility request, then the
-- visibility requests are merged with the inner visibility request -- visibility requests are merged with the inner visibility request
@ -1441,8 +1444,8 @@ viewport vpname typ p =
newSize = (newWidth, newHeight) newSize = (newWidth, newHeight)
newWidth = c^.availWidthL - vSBWidth newWidth = c^.availWidthL - vSBWidth
newHeight = c^.availHeightL - hSBHeight newHeight = c^.availHeightL - hSBHeight
vSBWidth = maybe 0 (const 1) vsOrientation vSBWidth = maybe 0 (const $ scrollbarWidthAllocation vsRenderer) vsOrientation
hSBHeight = maybe 0 (const 1) hsOrientation hSBHeight = maybe 0 (const $ scrollbarHeightAllocation hsRenderer) hsOrientation
doInsert (Just vp) = Just $ vp & vpSize .~ newSize doInsert (Just vp) = Just $ vp & vpSize .~ newSize
doInsert Nothing = Just newVp doInsert Nothing = Just newVp
@ -1542,7 +1545,8 @@ viewport vpname typ p =
let addVScrollbar = case vsOrientation of let addVScrollbar = case vsOrientation of
Nothing -> id Nothing -> id
Just orientation -> Just orientation ->
let sb = verticalScrollbar vsRenderer vpname let sb = verticalScrollbar vsRenderer orientation
vpname
vsbClickableConstr vsbClickableConstr
showVHandles showVHandles
(vpFinal^.vpSize._2) (vpFinal^.vpSize._2)
@ -1555,7 +1559,8 @@ viewport vpname typ p =
addHScrollbar = case hsOrientation of addHScrollbar = case hsOrientation of
Nothing -> id Nothing -> id
Just orientation -> Just orientation ->
let sb = horizontalScrollbar hsRenderer vpname let sb = horizontalScrollbar hsRenderer orientation
vpname
hsbClickableConstr hsbClickableConstr
showHHandles showHHandles
(vpFinal^.vpSize._1) (vpFinal^.vpSize._1)
@ -1609,7 +1614,7 @@ maybeClick :: (Ord n)
maybeClick _ Nothing _ w = w maybeClick _ Nothing _ w = w
maybeClick n (Just f) el w = clickable (f el n) 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. -- settings.
-- --
-- You probably don't want to use this directly; instead, -- You probably don't want to use this directly; instead,
@ -1618,8 +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@ -- render a scroll bar of your own, you can do so outside the @viewport@
-- context. -- context.
verticalScrollbar :: (Ord n) verticalScrollbar :: (Ord n)
=> ScrollbarRenderer n => VScrollbarRenderer n
-- ^ The renderer to use. -- ^ 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 -> n
-- ^ The viewport name associated with this scroll -- ^ The viewport name associated with this scroll
-- bar. -- bar.
@ -1634,24 +1644,35 @@ verticalScrollbar :: (Ord n)
-> Int -> Int
-- ^ The total viewport content height. -- ^ The total viewport content height.
-> Widget n -> Widget n
verticalScrollbar vsRenderer n constr False vpHeight vOffset contentHeight = verticalScrollbar vsRenderer o n constr showHandles vpHeight vOffset contentHeight =
verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight hLimit (scrollbarWidthAllocation vsRenderer) $
verticalScrollbar vsRenderer n constr True vpHeight vOffset contentHeight = applyPadding $
vBox [ maybeClick n constr SBHandleBefore $ if showHandles
hLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleBefore vsRenderer then vBox [ vLimit 1 $
, verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight maybeClick n constr SBHandleBefore $
, maybeClick n constr SBHandleAfter $ withDefAttr scrollbarHandleAttr $ renderVScrollbarHandleBefore vsRenderer
hLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleAfter 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) verticalScrollbar' :: (Ord n)
=> ScrollbarRenderer n => VScrollbarRenderer n
-- ^ The renderer to use. -- ^ The renderer to use.
-> n -> n
-- ^ The viewport name associated with this scroll -- ^ The viewport name associated with this scroll
-- bar. -- bar.
-> Maybe (ClickableScrollbarElement -> n -> n) -> 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 -> Int
-- ^ The total viewport height in effect. -- ^ The total viewport height in effect.
-> Int -> Int
@ -1660,7 +1681,7 @@ verticalScrollbar' :: (Ord n)
-- ^ The total viewport content height. -- ^ The total viewport content height.
-> Widget n -> Widget n
verticalScrollbar' vsRenderer _ _ vpHeight _ 0 = verticalScrollbar' vsRenderer _ _ vpHeight _ 0 =
hLimit 1 $ vLimit vpHeight $ renderScrollbarTrough vsRenderer vLimit vpHeight $ renderVScrollbarTrough vsRenderer
verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight = verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight =
Widget Fixed Greedy $ do Widget Fixed Greedy $ do
c <- getContext c <- getContext
@ -1692,22 +1713,21 @@ verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight =
sbAbove = maybeClick n constr SBTroughBefore $ sbAbove = maybeClick n constr SBTroughBefore $
withDefAttr scrollbarTroughAttr $ vLimit sbOffset $ withDefAttr scrollbarTroughAttr $ vLimit sbOffset $
renderScrollbarTrough vsRenderer renderVScrollbarTrough vsRenderer
sbBelow = maybeClick n constr SBTroughAfter $ sbBelow = maybeClick n constr SBTroughAfter $
withDefAttr scrollbarTroughAttr $ vLimit (ctxHeight - (sbOffset + sbSize)) $ withDefAttr scrollbarTroughAttr $ vLimit (ctxHeight - (sbOffset + sbSize)) $
renderScrollbarTrough vsRenderer renderVScrollbarTrough vsRenderer
sbMiddle = maybeClick n constr SBBar $ sbMiddle = maybeClick n constr SBBar $
withDefAttr scrollbarAttr $ vLimit sbSize $ renderScrollbar vsRenderer withDefAttr scrollbarAttr $ vLimit sbSize $ renderVScrollbar vsRenderer
sb = hLimit 1 $ sb = if sbSize == ctxHeight
if sbSize == ctxHeight
then vLimit sbSize $ then vLimit sbSize $
renderScrollbarTrough vsRenderer renderVScrollbarTrough vsRenderer
else vBox [sbAbove, sbMiddle, sbBelow] else vBox [sbAbove, sbMiddle, sbBelow]
render sb render sb
-- | Build a horizontal scroll bar using the specified render and -- | Build a horizontal scroll bar using the specified renderer and
-- settings. -- settings.
-- --
-- You probably don't want to use this directly; instead, use -- You probably don't want to use this directly; instead, use
@ -1716,14 +1736,21 @@ verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight =
-- render a scroll bar of your own, you can do so outside the @viewport@ -- render a scroll bar of your own, you can do so outside the @viewport@
-- context. -- context.
horizontalScrollbar :: (Ord n) horizontalScrollbar :: (Ord n)
=> ScrollbarRenderer n => HScrollbarRenderer n
-- ^ The renderer to use. -- ^ 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 -> n
-- ^ The viewport name associated with this scroll -- ^ The viewport name associated with this scroll
-- bar. -- bar.
-> Maybe (ClickableScrollbarElement -> n -> n) -> Maybe (ClickableScrollbarElement -> n -> n)
-- ^ Constructor for clickable scroll bar element -- ^ Constructor for clickable scroll bar element
-- names. -- names. Will be given the element name and the
-- viewport name.
-> Bool -> Bool
-- ^ Whether to show handles. -- ^ Whether to show handles.
-> Int -> Int
@ -1733,18 +1760,27 @@ horizontalScrollbar :: (Ord n)
-> Int -> Int
-- ^ The total viewport content width. -- ^ The total viewport content width.
-> Widget n -> Widget n
horizontalScrollbar hsRenderer n constr False vpWidth hOffset contentWidth = horizontalScrollbar hsRenderer o n constr showHandles vpWidth hOffset contentWidth =
horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth vLimit (scrollbarHeightAllocation hsRenderer) $
horizontalScrollbar hsRenderer n constr True vpWidth hOffset contentWidth = applyPadding $
hBox [ maybeClick n constr SBHandleBefore $ if showHandles
vLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleBefore hsRenderer then hBox [ hLimit 1 $
, horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth maybeClick n constr SBHandleBefore $
, maybeClick n constr SBHandleAfter $ withDefAttr scrollbarHandleAttr $ renderHScrollbarHandleBefore hsRenderer
vLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleAfter 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) horizontalScrollbar' :: (Ord n)
=> ScrollbarRenderer n => HScrollbarRenderer n
-- ^ The renderer to use. -- ^ The renderer to use.
-> n -> n
-- ^ The viewport name associated with this scroll -- ^ The viewport name associated with this scroll
@ -1760,7 +1796,7 @@ horizontalScrollbar' :: (Ord n)
-- ^ The total viewport content width. -- ^ The total viewport content width.
-> Widget n -> Widget n
horizontalScrollbar' hsRenderer _ _ vpWidth _ 0 = horizontalScrollbar' hsRenderer _ _ vpWidth _ 0 =
vLimit 1 $ hLimit vpWidth $ renderScrollbarTrough hsRenderer hLimit vpWidth $ renderHScrollbarTrough hsRenderer
horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth = horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth =
Widget Greedy Fixed $ do Widget Greedy Fixed $ do
c <- getContext c <- getContext
@ -1791,17 +1827,16 @@ horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth =
sbLeft = maybeClick n constr SBTroughBefore $ sbLeft = maybeClick n constr SBTroughBefore $
withDefAttr scrollbarTroughAttr $ hLimit sbOffset $ withDefAttr scrollbarTroughAttr $ hLimit sbOffset $
renderScrollbarTrough hsRenderer renderHScrollbarTrough hsRenderer
sbRight = maybeClick n constr SBTroughAfter $ sbRight = maybeClick n constr SBTroughAfter $
withDefAttr scrollbarTroughAttr $ hLimit (ctxWidth - (sbOffset + sbSize)) $ withDefAttr scrollbarTroughAttr $ hLimit (ctxWidth - (sbOffset + sbSize)) $
renderScrollbarTrough hsRenderer renderHScrollbarTrough hsRenderer
sbMiddle = maybeClick n constr SBBar $ sbMiddle = maybeClick n constr SBBar $
withDefAttr scrollbarAttr $ hLimit sbSize $ renderScrollbar hsRenderer withDefAttr scrollbarAttr $ hLimit sbSize $ renderHScrollbar hsRenderer
sb = vLimit 1 $ sb = if sbSize == ctxWidth
if sbSize == ctxWidth
then hLimit sbSize $ then hLimit sbSize $
renderScrollbarTrough hsRenderer renderHScrollbarTrough hsRenderer
else hBox [sbLeft, sbMiddle, sbRight] else hBox [sbLeft, sbMiddle, sbRight]
render sb render sb