Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-brick for openSUSE:Factory checked in at 2021-12-19 17:34:44 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-brick (Old) and /work/SRC/openSUSE:Factory/.ghc-brick.new.2520 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-brick" Sun Dec 19 17:34:44 2021 rev:18 rq:934280 version:0.65 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-brick/ghc-brick.changes 2021-11-11 21:36:20.688885274 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-brick.new.2520/ghc-brick.changes 2021-12-19 17:35:00.292288959 +0100 @@ -1,0 +2,46 @@ +Sat Nov 20 17:30:51 UTC 2021 - [email protected] + +- Update brick to version 0.65. + 0.65 + ---- + + New features and API changes: + * Viewports got support for built-in scroll bar rendering. This + includes additions of types and functions to manage the feature + behavior. These changes enable viewports to automatically get + scroll bars drawn next to them (on any side) with customizable + attributes and drawings. As part of this change, a new demo program, + `ViewportScrollbarsDemo.hs`, was added to show off these new + features. Here are the new types and functions that got added (mostly + to `Brick.Widgets.Core`): + * `withVScrollBars` - enable display of vertical scroll bars + * `withHScrollBars` - enable display of horizontal scroll bars + * `withClickableVScrollBars` - enable mouse click reporting on + vertical scroll bar elements + * `withClickableHScrollBars` - enable mouse click reporting on + horizontal scroll bar elements + * `ClickableScrollbarElement` - the type of elements of a scroll bar + that can be clicked on and provided to the application + * `withVScrollBarHandles` - enable vertical scroll bar handle drawing + * `withHScrollBarHandles` - enable horizontal scroll bar handle + drawing + * `withVScrollBarRenderer` - customize the renderer used for vertical + scroll bars + * `withHScrollBarRenderer` - customize the renderer used for + horizontal scroll bars + * `ScrollbarRenderer(..)` - the type of scroll bar renderer + implementations + * `verticalScrollbarRenderer` - the default renderer for vertical + scrollbars, customizable with `withVScrollBarRenderer` + * `horizontalScrollbarRenderer` - the default renderer for horizontal + scrollbars, customizable with `withHScrollBarRenderer` + * `scrollbarAttr` - the base attribute of scroll bars + * `scrollbarTroughAttr` - the attribute of scroll bar troughs + * `scrollbarHandleAttr` - the attribute of scroll bar handles + + Package changes: + * Raised `base` bounds to allow building with GHC 9.2.1 (thanks Mario + Lang) + * Stopped supporting GHC 7.10. + +------------------------------------------------------------------- Old: ---- brick-0.64.2.tar.gz New: ---- brick-0.65.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-brick.spec ++++++ --- /var/tmp/diff_new_pack.ytPzMM/_old 2021-12-19 17:35:00.720289261 +0100 +++ /var/tmp/diff_new_pack.ytPzMM/_new 2021-12-19 17:35:00.724289264 +0100 @@ -19,7 +19,7 @@ %global pkg_name brick %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.64.2 +Version: 0.65 Release: 0 Summary: A declarative terminal user interface library License: BSD-3-Clause ++++++ brick-0.64.2.tar.gz -> brick-0.65.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/CHANGELOG.md new/brick-0.65/CHANGELOG.md --- old/brick-0.64.2/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -2,6 +2,48 @@ Brick changelog --------------- +0.65 +---- + +New features and API changes: + * Viewports got support for built-in scroll bar rendering. This + includes additions of types and functions to manage the feature + behavior. These changes enable viewports to automatically get + scroll bars drawn next to them (on any side) with customizable + attributes and drawings. As part of this change, a new demo program, + `ViewportScrollbarsDemo.hs`, was added to show off these new + features. Here are the new types and functions that got added (mostly + to `Brick.Widgets.Core`): + * `withVScrollBars` - enable display of vertical scroll bars + * `withHScrollBars` - enable display of horizontal scroll bars + * `withClickableVScrollBars` - enable mouse click reporting on + vertical scroll bar elements + * `withClickableHScrollBars` - enable mouse click reporting on + horizontal scroll bar elements + * `ClickableScrollbarElement` - the type of elements of a scroll bar + that can be clicked on and provided to the application + * `withVScrollBarHandles` - enable vertical scroll bar handle drawing + * `withHScrollBarHandles` - enable horizontal scroll bar handle + drawing + * `withVScrollBarRenderer` - customize the renderer used for vertical + scroll bars + * `withHScrollBarRenderer` - customize the renderer used for + horizontal scroll bars + * `ScrollbarRenderer(..)` - the type of scroll bar renderer + implementations + * `verticalScrollbarRenderer` - the default renderer for vertical + scrollbars, customizable with `withVScrollBarRenderer` + * `horizontalScrollbarRenderer` - the default renderer for horizontal + scrollbars, customizable with `withHScrollBarRenderer` + * `scrollbarAttr` - the base attribute of scroll bars + * `scrollbarTroughAttr` - the attribute of scroll bar troughs + * `scrollbarHandleAttr` - the attribute of scroll bar handles + +Package changes: + * Raised `base` bounds to allow building with GHC 9.2.1 (thanks Mario + Lang) + * Stopped supporting GHC 7.10. + 0.64.2 ------ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/README.md new/brick-0.65/README.md --- old/brick-0.64.2/README.md 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/README.md 2001-09-09 03:46:40.000000000 +0200 @@ -2,8 +2,8 @@ `brick` is a Haskell terminal user interface (TUI) programming toolkit. To use it, you write a pure function that describes how your user -interface should look based on your current application state and you -provide a state transformation function to handle events. +interface should be drawn based on your current application state and +you provide a state transformation function to handle events. `brick` exposes a declarative API. Unlike most GUI toolkits which require you to write a long and tedious sequence of "create a widget, @@ -40,9 +40,9 @@ Featured Projects ----------------- -To get an idea of what some people have done with `brick`, take a look -at these projects. If you have made something and would like me to -include it, get in touch! +To get an idea of what some people have done with `brick`, check out +these projects. If you have made something and would like me to include +it, get in touch! | Project | Description | | ------- | ----------- | @@ -79,6 +79,8 @@ | [`sandwich`](https://codedownio.github.io/sandwich/) | A test framework with a TUI interface | | [`youbrick`](https://github.com/florentc/youbrick) | A feed aggregator and launcher for Youtube channels | | [`swarm`](https://github.com/byorgey/swarm/) | A 2D programming and resource gathering game | +| [`hledger-ui`](https://github.com/simonmichael/hledger) | A terminal UI for the hledger accounting system. | +| [`hledger-iadd`](http://github.com/rootzlevel/hledger-iadd) | An interactive terminal UI for adding hledger journal entries | These third-party packages also extend `brick`: @@ -124,18 +126,18 @@ * Vertical and horizontal box layout widgets * Basic single- and multi-line text editor widgets - * List widget + * List and table widgets * Progress bar widget * Simple dialog box widget * Border-drawing widgets (put borders around or in between things) - * Generic scrollable viewports + * Generic scrollable viewports and viewport scroll bars * General-purpose layout control combinators * Extensible widget-building API * User-customizable attribute themes * Type-safe, validated input form API (see the `Brick.Forms` module) * A filesystem browser for file and directory selection * Borders can be configured to automatically connect! - + Brick-Users Discussion ---------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/brick.cabal new/brick-0.65/brick.cabal --- old/brick-0.64.2/brick.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/brick.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ name: brick -version: 0.64.2 +version: 0.65 synopsis: A declarative terminal user interface library description: Write terminal user interfaces (TUIs) painlessly with 'brick'! You @@ -38,7 +38,7 @@ cabal-version: 1.18 Homepage: https://github.com/jtdaugherty/brick/ Bug-reports: https://github.com/jtdaugherty/brick/issues -tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.2 +tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.1 extra-doc-files: README.md, docs/guide.rst, @@ -114,7 +114,7 @@ Brick.Types.Internal Brick.Widgets.Internal - build-depends: base < 4.16.0.0, + build-depends: base >= 4.9.0.0 && < 4.17.0.0, vty >= 5.33, transformers, data-clist >= 0.1, @@ -137,8 +137,6 @@ unix, bytestring, word-wrap >= 0.2 - if impl(ghc < 8.0) - build-depends: semigroups executable brick-table-demo if !flag(demos) @@ -249,6 +247,20 @@ microlens >= 0.3.0.0, microlens-th +executable brick-viewport-scrollbars-demo + if !flag(demos) + Buildable: False + hs-source-dirs: programs + ghc-options: -threaded -Wall -Wcompat -O2 + default-language: Haskell2010 + default-extensions: CPP + main-is: ViewportScrollbarsDemo.hs + build-depends: base, + brick, + vty, + text, + microlens + executable brick-viewport-scroll-demo if !flag(demos) Buildable: False @@ -512,9 +524,7 @@ test-suite brick-tests type: exitcode-stdio-1.0 hs-source-dirs: tests - ghc-options: -Wall -Wcompat -O2 - if impl(ghc >= 8) - ghc-options: -Wno-orphans + ghc-options: -Wall -Wcompat -Wno-orphans -O2 default-language: Haskell2010 main-is: Main.hs other-modules: List @@ -524,5 +534,3 @@ microlens, vector, QuickCheck - if impl(ghc < 8.0) - build-depends: semigroups diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/docs/guide.rst new/brick-0.65/docs/guide.rst --- old/brick-0.64.2/docs/guide.rst 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/docs/guide.rst 2001-09-09 03:46:40.000000000 +0200 @@ -21,7 +21,7 @@ two important functions: - A *drawing function* that turns your application state into a - specification of how your interface should look, and + specification of how your interface should be drawn, and - An *event handler* that takes your application state and an input event and decides whether to change the state or quit the program. @@ -334,7 +334,7 @@ With this type declaration we can now use counter events in our app by using the application type ``App s CounterEvent n``. To handle these -events we'll just need to look for ``AppEvent`` values in the event +events we'll just need to check for ``AppEvent`` values in the event handler: .. code:: haskell @@ -391,8 +391,8 @@ your event handler when choosing the channel capacity and design event producers so that they can block if the channel is full. -Starting up: appStartEvent -************************** +appStartEvent: Starting up +-------------------------- When an application starts, it may be desirable to perform some of the duties typically only possible when an event has arrived, such as @@ -1232,6 +1232,22 @@ its selected item visible regardless of its size, which makes the list widget scrolling-unaware. +Showing Scroll Bars on Viewports +-------------------------------- + +Brick supports drawing both vertical and horizontal scroll bars on +viewports. To enable scroll bars, wrap your call to ``viewport`` with +a call to ``withVScrollBars`` and/or ``withHScrollBars``. If you don't +like the appearance of the resulting scroll bars, 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. + +For a demonstration of the scroll bar API in action, see the +``ViewportScrollbarsDemo.hs`` demonstration program. + Viewport Restrictions --------------------- @@ -1272,7 +1288,7 @@ A Form Example -------------- -Let's look at an example data type that we'd want to use as the +Let's consider an example data type that we'd want to use as the basis for an input interface. This example comes directly from the ``FormDemo.hs`` demonstration program. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/programs/BorderDemo.hs new/brick-0.65/programs/BorderDemo.hs --- old/brick-0.64.2/programs/BorderDemo.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/programs/BorderDemo.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,10 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif - #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/programs/CacheDemo.hs new/brick-0.65/programs/CacheDemo.hs --- old/brick-0.64.2/programs/CacheDemo.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/programs/CacheDemo.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,10 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - import Control.Monad (void) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/programs/MouseDemo.hs new/brick-0.65/programs/MouseDemo.hs --- old/brick-0.64.2/programs/MouseDemo.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/programs/MouseDemo.hs 2001-09-09 03:46:40.000000000 +0200 @@ -3,9 +3,6 @@ {-# LANGUAGE TemplateHaskell #-} module Main where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif import Lens.Micro ((^.), (&), (.~), (%~)) import Lens.Micro.TH (makeLenses) import Control.Monad (void) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/programs/TailDemo.hs new/brick-0.65/programs/TailDemo.hs --- old/brick-0.64.2/programs/TailDemo.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/programs/TailDemo.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,9 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/programs/ViewportScrollDemo.hs new/brick-0.65/programs/ViewportScrollDemo.hs --- old/brick-0.64.2/programs/ViewportScrollDemo.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/programs/ViewportScrollDemo.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,10 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - import Control.Monad (void) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/programs/ViewportScrollbarsDemo.hs new/brick-0.65/programs/ViewportScrollbarsDemo.hs --- old/brick-0.64.2/programs/ViewportScrollbarsDemo.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/brick-0.65/programs/ViewportScrollbarsDemo.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,149 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Control.Monad (void) +#if !(MIN_VERSION_base(4,11,0)) +import Data.Monoid ((<>)) +#endif +import qualified Graphics.Vty as V + +import qualified Brick.Types as T +import qualified Brick.Main as M +import qualified Brick.Widgets.Center as C +import qualified Brick.Widgets.Border as B +import Brick.Types + ( Widget + , ViewportType(Horizontal, Both) + , VScrollBarOrientation(..) + , HScrollBarOrientation(..) + ) +import Brick.Util + ( fg + ) +import Brick.AttrMap + ( AttrMap + , attrMap + ) +import Brick.Widgets.Core + ( hLimit + , vLimit + , padRight + , hBox + , vBox + , viewport + , str + , fill + , withVScrollBars + , withHScrollBars + , withHScrollBarRenderer + , withVScrollBarHandles + , withHScrollBarHandles + , withClickableHScrollBars + , withClickableVScrollBars + , ScrollbarRenderer(..) + , scrollbarAttr + , scrollbarHandleAttr + ) + +customScrollbars :: ScrollbarRenderer n +customScrollbars = + ScrollbarRenderer { renderScrollbar = fill '^' + , renderScrollbarTrough = fill ' ' + , renderScrollbarHandleBefore = str "<<" + , renderScrollbarHandleAfter = str ">>" + } + +data Name = VP1 | VP2 | SBClick T.ClickableScrollbarElement Name + deriving (Ord, Show, Eq) + +data St = St { lastClickedElement :: Maybe (T.ClickableScrollbarElement, Name) } + +drawUi :: St -> [Widget Name] +drawUi st = [ui] + where + ui = C.center $ hLimit 70 $ vLimit 21 $ + (vBox [ pair + , C.hCenter (str "Last clicked scroll bar element:") + , str $ show $ lastClickedElement st + ]) + pair = hBox [ padRight (T.Pad 5) $ + B.border $ + withClickableHScrollBars SBClick $ + withHScrollBars OnBottom $ + withHScrollBarRenderer customScrollbars $ + withHScrollBarHandles $ + viewport VP1 Horizontal $ + str $ "Press left and right arrow keys to scroll this viewport.\n" <> + "This viewport uses a\n" <> + "custom scroll bar renderer!" + , B.border $ + withClickableVScrollBars SBClick $ + withVScrollBars OnLeft $ + withVScrollBarHandles $ + viewport VP2 Both $ + vBox $ str "Press ctrl-arrow keys to scroll this viewport horizontally and vertically." + : (str <$> [ "Line " <> show i | i <- [2..55::Int] ]) + ] + +vp1Scroll :: M.ViewportScroll Name +vp1Scroll = M.viewportScroll VP1 + +vp2Scroll :: M.ViewportScroll Name +vp2Scroll = M.viewportScroll VP2 + +appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St) +appEvent st (T.VtyEvent (V.EvKey V.KRight [])) = M.hScrollBy vp1Scroll 1 >> M.continue st +appEvent st (T.VtyEvent (V.EvKey V.KLeft [])) = M.hScrollBy vp1Scroll (-1) >> M.continue st +appEvent st (T.VtyEvent (V.EvKey V.KDown [])) = M.vScrollBy vp2Scroll 1 >> M.continue st +appEvent st (T.VtyEvent (V.EvKey V.KUp [])) = M.vScrollBy vp2Scroll (-1) >> M.continue st +appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st +appEvent st (T.MouseDown (SBClick el n) _ _ _) = do + case n of + VP1 -> do + let vp = M.viewportScroll VP1 + case el of + T.SBHandleBefore -> M.hScrollBy vp (-1) + T.SBHandleAfter -> M.hScrollBy vp 1 + T.SBTroughBefore -> M.hScrollBy vp (-10) + T.SBTroughAfter -> M.hScrollBy vp 10 + T.SBBar -> return () + VP2 -> do + let vp = M.viewportScroll VP2 + case el of + T.SBHandleBefore -> M.vScrollBy vp (-1) + T.SBHandleAfter -> M.vScrollBy vp 1 + T.SBTroughBefore -> M.vScrollBy vp (-10) + T.SBTroughAfter -> M.vScrollBy vp 10 + T.SBBar -> return () + _ -> + return () + + M.continue $ st { lastClickedElement = Just (el, n) } +appEvent st _ = M.continue st + +theme :: AttrMap +theme = + attrMap V.defAttr $ + [ (scrollbarAttr, fg V.white) + , (scrollbarHandleAttr, fg V.brightYellow) + ] + +app :: M.App St e Name +app = + M.App { M.appDraw = drawUi + , M.appStartEvent = return + , M.appHandleEvent = appEvent + , M.appAttrMap = const theme + , M.appChooseCursor = M.neverShowCursor + } + +main :: IO () +main = do + let buildVty = do + v <- V.mkVty =<< V.standardIOConfig + V.setMode (V.outputIface v) V.Mouse True + return v + + initialVty <- buildVty + void $ M.customMain initialVty buildVty Nothing app (St Nothing) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Brick/AttrMap.hs new/brick-0.65/src/Brick/AttrMap.hs --- old/brick-0.64.2/src/Brick/AttrMap.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Brick/AttrMap.hs 2001-09-09 03:46:40.000000000 +0200 @@ -45,11 +45,6 @@ ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -import Data.Monoid -#endif - import qualified Data.Semigroup as Sem import Control.DeepSeq diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Brick/BChan.hs new/brick-0.65/src/Brick/BChan.hs --- old/brick-0.64.2/src/Brick/BChan.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Brick/BChan.hs 2001-09-09 03:46:40.000000000 +0200 @@ -8,10 +8,6 @@ ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif - import Control.Concurrent.STM.TBQueue import Control.Monad.STM (atomically, orElse) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Brick/Forms.hs new/brick-0.65/src/Brick/Forms.hs --- old/brick-0.64.2/src/Brick/Forms.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Brick/Forms.hs 2001-09-09 03:46:40.000000000 +0200 @@ -88,7 +88,7 @@ #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif -import Data.Maybe (isJust, isNothing) +import Data.Maybe (fromJust, isJust, isNothing) import Data.List (elemIndex) import Data.Vector (Vector) @@ -807,13 +807,13 @@ entryAfter :: (Eq a) => [a] -> a -> a entryAfter as a = - let Just i = elemIndex a as + let i = fromJust $ elemIndex a as i' = if i == length as - 1 then 0 else i + 1 in as !! i' entryBefore :: (Eq a) => [a] -> a -> a entryBefore as a = - let Just i = elemIndex a as + let i = fromJust $ elemIndex a as i' = if i == 0 then length as - 1 else i - 1 in as !! i' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Brick/Main.hs new/brick-0.65/src/Brick/Main.hs --- old/brick-0.64.2/src/Brick/Main.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Brick/Main.hs 2001-09-09 03:46:40.000000000 +0200 @@ -56,10 +56,6 @@ import Control.Monad.Trans.State import Control.Monad.Trans.Reader import Control.Concurrent (forkIO, killThread) -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -import Data.Monoid (mempty) -#endif import qualified Data.Foldable as F import Data.Maybe (listToMaybe) import qualified Data.Map as M @@ -82,7 +78,7 @@ import Graphics.Vty.Attributes (defAttr) import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan) -import Brick.Types (Widget, EventM(..)) +import Brick.Types (EventM(..)) import Brick.Types.Internal import Brick.Widgets.Internal import Brick.AttrMap diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Brick/Types/Internal.hs new/brick-0.65/src/Brick/Types/Internal.hs --- old/brick-0.64.2/src/Brick/Types/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Brick/Types/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -20,7 +20,30 @@ , cursorLocationL , cursorLocationNameL , cursorLocationVisibleL + , VScrollBarOrientation(..) + , HScrollBarOrientation(..) + , ScrollbarRenderer(..) + , ClickableScrollbarElement(..) , Context(..) + , ctxAttrMapL + , ctxAttrNameL + , ctxBorderStyleL + , ctxDynBordersL + , ctxVScrollBarOrientationL + , ctxVScrollBarRendererL + , ctxHScrollBarOrientationL + , ctxHScrollBarRendererL + , ctxVScrollBarShowHandlesL + , ctxHScrollBarShowHandlesL + , ctxVScrollBarClickableConstrL + , ctxHScrollBarClickableConstrL + , availWidthL + , availHeightL + , windowWidthL + , windowHeightL + + , Size(..) + , EventState(..) , EventRO(..) , Next(..) @@ -34,6 +57,9 @@ , dbStyleL, dbAttrL, dbSegmentsL , CacheInvalidateRequest(..) , BrickEvent(..) + , RenderM + , getContext + , Widget(..) , rsScrollRequestsL , viewportMapL @@ -53,10 +79,8 @@ ) where -#if !MIN_VERSION_base(4,8,0) -import Data.Monoid -#endif - +import Control.Monad.Trans.Reader +import Control.Monad.Trans.State.Lazy import Lens.Micro (_1, _2, Lens') import Lens.Micro.TH (makeLenses) import qualified Data.Set as S @@ -84,6 +108,83 @@ | SetLeft Int deriving (Read, Show, Generic, NFData) +-- | Widget size policies. These policies communicate how a widget uses +-- space when being rendered. These policies influence rendering order +-- and space allocation in the box layout algorithm for 'hBox' and +-- 'vBox'. +data Size = Fixed + -- ^ Widgets advertising this size policy should take up the + -- same amount of space no matter how much they are given, + -- i.e. their size depends on their contents alone rather than + -- on the size of the rendering area. + | Greedy + -- ^ Widgets advertising this size policy must take up all the + -- space they are given. + deriving (Show, Eq, Ord) + +-- | The type of widgets. +data Widget n = + Widget { hSize :: Size + -- ^ This widget's horizontal growth policy + , vSize :: Size + -- ^ This widget's vertical growth policy + , render :: RenderM n (Result n) + -- ^ This widget's rendering function + } + +data RenderState n = + RS { viewportMap :: !(M.Map n Viewport) + , rsScrollRequests :: ![(n, ScrollRequest)] + , observedNames :: !(S.Set n) + , renderCache :: !(M.Map n ([n], Result n)) + , clickableNames :: ![n] + } deriving (Read, Show, Generic, NFData) + +-- | The type of the rendering monad. This monad is used by the +-- library's rendering routines to manage rendering state and +-- communicate rendering parameters to widgets' rendering functions. +type RenderM n a = ReaderT (Context n) (State (RenderState n)) a + +-- | Get the current rendering context. +getContext :: RenderM n (Context n) +getContext = ask + +-- | Orientations for vertical scroll bars. +data VScrollBarOrientation = OnLeft | OnRight + deriving (Show, Eq) + +-- | Orientations for horizontal scroll bars. +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. + } + data VisibilityRequest = VR { vrPosition :: Location , vrSize :: DisplayRegion @@ -183,8 +284,6 @@ -- ^ Should this segment be represented visually? } deriving (Eq, Ord, Read, Show, Generic, NFData) -suffixLenses ''BorderSegment - -- | Information about how to redraw a dynamic border character when it abuts -- another dynamic border character. data DynBorder = DynBorder @@ -199,8 +298,6 @@ , dbSegments :: Edges BorderSegment } deriving (Eq, Read, Show, Generic, NFData) -suffixLenses ''DynBorder - -- | The type of result returned by a widget's rendering function. The -- result provides the image, cursor positions, and visibility requests -- that resulted from the rendering process. @@ -232,8 +329,6 @@ } deriving (Show, Read, Generic, NFData) -suffixLenses ''Result - emptyResult :: Result n emptyResult = Result emptyImage [] [] [] BM.empty @@ -252,25 +347,31 @@ -- the clicked widget (see 'clickable'). deriving (Show, Eq, Ord) -data RenderState n = - RS { viewportMap :: !(M.Map n Viewport) - , rsScrollRequests :: ![(n, ScrollRequest)] - , observedNames :: !(S.Set n) - , renderCache :: !(M.Map n ([n], Result n)) - , clickableNames :: ![n] - } deriving (Read, Show, Generic, NFData) - data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport , eventVtyHandle :: Vty , latestExtents :: [Extent n] , oldState :: RenderState n } +-- | Clickable elements of a scroll bar. +data ClickableScrollbarElement = + SBHandleBefore + -- ^ The handle at the beginning (left/top) of the scroll bar. + | SBHandleAfter + -- ^ The handle at the end (right/bottom) of the scroll bar. + | SBBar + -- ^ The scroll bar itself. + | SBTroughBefore + -- ^ The trough before the scroll bar. + | SBTroughAfter + -- ^ The trough after the scroll bar. + deriving (Eq, Show, Ord) + -- | The rendering context. This tells widgets how to render: how much -- space they have in which to render, which attribute they should use -- to render, which bordering style should be used, and the attribute map -- available for rendering. -data Context = +data Context n = Context { ctxAttrName :: AttrName , availWidth :: Int , availHeight :: Int @@ -279,10 +380,21 @@ , ctxBorderStyle :: BorderStyle , ctxAttrMap :: AttrMap , ctxDynBorders :: Bool + , ctxVScrollBarOrientation :: Maybe VScrollBarOrientation + , ctxVScrollBarRenderer :: Maybe (ScrollbarRenderer n) + , ctxHScrollBarOrientation :: Maybe HScrollBarOrientation + , ctxHScrollBarRenderer :: Maybe (ScrollbarRenderer n) + , ctxVScrollBarShowHandles :: Bool + , ctxHScrollBarShowHandles :: Bool + , ctxVScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n) + , ctxHScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n) } - deriving Show suffixLenses ''RenderState suffixLenses ''VisibilityRequest suffixLenses ''CursorLocation +suffixLenses ''Context +suffixLenses ''DynBorder +suffixLenses ''Result +suffixLenses ''BorderSegment makeLenses ''Viewport diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Brick/Types.hs new/brick-0.65/src/Brick/Types.hs --- old/brick-0.64.2/src/Brick/Types.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Brick/Types.hs 2001-09-09 03:46:40.000000000 +0200 @@ -22,6 +22,10 @@ , vpTop , vpLeft , vpContentSize + , VScrollBarOrientation(..) + , HScrollBarOrientation(..) + , ScrollbarRenderer(..) + , ClickableScrollbarElement(..) -- * Event-handling types , EventM(..) @@ -40,6 +44,10 @@ , availHeightL , windowWidthL , windowHeightL + , ctxVScrollBarOrientationL + , ctxVScrollBarRendererL + , ctxHScrollBarOrientationL + , ctxHScrollBarRendererL , ctxAttrMapL , ctxAttrNameL , ctxBorderStyleL @@ -84,11 +92,6 @@ ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Monoid (Monoid(..)) -#endif - import Lens.Micro (_1, _2, to, (^.), (&), (.~), Lens') import Lens.Micro.Type (Getting) import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask) @@ -139,43 +142,8 @@ , MonadThrow, MonadCatch, MonadMask, MonadFail ) --- | Widget size policies. These policies communicate how a widget uses --- space when being rendered. These policies influence rendering order --- and space allocation in the box layout algorithm for 'hBox' and --- 'vBox'. -data Size = Fixed - -- ^ Widgets advertising this size policy should take up the - -- same amount of space no matter how much they are given, - -- i.e. their size depends on their contents alone rather than - -- on the size of the rendering area. - | Greedy - -- ^ Widgets advertising this size policy must take up all the - -- space they are given. - deriving (Show, Eq, Ord) - --- | The type of widgets. -data Widget n = - Widget { hSize :: Size - -- ^ This widget's horizontal growth policy - , vSize :: Size - -- ^ This widget's vertical growth policy - , render :: RenderM n (Result n) - -- ^ This widget's rendering function - } - --- | The type of the rendering monad. This monad is used by the --- library's rendering routines to manage rendering state and --- communicate rendering parameters to widgets' rendering functions. -type RenderM n a = ReaderT Context (State (RenderState n)) a - --- | Get the current rendering context. -getContext :: RenderM n Context -getContext = ask - -suffixLenses ''Context - -- | The rendering context's current drawing attribute. -attrL :: forall r. Getting r Context Attr +attrL :: forall r n. Getting r (Context n) Attr attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL)) instance TerminalLocation (CursorLocation n) where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Brick/Widgets/Border.hs new/brick-0.65/src/Brick/Widgets/Border.hs --- old/brick-0.64.2/src/Brick/Widgets/Border.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Brick/Widgets/Border.hs 2001-09-09 03:46:40.000000000 +0200 @@ -26,10 +26,6 @@ ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif - import Lens.Micro ((^.), (&), (.~), to) import Graphics.Vty (imageHeight, imageWidth) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Brick/Widgets/Core.hs new/brick-0.65/src/Brick/Widgets/Core.hs --- old/brick-0.64.2/src/Brick/Widgets/Core.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Brick/Widgets/Core.hs 2001-09-09 03:46:40.000000000 +0200 @@ -88,6 +88,24 @@ , unsafeLookupViewport , cached + -- ** Viewport scroll bars + , withVScrollBars + , withHScrollBars + , withClickableHScrollBars + , withClickableVScrollBars + , withVScrollBarHandles + , withHScrollBarHandles + , withVScrollBarRenderer + , withHScrollBarRenderer + , ScrollbarRenderer(..) + , verticalScrollbarRenderer + , horizontalScrollbarRenderer + , scrollbarAttr + , scrollbarTroughAttr + , scrollbarHandleAttr + , verticalScrollbar + , horizontalScrollbar + -- ** Adding offsets to cursor positions and visibility requests , addResultOffset @@ -100,11 +118,6 @@ import Data.Monoid ((<>)) #endif -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Monoid ((<>), mempty) -#endif - import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, Lens') import Lens.Micro.Mtl (use, (%=)) import Control.Monad ((>=>),when) @@ -119,6 +132,7 @@ import qualified Data.IMap as I import qualified Data.Function as DF import Data.List (sortBy, partition) +import Data.Maybe (fromMaybe) import qualified Graphics.Vty as V import Control.DeepSeq @@ -466,8 +480,8 @@ -- have one implementation for box layout and parameterizing on the -- orientation of all of the operations. data BoxRenderer n = - BoxRenderer { contextPrimary :: Lens' Context Int - , contextSecondary :: Lens' Context Int + BoxRenderer { contextPrimary :: Lens' (Context n) Int + , contextSecondary :: Lens' (Context n) Int , imagePrimary :: V.Image -> Int , imageSecondary :: V.Image -> Int , limitPrimary :: Int -> Widget n -> Widget n @@ -1058,6 +1072,92 @@ cacheUpdate :: Ord n => n -> ([n], Result n) -> RenderM n () cacheUpdate n r = lift $ modify (renderCacheL %~ M.insert n r) +-- | Enable vertical scroll bars on all viewports in the specified +-- widget and draw them with the specified orientation. +withVScrollBars :: VScrollBarOrientation -> Widget n -> Widget n +withVScrollBars orientation w = + Widget (hSize w) (vSize w) $ + withReaderT (ctxVScrollBarOrientationL .~ Just orientation) (render w) + +-- | Enable scroll bar handles on all vertical scroll bars in the +-- specified widget. This will only have an effect if 'withVScrollBars' +-- is also called. +withVScrollBarHandles :: Widget n -> Widget n +withVScrollBarHandles w = + Widget (hSize w) (vSize w) $ + withReaderT (ctxVScrollBarShowHandlesL .~ True) (render 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 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 = + ScrollbarRenderer { renderScrollbar = fill '???' + , renderScrollbarTrough = fill ' ' + , renderScrollbarHandleBefore = str "^" + , renderScrollbarHandleAfter = str "v" + } + +-- | Enable horizontal scroll bars on all viewports in the specified +-- widget and draw them with the specified orientation. +withHScrollBars :: HScrollBarOrientation -> Widget n -> Widget n +withHScrollBars orientation w = + Widget (hSize w) (vSize w) $ + withReaderT (ctxHScrollBarOrientationL .~ Just orientation) (render w) + +-- | Enable mouse click reporting on horizontal scroll bars in the +-- specified widget. This must be used with 'withHScrollBars'. The +-- provided function is used to build a resource name containing the +-- scroll bar element clicked and the viewport name associated with the +-- scroll bar. It is usually a data constructor of the @n@ type. +withClickableHScrollBars :: (ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n +withClickableHScrollBars f w = + Widget (hSize w) (vSize w) $ + withReaderT (ctxHScrollBarClickableConstrL .~ Just f) (render w) + +-- | Enable mouse click reporting on vertical scroll bars in the +-- specified widget. This must be used with 'withVScrollBars'. The +-- provided function is used to build a resource name containing the +-- scroll bar element clicked and the viewport name associated with the +-- scroll bar. It is usually a data constructor of the @n@ type. +withClickableVScrollBars :: (ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n +withClickableVScrollBars f w = + Widget (hSize w) (vSize w) $ + withReaderT (ctxVScrollBarClickableConstrL .~ Just f) (render w) + +-- | Enable scroll bar handles on all horizontal scroll bars in the +-- specified widget. This will only have an effect if 'withHScrollBars' +-- is also called. +withHScrollBarHandles :: Widget n -> Widget n +withHScrollBarHandles w = + Widget (hSize w) (vSize w) $ + withReaderT (ctxHScrollBarShowHandlesL .~ True) (render 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 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 = + ScrollbarRenderer { renderScrollbar = fill '???' + , renderScrollbarTrough = fill ' ' + , renderScrollbarHandleBefore = str "<" + , renderScrollbarHandleAfter = str ">" + } + -- | Render the specified widget in a named viewport with the -- specified type. This permits widgets to be scrolled without being -- scrolling-aware. To make the most use of viewports, the specified @@ -1067,6 +1167,18 @@ -- 'Brick.Main.EventM' monad provides primitives to scroll viewports -- created by this function if 'visible' is not what you want. -- +-- This function can automatically render vertical and horizontal scroll +-- bars if desired. To enable scroll bars, wrap your call to 'viewport' +-- with a call to 'withVScrollBars' and/or 'withHScrollBars'. If you +-- 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. +-- -- If a viewport receives more than one visibility request, then the -- visibility requests are merged with the inner visibility request -- taking preference. If a viewport receives more than one scrolling @@ -1091,6 +1203,17 @@ -> Widget n viewport vpname typ p = clickable vpname $ Widget Greedy Greedy $ do + -- Obtain the scroll bar configuration. + c <- getContext + let vsOrientation = ctxVScrollBarOrientation c + hsOrientation = ctxHScrollBarOrientation c + vsRenderer = fromMaybe verticalScrollbarRenderer (ctxVScrollBarRenderer c) + hsRenderer = fromMaybe horizontalScrollbarRenderer (ctxHScrollBarRenderer c) + showVHandles = ctxVScrollBarShowHandles c + showHHandles = ctxHScrollBarShowHandles c + vsbClickableConstr = ctxVScrollBarClickableConstr c + hsbClickableConstr = ctxHScrollBarClickableConstr c + -- Observe the viewport name so we can detect multiple uses of the -- name. let observeName :: (Ord n, Show n) => n -> RenderM n () @@ -1109,9 +1232,10 @@ observeName vpname -- Update the viewport size. - c <- getContext let newVp = VP 0 0 newSize (0, 0) - newSize = (c^.availWidthL, c^.availHeightL) + newSize = (c^.availWidthL - vSBWidth, c^.availHeightL - hSBHeight) + vSBWidth = maybe 0 (const 1) vsOrientation + hSBHeight = maybe 0 (const 1) hsOrientation doInsert (Just vp) = Just $ vp & vpSize .~ newSize doInsert Nothing = Just newVp @@ -1204,6 +1328,35 @@ translated <- render $ translateBy (Location (-1 * vpFinal^.vpLeft, -1 * vpFinal^.vpTop)) $ Widget Fixed Fixed $ return initialResult + -- If the vertical scroll bar is enabled, render the scroll bar + -- area. + let addVScrollbar = case vsOrientation of + Nothing -> id + Just orientation -> + let sb = verticalScrollbar vsRenderer vpname + vsbClickableConstr + showVHandles + (vpFinal^.vpSize._2) + (vpFinal^.vpTop) + (vpFinal^.vpContentSize._2) + combine = case orientation of + OnLeft -> (<+>) + OnRight -> flip (<+>) + in combine sb + addHScrollbar = case hsOrientation of + Nothing -> id + Just orientation -> + let sb = horizontalScrollbar hsRenderer vpname + hsbClickableConstr + showHHandles + (vpFinal^.vpSize._1) + (vpFinal^.vpLeft) + (vpFinal^.vpContentSize._1) + combine = case orientation of + OnTop -> (<=>) + OnBottom -> flip (<=>) + in combine sb + -- Return the translated result with the visibility requests -- discarded let translatedSize = ( translated^.imageL.to V.imageWidth @@ -1215,12 +1368,231 @@ return $ translated & imageL .~ spaceFill & visibilityRequestsL .~ mempty & extentsL .~ mempty - _ -> render $ cropToContext + _ -> render $ addVScrollbar + $ addHScrollbar + $ cropToContext + $ vLimit (vpFinal^.vpSize._2) + $ hLimit (vpFinal^.vpSize._1) $ padBottom Max $ padRight Max $ Widget Fixed Fixed $ return $ translated & visibilityRequestsL .~ mempty +-- | The base attribute for scroll bars. +scrollbarAttr :: AttrName +scrollbarAttr = "scrollbar" + +-- | The attribute for scroll bar troughs. This attribute is a +-- specialization of @scrollbarAttr@. +scrollbarTroughAttr :: AttrName +scrollbarTroughAttr = scrollbarAttr <> "trough" + +-- | The attribute for scroll bar handles. This attribute is a +-- specialization of @scrollbarAttr@. +scrollbarHandleAttr :: AttrName +scrollbarHandleAttr = scrollbarAttr <> "handle" + +maybeClick :: n + -> Maybe (ClickableScrollbarElement -> n -> n) + -> ClickableScrollbarElement + -> Widget n + -> Widget 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 +-- settings. +-- +-- You probably don't want to use this directly; instead, +-- use @viewport@, @withVScrollBars@, and, if needed, +-- @withVScrollBarRenderer@. This is exposed so that if you want to +-- render a scroll bar of your own, you can do so outside the @viewport@ +-- context. +verticalScrollbar :: ScrollbarRenderer 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. + -> Bool + -- ^ Whether to display handles. + -> Int + -- ^ The total viewport height in effect. + -> Int + -- ^ The viewport vertical scrolling offset in effect. + -> 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' :: ScrollbarRenderer 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. + -> Int + -- ^ The total viewport height in effect. + -> Int + -- ^ The viewport vertical scrolling offset in effect. + -> Int + -- ^ The total viewport content height. + -> Widget n +verticalScrollbar' vsRenderer _ _ vpHeight _ 0 = + hLimit 1 $ vLimit vpHeight $ renderScrollbarTrough vsRenderer +verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight = + Widget Fixed Greedy $ do + c <- getContext + + -- Get the proportion of the total content that is visible + let visibleContentPercent :: Double + visibleContentPercent = fromIntegral vpHeight / + fromIntegral contentHeight + + ctxHeight = c^.availHeightL + + -- Then get the proportion of the scroll bar that + -- should be filled in + sbSize = min ctxHeight $ + max 1 $ + round $ visibleContentPercent * (fromIntegral ctxHeight) + + -- Then get the vertical offset of the scroll bar + -- itself + sbOffset = if vOffset == 0 + then 0 + else if vOffset == contentHeight - vpHeight + then ctxHeight - sbSize + else min (ctxHeight - sbSize - 1) $ + max 1 $ + round $ fromIntegral ctxHeight * + (fromIntegral vOffset / + fromIntegral contentHeight::Double) + + sbAbove = maybeClick n constr SBTroughBefore $ + withDefAttr scrollbarTroughAttr $ vLimit sbOffset $ + renderScrollbarTrough vsRenderer + sbBelow = maybeClick n constr SBTroughAfter $ + withDefAttr scrollbarTroughAttr $ vLimit (ctxHeight - (sbOffset + sbSize)) $ + renderScrollbarTrough vsRenderer + sbMiddle = maybeClick n constr SBBar $ + withDefAttr scrollbarAttr $ vLimit sbSize $ renderScrollbar vsRenderer + + sb = hLimit 1 $ + if sbSize == ctxHeight + then vLimit sbSize $ + renderScrollbarTrough vsRenderer + else vBox [sbAbove, sbMiddle, sbBelow] + + render sb + +-- | Build a horizontal scroll bar using the specified render and +-- settings. +-- +-- You probably don't want to use this directly; instead, use +-- @viewport@, @withHScrollBars@, and, if needed, +-- @withHScrollBarRenderer@. This is exposed so that if you want to +-- render a scroll bar of your own, you can do so outside the @viewport@ +-- context. +horizontalScrollbar :: ScrollbarRenderer 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. + -> Bool + -- ^ Whether to show handles. + -> Int + -- ^ The total viewport width in effect. + -> Int + -- ^ The viewport horizontal scrolling offset in effect. + -> 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' :: ScrollbarRenderer 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. + -> Int + -- ^ The total viewport width in effect. + -> Int + -- ^ The viewport horizontal scrolling offset in effect. + -> Int + -- ^ The total viewport content width. + -> Widget n +horizontalScrollbar' hsRenderer _ _ vpWidth _ 0 = + vLimit 1 $ hLimit vpWidth $ renderScrollbarTrough hsRenderer +horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth = + Widget Greedy Fixed $ do + c <- getContext + + -- Get the proportion of the total content that is visible + let visibleContentPercent :: Double + visibleContentPercent = fromIntegral vpWidth / + fromIntegral contentWidth + + ctxWidth = c^.availWidthL + + -- Then get the proportion of the scroll bar that + -- should be filled in + sbSize = min ctxWidth $ + max 1 $ + round $ visibleContentPercent * (fromIntegral ctxWidth) + + -- Then get the horizontal offset of the scroll bar itself + sbOffset = if hOffset == 0 + then 0 + else if hOffset == contentWidth - vpWidth + then ctxWidth - sbSize + else min (ctxWidth - sbSize - 1) $ + max 1 $ + round $ fromIntegral ctxWidth * + (fromIntegral hOffset / + fromIntegral contentWidth::Double) + + sbLeft = maybeClick n constr SBTroughBefore $ + withDefAttr scrollbarTroughAttr $ hLimit sbOffset $ + renderScrollbarTrough hsRenderer + sbRight = maybeClick n constr SBTroughAfter $ + withDefAttr scrollbarTroughAttr $ hLimit (ctxWidth - (sbOffset + sbSize)) $ + renderScrollbarTrough hsRenderer + sbMiddle = maybeClick n constr SBBar $ + withDefAttr scrollbarAttr $ hLimit sbSize $ renderScrollbar hsRenderer + + sb = vLimit 1 $ + if sbSize == ctxWidth + then hLimit sbSize $ + renderScrollbarTrough hsRenderer + else hBox [sbLeft, sbMiddle, sbRight] + + render sb + -- | Given a name, obtain the viewport for that name by consulting the -- viewport map in the rendering monad. NOTE! Some care must be taken -- when calling this function, since it only returns useful values diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Brick/Widgets/Dialog.hs new/brick-0.65/src/Brick/Widgets/Dialog.hs --- old/brick-0.64.2/src/Brick/Widgets/Dialog.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Brick/Widgets/Dialog.hs 2001-09-09 03:46:40.000000000 +0200 @@ -36,10 +36,6 @@ ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - import Lens.Micro #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Brick/Widgets/Internal.hs new/brick-0.65/src/Brick/Widgets/Internal.hs --- old/brick-0.64.2/src/Brick/Widgets/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Brick/Widgets/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -7,10 +7,6 @@ ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - import Lens.Micro ((^.), (&), (%~)) import Control.Monad.Trans.State.Lazy import Control.Monad.Trans.Reader @@ -45,6 +41,14 @@ , ctxBorderStyle = defaultBorderStyle , ctxAttrMap = aMap , ctxDynBorders = False + , ctxVScrollBarOrientation = Nothing + , ctxVScrollBarRenderer = Nothing + , ctxHScrollBarOrientation = Nothing + , ctxHScrollBarRenderer = Nothing + , ctxHScrollBarShowHandles = False + , ctxVScrollBarShowHandles = False + , ctxHScrollBarClickableConstr = Nothing + , ctxVScrollBarClickableConstr = Nothing } pic = V.picForLayers $ uncurry V.resize (w, h) <$> (^.imageL) <$> layerResults @@ -70,10 +74,10 @@ & extentsL %~ cropExtents c & bordersL %~ cropBorders c -cropImage :: Context -> V.Image -> V.Image +cropImage :: Context n -> V.Image -> V.Image cropImage c = V.crop (max 0 $ c^.availWidthL) (max 0 $ c^.availHeightL) -cropCursors :: Context -> [CursorLocation n] -> [CursorLocation n] +cropCursors :: Context n -> [CursorLocation n] -> [CursorLocation n] cropCursors ctx cs = catMaybes $ cropCursor <$> cs where -- A cursor location is removed if it is not within the region @@ -87,7 +91,7 @@ , c^.cursorLocationL.locationColumnL >= ctx^.availWidthL ] -cropExtents :: Context -> [Extent n] -> [Extent n] +cropExtents :: Context n -> [Extent n] -> [Extent n] cropExtents ctx es = catMaybes $ cropExtent <$> es where -- An extent is cropped in places where it is not within the @@ -118,7 +122,7 @@ then Nothing else Just e -cropBorders :: Context -> BorderMap DynBorder -> BorderMap DynBorder +cropBorders :: Context n -> BorderMap DynBorder -> BorderMap DynBorder cropBorders ctx = BM.crop Edges { eTop = 0 , eBottom = availHeight ctx - 1 @@ -127,17 +131,19 @@ } renderDynBorder :: DynBorder -> V.Image -renderDynBorder db = V.char (dbAttr db) . ($dbStyle db) $ case bsDraw <$> dbSegments db of - -- top bot left right - Edges False False False False -> const ' ' -- dunno lol (but should never happen, so who cares) - Edges False False _ _ -> bsHorizontal - Edges _ _ False False -> bsVertical - Edges False True False True -> bsCornerTL - Edges False True True False -> bsCornerTR - Edges True False False True -> bsCornerBL - Edges True False True False -> bsCornerBR - Edges False True True True -> bsIntersectT - Edges True False True True -> bsIntersectB - Edges True True False True -> bsIntersectL - Edges True True True False -> bsIntersectR - Edges True True True True -> bsIntersectFull +renderDynBorder db = V.char (dbAttr db) $ getBorderChar $ dbStyle db + where + getBorderChar = case bsDraw <$> dbSegments db of + -- top bot left right + Edges False False False False -> const ' ' + Edges False False _ _ -> bsHorizontal + Edges _ _ False False -> bsVertical + Edges False True False True -> bsCornerTL + Edges False True True False -> bsCornerTR + Edges True False False True -> bsCornerBL + Edges True False True False -> bsCornerBR + Edges False True True True -> bsIntersectT + Edges True False True True -> bsIntersectB + Edges True True False True -> bsIntersectL + Edges True True True False -> bsIntersectR + Edges True True True True -> bsIntersectFull diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Brick/Widgets/List.hs new/brick-0.65/src/Brick/Widgets/List.hs --- old/brick-0.64.2/src/Brick/Widgets/List.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Brick/Widgets/List.hs 2001-09-09 03:46:40.000000000 +0200 @@ -78,13 +78,7 @@ import Prelude hiding (reverse, splitAt) import Control.Applicative ((<|>)) -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>), (<*>), pure) -import Data.Foldable (Foldable, find, toList) -import Data.Traversable (Traversable) -#else import Data.Foldable (find, toList) -#endif import Control.Monad.Trans.State (evalState, get, put) import Lens.Micro ((^.), (^?), (&), (.~), (%~), _2, _head, set) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.64.2/src/Data/Text/Markup.hs new/brick-0.65/src/Data/Text/Markup.hs --- old/brick-0.64.2/src/Data/Text/Markup.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.65/src/Data/Text/Markup.hs 2001-09-09 03:46:40.000000000 +0200 @@ -17,11 +17,6 @@ ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -import Data.Monoid -#endif - import qualified Data.Semigroup as Sem import Data.String (IsString(..)) import qualified Data.Text as T
