brick 2.13 → 3.0

raw patch · 31 files changed

+2612/−280 lines, 31 filesdep ~basedep ~microlensdep ~microlens-platformnew-component:exe:brick-menu-bar-demonew-component:exe:brick-menu-demonew-component:exe:brick-menu-keybindings-demoPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, microlens, microlens-platform, text, vty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +131/−5
• README.md +5/−4
• brick.cabal +62/−12
• docs/guide.rst +4/−2
• programs/AnimationDemo.hs +2/−2
• programs/FormDemo.hs +1/−1
• programs/LayerDemo.hs +22/−10
• programs/ListDemo.hs +7/−12
• programs/MenuBarDemo.hs +146/−0
• programs/MenuDemo.hs +129/−0
• programs/MenuKeybindingsDemo.hs +177/−0
• programs/MouseDemo.hs +11/−7
• programs/ViewportScrollbarsDemo.hs +42/−9
• src/Brick.hs +1/−1
• src/Brick/Animation.hs +1/−1
• src/Brick/Keybindings/KeyDispatcher.hs +17/−3
• src/Brick/Main.hs +41/−9
• src/Brick/Types.hs +1/−8
• src/Brick/Types/Common.hs +4/−4
• src/Brick/Types/Internal.hs +97/−4
• src/Brick/Util.hs +2/−6
• src/Brick/Widgets/Center.hs +18/−27
• src/Brick/Widgets/Core.hs +278/−117
• src/Brick/Widgets/Edit.hs +2/−2
• src/Brick/Widgets/Internal.hs +94/−16
• src/Brick/Widgets/List.hs +13/−15
• src/Brick/Widgets/Menu.hs +1015/−0
• src/Brick/Widgets/MenuBar.hs +280/−0
• src/Brick/Widgets/ProgressBar.hs +1/−1
• src/Data/IMap.hs +3/−0
• tests/Main.hs +5/−2

@@ -2,17 +2,143 @@ Brick changelog --------------- +3.0+---++This release focuses on two major new features that include some+breaking API changes: *layer embedding* and *pop-up menus*.++* Layer embedding: This release introduces a powerful new function,+  `Brick.Widgets.Core.above`, written ``a `above` b`` that allows any+  widget at any layer (in this case, `b`) to introduce a new layer+  floating above it (here, `a`), positioned relative to the upper-left+  corner of the lower element. This makes the introduction of floating+  layers much more modular and composable. This change brings with it+  some API and behavioral changes; see below for details. Prior to the+  addition of this feature, the only way to introduce new layers into+  Brick's output was to include them in the list of layers returned by+  the top-level application draw function. This made it difficult to use+  layers in a modular way as part of UI components because the top-level+  draw function would need to be updated to introduce any layers+  needed by elements in the UI. The `LayerDemo` (`brick-layer-demo`)+  demonstration program was updated to include a demonstration of+  `above`.+* Pop-up menus: taking advantage of the new `above` function are the new+  modules `Brick.Widgets.Menu` and `Brick.Widgets.MenuBar`, which+  introduce support for menus and menu bars in Brick applications. The+  menu interface allows for custom menus as well as menus that integrate+  with Brick's custom keybinding infrastructure. To learn more, see+  the Haddock documentation for those modules as well as the new+  demonstration programs, built with `cabal run -f demos <progname>`:+  * `programs/MenuDemo.hs` (`brick-menu-demo`)+  * `programs/MenuKeybindingsDemo.hs` (`brick-menu-keybindings-demo`)+  * `programs/MenuBarDemo.hs` (`brick-menu-bar-demo`)++Additional layer embedding details:++The layer embedding feature comes with a rework of how Brick handles+layer translations. Here's a summary of the impact:++* `translateBy` was renamed to `translateLayer` and now has no effect on+  non-layer widgets. Previously, `translateBy` worked by adding left and+  top padding for positive translations, and by performing cropping for+  negative translations. While this gave the desired effect, it wasn't+  a true translation and it needed to be changed to support the new+  layer embedding feature. Starting with this release, `translateLayer`+  does a true translation without modifying the layer image itself. When+  applied to a non-layer, it has no effect. A widget is a non-layer if+  it gets embedded within or modified by another widget (such as by+  embedding it in an `hBox`).+* `relativeTo` was renamed to `layerRelativeTo` to clarify that its+  use is only for layers; like `translateLayer`, it has no effect for+  non-layer widgets. Its behavior is unchanged.+* Applications that were exploiting the previous padding and cropping+  behavior of `translateBy` for non-layer widgets should migrate to+  applying padding and cropping directly to achieve the same result.+  Most applications can likely just update to account for the renamings+  without further changes.+* `above` also works in viewports and behaves as one might expect:+  layers above viewport content are placed as specified, but are cropped+  as they are scrolled out of view.+* The layer-handling functions in `Brick.Widgets.Center` were updated to+  use `translateLayer`. Their apparent behavior is unchanged.+* Widget-modifying functions are commutative with `translateLayer`. In+  general, any transformation applied to a layer is applied directly+  to the layer itself without regard for its translation position. For+  example, these are equivalent:+  * `padLeft (Pad 2) $ translateLayer (Location (a, b)) $ txt "foo"`+  * `translateLayer (Location (a, b)) $ padLeft (Pad 2) $ txt "foo"`+* Cropping functions were changed to use less aggressive context sizes.+  Prior to this change, cropping functions rendered with a rendering+  context using the size of the widget being cropped as the basis for+  the cropping amount. This turned out to be too aggressive when things+  like cursor positions and other positional information were present+  outside the widgets' cropped regions, since they could be mistakenly+  removed from the rendering result. For example, `cropLeftBy 1 (str+  "foo")` previously would crop to "oo" and remove any extents and+  cursor positions to the *right* of the "oo" portion of the result even+  though that area shouldn't be affected at all because it wasn't in the+  cropped portion of the image. The improvement to these functions fixes+  this behavior so that only cursors, extents, etc. in the affected+  image region are cropped.++Other improvements in this release:++* Mouse clicks in layers will no longer fall through to lower layers+  when the mouse clicks occur at locations that aren't within any named+  regions in the clicked layer. Prior to this change, Brick would+  report click events in clickable regions even if those clickable+  regions were obscured by higher, non-clickable layers. This obviously+  isn't good and is almost certainly never what anyone wants; the+  more natural behavior is to ensure that a clickable region is+  only clickable if it is not obscured by anything on top of it.+  `Brick.Main.findClickedExtents` now reflects this behavior, which+  means that the function no longer reports underlying region matches if+  they are obscured.++API changes in this release:++* Added new modules:+  * `Brick.Widgets.Menu`+  * `Brick.Widgets.MenuBar`+* `Brick.Widgets.Core`:+  * Added `clampLayerToScreen`+  * Added `char` `Widget` constructor+  * Renamed `translateBy` to `translateLayer`+  * Renamed `relativeTo` to `layerRelativeTo`+* `Brick.Types` now exports `Result` lenses `performTranslationL` and+  `translationOffsetL` used in tracking layer translations.+* `Brick.Keybindings.KeyDispatcher`:+  * Added `bindingsForEvent` for obtaining bindings for an event from a+    dispatcher+  * Added `lookupEvent` for looking up a handler by key event++Functionality-preserving changes:++* Made `Brick.Types.Location` a `newtype`. Previously, `Location` was a+  normal data type with one record field to access its inner tuple; it+  is now a `newtype` wrapper around that tuple with the same record+  field name.++Package changes:++* Set a lower bound on `text` to `2.1.2`++Repository changes:++* Renamed the `master` branch to `main`+ 2.13 ----  New features:  * Brick.Widgets.List: added support for wrapping (thanks Enrico Maria De-  Angelis). The List API now provides `setScrollWrap` to configure lists-  to wrap when moving their cursor, and the cursor-movement functions-  and event handlers now cause selection wrapping when a list has-  wrapping enabled. The `ListDemo` demo program was also updated to-  demonstrate the wrapping behavior.+  Angelis). The List API now provides `setScrollWrap`, `getScrollWrap`,+  and `listScrollWrapL` to configure lists to wrap when moving their+  cursor, and the cursor-movement functions and event handlers now cause+  selection wrapping when a list has wrapping enabled. The `ListDemo`+  demo program was also updated to demonstrate the wrapping behavior.  2.12 ----

@@ -125,17 +125,17 @@ $ find dist-newstyle -type f -name \*-demo ``` -To get started, see the [user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst).+To get started, see the [user guide](https://github.com/jtdaugherty/brick/blob/main/docs/guide.rst).  Documentation -------------  Documentation for `brick` comes in a variety of forms: -* [The official brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)+* [The official brick user guide](https://github.com/jtdaugherty/brick/blob/main/docs/guide.rst) * [Haddock documentation](https://hackage.haskell.org/package/brick)-* [Demo programs](https://github.com/jtdaugherty/brick/blob/master/programs)-* [FAQ](https://github.com/jtdaugherty/brick/blob/master/FAQ.md)+* [Demo programs](https://github.com/jtdaugherty/brick/blob/main/programs)+* [FAQ](https://github.com/jtdaugherty/brick/blob/main/FAQ.md)  Feature Overview ----------------@@ -147,6 +147,7 @@  * List and table widgets  * Progress bar widget  * Simple dialog box widget+ * Menus and menu bars with optional custom keybinding integration  * Border-drawing widgets (put borders around or in between things)  * Animation support  * Generic scrollable viewports and viewport scroll bars

@@ -1,5 +1,5 @@ name:                brick-version:             2.13+version:             3.0 synopsis:            A declarative terminal user interface library description:   Write terminal user interfaces (TUIs) painlessly with 'brick'! You@@ -20,9 +20,9 @@   .   To get started, see:   .-  * <https://github.com/jtdaugherty/brick/blob/master/README.md The README>+  * <https://github.com/jtdaugherty/brick/blob/main/README.md The README>   .-  * The <https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst Brick user guide>+  * The <https://github.com/jtdaugherty/brick/blob/main/docs/guide.rst Brick user guide>   .   * The demonstration programs in the 'programs' directory   .@@ -32,24 +32,20 @@ license-file:        LICENSE author:              Jonathan Daugherty <cygnus@foobox.com> maintainer:          Jonathan Daugherty <cygnus@foobox.com>-copyright:           (c) Jonathan Daugherty 2015-2025+copyright:           (c) Jonathan Daugherty 2015-2026 category:            Graphics build-type:          Simple cabal-version:       1.18 Homepage:            https://github.com/jtdaugherty/brick/ Bug-reports:         https://github.com/jtdaugherty/brick/issues-tested-with:         GHC == 8.2.2-                      || == 8.4.4-                      || == 8.6.5-                      || == 8.8.4-                      || == 8.10.7-                      || == 9.0.2+tested-with:         GHC == 9.0.2                       || == 9.2.8                       || == 9.4.8                       || == 9.6.7                       || == 9.8.4                       || == 9.10.3                       || == 9.12.2+                      || == 9.14.1  extra-doc-files:     README.md,                      docs/guide.rst,@@ -97,6 +93,8 @@     Brick.Widgets.Edit     Brick.Widgets.FileBrowser     Brick.Widgets.List+    Brick.Widgets.Menu+    Brick.Widgets.MenuBar     Brick.Widgets.ProgressBar     Brick.Widgets.Table     Data.IMap@@ -117,14 +115,15 @@                        exceptions >= 0.10.0,                        filepath,                        containers >= 0.5.7,-                       microlens >= 0.3.0.0 && < 0.6,+                       microlens-platform >= 0.3.0.0 && < 0.6,+                       microlens,                        microlens-th,                        microlens-mtl,                        mtl,                        config-ini,                        vector,                        stm >= 2.4.3,-                       text,+                       text >= 2.1.2,                        text-zipper >= 0.13,                        template-haskell,                        deepseq >= 1.3 && < 1.6,@@ -540,6 +539,57 @@   build-depends:       base,                        brick,                        vty,+                       microlens-mtl,+                       microlens-th++executable brick-menu-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-extensions:  CPP+  default-language:    Haskell2010+  main-is:             MenuDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       mtl,+                       text,+                       microlens,+                       microlens-mtl,+                       microlens-th++executable brick-menu-keybindings-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-extensions:  CPP+  default-language:    Haskell2010+  main-is:             MenuKeybindingsDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       mtl,+                       text,+                       microlens,+                       microlens-mtl,+                       microlens-th++executable brick-menu-bar-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-extensions:  CPP+  default-language:    Haskell2010+  main-is:             MenuBarDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       mtl,+                       text,+                       microlens,                        microlens-mtl,                        microlens-th 

@@ -1198,8 +1198,10 @@ This approach finds all clicked extents and returns them in a list with the following properties: -* For extents ``A`` and ``B``, if ``A``'s layer is higher than ``B``'s-  layer, ``A`` comes before ``B`` in the list.+* For matching extents ``A`` and ``B``, if ``A``'s layer is higher than+  ``B``'s layer, ``A`` is included in the results but ``B`` is not. This+  is because the layer containing ``A`` obscures the region ``B``, so it+  doesn't make sense to include it. * For extents ``A`` and ``B``, if ``A`` and ``B`` are in the same layer   and ``A`` is contained within ``B``, ``A`` comes before ``B`` in the   list.

@@ -20,7 +20,7 @@ import Brick.Types (Widget, EventM, BrickEvent(..), Location(..)) import Brick.Widgets.Border (border) import Brick.Widgets.Center (center)-import Brick.Widgets.Core ((<+>), str, vBox, hBox, hLimit, vLimit, translateBy, withDefAttr)+import Brick.Widgets.Core ((<+>), str, vBox, hBox, hLimit, vLimit, translateLayer, withDefAttr) import qualified Brick.Animation as A  data CustomEvent =@@ -50,7 +50,7 @@  drawClickAnimation :: St -> (Location, A.Animation St ()) -> Widget () drawClickAnimation st (l, a) =-    translateBy l $+    translateLayer l $     A.renderAnimation (const $ str " ") st (Just a)  drawAnimations :: St -> Widget ()

@@ -106,7 +106,7 @@         help = padTop (Pad 1) $ B.borderWithLabel (str "Help") body         body = str $ "- Name is free-form text\n" <>                      "- Age must be an integer (try entering an\n" <>-                     "  invalid age!)\n" <>+                     "  invalid age or an age less than 18!)\n" <>                      "- Handedness selects from a list of options\n" <>                      "- The last option is a checkbox\n" <>                      "- Enter/Esc quit, mouse interacts with fields"

@@ -17,11 +17,12 @@ import qualified Brick.Widgets.Border as B import qualified Brick.Widgets.Center as C import Brick.Widgets.Core-  ( translateBy+  ( translateLayer   , str-  , relativeTo+  , layerRelativeTo   , reportExtent   , withDefAttr+  , above   ) import Brick.Util (fg) import Brick.AttrMap@@ -45,29 +46,40 @@ drawUi st =     [ C.centerLayer $       B.border $ str "This layer is centered but other\nlayers are placed underneath it."-    , arrowLayer-    , middleLayer (st^.middleLayerLocation)+    , arrowLayer1+    , arrowLayer2 `above` (middleLayer (st^.middleLayerLocation))     , bottomLayer (st^.bottomLayerLocation)     ] -arrowLayer :: Widget Name-arrowLayer =+arrowLayer1 :: Widget Name+arrowLayer1 =     let msg = "Relatively\n" <>+              "positioned with\n" <>+              "'layerRelativeTo'"+    in layerRelativeTo MiddleLayerElement (Location (-18, -4)) $+       withDefAttr arrowAttr $+       B.border $+       str msg++arrowLayer2 :: Widget Name+arrowLayer2 =+    let msg = "Relatively\n" <>               "positioned\n" <>-              "arrow---->"-    in relativeTo MiddleLayerElement (Location (-10, -2)) $+              "with 'above'"+    in translateLayer (Location (18, 3)) $        withDefAttr arrowAttr $+       B.border $        str msg  middleLayer :: Location -> Widget Name middleLayer l =-    translateBy l $+    translateLayer l $     reportExtent MiddleLayerElement $     B.border $ str "Middle layer\n(Arrow keys move)"  bottomLayer :: Location -> Widget Name bottomLayer l =-    translateBy l $+    translateLayer l $     B.border $ str "Bottom layer\n(Ctrl-arrow keys move)"  appEvent :: T.BrickEvent Name e -> T.EventM Name St ()

@@ -8,7 +8,6 @@ #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif-import Data.Maybe (fromMaybe) import qualified Graphics.Vty as V  import qualified Brick.Main as M@@ -55,14 +54,13 @@                               , C.hCenter $ str $ "Selection wrapping is currently " <> wrapStatus <> "."                               ] -appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()+appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Int) () appEvent (T.VtyEvent e) =     case e of         V.EvKey (V.KChar '+') [] -> do             els <- use L.listElementsL-            let el = nextElement els-                pos = Vec.length els-            modify $ L.listInsert pos el+            let pos = Vec.length els+            modify $ L.listInsert pos pos          V.EvKey (V.KChar '-') [] -> do             sel <- use L.listSelectedL@@ -76,12 +74,9 @@         V.EvKey V.KEsc [] -> M.halt          ev -> L.handleListEvent ev-    where-      nextElement :: Vec.Vector Char -> Char-      nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z']) appEvent _ = return () -toggleListWrapping :: T.EventM () (L.List () Char) ()+toggleListWrapping :: T.EventM () (L.List () Int) () toggleListWrapping = L.listScrollWrapL %= not  listDrawElement :: (Show a) => Bool -> a -> Widget ()@@ -91,8 +86,8 @@                    else str s     in C.hCenter $ str "Item " <+> (selStr $ show a) -initialState :: L.List () Char-initialState = L.list () (Vec.fromList ['a','b','c']) 1+initialState :: L.List () Int+initialState = L.list () (Vec.fromList [0..2000]) 1  customAttr :: A.AttrName customAttr = L.listSelectedAttr <> A.attrName "custom"@@ -104,7 +99,7 @@     , (customAttr,            fg V.cyan)     ] -theApp :: M.App (L.List () Char) e ()+theApp :: M.App (L.List () Int) e () theApp =     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor

@@ -0,0 +1,146 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Lens.Micro ((^.))+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl ((%=), use)+import Control.Monad (void, when)+import Control.Monad.Trans (liftIO)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Text as Text+import qualified Graphics.Vty as V++import qualified Brick.Types as T+import Brick.AttrMap+import Brick.Util+import Brick.Types (Widget)+import qualified Brick.Main as M+import Brick.Widgets.Core (txtWrap, hLimit)+import Brick.Widgets.Center (center)+import Brick.Widgets.Menu+import Brick.Widgets.MenuBar++data Name = FileMenu MenuRegion+          | EditMenu MenuRegion+          | HelpMenu MenuRegion+          deriving (Show, Ord, Eq)++data St =+    St { _menuBar :: SimpleMenuBar St Name+       , _menuBarOrientation :: MenuOrientation+       }++makeLenses ''St++drawUi :: St -> [Widget Name]+drawUi st =+    [ renderMenuBar st (st^.menuBar)+    , center $+      hLimit 40 $+      txtWrap $+      Text.unlines $+      [ "Click the menu title with the mouse or press Alt-F, Alt-E, " <>+        "or Alt-H to open the menus."+      , ""+      , "Press 'o' to toggle the orientation of the menu bar and its menus."+      , ""+      , "When a menu is open:"+      , ""+      , "- Press up/down arrow keys to select items and then " <>+        "press Enter to activate them, or click them with the mouse instead."+      , ""+      , "- Press left/right arrow keys cycle through open menus."+      , ""+      , "Press Esc to quit the program."+      ]+    ]++appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent e = do+    handled <- handleMenuBarEvent menuBar e+    when (not handled) $ handleNonMenuBarEvent e++handleNonMenuBarEvent :: T.BrickEvent Name e -> T.EventM Name St ()+handleNonMenuBarEvent (T.VtyEvent (V.EvKey V.KEsc [])) =+    -- Esc quits the application+    M.halt+handleNonMenuBarEvent (T.VtyEvent (V.EvKey (V.KChar 'f') [V.MMeta])) =+    menuBar %= toggleMenuAtIndex 0+handleNonMenuBarEvent (T.VtyEvent (V.EvKey (V.KChar 'e') [V.MMeta])) =+    menuBar %= toggleMenuAtIndex 1+handleNonMenuBarEvent (T.VtyEvent (V.EvKey (V.KChar 'h') [V.MMeta])) =+    menuBar %= toggleMenuAtIndex 2+handleNonMenuBarEvent (T.VtyEvent (V.EvKey (V.KChar 'o') [])) = do+    menuBarOrientation %= nextOrientation+    o <- use menuBarOrientation+    menuBar %= setMenuBarOrientation o+handleNonMenuBarEvent _ =+    return ()++nextOrientation :: MenuOrientation -> MenuOrientation+nextOrientation LeftToRight = RightToLeft+nextOrientation RightToLeft = LeftToRight++aMap :: AttrMap+aMap = attrMap V.defAttr+    [ (menuAttr, fg V.white)+    , (menuTitleAttr, V.white `on` V.blue)+    , (menuTitleSelectedAttr, V.black `on` V.white)+    , (menuEntryDisabledAttr, fg V.red)+    , (menuEntrySelectedAttr, V.black `on` V.yellow)+    , (menuEntrySelectedDisabledAttr, V.black `on` V.red)+    , (menuTitleKeyHighlightAttr, style V.underline)+    ]++app :: M.App St e Name+app =+    M.App { M.appDraw = drawUi+          , M.appStartEvent = do+              vty <- M.getVtyHandle+              liftIO $ V.setMode (V.outputIface vty) V.Mouse True+          , M.appHandleEvent = appEvent+          , M.appAttrMap = const aMap+          , M.appChooseCursor = M.showFirstCursor+          }++newFileMenu :: SimpleMenu St Name+newFileMenu =+    setTitleRenderer (titleHightlightKey 'f') $+    simpleMenu "File" FileMenu+        [ menuEntry "New..." (return ())+        , menuEntry "Open..." (return ())+        , menuSeparator+        , menuEntry "Exit" M.halt+        ]++newEditMenu :: SimpleMenu St Name+newEditMenu =+    setTitleRenderer (titleHightlightKey 'e') $+    simpleMenu "Edit" EditMenu+        [ menuEntry "Undo" (return ())+        , menuEntry "Redo" (return ())+        , menuSeparator+        , menuEntry "Cut" (return ())+        , menuEntry "Copy" (return ())+        , menuEntry "Paste" (return ())+        ]++newHelpMenu :: SimpleMenu St Name+newHelpMenu =+    setTitleRenderer (titleHightlightKey 'h') $+    simpleMenu "Help" HelpMenu+        [ menuEntry "About" (return ())+        , menuEntry "Check for updates" (return ())+        ]++main :: IO ()+main = do+    let mb = newMenuBar [ newFileMenu+                        , newEditMenu+                        , newHelpMenu+                        ]+    void $ M.defaultMain app $ St mb LeftToRight

@@ -0,0 +1,129 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Lens.Micro ((^.))+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl+import Control.Monad (void, when)+import Control.Monad.Trans (liftIO)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Text as Text+import qualified Graphics.Vty as V++import qualified Brick.Types as T+import Brick.AttrMap+import Brick.Util+import Brick.Types (Widget)+import qualified Brick.Main as M+import Brick.Widgets.Core (txtWrap, hLimit, padLeft, Padding(..), withBorderStyle)+import Brick.Widgets.Center (center)+import qualified Brick.Widgets.Border.Style as S+import Brick.Widgets.Menu++data Name = FileMenu MenuRegion+          | ExportMenu MenuRegion+          deriving (Show, Ord, Eq)++data St =+    St { _fileMenu :: SimpleMenu St Name+       , _borderStyle :: S.BorderStyle+       }++makeLenses ''St++drawUi :: St -> [Widget Name]+drawUi st =+    [ padLeft (Pad 1) $+      withBorderStyle (st^.borderStyle) $+      renderMenu st (st^.fileMenu)+    , center $+      hLimit 60 $+      txtWrap $+      Text.unlines $+      [ "Click the menu title with the mouse or press Alt-F to open the menu."+      , ""+      , "When the menu is open, press arrow keys to select items and then " <>+        "press Enter to activate them, or click them with the mouse instead."+      , ""+      , "When the menu is open, press Enter or the right arrow key to open " <>+        "the submenu; press Esc or the left arrow key to close it."+      , ""+      , "Press these keys to switch menu border styles:"+      , ""+      ] <>+      [ "- " <> Text.singleton c <> ": " <> label | (c, (label, _)) <- borderStyles] <>+      [ ""+      , "Press Esc to quit the program."+      ]+    ]++borderStyles :: [(Char, (Text.Text, S.BorderStyle))]+borderStyles =+    [ ('1', ("Unicode (default)", S.unicode))+    , ('2', ("Unicode rounded", S.unicodeRounded))+    , ('3', ("Unicode bold", S.unicodeBold))+    , ('4', ("ASCII", S.ascii))+    ]++appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey (V.KChar 'f') [V.MMeta])) =+    fileMenu %= toggleMenu+appEvent (T.VtyEvent (V.EvKey (V.KChar c) [])) =+    case lookup c borderStyles of+        Nothing -> return ()+        Just (_, s) -> borderStyle .= s+appEvent e = do+    handled <- handleMenuEvent fileMenu e+    when (not handled) $ handleNonMenuEvent e++handleNonMenuEvent :: T.BrickEvent Name e -> T.EventM Name St ()+handleNonMenuEvent (T.VtyEvent (V.EvKey V.KEsc [])) =+    -- Esc quits the application+    M.halt+handleNonMenuEvent _ =+    return ()++aMap :: AttrMap+aMap = attrMap V.defAttr+    [ (menuAttr, fg V.white)+    , (menuTitleAttr, fg V.white)+    , (menuTitleSelectedAttr, V.black `on` V.white)+    , (menuEntryDisabledAttr, fg V.red)+    , (menuEntrySelectedAttr, V.black `on` V.yellow)+    , (menuEntrySelectedDisabledAttr, V.black `on` V.red)+    , (menuTitleKeyHighlightAttr, style V.underline)+    ]++app :: M.App St e Name+app =+    M.App { M.appDraw = drawUi+          , M.appStartEvent = do+              vty <- M.getVtyHandle+              liftIO $ V.setMode (V.outputIface vty) V.Mouse True+          , M.appHandleEvent = appEvent+          , M.appAttrMap = const aMap+          , M.appChooseCursor = M.showFirstCursor+          }++newFileMenu :: SimpleMenu St Name+newFileMenu =+    setTitleRenderer (titleHightlightKey 'f') $+    simpleMenu "File" FileMenu+        [ menuEntry "New..." (return ())+        , menuEntry "Open..." (return ())+        , menuSeparator+        , submenu $ simpleMenu "Export" ExportMenu+            [ menuEntry "JPEG" (return ())+            , menuEntry "PNG" (return ())+            , menuEntry "GIF" (return ())+            ]+        , menuSeparator+        , menuEntry "Exit" M.halt+        ]++main :: IO ()+main = void $ M.defaultMain app $ St newFileMenu S.unicode

@@ -0,0 +1,177 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Lens.Micro ((^.))+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl+import Control.Monad (void, forM_)+import Control.Monad.Trans (liftIO)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import Data.Maybe (fromJust)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import qualified Graphics.Vty as V+import System.Exit (exitFailure)++import qualified Brick.Types as T+import Brick.AttrMap+import Brick.Util+import Brick.Types (Widget)+import qualified Brick.Main as M+import Brick.Widgets.Core ((<=>), txt, withAttr, txtWrap, hLimit, padLeft, Padding(..))+import Brick.Widgets.Center (center)+import Brick.Widgets.Menu++import qualified Brick.Keybindings as K++-- | The abstract key events for the application.+data KeyEvent = QuitEvent+              | ToggleFileMenuEvent+              | NewEvent+              | OpenEvent+              deriving (Ord, Eq, Show)++-- | The mapping of key events to their configuration field names.+allKeyEvents :: K.KeyEvents KeyEvent+allKeyEvents =+    K.keyEvents [ ("quit",             QuitEvent)+                , ("toggle-file-menu", ToggleFileMenuEvent)+                , ("new",              NewEvent)+                , ("open",             OpenEvent)+                ]++-- | Default key bindings for each abstract key event.+defaultBindings :: [(KeyEvent, [K.Binding])]+defaultBindings =+    [ (QuitEvent,           [K.ctrl 'q'])+    , (ToggleFileMenuEvent, [K.meta 'f'])+    , (NewEvent,            [K.meta 'n'])+    , (OpenEvent,           [K.meta 'o'])+    ]++data Name = FileMenu MenuRegion+          deriving (Show, Ord, Eq)++data St =+    St { _keyConfig :: K.KeyConfig KeyEvent+       , _dispatcher :: K.KeyDispatcher KeyEvent (T.EventM Name St)+       , _fileMenu :: DispatchingMenu St Name KeyEvent+       , _lastAction :: Text.Text+       }++makeLenses ''St++drawUi :: St -> [Widget Name]+drawUi st =+    [ padLeft (Pad 1) $+      renderMenu st (st^.fileMenu)+    , center $+      hLimit 60 $+      (txtWrap $+       Text.unlines $+       [ "Click the menu title with the mouse or press Alt-F to open the menu."+       , ""+       , "When the menu is open, press arrow keys to select items and then " <>+         "press Enter to activate them, or click them with the mouse instead."+       , ""+       , "When the menu is open or closed, press the keybindings shown in the " <>+         "menu to activate the corresponding menu items."+       , ""+       ])+      <=>+      (withAttr emphAttr $+        txt $ "Last action: " <> st^.lastAction)+    ]++-- | Key event handlers for our application.+handlers :: [K.KeyEventHandler KeyEvent (T.EventM n St)]+handlers =+    [ K.onEvent QuitEvent "Quit the program" M.halt++    , K.onEvent ToggleFileMenuEvent "Toggle the File menu" $ do+        lastAction .= "Toggled the File menu"+        fileMenu %= toggleMenu++    , K.onEvent NewEvent "New" $+        lastAction .= "Activated New... menu entry"++    , K.onEvent OpenEvent "Open" $+        lastAction .= "Activated Open... menu entry"++    , K.onKey (K.ctrl 't') "Fixed key" $+        lastAction .= "Activated fixed-key event handler"+    ]++appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent e = void $ handleMenuEvent fileMenu e++emphAttr :: AttrName+emphAttr = attrName "emphasis"++aMap :: AttrMap+aMap = attrMap V.defAttr+    [ (menuAttr, fg V.white)+    , (menuTitleAttr, fg V.white)+    , (menuTitleSelectedAttr, V.black `on` V.white)+    , (menuEntryDisabledAttr, fg V.red)+    , (menuEntrySelectedAttr, V.black `on` V.yellow)+    , (menuEntrySelectedDisabledAttr, V.black `on` V.red)+    , (menuEntryKeybindingAttr, fg V.cyan `V.withStyle` V.bold)+    , (emphAttr, fg V.white)+    ]++app :: M.App St e Name+app =+    M.App { M.appDraw = drawUi+          , M.appStartEvent = do+              vty <- M.getVtyHandle+              liftIO $ V.setMode (V.outputIface vty) V.Mouse True+          , M.appHandleEvent = appEvent+          , M.appAttrMap = const aMap+          , M.appChooseCursor = M.showFirstCursor+          }++newFileMenu :: K.KeyDispatcher KeyEvent (T.EventM Name St) -> DispatchingMenu St Name KeyEvent+newFileMenu d =+    menuWithDispatcher d "File" FileMenu+        [ menuEntryForEvent "New..." NewEvent+        , menuEntryForEvent "Open..." OpenEvent+        , menuEntryForKey "Test" (K.ctrl 't')+        , menuEntryForAction "Test 2" (lastAction .= "Activated 'Test 2' item")+        , menuSeparator+        , menuEntryForEvent "Exit" QuitEvent+        ]++sectionName :: Text.Text+sectionName = "keybindings"++main :: IO ()+main = do+    -- Create a key config that includes the default bindings.+    let kc = K.newKeyConfig allKeyEvents defaultBindings []++    -- Build a key dispatcher for our event handlers. If this fails+    -- due to key collision detection, we'll print out info about the+    -- collisions.+    d <- case K.keyDispatcher kc handlers of+        Right d -> return d+        Left collisions -> do+            putStrLn "Error: some key events have the same keys bound to them."++            forM_ collisions $ \(b, hs) -> do+                Text.putStrLn $ "Handlers with the '" <> K.ppBinding b <> "' binding:"+                forM_ hs $ \h -> do+                    let trigger = case K.kehEventTrigger $ K.khHandler h of+                            K.ByKey k   -> "triggered by the key '" <> K.ppBinding k <> "'"+                            K.ByEvent e -> "triggered by the event '" <> fromJust (K.keyEventName allKeyEvents e) <> "'"+                        desc = K.handlerDescription $ K.kehHandler $ K.khHandler h++                    Text.putStrLn $ "  " <> desc <> " (" <> trigger <> ")"++            exitFailure++    void $ M.defaultMain app $ St kc d (newFileMenu d) "(none yet)"

@@ -43,11 +43,15 @@  buttonLayer :: St -> Widget Name buttonLayer st =-    C.vCenterLayer $-      C.hCenterLayer (padBottom (Pad 1) $ str "Click a button:") <=>-      C.hCenterLayer (hBox $ padLeftRight 1 <$> buttons) <=>-      C.hCenterLayer (padTopBottom 1 $ str "Or enter text and then click in this editor:") <=>-      C.hCenterLayer (vLimit 3 $ hLimit 50 $ E.renderEditor (str . unlines) True (st^.edit))+    C.centerLayer $+      hLimit 60 $+      vBox $+      C.hCenter <$>+      [ padBottom (Pad 1) $ str "Click a button:"+      , hBox $ padLeftRight 1 <$> buttons+      , padTopBottom 1 $ str "Or enter text and then click in this editor:"+      , vLimit 3 $ hLimit 50 $ E.renderEditor (str . unlines) True (st^.edit)+      ]     where         buttons = mkButton <$> buttonData         buttonData = [ (Button1, "Button 1", attrName "button1")@@ -65,8 +69,8 @@  proseLayer :: St -> Widget Name proseLayer st =+  C.hCenter $   B.border $-  C.hCenterLayer $   vLimit 8 $   viewport Prose Vertical $   vBox $ map str $ lines (st^.prose)@@ -80,7 +84,7 @@                     "Click and hold/drag to report a mouse click"                 Just (name, T.Location l) ->                     "Mouse down at " <> show name <> " @ " <> show l-    T.render $ translateBy (T.Location (0, h-1)) $ clickable Info $+    T.render $ translateLayer (T.Location (0, h-1)) $ clickable Info $                withDefAttr (attrName "info") $                C.hCenter $ str msg 

@@ -71,7 +71,7 @@                        , scrollbarWidthAllocation = 5                        } -data Name = VP1 | VP2 | SBClick T.ClickableScrollbarElement Name+data Name = VP1 | VP2 | VP3 | SBClick T.ClickableScrollbarElement Name           deriving (Ord, Show, Eq)  data St = St { _lastClickedElement :: Maybe (T.ClickableScrollbarElement, Name) }@@ -86,7 +86,7 @@                    , C.hCenter (str "Last clicked scroll bar element:")                    , str $ show $ _lastClickedElement st                    ])-        pair = hBox [ padRight (Pad 5) $+        pair = hBox [ padRight (Pad 2) $                       B.border $                       withClickableHScrollBars SBClick $                       withHScrollBars OnBottom $@@ -96,7 +96,9 @@                       str $ "Press left and right arrow keys to scroll this viewport.\n" <>                             "This viewport uses a\n" <>                             "custom scroll bar renderer!"-                    , B.border $++                    , padRight (Pad 2) $+                      B.border $                       withClickableVScrollBars SBClick $                       withVScrollBars OnLeft $                       withVScrollBarRenderer customVScrollbars $@@ -104,14 +106,32 @@                       viewport VP2 Both $                       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."+                       [ "Press up and down"+                       , "arrow keys to"+                       , "scroll this"+                       , "viewport."+                       , "This viewport uses"+                       , "a custom scroll"+                       , "bar renderer."                        ])                       : (str <$> [ "Line " <> show i | i <- [2..55::Int] ])++                    , B.border $+                      withClickableVScrollBars SBClick $+                      withVScrollBars OnLeft $+                      withVScrollBarHandles $+                      viewport VP3 Both $+                      vBox $+                      (str $ unlines $+                       [ "Press control-up and"+                       , "control-down arrow"+                       , "keys to scroll"+                       , "this viewport."+                       , "This viewport uses"+                       , "the default scroll bar"+                       , "renderer."+                       ])+                      : (str <$> [ "Line " <> show i | i <- [2..55::Int] ])                     ]  vp1Scroll :: M.ViewportScroll Name@@ -120,11 +140,16 @@ vp2Scroll :: M.ViewportScroll Name vp2Scroll = M.viewportScroll VP2 +vp3Scroll :: M.ViewportScroll Name+vp3Scroll = M.viewportScroll VP3+ appEvent :: T.BrickEvent Name e -> T.EventM Name St () appEvent (T.VtyEvent (V.EvKey V.KRight []))  = M.hScrollBy vp1Scroll 1 appEvent (T.VtyEvent (V.EvKey V.KLeft []))   = M.hScrollBy vp1Scroll (-1) 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.KDown [V.MCtrl])) = M.vScrollBy vp3Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KUp [V.MCtrl]))   = M.vScrollBy vp3Scroll (-1) appEvent (T.VtyEvent (V.EvKey V.KEsc []))    = M.halt appEvent (T.MouseDown (SBClick el n) _ _ _) = do     lastClickedElement .= Just (el, n)@@ -139,6 +164,14 @@                 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 ()+        VP3 -> do+            let vp = M.viewportScroll VP3             case el of                 T.SBHandleBefore -> M.vScrollBy vp (-1)                 T.SBHandleAfter  -> M.vScrollBy vp 1

@@ -1,7 +1,7 @@ -- | This module is provided as a convenience to import the most -- important parts of the API all at once. If you are new to Brick and -- are looking to learn it, the best place to start is the--- [Brick User Guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst).+-- [Brick User Guide](https://github.com/jtdaugherty/brick/blob/main/docs/guide.rst). -- The README also has links to other learning resources. Unlike -- most Haskell libraries that only have API documentation, Brick -- is best learned by reading the User Guide and other materials and

@@ -292,7 +292,7 @@                           C.offsetToMs $                           C.subtractTime nextTickTime now -            -- threadDelay works microseconds.+            -- threadDelay works in microseconds.             threadDelay $ sleepMs * 1000             go nextTickTime 

@@ -45,10 +45,13 @@   -- * Misc   , keyDispatcherToList   , lookupVtyEvent+  , lookupEvent+  , bindingsForEvent   ) where  import qualified Data.Map.Strict as M+import Data.Maybe (listToMaybe) import qualified Data.Set as S import qualified Data.Text as T import qualified Graphics.Vty as Vty@@ -106,6 +109,18 @@ lookupVtyEvent :: Vty.Key -> [Vty.Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m) lookupVtyEvent k mods (KeyDispatcher m) = M.lookup (Binding k $ S.fromList mods) m +-- | Find the handler that matches an abstract key event, if any.+lookupEvent :: (Eq k) => k -> KeyDispatcher k m -> Maybe (KeyHandler k m)+lookupEvent ev (KeyDispatcher m) = listToMaybe results+    where+        results = filter ((== ByEvent ev) . kehEventTrigger . khHandler) $ M.elems m++-- | Get the list of all key bindings for the specified event from this+-- dispatcher.+bindingsForEvent :: (Eq k) => KeyDispatcher k m -> k -> [Binding]+bindingsForEvent kd ev =+    [ b | KeyHandler { khBinding = b, khHandler = h } <- snd <$> keyDispatcherToList kd, kehEventTrigger h == ByEvent ev ]+ -- | Handle a keyboard event by looking it up in the 'KeyDispatcher' -- and invoking the matching binding's handler if one is found. Return -- @True@ if the a matching handler was found and run; return @False@ if@@ -151,9 +166,8 @@         groups = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) pairs         badGroups = filter ((> 1) . length) groups         combine :: [(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m])-        combine as =-            let b = fst $ head as-            in (b, snd <$> as)+        combine as@((b, _):_) = (b, snd <$> as)+        combine _ = error "BUG: combine should only be called with non-empty lists"     in if null badGroups        then Right $ KeyDispatcher $ M.fromList pairs        else Left $ combine <$> badGroups

@@ -299,7 +299,7 @@                        , rsScrollRequests = esScrollRequests eState                        , observedNames = S.empty                        , renderCache = mempty-                       , clickableNames = []+                       , clickableNames = mempty                        , requestedVisibleNames_ = requestedVisibleNames eState                        , reportedExtents = mempty                        }@@ -348,9 +348,9 @@        -> App s e n        -> s        -> RenderState n-       -> [Extent n]+       -> [LayerExtents n]        -> Bool-       -> IO (s, NextAction, RenderState n, [Extent n], VtyContext)+       -> IO (s, NextAction, RenderState n, [LayerExtents n], VtyContext) runVty vtyCtx readEvent app appState rs prevExtents draw = do     (firstRS, exts) <- if draw                        then renderApp vtyCtx app appState rs@@ -460,14 +460,25 @@ -- | Did the specified mouse coordinates (column, row) intersect the -- specified extent? clickedExtent :: (Int, Int) -> Extent n -> Bool-clickedExtent (c, r) (Extent _ (Location (lc, lr)) (w, h)) =+clickedExtent pos (Extent _ ul sz) = clickedRegion pos ul sz++-- | Given a position and layer extent, return whether the position+-- falls within the layer extent.+clickedLayerExtent :: (Int, Int) -> LayerExtents n -> Bool+clickedLayerExtent pos (LayerExtents ul sz _) = clickedRegion pos ul sz++-- | Given a position, an upper-left corner, and a region size, return+-- whether the position falls within the region with the specified size+-- at the specified upper-left corner.+clickedRegion :: (Int, Int) -> Location -> (Int, Int) -> Bool+clickedRegion (c, r) (Location (lc, lr)) (w, h) =    c >= lc && c < (lc + w) &&    r >= lr && r < (lr + h)  -- | Given a resource name, get the most recent rendering extent for the -- name (if any). lookupExtent :: (Eq n) => n -> EventM n s (Maybe (Extent n))-lookupExtent n = EventM $ asks (find f . latestExtents)+lookupExtent n = EventM $ asks (find f . concat . fmap layerAppExtents . latestExtents)     where         f (Extent n' _ _) = n == n' @@ -476,12 +487,33 @@ -- the list is the most specific extent and the last extent is the most -- generic (top-level). So if two extents A and B both intersected the -- mouse click but A contains B, then they would be returned [B, A].+--+-- Note that this will prohibit clicks from matching underlying layers+-- if the clicks intersect a layer even if that point in the layer is+-- not itself within a clickable region. This behavior ensures that any+-- clickable region is only clickable if it is not visually obscured by+-- another layer. findClickedExtents :: (Int, Int) -> EventM n s [Extent n] findClickedExtents pos = EventM $ asks (findClickedExtents_ pos . latestExtents) -findClickedExtents_ :: (Int, Int) -> [Extent n] -> [Extent n]-findClickedExtents_ pos = reverse . filter (clickedExtent pos)+-- Internal mouse click extent matching: assuming extents are in order+-- from upper to lower (in layer order), find all matching extents until+-- a layer base is reached, then stop. This ensures that a click on a+-- layer with no matching extent at that location will not fall through+-- to a matching extent at a lower (but visually obstructed) layer.+findClickedExtents_ :: (Int, Int) -> [LayerExtents n] -> [Extent n]+findClickedExtents_ pos ls =+    maybe [] fst $ find isMatch $ getMatching <$> ls+    where+        -- A layer is a match -- that is, it has been clicked on -- if+        -- either some application extent(s) were clicked, or if the+        -- layer itself was clicked outside of any declared extents+        isMatch (es, l) = not (null es) || clickedLayerExtent pos l +        -- For a given layer, pair the layer with all of the clicked+        -- extents in that layer+        getMatching l = (reverse $ filter (clickedExtent pos) $ layerAppExtents l, l)+ -- | Get the Vty handle currently in use. getVtyHandle :: EventM n s Vty getVtyHandle = vtyContextHandle <$> getVtyContext@@ -504,12 +536,12 @@ getRenderState :: EventM n s (RenderState n) getRenderState = EventM $ asks oldState -resetRenderState :: RenderState n -> RenderState n+resetRenderState :: (Ord n) => RenderState n -> RenderState n resetRenderState s =     s & observedNamesL .~ S.empty       & clickableNamesL .~ mempty -renderApp :: (Ord n) => VtyContext -> App s e n -> s -> RenderState n -> IO (RenderState n, [Extent n])+renderApp :: (Ord n) => VtyContext -> App s e n -> s -> RenderState n -> IO (RenderState n, [LayerExtents n]) renderApp vtyCtx app appState rs = do     sz <- displayBounds $ outputIface $ vtyContextHandle vtyCtx     let (newRS, pic, theCursor, exts) = renderFinal (appAttrMap app appState)

@@ -1,6 +1,5 @@ -- | Basic types used by this library. {-# LANGUAGE RankNTypes #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} module Brick.Types   ( -- * The Widget type     Widget(..)@@ -98,7 +97,7 @@   ) where -import Lens.Micro (_1, _2, to, (^.))+import Lens.Micro (to, (^.)) import Lens.Micro.Type (Getting) import Lens.Micro.Mtl (zoom) #if !MIN_VERSION_base(4,13,0)@@ -154,12 +153,6 @@ -- | The rendering context's current drawing attribute. attrL :: forall r n. Getting r (Context n) Attr attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL))--instance TerminalLocation (CursorLocation n) where-    locationColumnL = cursorLocationL._1-    locationColumn = locationColumn . cursorLocation-    locationRowL = cursorLocationL._2-    locationRow = locationRow . cursorLocation  -- | Given an attribute name, obtain the attribute for the attribute -- name by consulting the context's attribute map.

@@ -24,10 +24,10 @@ #endif  -- | A terminal screen location.-data Location = Location { loc :: !(Int, Int)-                         -- ^ (Column, Row)-                         }-                deriving (Show, Eq, Ord, Read, Generic, NFData)+newtype Location = Location { loc :: (Int, Int)+                            -- ^ (Column, Row)+                            }+                            deriving (Show, Eq, Ord, Read, Generic, NFData)  suffixLenses ''Location 

@@ -12,6 +12,7 @@   , locL   , origin   , TerminalLocation(..)+  , ClampPolicy(..)   , Viewport(..)   , ViewportType(..)   , RenderState(..)@@ -20,6 +21,7 @@   , cursorLocationL   , cursorLocationNameL   , cursorLocationVisibleL+  , clOffset   , VScrollBarOrientation(..)   , HScrollBarOrientation(..)   , VScrollbarRenderer(..)@@ -27,6 +29,7 @@   , ClickableScrollbarElement(..)   , Context(..)   , ctxAttrMapL+  , ctxOrigAttrMapL   , ctxAttrNameL   , ctxBorderStyleL   , ctxDynBordersL@@ -50,7 +53,10 @@   , EventRO(..)   , NextAction(..)   , Result(..)+  , addResultOffset+  , addTranslationOffset   , Extent(..)+  , LayerExtents(..)   , Edges(..)   , eTopL, eBottomL, eRightL, eLeftL   , BorderSegment(..)@@ -79,6 +85,10 @@   , cursorsL   , extentsL   , bordersL+  , translationOffsetL+  , verticalClampPolicyL+  , horizontalClampPolicyL+  , extraLayersL   , visibilityRequestsL   , emptyResult   )@@ -87,7 +97,8 @@ import Control.Concurrent (ThreadId) import Control.Monad.Reader import Control.Monad.State.Strict-import Lens.Micro (_1, _2, Lens')+import Data.Sequence (Seq)+import Lens.Micro ((&), (%~), (^.), _1, _2, Lens', each) import Lens.Micro.Mtl (use) import Lens.Micro.TH (makeLenses) import qualified Data.Set as S@@ -143,8 +154,8 @@     RS { viewportMap :: !(M.Map n Viewport)        , rsScrollRequests :: ![(n, ScrollRequest)]        , observedNames :: !(S.Set n)-       , renderCache :: !(M.Map n ([n], Result n))-       , clickableNames :: ![n]+       , renderCache :: !(M.Map n (S.Set n, Result n))+       , clickableNames :: !(S.Set n)        , requestedVisibleNames_ :: !(S.Set n)        , reportedExtents :: !(M.Map n (Extent n))        } deriving (Read, Show, Generic, NFData)@@ -287,6 +298,12 @@                        }                        deriving (Show, Read, Generic, NFData) +data LayerExtents n =+    LayerExtents { layerExtentUpperLeft :: !Location+                 , layerExtentSize      :: !(Int, Int)+                 , layerAppExtents      :: ![Extent n]+                 }+ -- | The type of actions to take upon completion of an event handler. data NextAction =     Continue@@ -353,6 +370,9 @@     , dbSegments :: !(Edges BorderSegment)     } deriving (Eq, Read, Show, Generic, NFData) +data ClampPolicy = Truncate | Reposition+                 deriving (Show, Read, Generic, NFData)+ -- | 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.@@ -381,6 +401,18 @@            , borders :: !(BorderMap DynBorder)            -- ^ Places where we may rewrite the edge of the image when            -- placing this widget next to another one.+           , translationOffset :: !Location+           -- ^ Offset of this result's upper-left corner as a+           -- consequence of translation+           , horizontalClampPolicy :: !ClampPolicy+           -- ^ The policy for whether to clamp this layer to the screen+           -- horizontally, or let it get truncated+           , verticalClampPolicy :: !ClampPolicy+           -- ^ The policy for whether to clamp this layer to the screen+           -- vertically, or let it get truncated+           , extraLayers :: !(Seq (Result n))+           -- ^ Rendering results introduced as intermediate layers+           -- by this result            }            deriving (Show, Read, Generic, NFData) @@ -391,6 +423,10 @@            , visibilityRequests = []            , extents = []            , borders = BM.empty+           , translationOffset = Location (0, 0)+           , extraLayers = mempty+           , horizontalClampPolicy = Truncate+           , verticalClampPolicy = Truncate            }  -- | The type of events.@@ -409,7 +445,7 @@                     deriving (Show, Eq, Ord)  data EventRO n = EventRO { eventViewportMap :: !(M.Map n Viewport)-                         , latestExtents :: ![Extent n]+                         , latestExtents :: ![LayerExtents n]                          , oldState :: !(RenderState n)                          } @@ -439,6 +475,7 @@             , windowHeight :: !Int             , ctxBorderStyle :: !BorderStyle             , ctxAttrMap :: !AttrMap+            , ctxOrigAttrMap :: !AttrMap             , ctxDynBorders :: !Bool             , ctxVScrollBarOrientation :: !(Maybe VScrollBarOrientation)             , ctxVScrollBarRenderer :: !(Maybe (VScrollbarRenderer n))@@ -459,7 +496,63 @@ suffixLenses ''BorderSegment makeLenses ''Viewport +instance TerminalLocation (CursorLocation n) where+    locationColumnL = cursorLocationL._1+    locationColumn = locationColumn . cursorLocation+    locationRowL = cursorLocationL._2+    locationRow = locationRow . cursorLocation++-- | Add a 'Location' offset to the specified 'CursorLocation'.+clOffset :: CursorLocation n -> Location -> CursorLocation n+clOffset cl off = cl & cursorLocationL %~ (<> off)+ lookupReportedExtent :: (Ord n) => n -> RenderM n (Maybe (Extent n)) lookupReportedExtent n = do     m <- lift $ use reportedExtentsL     return $ M.lookup n m++-- | Add an offset to all cursor locations, visibility requests, and+-- extents in the specified rendering result. This function is critical+-- for maintaining correctness in the rendering results as they are+-- processed successively by box layouts and other wrapping combinators,+-- since calls to this function result in converting from widget-local+-- coordinates to (ultimately) terminal-global ones so they can be+-- used by other combinators. You should call this any time you render+-- something and offset it from its original origin.+--+-- Note that this does not modify the translation offset of this result,+-- but it does offset the translations of this result's extra layers+-- so that they maintain their relative position with respect to this+-- result.+addResultOffset :: Location -> Result n -> Result n+addResultOffset (Location (0, 0)) = id+addResultOffset off =+    addCursorOffset off .+    addVisibilityOffset off .+    addExtentOffset off .+    addDynBorderOffset off .+    addExtraLayersOffset off++addVisibilityOffset :: Location -> Result n -> Result n+addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)++addExtentOffset :: Location -> Result n -> Result n+addExtentOffset off r = r & extentsL.each %~ (\(Extent n l sz) -> Extent n (off <> l) sz)++addDynBorderOffset :: Location -> Result n -> Result n+addDynBorderOffset off r = r & bordersL %~ BM.translate off++addCursorOffset :: Location -> Result n -> Result n+addCursorOffset off r =+    let onlyVisible = filter isVisible+        isVisible l = l^.locationColumnL >= 0 && l^.locationRowL >= 0+    in r & cursorsL %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs)++-- | Add an offset to the translation offset for this result.+addTranslationOffset :: Location -> Result n -> Result n+addTranslationOffset (Location (0, 0)) r = r+addTranslationOffset off r =+    r & translationOffsetL %~ (off <>)++addExtraLayersOffset :: Location -> Result n -> Result n+addExtraLayersOffset off r = r & extraLayersL %~ (fmap (addTranslationOffset off))

@@ -9,13 +9,13 @@   ) where -import Lens.Micro ((&), (%~)) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif import Graphics.Vty -import Brick.Types.Internal (Location(..), CursorLocation(..), cursorLocationL)+-- Re-export clOffset for backwards compatibility.+import Brick.Types.Internal (clOffset)  -- | Given a minimum value and a maximum value, clamp a value to that -- range (values less than the minimum map to the minimum and values@@ -61,7 +61,3 @@ -- "default"). style :: Style -> Attr style = (defAttr `withStyle`)---- | Add a 'Location' offset to the specified 'CursorLocation'.-clOffset :: CursorLocation n -> Location -> CursorLocation n-clOffset cl off = cl & cursorLocationL %~ (<> off)

@@ -19,8 +19,7 @@  import Lens.Micro ((^.), (&), (.~), to) import Data.Maybe (fromMaybe)-import Graphics.Vty (imageWidth, imageHeight, horizCat, charFill, vertCat,-                    translateX, translateY)+import Graphics.Vty (imageWidth, imageHeight, horizCat, charFill, vertCat)  import Brick.Types import Brick.Widgets.Core@@ -30,11 +29,11 @@ hCenter :: Widget n -> Widget n hCenter = hCenterWith Nothing --- | Center the specified widget horizontally using a Vty image--- translation. Consumes all available horizontal space. Unlike hCenter,--- this does not fill the surrounding space so it is suitable for use--- as a layer. Layers underneath this widget will be visible in regions--- surrounding the centered widget.+-- | Center the specified widget horizontally using a layer translation.+-- Consumes all available horizontal space. Unlike hCenter, this does+-- not fill the surrounding space so it is suitable for use as a layer.+-- Layers underneath this widget will be visible in regions surrounding+-- the centered widget. hCenterLayer :: Widget n -> Widget n hCenterLayer p =     Widget Greedy (vSize p) $ do@@ -42,12 +41,8 @@         c <- getContext         let rWidth = result^.imageL.to imageWidth             leftPaddingAmount = max 0 $ (c^.availWidthL - rWidth) `div` 2-            paddedImage = translateX leftPaddingAmount $ result^.imageL             off = Location (leftPaddingAmount, 0)-        if leftPaddingAmount == 0 then-            return result else-            return $ addResultOffset off-                   $ result & imageL .~ paddedImage+        render $ translateLayer off $ Widget Fixed Fixed $ return result  -- | Center the specified widget horizontally. Consumes all available -- horizontal space. Uses the specified character to fill in the space@@ -79,11 +74,11 @@ vCenter :: Widget n -> Widget n vCenter = vCenterWith Nothing --- | Center the specified widget vertically using a Vty image--- translation. Consumes all available vertical space. Unlike vCenter,--- this does not fill the surrounding space so it is suitable for use--- as a layer. Layers underneath this widget will be visible in regions--- surrounding the centered widget.+-- | Center the specified widget vertically using a layer translation.+-- Consumes all available vertical space. Unlike vCenter, this does not+-- fill the surrounding space so it is suitable for use as a layer.+-- Layers underneath this widget will be visible in regions surrounding+-- the centered widget. vCenterLayer :: Widget n -> Widget n vCenterLayer p =     Widget (hSize p) Greedy $ do@@ -91,12 +86,8 @@         c <- getContext         let rHeight = result^.imageL.to imageHeight             topPaddingAmount = max 0 $ (c^.availHeightL - rHeight) `div` 2-            paddedImage = translateY topPaddingAmount $ result^.imageL             off = Location (0, topPaddingAmount)-        if topPaddingAmount == 0 then-            return result else-            return $ addResultOffset off-                   $ result & imageL .~ paddedImage+        render $ translateLayer off $ Widget Fixed Fixed $ return result  -- | Center a widget vertically. Consumes all vertical space. Uses the -- specified character to fill in the space above and below the centered@@ -135,7 +126,7 @@ centerWith :: Maybe Char -> Widget n -> Widget n centerWith c = vCenterWith c . hCenterWith c --- | Center a widget both vertically and horizontally using a Vty image+-- | Center a widget both vertically and horizontally using a layer -- translation. Consumes all available vertical and horizontal space. -- Unlike center, this does not fill in the surrounding space with a -- character so it is usable as a layer. Any widget underneath this one@@ -153,10 +144,10 @@       c <- getContext       let centerW = c^.availWidthL `div` 2           centerH = c^.availHeightL `div` 2-          off = Location ( centerW - l^.locationColumnL-                         , centerH - l^.locationRowL-                         )-      result <- render $ translateBy off p+          hOff = centerW - l^.locationColumnL+          vOff = centerH - l^.locationRowL++      result <- render $ padLeft (Pad hOff) $ padTop (Pad vOff) p        -- Pad the result so it consumes available space       let rightPaddingAmt = max 0 $ c^.availWidthL - imageWidth (result^.imageL)

@@ -13,6 +13,7 @@     TextWidth(..)   , emptyWidget   , raw+  , char   , txt   , txtWrap   , txtWrapWith@@ -67,9 +68,11 @@   -- * Naming   , Named(..) -  -- * Translation and positioning-  , translateBy-  , relativeTo+  -- * Layer translation and positioning+  , translateLayer+  , layerRelativeTo+  , above+  , clampLayerToScreen    -- * Cropping   , cropLeftBy@@ -85,12 +88,14 @@   , reportExtent   , clickable +  -- * Caching widget renderings+  , cached+   -- * Scrollable viewports   , viewport   , visible   , visibleRegion   , unsafeLookupViewport-  , cached    -- ** Viewport scroll bars   , withVScrollBars@@ -123,11 +128,12 @@ import Data.Monoid ((<>)) #endif -import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, Lens')+import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, to, Lens') import Lens.Micro.Mtl (use, (%=)) import Control.Monad import Control.Monad.State.Strict import Control.Monad.Reader+import qualified Data.Sequence as Seq import qualified Data.Foldable as F import Data.Traversable (for) import qualified Data.Text as T@@ -136,7 +142,7 @@ import qualified Data.IMap as I import qualified Data.Function as DF import Data.List (sortBy, partition)-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, fromJust) import qualified Graphics.Vty as V import Control.DeepSeq @@ -145,7 +151,7 @@ import Brick.Types import Brick.Types.Internal import Brick.Widgets.Border.Style-import Brick.Util (clOffset, clamp)+import Brick.Util (clamp) import Brick.AttrMap import Brick.Widgets.Internal import qualified Brick.BorderMap as BM@@ -158,7 +164,7 @@     textWidth :: a -> Int  instance TextWidth T.Text where-    textWidth = V.wcswidth . T.unpack+    textWidth = V.wctwidth  instance (F.Foldable f) => TextWidth (f Char) where     textWidth = V.wcswidth . F.toList@@ -174,15 +180,16 @@ withBorderStyle bs p = Widget (hSize p) (vSize p) $     withReaderT (ctxBorderStyleL .~ bs) (render p) --- | When rendering the specified widget, create borders that respond--- dynamically to their neighbors to form seamless connections.+-- | When rendering the specified widget, draw any borders dynamically+-- so that they connect with each other when they're adjacent. joinBorders :: Widget n -> Widget n joinBorders p = Widget (hSize p) (vSize p) $     withReaderT (ctxDynBordersL .~ True) (render p) --- | When rendering the specified widget, use static borders. This--- may be marginally faster, but will introduce a small gap between--- neighboring orthogonal borders.+-- | When rendering the specified widget, use static borders that do not+-- connect to each other dynamically. This may be marginally faster, but+-- will leave a small visual gap between adjacent borders that would+-- otherwise touch. -- -- This is the default for backwards compatibility. separateBorders :: Widget n -> Widget n@@ -190,10 +197,11 @@     withReaderT (ctxDynBordersL .~ False) (render p)  -- | After the specified widget has been rendered, freeze its borders. A--- frozen border will not be affected by neighbors, nor will it affect--- neighbors. Compared to 'separateBorders', 'freezeBorders' will not--- affect whether borders connect internally to a widget (whereas--- 'separateBorders' prevents them from connecting).+-- frozen border will not be affected by adjacent borders, nor will it+-- affect other adjacent borders in the enclosing widget. Compared to+-- 'separateBorders', 'freezeBorders' will not affect whether borders+-- connect internally to a widget (whereas 'separateBorders' prevents+-- them from connecting). -- -- Frozen borders cannot be thawed. freezeBorders :: Widget n -> Widget n@@ -203,30 +211,6 @@ emptyWidget :: Widget n emptyWidget = raw V.emptyImage --- | Add an offset to all cursor locations, visibility requests, and--- extents in the specified rendering result. This function is critical--- for maintaining correctness in the rendering results as they are--- processed successively by box layouts and other wrapping combinators,--- since calls to this function result in converting from widget-local--- coordinates to (ultimately) terminal-global ones so they can be--- used by other combinators. You should call this any time you render--- something and then translate it or otherwise offset it from its--- original origin.-addResultOffset :: Location -> Result n -> Result n-addResultOffset off = addCursorOffset off .-                      addVisibilityOffset off .-                      addExtentOffset off .-                      addDynBorderOffset off--addVisibilityOffset :: Location -> Result n -> Result n-addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)--addExtentOffset :: Location -> Result n -> Result n-addExtentOffset off r = r & extentsL.each %~ (\(Extent n l sz) -> Extent n (off <> l) sz)--addDynBorderOffset :: Location -> Result n -> Result n-addDynBorderOffset off r = r & bordersL %~ BM.translate off- -- | Render the specified widget and record its rendering extent using -- the specified name (see also 'lookupExtent'). --@@ -260,15 +244,9 @@ clickable :: (Ord n) => n -> Widget n -> Widget n clickable n p =     Widget (hSize p) (vSize p) $ do-        clickableNamesL %= (n:)+        clickableNamesL %= S.insert n         render $ reportExtent n p -addCursorOffset :: Location -> Result n -> Result n-addCursorOffset off r =-    let onlyVisible = filter isVisible-        isVisible l = l^.locationColumnL >= 0 && l^.locationRowL >= 0-    in r & cursorsL %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs)- unrestricted :: Int unrestricted = 100000 @@ -312,13 +290,21 @@       case force theLines of           [] -> return emptyResult           multiple ->-              let maxLength = maximum $ textWidth <$> multiple+              let maxLength = maximum $ fst <$> linesWithLength+                  linesWithLength = (\l -> (textWidth l, l)) <$> multiple                   padding = V.charFill (c^.attrL) ' ' (c^.availWidthL - maxLength) (length lineImgs)-                  lineImgs = lineImg <$> multiple-                  lineImg lStr = V.text' (c^.attrL)-                                   (lStr <> T.replicate (maxLength - textWidth lStr) " ")+                  lineImgs = lineImg <$> linesWithLength+                  lineImg (len, lStr) = V.text' (c^.attrL)+                                   (lStr <> T.replicate (maxLength - len) " ")               in return $ emptyResult & imageL .~ (V.horizCat [V.vertCat lineImgs, padding]) +-- | Build a widget from a single character.+char :: Char -> Widget n+char ch =+    Widget Fixed Fixed $ do+        c <- getContext+        return $ emptyResult & imageL .~ (V.char (c^.attrL) ch)+ -- | Build a widget from a 'String'. Behaves the same as 'txt' when the -- input contains multiple lines. --@@ -353,10 +339,11 @@             [] -> emptyResult             [one] -> emptyResult & imageL .~ (V.text' (c^.attrL) one)             multiple ->-                let maxLength = maximum $ V.safeWctwidth <$> multiple-                    lineImgs = lineImg <$> multiple-                    lineImg lStr = V.text' (c^.attrL)-                        (lStr <> T.replicate (maxLength - V.safeWctwidth lStr) (T.singleton ' '))+                let maxLength = maximum $ fst <$> linesWithLength+                    linesWithLength = (\l -> (V.safeWctwidth l, l)) <$> multiple+                    lineImgs = lineImg <$> linesWithLength+                    lineImg (len, lStr) = V.text' (c^.attrL)+                        (lStr <> T.replicate (maxLength - len) (T.singleton ' '))                 in emptyResult & imageL .~ (V.vertCat lineImgs)  -- | Take up to the given width, having regard to character width.@@ -718,7 +705,62 @@                             (concatMap visibilityRequests allTranslatedResults)                             (concatMap extents allTranslatedResults)                             newBorders+                            (Location (0, 0))+                            Truncate Truncate+                            (mconcat $ extraLayers <$> allTranslatedResults) +-- | Given a result, crop all of its extra layers to the rendering+-- context. This is only used when rendering a result in a viewport; in+-- a viewport setting, we want to show extra layers but crop them to the+-- bounds of the viewport.+cropExtraLayersToContext :: Result n -> RenderM n (Result n)+cropExtraLayersToContext r = do+    let ls = r^.extraLayersL+    ls' <- mapM cropExtraLayerToContext ls+    return $ r & extraLayersL .~ ls'++-- | Given a layer, crop it to the rendering context. This is only used+-- when rendering a layer on top of a base layer in a viewport. In this+-- setting, we want to crop the layer so that it is confined to the+-- viewport's region. This works by assuming that the rendering context+-- represents the scrollable area of the viewport, and that the extra+-- layers on top of the base layer have been translated with respect to+-- the viewport's scrolling state, meaning that some layers may have+-- been translated to have negative left or top offsets. Negative left+-- or top offsets indicate that a layer is partially or fully obscured+-- by the viewport's visible area, and right or bottom portions of+-- layers that exceed the bounds of the scrollable area will exceed the+-- rendering context's size so normal 'cropResultToContext' behavior+-- will crop them.+--+-- In all cases, the extra layer will be cropped on all sides as+-- necessary to limit its visible portion to whatever is permitted by+-- its base layer's scroll position in the viewport, since that has been+-- used to set up the rendering context and layer translation.+cropExtraLayerToContext :: Result n -> RenderM n (Result n)+cropExtraLayerToContext r = do+    ctx <- getContext++    let hOff = r^.translationOffsetL.locationColumnL+        vOff = r^.translationOffsetL.locationRowL+        leftCropAmt = abs $ min 0 hOff+        topCropAmt = abs $ min 0 vOff+        iWidth = V.imageWidth $ r^.imageL+        iHeight = V.imageHeight $ r^.imageL+        rightCropAmt = max (hOff + iWidth - ctx^.availWidthL) 0+        bottomCropAmt = max (vOff + iHeight - ctx^.availHeightL) 0+        maybeCropLeft = if leftCropAmt > 0 then cropLeftBy leftCropAmt else id+        maybeCropTop = if topCropAmt > 0 then cropTopBy topCropAmt else id++    r' <- addTranslationOffset (Location (leftCropAmt, topCropAmt)) <$>+          (render $ cropRightBy rightCropAmt $+                    cropBottomBy bottomCropAmt $+                    maybeCropLeft $+                    maybeCropTop $+                    Widget Fixed Fixed $ return r)++    cropExtraLayersToContext r'+ catDynBorder :: Lens' (Edges BorderSegment) BorderSegment              -> Lens' (Edges BorderSegment) BorderSegment              -> DynBorder@@ -1069,57 +1111,147 @@ raw :: V.Image -> Widget n raw img = Widget Fixed Fixed $ return $ emptyResult & imageL .~ img --- | Translate the specified widget by the specified offset amount.+-- | Translate the specified layer widget by the specified offset. -- Defers to the translated widget for growth policy.-translateBy :: Location -> Widget n -> Widget n-translateBy off p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      return $ addResultOffset off-             $ result & imageL %~ (V.translate (off^.locationColumnL) (off^.locationRowL))+--+-- This only applies to layer widgets, meaning that translating a+-- widget that is embedded within another widget will have no effect.+-- For example, this translation of @bar@ has no effect because @bar@ is+-- embedded in a box, and translations only apply if specified for the+-- outermost @Widget@:+--+-- > foo <+> translateLayer (Location (1, 1)) bar+--+-- @translateLayer@ does not translate immediately; instead, it records+-- a translation offset to be applied at rendering time. Subsequent+-- calls to this function on the same widget accumulate the offset.+--+-- Note that by default, layers may be cut off by screen edges when+-- translated enough so that the contents don't fit on screen; to+-- prevent this, use 'clampLayerToScreen'.+translateLayer :: Location -> Widget n -> Widget n+translateLayer (Location (0, 0)) w = w+translateLayer off p =+    Widget (hSize p) (vSize p) $ addTranslationOffset off <$> render p --- | Given a widget, translate it to position it relative to the--- upper-left coordinates of a reported extent with the specified+-- | Given a layer, clamp its translation offset so that its contents+-- stay on screen even when its translation would otherwise result the+-- widget being partially or completely cut off by a screen edge.+clampLayerToScreen :: Widget n -> Widget n+clampLayerToScreen w =+    Widget (hSize w) (vSize w) $ do+        r <- render w+        return $ r & horizontalClampPolicyL .~ Reposition+                   & verticalClampPolicyL .~ Reposition++-- | Given a layer widget, translate it to position it relative to+-- the upper-left coordinates of a reported extent with the specified -- positioning offset. If the specified name has no reported extent, -- this draws nothing on the basis that it only makes sense to draw what--- was requested when the relative position can be known.------ This is only useful for positioning something in a higher layer--- relative to a reported extent in a lower layer. Any other use is--- likely to result in the specified widget not being rendered. This--- is because this function relies on information about lower layer--- renderings in order to work; using it with a resource name that--- wasn't rendered in a lower layer will result in this being equivalent--- to @emptyWidget@.+-- was requested when the relative position is known. -- -- For example, if you have two layers @topLayer@ and @bottomLayer@, -- then a widget drawn in @bottomLayer@ with @reportExtent Foo@ can be -- used to relatively position a widget in @topLayer@ with @topLayer = -- relativeTo Foo ...@.-relativeTo :: (Ord n) => n -> Location -> Widget n -> Widget n-relativeTo n off w =+--+-- To introduce a new layer directly into the rendering process without+-- referencing a reported extent, see 'above'.+layerRelativeTo :: (Ord n) => n -> Location -> Widget n -> Widget n+layerRelativeTo n off w =     Widget (hSize w) (vSize w) $ do         mExt <- lookupReportedExtent n         case mExt of             Nothing -> render emptyWidget-            Just ext -> render $ translateBy (extentUpperLeft ext <> off) w+            Just ext -> render $ translateLayer (extentUpperLeft ext <> off) w +-- | @above upper lower@ introduces @upper@ as a new layer that is+-- positioned relative to the upper-left corner of @lower@. The upper+-- layer will be drawn in a rendering context with the same available+-- space as the screen, regardless of the rendering context in which+-- the lower layer is drawn. The attribute map in use for the upper+-- layer will be the same as the one for the initial rendering request,+-- meaning that any attribute changes for the lower layer will not+-- affect the upper layer's appearnce.+--+-- A layer introduced this way will be beneath any layers further up in+-- the layer stack returned by the main drawing function, so that means+-- that in this arrangement,+--+-- > draw :: s -> [Widget n]+-- > draw _ = [upper, lower]+-- >+-- > lower :: Widget n+-- > lower = middle `above` bottom+--+-- the resulting layering is @[upper, middle, bottom]@, with @middle@+-- having the same upper-left corner position as @bottom@, even+-- if @bottom@ has been translated with 'translateBy' or has been+-- positioned in a box layout.+--+-- In addition, when two layers are introduced above widgets in the same+-- layer, their ordering with respect to each other in the final layer+-- list is undefined. The only guarantee is that they will be above the+-- widget in question but underneath the nextmost layer further up in+-- the stack. For example,+--+-- > draw :: s -> [Widget n]+-- > draw _ = [upper, lower]+-- >+-- > lower :: Widget n+-- > lower = (a `above` b) <+> (c `above` d)+--+-- will result in a layer ordering with both @a@ and @c@ being beneath+-- @upper@ and above @b \<+\> d@ in the sequence, but the order of @a@ and+-- @c@ with respect to each other is undefined.+above :: Widget n -> Widget n -> Widget n+above upper lower =+    Widget (hSize lower) (vSize lower) $ do+        ctx <- getContext++        let resetConstraints = (availHeightL .~ ctx^.windowHeightL) .+                               (availWidthL .~ ctx^.windowWidthL) .+                               (ctxAttrNameL .~ attrName "") .+                               (ctxAttrMapL .~ ctx^.ctxOrigAttrMapL)++        upperResult <- withReaderT resetConstraints $ render upper++        lowerResult <- render lower++        return $ lowerResult & extraLayersL %~ (upperResult Seq.<|)+ -- | Crop the specified widget on the left by the specified number of -- columns. Defers to the cropped widget for growth policy.+--+-- This operation crops the widget without regard for its translation+-- offset, meaning that+--+-- > cropLeftBy amt $ translateBy n w+--+-- is effectively equivalent to+--+-- > translateBy n $ cropLeftBy amt w cropLeftBy :: Int -> Widget n -> Widget n+cropLeftBy 0 p = p cropLeftBy cols p =     Widget (hSize p) (vSize p) $ do       result <- render p-      let amt = V.imageWidth (result^.imageL) - cols-          cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img-      render $ Widget (hSize p) (vSize p) $-               withReaderT (availWidthL .~ amt) $-                   cropResultToContext $-                       addResultOffset (Location (-1 * cols, 0)) $-                           result & imageL %~ cropped +      let img = result^.imageL+          newWidth = V.imageWidth img - cols++      withReaderT (availWidthL .~ newWidth) $+          cropResultToContext $+              if cols >= V.imageWidth img+              then emptyResult+              else addResultOffset (Location ((-1 * cols), 0)) $+                   result & imageL .~ V.cropLeft newWidth img+ -- | Crop the specified widget to the specified size from the left. -- Defers to the cropped widget for growth policy.+--+-- See 'cropLeftBy' for details about how this interacts with layer+-- translations. cropLeftTo :: Int -> Widget n -> Widget n cropLeftTo cols p =     Widget (hSize p) (vSize p) $ do@@ -1132,17 +1264,25 @@  -- | Crop the specified widget on the right by the specified number of -- columns. Defers to the cropped widget for growth policy.+--+-- See 'cropLeftBy' for details about how this interacts with layer+-- translations. cropRightBy :: Int -> Widget n -> Widget n+cropRightBy 0 p = p cropRightBy cols p =     Widget (hSize p) (vSize p) $ do       result <- render p-      let amt = V.imageWidth (result^.imageL) - cols-          cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img-      withReaderT (availWidthL .~ amt) $-          cropResultToContext $ result & imageL %~ cropped +      let img = result^.imageL+          newWidth = V.imageWidth img - cols++      render $ hLimit newWidth $ Widget Fixed Fixed $ return result+ -- | Crop the specified widget to the specified size from the right. -- Defers to the cropped widget for growth policy.+--+-- See 'cropLeftBy' for details about how this interacts with layer+-- translations. cropRightTo :: Int -> Widget n -> Widget n cropRightTo cols p =     Widget (hSize p) (vSize p) $ do@@ -1155,20 +1295,30 @@  -- | Crop the specified widget on the top by the specified number of -- rows. Defers to the cropped widget for growth policy.+--+-- See 'cropLeftBy' for details about how this interacts with layer+-- translations. cropTopBy :: Int -> Widget n -> Widget n+cropTopBy 0 p = p cropTopBy rows p =     Widget (hSize p) (vSize p) $ do       result <- render p-      let amt = V.imageHeight (result^.imageL) - rows-          cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img-      render $ Widget (hSize p) (vSize p) $-               withReaderT (availHeightL .~ amt) $-                   cropResultToContext $-                       addResultOffset (Location (0, -1 * rows)) $-                           result & imageL %~ cropped +      let img = result^.imageL+          newHeight = V.imageHeight img - rows++      withReaderT (availHeightL .~ newHeight) $+          cropResultToContext $+              if rows >= V.imageHeight img+              then emptyResult+              else addResultOffset (Location (0, (-1 * rows))) $+                   result & imageL .~ V.cropTop newHeight img+ -- | Crop the specified widget to the specified size from the top. -- Defers to the cropped widget for growth policy.+--+-- See 'cropLeftBy' for details about how this interacts with layer+-- translations. cropTopTo :: Int -> Widget n -> Widget n cropTopTo rows p =     Widget (hSize p) (vSize p) $ do@@ -1181,17 +1331,25 @@  -- | Crop the specified widget on the bottom by the specified number of -- rows. Defers to the cropped widget for growth policy.+--+-- See 'cropLeftBy' for details about how this interacts with layer+-- translations. cropBottomBy :: Int -> Widget n -> Widget n+cropBottomBy 0 p = p cropBottomBy rows p =     Widget (hSize p) (vSize p) $ do       result <- render p-      let amt = V.imageHeight (result^.imageL) - rows-          cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img-      withReaderT (availHeightL .~ amt) $-          cropResultToContext $ result & imageL %~ cropped +      let img = result^.imageL+          newHeight = V.imageHeight img - rows++      render $ vLimit newHeight $ Widget Fixed Fixed $ return result+ -- | Crop the specified widget to the specified size from the bottom. -- Defers to the cropped widget for growth policy.+--+-- See 'cropLeftBy' for details about how this interacts with layer+-- translations. cropBottomTo :: Int -> Widget n -> Widget n cropBottomTo rows p =     Widget (hSize p) (vSize p) $ do@@ -1245,7 +1403,7 @@         result <- cacheLookup n         case result of             Just (clickables, prevResult) -> do-                clickableNamesL %= (clickables ++)+                clickableNamesL %= (clickables <>)                 return prevResult             Nothing  -> do                 wResult <- render w@@ -1255,17 +1413,18 @@     where         -- Given the rendered result of a Widget, collect the list of "clickable" names         -- from the extents that were in the result.-        renderedClickables :: (Ord n) => Result n -> RenderM n [n]+        renderedClickables :: (Ord n) => Result n -> RenderM n (S.Set n)         renderedClickables renderResult = do+            layerClickables <- S.unions <$> mapM renderedClickables (renderResult^.extraLayersL)             allClickables <- use clickableNamesL-            return [extentName e | e <- renderResult^.extentsL, extentName e `elem` allClickables]+            return $ layerClickables <> S.fromList [extentName e | e <- renderResult^.extentsL, extentName e `F.elem` allClickables] -cacheLookup :: (Ord n) => n -> RenderM n (Maybe ([n], Result n))+cacheLookup :: (Ord n) => n -> RenderM n (Maybe (S.Set n, Result n)) cacheLookup n = do     cache <- lift $ gets (^.renderCacheL)     return $ M.lookup n cache -cacheUpdate :: Ord n => n -> ([n], Result n) -> RenderM n ()+cacheUpdate :: Ord n => n -> (S.Set 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@@ -1302,8 +1461,8 @@ verticalScrollbarRenderer =     VScrollbarRenderer { renderVScrollbar = fill '█'                        , renderVScrollbarTrough = fill ' '-                       , renderVScrollbarHandleBefore = str "^"-                       , renderVScrollbarHandleAfter = str "v"+                       , renderVScrollbarHandleBefore = char '^'+                       , renderVScrollbarHandleAfter = char 'v'                        , scrollbarWidthAllocation = 1                        } @@ -1361,8 +1520,8 @@ horizontalScrollbarRenderer =     HScrollbarRenderer { renderHScrollbar = fill '█'                        , renderHScrollbarTrough = fill ' '-                       , renderHScrollbarHandleBefore = str "<"-                       , renderHScrollbarHandleAfter = str ">"+                       , renderHScrollbarHandleBefore = char '<'+                       , renderHScrollbarHandleAfter = char '>'                        , scrollbarHeightAllocation = 1                        } @@ -1540,10 +1699,13 @@           Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"           Just v -> return v -      -- Then perform a translation of the sub-rendering to fit into the-      -- viewport-      translated <- render $ translateBy (Location (-1 * vpFinal^.vpLeft, -1 * vpFinal^.vpTop))-                           $ Widget Fixed Fixed $ return initialResult+      -- Then crop the sub-rendering to fit into the viewport at the+      -- desired viewport offset.+      translated <- render $ fromJust $+                             release $+                             cropLeftBy (vpFinal^.vpLeft) $+                             cropTopBy (vpFinal^.vpTop) $+                             Widget Fixed Fixed $ return initialResult        -- If the vertical scroll bar is enabled, render the scroll bar       -- area.@@ -1584,17 +1746,16 @@       case translatedSize of           (0, 0) -> do               let spaceFill = V.charFill (c^.attrL) ' ' (c^.availWidthL) (c^.availHeightL)-              return $ translated & imageL .~ spaceFill-                                  & visibilityRequestsL .~ mempty-                                  & extentsL .~ mempty+              return $ emptyResult & imageL .~ spaceFill           _ -> render $ addVScrollbar                       $ addHScrollbar                       $ vLimit (vpFinal^.vpSize._2)                       $ hLimit (vpFinal^.vpSize._1)                       $ padBottom Max                       $ padRight Max-                      $ Widget Fixed Fixed-                      $ return $ translated & visibilityRequestsL .~ mempty+                      $ Widget Fixed Fixed $+                            cropResultToContext =<<+                                (cropExtraLayersToContext $ translated & visibilityRequestsL .~ mempty)  -- | The base attribute for scroll bars. scrollbarAttr :: AttrName

@@ -232,13 +232,13 @@             Just lim -> vLimit lim         atChar = charAtCursor $ e^.editContentsL         atCharWidth = maybe 1 textWidth atChar+        contents = getEditContents e     in withAttr (if foc then editFocusedAttr else editAttr) $        limit $        viewport (e^.editorNameL) Both $        (if foc then showCursor (e^.editorNameL) cursorLoc else id) $        visibleRegion cursorLoc (atCharWidth, 1) $-       draw $-       getEditContents e+       (draw contents) <+> char ' '  charAtCursor :: (Z.GenericTextZipper t) => Z.TextZipper t -> Maybe t charAtCursor z =

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-} module Brick.Widgets.Internal   ( renderFinal   , cropToContext@@ -13,6 +14,9 @@ import Control.Monad import Control.Monad.State.Strict import Control.Monad.Reader+import qualified Data.Foldable as F+import qualified Data.Sequence as Seq+import qualified Data.Traversable as T import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Map as M import qualified Data.Set as S@@ -31,9 +35,9 @@             -> V.DisplayRegion             -> ([CursorLocation n] -> Maybe (CursorLocation n))             -> RenderState n-            -> (RenderState n, V.Picture, Maybe (CursorLocation n), [Extent n])+            -> (RenderState n, V.Picture, Maybe (CursorLocation n), [LayerExtents n]) renderFinal aMap layerRenders (w, h) chooseCursor rs =-    (newRS, picWithBg, theCursor, concat layerExtents)+    (newRS, picWithBg, theCursor, F.toList layerExtents)     where         -- Reset various fields from the last rendering state so they         -- don't accumulate or affect this rendering.@@ -41,15 +45,83 @@                      & observedNamesL .~ mempty                      & clickableNamesL .~ mempty -        (layerResults, !newRS) = flip runState resetRs $ sequence $-            (\p -> runReaderT p ctx) <$>-            (\layerWidget -> do-                result <- render $ cropToContext layerWidget-                forM_ (result^.extentsL) $ \e ->-                    reportedExtentsL %= M.insert (extentName e) e-                return result-                ) <$> reverse layerRenders+        (allLayers, !newRS) = flip runState resetRs $ do+            go $ Seq.fromList layerRenders+            where+                go layers =+                    case Seq.viewr layers of+                        Seq.EmptyR -> return mempty+                        rest Seq.:> next -> do+                            thisLayerResults <- flip runReaderT ctx $+                                processMainLayer next +                            restResults <- go rest+                            return $ restResults <> thisLayerResults++                processMainLayer layerWidget = do+                    let recordExtents r =+                            forM_ (r^.extentsL) $ \e ->+                                reportedExtentsL %= M.insert (extentName e) e++                    -- Keep track of the rendered result prior to+                    -- translation so we can record its size. Once+                    -- translated, its size will be the size of the+                    -- display region, but we need the original+                    -- untranslated size so we can keep track of layer+                    -- extents for click events.+                    preTranslation <- render $ cropToContext layerWidget+                    let result = translateResult preTranslation+                    recordExtents result++                    let gatherLayer r = do+                            let r' = translateResult r+                            recordExtents r'++                            rest <- T.mapM gatherLayer $ r'^.extraLayersL+                            return $ concatSeq rest Seq.|> (resultSize r, r')++                    translatedLayerResults <- T.mapM gatherLayer $ result^.extraLayersL+                    return $ concatSeq translatedLayerResults Seq.|> (resultSize preTranslation, result)++        getTranslationOffset r =+            let originalOffset = translationOffset r+                correction = getTranslationCorrection r+            in originalOffset <> correction++        getTranslationCorrection r =+            let Location (hOff, vOff) = translationOffset r+                rWidth = V.imageWidth (r^.imageL)+                rHeight = V.imageHeight (r^.imageL)+                colCorrection = if hOff < 0+                                then abs hOff+                                else if hOff + rWidth > w+                                     then w - (hOff + rWidth)+                                     else 0+                rowCorrection = if vOff < 0+                                then abs vOff+                                else if vOff + rHeight > h+                                     then h - (vOff + rHeight)+                                     else 0+                hCorrection = case horizontalClampPolicy r of+                    Truncate -> Location (0, 0)+                    Reposition -> Location (colCorrection, 0)+                vCorrection = case verticalClampPolicy r of+                    Truncate -> Location (0, 0)+                    Reposition -> Location (0, rowCorrection)+            in hCorrection <> vCorrection++        translateResult r =+            let off = getTranslationOffset r+            in addResultOffset off $+               r & imageL %~ (V.translate (off^.locationColumnL) (off^.locationRowL))++        resultSize r = (V.imageWidth i, V.imageHeight i)+            where+            i = r^.imageL++        concatSeq ss =+            F.foldr (Seq.><) Seq.empty ss+         ctx = Context { ctxAttrName = mempty                       , availWidth = w                       , availHeight = h@@ -57,6 +129,7 @@                       , windowHeight = h                       , ctxBorderStyle = defaultBorderStyle                       , ctxAttrMap = aMap+                      , ctxOrigAttrMap = aMap                       , ctxDynBorders = False                       , ctxVScrollBarOrientation = Nothing                       , ctxVScrollBarRenderer = Nothing@@ -68,16 +141,21 @@                       , ctxVScrollBarClickableConstr = Nothing                       } -        layersTopmostFirst = reverse layerResults-        pic = V.picForLayers $ V.resize w h <$> (^.imageL) <$> layersTopmostFirst+        pic = V.picForLayers $ F.toList $ V.resize w h <$> (^.imageL) <$> snd <$> allLayers          -- picWithBg is a workaround for runaway attributes.         -- See https://github.com/coreyoconnor/vty/issues/95         picWithBg = pic { V.picBackground = V.Background ' ' V.defAttr } -        layerCursors = (^.cursorsL) <$> layersTopmostFirst-        layerExtents = reverse $ (^.extentsL) <$> layersTopmostFirst-        theCursor = chooseCursor $ concat layerCursors+        (layerCursors, layerExtents) = Seq.unzipWith layerInfo allLayers+        layerInfo (untranslatedSize, l) = (l^.cursorsL, mkLayerExtents untranslatedSize l)+        mkLayerExtents untranslatedSize l =+            -- The size of a layer is its size prior to translation,+            -- since measuring the layer's image size after translation+            -- will give a size much bigger than the size of the layer's+            -- apparent visual area.+            LayerExtents (l^.translationOffsetL) untranslatedSize $ l^.extentsL+        theCursor = chooseCursor $ concat $ F.toList layerCursors  -- | After rendering the specified widget, crop its result image to the -- dimensions in the rendering context.@@ -191,7 +269,7 @@                        , rsScrollRequests = []                        , observedNames = S.empty                        , renderCache = mempty-                       , clickableNames = []+                       , clickableNames = mempty                        , requestedVisibleNames_ = S.empty                        , reportedExtents = mempty                        }

@@ -1,20 +1,18 @@-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE DeriveGeneric #-}--- | This module provides a scrollable list type and functions for--- manipulating and rendering it.+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+-- | This module provides a scrollable list type. ----- Note that lenses are provided for direct manipulation purposes, but--- lenses are *not* safe and should be used with care. (For example,--- 'listElementsL' permits direct manipulation of the list container--- without performing bounds checking on the selected index.) If you--- need a safe API, consider one of the various functions for list--- manipulation. For example, instead of 'listElementsL', consider--- 'listReplace'.+-- Note that some lenses are provided for direct manipulation purposes,+-- but not all lenses are safe to use since misuse can violate+-- invariants. (For example, 'listElementsL' permits direct manipulation+-- of the list container without performing bounds checking on the+-- selected index.) If you need a safe API, consider one of the+-- various functions for list manipulation. For example, instead of+-- 'listElementsL', consider 'listReplace'. module Brick.Widgets.List   ( GenericList   , List@@ -399,7 +397,7 @@                 in makeVisible elemWidget          render $ viewport (l^.listNameL) Vertical $-                 translateBy (Location (0, off)) $+                 padTop (Pad off) $                  vBox $ toList drawnElements  -- | Insert an item into a list at the specified position.

@@ -0,0 +1,1015 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}+-- | This module provides a menu widget that is similar to the ones+-- commonly found in most graphical interface toolkits. Menus carry+-- entries that can be activated with the mouse and keyboard and invoke+-- event handlers that you specify when creating the menus and entries.+--+-- = General Information+--+-- Menus carry a sequence of /items/, expressed by the 'MenuItem' type.+-- Items can be:+--+-- * /entries/ - named menu items that can be activated with the+--   keyboard or mouse+-- * /submenus/ - entries that contain nested menus+-- * /separators/ - horizontal lines dividing up groups of other+--   entries+-- * /gaps/ - vertical space between items+--+-- Menu /entries/ can be either enabled or disabled; their status in+-- this regard is determined by invoking a function of type @s -> Bool@+-- at rendering and event-handling time.+--+-- Menus and submenus support both mouse and keyboard interaction. See+-- 'handleMenuEvent' for details.+--+-- Menus have an orientation that can be changed with+-- 'setMenuOrientation' to suit different writing systems. This affects+-- how entries and submenus are rendered and how left/right arrow keys+-- navigate submenus.+--+-- = Use Cases+--+-- This module provides a fully general 'Menu' type and a few+-- specialized menu types for common menu use cases:+--+-- * 'SimpleMenu': a menu with entries that have 'EventM' handlers.+--   Create one of these with 'simpleMenu'. This is a good starting point.+-- * 'DispatchingMenu': a menu whose entries correspond to abstract key+--   events bound to keys by a 'KeyDispatcher'. Create one of these with+--   'menuWithDispatcher'. This is a good choice when you already have a+--   'KeyDispatcher' set up and would like menu entries to be triggered+--   by the rebindable keys that trigger the dispatcher's handlers.+-- * 'Menu': the fully general type for menus. Create one of these with+--   'menu'.+--+-- Depending on the type of menu you're creating, different item+-- constructors may apply. See the 'MenuItem' type aliases since their+-- naming convention follows that of the menu types.+--+-- See the @MenuDemo@ and @MenuKeybindingsDemo@ demonstration programs+-- for complete working examples of using this API.+--+-- = Adding Menus to An Application+--+-- To use this module in an application:+--+-- * Choose a menu type that you want to work with such as 'SimpleMenu'.+-- * For each menu that you want to host, add an application state field+--   and lens for a value of the menu's type, and add a constructor+--   to the application's resource name type, with an argument of+--   type 'MenuRegion'. Add lenses to the application state type with+--   'Lens.Micro.TH.makeLenses'.+-- * Populate the application's initial state with the menus.+-- * Render menus with 'renderMenu'.+-- * Handle incoming events first with 'handleMenuEvent', and when+--   'handleMenuEvent' returns @False@, pass unhandled events on to the+--   existing application event handler.+-- * As desired, add entries to the application's 'AttrMap' for the+--   attributes used in this module.+--+-- Use 'Brick.Widgets.MenuBar.MenuBar' if you want to host more than one+-- menu in a group.+--+-- = Handling Events+--+-- Menu events are handled with 'handleMenuEvent', and any unhandled+-- events should be deferred to the application's event handler.+--+-- To support mouse events, each menu must be identified by a unique+-- resource name; this is done by providing a resource name constructor+-- when creating each menu. The application's name type must provide a+-- constructor of type @MenuRegion -> n@ to uniquely identify the menu+-- and its constituent parts. For example, if the application's resource+-- name type is as follows,+--+-- @+-- data Name = Editor1 | Editor2+-- @+--+-- It would need to be modified so that a new data constructor (e.g.+-- @FileMenu@) could be given to the menu constuctors:+--+-- @+-- data Name = Editor1 | Editor2 | FileMenu MenuRegion+-- @+module Brick.Widgets.Menu+  ( Menu+  , menuIsOpen+  , menuContentWidth+  , menuTitleName+  , MenuRegion(..)+  , MenuOrientation(..)+  , openMenu+  , closeMenu+  , toggleMenu++  -- * Constructing menus and items+  , menu+  , MenuItem+  , menuEntry+  , menuSeparator+  , menuGap+  , submenu++  -- * Configuring menus+  , setDefaultEntryRenderer+  , setTitleRenderer+  , titleHightlightKey+  , setMenuOrientation++  -- * Configuring menu items+  , setEnabledWith+  , setEntryRenderer++  -- * Menus with EventM handlers+  , SimpleMenu+  , SimpleMenuItem+  , simpleMenu++  -- * Menus with custom keybindings+  , DispatchingMenu+  , DispatchingMenuItem+  , EntryTrigger(..)+  , menuWithDispatcher+  , menuEntryForKey+  , menuEntryForEvent+  , menuEntryForAction+  , entryWithKeybinding++  -- * Handling events+  , handleMenuEvent++  -- * Rendering menus+  , renderMenu++  -- * Attributes+  , menuAttr+  , menuTitleAttr+  , menuTitleSelectedAttr+  , menuTitleKeyHighlightAttr+  , menuBodyAttr+  , menuEntryDisabledAttr+  , menuEntrySelectedAttr+  , menuEntrySelectedDisabledAttr+  , menuEntryKeybindingAttr+  )+where++import Control.Monad (when)++import Lens.Micro.Platform ((^.), (^?), (.~), (%~), (&), Traversal', ix, each)+import Lens.Micro.Mtl++import Data.Char (toLower)+import qualified Data.Foldable as F+import qualified Data.Text as T+import qualified Data.Vector as V+import Data.Maybe (listToMaybe, fromMaybe)++import qualified Graphics.Vty as Vty++import Brick.AttrMap+import Brick.Types+import Brick.Widgets.Border+import Brick.Widgets.Core++import Brick.Keybindings.KeyDispatcher+import Brick.Keybindings.KeyConfig+import Brick.Keybindings.Pretty++-- | The type of menu regions for embedding in the application's+-- resource name and reporting mouse click events.+data MenuRegion =+    MenuTitle+    -- ^ The region of a menu's title+    | MenuBody+    -- ^ The region of a menu's body+    | MenuItemAt Int+    -- ^ The region of the menu item at the specified index+    deriving (Ord, Show, Eq)++-- | Orientation for menu contents.+data MenuOrientation =+    LeftToRight+    -- ^ Menu entries are laid out with labels on the left and submenus+    -- opening to the right+    | RightToLeft+    -- ^ Menu entries are laid out with labels on the right and submenus+    -- opening to the left+    deriving (Ord, Show, Eq)++-- | The general menu type.+--+-- Menus and their items are parameterized on three types:+--+-- * @s@: the application state type used in the @App@ type,+-- * @n@: the application resource name type used in the application's+--   @Widget@ type, and+-- * @k@: the type of data carried and handled by the menu's event+--   handler when a menu entry has been activated.+--+-- Menus contain a sequence of items of type 'MenuItem'. See the+-- documentation above and the constructors for both menus and menu+-- items to create menus.+--+-- A menu is either /open/, in which case its contents are being shown+-- in a floating layer above the application's UI and it is responding+-- to events that manipulate the menu's selected entry, or it is+-- /closed/, in which case its contents are not shown and it is not+-- responding to events other than mouse clicks on its title. The menu's+-- open/closed state is affected by calls to 'openMenu', 'closeMenu',+-- and mouse click events on the menu's title.+--+-- At any given time, a menu may or may not have a currently-selected+-- entry. See 'handleMenuEvent' for details on how keyboard and mouse+-- events influence the choice and behavior of the selected entry. When+-- an entry is selected, it can be /activated/ by an @Enter@ keypress or+-- a mouse click. When activated, its event data is used to invoke the+-- menu's event handler.+--+-- To support mouse events, each menu must be identified by a unique+-- resource name; this is done by providing a resource name constructor+-- when creating each menu. The application's name type must provide a+-- constructor of type @MenuRegion -> n@ to uniquely identify the menu+-- and its constituent parts.+--+-- A menu carries an event handler that will be invoked by+-- 'handleMenuEvent' whenever a menu entry is selected.+data Menu s n k =+    Menu { menuTitle :: !T.Text+         -- ^ The menu's title+         , menuTitleRenderer :: s -> T.Text -> Widget n+         -- ^ The renderer for the menu's title+         , menuItems :: !(V.Vector (MenuItem s n k))+         -- ^ The contents of the menu+         , menuIsOpen :: !Bool+         -- ^ Whether the menu is open.+         , menuContentWidth :: !Int+         -- ^ The width of the menu's items within the enclosing border.+         -- This is a record accessor so it can also be used to change+         -- the menu's width.+         , menuTitleName :: !n+         -- ^ The resource name for this menu's title for generating and+         -- detecting mouse click events+         , menuRegionNameBuilder :: MenuRegion -> n+         -- ^ A function to build resource names for clickable regions+         , menuSelectedIndex :: !(Maybe Int)+         -- ^ State for tracking the selected item index, if any+         , menuEventHandler :: k -> EventM n s ()+         -- ^ Handler to be invoked when an entry in this menu is+         -- activated+         , menuFallbackEventHandler :: Vty.Key -> [Vty.Modifier] -> EventM n s Bool+         -- ^ Handler for key events that weren't handled by+         -- 'handleMenuEvent'+         , menuEntryDefaultRenderer :: MenuOrientation -> k -> T.Text -> Widget n+         -- ^ The function to render entries in this menu+         , menuOrientation :: !MenuOrientation+         -- ^ The layout orientation of the menu's contents+         }++-- | The type of menu items.+data MenuItem s n k =+    MISeparator+    -- ^ A horizontal border between menu items+    | MIGap+    -- ^ An empty line between menu items+    | MIEntry !(MenuEntry s n k)+    -- ^ A labeled menu entry that can be activated with the mouse or by+    -- a keypress+    | MISubmenu !(Menu s n k)+    -- ^ A submenu++-- | A labeled menu entry that can be activated with the mouse or by a+-- keypress.+data MenuEntry s n k =+    MenuEntry { menuEntryLabel :: !T.Text+              -- ^ The menu entry's label+              , menuEntryEnabled :: s -> Bool+              -- ^ The function to determine whether this menu entry is+              -- enabled+              , menuEntryEvent :: !k+              -- ^ The event to generate when this entry is activated+              , menuEntryRenderer :: Maybe (MenuOrientation -> k -> T.Text -> Widget n)+              -- ^ This menu entry's renderer+              }++suffixLenses ''Menu++-- | Set the menu's content orientation, including the orientation of+-- all of its submenus.+setMenuOrientation :: MenuOrientation -> Menu s n k -> Menu s n k+setMenuOrientation o m =+    m & menuOrientationL .~ o+      & menuItemsL.each._Submenu %~ setMenuOrientation o++-- | Set this menu entry's function used to check for its enabled state.+-- This is equivalent to 'id' for non-entry items.+setEnabledWith :: (s -> Bool) -> MenuItem s n k -> MenuItem s n k+setEnabledWith f = mapMenuEntry (\e -> e { menuEntryEnabled = f })++-- | Set this menu entry's rendering function, overriding the menu's+-- default rendering behavior for this entry. This is equivalent to 'id'+-- for non-entry items.+setEntryRenderer :: (MenuOrientation -> k -> T.Text -> Widget n) -> MenuItem s n k -> MenuItem s n k+setEntryRenderer f = mapMenuEntry (\e -> e { menuEntryRenderer = Just f })++-- | Set this menu's entry rendering function.+setDefaultEntryRenderer :: (MenuOrientation -> k -> T.Text -> Widget n) -> Menu s n k -> Menu s n k+setDefaultEntryRenderer f m = m { menuEntryDefaultRenderer = f }++-- | Set this menu's title renderer.+setTitleRenderer :: (s -> T.Text -> Widget n) -> Menu s n k -> Menu s n k+setTitleRenderer f m = m { menuTitleRenderer = f }++mapMenuEntry :: (MenuEntry s n k -> MenuEntry s n k) -> MenuItem s n k -> MenuItem s n k+mapMenuEntry f (MIEntry e) = MIEntry $ f e+mapMenuEntry _ e = e++-- | A separator between menu items.+menuSeparator :: MenuItem s n k+menuSeparator = MISeparator++-- | A gap between menu items.+menuGap :: MenuItem s n k+menuGap = MIGap++-- | A submenu. The menu's title will be used as the submenu's label in+-- its parent menu.+submenu :: Menu s n k -> MenuItem s n k+submenu = MISubmenu++-- | Create a menu entry with the specified label and event data.+-- When the entry is activated, its event data will be passed to the+-- event handler of the enclosing menu.+--+-- By default, this entry has no custom renderer so its appearance is+-- determined by the default entry renderer of the enclosing menu.+-- To change either of these behaviors, use 'setEntryRenderer' or+-- 'setDefaultEntryRenderer'.+--+-- By default, this entry is always enabled regardless of the+-- application state. To change this, use 'setEnabledWith'.+--+-- This is the fully general entry constructor. For more specific use+-- cases, see the other 'MenuItem' constructors in this module.+menuEntry :: T.Text+          -- ^ The menu entry's label+          -> k+          -- ^ The event data carried by the menu entry that will be+          -- passed to the enclosing menu's event handler when this+          -- entry is activated+          -> MenuItem s n k+menuEntry label ev =+    MIEntry $ MenuEntry { menuEntryLabel = label+                        , menuEntryEnabled = const True+                        , menuEntryEvent = ev+                        , menuEntryRenderer = Nothing+                        }++-- | A specialization of 'Menu' that has 'EventM' handlers in each menu+-- entry that are evaluated whenever the entries are activated. Create+-- one of these with 'simpleMenu'.+type SimpleMenu s n = Menu s n (EventM n s ())++-- | A specialization of 'MenuItem' for 'SimpleMenu'. Create these with+-- 'menuGap', 'menuSeparator', 'submenu', and 'menuEntry'.+type SimpleMenuItem s n = MenuItem s n (EventM n s ())++-- | Create a 'SimpleMenu' whose entries carry ordinary 'EventM'+-- handlers that are evaluated whenever the menu's entries are+-- activated.+simpleMenu :: T.Text+           -- ^ The menu's title+           -> (MenuRegion -> n)+           -- ^ The menu's resource name constructor+           -> [SimpleMenuItem s n]+           -- ^ The items in this menu+           -> SimpleMenu s n+simpleMenu title regionNameBuilder items =+    menu title regionNameBuilder items id++defaultMenuPadding :: Int+defaultMenuPadding = 7++-- | Create a 'Menu'.+--+-- By default, menus use the 'LeftToRight' content orientation. This can+-- be changed with 'setMenuOrientation'.+--+-- By default, entries are rendered using 'txt'. Change this with+-- 'setDefaultEntryRenderer' or 'setEntryRenderer'.+--+-- By default, the menu title is rendered using 'txt'. Change this with+-- 'setTitleRenderer'.+menu :: T.Text+     -- ^ The menu's title+     -> (MenuRegion -> n)+     -- ^ The menu's resource name constructor+     -> [MenuItem s n k]+     -- ^ The items in this menu+     -> (k -> EventM n s ())+     -- ^ The event handler to invoke when entries are activated+     -> Menu s n k+menu title regionNameBuilder items handler =+    let defaultWidth = (maximum $ menuItemWidth <$> items) + defaultMenuPadding+    in Menu { menuTitle = title+            , menuTitleRenderer = const txt+            , menuItems = V.fromList items+            , menuIsOpen = False+            , menuContentWidth = defaultWidth+            , menuTitleName = regionNameBuilder MenuTitle+            , menuRegionNameBuilder = regionNameBuilder+            , menuSelectedIndex = Nothing+            , menuEventHandler = handler+            , menuFallbackEventHandler = const $ const $ return False+            , menuEntryDefaultRenderer = \_ _ label -> txt label+            , menuOrientation = LeftToRight+            }++-- | A trigger to be executed when an entry with this trigger+-- is activated. This is exposed for completeness only; use+-- 'menuEntryForKey', 'menuEntryForAction', and 'menuEntryForEvent' to+-- work with this data type indirectly.+data EntryTrigger s n k =+    TriggerEvent !(EventTrigger k)+    -- ^ The entry produces an 'EventTrigger' to be handled by a+    -- 'KeyDispatcher'+    | TriggerAction !(EventM n s ())+    -- ^ The entry runs a specific 'EventM' action++-- | A specialization of 'Menu' whose entries are associated with+-- specific keys or abstract key events handled by a 'KeyDispatcher'.+-- Create one of these with 'menuWithDispatcher'.+type DispatchingMenu s n k = Menu s n (EntryTrigger s n k)++-- | A specialization of 'MenuItem' for 'DispatchingMenu'. Create these+-- with 'menuGap', 'menuSeparator', 'submenu', 'menuEntryForKey',+-- 'menuEntryForAction', and 'menuEntryForEvent'.+type DispatchingMenuItem s n k = MenuItem s n (EntryTrigger s n k)++-- | Create a 'Menu' whose entries are activated by specific triggers,+-- including specified key bindings or abstract key events associated+-- with a 'KeyDispatcher'. This uses 'entryWithKeybinding' as its+-- default entry renderer to show available keybindings for entries+-- associated with key events.+--+-- To create entries in this menu, use 'menuEntryForKey',+-- 'menuEntryForEvent', and 'menuEntryForAction'.+menuWithDispatcher :: (Eq k)+                   => KeyDispatcher k (EventM n s)+                   -- ^ The key dispatcher to use to build the menu, and+                   -- whose handlers should be invoked by the menu's+                   -- entries when activated+                   -> T.Text+                   -- ^ The menu's title+                   -> (MenuRegion -> n)+                   -- ^ The menu's resource name constructor+                   -> [DispatchingMenuItem s n k]+                   -- ^ The items in this menu+                   -> DispatchingMenu s n k+menuWithDispatcher kd title regionNameBuilder items =+    setWidth $+    addFallbackHandler $+    setDefaultEntryRenderer (entryWithKeybinding kd) $+    menu title regionNameBuilder items handler+    where+        setWidth m =+            m { menuContentWidth = menuContentWidth m + 4 }++        addFallbackHandler m =+            m { menuFallbackEventHandler = handleKey kd }++        handler trigger =+            case trigger of+                  TriggerEvent (ByKey b)    -> invokeHandler $ lookupVtyEvent (kbKey b) (F.toList $ kbMods b) kd+                  TriggerEvent (ByEvent ev) -> invokeHandler $ lookupEvent ev kd+                  TriggerAction act         -> act+            where+                invokeHandler Nothing = return ()+                invokeHandler (Just kh) = handlerAction $ kehHandler $ khHandler kh++-- | An entry rendering function usable with 'setDefaultEntryRenderer'+-- and 'setEntryRenderer' that renders a menu entry with the first known+-- available keybinding for its abstract event, as configured in the+-- specified 'KeyDispatcher'.+entryWithKeybinding :: (Eq k)+                    => KeyDispatcher k (EventM n s)+                    -- ^ The key dispatcher to check for bindings+                    -> MenuOrientation+                    -- ^ The menu's orientation+                    -> EntryTrigger s n k+                    -- ^ The entry's trigger+                    -> T.Text+                    -- ^ The entry's label+                    -> Widget n+entryWithKeybinding kd o e label =+    let maybeShowKeybinding w = fromMaybe w $ do+            keybinding <- case e of+                TriggerEvent (ByKey b) -> return b+                TriggerEvent (ByEvent ev) -> listToMaybe $ bindingsForEvent kd ev+                TriggerAction {} -> Nothing++            let renderedBinding = withDefAttr menuEntryKeybindingAttr $+                                  txt $ ppBinding keybinding+            return $ case o of+                LeftToRight ->+                    w <+> renderedBinding+                RightToLeft ->+                    renderedBinding <+> w++    in maybeShowKeybinding $ case o of+        LeftToRight -> padRight Max $ txt label+        RightToLeft -> padLeft Max $ txt label++-- | Create a menu entry that is activated by the specified key binding,+-- irrespective of the enclosing menu's 'KeyDispatcher' configuration.+-- This entry will show the specified keybinding in its text.+menuEntryForKey :: T.Text+                -- ^ The menu entry's label+                -> Binding+                -- ^ The specific key binding to trigger this menu entry+                -> DispatchingMenuItem s n k+menuEntryForKey label b = menuEntry label $ TriggerEvent $ ByKey b++-- | Create a menu entry that generates the specified abstract key event+-- when activated, thus triggering the enclosing menu's 'KeyDispatcher'+-- handler for that event. This entry will show the first known+-- keybinding for the specified abstract key event, if any.+menuEntryForEvent :: T.Text+                  -- ^ The menu entry's label+                  -> k+                  -- ^ The abstract key event to generate when this+                  -- entry is activated+                  -> DispatchingMenuItem s n k+menuEntryForEvent label ev = menuEntry label $ TriggerEvent $ ByEvent ev++-- | Create a menu entry that invokes the specified 'EventM' action when+-- activated. Use this for entries that are not invoked by specific keys+-- or associated with abstract key events.+menuEntryForAction :: T.Text+                   -- ^ The menu entry's label+                   -> EventM n s ()+                   -- ^ The action to evaluate when this entry is+                   -- activated+                   -> DispatchingMenuItem s n k+menuEntryForAction label act = menuEntry label $ TriggerAction act++-- | Close a menu and unselect any selected entry. Also closes any open+-- submenus in the menu, recursively.+closeMenu :: Menu s n k -> Menu s n k+closeMenu m =+    closeSubmenus $+        m & menuIsOpenL .~ False+          & menuSelectedIndexL .~ Nothing++closeSubmenus :: Menu s n k -> Menu s n k+closeSubmenus m =+    m & menuItemsL.each._Submenu %~ closeMenu++-- | Open a menu.+openMenu :: Menu s n k -> Menu s n k+openMenu m = m & menuIsOpenL .~ True++-- | Toggle the menu's open state.+toggleMenu :: Menu s n k -> Menu s n k+toggleMenu m =+    if m^.menuIsOpenL+    then closeMenu m+    else openMenu m++-- | Get the screen width of this menu item if it is an entry; zero+-- otherwise.+menuItemWidth :: MenuItem s n k -> Int+menuItemWidth MISeparator = 0+menuItemWidth MIGap = 0+menuItemWidth (MIEntry e) = menuEntryWidth e+menuItemWidth (MISubmenu sm) = textWidth $ menuTitle sm++-- | Get this entry's width, i.e., the width of its label.+menuEntryWidth :: MenuEntry s n k -> Int+menuEntryWidth = textWidth . menuEntryLabel++-- | Render a menu.+--+-- If the menu is closed, only its title is rendered. If the menu is+-- open, its title is rendered with its contents shown as a floating+-- layer vertically positioned below the title.+--+-- When menu contents are shown, they are rendered in a 'border', and+-- separators are rendered with 'hBorder'. Use 'withBorderStyle' to+-- change how such borders are drawn, e.g.,+--+-- @+-- drawUi :: s -> Widget n+-- drawUi s =+--     withBorderStyle unicodeRounded $+--     renderMenu s (s^.myMenu)+-- @+renderMenu :: (Ord n) => s -> Menu s n k -> Widget n+renderMenu s m =+    if menuIsOpen m+    then contentsLayer `above` title+    else title+    where+        contentsLayer = clampLayerToScreen $+                        translateLayer layerOffset $ renderMenuContents s m+        layerOffset =+            case m^.menuOrientationL of+                LeftToRight -> Location (-1, 1)+                RightToLeft -> Location (-1 * (menuContentWidth m - textWidth (menuTitle m) + 1), 1)+        setTitleAttr = if menuIsOpen m+                       then forceAttr menuTitleSelectedAttr+                       else withDefAttr menuTitleAttr+        maybePutCursor =+            if menuIsOpen m+            then putCursor (menuTitleName m) (Location (0, 0))+            else id+        title = clickable (menuTitleName m) $+                maybePutCursor $+                setTitleAttr $+                menuTitleRenderer m s $+                menuTitle m++renderMenuContents :: (Ord n) => s -> Menu s n k -> Widget n+renderMenuContents s m = body+    where+        body = withDefAttr menuAttr $+               joinBorders $+               border $+               hLimit (menuContentWidth m) $+               clickable (menuRegionNameBuilder m MenuBody) $+               vBox $+               renderMenuItem <$> (zip [0..] $ V.toList $ menuItems m)++        renderMenuItem (_, MISeparator)  = hBorder+        renderMenuItem (_, MIGap)        = vLimit 1 $ fill ' '+        renderMenuItem (i, MIEntry e)    = renderMenuEntry i e+        renderMenuItem (i, MISubmenu sm) = renderSubmenu i sm++        maybePutCursor i =+            if menuSelectedIndex m == Just i+            then putCursor (menuRegionNameBuilder m $ MenuItemAt i) (Location (0, 0))+            else id++        renderSubmenu i sm =+            let submenuTitle = vLimit 1 $+                               maybePutCursor i $+                               padRight (Pad 1) $+                               padLeft (Pad 1) $+                               addSubmenuPointer $+                               padEntry $+                               txt $ menuTitle sm+                addSubmenuPointer w =+                    case m^.menuOrientationL of+                        LeftToRight -> w <+> txt ">"+                        RightToLeft -> txt "<" <+> w+                layerOffset =+                    case menuOrientation sm of+                        LeftToRight -> Location (menuContentWidth m + 1, -1)+                        RightToLeft -> Location (-1 * (menuContentWidth sm + 3), -1)+                submenuLayer = clampLayerToScreen $+                               translateLayer layerOffset $ renderMenuContents s sm+                maybeAddLayer = if sm^.menuIsOpenL+                                then (submenuLayer `above`)+                                else id+                maybeSetAttr = if Just i == menuSelectedIndex m+                               then forceAttr menuEntrySelectedAttr+                               else id+            in maybeAddLayer $+               maybeSetAttr submenuTitle++        padEntry = case m^.menuOrientationL of+            LeftToRight -> padRight Max+            RightToLeft -> padLeft Max++        renderMenuEntry i e =+            let renderEntry = fromMaybe (menuEntryDefaultRenderer m) (menuEntryRenderer e)+            in setEntryAttr i e $+               vLimit 1 $+               maybePutCursor i $+               padRight (Pad 1) $+               padLeft (Pad 1) $+               padEntry $+               renderEntry (menuOrientation m) (menuEntryEvent e) (menuEntryLabel e)++        setEntryAttr i e =+            if Just i == menuSelectedIndex m+            then if menuEntryEnabled e s+                 then forceAttr menuEntrySelectedAttr+                 else forceAttr menuEntrySelectedDisabledAttr+            else if menuEntryEnabled e s+                 then id+                 else forceAttr menuEntryDisabledAttr++-- | The base attribute of menus.+menuAttr :: AttrName+menuAttr = attrName "brick" <> attrName "menu"++-- | Menu titles.+menuTitleAttr :: AttrName+menuTitleAttr = menuAttr <> attrName "title"++-- | A highlighted key in a menu title as rendered with+-- 'titleHightlightKey', based on 'menuTitleAttr'.+menuTitleKeyHighlightAttr :: AttrName+menuTitleKeyHighlightAttr = menuTitleAttr <> attrName "highlightedKey"++-- | Selected menu titles, for open menus.+menuTitleSelectedAttr :: AttrName+menuTitleSelectedAttr = menuTitleAttr <> attrName "selected"++-- | The base attribute for menu bodies.+menuBodyAttr :: AttrName+menuBodyAttr = menuAttr <> attrName "body"++-- | Menu entry keybindings for entries in menus created with+-- 'menuWithDispatcher'.+menuEntryKeybindingAttr :: AttrName+menuEntryKeybindingAttr = menuBodyAttr <> attrName "keybinding"++-- | Disabled menu entries.+menuEntryDisabledAttr :: AttrName+menuEntryDisabledAttr = menuBodyAttr <> attrName "disabled"++-- | Selected and enabled menu entries.+menuEntrySelectedAttr :: AttrName+menuEntrySelectedAttr = menuBodyAttr <> attrName "selected"++-- | Selected and disnabled menu entries.+menuEntrySelectedDisabledAttr :: AttrName+menuEntrySelectedDisabledAttr = menuEntrySelectedAttr <> attrName "disabled"++-- | A title rendering function that highlights the specified character+-- with 'menuTitleKeyHighlightAttr' if it appears in the title,+-- case-insensitively. Use with 'setTitleRenderer'.+titleHightlightKey :: Char -> s -> T.Text -> Widget n+titleHightlightKey c _ title = hBox parts+    where+        parts = go "" title++        go acc (h T.:< tl)+            | toLower h == toLower c =+                (if T.null acc then [] else [txt acc]) <>+                [withDefAttr menuTitleKeyHighlightAttr $ char h] <>+                go "" tl+            | otherwise =+                go (T.snoc acc h) tl+        go acc T.Empty =+            if T.null acc then [] else [txt acc]++-- | Select the next entry in a menu, or the first one if no entry is+-- currently selected.+selectNextEntry :: Menu s n k -> Menu s n k+selectNextEntry m =+    case matching V.!? 0 of+        Nothing -> m+        Just (newIdx, _) -> m & menuSelectedIndexL .~ Just newIdx+    where+        dropAmt = case m^.menuSelectedIndexL of+                 Nothing -> 0+                 Just i -> i + 1+        is = m^.menuItemsL+        matching = V.filter (itemIsSelectable . snd) items+        pairs = V.zip (V.enumFromN 0 (V.length is)) is+        items = V.drop dropAmt $ pairs <> pairs++itemIsSelectable :: MenuItem s n k -> Bool+itemIsSelectable (MIEntry {}) = True+itemIsSelectable (MISubmenu {}) = True+itemIsSelectable _ = False++-- | Select the prevouis entry in a menu, or the last one if no entry is+-- currently selected.+selectPrevEntry :: Menu s n k -> Menu s n k+selectPrevEntry m =+    case matching V.!? 0 of+        Nothing -> m+        Just (newIdx, _) -> m & menuSelectedIndexL .~ Just newIdx+    where+        takeAmt = fromMaybe 0 $ m^.menuSelectedIndexL+        is = m^.menuItemsL+        matching = V.filter (itemIsSelectable . snd) items+        pairs = V.zip (V.enumFromN 0 (V.length is)) is+        items = V.reverse $ pairs <> V.take takeAmt pairs++withMenu :: Traversal' s (Menu s n k) -> (Menu s n k -> EventM n s Bool) -> EventM n s Bool+withMenu which f = do+    mMenu <- preuse which+    case mMenu of+        Nothing -> return False+        Just m -> f m++resolveMenuEventTarget :: Traversal' s (Menu s n k)+                       -> EventM n s [Int]+resolveMenuEventTarget which = do+    mMenu <- preuse which+    case mMenu of+        Nothing -> return []+        Just m -> return $ resolveMenuEventTarget' m++resolveMenuEventTarget' :: Menu s n k -> [Int]+resolveMenuEventTarget' m = fromMaybe [] $ do+    idx <- m^.menuSelectedIndexL+    let is = m^.menuItemsL+    sel <- is V.!? idx++    case sel of+        MISubmenu sm -> do+            -- If the submenu is open, recurse; if it is not, don't add+            -- its index because we aren't targeting the submenu at that+            -- index.+            if not $ sm^.menuIsOpenL+               then return []+               else do+                   let rest = maybe [] resolveMenuEventTarget' $+                              m^?menuItemsL.ix idx._Submenu++                   return $ idx : rest+        _ -> return []++targetMenu :: Traversal' s (Menu s n k)+           -> [Int]+           -> Traversal' s (Menu s n k)+targetMenu which path = which . go path+    where+        go [] = id+        go (idx:rest) = menuItemsL.ix idx._Submenu . go rest++-- | Handle an event for this menu and return @True@, or return @False@+-- if the event was not handled (e.g. because the event was not a menu+-- title mouse click or because the menu was not open to receive the+-- event).+--+-- Events handled include:+--+-- * Mouse clicks on the menu title will toggle whether the menu is+--   open.+-- * If a submenu entry is selected, arrow keys will open and close it+--   depending on the menu orientation.+-- * Mouse clicks on submenu entries will open their submenus.+-- * @Esc@ will close the menu if no submenus are open; otherwise it+--   will close the last open submenu.+-- * If no entry is selected, the Down arrow key will select the first+--   entry and the Up arrow key will select the last entry.+-- * If an entry is selected, the Down arrow key will select the next+--   entry and the Up arrow key will select the previous entry.+-- * If the selected entry is a submenu and the submenu is open, events+--   will be delegated to the submenu until it closes.+--+-- In all other cases, this will attempt to defer to the menu's selected+-- entry or submenu to handle the event. This returns @True@ if the+-- event was one of the above and was handled, @True@ if the event was+-- not one of the above but was handled by the menu's selected entry, or+-- @False@ otherwise.+--+-- A return value of @True@ indicates that the event should not be+-- handled by the application because it was destined for the menu; a+-- return value of @False@ indicates that the event should be handled by+-- the application because it did not affect the menu or its entries in+-- their current state for any reason. Consequently, a common pattern+-- when using this function will look something like this:+--+-- @+-- myApplicationEventHandler :: BrickEvent n e -> EventM n s ()+-- myApplicationEventHandler e = do+--     handled <- handleMenuEvent myMenuLens e+--     when (not handled) $ do+--         -- Go on to handle the event in the rest of the application+-- @+handleMenuEvent :: (Eq n)+                => Traversal' s (Menu s n k)+                -- ^ The traversal into the application state where the+                -- menu state can be found+                -> BrickEvent n e+                -- ^ The event to handle+                -> EventM n s Bool+handleMenuEvent which e = do+    -- First, determine where we're routing the event based on whether+    -- the current selection targets an open submenu.+    path <- resolveMenuEventTarget which++    handled <- handleMenuEventCommon which path e+    if handled+       then return True+       else handleMenuEventFallback which path e++handleMenuEventFallback :: (Eq n) => Traversal' s (Menu s n k) -> [Int] -> BrickEvent n e -> EventM n s Bool+handleMenuEventFallback which path (VtyEvent (Vty.EvKey k mods)) =+    withMenu (targetMenu which path) $ \m -> do+        handled <- menuFallbackEventHandler m k mods+        return handled+handleMenuEventFallback _ _ _ =+    return False++handleMenuEventCommon :: (Eq n) => Traversal' s (Menu s n k) -> [Int] -> BrickEvent n e -> EventM n s Bool+handleMenuEventCommon which path (VtyEvent (Vty.EvKey Vty.KEnter [])) = do+    withMenu (targetMenu which path) $ \m -> do+        let sel = m^.menuSelectedIndexL+        case sel of+            Nothing -> return True+            Just idx -> activateMenuItem which path idx+handleMenuEventCommon which path (VtyEvent (Vty.EvKey Vty.KRight [])) = do+    withMenu which $ \m ->+        case menuOrientation m of+            LeftToRight ->+                maybeOpenSubmenu which path+            RightToLeft ->+                maybeCloseSubmenu which path+handleMenuEventCommon which path (VtyEvent (Vty.EvKey Vty.KLeft [])) = do+    withMenu which $ \m ->+        case menuOrientation m of+            LeftToRight ->+                maybeCloseSubmenu which path+            RightToLeft ->+                maybeOpenSubmenu which path+handleMenuEventCommon which path (VtyEvent (Vty.EvKey Vty.KDown [])) = do+    targetMenu which path %= selectNextEntry+    return True+handleMenuEventCommon which path (VtyEvent (Vty.EvKey Vty.KUp [])) = do+    targetMenu which path %= selectPrevEntry+    return True+handleMenuEventCommon which path (MouseDown n _ _ (Location (_, row))) = do+    withMenu (targetMenu which path) $ \m -> do+        let mkRegionName = m^.menuRegionNameBuilderL++        if | mkRegionName MenuTitle == n -> do+               (targetMenu which path).menuIsOpenL %= not+               return True+           | mkRegionName MenuBody == n ->+               -- Map the location to the clicked menu entry; since each+               -- item is expected to be exactly one row high, the row+               -- index here is equivalent to the item index.+               activateMenuItem which path row+           | otherwise -> return False+handleMenuEventCommon which path (VtyEvent (Vty.EvMouseDown {})) = do+    targetMenu which path %= closeMenu+    return True+handleMenuEventCommon which path (VtyEvent (Vty.EvKey Vty.KEsc [])) = do+    withMenu (targetMenu which path) $ \m -> do+        if menuIsOpen m+        then do+            targetMenu which path %= closeMenu+            return True+        else return False+handleMenuEventCommon _ _ _ =+    return False++maybeCloseSubmenu :: Traversal' s (Menu s n k) -> [Int] -> EventM n s Bool+maybeCloseSubmenu which path = do+    -- Close the current menu if it is a submenu.+    case path of+        [] -> return False+        _ -> do+            targetMenu which path %= closeMenu+            return True++maybeOpenSubmenu :: Traversal' s (Menu s n k) -> [Int] -> EventM n s Bool+maybeOpenSubmenu which path = do+    withMenu (targetMenu which path) $ \m -> do+        let sel = m^.menuSelectedIndexL+        case sel of+            Nothing -> return False+            Just idx -> do+                -- If the selected item is a submenu that is not open,+                -- open it and select its first item.+                let is = m^.menuItemsL+                case is V.!? idx of+                    Just (MISubmenu sm) | not (sm^.menuIsOpenL) -> do+                        (targetMenu which path).menuItemsL.ix idx._Submenu %= (selectNextEntry . openMenu)+                        return True+                    _ -> return False++_Submenu :: Traversal' (MenuItem s n k) (Menu s n k)+_Submenu f (MISubmenu sm) = MISubmenu <$> f sm+_Submenu _ i = pure i++-- | Activate the menu's selected entry. If the selected entry is a+-- normal entry and is enabled, trigger its handler and close the menu+-- and its ancestors. If the selected entry is a submenu, open the+-- submenu.+activateMenuItem :: Traversal' s (Menu s n k) -> [Int] -> Int -> EventM n s Bool+activateMenuItem which path idx =+    withMenu (targetMenu which path) $ \m -> do+        s <- use id+        let handler = m^.menuEventHandlerL+            is = m^.menuItemsL+        case is V.!? idx of+            Just (MIEntry entry) -> do+                when (menuEntryEnabled entry s) $ do+                    which %= closeMenu+                    handler $ menuEntryEvent entry+                return True+            Just (MISubmenu {}) -> do+                -- If the submenu entry isn't the selected one, select+                -- it.+                when (Just idx /= (m^.menuSelectedIndexL)) $+                    (targetMenu which path).menuSelectedIndexL .= Just idx++                (targetMenu which path).menuItemsL.ix idx._Submenu %= openMenu+                return True+            _ -> return False

@@ -0,0 +1,280 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}+-- | This module provides a menu bar for grouping menus together.+--+-- Menu bars carry menus of a particular type using the menu types+-- provided in the @Brick.Widgets.Menu@ module. The type aliases+-- provided here correspond to the aliases for menu use cases:+--+-- * 'SimpleMenuBar': a menu bar made up of 'SimpleMenu's created with+--   'simpleMenu'+-- * 'DispatchingMenuBar': a menu bar made up of 'DispatchingMenu's+--    created with 'menuWithDispatcher'+-- * 'MenuBar': the fully general type for menu bars with menus created+--   with 'menu'+--+-- In all cases, use 'newMenuBar' to construct a menu bar, and create+-- its menus using the corresponding menu constructor for the type of+-- menu bar you want to use.+--+-- Render the menu bar with 'renderMenuBar' and handle menu bar events+-- with 'handleMenuBarEvent', deferring to the application's event+-- handling for events that the menu bar doesn't handle.+--+-- Similar to individual menus, menu bars have an orientation that can+-- be changed with 'setMenuBarOrientation'.+--+-- This API requires the use of lenses for application state fields that+-- store menu bar state.+--+-- See the @MenuBarDemo@ demonstration program for a complete working+-- example of using this API.+--+-- = Adding a Menu Bar to An Application+--+-- To use this module in an application:+--+-- * Choose a menu bar type that you want to work with such as+--   'SimpleMenuBar'.+-- * Add an application state field and lens for a value of the menu+--   bar's type, and add a constructor to the application's resource+--   name type, with an argument of type 'MenuRegion', for each menu+--   in the menu bar. Add lenses to the application state type with+--   'Lens.Micro.TH.makeLenses'.+-- * Populate the application's initial state with the menu bar.+-- * Render the menu bar with 'renderMenuBar'.+-- * Handle incoming events first with 'handleMenuBarEvent', and when+--   'handleMenuBarEvent' returns @False@, pass unhandled events on to+--   the existing application event handler.+module Brick.Widgets.MenuBar+  (+  -- * Types+    MenuBar+  , SimpleMenuBar+  , DispatchingMenuBar++  -- * Creating menu bars+  , newMenuBar++  -- * Handling events+  , handleMenuBarEvent++  -- * Rendering+  , renderMenuBar++  -- * Working with menu bars+  , hasOpenMenu+  , closeAllMenus+  , openMenuAtIndex+  , toggleMenuAtIndex+  , setMenuBarOrientation+  )+where++import Control.Monad (when)+import Data.Maybe (isJust, listToMaybe, fromMaybe)+import Lens.Micro.Platform ((^.), (&), (%~), (.~), Lens', ix, each)+import Lens.Micro.Mtl++import qualified Data.Foldable as F+import qualified Data.Vector as V++import qualified Graphics.Vty as Vty++import Brick.Types+import Brick.Widgets.Core+import Brick.Widgets.Menu++-- | A menu bar holding a sequence of menus.+--+-- A menu bar can have up to one open menu at a time.+data MenuBar s n k =+    MenuBar { menuBarOrientation :: !MenuOrientation+            , menuBarMenus :: !(V.Vector (Menu s n k))+            }++suffixLenses ''MenuBar++-- | A specialization of 'MenuBar' for menus with 'EventM' handlers; use+-- this with 'simpleMenu'.+type SimpleMenuBar s n = MenuBar s n (EventM n s ())++-- | A specialization of 'MenuBar' for menus with abstract key event+-- triggers; this with 'menuWithDispatcher'.+type DispatchingMenuBar s n k = MenuBar s n (EventM n s (EntryTrigger s n k))++-- | Create a new menu bar from the specified menu list. If the list is+-- empty, this calls 'error'.+newMenuBar :: [Menu s n k] -> MenuBar s n k+newMenuBar [] = error "BUG: newMenuBar requires a non-empty list"+newMenuBar ms = MenuBar LeftToRight $ V.fromList ms++-- | Return whether this menu bar has an open menu.+hasOpenMenu :: MenuBar s n k -> Bool+hasOpenMenu = isJust . getOpenMenu++-- | Get this menu bar's current open menu and its index, if any.+getOpenMenu :: MenuBar s n k -> Maybe (Int, Menu s n k)+getOpenMenu mb = do+    let ms = menuBarMenus mb+    idx <- V.findIndex menuIsOpen ms+    return (idx, ms V.! idx)++-- | Render this menu bar with the given application state as input.+renderMenuBar :: (Ord n) => s -> MenuBar s n k -> Widget n+renderMenuBar s mb =+    withDefAttr menuTitleAttr $ padForOrientation body+    where+        padForOrientation = case mb^.menuBarOrientationL of+            LeftToRight -> padRight Max+            RightToLeft -> padLeft Max . padRight (Pad 1)++        body = hBox $+               padLeft (Pad 1) <$>+               F.toList (renderMenu s <$> menuBarMenus mb)++-- | Given a resource name, find the menu whose title bar portion+-- matches the resource name, if any.+getMenuTitleMatch :: (Eq n) => MenuBar s n k -> n -> Maybe (Int, Menu s n k)+getMenuTitleMatch mb n =+    listToMaybe $ filter matchesTitle $ zip [0..] (F.toList $ mb^.menuBarMenusL)+    where+        matchesTitle (_, m) = n == menuTitleName m++-- | Handle an event for this menu bar and return @True@, or return+-- @False@ if the event was not handled (e.g. because the event was not+-- a menu title mouse click or because no menu was open to receive the+-- event).+--+-- Events handled include:+--+-- * Mouse clicks on menu titles will open the clicked menu, closing+--   other open menus.+-- * Left and Right arrow keys will cycle between menus if there is an+--   open menu.+-- * If a submenu entry is selected, the arrow keys will open it or+--   close it if it is open, depending on the configured menu bar+--   orientation.+-- * @Esc@ will close the currently-open menu.+--+-- In all other cases, this will attempt to defer to the opened menu to+-- handle the event. This returns @True@ if the event was one of the+-- above and was handled, @True@ if the event was not one of the above+-- but was handled by the open menu, or @False@ otherwise.+--+-- A return value of @True@ indicates that the event should not be+-- handled by the application because it was destined for the menu bar+-- or one of its menus; a return value of @False@ indicates that the+-- event should be handled by the application because it did not affect+-- the menu bar or its menus in their current state for any reason.+-- Consequently, a common pattern when using this function will look+-- something like this:+--+-- @+-- myApplicationEventHandler :: BrickEvent n e -> EventM n s ()+-- myApplicationEventHandler e = do+--     handled <- handleMenuBarEvent myMenuBarLens e+--     when (not handled) $ do+--         -- Go on to handle the event in the rest of the application+-- @+handleMenuBarEvent :: (Eq n)+                   => Lens' s (MenuBar s n k)+                   -- ^ The lens into the application state where the+                   -- menu state can be found+                   -> BrickEvent n e+                   -- ^ The event to handle+                   -> EventM n s Bool+handleMenuBarEvent which e@(VtyEvent (Vty.EvKey Vty.KLeft [])) = do+    -- Since this key might be handled by the open menu, try that first+    -- and only switch menus if it wasn't handled by the menu.+    handled <- withOpenMenu which $ \(idx, _) ->+        handleMenuEvent (which.menuBarMenusL.ix idx) e++    when (not handled) $+        which %= openPreviousMenu++    return True+handleMenuBarEvent which e@(VtyEvent (Vty.EvKey Vty.KRight [])) = do+    -- Since this key might be handled by the open menu, try that first+    -- and only switch menus if it wasn't handled by the menu.+    handled <- withOpenMenu which $ \(idx, _) ->+        handleMenuEvent (which.menuBarMenusL.ix idx) e++    when (not handled) $+        which %= openNextMenu++    return True+handleMenuBarEvent which e@(MouseDown n _ _ _) = do+    mb <- use which+    case getMenuTitleMatch mb n of+        Nothing -> withOpenMenu which $ \(idx, _) ->+            handleMenuEvent (which.menuBarMenusL.ix idx) e+        Just (i, _) -> do+            mMatchingMenu <- preuse (which.menuBarMenusL.ix i)+            case mMatchingMenu of+                Nothing -> return ()+                Just matchingMenu ->+                    when (not $ menuIsOpen matchingMenu) $ do+                        which %= closeAllMenus+                        which %= openMenuAtIndex i+            return True+handleMenuBarEvent which e =+    withOpenMenu which $ \(idx, _) ->+        handleMenuEvent (which.menuBarMenusL.ix idx) e++-- | Given a menu bar with an open menu, switch the open menu to the one+-- preceding the currently open one, or do nothing if no menu is open.+openPreviousMenu :: MenuBar s n k -> MenuBar s n k+openPreviousMenu mb = fromMaybe mb $ do+    (i, _) <- getOpenMenu mb+    let newIndex = if i == 0+                   then V.length (mb^.menuBarMenusL) - 1+                   else i - 1+    return $ openMenuAtIndex newIndex $ closeAllMenus mb++-- | Given a menu bar with an open menu, switch the open menu to the one+-- following the currently open one, or do nothing if no menu is open.+openNextMenu :: MenuBar s n k -> MenuBar s n k+openNextMenu mb = fromMaybe mb $ do+    (i, _) <- getOpenMenu mb+    let newIndex = if i == V.length (mb^.menuBarMenusL) - 1+                   then 0+                   else i + 1+    return $ openMenuAtIndex newIndex mb++-- | Close all open menus in this menu bar.+closeAllMenus :: MenuBar s n k -> MenuBar s n k+closeAllMenus mb = mb & menuBarMenusL.each %~ closeMenu++-- | Open the menu at the specified index, closing any other open menus+-- in the menu bar. If the index is invalid, this does nothing.+openMenuAtIndex :: Int -> MenuBar s n k -> MenuBar s n k+openMenuAtIndex i mb = (closeAllMenus mb) & menuBarMenusL.ix i %~ openMenu++-- | Set the menu orientation of the menu bar and all of its menus. For+-- details, see 'setMenuOrientation'.+setMenuBarOrientation :: MenuOrientation -> MenuBar s n k -> MenuBar s n k+setMenuBarOrientation o mb = mb & menuBarOrientationL .~ o+                                & menuBarMenusL.each %~ setMenuOrientation o++-- | Toggle the open state of the menu at the specified index. If+-- toggling to open, this will close any other open menus in the menu+-- bar. If the index is invalid, this does nothing.+toggleMenuAtIndex :: Int -> MenuBar s n k -> MenuBar s n k+toggleMenuAtIndex i mb =+    case getOpenMenu mb of+        Nothing -> openMenuAtIndex i mb+        Just (idx, _) -> if idx == i+                         then closeAllMenus mb+                         else openMenuAtIndex i mb++-- | Given a lens to access a menu bar and a handler to invoke on its+-- currently open menu, invoke the handler if there is an open menu and+-- return its result, or do nothing and return False otherwise.+withOpenMenu :: Lens' s (MenuBar s n k) -> ((Int, Menu s n k) -> EventM n s Bool) -> EventM n s Bool+withOpenMenu which f = do+    mb <- use which+    case getOpenMenu mb of+        Nothing -> return False+        Just pair -> f pair

@@ -44,7 +44,7 @@ -- progress value and custom characters to fill the progress. -- This fills available horizontal space and is one row high. -- Please be aware of using wide characters in Brick,--- see [Wide Character Support and the TextWidth class](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst#wide-character-support-and-the-textwidth-class)+-- see [Wide Character Support and the TextWidth class](https://github.com/jtdaugherty/brick/blob/main/docs/guide.rst#wide-character-support-and-the-textwidth-class) customProgressBar :: Char                   -- ^ Character to fill the completed part.                   -> Char

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE CPP #-} module Data.IMap     ( IMap     , Run(..)@@ -21,7 +22,9 @@     , unsafeToAscList     ) where +#if !MIN_VERSION_base(4,20,0) import Data.List (foldl')+#endif import Data.Monoid import Data.IntMap.Strict (IntMap) import GHC.Generics

@@ -1,10 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -import Control.Applicative import Data.Bool (bool)-import Data.Traversable (sequenceA) import System.Exit (exitFailure, exitSuccess)  import Data.IMap (IMap, Run(Run))@@ -15,6 +14,10 @@  import qualified List import qualified Render++#if !(MIN_VERSION_base(4,18,0))+import Control.Applicative (liftA2)+#endif  instance Arbitrary v => Arbitrary (Run v) where     arbitrary = liftA2 (\(Positive n) -> Run n) arbitrary arbitrary