brick 1.3 → 2.12
raw patch · 70 files changed
Files
- CHANGELOG.md +311/−2
- LICENSE +1/−1
- README.md +87/−54
- brick.cabal +88/−93
- docs/guide.rst +36/−17
- docs/programs-screenshots.md +0/−70
- docs/programs-screenshots/brick-attr-demo.png binary
- docs/programs-screenshots/brick-border-demo.png binary
- docs/programs-screenshots/brick-cache-demo.png binary
- docs/programs-screenshots/brick-custom-event-demo.png binary
- docs/programs-screenshots/brick-dialog-demo.png binary
- docs/programs-screenshots/brick-dynamic-border-demo.png binary
- docs/programs-screenshots/brick-edit-demo.png binary
- docs/programs-screenshots/brick-file-browser-demo.png binary
- docs/programs-screenshots/brick-fill-demo.png binary
- docs/programs-screenshots/brick-form-demo.png binary
- docs/programs-screenshots/brick-hello-world-demo.png binary
- docs/programs-screenshots/brick-layer-demo.png binary
- docs/programs-screenshots/brick-list-demo.png binary
- docs/programs-screenshots/brick-list-vi-demo.png binary
- docs/programs-screenshots/brick-mouse-demo.png binary
- docs/programs-screenshots/brick-padding-demo.png binary
- docs/programs-screenshots/brick-progressbar-demo.png binary
- docs/programs-screenshots/brick-readme-demo.png binary
- docs/programs-screenshots/brick-suspend-resume-demo.png binary
- docs/programs-screenshots/brick-text-wrap-demo.png binary
- docs/programs-screenshots/brick-theme-demo.png binary
- docs/programs-screenshots/brick-viewport-scroll-demo.png binary
- docs/programs-screenshots/brick-visibility-demo.png binary
- programs/AnimationDemo.hs +223/−0
- programs/BorderDemo.hs +18/−13
- programs/CustomEventDemo.hs +3/−4
- programs/DialogDemo.hs +14/−8
- programs/EditorLineNumbersDemo.hs +135/−0
- programs/FormDemo.hs +3/−1
- programs/LayerDemo.hs +8/−8
- programs/ProgressBarDemo.hs +48/−4
- programs/TabularListDemo.hs +146/−0
- programs/TailDemo.hs +2/−3
- programs/ThemeDemo.hs +1/−1
- programs/ViewportScrollbarsDemo.hs +35/−14
- src/Brick/Animation.hs +588/−0
- src/Brick/Animation/Clock.hs +64/−0
- src/Brick/AttrMap.hs +18/−0
- src/Brick/BorderMap.hs +2/−0
- src/Brick/Focus.hs +1/−0
- src/Brick/Forms.hs +126/−17
- src/Brick/Keybindings/KeyConfig.hs +15/−6
- src/Brick/Keybindings/Normalize.hs +14/−0
- src/Brick/Keybindings/Parse.hs +3/−2
- src/Brick/Keybindings/Pretty.hs +7/−8
- src/Brick/Main.hs +32/−7
- src/Brick/Themes.hs +0/−2
- src/Brick/Types.hs +2/−1
- src/Brick/Types/Common.hs +7/−2
- src/Brick/Types/Internal.hs +110/−74
- src/Brick/Util.hs +7/−1
- src/Brick/Widgets/Border.hs +21/−4
- src/Brick/Widgets/Center.hs +1/−1
- src/Brick/Widgets/Core.hs +266/−179
- src/Brick/Widgets/Dialog.hs +73/−61
- src/Brick/Widgets/Edit.hs +2/−2
- src/Brick/Widgets/FileBrowser.hs +74/−36
- src/Brick/Widgets/Internal.hs +33/−24
- src/Brick/Widgets/List.hs +20/−3
- src/Brick/Widgets/ProgressBar.hs +30/−4
- src/Brick/Widgets/Table.hs +130/−72
- tests/List.hs +9/−0
- tests/Main.hs +1/−0
- tests/Render.hs +2/−1
CHANGELOG.md view
@@ -2,6 +2,315 @@ Brick changelog --------------- +2.12+----++Package changes:++* Raised upper bound on microlens to allow building with 0.5.++2.11+----++Bug fixes:++* Fixed a bug in FileBrowser: if a user pressed Enter when the cursor+ was on a selected entry, it was omitted from the list of+ selected browser entries. As part of this change, the function+ `actionFileBrowserSelectCurrent` previously toggled the selection+ of the entry at the cursor, but should have selected it instead.+ It now does so, and a new function for toggling was introduced:+ `actionFileBrowserToggleCurrent`.++Other changes:++* Upper bounds on `base` and `microlens` were adjusted.++2.10+----++* Updated `brick` to build with `microlens == 0.5.0.0` which moved its+ Field* classes to `Lens.Micro.FieldN`.++2.9+---++API changes:+* Added `Brick.Widgets.List.listFindFirst` function.++2.8.3+-----++Bug fixes:++* Fixed a bug that completely broke `makeVisible` that was introduced+ in brick 2.6.+* Fixed context cropping in `cropRightBy` and `cropBottomBy`.++2.8.2+-----++* Updated `Brick.Widgets.Core` functions `cropBottomBy`, `cropToBy`,+ `cropLeftBy`, and `cropRightBy` to properly perform result cropping to+ actually address the internal bug fixed in 2.8.1.++2.8.1+-----++* Fixed a long-standing bug in `cropToContext` that resulted in some+ extents getting left around when they should be dropped, possibly+ leading to application bugs when handling mouse clicks in extent+ regions that should have been removed from the rendering result.++2.8+---++Behavior changes:+* `FileBrowser` file marking with `Space` now honors the file browser's+ configured file selector predicate.+* `FileBrowser` file marking with `Space` and `Enter` now toggles file+ selection rather than just selecting files, allowing for selected+ files to be unselected.++2.7+---++This release adds `Brick.Animation`, a module providing infrastructure+for adding animations to Brick interfaces. See the Haddock documentation+in `Brick.Animation` for full details; see `programs/AnimationDemo.hs`+for a working example.++2.6+---++Behavior changes:+ * `Brick.Widgets.Core.relativeTo` now draws nothing if the requested+ extent is not found. Previously it would draw the specified widget in+ the upper-left corner of the layer.++Bug fixes:+ * Fixed the conditional import in `BorderMap` (#519)+ * `Brick.Widgets.Center.hCenterWith` now properly accounts for centered+ image width when computing additional right padding (#520)+ * The Brick renderer now properly resets some render-specific state+ in between renderings that was previously kept around, avoiding+ preservation of stale extents across renderings+ * `brick-tail-demo` and `brick-custom-event-demo` now shut down Vty+ properly++2.5+---++New features:+* `Brick.Widgets.ProgressBar` got a new function, `customProgressBar`,+ which allows the customization of the fill characters used to draw a+ progress bar. (Thanks @sectore)++2.4+---++Changes:+* The `Keybindings` API now normalizes keybindings+ to lowercase when modifiers are present. (See also+ https://github.com/jtdaugherty/brick/issues/512) This means that,+ for example, a constructed binding for `C-X` would be normalized to+ `C-x`, and a binding from a configuration file written `C-X` would be+ parsed and then normalized to `C-x`. This is because, in general, when+ modifiers are present, input events are received for the lowercase+ version of the character in question. Prior to changing this, Brick+ would silently parse (or permit the construction of) uppercase-mapped+ key bindings, but in practice those bindings were unusable because+ they are not generated by terminals.++2.3.2+-----++Bug fixes:+* `FileBrowser`: if the `FileBrowser` was initialized with a `FilePath`+ that ended in a slash, then if the user hit `Enter` on the `../` entry+ to move to the parent directory, the only effect was the removal of+ that trailing slash. This change trims the trailing slash so that the+ expected move occurs whenever the `../` entry is selected.+* `Brick.Keybindings.Pretty.keybindingHelpWidget`: fixed a problem where+ a key event with no name in a `KeyEvents` would cause a `fromJust`+ exception. The pretty-printer now falls back to a placeholder+ representation for such unnamed key events.++2.3.1+-----++Bug fixes:+* Form field rendering now correctly checks for form field focus when+ its visibility mode is `ShowAugmentedField`.++2.3+---++API changes:+* `FormFieldVisibilityMode`'s `ShowAugmentedField` was renamed to+ `ShowCompositeField` to be clearer about what it does, and a new+ `ShowAugmentedField` constructor was added to support a mode where+ field augmentations applied with `@@=` are made visible as well.++2.2+---++Enhancements:+* `Brick.Forms` got a new `FormFieldVisibilityMode` type and a+ `setFieldVisibilityMode` function to allow greater control over+ how form field collections are brought into view when forms are+ rendered in viewports. Form fields will default to using the+ `ShowFocusedFieldOnly` mode which preserves functionality prior to+ this release. To get the new behavior, set a field's visibility mode+ to `ShowAugmentedField`.++2.1.1+-----++Bug fixes:+* `defaultMain` now properly shuts down Vty before it returns, fixing+ a bug where the terminal would be in an unclean state on return from+ `defaultMain`.++2.1+---++API changes:++* Added `Brick.Main.customMainWithDefaultVty` as an alternative way to+ initialize Brick.++2.0+---++This release updates Brick to support Vty 6, which includes support for+Windows.++Package changes:+* Increased lower bound on `vty` to 6.0.+* Added dependency on `vty-crossplatform`.+* Migrated from `unix` dependency to `unix-compat`.++Other changes:+* Update core library and demo programs to use `vty-crossplatform` to+ initialize the terminal.++1.10+----++API changes:+* The `ScrollbarRenderer` type got split up into vertical and horizontal+ versions, `VScrollbarRenderer` and `HScrollbarRenderer`, respectively.+ Their fields are nearly identical to the original `ScrollbarRenderer`+ fields except that many fields now have a `V` or `H` in them as+ appropriate. As part of this change, the various `Brick.Widgets.Core`+ functions that deal with the renderers got their types updated, and+ the types of the default scroll bar renderers changed, too.+* The scroll bar renderers now have a field to control how much space+ is allocated to a scroll bar. Previously, all scroll bars were+ assumed to be exactly one row in height or one column in width. This+ change is motivated by a desire to be able to control how scroll+ bars are rendered adjacent to viewport contents. It isn't always+ desirable to render them right up against the contents; sometimes,+ spacing would be nice between the bar and contents, for example.+ As part of this change, `VScrollbarRenderer` got a field called+ `scrollbarWidthAllocation` and `HScrollbarRenderer` got a field called+ `scrollbarHeightAllocation`. The fields specify the height (for+ horizontal scroll bars) or width (for vertical ones) of the region+ in which the bar is rendered, allowing scroll bar element widgets+ to take up more than one row in height (for horizontal scroll bars)+ or more than one column in width (for vertical ones) as desired. If+ the widgets take up less space, padding is added between the scroll+ bar and the viewport contents to pad the scroll bar to take up the+ specified allocation.++1.9+---++API changes:+* `FocusRing` got a `Show` instance.++1.8+---++API changes:+* Added `Brick.Widgets.Core.forceAttrAllowStyle`, which is like+ `forceAttr` but allows styles to be preserved rather than overridden.++Other improvements:+* The `Brick.Forms` documentation was updated to clarify how attributes+ get used for form fields.++1.7+---++Package changes:+* Allow building with `base` 4.18 (GHC 9.6) (thanks Mario Lang)++API changes:+* Added a new function, `Brick.Util.style`, to create a Vty `Attr` from+ a style value (thanks Amir Dekel)++Other improvements:+* `Brick.Forms.renderForm` now issues a visibility request for the+ focused form field, which makes forms usable within viewports.++1.6+---++Package changes:+* Support `mtl` 2.3 (thanks Daniel Firth)++API changes:+* `Brick.Widgets.Table` got a new `alignColumns` function that can be+ used to do column layout of a list of widgets using `ColumnAlignment`+ values from the table API.+* `Brick.Widgets.Table` got a new low-level table-rendering API for use+ in applications that want to use the table layout machinery without+ using `Table` itself. This includes:+ * `tableCellLayout` - does table cell layout using table configuration+ settings,+ * `addBorders` - adds row, column, and surrounding borders using table+ border-drawing settings, and+ * `RenderedTableCells` and `BorderConfiguration` - the low-level types+ used for the new functions.++Other changes:+* Added a new `EditorLineNumbersDemo` demo program.++1.5+---++This release focuses on API improvements in `Brick.Widgets.Dialog`:++* `Dialog` got an additional type argument, `n`, for resource names.+* The `dialog` constructor now takes `[(String, n, a)]` rather than+ `[(String, a)]`; this allows the caller to associate a resource name+ with each dialog button.+* Dialog buttons now report click events under their associated resource+ names.+* Dialog buttons now `putCursor` when they are focused in order to work+ better with screen readers.+* The `Dialog` module got `getDialogFocus` and `setDialogFocus`+ functions to help with focus management, and as part of this change,+ the `dialogSelectedIndex` function and its lens `dialogSelectedIndexL`+ were removed.++1.4+---++API changes:+* `Brick.Widgets.Border` got `hBorderAttr` and `vBorderAttr` for use by+ `hBorder` and `vBorder` respectively. The new attributes inherit from+ `borderAttr`, so applications that just specify `borderAttr` will not+ see any change in behavior for those specific border elements.++Performance improvements:+* `Brick.Widgets.Core.txt` had its performance improved. (thanks Fraser+ Tweedale)+* `Brick.Widgets.Core.hBox` and `vBox` had their performance improved.+ (thanks Fraser Tweedale)+ 1.3 --- @@ -47,7 +356,7 @@ you to update your programs. This section details the list of API changes in 1.0 that are likely to introduce breakage and how to deal with each one. You can also consult the demonstration-programs to see orking examples of the new API. For those+programs to see working examples of the new API. For those interested in a bit of discussion on the changes, see [this ticket](https://github.com/jtdaugherty/brick/issues/379). @@ -1563,7 +1872,7 @@ Bug fixes: * Fixed viewport behavior when the image in a viewport reduces its size enough to render the viewport offsets invalid. Before, this behavior- caused a crash during image croppin in vty; now the behavior is+ caused a crash during image cropping in vty; now the behavior is handled sanely (fixes #22; reported by Hans-Peter Deifel) 0.2.2
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015-2018, Jonathan Daugherty.+Copyright (c) 2015-2025, Jonathan Daugherty. All rights reserved. Redistribution and use in source and binary forms, with or without
README.md view
@@ -6,13 +6,16 @@ you provide a state transformation function to handle events. `brick` exposes a declarative API. Unlike most GUI toolkits which-require you to write a long and tedious sequence of "create a widget,-now bind an event handler", `brick` just requires you to describe your-interface using a set of declarative layout combinators.+require you to write a long and tedious sequence of widget creations+and layout setup, `brick` just requires you to describe your interface+using a set of declarative layout combinators. Event-handling is done by+pattern-matching on incoming events and updating your application state. Under the hood, this library builds upon [vty](http://hackage.haskell.org/package/vty), so some knowledge of Vty-will be helpful in using this library.+will be necessary to use this library. Brick depends on+`vty-crossplatform`, so Brick should work anywhere Vty works (Unix and+Windows). Brick releases prior to 2.0 only support Unix-based systems. Example -------@@ -47,58 +50,69 @@ | Project | Description | | ------- | ----------- |-| [`tetris`](https://github.com/SamTay/tetris) | An implementation of the Tetris game |-| [`gotta-go-fast`](https://github.com/callum-oakley/gotta-go-fast) | A typing tutor |-| [`haskell-player`](https://github.com/potomak/haskell-player) | An `afplay` frontend |-| [`mushu`](https://github.com/elaye/mushu) | An `MPD` client |-| [`matterhorn`](https://github.com/matterhorn-chat/matterhorn) | A client for [Mattermost](https://about.mattermost.com/) |-| [`viewprof`](https://github.com/maoe/viewprof) | A GHC profile viewer |-| [`tart`](https://github.com/jtdaugherty/tart) | A mouse-driven ASCII art drawing program |-| [`silly-joy`](https://github.com/rootmos/silly-joy) | An interpreter for Joy |-| [`herms`](https://github.com/jackkiefer/herms) | A command-line tool for managing kitchen recipes |-| [`purebred`](https://github.com/purebred-mua/purebred) | A mail user agent | | [`2048Haskell`](https://github.com/8Gitbrix/2048Haskell) | An implementation of the 2048 game |+| [`babel-cards`](https://github.com/srhoulam/babel-cards) | A TUI spaced-repetition memorization tool. Similar to Anki. | | [`bhoogle`](https://github.com/andrevdm/bhoogle) | A [Hoogle](https://www.haskell.org/hoogle/) client |+| [`bollama`](https://github.com/andrevdm/bollama) | A simple [Ollama](https://ollama.com/) TUI |+| [`brewsage`](https://github.com/gerdreiss/brewsage#readme) | A TUI for Homebrew |+| [`brick-trading-journal`](https://codeberg.org/amano.kenji/brick-trading-journal) | A TUI program that calculates basic statistics from trades |+| [`Brickudoku`](https://github.com/Thecentury/brickudoku) | A hybrid of Tetris and Sudoku |+| [`cbookview`](https://github.com/mlang/cbookview) | A TUI for exploring polyglot chess opening book files | | [`clifm`](https://github.com/pasqu4le/clifm) | A file manager |-| [`towerHanoi`](https://github.com/shajenM/projects/tree/master/towerHanoi) | Animated solutions to The Tower of Hanoi |-| [`VOIDSPACE`](https://github.com/ChrisPenner/void-space) | A space-themed typing-tutor game |-| [`solitaire`](https://github.com/ambuc/solitaire) | The card game |-| [`sudoku-tui`](https://github.com/evanrelf/sudoku-tui) | A Sudoku implementation |-| [`summoner-tui`](https://github.com/kowainik/summoner/tree/master/summoner-tui) | An interactive frontend to the Summoner tool |-| [`wrapping-editor`](https://github.com/ta0kira/wrapping-editor) | An embeddable editor with support for Brick |+| [`codenames-haskell`](https://github.com/VigneshN1997/codenames-haskell) | An implementation of the Codenames game |+| [`fifteen`](https://github.com/benjaminselfridge/fifteen) | An implementation of the [15 puzzle](https://en.wikipedia.org/wiki/15_puzzle) |+| [`ghcup`](https://www.haskell.org/ghcup/) | A TUI for `ghcup`, the Haskell toolchain manager | | [`git-brunch`](https://github.com/andys8/git-brunch) | A git branch checkout utility |+| [`Giter`](https://gitlab.com/refaelsh/giter) | A UI wrapper around Git CLI inspired by [Magit](https://magit.vc/). |+| [`gotta-go-fast`](https://github.com/callum-oakley/gotta-go-fast) | A typing tutor |+| [`haradict`](https://github.com/srhoulam/haradict) | A TUI Arabic dictionary powered by [ElixirFM](https://github.com/otakar-smrz/elixir-fm) | | [`hascard`](https://github.com/Yvee1/hascard) | A program for reviewing "flash card" notes |-| [`ttyme`](https://github.com/evuez/ttyme) | A TUI for [Harvest](https://www.getharvest.com/) |-| [`ghcup`](https://www.haskell.org/ghcup/) | A TUI for `ghcup`, the Haskell toolchain manager |-| [`cbookview`](https://github.com/mlang/chessIO) | A TUI for exploring polyglot chess opening book files |-| [`thock`](https://github.com/rmehri01/thock) | A modern TUI typing game featuring online racing against friends |-| [`fifteen`](https://github.com/benjaminselfridge/fifteen) | An implementation of the [15 puzzle](https://en.wikipedia.org/wiki/15_puzzle) |+| [`haskell-player`](https://github.com/potomak/haskell-player) | An `afplay` frontend |+| [`herms`](https://github.com/jackkiefer/herms) | A command-line tool for managing kitchen recipes |+| [`hic-hac-hoe`](https://github.com/blastwind/hic-hac-hoe) | Play tic tac toe in terminal! |+| [`hledger-iadd`](http://github.com/rootzlevel/hledger-iadd) | An interactive terminal UI for adding hledger journal entries |+| [`hledger-ui`](https://github.com/simonmichael/hledger) | A terminal UI for the hledger accounting system. |+| [`homodoro`](https://github.com/c0nradLC/homodoro) | A terminal application to use the pomodoro technique and keep track of daily tasks |+| [`hskanban`](https://github.com/vincentaxhe/hskanban) | A Kanban organizer |+| [`htyper`](https://github.com/Simon-Hostettler/htyper) | A typing speed test program |+| [`hyahtzee2`](https://github.com/DamienCassou/hyahtzee2#readme) | Famous Yahtzee dice game |+| [`kpxhs`](https://github.com/akazukin5151/kpxhs) | An interactive [Keepass](https://github.com/keepassxreboot/keepassxc/) database viewer |+| [`matterhorn`](https://github.com/matterhorn-chat/matterhorn) | A client for [Mattermost](https://about.mattermost.com/) | | [`maze`](https://github.com/benjaminselfridge/maze) | A Brick-based maze game |+| [`monad-torrent`](https://github.com/davorluc/monad-torrent) | A simple and minimal torrent client |+| [`monalog`](https://github.com/goosedb/Monalog) | Terminal logs observer |+| [`mushu`](https://github.com/elaye/mushu) | An `MPD` client |+| [`mywork`](https://github.com/kquick/mywork) [[Hackage]](https://hackage.haskell.org/package/mywork) | A tool to keep track of the projects you are working on | | [`pboy`](https://github.com/2mol/pboy) | A tiny PDF organizer |-| [`hyahtzee2`](https://github.com/DamienCassou/hyahtzee2#readme) | Famous Yahtzee dice game |-| [`brewsage`](https://github.com/gerdreiss/brewsage#readme) | A TUI for Homebrew |+| [`purebred`](https://github.com/purebred-mua/purebred) | A mail user agent | | [`sandwich`](https://codedownio.github.io/sandwich/) | A test framework with a TUI interface |-| [`youbrick`](https://github.com/florentc/youbrick) | A feed aggregator and launcher for Youtube channels |+| [`silly-joy`](https://github.com/rootmos/silly-joy) | An interpreter for Joy |+| [`solitaire`](https://github.com/ambuc/solitaire) | The card game |+| [`sudoku-tui`](https://github.com/evanrelf/sudoku-tui) | A Sudoku implementation |+| [`summoner-tui`](https://github.com/kowainik/summoner/tree/master/summoner-tui) | An interactive frontend to the Summoner tool | | [`swarm`](https://github.com/byorgey/swarm/) | A 2D programming and resource gathering game |-| [`hledger-ui`](https://github.com/simonmichael/hledger) | A terminal UI for the hledger accounting system. |-| [`hledger-iadd`](http://github.com/rootzlevel/hledger-iadd) | An interactive terminal UI for adding hledger journal entries |-| [`wordle`](https://github.com/ivanjermakov/wordle) | An implementation of the Wordle game |-| [`kpxhs`](https://github.com/akazukin5151/kpxhs) | An interactive [Keepass](https://github.com/keepassxreboot/keepassxc/) database viewer |-| [`htyper`](https://github.com/Simon-Hostettler/htyper) | A typing speed test program |+| [`tart`](https://github.com/jtdaugherty/tart) | A mouse-driven ASCII art drawing program |+| [`tick-tock-tui`](https://github.com/sectore/tick-tock-tui) | A stylish TUI app to handle Bitcoin data provided by [Mempool REST API](https://mempool.space/docs/api/rest) incl. blocks, fees and price converter. |+| [`tetris`](https://github.com/SamTay/tetris) | An implementation of the Tetris game |+| [`thock`](https://github.com/rmehri01/thock) | A modern TUI typing game featuring online racing against friends |+| [`timeloop`](https://github.com/cdupont/timeloop) | A time-travelling demonstrator |+| [`towerHanoi`](https://github.com/shajenM/projects/tree/master/towerHanoi) | Animated solutions to The Tower of Hanoi |+| [`ttyme`](https://github.com/evuez/ttyme) | A TUI for [Harvest](https://www.getharvest.com/) | | [`ullekha`](https://github.com/ajithnn/ullekha) | An interactive terminal notes/todo app with file/redis persistence |--These third-party packages also extend `brick`:--| Project | Description |-| ------- | ----------- |-| [`brick-filetree`](https://github.com/ChrisPenner/brick-filetree) [[Hackage]](http://hackage.haskell.org/package/brick-filetree) | A widget for exploring a directory tree and selecting or flagging files and directories |--Release Announcements / News-----------------------------+| [`viewprof`](https://github.com/maoe/viewprof) | A GHC profile viewer |+| [`VOIDSPACE`](https://github.com/ChrisPenner/void-space) | A space-themed typing-tutor game |+| [`wordle`](https://github.com/ivanjermakov/wordle) | An implementation of the Wordle game |+| [`wrapping-editor`](https://github.com/ta0kira/wrapping-editor) | An embeddable editor with support for Brick |+| [`youbrick`](https://github.com/florentc/youbrick) | A feed aggregator and launcher for Youtube channels | -Find out about `brick` releases and other news on Twitter:+These additional packages also extend `brick`: -https://twitter.com/brick_haskell/+| Project | Description | Hackage |+| ------- | ----------- | ------- |+| [`brick-filetree`](https://github.com/ChrisPenner/brick-filetree) | A widget for exploring a directory tree and selecting or flagging files and directories | [Hackage](https://hackage.haskell.org/package/brick-filetree) |+| [`brick-panes`](https://github.com/kquick/brick-panes) | A Brick overlay library providing composition and isolation of screen areas for TUI apps. | [Hackage](https://hackage.haskell.org/package/brick-panes) |+| [`brick-calendar`](https://github.com/ldgrp/brick-calendar) | A library providing a calendar widget for Brick-based applications. | [Hackage](https://hackage.haskell.org/package/brick-calendar) |+| [`brick-skylighting`](https://github.com/jtdaugherty/brick-skylighting) | A library providing integration support for [Skylighting](https://hackage.haskell.org/package/skylighting)-based syntax highlighting. | [Hackage](https://hackage.haskell.org/package/brick-skylighting) | Getting Started ---------------@@ -119,8 +133,8 @@ Documentation for `brick` comes in a variety of forms: * [The official brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)-* Haddock (all modules)-* [Demo programs](https://github.com/jtdaugherty/brick/blob/master/programs) ([Screenshots](https://github.com/jtdaugherty/brick/blob/master/docs/programs-screenshots.md))+* [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) Feature Overview@@ -134,6 +148,7 @@ * Progress bar widget * Simple dialog box widget * Border-drawing widgets (put borders around or in between things)+ * Animation support * Generic scrollable viewports and viewport scroll bars * General-purpose layout control combinators * Extensible widget-building API@@ -142,13 +157,14 @@ * A filesystem browser for file and directory selection * Borders can be configured to automatically connect! -Brick-Users Discussion-----------------------+Brick Discussion+---------------- -The `brick-users` Google Group / e-mail list is a place to discuss-library changes, give feedback, and ask questions. You can subscribe at:+There are two forums for discussing brick-related things: -[https://groups.google.com/group/brick-users](https://groups.google.com/group/brick-users)+1. The [Discussions page](https://github.com/jtdaugherty/brick/discussions) on the github repo, and+1. The `brick-users` Google Group / e-mail list. You can subscribe+ [here](https://groups.google.com/group/brick-users). Status ------@@ -168,14 +184,24 @@ packages and widgets. If you use that, you'll also be helping to test whether the exported interface is usable and complete! +A note on Windows support+-------------------------++Brick supports Windows implicitly by way of Vty's Windows support.+While I don't (and can't) personally test Brick on Windows hosts,+it should be possible to use Brick on Windows. If you have any+trouble, report any issues here. If needed, we'll migrate them to the+[vty-windows](https://github.com/chhackett/vty-windows) repository if+they need to be fixed there.+ Reporting bugs -------------- Please file bug reports as GitHub issues. For best results: - Include the versions of relevant software packages: your terminal- emulator, `brick`, `ghc`, and `vty` will be the most important- ones.+ emulator, `brick`, `ghc`, `vty`, and Vty platform packages will be+ the most important ones. - Clearly describe the behavior you expected ... @@ -188,6 +214,8 @@ If you decide to contribute, that's great! Here are some guidelines you should consider to make submitting patches easier for all concerned: + - Patches written completely or partially by AI are unlikely to be+ accepted. - If you want to take on big things, talk to me first; let's have a design/vision discussion before you start coding. Create a GitHub issue and we can use that as the place to hash things out.@@ -195,7 +223,12 @@ codebase. - Please adjust or provide Haddock and/or user guide documentation relevant to any changes you make.- - New commits should be `-Wall` clean.+ - Please ensure that commits are `-Wall` clean.+ - Please ensure that each commit makes a single, logical, isolated+ change as much as possible.+ - Please do not submit changes that your linter told you to make. I+ will probably decline them. Relatedly: please do not submit changes+ that change only style without changing functionality. - Please do NOT include package version changes in your patches. Package version changes are only done at release time when the full scope of a release's changes can be evaluated to determine the
brick.cabal view
@@ -1,5 +1,5 @@ name: brick-version: 1.3+version: 2.12 synopsis: A declarative terminal user interface library description: Write terminal user interfaces (TUIs) painlessly with 'brick'! You@@ -32,47 +32,34 @@ license-file: LICENSE author: Jonathan Daugherty <cygnus@foobox.com> maintainer: Jonathan Daugherty <cygnus@foobox.com>-copyright: (c) Jonathan Daugherty 2015-2022+copyright: (c) Jonathan Daugherty 2015-2025 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, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.4, GHC == 9.4.2+tested-with: GHC == 8.2.2+ || == 8.4.4+ || == 8.6.5+ || == 8.8.4+ || == 8.10.7+ || == 9.0.2+ || == 9.2.8+ || == 9.4.8+ || == 9.6.7+ || == 9.8.4+ || == 9.10.3+ || == 9.12.2 extra-doc-files: README.md, docs/guide.rst, docs/snake-demo.gif, CHANGELOG.md,- programs/custom_keys.ini,- docs/programs-screenshots.md,- docs/programs-screenshots/brick-attr-demo.png,- docs/programs-screenshots/brick-border-demo.png,- docs/programs-screenshots/brick-cache-demo.png,- docs/programs-screenshots/brick-custom-event-demo.png,- docs/programs-screenshots/brick-dialog-demo.png,- docs/programs-screenshots/brick-dynamic-border-demo.png,- docs/programs-screenshots/brick-edit-demo.png,- docs/programs-screenshots/brick-file-browser-demo.png,- docs/programs-screenshots/brick-fill-demo.png,- docs/programs-screenshots/brick-form-demo.png,- docs/programs-screenshots/brick-hello-world-demo.png,- docs/programs-screenshots/brick-layer-demo.png,- docs/programs-screenshots/brick-list-demo.png,- docs/programs-screenshots/brick-list-vi-demo.png,- docs/programs-screenshots/brick-mouse-demo.png,- docs/programs-screenshots/brick-padding-demo.png,- docs/programs-screenshots/brick-progressbar-demo.png,- docs/programs-screenshots/brick-readme-demo.png,- docs/programs-screenshots/brick-suspend-resume-demo.png,- docs/programs-screenshots/brick-text-wrap-demo.png,- docs/programs-screenshots/brick-theme-demo.png,- docs/programs-screenshots/brick-viewport-scroll-demo.png,- docs/programs-screenshots/brick-visibility-demo.png+ programs/custom_keys.ini Source-Repository head type: git- location: git://github.com/jtdaugherty/brick.git+ location: http://github.com/jtdaugherty/brick Flag demos Description: Build demonstration programs@@ -80,11 +67,12 @@ library default-language: Haskell2010- ghc-options: -Wall -Wcompat -O2+ ghc-options: -Wall -Wcompat -O2 -Wunused-packages default-extensions: CPP hs-source-dirs: src exposed-modules: Brick+ Brick.Animation Brick.AttrMap Brick.BChan Brick.BorderMap@@ -92,6 +80,7 @@ Brick.Keybindings.KeyConfig Brick.Keybindings.KeyEvents Brick.Keybindings.KeyDispatcher+ Brick.Keybindings.Normalize Brick.Keybindings.Parse Brick.Keybindings.Pretty Brick.Focus@@ -112,35 +101,39 @@ Brick.Widgets.Table Data.IMap other-modules:+ Brick.Animation.Clock Brick.Types.Common Brick.Types.TH Brick.Types.EventM Brick.Types.Internal Brick.Widgets.Internal - build-depends: base >= 4.9.0.0 && < 4.18.0.0,- vty >= 5.36,+ build-depends: base >= 4.9.0.0 && < 4.23.0.0,+ vty >= 6.0,+ vty-crossplatform, bimap >= 0.5 && < 0.6, data-clist >= 0.1, directory >= 1.2.5.0, exceptions >= 0.10.0, filepath, containers >= 0.5.7,- microlens >= 0.3.0.0,+ microlens >= 0.3.0.0 && < 0.6, microlens-th, microlens-mtl, mtl, config-ini, vector,- contravariant, stm >= 2.4.3, text,- text-zipper >= 0.12,+ text-zipper >= 0.13, template-haskell,- deepseq >= 1.3 && < 1.5,- unix,+ deepseq >= 1.3 && < 1.6,+ unix-compat, bytestring,- word-wrap >= 0.2+ word-wrap >= 0.2,+ unordered-containers,+ hashable,+ time executable brick-custom-keybinding-demo if !flag(demos)@@ -168,9 +161,7 @@ default-extensions: CPP main-is: TableDemo.hs build-depends: base,- brick,- text,- vty+ brick executable brick-tail-demo if !flag(demos)@@ -197,8 +188,7 @@ default-extensions: CPP main-is: ReadmeDemo.hs build-depends: base,- brick,- text+ brick executable brick-file-browser-demo if !flag(demos)@@ -227,6 +217,7 @@ text, microlens, microlens-th,+ vty-crossplatform, vty executable brick-text-wrap-demo@@ -239,7 +230,6 @@ main-is: TextWrapDemo.hs build-depends: base, brick,- text, word-wrap executable brick-cache-demo@@ -253,9 +243,6 @@ build-depends: base, brick, vty,- text,- microlens >= 0.3.0.0,- microlens-th, mtl executable brick-visibility-demo@@ -268,7 +255,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-th, microlens-mtl@@ -284,8 +270,7 @@ build-depends: base, brick, vty,- text,- microlens,+ vty-crossplatform, microlens-mtl, microlens-th @@ -299,9 +284,7 @@ main-is: ViewportScrollDemo.hs build-depends: base, brick,- vty,- text,- microlens+ vty executable brick-dialog-demo if !flag(demos)@@ -312,9 +295,7 @@ main-is: DialogDemo.hs build-depends: base, brick,- vty,- text,- microlens+ vty executable brick-mouse-demo if !flag(demos)@@ -326,11 +307,9 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-th, microlens-mtl,- text-zipper, mtl executable brick-layer-demo@@ -343,7 +322,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-th, microlens-mtl@@ -358,7 +336,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-th @@ -371,9 +348,7 @@ main-is: CroppingDemo.hs build-depends: base, brick,- vty,- text,- microlens+ vty executable brick-padding-demo if !flag(demos)@@ -384,9 +359,7 @@ main-is: PaddingDemo.hs build-depends: base, brick,- vty,- text,- microlens+ vty executable brick-theme-demo if !flag(demos)@@ -398,9 +371,7 @@ build-depends: base, brick, vty,- text,- mtl,- microlens+ mtl executable brick-attr-demo if !flag(demos)@@ -411,9 +382,22 @@ main-is: AttrDemo.hs build-depends: base, brick,+ vty++executable brick-tabular-list-demo+ if !flag(demos)+ Buildable: False+ hs-source-dirs: programs+ ghc-options: -threaded -Wall -Wcompat -O2+ default-language: Haskell2010+ main-is: TabularListDemo.hs+ build-depends: base,+ brick, vty,- text,- microlens+ microlens >= 0.3.0.0,+ microlens-mtl,+ microlens-th,+ vector executable brick-list-demo if !flag(demos)@@ -425,7 +409,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-mtl, mtl,@@ -441,12 +424,25 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-mtl, mtl, vector +executable brick-animation-demo+ if !flag(demos)+ Buildable: False+ hs-source-dirs: programs+ ghc-options: -threaded -Wall -Wcompat -O2+ default-language: Haskell2010+ main-is: AnimationDemo.hs+ build-depends: base,+ brick,+ vty,+ vty-crossplatform,+ containers,+ microlens-platform+ executable brick-custom-event-demo if !flag(demos) Buildable: False@@ -457,7 +453,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-th, microlens-mtl@@ -470,10 +465,7 @@ default-language: Haskell2010 main-is: FillDemo.hs build-depends: base,- brick,- vty,- text,- microlens+ brick executable brick-hello-world-demo if !flag(demos)@@ -483,10 +475,7 @@ default-language: Haskell2010 main-is: HelloWorldDemo.hs build-depends: base,- brick,- vty,- text,- microlens+ brick executable brick-edit-demo if !flag(demos)@@ -498,13 +487,24 @@ build-depends: base, brick, vty,- text,- vector,- mtl, microlens >= 0.3.0.0, microlens-th, microlens-mtl +executable brick-editor-line-numbers-demo+ if !flag(demos)+ Buildable: False+ hs-source-dirs: programs+ ghc-options: -threaded -Wall -Wcompat -O2+ default-language: Haskell2010+ main-is: EditorLineNumbersDemo.hs+ build-depends: base,+ brick,+ vty,+ microlens >= 0.3.0.0,+ microlens-th,+ microlens-mtl+ executable brick-border-demo if !flag(demos) Buildable: False@@ -516,8 +516,7 @@ build-depends: base, brick, vty,- text,- microlens+ text executable brick-dynamic-border-demo if !flag(demos)@@ -528,10 +527,7 @@ default-language: Haskell2010 main-is: DynamicBorderDemo.hs build-depends: base <= 5,- brick,- vty,- text,- microlens+ brick executable brick-progressbar-demo if !flag(demos)@@ -544,8 +540,6 @@ build-depends: base, brick, vty,- text,- microlens, microlens-mtl, microlens-th @@ -562,4 +556,5 @@ microlens, vector, vty,+ vty-crossplatform, QuickCheck
docs/guide.rst view
@@ -53,6 +53,13 @@ $ cd brick $ cabal new-build +Your package will need some dependencies:++* ``brick``,+* ``vty >= 6.0``, and+* ``vty-crossplatform`` or ``vty-unix`` or ``vty-windows``, depending+ on which platform(s) your application supports.+ Building the Demonstration Programs ----------------------------------- @@ -214,8 +221,8 @@ appHandleEvent :: BrickEvent n e -> EventM n s () ``appHandleEvent`` is responsible for deciding how to change the state-based on the event. The single parameter to the event handler is the-event to be handled. Its type variables ``n`` and ``e`` correspond+based on incoming events. The single parameter to the event handler is+the event to be handled. Its type variables ``n`` and ``e`` correspond to the *resource name type* and *event type* of your application, respectively, and must match the corresponding types in ``App`` and ``EventM``.@@ -254,11 +261,11 @@ in this monad by using ``liftIO``. Keep in mind, however, that event handlers should execute as quickly as possible to avoid introducing screen redraw latency. Consider using background threads to work-asynchronously when it would otherwise cause redraw latency.+asynchronously when handling an event would otherwise cause redraw+latency. -Beyond I/O, ``EventM`` is used to make scrolling requests to the-renderer (see `Viewports`_), obtain named extents (see `Extents`_), and-other duties.+``EventM`` is also used to make scrolling requests to the renderer (see+`Viewports`_), obtain named extents (see `Extents`_), and other duties. Event Handlers for Component State **********************************@@ -291,7 +298,7 @@ .. code:: haskell - data MyState = MyState { _editor :: Editor Text n }+ data MyState n = MyState { _editor :: Editor Text n } makeLenses ''MyState This declares the ``MyState`` type with an ``Editor`` contained within@@ -403,7 +410,7 @@ main :: IO () main = do eventChan <- Brick.BChan.newBChan 10- let buildVty = Graphics.Vty.mkVty Graphics.Vty.defaultConfig+ let buildVty = Graphics.Vty.CrossPlatform.mkVty Graphics.Vty.Config.defaultConfig initialVty <- buildVty finalState <- customMain initialVty buildVty (Just eventChan) app initialState@@ -412,7 +419,11 @@ The ``customMain`` function lets us have control over how the ``vty`` library is initialized *and* how ``brick`` gets custom events to give to our event handler. ``customMain`` is the entry point into ``brick`` when-you need to use your own event type as shown here.+you need to use your own event type as shown here. In this example we're+using ``mkVty`` provided by the ``vty-crossplatform`` package, which+provides build-time support for both Unix and Windows. If you prefer,+you can use either the ``vty-unix`` package or the ``vty-windows``+package directly instead if you only want to support one platform. With all of this in place, sending our custom events to the event handler is straightforward:@@ -1649,8 +1660,8 @@ ``Brick.Keybindings.KeyDispatcher``. The following table compares Brick application design decisions and-runtime behaviors in a typical application compared to one that uses the-customizable keybindings API:+runtime behaviors in a typical application to those of an application+that uses the customizable keybindings API: +---------------------+------------------------+-------------------------+ | **Approach** | **Before runtime** | **At runtime** |@@ -1745,12 +1756,12 @@ open and only handled ``QuitEvent`` when the window had been closed. This kind of "modal" approach to handling events means that we only consider a key to have a collision if it is bound to two or more- events that are handled in the same event handler.+ events that are handled in the same event handling context. -There's also another situation that would be problematic, which is when-an abstract event like ``QuitEvent`` has a key mapping that+There's also another situation that would be problematic, which is+when an abstract event like ``QuitEvent`` has a key mapping that collides with a key handler that is bound to a specific key using-``Brick.Keybindings.KeyDispatcher.onKey`` rather than an event:+``Brick.Keybindings.KeyDispatcher.onKey`` rather than an abstract event: .. code:: haskell @@ -1955,6 +1966,14 @@ so by consulting the ``ctxDynBorders`` field of the rendering context before writing to your ``Result``'s ``borders`` field. +Animations+==========++Brick provides animation support in ``Brick.Animation``. See the Haddock+documentation in that module for a complete explanation of the API; see+``programs/AnimationDemo.hs`` (``brick-animation-demo``) for a working+example.+ The Rendering Cache =================== @@ -1974,8 +1993,8 @@ border $ str "This will be cached" -In the example above, the first time the ``border $ str "This will be-cached"`` widget is rendered, the resulting Vty image will be stored+In the example above, the first time the ``border $ str "This will be cached"``+widget is rendered, the resulting Vty image will be stored in the rendering cache under the key ``ExpensiveThing``. On subsequent renderings the cached Vty image will be used instead of re-rendering the widget. This example doesn't need caching to improve performance, but
− docs/programs-screenshots.md
@@ -1,70 +0,0 @@-# Demo program screenshots--## [AttrDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/AttrDemo.hs)---## [BorderDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/BorderDemo.hs)---## [CacheDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/CacheDemo.hs)---## [CustomEventDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/CustomEventDemo.hs)---## [DialogDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/DialogDemo.hs)---## [DynamicBorderDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/DynamicBorderDemo.hs)---## [EditDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/EditDemo.hs)---## [FileBrowserDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/FileBrowserDemo.hs)---## [FillDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/FillDemo.hs)---## [FormDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/FormDemo.hs)---## [HelloWorldDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/HelloWorldDemo.hs)---## [LayerDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/LayerDemo.hs)---## [ListDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ListDemo.hs)---## [ListViDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ListViDemo.hs)---## [MouseDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/MouseDemo.hs)---## [PaddingDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/PaddingDemo.hs)---## [ProgressBarDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ProgressBarDemo.hs)---## [ReadmeDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ReadmeDemo.hs)---## [SuspendAndResumeDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/SuspendAndResumeDemo.hs)---## [TextWrapDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/TextWrapDemo.hs)---## [ThemeDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ThemeDemo.hs)---## [ViewportScrollDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ViewportScrollDemo.hs)---## [VisibilityDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/VisibilityDemo.hs)-
− docs/programs-screenshots/brick-attr-demo.png
binary file changed (52808 → absent bytes)
− docs/programs-screenshots/brick-border-demo.png
binary file changed (19670 → absent bytes)
− docs/programs-screenshots/brick-cache-demo.png
binary file changed (44698 → absent bytes)
− docs/programs-screenshots/brick-custom-event-demo.png
binary file changed (12081 → absent bytes)
− docs/programs-screenshots/brick-dialog-demo.png
binary file changed (14232 → absent bytes)
− docs/programs-screenshots/brick-dynamic-border-demo.png
binary file changed (25746 → absent bytes)
− docs/programs-screenshots/brick-edit-demo.png
binary file changed (18668 → absent bytes)
− docs/programs-screenshots/brick-file-browser-demo.png
binary file changed (43038 → absent bytes)
− docs/programs-screenshots/brick-fill-demo.png
binary file changed (12794 → absent bytes)
− docs/programs-screenshots/brick-form-demo.png
binary file changed (20724 → absent bytes)
− docs/programs-screenshots/brick-hello-world-demo.png
binary file changed (10794 → absent bytes)
− docs/programs-screenshots/brick-layer-demo.png
binary file changed (22655 → absent bytes)
− docs/programs-screenshots/brick-list-demo.png
binary file changed (18011 → absent bytes)
− docs/programs-screenshots/brick-list-vi-demo.png
binary file changed (18448 → absent bytes)
− docs/programs-screenshots/brick-mouse-demo.png
binary file changed (35768 → absent bytes)
− docs/programs-screenshots/brick-padding-demo.png
binary file changed (22308 → absent bytes)
− docs/programs-screenshots/brick-progressbar-demo.png
binary file changed (16385 → absent bytes)
− docs/programs-screenshots/brick-readme-demo.png
binary file changed (11141 → absent bytes)
− docs/programs-screenshots/brick-suspend-resume-demo.png
binary file changed (12771 → absent bytes)
− docs/programs-screenshots/brick-text-wrap-demo.png
binary file changed (27669 → absent bytes)
− docs/programs-screenshots/brick-theme-demo.png
binary file changed (13429 → absent bytes)
− docs/programs-screenshots/brick-viewport-scroll-demo.png
binary file changed (32432 → absent bytes)
− docs/programs-screenshots/brick-visibility-demo.png
binary file changed (50627 → absent bytes)
+ programs/AnimationDemo.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+module Main where++import Control.Monad (void)+import Lens.Micro.Platform+import Data.List (intersperse)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Data.Map as M+import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)++import Brick.BChan+import Brick.Util (fg)+import Brick.Main (App(..), neverShowCursor, customMain, halt)+import Brick.AttrMap (AttrName, AttrMap, attrMap, attrName)+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 qualified Brick.Animation as A++data CustomEvent =+ AnimationUpdate (EventM () St ())+ -- ^ The state update constructor required by the animation API++data St =+ St { _stAnimationManager :: A.AnimationManager St CustomEvent ()+ -- ^ The animation manager that will run all of our animations+ , _animation1 :: Maybe (A.Animation St ())+ , _animation2 :: Maybe (A.Animation St ())+ , _animation3 :: Maybe (A.Animation St ())+ , _clickAnimations :: M.Map Location (A.Animation St ())+ -- ^ The various fields for storing animation states. For mouse+ -- animations, we store animations for each screen location that+ -- was clicked.+ }++makeLenses ''St++drawUI :: St -> [Widget ()]+drawUI st = drawClickAnimations st <> [drawAnimations st]++drawClickAnimations :: St -> [Widget ()]+drawClickAnimations st =+ drawClickAnimation st <$> M.toList (st^.clickAnimations)++drawClickAnimation :: St -> (Location, A.Animation St ()) -> Widget ()+drawClickAnimation st (l, a) =+ translateBy l $+ A.renderAnimation (const $ str " ") st (Just a)++drawAnimations :: St -> Widget ()+drawAnimations st =+ let animStatus label key a =+ str (label <> ": ") <+>+ maybe (str "Not running") (const $ str "Running") a <+>+ str (" (Press " <> key <> " to toggle)")+ statusMessages = statusMessage <$> zip [(0::Int)..] animations+ statusMessage (i, (c, config)) =+ animStatus ("Animation #" <> (show $ i + 1)) [c]+ (st^.(animationTarget config))+ animationDrawings = hBox $ intersperse (str " ") $+ drawSingleAnimation <$> animations+ drawSingleAnimation (_, config) =+ A.renderAnimation (const $ str " ") st (st^.(animationTarget config))+ in vBox [ str "Click and drag the mouse or press keys to start animations."+ , str " "+ , vBox statusMessages+ , animationDrawings+ ]++clip1 :: A.Clip a ()+clip1 = A.newClip_ $ str <$> [".", "o", "O", "^", " "]++clip2 :: A.Clip a ()+clip2 = A.newClip_ $ str <$> ["|", "/", "-", "\\"]++clip3 :: A.Clip a ()+clip3 =+ A.newClip_ $+ (hLimit 9 . vLimit 9 . border . center) <$>+ [ border $ str " "+ , border $ vBox $ replicate 3 $ str $ replicate 3 ' '+ , border $ vBox $ replicate 5 $ str $ replicate 5 ' '+ ]++mouseClickClip :: A.Clip a ()+mouseClickClip =+ A.newClip_+ [ withDefAttr attr6 $ str "0"+ , withDefAttr attr5 $ str "O"+ , withDefAttr attr4 $ str "o"+ , withDefAttr attr3 $ str "•"+ , withDefAttr attr2 $ str "*"+ , withDefAttr attr2 $ str "."+ ]++attr6 :: AttrName+attr6 = attrName "attr6"++attr5 :: AttrName+attr5 = attrName "attr5"++attr4 :: AttrName+attr4 = attrName "attr4"++attr3 :: AttrName+attr3 = attrName "attr3"++attr2 :: AttrName+attr2 = attrName "attr2"++attr1 :: AttrName+attr1 = attrName "attr1"++attrs :: AttrMap+attrs =+ attrMap V.defAttr+ [ (attr6, fg V.white)+ , (attr5, fg V.brightYellow)+ , (attr4, fg V.brightGreen)+ , (attr3, fg V.cyan)+ , (attr2, fg V.blue)+ , (attr1, fg V.black)+ ]++-- | Animation settings grouped together for lookup by keystroke.+data AnimationConfig =+ AnimationConfig { animationTarget :: Lens' St (Maybe (A.Animation St ()))+ , animationClip :: A.Clip St ()+ , animationFrameTime :: Integer+ , animationMode :: A.RunMode+ }++animations :: [(Char, AnimationConfig)]+animations =+ [ ('1', AnimationConfig animation1 clip1 1000 A.Loop)+ , ('2', AnimationConfig animation2 clip2 100 A.Loop)+ , ('3', AnimationConfig animation3 clip3 100 A.Once)+ ]++-- | Start the animation specified by this config.+startAnimationFromConfig :: AnimationConfig -> EventM () St ()+startAnimationFromConfig config = do+ mgr <- use stAnimationManager+ A.startAnimation mgr (animationClip config)+ (animationFrameTime config)+ (animationMode config)+ (animationTarget config)++-- | If the animation specified in this config is not running, start it.+-- Otherwise stop it.+toggleAnimationFromConfig :: AnimationConfig -> EventM () St ()+toggleAnimationFromConfig config = do+ mgr <- use stAnimationManager+ mOld <- use (animationTarget config)+ case mOld of+ Just a -> A.stopAnimation mgr a+ Nothing -> startAnimationFromConfig config++-- | Start a new mouse click animation at the specified location if one+-- is not already running there.+startMouseClickAnimation :: Location -> EventM () St ()+startMouseClickAnimation l = do+ mgr <- use stAnimationManager+ a <- use (clickAnimations.at l)+ case a of+ Just {} -> return ()+ Nothing -> A.startAnimation mgr mouseClickClip 100 A.Once (clickAnimations.at l)++appEvent :: BrickEvent () CustomEvent -> EventM () St ()+appEvent e = do+ case e of+ -- A mouse click starts an animation at the click location.+ VtyEvent (V.EvMouseDown col row _ _) ->+ startMouseClickAnimation (Location (col, row))++ -- If we got a character keystroke, see if there is a specific+ -- animation mapped to that character and toggle the resulting+ -- animation.+ VtyEvent (V.EvKey (V.KChar c) [])+ | Just aConfig <- lookup c animations ->+ toggleAnimationFromConfig aConfig++ -- Apply a state update from the animation manager.+ AppEvent (AnimationUpdate act) -> act++ VtyEvent (V.EvKey V.KEsc []) -> halt++ _ -> return ()++theApp :: App St CustomEvent ()+theApp =+ App { appDraw = drawUI+ , appChooseCursor = neverShowCursor+ , appHandleEvent = appEvent+ , appStartEvent = return ()+ , appAttrMap = const attrs+ }++main :: IO ()+main = do+ chan <- newBChan 10+ mgr <- A.startAnimationManager 50 chan AnimationUpdate++ let initialState =+ St { _stAnimationManager = mgr+ , _animation1 = Nothing+ , _animation2 = Nothing+ , _animation3 = Nothing+ , _clickAnimations = mempty+ }+ buildVty = do+ v <- mkVty V.defaultConfig+ V.setMode (V.outputIface v) V.Mouse True+ return v++ initialVty <- buildVty+ void $ customMain initialVty buildVty (Just chan) theApp initialState
programs/BorderDemo.hs view
@@ -16,16 +16,17 @@ ( Widget ) import Brick.Widgets.Core- ( (<=>)- , (<+>)+ ( (<+>) , withAttr , vLimit , hLimit , hBox+ , vBox , updateAttrMap , withBorderStyle , txt , str+ , padLeftRight ) import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B@@ -65,20 +66,23 @@ B.borderWithLabel (str "label") $ vLimit 5 $ C.vCenter $- txt $ " " <> styleName <> " style "+ padLeftRight 2 $+ txt $ styleName <> " style" titleAttr :: A.AttrName titleAttr = A.attrName "title" -borderMappings :: [(A.AttrName, V.Attr)]-borderMappings =+attrs :: [(A.AttrName, V.Attr)]+attrs = [ (B.borderAttr, V.yellow `on` V.black)+ , (B.vBorderAttr, fg V.cyan)+ , (B.hBorderAttr, fg V.magenta) , (titleAttr, fg V.cyan) ] colorDemo :: Widget () colorDemo =- updateAttrMap (A.applyAttrMappings borderMappings) $+ updateAttrMap (A.applyAttrMappings attrs) $ B.borderWithLabel (withAttr titleAttr $ str "title") $ hLimit 20 $ vLimit 5 $@@ -87,13 +91,14 @@ ui :: Widget () ui =- hBox borderDemos- <=> B.hBorder- <=> colorDemo- <=> B.hBorderWithLabel (str "horizontal border label")- <=> (C.center (str "Left of vertical border")- <+> B.vBorder- <+> C.center (str "Right of vertical border"))+ vBox [ hBox borderDemos+ , B.hBorder+ , colorDemo+ , B.hBorderWithLabel (str "horizontal border label")+ , (C.center (str "Left of vertical border")+ <+> B.vBorder+ <+> C.center (str "Right of vertical border"))+ ] main :: IO () main = M.simpleMain ui
programs/CustomEventDemo.hs view
@@ -17,7 +17,7 @@ import Brick.Main ( App(..) , showFirstCursor- , customMain+ , customMainWithDefaultVty , halt ) import Brick.AttrMap@@ -82,6 +82,5 @@ writeBChan chan Counter threadDelay 1000000 - let buildVty = V.mkVty V.defaultConfig- initialVty <- buildVty- void $ customMain initialVty buildVty (Just chan) theApp initialState+ (_, vty) <- customMainWithDefaultVty (Just chan) theApp initialState+ V.shutdown vty
programs/DialogDemo.hs view
@@ -25,12 +25,18 @@ data Choice = Red | Blue | Green deriving Show -drawUI :: D.Dialog Choice -> [Widget ()]+data Name =+ RedButton+ | BlueButton+ | GreenButton+ deriving (Show, Eq, Ord)++drawUI :: D.Dialog Choice Name -> [Widget Name] drawUI d = [ui] where ui = D.renderDialog d $ C.hCenter $ padAll 1 $ str "This is the dialog body." -appEvent :: BrickEvent () e -> T.EventM () (D.Dialog Choice) ()+appEvent :: BrickEvent Name e -> T.EventM Name (D.Dialog Choice Name) () appEvent (VtyEvent ev) = case ev of V.EvKey V.KEsc [] -> M.halt@@ -38,12 +44,12 @@ _ -> D.handleDialogEvent ev appEvent _ = return () -initialState :: D.Dialog Choice-initialState = D.dialog (Just "Title") (Just (0, choices)) 50+initialState :: D.Dialog Choice Name+initialState = D.dialog (Just $ str "Title") (Just (RedButton, choices)) 50 where- choices = [ ("Red", Red)- , ("Blue", Blue)- , ("Green", Green)+ choices = [ ("Red", RedButton, Red)+ , ("Blue", BlueButton, Blue)+ , ("Green", GreenButton, Green) ] theMap :: A.AttrMap@@ -53,7 +59,7 @@ , (D.buttonSelectedAttr, bg V.yellow) ] -theApp :: M.App (D.Dialog Choice) e ()+theApp :: M.App (D.Dialog Choice Name) e Name theApp = M.App { M.appDraw = drawUI , M.appChooseCursor = M.showFirstCursor
+ programs/EditorLineNumbersDemo.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+module Main where++import Control.Monad (void)+import Lens.Micro+import Lens.Micro.TH+import Lens.Micro.Mtl+import qualified Graphics.Vty as V+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif++import qualified Brick.Main as M+import qualified Brick.Types as T+import Brick.Widgets.Core+ ( (<+>)+ , vBox+ , hLimit+ , vLimit+ , str+ , visible+ , viewport+ , withDefAttr+ )+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Edit as E+import qualified Brick.AttrMap as A+import Brick.Util (on, fg)++data Name = Edit+ | EditLines+ deriving (Ord, Show, Eq)++data St =+ St { _edit :: E.Editor String Name+ }++makeLenses ''St++drawUI :: St -> [T.Widget Name]+drawUI st = [ui]+ where+ e = renderWithLineNumbers (st^.edit)+ ui = C.center $ hLimit 50 $ vLimit 10 e++-- | Given an editor, render the editor with line numbers to the left of+-- the editor.+--+-- This essentially exploits knowledge of how the editor is implemented:+-- we make a viewport containing line numbers that is just as high as+-- the editor, then request that the line number associated with the+-- editor's current line position be made visible, thus scrolling it+-- into view. This is slightly brittle, however, because it relies on+-- essentially keeping the line number viewport and the editor viewport+-- in the same vertical scrolling state; with direct scrolling requests+-- from EventM it is easily possible to put the two viewports into a+-- state where they do not have the same vertical scrolling offset. That+-- means that visibility requests made with 'visible' won't necessarily+-- have the same effect in each viewport in that case. So this is+-- only really usable in the case where you're sure that the editor's+-- viewport and the line number viewports will not be managed by direct+-- viewport operations in EventM. That's what I'd recommend anyway, but+-- still, this is an important caveat.+--+-- There's another important caveat here: this particular implementation+-- has @O(n)@ performance for editor height @n@ because we generate+-- the entire list of line numbers on each rendering depending on the+-- height of the editor. That means that for sufficiently large files,+-- it will get more expensive to render the line numbers. There is a way+-- around this problem, which is to take the approach that the @List@+-- implementation takes: only render a region of visible line numbers+-- around the currently-edited line that is just large enough to be+-- guaranteed to fill the viewport, then translate that so that it+-- appears at the right viewport offset, thus faking a viewport filled+-- with line numbers when in fact we'd only ever render at most @2 * K ++-- 1@ line numbers for a viewport height of @K@. That's more involved,+-- so I didn't do it here, but that would be the way to go for a Real+-- Application.+renderWithLineNumbers :: E.Editor String Name -> T.Widget Name+renderWithLineNumbers e =+ lineNumbersVp <+> editorVp+ where+ lineNumbersVp = hLimit (maxNumWidth + 1) $ viewport EditLines T.Vertical body+ editorVp = E.renderEditor (str . unlines) True e+ body = withDefAttr lineNumberAttr $ vBox numWidgets+ numWidgets = mkNumWidget <$> numbers+ mkNumWidget i = maybeVisible i $ str $ show i+ maybeVisible i+ | i == curLine + 1 =+ visible . withDefAttr currentLineNumberAttr+ | otherwise =+ id+ numbers = [1..h]+ contents = E.getEditContents e+ h = length contents+ curLine = fst $ E.getCursorPosition e+ maxNumWidth = length $ show h++appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =+ M.halt+appEvent ev = do+ zoom edit $ E.handleEditorEvent ev++initialState :: St+initialState =+ St (E.editor Edit Nothing "")++lineNumberAttr :: A.AttrName+lineNumberAttr = A.attrName "lineNumber"++currentLineNumberAttr :: A.AttrName+currentLineNumberAttr = lineNumberAttr <> A.attrName "current"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+ [ (E.editAttr, V.white `on` V.blue)+ , (E.editFocusedAttr, V.black `on` V.yellow)+ , (lineNumberAttr, fg V.cyan)+ , (currentLineNumberAttr, V.defAttr `V.withStyle` V.bold)+ ]++theApp :: M.App St e Name+theApp =+ M.App { M.appDraw = drawUI+ , M.appChooseCursor = const $ M.showCursorNamed Edit+ , M.appHandleEvent = appEvent+ , M.appStartEvent = return ()+ , M.appAttrMap = const theMap+ }++main :: IO ()+main = do+ void $ M.defaultMain theApp initialState
programs/FormDemo.hs view
@@ -11,6 +11,8 @@ #endif import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)+ import Brick import Brick.Forms ( Form@@ -136,7 +138,7 @@ main :: IO () main = do let buildVty = do- v <- V.mkVty =<< V.standardIOConfig+ v <- mkVty V.defaultConfig V.setMode (V.outputIface v) V.Mouse True return v
programs/LayerDemo.hs view
@@ -46,8 +46,8 @@ [ C.centerLayer $ B.border $ str "This layer is centered but other\nlayers are placed underneath it." , arrowLayer- , middleLayer st- , bottomLayer st+ , middleLayer (st^.middleLayerLocation)+ , bottomLayer (st^.bottomLayerLocation) ] arrowLayer :: Widget Name@@ -59,15 +59,15 @@ withDefAttr arrowAttr $ str msg -middleLayer :: St -> Widget Name-middleLayer st =- translateBy (st^.middleLayerLocation) $+middleLayer :: Location -> Widget Name+middleLayer l =+ translateBy l $ reportExtent MiddleLayerElement $ B.border $ str "Middle layer\n(Arrow keys move)" -bottomLayer :: St -> Widget Name-bottomLayer st =- translateBy (st^.bottomLayerLocation) $+bottomLayer :: Location -> Widget Name+bottomLayer l =+ translateBy l $ B.border $ str "Bottom layer\n(Ctrl-arrow keys move)" appEvent :: T.BrickEvent Name e -> T.EventM Name St ()
programs/ProgressBarDemo.hs view
@@ -21,12 +21,13 @@ import Brick.Widgets.Core ( (<+>), (<=>) , str+ , strWrap , updateAttrMap , overrideAttr ) import Brick.Util (fg, bg, on, clamp) -data MyAppState n = MyAppState { _x, _y, _z :: Float }+data MyAppState n = MyAppState { _x, _y, _z :: Float, _showLabel :: Bool } makeLenses ''MyAppState @@ -48,13 +49,32 @@ zBar = overrideAttr P.progressCompleteAttr zDoneAttr $ overrideAttr P.progressIncompleteAttr zToDoAttr $ bar $ _z p- lbl c = Just $ show $ fromEnum $ c * 100+ -- custom bars+ cBar1 = overrideAttr P.progressCompleteAttr cDoneAttr1 $+ overrideAttr P.progressIncompleteAttr cToDoAttr1+ $ bar' '▰' '▱' $ _x p+ cBar2 = overrideAttr P.progressCompleteAttr cDoneAttr2 $+ overrideAttr P.progressIncompleteAttr cToDoAttr2+ $ bar' '|' '─' $ _y p+ cBar3 = overrideAttr P.progressCompleteAttr cDoneAttr $+ overrideAttr P.progressIncompleteAttr cToDoAttr+ $ bar' '⣿' '⠶' $ _z p+ lbl c = if _showLabel p+ then Just $ " " ++ (show $ fromEnum $ c * 100) ++ " "+ else Nothing bar v = P.progressBar (lbl v) v+ bar' cc ic v = P.customProgressBar cc ic (lbl v) v ui = (str "X: " <+> xBar) <=> (str "Y: " <+> yBar) <=> (str "Z: " <+> zBar) <=>+ (str "X: " <+> cBar1) <=>+ (str "Y: " <+> cBar2) <=>+ (str "Z: " <+> cBar3) <=> str "" <=>- str "Hit 'x', 'y', or 'z' to advance progress, or 'q' to quit"+ (strWrap $ concat [ "Hit 'x', 'y', or 'z' to advance progress,"+ , "'t' to toggle labels, 'r' to revert values, "+ , "'Ctrl + r' to reset values or 'q' to quit"+ ]) appEvent :: T.BrickEvent () e -> T.EventM () (MyAppState ()) () appEvent (T.VtyEvent e) =@@ -63,12 +83,18 @@ V.EvKey (V.KChar 'x') [] -> x %= valid . (+ 0.05) V.EvKey (V.KChar 'y') [] -> y %= valid . (+ 0.03) V.EvKey (V.KChar 'z') [] -> z %= valid . (+ 0.02)+ V.EvKey (V.KChar 't') [] -> showLabel %= not+ V.EvKey (V.KChar 'r') [V.MCtrl] -> do+ x .= 0+ y .= 0+ z .= 0+ V.EvKey (V.KChar 'r') [] -> T.put initialState V.EvKey (V.KChar 'q') [] -> M.halt _ -> return () appEvent _ = return () initialState :: MyAppState ()-initialState = MyAppState 0.25 0.18 0.63+initialState = MyAppState 0.25 0.18 0.63 True theBaseAttr :: A.AttrName theBaseAttr = A.attrName "theBase"@@ -85,6 +111,18 @@ zDoneAttr = theBaseAttr <> A.attrName "Z:done" zToDoAttr = theBaseAttr <> A.attrName "Z:remaining" +cDoneAttr, cToDoAttr :: A.AttrName+cDoneAttr = A.attrName "C:done"+cToDoAttr = A.attrName "C:remaining"++cDoneAttr1, cToDoAttr1 :: A.AttrName+cDoneAttr1 = A.attrName "C1:done"+cToDoAttr1 = A.attrName "C1:remaining"++cDoneAttr2, cToDoAttr2 :: A.AttrName+cDoneAttr2 = A.attrName "C2:done"+cToDoAttr2 = A.attrName "C2:remaining"+ theMap :: A.AttrMap theMap = A.attrMap V.defAttr [ (theBaseAttr, bg V.brightBlack)@@ -93,6 +131,12 @@ , (yDoneAttr, V.magenta `on` V.yellow) , (zDoneAttr, V.blue `on` V.green) , (zToDoAttr, V.blue `on` V.red)+ , (cDoneAttr, fg V.blue)+ , (cToDoAttr, fg V.blue)+ , (cDoneAttr1, fg V.red)+ , (cToDoAttr1, fg V.brightWhite)+ , (cDoneAttr2, fg V.green)+ , (cToDoAttr2, fg V.brightGreen) , (P.progressIncompleteAttr, fg V.yellow) ]
+ programs/TabularListDemo.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+module Main where++import Lens.Micro ((^.))+import Lens.Micro.Mtl+import Lens.Micro.TH+import Control.Monad (void)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Graphics.Vty as V++import qualified Brick.Main as M+import qualified Brick.Types as T+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.List as L+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Table as Table+import qualified Brick.AttrMap as A+import qualified Data.Vector as Vec+import Brick.Types+ ( Widget+ )+import Brick.Widgets.Core+ ( (<=>)+ , str+ , vLimit+ , hLimit+ , vBox+ , hBox+ , withDefAttr+ )+import Brick.Util (on)++data Row = Row String String String++data AppState =+ AppState { _tabularList :: L.List () Row+ , _colIndex :: Int+ }++makeLenses ''AppState++drawUI :: AppState -> [Widget ()]+drawUI s = [ui]+ where+ l = s^.tabularList+ label = str $ "Row " <> cur <> " / col " <> show (s^.colIndex + 1)+ cur = case l^.(L.listSelectedL) of+ Nothing -> "-"+ Just i -> show (i + 1)+ box = B.borderWithLabel label $+ hLimit totalWidth $+ vLimit 15 $+ listDrawElement 0 False headerRow <=>+ L.renderList (listDrawElement (s^.colIndex)) True l+ ui = C.vCenter $ vBox [ C.hCenter box+ , str " "+ , C.hCenter $ str "Press +/- to add/remove list elements."+ , C.hCenter $ str "Use arrow keys to change selection."+ , C.hCenter $ str "Press Esc to exit."+ ]++appEvent :: T.BrickEvent () e -> T.EventM () AppState ()+appEvent (T.VtyEvent e) =+ case e of+ V.EvKey (V.KChar '+') [] -> do+ els <- use (tabularList.L.listElementsL)+ let el = Row (show pos) (show $ pos * 3) (show $ pos * 9)+ pos = Vec.length els+ tabularList %= L.listInsert pos el++ V.EvKey (V.KChar '-') [] -> do+ sel <- use (tabularList.L.listSelectedL)+ case sel of+ Nothing -> return ()+ Just i -> tabularList %= L.listRemove i++ V.EvKey V.KLeft [] ->+ colIndex %= (\i -> max 0 (i - 1))+ V.EvKey V.KRight [] ->+ colIndex %= (\i -> min (length columnAlignments - 1) (i + 1))++ V.EvKey V.KEsc [] -> M.halt++ ev -> T.zoom tabularList $ L.handleListEvent ev+appEvent _ = return ()++listDrawElement :: Int -> Bool -> Row -> Widget ()+listDrawElement colIdx sel (Row a b c) =+ let ws = [str a, str b, str c]+ maybeSelect es = selectCell <$> zip [0..] es+ selectCell (i, w) = if sel && i == colIdx+ then withDefAttr selectedCellAttr w+ else w+ in hLimit totalWidth $+ hBox $+ maybeSelect $+ Table.alignColumns columnAlignments columnWidths ws++initialState :: AppState+initialState =+ AppState { _tabularList = L.list () (Vec.fromList initialRows) 1+ , _colIndex = 0+ }++selectedCellAttr :: A.AttrName+selectedCellAttr = A.attrName "selectedCell"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+ [ (L.listAttr, V.white `on` V.blue)+ , (selectedCellAttr, V.blue `on` V.white)+ ]++columnWidths :: [Int]+columnWidths = [10, 15, 20]++totalWidth :: Int+totalWidth = sum columnWidths++headerRow :: Row+headerRow = Row "Col 1" "Col 2" "Col 3"++columnAlignments :: [Table.ColumnAlignment]+columnAlignments = [Table.AlignLeft, Table.AlignCenter, Table.AlignRight]++initialRows :: [Row]+initialRows =+ [ Row "one" "two" "three"+ , Row "foo" "bar" "baz"+ , Row "stuff" "things" "blah"+ ]++theApp :: M.App AppState e ()+theApp =+ M.App { M.appDraw = drawUI+ , M.appChooseCursor = M.showFirstCursor+ , M.appHandleEvent = appEvent+ , M.appStartEvent = return ()+ , M.appAttrMap = const theMap+ }++main :: IO ()+main = void $ M.defaultMain theApp initialState
programs/TailDemo.hs view
@@ -142,11 +142,10 @@ main :: IO () main = do- cfg <- V.standardIOConfig- vty <- V.mkVty cfg chan <- newBChan 10 -- Run thread to simulate incoming data void $ forkIO $ generateLines chan - void $ customMain vty (V.mkVty cfg) (Just chan) app initialState+ (_, vty) <- customMainWithDefaultVty (Just chan) app initialState+ V.shutdown vty
programs/ThemeDemo.hs view
@@ -71,7 +71,7 @@ , appStartEvent = return () , appAttrMap = \s -> -- Note that in practice this is not ideal: we don't want- -- to build an attribute from a theme every time this is+ -- to build an attribute map from a theme every time this is -- invoked, because it gets invoked once per redraw. Instead -- we'd build the attribute map at startup and store it in -- the application state. Here I just use themeToAttrMap to
programs/ViewportScrollbarsDemo.hs view
@@ -10,6 +10,7 @@ import Data.Monoid ((<>)) #endif import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty) import qualified Brick.Types as T import qualified Brick.Main as M@@ -41,23 +42,35 @@ , withVScrollBars , withHScrollBars , withHScrollBarRenderer+ , withVScrollBarRenderer , withVScrollBarHandles , withHScrollBarHandles , withClickableHScrollBars , withClickableVScrollBars- , ScrollbarRenderer(..)+ , VScrollbarRenderer(..)+ , HScrollbarRenderer(..) , scrollbarAttr , scrollbarHandleAttr ) -customScrollbars :: ScrollbarRenderer n-customScrollbars =- ScrollbarRenderer { renderScrollbar = fill '^'- , renderScrollbarTrough = fill ' '- , renderScrollbarHandleBefore = str "<<"- , renderScrollbarHandleAfter = str ">>"- }+customHScrollbars :: HScrollbarRenderer n+customHScrollbars =+ HScrollbarRenderer { renderHScrollbar = vLimit 1 $ fill '^'+ , renderHScrollbarTrough = vLimit 1 $ fill ' '+ , renderHScrollbarHandleBefore = str "<<"+ , renderHScrollbarHandleAfter = str ">>"+ , scrollbarHeightAllocation = 2+ } +customVScrollbars :: VScrollbarRenderer n+customVScrollbars =+ VScrollbarRenderer { renderVScrollbar = C.hCenter $ hLimit 1 $ fill '*'+ , renderVScrollbarTrough = fill ' '+ , renderVScrollbarHandleBefore = C.hCenter $ str "-^-"+ , renderVScrollbarHandleAfter = C.hCenter $ str "-v-"+ , scrollbarWidthAllocation = 5+ }+ data Name = VP1 | VP2 | SBClick T.ClickableScrollbarElement Name deriving (Ord, Show, Eq) @@ -68,7 +81,7 @@ drawUi :: St -> [Widget Name] drawUi st = [ui] where- ui = C.center $ hLimit 70 $ vLimit 21 $+ ui = C.center $ hLimit 80 $ vLimit 21 $ (vBox [ pair , C.hCenter (str "Last clicked scroll bar element:") , str $ show $ _lastClickedElement st@@ -77,7 +90,7 @@ B.border $ withClickableHScrollBars SBClick $ withHScrollBars OnBottom $- withHScrollBarRenderer customScrollbars $+ withHScrollBarRenderer customHScrollbars $ withHScrollBarHandles $ viewport VP1 Horizontal $ str $ "Press left and right arrow keys to scroll this viewport.\n" <>@@ -86,9 +99,18 @@ , B.border $ withClickableVScrollBars SBClick $ withVScrollBars OnLeft $+ withVScrollBarRenderer customVScrollbars $ withVScrollBarHandles $ viewport VP2 Both $- vBox $ str "Press ctrl-arrow keys to scroll this viewport horizontally and vertically."+ vBox $+ (str $ unlines $+ [ "Press up and down arrow keys to"+ , "scroll this viewport vertically."+ , "This viewport uses a custom"+ , "scroll bar renderer with"+ , "a larger space allocation and"+ , "even more fancy rendering."+ ]) : (str <$> [ "Line " <> show i | i <- [2..55::Int] ]) ] @@ -105,6 +127,7 @@ appEvent (T.VtyEvent (V.EvKey V.KUp [])) = M.vScrollBy vp2Scroll (-1) appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt appEvent (T.MouseDown (SBClick el n) _ _ _) = do+ lastClickedElement .= Just (el, n) case n of VP1 -> do let vp = M.viewportScroll VP1@@ -124,8 +147,6 @@ T.SBBar -> return () _ -> return ()-- lastClickedElement .= Just (el, n) appEvent _ = return () theme :: AttrMap@@ -147,7 +168,7 @@ main :: IO () main = do let buildVty = do- v <- V.mkVty =<< V.standardIOConfig+ v <- mkVty V.defaultConfig V.setMode (V.outputIface v) V.Mouse True return v
+ src/Brick/Animation.hs view
@@ -0,0 +1,588 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+-- | This module provides some infrastructure for adding animations to+-- Brick applications. See @programs/AnimationDemo.hs@ for a complete+-- working example of this API.+--+-- At a high level, this works as follows:+--+-- This module provides a threaded animation manager that manages a set+-- of running animations. The application creates the manager and starts+-- animations, which automatically loop or run once, depending on their+-- configuration. Each animation has some state in the application's+-- state that is automatically managed by the animation manager using a+-- lens-based API. Whenever animations need to be redrawn, the animation+-- manager sends a custom event with a state update to the application,+-- which must be evaluated by the main event loop to update animation+-- states. Each animation is associated with a 'Clip' -- sequence of+-- frames -- which may be static or may be built from the application+-- state at rendering time.+--+-- To use this module:+--+-- * Use a custom event type @e@ in your 'Brick.Main.App' and give the+-- event type a constructor @EventM n s () -> e@ (where @s@ and+-- @n@ are those in @App s e n@). This will require the use of+-- 'Brick.Main.customMain' and will also require the creation of a+-- 'Brick.BChan.BChan' for custom events.+--+-- * Add an 'AnimationManager' field to the application state @s@.+--+-- * Create an 'AnimationManager' at startup with+-- 'startAnimationManager', providing the custom event constructor and+-- 'BChan' created above. Store the manager in the application state.+--+-- * For each animation you want to run at any given time, add a field+-- to the application state of type @Maybe (Animation s n)@,+-- initialized to 'Nothing'. A value of 'Nothing' indicates that the+-- animation is not running.+--+-- * Ensure that each animation state field in @s@ has a lens, usually+-- by using 'Lens.Micro.TH.makeLenses'.+--+-- * Start new animations in 'EventM' with 'startAnimation'; stop them+-- with 'stopAnimation'. Supply clips for new animations with+-- 'newClip', 'newClip_', and the clip transformation functions.+--+-- * Call 'renderAnimation' in 'Brick.Main.appDraw' for each animation in the+-- application state.+--+-- * If needed, stop the animation manager with 'stopAnimationManager'.+--+-- See 'AnimationManager' and the docs for the rest of this module for+-- details.+module Brick.Animation+ ( -- * Animation managers+ AnimationManager+ , startAnimationManager+ , stopAnimationManager+ , minTickTime++ -- * Animations+ , Animation+ , animationFrameIndex++ -- * Starting and stopping animations+ , RunMode(..)+ , startAnimation+ , stopAnimation++ -- * Rendering animations+ , renderAnimation++ -- * Creating clips+ , Clip+ , newClip+ , newClip_+ , clipLength++ -- * Transforming clips+ , pingPongClip+ , reverseClip+ )+where++import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread, myThreadId)+import qualified Control.Concurrent.STM as STM+import Control.Monad (forever, when)+import Control.Monad.State.Strict+import Data.Foldable (foldrM)+import Data.Hashable (Hashable)+import qualified Data.HashMap.Strict as HM+import Data.Maybe (fromMaybe)+import qualified Data.Vector as V+import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just)+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl++import Brick.BChan+import Brick.Types (EventM, Widget)+import qualified Brick.Animation.Clock as C++-- | A sequence of a animation frames.+newtype Clip s n = Clip (V.Vector (s -> Widget n))+ deriving (Semigroup)++-- | Get the number of frames in a clip.+clipLength :: Clip s n -> Int+clipLength (Clip fs) = V.length fs++-- | Build a clip.+--+-- Each frame in a clip is represented by a function from a state to a+-- 'Widget'. This allows applications to determine on a per-frame basis+-- what should be drawn in an animation based on application state, if+-- desired, in the same style as 'Brick.Main.appDraw'.+--+-- If the provided list is empty, this calls 'error'.+newClip :: [s -> Widget n] -> Clip s n+newClip [] = error "clip: got an empty list"+newClip fs = Clip $ V.fromList fs++-- | Like 'newClip' but for static frames.+newClip_ :: [Widget n] -> Clip s n+newClip_ ws = newClip $ const <$> ws++-- | Extend a clip so that when the end of the original clip is reached,+-- it continues in reverse order to create a loop.+--+-- For example, if this is given a clip with frames A, B, C, and D, then+-- this returns a clip with frames A, B, C, D, C, and B.+--+-- If the given clip contains less than two frames, this is equivalent+-- to 'id'.+pingPongClip :: Clip s n -> Clip s n+pingPongClip (Clip fs) | V.length fs >= 2 =+ Clip $ fs <> V.reverse (V.init $ V.tail fs)+pingPongClip c = c++-- | Reverse a clip.+reverseClip :: Clip s n -> Clip s n+reverseClip (Clip fs) = Clip $ V.reverse fs++data AnimationManagerRequest s n =+ Tick C.Time+ | StartAnimation (Clip s n) Integer RunMode (Traversal' s (Maybe (Animation s n)))+ -- ^ Clip, frame duration in milliseconds, run mode, updater+ | StopAnimation (Animation s n)+ | Shutdown++-- | The running mode for an animation.+data RunMode =+ Once+ -- ^ Run the animation once and then end+ | Loop+ -- ^ Run the animation in a loop forever+ deriving (Eq, Show, Ord)++newtype AnimationID = AnimationID Int+ deriving (Eq, Ord, Show, Hashable)++-- | The state of a running animation.+--+-- Put one of these (wrapped in 'Maybe') in your application state for+-- each animation that you'd like to run concurrently.+data Animation s n =+ Animation { animationFrameIndex :: Int+ -- ^ The animation's current frame index, provided for+ -- convenience. Applications won't need to access this in+ -- most situations; use 'renderAnimation' instead.+ , animationID :: AnimationID+ -- ^ The animation's internally-managed ID+ , animationClip :: Clip s n+ -- ^ The animation's clip+ }++-- | Render an animation.+renderAnimation :: (s -> Widget n)+ -- ^ The fallback function to use for drawing if the+ -- animation is not running+ -> s+ -- ^ The state to provide when rendering the animation's+ -- current frame+ -> Maybe (Animation s n)+ -- ^ The animation state itself+ -> Widget n+renderAnimation fallback input mAnim =+ draw input+ where+ draw = fromMaybe fallback $ do+ a <- mAnim+ let idx = animationFrameIndex a+ Clip fs = animationClip a+ fs V.!? idx++data AnimationState s n =+ AnimationState { _animationStateID :: AnimationID+ , _animationNumFrames :: Int+ , _animationCurrentFrame :: Int+ , _animationFrameMilliseconds :: Integer+ , _animationRunMode :: RunMode+ , animationFrameUpdater :: Traversal' s (Maybe (Animation s n))+ , _animationNextFrameTime :: C.Time+ }++makeLenses ''AnimationState++-- | A manager for animations. The type variables for this type are the+-- same as those for 'Brick.Main.App'.+--+-- This asynchronously manages a set of running animations, advancing+-- each one over time. When a running animation's current frame needs+-- to be changed, the manager sends an 'EventM' update for that+-- animation to the application's event loop to perform the update to+-- the animation in the application state. The manager will batch such+-- updates if more than one animation needs to be changed at a time.+--+-- The manager has a /tick duration/ in milliseconds which is the+-- resolution at which animations are checked to see if they should+-- be updated. Animations also have their own frame duration in+-- milliseconds. For example, if a manager has a tick duration of 50+-- milliseconds and is running an animation with a frame duration of 100+-- milliseconds, then the manager will advance that animation by one+-- frame every two ticks. On the other hand, if a manager has a tick+-- duration of 100 milliseconds and is running an animation with a frame+-- duration of 50 milliseconds, the manager will advance that animation+-- by two frames on each tick.+--+-- Animation managers are started with 'startAnimationManager' and+-- stopped with 'stopAnimationManager'.+--+-- Animations are started with 'startAnimation' and stopped with+-- 'stopAnimation'. Each animation must be associated with an+-- application state field accessible with a traversal given to+-- 'startAnimation'.+--+-- When an animation is started, every time it advances a frame, and+-- when it is ended, the manager communicates these changes to the+-- application by using the custom event constructor provided to+-- 'startAnimationManager'. The manager uses that to schedule a state+-- update which the application is responsible for evaluating. The state+-- updates are built from the traversals provided to 'startAnimation'.+--+-- The manager-updated 'Animation' values in the application state are+-- then drawn with 'renderAnimation'.+--+-- Animations in 'Loop' mode are run forever until stopped with+-- 'stopAnimation'; animations in 'Once' mode run once and are removed+-- from the application state (set to 'Nothing') when they finish. All+-- state updates to the application state are performed by the manager's+-- custom event mechanism; the application never needs to directly+-- modify the 'Animation' application state fields except to initialize+-- them to 'Nothing'.+--+-- There is nothing here to prevent an application from running multiple+-- managers, each at a different tick rate. That may have performance+-- consequences, though, due to the loss of batch efficiency in state+-- updates, so we recommend using only one manager per application at a+-- sufficiently short tick duration.+data AnimationManager s e n =+ AnimationManager { animationMgrRequestThreadId :: ThreadId+ , animationMgrTickThreadId :: ThreadId+ , animationMgrOutputChan :: BChan e+ , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s n)+ , animationMgrEventConstructor :: EventM n s () -> e+ , animationMgrRunning :: STM.TVar Bool+ }++tickThreadBody :: Int+ -> STM.TChan (AnimationManagerRequest s n)+ -> IO ()+tickThreadBody tickMilliseconds outChan = do+ let nextTick = C.addOffset tickOffset+ tickOffset = C.offsetFromMs $ toInteger tickMilliseconds+ go targetTime = do+ now <- C.getTime+ STM.atomically $ STM.writeTChan outChan $ Tick now++ -- threadDelay does not guarantee that we will wake up on+ -- time; it only ensures that we won't wake up earlier than+ -- requested. Since we can therefore oversleep, instead of+ -- always sleeping for tickMilliseconds (which would cause+ -- us to drift off of schedule as delays accumulate) we+ -- determine sleep time by measuring the distance between+ -- now and the next scheduled tick. This is still unreliable+ -- as we can still oversleep, but it keeps the oversleeping+ -- under control over time. It means most ticks may be+ -- slightly late (about 1-2 milliseconds is common) but this+ -- will prevent that per-tick error from accumulating.+ let nextTickTime = nextTick targetTime+ sleepMs = fromInteger $+ C.offsetToMs $+ C.subtractTime nextTickTime now++ -- threadDelay works microseconds.+ threadDelay $ sleepMs * 1000+ go nextTickTime++ go =<< C.getTime++setNextFrameTime :: C.Time -> AnimationState s n -> AnimationState s n+setNextFrameTime t a = a & animationNextFrameTime .~ t++data ManagerState s e n =+ ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s n)+ , _managerStateOutChan :: BChan e+ , _managerStateEventBuilder :: EventM n s () -> e+ , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s n)+ , _managerStateIDVar :: STM.TVar AnimationID+ }++makeLenses ''ManagerState++animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s n)+ -> BChan e+ -> (EventM n s () -> e)+ -> IO ()+animationManagerThreadBody inChan outChan mkEvent = do+ idVar <- STM.newTVarIO $ AnimationID 1+ let initial = ManagerState { _managerStateInChan = inChan+ , _managerStateOutChan = outChan+ , _managerStateEventBuilder = mkEvent+ , _managerStateAnimations = mempty+ , _managerStateIDVar = idVar+ }+ evalStateT runManager initial++type ManagerM s e n a = StateT (ManagerState s e n) IO a++getNextManagerRequest :: ManagerM s e n (AnimationManagerRequest s n)+getNextManagerRequest = do+ inChan <- use managerStateInChan+ liftIO $ STM.atomically $ STM.readTChan inChan++sendApplicationStateUpdate :: EventM n s () -> ManagerM s e n ()+sendApplicationStateUpdate act = do+ outChan <- use managerStateOutChan+ mkEvent <- use managerStateEventBuilder+ liftIO $ writeBChan outChan $ mkEvent act++removeAnimation :: AnimationID -> ManagerM s e n ()+removeAnimation aId =+ managerStateAnimations %= HM.delete aId++lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (AnimationState s n))+lookupAnimation aId =+ HM.lookup aId <$> use managerStateAnimations++insertAnimation :: AnimationState s n -> ManagerM s e n ()+insertAnimation a =+ managerStateAnimations %= HM.insert (a^.animationStateID) a++getNextAnimationID :: ManagerM s e n AnimationID+getNextAnimationID = do+ var <- use managerStateIDVar+ liftIO $ STM.atomically $ do+ AnimationID i <- STM.readTVar var+ let next = AnimationID $ i + 1+ STM.writeTVar var next+ return $ AnimationID i++runManager :: ManagerM s e n ()+runManager = forever $ do+ getNextManagerRequest >>= handleManagerRequest++handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n ()+handleManagerRequest (StartAnimation clip frameMs runMode updater) = do+ aId <- getNextAnimationID+ now <- liftIO C.getTime+ let next = C.addOffset frameOffset now+ frameOffset = C.offsetFromMs frameMs+ a = AnimationState { _animationStateID = aId+ , _animationNumFrames = clipLength clip+ , _animationCurrentFrame = 0+ , _animationFrameMilliseconds = frameMs+ , _animationRunMode = runMode+ , animationFrameUpdater = updater+ , _animationNextFrameTime = next+ }++ insertAnimation a+ sendApplicationStateUpdate $ updater .= Just (Animation { animationID = aId+ , animationFrameIndex = 0+ , animationClip = clip+ })+handleManagerRequest (StopAnimation a) = do+ let aId = animationID a+ mA <- lookupAnimation aId+ case mA of+ Nothing -> return ()+ Just aState -> do+ -- Remove the animation from the manager+ removeAnimation aId++ -- Set the current animation state in the application state+ -- to none+ sendApplicationStateUpdate $ clearStateAction aState+handleManagerRequest Shutdown = do+ as <- HM.elems <$> use managerStateAnimations++ let updater = sequence_ $ clearStateAction <$> as+ when (not $ null as) $ do+ sendApplicationStateUpdate updater++ liftIO $ myThreadId >>= killThread+handleManagerRequest (Tick tickTime) = do+ -- Check all animation states for frame advances+ -- based on the relationship between the tick time+ -- and each animation's next frame time+ mUpdateAct <- checkAnimations tickTime+ case mUpdateAct of+ Nothing -> return ()+ Just act -> sendApplicationStateUpdate act++clearStateAction :: AnimationState s n -> EventM n s ()+clearStateAction a = animationFrameUpdater a .= Nothing++frameUpdateAction :: AnimationState s n -> EventM n s ()+frameUpdateAction a =+ animationFrameUpdater a._Just %=+ (\an -> an { animationFrameIndex = a^.animationCurrentFrame })++updateAnimationState :: C.Time -> AnimationState s n -> AnimationState s n+updateAnimationState now a =+ let differenceMs = C.offsetToMs $+ C.subtractTime now (a^.animationNextFrameTime)+ numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds))+ newNextTime = C.addOffset (C.offsetFromMs $ numFrames * (a^.animationFrameMilliseconds))+ (a^.animationNextFrameTime)++ -- The new frame is obtained by advancing from the current frame by+ -- numFrames.+ in setNextFrameTime newNextTime $ advanceBy numFrames a++checkAnimations :: C.Time -> ManagerM s e n (Maybe (EventM n s ()))+checkAnimations now = do+ let go a updaters = do+ result <- checkAnimation now a+ return $ case result of+ Nothing -> updaters+ Just u -> u : updaters++ anims <- use managerStateAnimations+ updaters <- foldrM go [] anims++ case updaters of+ [] -> return Nothing+ _ -> return $ Just $ sequence_ updaters++-- For each active animation, check to see if the animation's next frame+-- time has passed. If it has, advance its frame counter as appropriate+-- and schedule its frame index to be updated in the application state.+checkAnimation :: C.Time -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ()))+checkAnimation now a+ | isFinished a = do+ -- This animation completed in a previous check, so clear it+ -- from the manager and the application state.+ removeAnimation (a^.animationStateID)+ return $ Just $ clearStateAction a+ | (now < a^.animationNextFrameTime) =+ -- This animation is not due for an update, so don't do+ -- anything.+ return Nothing+ | otherwise = do+ -- This animation is still running, so determine how many frames+ -- have elapsed for it and then advance the frame index based+ -- the elapsed time. Also set its next frame time.+ let a' = updateAnimationState now a+ managerStateAnimations %= HM.insert (a'^.animationStateID) a'+ return $ Just $ frameUpdateAction a'++isFinished :: AnimationState s n -> Bool+isFinished a =+ case a^.animationRunMode of+ Once -> a^.animationCurrentFrame == a^.animationNumFrames - 1+ Loop -> False++advanceBy :: Integer -> AnimationState s n -> AnimationState s n+advanceBy n a+ | n <= 0 = a+ | otherwise =+ advanceBy (n - 1) $+ advanceByOne a++advanceByOne :: AnimationState s n -> AnimationState s n+advanceByOne a =+ if a^.animationCurrentFrame == a^.animationNumFrames - 1+ then case a^.animationRunMode of+ Loop -> a & animationCurrentFrame .~ 0+ Once -> a+ else a & animationCurrentFrame %~ (+ 1)++-- | The minimum tick duration in milliseconds allowed by+-- 'startAnimationManager'.+minTickTime :: Int+minTickTime = 25++-- | Start a new animation manager. For full details about how managers+-- work, see 'AnimationManager'.+--+-- If the specified tick duration is less than 'minTickTime', this will+-- call 'error'. This bound is in place to prevent API misuse leading to+-- ticking so fast that the terminal can't keep up with redraws.+startAnimationManager :: (MonadIO m)+ => Int+ -- ^ The tick duration for this manager in milliseconds+ -> BChan e+ -- ^ The event channel to use to send updates to+ -- the application (i.e. the same one given to+ -- e.g. 'Brick.Main.customVty')+ -> (EventM n s () -> e)+ -- ^ A constructor for building custom events+ -- that perform application state updates. The+ -- application must evaluate these custom events'+ -- 'EventM' actions in order to record animation+ -- updates in the application state.+ -> m (AnimationManager s e n)+startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickTime =+ error $ "startAnimationManager: tick duration too small (minimum is " <> show minTickTime <> ")"+startAnimationManager tickMilliseconds outChan mkEvent = liftIO $ do+ inChan <- STM.newTChanIO+ reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent+ tickTid <- forkIO $ tickThreadBody tickMilliseconds inChan+ runningVar <- STM.newTVarIO True+ return $ AnimationManager { animationMgrRequestThreadId = reqTid+ , animationMgrTickThreadId = tickTid+ , animationMgrEventConstructor = mkEvent+ , animationMgrOutputChan = outChan+ , animationMgrInputChan = inChan+ , animationMgrRunning = runningVar+ }++-- | Execute the specified action only when this manager is running.+whenRunning :: (MonadIO m) => AnimationManager s e n -> IO () -> m ()+whenRunning mgr act = do+ running <- liftIO $ STM.atomically $ STM.readTVar (animationMgrRunning mgr)+ when running $ liftIO act++-- | Stop the animation manager, ending all running animations.+stopAnimationManager :: (MonadIO m) => AnimationManager s e n -> m ()+stopAnimationManager mgr =+ whenRunning mgr $ do+ tellAnimationManager mgr Shutdown+ killThread $ animationMgrTickThreadId mgr+ STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False++-- | Send a request to an animation manager.+tellAnimationManager :: (MonadIO m)+ => AnimationManager s e n+ -- ^ The manager+ -> AnimationManagerRequest s n+ -- ^ The request to send+ -> m ()+tellAnimationManager mgr req =+ liftIO $+ STM.atomically $+ STM.writeTChan (animationMgrInputChan mgr) req++-- | Start a new animation at its first frame.+--+-- This will result in an application state update to initialize the+-- animation state at the provided traversal's location.+startAnimation :: (MonadIO m)+ => AnimationManager s e n+ -- ^ The manager to run the animation+ -> Clip s n+ -- ^ The frames for the animation+ -> Integer+ -- ^ The animation's frame duration in milliseconds+ -> RunMode+ -- ^ The animation's run mode+ -> Traversal' s (Maybe (Animation s n))+ -- ^ Where in the application state to manage this+ -- animation's state+ -> m ()+startAnimation mgr frames frameMs runMode updater =+ tellAnimationManager mgr $ StartAnimation frames frameMs runMode updater++-- | Stop an animation.+--+-- This will result in an application state update to remove the+-- animation state.+stopAnimation :: (MonadIO m)+ => AnimationManager s e n+ -> Animation s n+ -> m ()+stopAnimation mgr a =+ tellAnimationManager mgr $ StopAnimation a
+ src/Brick/Animation/Clock.hs view
@@ -0,0 +1,64 @@+-- | This module provides an API for working with+-- 'Data.Time.Clock.System.SystemTime' values similar to that of+-- 'Data.Time.Clock.UTCTime'. @SystemTime@s are more efficient to+-- obtain than @UTCTime@s, which is important to avoid animation+-- tick thread delays associated with expensive clock reads. In+-- addition, the @UTCTime@-based API provides unpleasant @Float@-based+-- conversions. Since the @SystemTime@-based API doesn't provide some+-- of the operations we need, and since it is easier to work with at+-- millisecond granularity, it is extended here for internal use.+module Brick.Animation.Clock+ ( Time+ , getTime+ , addOffset+ , subtractTime++ , Offset+ , offsetFromMs+ , offsetToMs+ )+where++import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Data.Time.Clock.System as C++newtype Time = Time C.SystemTime+ deriving (Ord, Eq)++-- | Signed difference in milliseconds+newtype Offset = Offset Integer+ deriving (Ord, Eq)++offsetFromMs :: Integer -> Offset+offsetFromMs = Offset++offsetToMs :: Offset -> Integer+offsetToMs (Offset ms) = ms++getTime :: (MonadIO m) => m Time+getTime = Time <$> liftIO C.getSystemTime++addOffset :: Offset -> Time -> Time+addOffset (Offset ms) (Time (C.MkSystemTime s ns)) =+ Time $ C.MkSystemTime (fromInteger s') (fromInteger ns')+ where+ -- Note that due to the behavior of divMod, this works even when+ -- the offset is negative: the number of seconds is decremented+ -- and the remainder of nanoseconds is correct.+ s' = newSec + toInteger s+ (newSec, ns') = (nsPerMs * ms + toInteger ns)+ `divMod` (msPerS * nsPerMs)++subtractTime :: Time -> Time -> Offset+subtractTime t1 t2 = Offset $ timeToMs t1 - timeToMs t2++timeToMs :: Time -> Integer+timeToMs (Time (C.MkSystemTime s ns)) =+ (toInteger s) * msPerS ++ (toInteger ns) `div` nsPerMs++nsPerMs :: Integer+nsPerMs = 1000000++msPerS :: Integer+msPerS = 1000
src/Brick/AttrMap.hs view
@@ -27,6 +27,7 @@ -- * Construction , attrMap , forceAttrMap+ , forceAttrMapAllowStyle , attrName -- * Inspection , attrNameComponents@@ -78,6 +79,7 @@ -- | An attribute map which maps 'AttrName' values to 'Attr' values. data AttrMap = AttrMap Attr (M.Map AttrName Attr) | ForceAttr Attr+ | ForceAttrAllowStyle Attr AttrMap deriving (Show, Generic, NFData) -- | Create an attribute name from a string.@@ -103,6 +105,11 @@ forceAttrMap :: Attr -> AttrMap forceAttrMap = ForceAttr +-- | Create an attribute map in which all lookups map to the same+-- attribute. This is functionally equivalent to @attrMap attr []@.+forceAttrMapAllowStyle :: Attr -> AttrMap -> AttrMap+forceAttrMapAllowStyle = ForceAttrAllowStyle+ -- | Given an attribute and a map, merge the attribute with the map's -- default attribute. If the map is forcing all lookups to a specific -- attribute, the forced attribute is returned without merging it with@@ -122,6 +129,7 @@ -- @ mergeWithDefault :: Attr -> AttrMap -> Attr mergeWithDefault _ (ForceAttr a) = a+mergeWithDefault _ (ForceAttrAllowStyle f _) = f mergeWithDefault a (AttrMap d _) = combineAttrs d a -- | Look up the specified attribute name in the map. Map lookups@@ -148,6 +156,12 @@ -- @ attrMapLookup :: AttrName -> AttrMap -> Attr attrMapLookup _ (ForceAttr a) = a+attrMapLookup a (ForceAttrAllowStyle forced m) =+ -- Look up the attribute in the contained map, then keep only its+ -- style.+ let result = attrMapLookup a m+ in forced { attrStyle = attrStyle forced `combineStyles` attrStyle result+ } attrMapLookup (AttrName []) (AttrMap theDefault _) = theDefault attrMapLookup (AttrName ns) (AttrMap theDefault m) = let results = mapMaybe (\n -> M.lookup (AttrName n) m) (inits ns)@@ -156,11 +170,14 @@ -- | Set the default attribute value in an attribute map. setDefaultAttr :: Attr -> AttrMap -> AttrMap setDefaultAttr _ (ForceAttr a) = ForceAttr a+setDefaultAttr newDefault (ForceAttrAllowStyle a m) =+ ForceAttrAllowStyle a (setDefaultAttr newDefault m) setDefaultAttr newDefault (AttrMap _ m) = AttrMap newDefault m -- | Get the default attribute value in an attribute map. getDefaultAttr :: AttrMap -> Attr getDefaultAttr (ForceAttr a) = a+getDefaultAttr (ForceAttrAllowStyle _ m) = getDefaultAttr m getDefaultAttr (AttrMap d _) = d combineAttrs :: Attr -> Attr -> Attr@@ -185,6 +202,7 @@ applyAttrMappings :: [(AttrName, Attr)] -> AttrMap -> AttrMap applyAttrMappings _ (ForceAttr a) = ForceAttr a applyAttrMappings ms (AttrMap d m) = AttrMap d ((M.fromList ms) `M.union` m)+applyAttrMappings ms (ForceAttrAllowStyle a m) = ForceAttrAllowStyle a (applyAttrMappings ms m) -- | Update an attribute map such that a lookup of 'ontoName' returns -- the attribute value specified by 'fromName'. This is useful for
src/Brick/BorderMap.hs view
@@ -17,7 +17,9 @@ ) where import Brick.Types.Common (Edges(..), Location(..), eTopL, eBottomL, eRightL, eLeftL, origin)+#if !(MIN_VERSION_base(4,18,0)) import Control.Applicative (liftA2)+#endif import Data.IMap (IMap, Run(Run)) import GHC.Generics import Control.DeepSeq
src/Brick/Focus.hs view
@@ -25,6 +25,7 @@ -- | A focus ring containing a sequence of resource names to focus and a -- currently-focused name. newtype FocusRing n = FocusRing (C.CList n)+ deriving (Show) -- | Construct a focus ring from the list of resource names. focusRing :: [n] -> FocusRing n
src/Brick/Forms.hs view
@@ -49,6 +49,7 @@ Form , FormFieldState(..) , FormField(..)+ , FormFieldVisibilityMode(..) -- * Creating and using forms , newForm@@ -65,6 +66,7 @@ , setFieldConcat , setFormFocus , updateFormState+ , setFieldVisibilityMode -- * Simple form field constructors , editTextField@@ -145,6 +147,21 @@ -- ^ An event handler for this field. } +-- | How to bring form fields into view when a form is rendered in a+-- viewport with 'viewport'.+data FormFieldVisibilityMode =+ ShowFocusedFieldOnly+ -- ^ Make only the focused field's selected input visible. For+ -- composite fields this will not bring all options into view.+ | ShowCompositeField+ -- ^ Make all inputs in the focused field visible. For composite+ -- fields this will bring all options into view as long as the+ -- viewport is large enough to show them all.+ | ShowAugmentedField+ -- ^ Like 'ShowCompositeField' but includes rendering augmentations+ -- applied with '@@='.+ deriving (Eq, Show)+ -- | A form field state accompanied by the fields that manipulate that -- state. The idea is that some record field in your form state has -- one or more form fields that manipulate that value. This data type@@ -189,6 +206,9 @@ , formFieldConcat :: [Widget n] -> Widget n -- ^ Concatenation function for this field's input -- renderings.+ , formFieldVisibilityMode :: FormFieldVisibilityMode+ -- ^ This field's visibility mode for use in+ -- viewports. } -> FormFieldState s e n -- | A form: a sequence of input fields that manipulate the fields of an@@ -250,8 +270,8 @@ updateFormState :: s -> Form s e n -> Form s e n updateFormState newState f = let updateField fs = case fs of- FormFieldState st l upd s rh concatAll ->- FormFieldState (upd (newState^.l) st) l upd s rh concatAll+ FormFieldState st l upd s rh concatAll visMode ->+ FormFieldState (upd (newState^.l) st) l upd s rh concatAll visMode in f { formState = newState , formFieldStates = updateField <$> formFieldStates f }@@ -287,7 +307,7 @@ } formFieldNames :: FormFieldState s e n -> [n]-formFieldNames (FormFieldState _ _ _ fields _ _) = formFieldName <$> fields+formFieldNames (FormFieldState _ _ _ fields _ _ _) = formFieldName <$> fields -- | A form field for manipulating a boolean value. This represents -- 'True' as @[X] label@ and 'False' as @[ ] label@.@@ -345,6 +365,7 @@ \val _ -> val , formFieldRenderHelper = id , formFieldConcat = vBox+ , formFieldVisibilityMode = ShowFocusedFieldOnly } renderCheckbox :: (Ord n) => Char -> Char -> Char -> T.Text -> n -> Bool -> Bool -> Widget n@@ -359,6 +380,9 @@ -- | A form field for selecting a single choice from a set of possible -- choices in a scrollable list. This uses a 'List' internally. --+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.List'.+-- -- This field responds to the same input events that a 'List' does. listField :: forall s e n a . (Ord n, Show n, Eq a) => (s -> Vector a)@@ -403,7 +427,9 @@ Just (_, e) -> listMoveToElement e l , formFieldRenderHelper = id , formFieldConcat = vBox+ , formFieldVisibilityMode = ShowFocusedFieldOnly }+ -- | A form field for selecting a single choice from a set of possible -- choices. Each choice has an associated value and text label. --@@ -471,6 +497,7 @@ , formFieldUpdate = \val _ -> val , formFieldRenderHelper = id , formFieldConcat = vBox+ , formFieldVisibilityMode = ShowFocusedFieldOnly } renderRadio :: (Eq a, Ord n) => Char -> Char -> Char -> a -> n -> T.Text -> Bool -> a -> Widget n@@ -492,6 +519,9 @@ -- a value. The other editing fields in this module are special cases of -- this function. --+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+-- -- This field responds to all events handled by 'editor', including -- mouse events. editField :: (Ord n, Show n)@@ -542,6 +572,7 @@ else applyEdit (Z.insertMany newTxt . Z.clearZipper) e , formFieldRenderHelper = id , formFieldConcat = vBox+ , formFieldVisibilityMode = ShowFocusedFieldOnly } -- | A form field using a single-line editor to edit the 'Show'@@ -550,6 +581,9 @@ -- useful in cases where the user-facing representation of a value -- matches the 'Show' representation exactly, such as with 'Int'. --+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+-- -- This field responds to all events handled by 'editor', including -- mouse events. editShowableField :: (Ord n, Show n, Read a, Show a)@@ -570,6 +604,9 @@ -- user-facing representation of a value matches the 'Show' representation -- exactly, such as with 'Int', but you don't want to accept just /any/ 'Int'. --+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+-- -- This field responds to all events handled by 'editor', including -- mouse events. editShowableFieldWithValidate :: (Ord n, Show n, Read a, Show a)@@ -598,6 +635,9 @@ -- | A form field using an editor to edit a text value. Since the value -- is free-form text, it is always valid. --+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+-- -- This field responds to all events handled by 'editor', including -- mouse events. editTextField :: (Ord n, Show n)@@ -620,6 +660,9 @@ -- value represented as a password. The value is always considered valid -- and is always represented with one asterisk per password character. --+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+-- -- This field responds to all events handled by 'editor', including -- mouse events. editPasswordField :: (Ord n, Show n)@@ -644,11 +687,18 @@ formAttr :: AttrName formAttr = attrName "brickForm" --- | The attribute for form input fields with invalid values.+-- | The attribute for form input fields with invalid values. Note that+-- this attribute will affect any field considered invalid and will take+-- priority over any attributes that the field uses to render itself. invalidFormInputAttr :: AttrName invalidFormInputAttr = formAttr <> attrName "invalidInput" --- | The attribute for form input fields that have the focus.+-- | The attribute for form input fields that have the focus. Note that+-- this attribute only affects fields that do not already use their own+-- attributes when rendering, such as editor- and list-based fields.+-- Those need to be styled by setting the appropriate attributes; see+-- the documentation for field constructors to find out which attributes+-- need to be configured. focusedFormInputAttr :: AttrName focusedFormInputAttr = formAttr <> attrName "focusedInput" @@ -666,6 +716,51 @@ invalidFields :: Form s e n -> [n] invalidFields f = concatMap getInvalidFields (formFieldStates f) +-- | Set the visibility mode of the specified form field's collection+-- when the form is rendered in viewport. This is used to change how+-- focused fields are brought into view when they're outside of view+-- in a viewport and gain focus. In practice, this means this function+-- need only be called on one form field name in a collection in order+-- to affect the visibility behavior of that field's entire input+-- collection.+--+-- There are two visibility modes:+--+-- * 'ShowFocusedFieldOnly' - this is the default behavior. In this+-- mode, when a field receives focus, it is brought into view but+-- other inputs in the same field collection (e.g. a set of radio+-- buttons) will not be brought into view along with it.+--+-- * 'ShowCompositeField' - in this mode, when a field receives focus,+-- all of the inputs in its collection (e.g. a set of radio buttons)+-- are brought into view as long as the viewport is large enough to+-- show them all. If it isn't, the viewport will show as many as space+-- allows.+--+-- * 'ShowAugmentedField' - in this mode, when a field receives focus,+-- all of the inputs in its collection (e.g. a set of radio buttons)+-- and its rendering augmentations (as applied with '@@=') are brought+-- into view as long as the viewport is large enough to show them all.+setFieldVisibilityMode :: (Eq n)+ => n+ -- ^ The name of the form field whose visibility mode is to be set.+ -> FormFieldVisibilityMode+ -- ^ The mode to set.+ -> Form s e n+ -- ^ The form to modify.+ -> Form s e n+setFieldVisibilityMode n mode form =+ let go1 [] = []+ go1 (s:ss) =+ let s' = case s of+ FormFieldState st l upd fs rh concatAll _ ->+ if n `elem` formFieldNames s+ then FormFieldState st l upd fs rh concatAll mode+ else s+ in s' : go1 ss++ in form { formFieldStates = go1 (formFieldStates form) }+ -- | Manually indicate that a field has invalid contents. This can be -- useful in situations where validation beyond the form element's -- validator needs to be performed and the result of that validation@@ -682,18 +777,18 @@ let go1 [] = [] go1 (s:ss) = let s' = case s of- FormFieldState st l upd fs rh concatAll ->+ FormFieldState st l upd fs rh concatAll visMode -> let go2 [] = [] go2 (f@(FormField fn val _ r h):ff) | n == fn = FormField fn val v r h : ff | otherwise = f : go2 ff- in FormFieldState st l upd (go2 fs) rh concatAll+ in FormFieldState st l upd (go2 fs) rh concatAll visMode in s' : go1 ss in form { formFieldStates = go1 (formFieldStates form) } getInvalidFields :: FormFieldState s e n -> [n]-getInvalidFields (FormFieldState st _ _ fs _ _) =+getInvalidFields (FormFieldState st _ _ fs _ _ _) = let gather (FormField n validate extValid _ _) = if not extValid || isNothing (validate st) then [n] else [] in concatMap gather fs@@ -710,7 +805,9 @@ -- 'invalidFormInputAttr' attribute. -- -- Finally, all of the resulting field renderings are concatenated with--- the form's concatenation function (see 'setFormConcat').+-- the form's concatenation function (see 'setFormConcat'). A visibility+-- request is also issued for the currently-focused form field in case+-- the form is rendered within a viewport. renderForm :: (Eq n) => Form s e n -> Widget n renderForm (Form es fr _ concatAll) = concatAll $ renderFormFieldState fr <$> es@@ -723,15 +820,24 @@ => FocusRing n -> FormFieldState s e n -> Widget n-renderFormFieldState fr (FormFieldState st _ _ fields helper concatFields) =- let renderFields [] = []+renderFormFieldState fr (FormFieldState st _ _ fields helper concatFields visMode) =+ let curFocus = focusGetCurrent fr+ foc = case curFocus of+ Nothing -> False+ Just n -> n `elem` fieldNames+ maybeVisible = if foc && visMode == ShowCompositeField then visible else id+ renderFields [] = [] renderFields ((FormField n validate extValid renderField _):fs) = let maybeInvalid = if (isJust $ validate st) && extValid then id else forceAttr invalidFormInputAttr- foc = Just n == focusGetCurrent fr- in maybeInvalid (renderField foc st) : renderFields fs- in helper $ concatFields $ renderFields fields+ fieldFoc = Just n == curFocus+ maybeFieldVisible = if fieldFoc && visMode == ShowFocusedFieldOnly then visible else id+ in (n, maybeFieldVisible $ maybeInvalid $ renderField fieldFoc st) : renderFields fs+ (fieldNames, renderedFields) = unzip $ renderFields fields+ maybeHelperVisible =+ if foc && visMode == ShowAugmentedField then visible else id+ in maybeHelperVisible $ helper $ maybeVisible $ concatFields renderedFields -- | Dispatch an event to the currently focused form field. This handles -- the following events in this order:@@ -807,7 +913,10 @@ i' = if i == 0 then length as - 1 else i - 1 in as !! i' -withFocusAndGrouping :: (Eq n) => BrickEvent n e -> (n -> [n] -> EventM n (Form s e n) ()) -> EventM n (Form s e n) ()+withFocusAndGrouping :: (Eq n)+ => BrickEvent n e+ -> (n -> [n] -> EventM n (Form s e n) ())+ -> EventM n (Form s e n) () withFocusAndGrouping e act = do foc <- gets formFocus case focusGetCurrent foc of@@ -834,7 +943,7 @@ let findFieldState _ [] = return () findFieldState prev (e:es) = case e of- FormFieldState st stLens upd fields helper concatAll -> do+ FormFieldState st stLens upd fields helper concatAll visMode -> do let findField [] = return Nothing findField (field:rest) = case field of@@ -851,7 +960,7 @@ case result of Nothing -> findFieldState (prev <> [e]) es Just (newSt, maybeSt) -> do- let newFieldState = FormFieldState newSt stLens upd fields helper concatAll+ let newFieldState = FormFieldState newSt stLens upd fields helper concatAll visMode formFieldStatesL .= prev <> [newFieldState] <> es case maybeSt of Nothing -> return ()
src/Brick/Keybindings/KeyConfig.hs view
@@ -47,6 +47,7 @@ import qualified Graphics.Vty as Vty import Brick.Keybindings.KeyEvents+import Brick.Keybindings.Normalize -- | A key binding. --@@ -67,10 +68,12 @@ -- ^ The set of modifiers. } deriving (Eq, Show, Ord) --- | Construct a 'Binding'. Modifier order is ignored.+-- | Construct a 'Binding'. Modifier order is ignored. If modifiers+-- are given and the binding is for a character key, it is forced to+-- lowercase. binding :: Vty.Key -> [Vty.Modifier] -> Binding binding k mods =- Binding { kbKey = k+ Binding { kbKey = normalizeKey mods k , kbMods = S.fromList mods } @@ -230,17 +233,23 @@ addModifier :: (ToBinding a) => Vty.Modifier -> a -> Binding addModifier m val = let b = bind val- in b { kbMods = S.insert m (kbMods b) }+ newMods = S.insert m $ kbMods b+ in b { kbMods = newMods+ , kbKey = normalizeKey (S.toList newMods) $ kbKey b+ } --- | Add Meta to a binding.+-- | Add Meta to a binding. If the binding is for a character key, force+-- it to lowercase. meta :: (ToBinding a) => a -> Binding meta = addModifier Vty.MMeta --- | Add Ctrl to a binding.+-- | Add Ctrl to a binding. If the binding is for a character key, force+-- it to lowercase. ctrl :: (ToBinding a) => a -> Binding ctrl = addModifier Vty.MCtrl --- | Add Shift to a binding.+-- | Add Shift to a binding. If the binding is for a character key, force+-- it to lowercase. shift :: (ToBinding a) => a -> Binding shift = addModifier Vty.MShift
+ src/Brick/Keybindings/Normalize.hs view
@@ -0,0 +1,14 @@+module Brick.Keybindings.Normalize+ ( normalizeKey+ )+where++import Data.Char (toLower)+import qualified Graphics.Vty as Vty++-- | A keybinding involving modifiers should have its key character+-- normalized to lowercase since it's impossible to get uppercase keys+-- from the terminal when modifiers are present.+normalizeKey :: [Vty.Modifier] -> Vty.Key -> Vty.Key+normalizeKey (_:_) (Vty.KChar c) = Vty.KChar $ toLower c+normalizeKey _ k = k
src/Brick/Keybindings/Parse.hs view
@@ -5,6 +5,7 @@ module Brick.Keybindings.Parse ( parseBinding , parseBindingList+ , normalizeKey , keybindingsFromIni , keybindingsFromFile@@ -14,7 +15,6 @@ import Control.Monad (forM) import Data.Maybe (catMaybes)-import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Graphics.Vty as Vty@@ -23,6 +23,7 @@ import Brick.Keybindings.KeyEvents import Brick.Keybindings.KeyConfig+import Brick.Keybindings.Normalize -- | Parse a key binding list into a 'BindingState'. --@@ -83,7 +84,7 @@ parseBinding s = go (T.splitOn "-" $ T.toLower s) [] where go [k] mods = do k' <- pKey k- return Binding { kbMods = S.fromList mods, kbKey = k' }+ return $ binding k' mods go (k:ks) mods = do m <- case k of "s" -> return Vty.MShift
src/Brick/Keybindings/Pretty.hs view
@@ -25,7 +25,6 @@ import Brick import Data.List (sort, intersperse)-import Data.Maybe (fromJust) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif@@ -124,19 +123,19 @@ ByKey b -> (Comment "(non-customizable key)", [Verbatim $ ppBinding b]) ByEvent ev ->- let name = fromJust $ keyEventName (keyConfigEvents kc) ev+ let name = maybe (Comment "(unnamed)") Verbatim $ keyEventName (keyConfigEvents kc) ev in case lookupKeyConfigBindings kc ev of Nothing -> if not (null (allDefaultBindings kc ev))- then (Verbatim name, Verbatim <$> ppBinding <$> allDefaultBindings kc ev)- else (Verbatim name, unbound)+ then (name, Verbatim <$> ppBinding <$> allDefaultBindings kc ev)+ else (name, unbound) Just Unbound ->- (Verbatim name, unbound)+ (name, unbound) Just (BindingList bs) -> let result = if not (null bs) then Verbatim <$> ppBinding <$> bs else unbound- in (Verbatim name, result)+ in (name, result) in (label, handlerDescription $ kehHandler h, evText) -- | Build a 'Widget' displaying key binding information for a single@@ -164,8 +163,8 @@ getText (Comment s) = s getText (Verbatim s) = s label = withDefAttr eventNameAttr $ case evName of- Comment s -> txt s -- TODO: was "; " <> s- Verbatim s -> txt s -- TODO: was: emph $ txt s+ Comment s -> txt s+ Verbatim s -> txt s in vBox [ withDefAttr eventDescriptionAttr $ txt desc , label <+> txt " = " <+> withDefAttr keybindingAttr (txt evText) ]
src/Brick/Main.hs view
@@ -5,6 +5,7 @@ , defaultMain , customMain , customMainWithVty+ , customMainWithDefaultVty , simpleMain , resizeOrQuit , simpleApp@@ -54,6 +55,7 @@ import qualified Control.Exception as E import Lens.Micro ((^.), (&), (.~), (%~), _1, _2)+import Control.Monad import Control.Monad.State.Strict import Control.Monad.Reader import Control.Concurrent (forkIO, killThread)@@ -72,11 +74,11 @@ , displayBounds , shutdown , nextEvent- , mkVty- , defaultConfig , restoreInputState , inputIface )+import Graphics.Vty.CrossPlatform (mkVty)+import Graphics.Vty.Config (defaultConfig) import Graphics.Vty.Attributes (defAttr) import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan)@@ -121,8 +123,8 @@ } -- | The default main entry point which takes an application and an--- initial state and returns the final state returned by a 'halt'--- operation.+-- initial state and returns the final state from 'EventM' once the+-- program exits. defaultMain :: (Ord n) => App s e n -- ^ The application.@@ -130,9 +132,9 @@ -- ^ The initial application state. -> IO s defaultMain app st = do- let builder = mkVty defaultConfig- initialVty <- builder- customMain initialVty builder Nothing app st+ (s, vty) <- customMainWithDefaultVty Nothing app st+ shutdown vty+ return s -- | A simple main entry point which takes a widget and renders it. This -- event loop terminates when the user presses any key, but terminal@@ -233,6 +235,29 @@ shutdown vty restoreInitialState return s++-- | Like 'customMainWithVty', except that Vty is initialized with the+-- default configuration.+--+-- The returned 'Vty' handle still has control of the terminal. The+-- caller is responsible for calling 'shutdown' to restore the terminal+-- state.+customMainWithDefaultVty :: (Ord n)+ => Maybe (BChan e)+ -- ^ An event channel for sending custom+ -- events to the event loop (you write to this+ -- channel, the event loop reads from it).+ -- Provide 'Nothing' if you don't plan on+ -- sending custom events.+ -> App s e n+ -- ^ The application.+ -> s+ -- ^ The initial application state.+ -> IO (s, Vty)+customMainWithDefaultVty mUserChan app initialAppState = do+ let builder = mkVty defaultConfig+ vty <- builder+ customMainWithVty vty builder mUserChan app initialAppState -- | Like 'customMain', except the last 'Vty' handle used by the -- application is returned without being shut down with 'shutdown'. This
src/Brick/Themes.hs view
@@ -6,8 +6,6 @@ -- | Support for representing attribute themes and loading and saving -- theme customizations in INI-style files. ----- The file format is as follows:--- -- Customization files are INI-style files with two sections, both -- optional: @"default"@ and @"other"@. --
src/Brick/Types.hs view
@@ -22,7 +22,8 @@ , vpContentSize , VScrollBarOrientation(..) , HScrollBarOrientation(..)- , ScrollbarRenderer(..)+ , VScrollbarRenderer(..)+ , HScrollbarRenderer(..) , ClickableScrollbarElement(..) -- * Event-handling types and functions
src/Brick/Types/Common.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE CPP #-} module Brick.Types.Common ( Location(..) , locL@@ -16,10 +17,14 @@ import GHC.Generics import Control.DeepSeq import Lens.Micro (_1, _2)+#if MIN_VERSION_microlens(0,5,0)+import Lens.Micro.FieldN (Field1, Field2)+#else import Lens.Micro.Internal (Field1, Field2)+#endif -- | A terminal screen location.-data Location = Location { loc :: (Int, Int)+data Location = Location { loc :: !(Int, Int) -- ^ (Column, Row) } deriving (Show, Eq, Ord, Read, Generic, NFData)@@ -43,7 +48,7 @@ mempty = origin mappend = (Sem.<>) -data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a }+data Edges a = Edges { eTop, eBottom, eLeft, eRight :: !a } deriving (Eq, Ord, Read, Show, Functor, Generic, NFData) suffixLenses ''Edges
src/Brick/Types/Internal.hs view
@@ -22,7 +22,8 @@ , cursorLocationVisibleL , VScrollBarOrientation(..) , HScrollBarOrientation(..)- , ScrollbarRenderer(..)+ , VScrollbarRenderer(..)+ , HScrollbarRenderer(..) , ClickableScrollbarElement(..) , Context(..) , ctxAttrMapL@@ -102,16 +103,16 @@ import Brick.AttrMap (AttrName, AttrMap) import Brick.Widgets.Border.Style (BorderStyle) -data ScrollRequest = HScrollBy Int- | HScrollPage Direction+data ScrollRequest = HScrollBy !Int+ | HScrollPage !Direction | HScrollToBeginning | HScrollToEnd- | VScrollBy Int- | VScrollPage Direction+ | VScrollBy !Int+ | VScrollPage !Direction | VScrollToBeginning | VScrollToEnd- | SetTop Int- | SetLeft Int+ | SetTop !Int+ | SetLeft !Int deriving (Read, Show, Generic, NFData) -- | Widget size policies. These policies communicate how a widget uses@@ -130,9 +131,9 @@ -- | The type of widgets. data Widget n =- Widget { hSize :: Size+ Widget { hSize :: !Size -- ^ This widget's horizontal growth policy- , vSize :: Size+ , vSize :: !Size -- ^ This widget's vertical growth policy , render :: RenderM n (Result n) -- ^ This widget's rendering function@@ -165,50 +166,85 @@ data HScrollBarOrientation = OnBottom | OnTop deriving (Show, Eq) --- | A scroll bar renderer.-data ScrollbarRenderer n =- ScrollbarRenderer { renderScrollbar :: Widget n- -- ^ How to render the body of the scroll bar.- -- This should provide a widget that expands in- -- whatever direction(s) this renderer will be- -- used for. So, for example, if this was used to- -- render vertical scroll bars, this widget would- -- need to be one that expands vertically such as- -- @fill@. The same goes for the trough widget.- , renderScrollbarTrough :: Widget n- -- ^ How to render the "trough" of the scroll bar- -- (the area to either side of the scroll bar- -- body). This should expand as described in the- -- documentation for the scroll bar field.- , renderScrollbarHandleBefore :: Widget n- -- ^ How to render the handle that appears at the- -- top or left of the scrollbar. The result should- -- be at most one row high for horizontal handles- -- and one column wide for vertical handles.- , renderScrollbarHandleAfter :: Widget n- -- ^ How to render the handle that appears at- -- the bottom or right of the scrollbar. The- -- result should be at most one row high for- -- horizontal handles and one column wide for- -- vertical handles.- }+-- | A vertical scroll bar renderer.+data VScrollbarRenderer n =+ VScrollbarRenderer { renderVScrollbar :: Widget n+ -- ^ How to render the body of the scroll bar.+ -- This should provide a widget that expands in+ -- whatever direction(s) this renderer will be+ -- used for. So, for example, this widget would+ -- need to be one that expands vertically such as+ -- @fill@. The same goes for the trough widget.+ , renderVScrollbarTrough :: Widget n+ -- ^ How to render the "trough" of the scroll bar+ -- (the area to either side of the scroll bar+ -- body). This should expand as described in the+ -- documentation for the scroll bar field.+ , renderVScrollbarHandleBefore :: Widget n+ -- ^ How to render the handle that appears at+ -- the top or left of the scrollbar. The result+ -- will be allowed to be at most one row high.+ , renderVScrollbarHandleAfter :: Widget n+ -- ^ How to render the handle that appears at the+ -- bottom or right of the scrollbar. The result+ -- will be allowed to be at most one row high.+ , scrollbarWidthAllocation :: Int+ -- ^ The number of columns that will be allocated+ -- to the scroll bar. This determines how much+ -- space the widgets of the scroll bar elements+ -- can take up. If they use less than this+ -- amount, padding will be applied between the+ -- scroll bar and the viewport contents.+ } +-- | A horizontal scroll bar renderer.+data HScrollbarRenderer n =+ HScrollbarRenderer { renderHScrollbar :: Widget n+ -- ^ How to render the body of the scroll bar.+ -- This should provide a widget that expands+ -- in whatever direction(s) this renderer will+ -- be used for. So, for example, this widget+ -- would need to be one that expands horizontally+ -- such as @fill@. The same goes for the trough+ -- widget.+ , renderHScrollbarTrough :: Widget n+ -- ^ How to render the "trough" of the scroll bar+ -- (the area to either side of the scroll bar+ -- body). This should expand as described in the+ -- documentation for the scroll bar field.+ , renderHScrollbarHandleBefore :: Widget n+ -- ^ How to render the handle that appears at the+ -- top or left of the scrollbar. The result will+ -- be allowed to be at most one column wide.+ , renderHScrollbarHandleAfter :: Widget n+ -- ^ How to render the handle that appears at the+ -- bottom or right of the scrollbar. The result+ -- will be allowed to be at most one column wide.+ , scrollbarHeightAllocation :: Int+ -- ^ The number of rows that will be allocated to+ -- the scroll bar. This determines how much space+ -- the widgets of the scroll bar elements can+ -- take up. If they use less than this amount,+ -- padding will be applied between the scroll bar+ -- and the viewport contents.+ }+ data VisibilityRequest =- VR { vrPosition :: Location- , vrSize :: DisplayRegion+ VR { vrPosition :: !Location+ , vrSize :: !DisplayRegion } deriving (Show, Eq, Read, Generic, NFData) -- | Describes the state of a viewport as it appears as its most recent -- rendering. data Viewport =- VP { _vpLeft :: Int+ VP { _vpLeft :: !Int -- ^ The column offset of left side of the viewport.- , _vpTop :: Int+ , _vpTop :: !Int -- ^ The row offset of the top of the viewport.- , _vpSize :: DisplayRegion+ , _vpSize :: !DisplayRegion -- ^ The size of the viewport.- , _vpContentSize :: DisplayRegion+ , _vpContentSize :: !DisplayRegion -- ^ The size of the contents of the viewport. } deriving (Show, Read, Generic, NFData)@@ -238,9 +274,9 @@ } data VtyContext =- VtyContext { vtyContextBuilder :: IO Vty- , vtyContextHandle :: Vty- , vtyContextThread :: ThreadId+ VtyContext { vtyContextBuilder :: !(IO Vty)+ , vtyContextHandle :: !Vty+ , vtyContextThread :: !ThreadId , vtyContextPutEvent :: Event -> IO () } @@ -294,27 +330,27 @@ -- | A border character has four segments, one extending in each direction -- (horizontally and vertically) from the center of the character. data BorderSegment = BorderSegment- { bsAccept :: Bool+ { bsAccept :: !Bool -- ^ Would this segment be willing to be drawn if a neighbor wanted to -- connect to it?- , bsOffer :: Bool+ , bsOffer :: !Bool -- ^ Does this segment want to connect to its neighbor?- , bsDraw :: Bool+ , bsDraw :: !Bool -- ^ Should this segment be represented visually? } deriving (Eq, Ord, Read, Show, Generic, NFData) -- | Information about how to redraw a dynamic border character when it abuts -- another dynamic border character. data DynBorder = DynBorder- { dbStyle :: BorderStyle+ { dbStyle :: !BorderStyle -- ^ The 'Char's to use when redrawing the border. Also used to filter -- connections: only dynamic borders with equal 'BorderStyle's will connect -- to each other.- , dbAttr :: Attr+ , dbAttr :: !Attr -- ^ What 'Attr' to use to redraw the border character. Also used to filter -- connections: only dynamic borders with equal 'Attr's will connect to -- each other.- , dbSegments :: Edges BorderSegment+ , dbSegments :: !(Edges BorderSegment) } deriving (Eq, Read, Show, Generic, NFData) -- | The type of result returned by a widget's rendering function. The@@ -358,23 +394,23 @@ } -- | The type of events.-data BrickEvent n e = VtyEvent Event+data BrickEvent n e = VtyEvent !Event -- ^ The event was a Vty event.- | AppEvent e+ | AppEvent !e -- ^ The event was an application event.- | MouseDown n Button [Modifier] Location+ | MouseDown !n !Button ![Modifier] !Location -- ^ A mouse-down event on the specified region was -- received. The 'n' value is the resource name of -- the clicked widget (see 'clickable').- | MouseUp n (Maybe Button) Location+ | MouseUp !n !(Maybe Button) !Location -- ^ A mouse-up event on the specified region was -- received. The 'n' value is the resource name of -- the clicked widget (see 'clickable'). deriving (Show, Eq, Ord) -data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport- , latestExtents :: [Extent n]- , oldState :: RenderState n+data EventRO n = EventRO { eventViewportMap :: !(M.Map n Viewport)+ , latestExtents :: ![Extent n]+ , oldState :: !(RenderState n) } -- | Clickable elements of a scroll bar.@@ -396,22 +432,22 @@ -- to render, which bordering style should be used, and the attribute map -- available for rendering. data Context n =- Context { ctxAttrName :: AttrName- , availWidth :: Int- , availHeight :: Int- , windowWidth :: Int- , windowHeight :: Int- , ctxBorderStyle :: BorderStyle- , ctxAttrMap :: AttrMap- , ctxDynBorders :: Bool- , ctxVScrollBarOrientation :: Maybe VScrollBarOrientation- , ctxVScrollBarRenderer :: Maybe (ScrollbarRenderer n)- , ctxHScrollBarOrientation :: Maybe HScrollBarOrientation- , ctxHScrollBarRenderer :: Maybe (ScrollbarRenderer n)- , ctxVScrollBarShowHandles :: Bool- , ctxHScrollBarShowHandles :: Bool- , ctxVScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n)- , ctxHScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n)+ Context { ctxAttrName :: !AttrName+ , availWidth :: !Int+ , availHeight :: !Int+ , windowWidth :: !Int+ , windowHeight :: !Int+ , ctxBorderStyle :: !BorderStyle+ , ctxAttrMap :: !AttrMap+ , ctxDynBorders :: !Bool+ , ctxVScrollBarOrientation :: !(Maybe VScrollBarOrientation)+ , ctxVScrollBarRenderer :: !(Maybe (VScrollbarRenderer n))+ , ctxHScrollBarOrientation :: !(Maybe HScrollBarOrientation)+ , ctxHScrollBarRenderer :: !(Maybe (HScrollbarRenderer n))+ , ctxVScrollBarShowHandles :: !Bool+ , ctxHScrollBarShowHandles :: !Bool+ , ctxVScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n))+ , ctxHScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n)) } suffixLenses ''RenderState
src/Brick/Util.hs view
@@ -4,6 +4,7 @@ , on , fg , bg+ , style , clOffset ) where@@ -52,9 +53,14 @@ fg = (defAttr `withForeColor`) -- | Create an attribute from the specified background color (the--- background color is the "default").+-- foreground color is the "default"). bg :: Color -> Attr bg = (defAttr `withBackColor`)++-- | Create an attribute from the specified style (the colors are the+-- "default").+style :: Style -> Attr+style = (defAttr `withStyle`) -- | Add a 'Location' offset to the specified 'CursorLocation'. clOffset :: CursorLocation n -> Location -> CursorLocation n
src/Brick/Widgets/Border.hs view
@@ -20,12 +20,17 @@ -- * Attribute names , borderAttr+ , hBorderAttr+ , vBorderAttr -- * Utility , joinableBorder ) where +#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif import Lens.Micro ((^.), (&), (.~), to) import Graphics.Vty (imageHeight, imageWidth) @@ -41,6 +46,14 @@ borderAttr :: AttrName borderAttr = attrName "border" +-- | The horizontal border attribute name. Inherits from 'borderAttr'.+hBorderAttr :: AttrName+hBorderAttr = borderAttr <> attrName "horizontal"++-- | The vertical border attribute name. Inherits from 'borderAttr'.+vBorderAttr :: AttrName+vBorderAttr = borderAttr <> attrName "vertical"+ -- | Draw the specified border element using the active border style -- using 'borderAttr'. --@@ -95,7 +108,8 @@ $ vLimit (middleResult^.imageL.to imageHeight + 2) $ total --- | A horizontal border. Fills all horizontal space.+-- | A horizontal border. Fills all horizontal space. Draws using+-- 'hBorderAttr'. hBorder :: Widget n hBorder = withAttr borderAttr $ Widget Greedy Fixed $ do@@ -105,7 +119,8 @@ db <- dynBorderFromDirections (Edges False False True True) let dynBorders = BM.insertH mempty (Run w db) $ BM.emptyCoordinates (Edges 0 0 0 (w-1))- setDynBorders dynBorders $ render $ vLimit 1 $ fill (bsHorizontal bs)+ setDynBorders dynBorders $ render $ withAttr hBorderAttr+ $ vLimit 1 $ fill (bsHorizontal bs) -- | A horizontal border with a label placed in the center of the -- border. Fills all horizontal space.@@ -117,7 +132,8 @@ res <- render $ vLimit 1 label render $ hBox [hBorder, Widget Fixed Fixed (return res), hBorder] --- | A vertical border. Fills all vertical space.+-- | A vertical border. Fills all vertical space. Draws using+-- 'vBorderAttr'. vBorder :: Widget n vBorder = withAttr borderAttr $ Widget Fixed Greedy $ do@@ -127,7 +143,8 @@ db <- dynBorderFromDirections (Edges True True False False) let dynBorders = BM.insertV mempty (Run h db) $ BM.emptyCoordinates (Edges 0 (h-1) 0 0)- setDynBorders dynBorders $ render $ hLimit 1 $ fill (bsVertical bs)+ setDynBorders dynBorders $ render $ withAttr vBorderAttr+ $ hLimit 1 $ fill (bsVertical bs) -- | Initialize a 'DynBorder'. It will be 'bsDraw'n and 'bsOffer'ing -- in the given directions to begin with, and accept join offers from
src/Brick/Widgets/Center.hs view
@@ -60,7 +60,7 @@ c <- getContext let rWidth = result^.imageL.to imageWidth rHeight = result^.imageL.to imageHeight- remainder = max 0 $ c^.availWidthL - (leftPaddingAmount * 2)+ remainder = max 0 $ c^.availWidthL - (rWidth + (leftPaddingAmount * 2)) leftPaddingAmount = max 0 $ (c^.availWidthL - rWidth) `div` 2 rightPaddingAmount = max 0 $ leftPaddingAmount + remainder leftPadding = charFill (c^.attrL) ch leftPaddingAmount rHeight
src/Brick/Widgets/Core.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} -- | This module provides the core widget combinators and rendering -- routines. Everything this library does is in terms of these basic -- primitives.@@ -49,6 +50,7 @@ , modifyDefAttr , withAttr , forceAttr+ , forceAttrAllowStyle , overrideAttr , updateAttrMap @@ -99,7 +101,8 @@ , withHScrollBarHandles , withVScrollBarRenderer , withHScrollBarRenderer- , ScrollbarRenderer(..)+ , VScrollbarRenderer(..)+ , HScrollbarRenderer(..) , verticalScrollbarRenderer , horizontalScrollbarRenderer , scrollbarAttr@@ -122,6 +125,7 @@ import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, Lens') import Lens.Micro.Mtl (use, (%=))+import Control.Monad import Control.Monad.State.Strict import Control.Monad.Reader import qualified Data.Foldable as F@@ -268,17 +272,6 @@ unrestricted :: Int unrestricted = 100000 --- | Take a substring capable of fitting into the number of specified--- columns. This function takes character column widths into--- consideration.-takeColumns :: Int -> String -> String-takeColumns _ "" = ""-takeColumns numCols (c:cs) =- let w = V.safeWcwidth c- in if w > numCols- then []- else c : takeColumns (numCols - w) cs- -- | Make a widget from a string, but wrap the words in the input's -- lines at the available width using the default wrapping settings. The -- input string should not contain escape sequences or carriage returns.@@ -296,9 +289,6 @@ strWrapWith :: WrapSettings -> String -> Widget n strWrapWith settings t = txtWrapWith settings $ T.pack t -safeTextWidth :: T.Text -> Int-safeTextWidth = V.safeWcswidth . T.unpack- -- | Make a widget from text, but wrap the words in the input's lines at -- the available width using the default wrapping settings. The input -- text should not contain escape sequences or carriage returns.@@ -322,15 +312,15 @@ case force theLines of [] -> return emptyResult multiple ->- let maxLength = maximum $ safeTextWidth <$> multiple+ let maxLength = maximum $ textWidth <$> multiple padding = V.charFill (c^.attrL) ' ' (c^.availWidthL - maxLength) (length lineImgs) lineImgs = lineImg <$> multiple lineImg lStr = V.text' (c^.attrL)- (lStr <> T.replicate (maxLength - safeTextWidth lStr) " ")+ (lStr <> T.replicate (maxLength - textWidth lStr) " ") in return $ emptyResult & imageL .~ (V.horizCat [V.vertCat lineImgs, padding]) --- | Build a widget from a 'String'. Breaks newlines up and space-pads--- short lines out to the length of the longest line.+-- | Build a widget from a 'String'. Behaves the same as 'txt' when the+-- input contains multiple lines. -- -- The input string must not contain tab characters. If it does, -- interface corruption will result since the terminal will likely@@ -338,25 +328,10 @@ -- replace tabs with the appropriate number of spaces as desired. The -- input string should not contain escape sequences or carriage returns. str :: String -> Widget n-str s =- Widget Fixed Fixed $ do- c <- getContext- let theLines = fixEmpty <$> (dropUnused . lines) s- fixEmpty :: String -> String- fixEmpty [] = " "- fixEmpty l = l- dropUnused l = takeColumns (availWidth c) <$> take (availHeight c) l- case force theLines of- [] -> return emptyResult- [one] -> return $ emptyResult & imageL .~ (V.string (c^.attrL) one)- multiple ->- let maxLength = maximum $ V.safeWcswidth <$> multiple- lineImgs = lineImg <$> multiple- lineImg lStr = V.string (c^.attrL) (lStr ++ replicate (maxLength - V.safeWcswidth lStr) ' ')- in return $ emptyResult & imageL .~ (V.vertCat lineImgs)+str = txt . T.pack --- | Build a widget from a 'T.Text' value. Behaves the same as 'str'--- when the input contains multiple lines.+-- | Build a widget from a 'T.Text' value. Breaks newlines up and+-- space-pads short lines out to the length of the longest line. -- -- The input string must not contain tab characters. If it does, -- interface corruption will result since the terminal will likely@@ -364,8 +339,45 @@ -- replace tabs with the appropriate number of spaces as desired. The -- input text should not contain escape sequences or carriage returns. txt :: T.Text -> Widget n-txt = str . T.unpack+txt s =+ -- Although vty Image uses lazy Text internally, using lazy text at this+ -- level may not be an improvement. Indeed it can be much worse, due+ -- the overhead of lazy Text being significant compared to the typically+ -- short string content used to compose UIs.+ Widget Fixed Fixed $ do+ c <- getContext+ let theLines = fixEmpty <$> (dropUnused . T.lines) s+ fixEmpty l = if T.null l then T.singleton ' ' else l+ dropUnused l = takeColumnsT (availWidth c) <$> take (availHeight c) l+ pure $ case theLines of+ [] -> 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 ' '))+ in emptyResult & imageL .~ (V.vertCat lineImgs) +-- | Take up to the given width, having regard to character width.+takeColumnsT :: Int -> T.Text -> T.Text+takeColumnsT w s = T.take (fst $ T.foldl' f (0,0) s) s+ where+ -- The accumulator value is (index in Text value, width of Text so far)+ f (i,z) c+ -- Width was previously exceeded; continue with same values.+ | z < 0 = (i, z)+ -- Width exceeded. Signal this with z = -1. Index will no longer be+ -- incremented.+ --+ -- Why not short circuit (e.g. using foldlM construction)?+ -- Because in the typical case, the Either allocation costs exceed+ -- any benefits. The pathological case, string length >> width, is+ -- probably rare.+ | z + V.safeWcwidth c > w = (i, -1)+ -- Width not yet exceeded. Increment index and add character width.+ | otherwise = (i + 1, z + V.safeWcwidth c)+ -- | Hyperlink the given widget to the specified URL. Not all terminal -- emulators support this. In those that don't, this should have no -- discernible effect.@@ -476,6 +488,19 @@ -- in the specified order (uppermost first). Defers growth policies to -- the growth policies of the contained widgets (if any are greedy, so -- is the box).+--+-- Allocates space to 'Fixed' elements first and 'Greedy' elements+-- second. For example, if a 'vBox' contains three elements @A@, @B@,+-- and @C@, and if @A@ and @B@ are 'Fixed', then 'vBox' first renders+-- @A@ and @B@. Suppose those two take up 10 rows total, and the 'vBox'+-- was given 50 rows. This means 'vBox' then allocates the remaining+-- 40 rows to @C@. If, on the other hand, @A@ and @B@ take up 50 rows+-- together, @C@ will not be rendered at all.+--+-- If all elements are 'Greedy', 'vBox' allocates the available height+-- evenly among the elements. So, for example, if a 'vBox' is rendered+-- in 90 rows and has three 'Greedy' elements, each element will be+-- allocated 30 rows. {-# NOINLINE vBox #-} vBox :: [Widget n] -> Widget n vBox [] = emptyWidget@@ -486,6 +511,19 @@ -- in the specified order (leftmost first). Defers growth policies to -- the growth policies of the contained widgets (if any are greedy, so -- is the box).+--+-- Allocates space to 'Fixed' elements first and 'Greedy' elements+-- second. For example, if an 'hBox' contains three elements @A@, @B@,+-- and @C@, and if @A@ and @B@ are 'Fixed', then 'hBox' first renders+-- @A@ and @B@. Suppose those two take up 10 columns total, and the+-- 'hBox' was given 50 columns. This means 'hBox' then allocates the+-- remaining 40 columns to @C@. If, on the other hand, @A@ and @B@ take+-- up 50 columns together, @C@ will not be rendered at all.+--+-- If all elements are 'Greedy', 'hBox' allocates the available width+-- evenly among the elements. So, for example, if an 'hBox' is rendered+-- in 90 columns and has three 'Greedy' elements, each element will be+-- allocated 30 columns. {-# NOINLINE hBox #-} hBox :: [Widget n] -> Widget n hBox [] = emptyWidget@@ -508,7 +546,6 @@ , imagePrimary :: V.Image -> Int , imageSecondary :: V.Image -> Int , limitPrimary :: Int -> Widget n -> Widget n- , limitSecondary :: Int -> Widget n -> Widget n , primaryWidgetSize :: Widget n -> Size , concatenatePrimary :: [V.Image] -> V.Image , concatenateSecondary :: [V.Image] -> V.Image@@ -534,7 +571,6 @@ , imagePrimary = V.imageHeight , imageSecondary = V.imageWidth , limitPrimary = vLimit- , limitSecondary = hLimit , primaryWidgetSize = vSize , concatenatePrimary = V.vertCat , concatenateSecondary = V.horizCat@@ -562,7 +598,6 @@ , imagePrimary = V.imageWidth , imageSecondary = V.imageHeight , limitPrimary = hLimit- , limitSecondary = vLimit , primaryWidgetSize = hSize , concatenatePrimary = V.horizCat , concatenateSecondary = V.vertCat@@ -639,18 +674,13 @@ (his, lows) = partition (\p -> (primaryWidgetSize br $ snd p) == Fixed) pairsIndexed - let availPrimary = c^.(contextPrimary br)- availSecondary = c^.(contextSecondary br)- renderHi prim = do remainingPrimary <- get- result <- lift $ render $ limitPrimary br remainingPrimary- $ limitSecondary br availSecondary- $ cropToContext prim+ result <- lift $ render $ limitPrimary br remainingPrimary prim result <$ (put $! remainingPrimary - (result^.imageL.(to $ imagePrimary br))) (renderedHis, remainingPrimary) <-- runStateT (traverse (traverse renderHi) his) availPrimary+ runStateT (traverse (traverse renderHi) his) (c ^. contextPrimary br) renderedLows <- case lows of [] -> return []@@ -660,10 +690,7 @@ primaries = replicate rest (primaryPerLow + 1) <> replicate (length ls - rest) primaryPerLow - let renderLow ((i, prim), pri) =- (i,) <$> (render $ limitPrimary br pri- $ limitSecondary br availSecondary- $ cropToContext prim)+ let renderLow ((i, prim), pri) = (i,) <$> render (limitPrimary br pri prim) if remainingPrimary > 0 then mapM renderLow (zip ls primaries) else return [] @@ -692,12 +719,11 @@ (concatMap extents allTranslatedResults) newBorders -catDynBorder- :: Lens' (Edges BorderSegment) BorderSegment- -> Lens' (Edges BorderSegment) BorderSegment- -> DynBorder- -> DynBorder- -> Maybe DynBorder+catDynBorder :: Lens' (Edges BorderSegment) BorderSegment+ -> Lens' (Edges BorderSegment) BorderSegment+ -> DynBorder+ -> DynBorder+ -> Maybe DynBorder catDynBorder towardsA towardsB a b -- Currently, we check if the 'BorderStyle's are exactly the same. In the -- future, it might be nice to relax this restriction. For example, if a@@ -715,12 +741,11 @@ = Just (a & dbSegmentsL.towardsB.bsDrawL .~ True) | otherwise = Nothing -catDynBorders- :: Lens' (Edges BorderSegment) BorderSegment- -> Lens' (Edges BorderSegment) BorderSegment- -> I.IMap DynBorder- -> I.IMap DynBorder- -> I.IMap DynBorder+catDynBorders :: Lens' (Edges BorderSegment) BorderSegment+ -> Lens' (Edges BorderSegment) BorderSegment+ -> I.IMap DynBorder+ -> I.IMap DynBorder+ -> I.IMap DynBorder catDynBorders towardsA towardsB am bm = I.mapMaybe id $ I.intersectionWith (catDynBorder towardsA towardsB) am bm @@ -730,9 +755,8 @@ -- images to keep the image in sync with the border information. -- -- The input borders are assumed to be disjoint. This property is not checked.-catBorders- :: (border ~ BM.BorderMap DynBorder, rewrite ~ I.IMap V.Image)- => BoxRenderer n -> border -> border -> ((rewrite, rewrite), border)+catBorders :: (border ~ BM.BorderMap DynBorder, rewrite ~ I.IMap V.Image)+ => BoxRenderer n -> border -> border -> ((rewrite, rewrite), border) catBorders br r l = if lCoord + 1 == rCoord then ((lRe, rRe), lr') else ((I.empty, I.empty), lr)@@ -761,20 +785,20 @@ -- overlap and are strictly increasing in the primary direction), produce: a -- list of rewrites for the lo and hi directions of each border, respectively, -- and the borders describing the fully concatenated object.-catAllBorders ::- BoxRenderer n ->- [BM.BorderMap DynBorder] ->- ([(I.IMap V.Image, I.IMap V.Image)], BM.BorderMap DynBorder)+catAllBorders :: BoxRenderer n+ -> [BM.BorderMap DynBorder]+ -> ([(I.IMap V.Image, I.IMap V.Image)], BM.BorderMap DynBorder) catAllBorders _ [] = ([], BM.empty) catAllBorders br (bm:bms) = (zip ([I.empty]++los) (his++[I.empty]), bm') where (rewrites, bm') = runState (traverse (state . catBorders br) bms) bm (his, los) = unzip rewrites -rewriteEdge ::- (Int -> V.Image -> V.Image) ->- (Int -> V.Image -> V.Image) ->- ([V.Image] -> V.Image) ->- I.IMap V.Image -> V.Image -> V.Image+rewriteEdge :: (Int -> V.Image -> V.Image)+ -> (Int -> V.Image -> V.Image)+ -> ([V.Image] -> V.Image)+ -> I.IMap V.Image+ -> V.Image+ -> V.Image rewriteEdge splitLo splitHi combine = (combine .) . go . offsets 0 . I.unsafeToAscList where -- convert absolute positions into relative ones@@ -811,9 +835,11 @@ -- growth of otherwise-greedy widgets. This is non-greedy horizontally -- and defers to the limited widget vertically. hLimit :: Int -> Widget n -> Widget n-hLimit w p =- Widget Fixed (vSize p) $- withReaderT (availWidthL %~ (min w)) $ render $ cropToContext p+hLimit w p+ | w <= 0 = emptyWidget+ | otherwise =+ Widget Fixed (vSize p) $+ withReaderT (availWidthL %~ (min w)) $ render $ cropToContext p -- | Limit the space available to the specified widget to the specified -- percentage of available width, as a value between 0 and 100@@ -822,22 +848,26 @@ -- growth of otherwise-greedy widgets. This is non-greedy horizontally -- and defers to the limited widget vertically. hLimitPercent :: Int -> Widget n -> Widget n-hLimitPercent w' p =- Widget Fixed (vSize p) $ do- let w = clamp 0 100 w'- ctx <- getContext- let usableWidth = ctx^.availWidthL- widgetWidth = round (toRational usableWidth * (toRational w / 100))- withReaderT (availWidthL %~ (min widgetWidth)) $ render $ cropToContext p+hLimitPercent w' p+ | w' <= 0 = emptyWidget+ | otherwise =+ Widget Fixed (vSize p) $ do+ let w = clamp 0 100 w'+ ctx <- getContext+ let usableWidth = ctx^.availWidthL+ widgetWidth = round (toRational usableWidth * (toRational w / 100))+ withReaderT (availWidthL %~ (min widgetWidth)) $ render $ cropToContext p -- | Limit the space available to the specified widget to the specified -- number of rows. This is important for constraining the vertical -- growth of otherwise-greedy widgets. This is non-greedy vertically and -- defers to the limited widget horizontally. vLimit :: Int -> Widget n -> Widget n-vLimit h p =- Widget (hSize p) Fixed $- withReaderT (availHeightL %~ (min h)) $ render $ cropToContext p+vLimit h p+ | h <= 0 = emptyWidget+ | otherwise =+ Widget (hSize p) Fixed $+ withReaderT (availHeightL %~ (min h)) $ render $ cropToContext p -- | Limit the space available to the specified widget to the specified -- percentage of available height, as a value between 0 and 100@@ -846,22 +876,26 @@ -- growth of otherwise-greedy widgets. This is non-greedy vertically and -- defers to the limited widget horizontally. vLimitPercent :: Int -> Widget n -> Widget n-vLimitPercent h' p =- Widget (hSize p) Fixed $ do- let h = clamp 0 100 h'- ctx <- getContext- let usableHeight = ctx^.availHeightL- widgetHeight = round (toRational usableHeight * (toRational h / 100))- withReaderT (availHeightL %~ (min widgetHeight)) $ render $ cropToContext p+vLimitPercent h' p+ | h' <= 0 = emptyWidget+ | otherwise =+ Widget (hSize p) Fixed $ do+ let h = clamp 0 100 h'+ ctx <- getContext+ let usableHeight = ctx^.availHeightL+ widgetHeight = round (toRational usableHeight * (toRational h / 100))+ withReaderT (availHeightL %~ (min widgetHeight)) $ render $ cropToContext p -- | Set the rendering context height and width for this widget. This -- is useful for relaxing the rendering size constraints on e.g. layer -- widgets where cropping to the screen size is undesirable. setAvailableSize :: (Int, Int) -> Widget n -> Widget n-setAvailableSize (w, h) p =- Widget Fixed Fixed $- withReaderT (\c -> c & availHeightL .~ h & availWidthL .~ w) $- render $ cropToContext p+setAvailableSize (w, h) p+ | w <= 0 || h <= 0 = emptyWidget+ | otherwise =+ Widget Fixed Fixed $+ withReaderT (\c -> c & availHeightL .~ h & availWidthL .~ w) $+ render $ cropToContext p -- | When drawing the specified widget, set the attribute used for -- drawing to the one with the specified name. Note that the widget may@@ -886,7 +920,7 @@ -- , withAttr "highlight" (str b) -- ] ----- render1 = renderA ("Brick", "fun")+-- render1 = renderA (\"Brick\", "fun") -- render2 = withAttr "warning" render1 -- @ --@@ -930,7 +964,7 @@ -- , str " is " -- , withAttr "highlight" (str b) ] ----- render1 = renderA ("Brick", "fun")+-- render1 = renderA (\"Brick\", "fun") -- render2 = withDefAttr "warning" render1 -- @ --@@ -994,6 +1028,17 @@ c <- getContext withReaderT (ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p) +-- | Like 'forceAttr', except that the style of attribute lookups in the+-- attribute map is preserved and merged with the forced attribute. This+-- allows for situations where 'forceAttr' would otherwise ignore style+-- information that is important to preserve.+forceAttrAllowStyle :: AttrName -> Widget n -> Widget n+forceAttrAllowStyle an p =+ Widget (hSize p) (vSize p) $ do+ c <- getContext+ let m = c^.ctxAttrMapL+ withReaderT (ctxAttrMapL .~ (forceAttrMapAllowStyle (attrMapLookup an m) m)) (render p)+ -- | Override the lookup of the attribute name 'targetName' to return -- the attribute value associated with 'fromName' when rendering the -- specified widget.@@ -1036,15 +1081,16 @@ -- | Given a 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 just draws the specified widget with no special positioning.+-- 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 being rendered as-is with--- no translation. 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 @id@.+-- 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@. -- -- For example, if you have two layers @topLayer@ and @bottomLayer@, -- then a widget drawn in @bottomLayer@ with @reportExtent Foo@ can be@@ -1055,7 +1101,7 @@ Widget (hSize w) (vSize w) $ do mExt <- lookupReportedExtent n case mExt of- Nothing -> render w+ Nothing -> render emptyWidget Just ext -> render $ translateBy (extentUpperLeft ext <> off) w -- | Crop the specified widget on the left by the specified number of@@ -1066,8 +1112,11 @@ result <- render p let amt = V.imageWidth (result^.imageL) - cols cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img- return $ addResultOffset (Location (-1 * cols, 0))- $ result & imageL %~ cropped+ render $ Widget (hSize p) (vSize p) $+ withReaderT (availWidthL .~ amt) $+ cropResultToContext $+ addResultOffset (Location (-1 * cols, 0)) $+ result & imageL %~ cropped -- | Crop the specified widget to the specified size from the left. -- Defers to the cropped widget for growth policy.@@ -1089,7 +1138,8 @@ result <- render p let amt = V.imageWidth (result^.imageL) - cols cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img- return $ result & imageL %~ cropped+ withReaderT (availWidthL .~ amt) $+ cropResultToContext $ result & imageL %~ cropped -- | Crop the specified widget to the specified size from the right. -- Defers to the cropped widget for growth policy.@@ -1111,8 +1161,11 @@ result <- render p let amt = V.imageHeight (result^.imageL) - rows cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img- return $ addResultOffset (Location (0, -1 * rows))- $ result & imageL %~ cropped+ render $ Widget (hSize p) (vSize p) $+ withReaderT (availHeightL .~ amt) $+ cropResultToContext $+ addResultOffset (Location (0, -1 * rows)) $+ result & imageL %~ cropped -- | Crop the specified widget to the specified size from the top. -- Defers to the cropped widget for growth policy.@@ -1134,7 +1187,8 @@ result <- render p let amt = V.imageHeight (result^.imageL) - rows cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img- return $ result & imageL %~ cropped+ withReaderT (availHeightL .~ amt) $+ cropResultToContext $ result & imageL %~ cropped -- | Crop the specified widget to the specified size from the bottom. -- Defers to the cropped widget for growth policy.@@ -1206,7 +1260,6 @@ allClickables <- use clickableNamesL return [extentName e | e <- renderResult^.extentsL, extentName e `elem` allClickables] - cacheLookup :: (Ord n) => n -> RenderM n (Maybe ([n], Result n)) cacheLookup n = do cache <- lift $ gets (^.renderCacheL)@@ -1238,20 +1291,21 @@ -- | Render vertical viewport scroll bars in the specified widget with -- the specified renderer. This is only needed if you want to override -- the use of the default renderer, 'verticalScrollbarRenderer'.-withVScrollBarRenderer :: ScrollbarRenderer n -> Widget n -> Widget n+withVScrollBarRenderer :: VScrollbarRenderer n -> Widget n -> Widget n withVScrollBarRenderer r w = Widget (hSize w) (vSize w) $ withReaderT (ctxVScrollBarRendererL .~ Just r) (render w) -- | The default renderer for vertical viewport scroll bars. Override -- with 'withVScrollBarRenderer'.-verticalScrollbarRenderer :: ScrollbarRenderer n+verticalScrollbarRenderer :: VScrollbarRenderer n verticalScrollbarRenderer =- ScrollbarRenderer { renderScrollbar = fill '█'- , renderScrollbarTrough = fill ' '- , renderScrollbarHandleBefore = str "^"- , renderScrollbarHandleAfter = str "v"- }+ VScrollbarRenderer { renderVScrollbar = fill '█'+ , renderVScrollbarTrough = fill ' '+ , renderVScrollbarHandleBefore = str "^"+ , renderVScrollbarHandleAfter = str "v"+ , scrollbarWidthAllocation = 1+ } -- | Enable horizontal scroll bars on all viewports in the specified -- widget and draw them with the specified orientation.@@ -1296,20 +1350,21 @@ -- | Render horizontal viewport scroll bars in the specified widget with -- the specified renderer. This is only needed if you want to override -- the use of the default renderer, 'horizontalScrollbarRenderer'.-withHScrollBarRenderer :: ScrollbarRenderer n -> Widget n -> Widget n+withHScrollBarRenderer :: HScrollbarRenderer n -> Widget n -> Widget n withHScrollBarRenderer r w = Widget (hSize w) (vSize w) $ withReaderT (ctxHScrollBarRendererL .~ Just r) (render w) -- | The default renderer for horizontal viewport scroll bars. Override -- with 'withHScrollBarRenderer'.-horizontalScrollbarRenderer :: ScrollbarRenderer n+horizontalScrollbarRenderer :: HScrollbarRenderer n horizontalScrollbarRenderer =- ScrollbarRenderer { renderScrollbar = fill '█'- , renderScrollbarTrough = fill ' '- , renderScrollbarHandleBefore = str "<"- , renderScrollbarHandleAfter = str ">"- }+ HScrollbarRenderer { renderHScrollbar = fill '█'+ , renderHScrollbarTrough = fill ' '+ , renderHScrollbarHandleBefore = str "<"+ , renderHScrollbarHandleAfter = str ">"+ , scrollbarHeightAllocation = 1+ } -- | Render the specified widget in a named viewport with the -- specified type. This permits widgets to be scrolled without being@@ -1326,11 +1381,11 @@ -- don't like the appearance of the resulting scroll bars (defaults: -- 'verticalScrollbarRenderer' and 'horizontalScrollbarRenderer'), -- you can customize how they are drawn by making your own--- 'ScrollbarRenderer' and using 'withVScrollBarRenderer' and/or--- 'withHScrollBarRenderer'. Note that when you enable scrollbars, the--- content of your viewport will lose one column of available space if--- vertical scroll bars are enabled and one row of available space if--- horizontal scroll bars are enabled.+-- 'VScrollbarRenderer' or 'HScrollbarRenderer' and using+-- 'withVScrollBarRenderer' and/or 'withHScrollBarRenderer'. Note that+-- when you enable scrollbars, the content of your viewport will lose+-- one column of available space if vertical scroll bars are enabled and+-- one row of available space if horizontal scroll bars are enabled. -- -- If a viewport receives more than one visibility request, then the -- visibility requests are merged with the inner visibility request@@ -1394,8 +1449,8 @@ newSize = (newWidth, newHeight) newWidth = c^.availWidthL - vSBWidth newHeight = c^.availHeightL - hSBHeight- vSBWidth = maybe 0 (const 1) vsOrientation- hSBHeight = maybe 0 (const 1) hsOrientation+ vSBWidth = maybe 0 (const $ scrollbarWidthAllocation vsRenderer) vsOrientation+ hSBHeight = maybe 0 (const $ scrollbarHeightAllocation hsRenderer) hsOrientation doInsert (Just vp) = Just $ vp & vpSize .~ newSize doInsert Nothing = Just newVp @@ -1495,7 +1550,8 @@ let addVScrollbar = case vsOrientation of Nothing -> id Just orientation ->- let sb = verticalScrollbar vsRenderer vpname+ let sb = verticalScrollbar vsRenderer orientation+ vpname vsbClickableConstr showVHandles (vpFinal^.vpSize._2)@@ -1508,7 +1564,8 @@ addHScrollbar = case hsOrientation of Nothing -> id Just orientation ->- let sb = horizontalScrollbar hsRenderer vpname+ let sb = horizontalScrollbar hsRenderer orientation+ vpname hsbClickableConstr showHHandles (vpFinal^.vpSize._1)@@ -1562,7 +1619,7 @@ maybeClick _ Nothing _ w = w maybeClick n (Just f) el w = clickable (f el n) w --- | Build a vertical scroll bar using the specified render and+-- | Build a vertical scroll bar using the specified renderer and -- settings. -- -- You probably don't want to use this directly; instead,@@ -1571,8 +1628,13 @@ -- render a scroll bar of your own, you can do so outside the @viewport@ -- context. verticalScrollbar :: (Ord n)- => ScrollbarRenderer n+ => VScrollbarRenderer n -- ^ The renderer to use.+ -> VScrollBarOrientation+ -- ^ The scroll bar orientation. The orientation+ -- governs how additional padding is added to+ -- the scroll bar if it is smaller than it space+ -- allocation according to 'scrollbarWidthAllocation'. -> n -- ^ The viewport name associated with this scroll -- bar.@@ -1587,24 +1649,35 @@ -> Int -- ^ The total viewport content height. -> Widget n-verticalScrollbar vsRenderer n constr False vpHeight vOffset contentHeight =- verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight-verticalScrollbar vsRenderer n constr True vpHeight vOffset contentHeight =- vBox [ maybeClick n constr SBHandleBefore $- hLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleBefore vsRenderer- , verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight- , maybeClick n constr SBHandleAfter $- hLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleAfter vsRenderer- ]+verticalScrollbar vsRenderer o n constr showHandles vpHeight vOffset contentHeight =+ hLimit (scrollbarWidthAllocation vsRenderer) $+ applyPadding $+ if showHandles+ then vBox [ vLimit 1 $+ maybeClick n constr SBHandleBefore $+ withDefAttr scrollbarHandleAttr $ renderVScrollbarHandleBefore vsRenderer+ , sbBody+ , vLimit 1 $+ maybeClick n constr SBHandleAfter $+ withDefAttr scrollbarHandleAttr $ renderVScrollbarHandleAfter vsRenderer+ ]+ else sbBody+ where+ sbBody = verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight+ applyPadding = case o of+ OnLeft -> padRight Max+ OnRight -> padLeft Max verticalScrollbar' :: (Ord n)- => ScrollbarRenderer n+ => VScrollbarRenderer n -- ^ The renderer to use. -> n -- ^ The viewport name associated with this scroll -- bar. -> Maybe (ClickableScrollbarElement -> n -> n)- -- ^ Constructor for clickable scroll bar element names.+ -- ^ Constructor for clickable scroll bar element+ -- names. Will be given the element name and the+ -- viewport name. -> Int -- ^ The total viewport height in effect. -> Int@@ -1613,7 +1686,7 @@ -- ^ The total viewport content height. -> Widget n verticalScrollbar' vsRenderer _ _ vpHeight _ 0 =- hLimit 1 $ vLimit vpHeight $ renderScrollbarTrough vsRenderer+ vLimit vpHeight $ renderVScrollbarTrough vsRenderer verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight = Widget Fixed Greedy $ do c <- getContext@@ -1645,22 +1718,21 @@ sbAbove = maybeClick n constr SBTroughBefore $ withDefAttr scrollbarTroughAttr $ vLimit sbOffset $- renderScrollbarTrough vsRenderer+ renderVScrollbarTrough vsRenderer sbBelow = maybeClick n constr SBTroughAfter $ withDefAttr scrollbarTroughAttr $ vLimit (ctxHeight - (sbOffset + sbSize)) $- renderScrollbarTrough vsRenderer+ renderVScrollbarTrough vsRenderer sbMiddle = maybeClick n constr SBBar $- withDefAttr scrollbarAttr $ vLimit sbSize $ renderScrollbar vsRenderer+ withDefAttr scrollbarAttr $ vLimit sbSize $ renderVScrollbar vsRenderer - sb = hLimit 1 $- if sbSize == ctxHeight+ sb = if sbSize == ctxHeight then vLimit sbSize $- renderScrollbarTrough vsRenderer+ renderVScrollbarTrough vsRenderer else vBox [sbAbove, sbMiddle, sbBelow] render sb --- | Build a horizontal scroll bar using the specified render and+-- | Build a horizontal scroll bar using the specified renderer and -- settings. -- -- You probably don't want to use this directly; instead, use@@ -1669,14 +1741,21 @@ -- render a scroll bar of your own, you can do so outside the @viewport@ -- context. horizontalScrollbar :: (Ord n)- => ScrollbarRenderer n+ => HScrollbarRenderer n -- ^ The renderer to use.+ -> HScrollBarOrientation+ -- ^ The scroll bar orientation. The orientation+ -- governs how additional padding is added+ -- to the scroll bar if it is smaller+ -- than it space allocation according to+ -- 'scrollbarHeightAllocation'. -> n -- ^ The viewport name associated with this scroll -- bar. -> Maybe (ClickableScrollbarElement -> n -> n) -- ^ Constructor for clickable scroll bar element- -- names.+ -- names. Will be given the element name and the+ -- viewport name. -> Bool -- ^ Whether to show handles. -> Int@@ -1686,18 +1765,27 @@ -> Int -- ^ The total viewport content width. -> Widget n-horizontalScrollbar hsRenderer n constr False vpWidth hOffset contentWidth =- horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth-horizontalScrollbar hsRenderer n constr True vpWidth hOffset contentWidth =- hBox [ maybeClick n constr SBHandleBefore $- vLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleBefore hsRenderer- , horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth- , maybeClick n constr SBHandleAfter $- vLimit 1 $ withDefAttr scrollbarHandleAttr $ renderScrollbarHandleAfter hsRenderer- ]+horizontalScrollbar hsRenderer o n constr showHandles vpWidth hOffset contentWidth =+ vLimit (scrollbarHeightAllocation hsRenderer) $+ applyPadding $+ if showHandles+ then hBox [ hLimit 1 $+ maybeClick n constr SBHandleBefore $+ withDefAttr scrollbarHandleAttr $ renderHScrollbarHandleBefore hsRenderer+ , sbBody+ , hLimit 1 $+ maybeClick n constr SBHandleAfter $+ withDefAttr scrollbarHandleAttr $ renderHScrollbarHandleAfter hsRenderer+ ]+ else sbBody+ where+ sbBody = horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth+ applyPadding = case o of+ OnTop -> padBottom Max+ OnBottom -> padTop Max horizontalScrollbar' :: (Ord n)- => ScrollbarRenderer n+ => HScrollbarRenderer n -- ^ The renderer to use. -> n -- ^ The viewport name associated with this scroll@@ -1713,7 +1801,7 @@ -- ^ The total viewport content width. -> Widget n horizontalScrollbar' hsRenderer _ _ vpWidth _ 0 =- vLimit 1 $ hLimit vpWidth $ renderScrollbarTrough hsRenderer+ hLimit vpWidth $ renderHScrollbarTrough hsRenderer horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth = Widget Greedy Fixed $ do c <- getContext@@ -1744,17 +1832,16 @@ sbLeft = maybeClick n constr SBTroughBefore $ withDefAttr scrollbarTroughAttr $ hLimit sbOffset $- renderScrollbarTrough hsRenderer+ renderHScrollbarTrough hsRenderer sbRight = maybeClick n constr SBTroughAfter $ withDefAttr scrollbarTroughAttr $ hLimit (ctxWidth - (sbOffset + sbSize)) $- renderScrollbarTrough hsRenderer+ renderHScrollbarTrough hsRenderer sbMiddle = maybeClick n constr SBBar $- withDefAttr scrollbarAttr $ hLimit sbSize $ renderScrollbar hsRenderer+ withDefAttr scrollbarAttr $ hLimit sbSize $ renderHScrollbar hsRenderer - sb = vLimit 1 $- if sbSize == ctxWidth+ sb = if sbSize == ctxWidth then hLimit sbSize $- renderScrollbarTrough hsRenderer+ renderHScrollbarTrough hsRenderer else hBox [sbLeft, sbMiddle, sbRight] render sb
src/Brick/Widgets/Dialog.hs view
@@ -5,21 +5,25 @@ -- dialog title, if any, as well as its body and buttons. -- -- Note that this dialog is really for simple use cases where you want--- to get the user's answer to a question, such as "Would you like--- to save changes before quitting?" If you require something more--- sophisticated, you'll need to build it yourself. You might also--- consider seeing the 'Brick.Forms' module for help with input--- management, and see the implementation of this module to see how to--- reproduce a dialog-style UI.+-- to get the user's answer to a question, such as "Would you like to+-- save changes before quitting?" As is typical in such cases, we assume+-- that this dialog box is used modally, meaning that while it is open+-- it is has exclusive input focus until it is closed.+--+-- If you require something more sophisticated, you'll need to build it+-- yourself. You might also consider seeing the 'Brick.Forms' module for+-- help with input management and see the implementation of this module+-- to see how to reproduce a dialog-style UI. module Brick.Widgets.Dialog ( Dialog , dialogTitle , dialogButtons- , dialogSelectedIndex , dialogWidth -- * Construction and rendering , dialog , renderDialog+ , getDialogFocus+ , setDialogFocus -- * Handling events , handleDialogEvent -- * Getting a dialog's current value@@ -30,20 +34,20 @@ , buttonSelectedAttr -- * Lenses , dialogButtonsL- , dialogSelectedIndexL , dialogWidthL , dialogTitleL ) where import Lens.Micro+import Lens.Micro.Mtl ((%=)) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif-import Data.List (intersperse)+import Data.List (intersperse, find) import Graphics.Vty.Input (Event(..), Key(..)) -import Brick.Util (clamp)+import Brick.Focus import Brick.Types import Brick.Widgets.Core import Brick.Widgets.Center@@ -59,43 +63,55 @@ -- -- * Tab or Right Arrow: select the next button -- * Shift-tab or Left Arrow: select the previous button-data Dialog a =- Dialog { dialogTitle :: Maybe String+data Dialog a n =+ Dialog { dialogTitle :: Maybe (Widget n) -- ^ The dialog title- , dialogButtons :: [(String, a)]- -- ^ The dialog button labels and values- , dialogSelectedIndex :: Maybe Int- -- ^ The currently selected dialog button index (if any)+ , dialogButtons :: [(String, n, a)]+ -- ^ The dialog buttons' labels, resource names, and values , dialogWidth :: Int -- ^ The maximum width of the dialog+ , dialogFocus :: FocusRing n+ -- ^ The focus ring for the dialog's buttons } suffixLenses ''Dialog -handleDialogEvent :: Event -> EventM n (Dialog a) ()+handleDialogEvent :: Event -> EventM n (Dialog a n) () handleDialogEvent ev = do- modify $ \d -> case ev of- EvKey (KChar '\t') [] -> nextButtonBy 1 True d- EvKey KBackTab [] -> nextButtonBy (-1) True d- EvKey KRight [] -> nextButtonBy 1 False d- EvKey KLeft [] -> nextButtonBy (-1) False d- _ -> d+ case ev of+ EvKey (KChar '\t') [] -> dialogFocusL %= focusNext+ EvKey KRight [] -> dialogFocusL %= focusNext+ EvKey KBackTab [] -> dialogFocusL %= focusPrev+ EvKey KLeft [] -> dialogFocusL %= focusPrev+ _ -> return () +-- | Set the focused button of a dialog.+setDialogFocus :: (Eq n) => n -> Dialog a n -> Dialog a n+setDialogFocus n d = d { dialogFocus = focusSetCurrent n $ dialogFocus d }++-- | Get the focused button of a dialog.+getDialogFocus :: Dialog a n -> Maybe n+getDialogFocus = focusGetCurrent . dialogFocus+ -- | Create a dialog.-dialog :: Maybe String+dialog :: (Eq n)+ => Maybe (Widget n) -- ^ The dialog title- -> Maybe (Int, [(String, a)])- -- ^ The currently-selected button index (starting at zero) and- -- the button labels and values to use+ -> Maybe (n, [(String, n, a)])+ -- ^ The currently-selected button resource name and the button+ -- labels, resource names, and values to use for each button,+ -- respectively -> Int -- ^ The maximum width of the dialog- -> Dialog a+ -> Dialog a n dialog title buttonData w =- let (buttons, idx) = case buttonData of- Nothing -> ([], Nothing)- Just (_, []) -> ([], Nothing)- Just (i, bs) -> (bs, Just $ clamp 0 (length bs - 1) i)- in Dialog title buttons idx w+ let (r, buttons) = case buttonData of+ Nothing ->+ (focusRing [], [])+ Just (focName, entries) ->+ let ns = (\(_, n, _) -> n) <$> entries+ in (focusSetCurrent focName $ focusRing ns, entries)+ in Dialog title buttons w r -- | The default attribute of the dialog dialogAttr :: AttrName@@ -113,17 +129,25 @@ -- dialog as a layer, which makes this suitable as a top-level layer in -- your rendering function to be rendered on top of the rest of your -- interface.-renderDialog :: Dialog a -> Widget n -> Widget n+renderDialog :: (Ord n) => Dialog a n -> Widget n -> Widget n renderDialog d body = let buttonPadding = str " "- mkButton (i, (s, _)) = let att = if Just i == d^.dialogSelectedIndexL- then buttonSelectedAttr- else buttonAttr- in withAttr att $ str $ " " <> s <> " "+ foc = focusGetCurrent $ dialogFocus d+ mkButton (s, n, _) =+ let att = if Just n == foc+ then buttonSelectedAttr+ else buttonAttr+ csr = if Just n == foc+ then putCursor n (Location (1,0))+ else id+ in csr $+ clickable n $+ withAttr att $+ str $ " " <> s <> " " buttons = hBox $ intersperse buttonPadding $- mkButton <$> (zip [0..] (d^.dialogButtonsL))+ mkButton <$> (d^.dialogButtonsL) - doBorder = maybe border borderWithLabel (str <$> d^.dialogTitleL)+ doBorder = maybe border borderWithLabel (d^.dialogTitleL) in centerLayer $ withDefAttr dialogAttr $ hLimit (d^.dialogWidthL) $@@ -132,24 +156,12 @@ , hCenter buttons ] -nextButtonBy :: Int -> Bool -> Dialog a -> Dialog a-nextButtonBy amt wrapCycle d =- let numButtons = length $ d^.dialogButtonsL- in if numButtons == 0 then d- else case d^.dialogSelectedIndexL of- Nothing -> d & dialogSelectedIndexL .~ (Just 0)- Just i -> d & dialogSelectedIndexL .~ (Just newIndex)- where- addedIndex = i + amt- newIndex = if wrapCycle- then addedIndex `mod` numButtons- else max 0 $ min addedIndex $ numButtons - 1---- | Obtain the value associated with the dialog's currently-selected--- button, if any. This function is probably what you want when someone--- presses 'Enter' in a dialog.-dialogSelection :: Dialog a -> Maybe a-dialogSelection d =- case d^.dialogSelectedIndexL of- Nothing -> Nothing- Just i -> Just $ ((d^.dialogButtonsL) !! i)^._2+-- | Obtain the resource name and value associated with the dialog's+-- currently-selected button, if any. The result of this function is+-- probably what you want when someone presses 'Enter' in a dialog.+dialogSelection :: (Eq n) => Dialog a n -> Maybe (n, a)+dialogSelection d = do+ n' <- focusGetCurrent $ dialogFocus d+ let matches (_, n, _) = n == n'+ (_, n, a) <- find matches (d^.dialogButtonsL)+ return (n, a)
src/Brick/Widgets/Edit.hs view
@@ -169,7 +169,7 @@ -> Editor T.Text n editorText = editor --- | Construct an editor over 'String' values+-- | Construct an editor over generic text values editor :: Z.GenericTextZipper a => n -- ^ The editor's name (must be unique)@@ -188,7 +188,7 @@ -- any edits applied here will be ignored if they edit text outside -- the line limit. applyEdit :: (Z.TextZipper t -> Z.TextZipper t)- -- ^ The 'Data.Text.Zipper' editing transformation to apply+ -- ^ The 'Z.TextZipper' editing transformation to apply -> Editor t n -> Editor t n applyEdit f e = e & editContentsL %~ f
src/Brick/Widgets/FileBrowser.hs view
@@ -71,6 +71,7 @@ , actionFileBrowserBeginSearch , actionFileBrowserSelectEnter , actionFileBrowserSelectCurrent+ , actionFileBrowserToggleCurrent , actionFileBrowserListPageUp , actionFileBrowserListPageDown , actionFileBrowserListHalfPageUp@@ -143,9 +144,10 @@ where import qualified Control.Exception as E-import Control.Monad (forM)+import Control.Monad (forM, when) import Control.Monad.IO.Class (liftIO) import Data.Char (toLower, isPrint)+import Data.Foldable (for_) import Data.Maybe (fromMaybe, isJust, fromJust) import qualified Data.Foldable as F import qualified Data.Text as T@@ -153,16 +155,16 @@ import Data.Monoid #endif import Data.Int (Int64)-import Data.List (sortBy, isSuffixOf)+import Data.List (sortBy, isSuffixOf, dropWhileEnd) import qualified Data.Set as Set import qualified Data.Vector as V import Lens.Micro-import Lens.Micro.Mtl ((%=))+import Lens.Micro.Mtl ((%=), use) import Lens.Micro.TH (lensRules, generateUpdateableOptics) import qualified Graphics.Vty as Vty import qualified System.Directory as D-import qualified System.Posix.Files as U-import qualified System.Posix.Types as U+import qualified System.PosixCompat.Files as U+import qualified System.PosixCompat.Types as U import qualified System.FilePath as FP import Text.Printf (printf) @@ -281,7 +283,7 @@ -> IO (FileBrowser n) newFileBrowser selPredicate name mCwd = do initialCwd <- FP.normalise <$> case mCwd of- Just path -> return path+ Just path -> return $ removeTrailingSlash path Nothing -> D.getCurrentDirectory let b = FileBrowser { fileBrowserWorkingDirectory = initialCwd@@ -297,6 +299,22 @@ setWorkingDirectory initialCwd b +-- | Removes any trailing slash(es) from the supplied FilePath (which should+-- indicate a directory). This does not remove a sole slash indicating the root+-- directory.+--+-- This is done because if the FileBrowser is initialized with an initial working+-- directory that ends in a slash, then selecting the "../" entry to move to the+-- parent directory will cause the removal of the trailing slash, but it will not+-- otherwise cause any change, misleading the user into thinking no action was+-- taken (the disappearance of the trailing slash is unlikely to be noticed).+-- All subsequent parent directory selection operations are processed normally,+-- and the 'fileBrowserWorkingDirectory' never ends in a trailing slash+-- thereafter (except at the root directory).+removeTrailingSlash :: FilePath -> FilePath+removeTrailingSlash "/" = "/"+removeTrailingSlash d = dropWhileEnd (== '/') d+ -- | A file entry selector that permits selection of all file entries -- except directories. Use this if you want users to be able to navigate -- directories in the browser. If you want users to be able to select@@ -318,10 +336,7 @@ selectDirectories i = case fileInfoFileType i of Just Directory -> True- Just SymbolicLink ->- case fileInfoLinkTargetType i of- Just Directory -> True- _ -> False+ Just SymbolicLink -> fileInfoLinkTargetType i == Just Directory _ -> False -- | Set the filtering function used to determine which entries in@@ -362,7 +377,7 @@ Left (_::E.IOException) -> entries Right parent -> parent : entries - return $ (setEntries allEntries b)+ return $ setEntries allEntries b & fileBrowserWorkingDirectoryL .~ path & fileBrowserExceptionL .~ exc & fileBrowserSelectedFilesL .~ mempty@@ -492,7 +507,7 @@ applyFilterAndSearch b = let filterMatch = fromMaybe (const True) (b^.fileBrowserEntryFilterL) searchMatch = maybe (const True)- (\search i -> (T.toLower search `T.isInfixOf` (T.pack $ toLower <$> fileInfoSanitizedFilename i)))+ (\search i -> T.toLower search `T.isInfixOf` T.pack (toLower <$> fileInfoSanitizedFilename i)) (b^.fileBrowserSearchStringL) match i = filterMatch i && searchMatch i matching = filter match $ b^.fileBrowserLatestResultsL@@ -588,7 +603,7 @@ -- -- * @/@: 'actionFileBrowserBeginSearch' -- * @Enter@: 'actionFileBrowserSelectEnter'--- * @Space@: 'actionFileBrowserSelectCurrent'+-- * @Space@: 'actionFileBrowserToggleCurrent' -- * @g@: 'actionFileBrowserListTop' -- * @G@: 'actionFileBrowserListBottom' -- * @j@: 'actionFileBrowserListNext'@@ -611,6 +626,10 @@ actionFileBrowserSelectCurrent = selectCurrentEntry +actionFileBrowserToggleCurrent :: EventM n (FileBrowser n) ()+actionFileBrowserToggleCurrent =+ toggleCurrentEntrySelected+ actionFileBrowserListPageUp :: Ord n => EventM n (FileBrowser n) () actionFileBrowserListPageUp = zoom fileBrowserEntriesL listMovePageUp@@ -683,8 +702,8 @@ -- Select file or enter directory actionFileBrowserSelectEnter Vty.EvKey (Vty.KChar ' ') [] ->- -- Select entry- actionFileBrowserSelectCurrent+ -- Toggle selected status of current entry+ actionFileBrowserToggleCurrent _ -> handleFileBrowserEventCommon e @@ -714,6 +733,29 @@ _ -> zoom fileBrowserEntriesL $ handleListEvent e +toggleSelected :: FileInfo -> EventM n (FileBrowser n) ()+toggleSelected e = do+ sel <- fileBrowserIsSelected e+ if sel+ then fileBrowserRemoveSelected e+ else fileBrowserAddSelected e++fileBrowserIsSelected :: FileInfo -> EventM n (FileBrowser n) Bool+fileBrowserIsSelected e = do+ fs <- use fileBrowserSelectedFilesL+ let fName = fileInfoFilename e+ return $ Set.member fName fs++fileBrowserAddSelected :: FileInfo -> EventM n (FileBrowser n) ()+fileBrowserAddSelected e = do+ let fName = fileInfoFilename e+ fileBrowserSelectedFilesL %= Set.insert fName++fileBrowserRemoveSelected :: FileInfo -> EventM n (FileBrowser n) ()+fileBrowserRemoveSelected e = do+ let fName = fileInfoFilename e+ fileBrowserSelectedFilesL %= Set.delete fName+ -- | If the browser's current entry is selectable according to -- @fileBrowserSelectable@, add it to the selection set and return. -- If not, and if the entry is a directory or a symlink targeting a@@ -723,30 +765,26 @@ maybeSelectCurrentEntry :: EventM n (FileBrowser n) () maybeSelectCurrentEntry = do b <- get- case fileBrowserCursor b of- Nothing -> return ()- Just entry ->- if fileBrowserSelectable b entry- then fileBrowserSelectedFilesL %= Set.insert (fileInfoFilename entry)- else case fileInfoFileType entry of- Just Directory ->- put =<< (liftIO $ setWorkingDirectory (fileInfoFilePath entry) b)- Just SymbolicLink ->- case fileInfoLinkTargetType entry of- Just Directory ->- put =<< (liftIO $ setWorkingDirectory (fileInfoFilePath entry) b)- _ ->- return ()- _ ->- return ()+ for_ (fileBrowserCursor b) $ \entry ->+ if fileBrowserSelectable b entry+ then fileBrowserAddSelected entry+ else when (selectDirectories entry) $+ put =<< liftIO (setWorkingDirectory (fileInfoFilePath entry) b) selectCurrentEntry :: EventM n (FileBrowser n) () selectCurrentEntry = do b <- get- case fileBrowserCursor b of- Nothing -> return ()- Just e -> fileBrowserSelectedFilesL %= Set.insert (fileInfoFilename e)+ for_ (fileBrowserCursor b) $ \entry ->+ when (fileBrowserSelectable b entry) $+ fileBrowserAddSelected entry +toggleCurrentEntrySelected :: EventM n (FileBrowser n) ()+toggleCurrentEntrySelected = do+ b <- get+ for_ (fileBrowserCursor b) $ \entry ->+ when (fileBrowserSelectable b entry) $+ toggleSelected entry+ -- | Render a file browser. This renders a list of entries in the -- working directory, a cursor to select from among the entries, a -- header displaying the working directory, and a footer displaying@@ -765,7 +803,7 @@ -- ^ The browser to render. -> Widget n renderFileBrowser foc b =- let maxFilenameLength = maximum $ (length . fileInfoFilename) <$> (b^.fileBrowserEntriesL)+ let maxFilenameLength = maximum $ length . fileInfoFilename <$> (b^.fileBrowserEntriesL) cwdHeader = padRight Max $ str $ sanitizeFilename $ fileBrowserWorkingDirectory b selInfo = case listSelectedElement (b^.fileBrowserEntriesL) of@@ -789,7 +827,7 @@ then ", " <> prettyFileSize (fileStatusSize stat) else "" in fileTypeLabel (fileStatusFileType stat) <> maybeSize- in txt $ (T.pack $ fileInfoSanitizedFilename i) <> ": " <> label+ in txt $ T.pack (fileInfoSanitizedFilename i) <> ": " <> label maybeSearchInfo = case b^.fileBrowserSearchStringL of Nothing -> emptyWidget
src/Brick/Widgets/Internal.hs view
@@ -8,8 +8,9 @@ ) where -import Lens.Micro ((^.), (&), (%~))+import Lens.Micro ((^.), (&), (%~), (.~)) import Lens.Micro.Mtl ((%=))+import Control.Monad import Control.Monad.State.Strict import Control.Monad.Reader import Data.Maybe (fromMaybe, mapMaybe)@@ -34,7 +35,13 @@ renderFinal aMap layerRenders (w, h) chooseCursor rs = (newRS, picWithBg, theCursor, concat layerExtents) where- (layerResults, !newRS) = flip runState rs $ sequence $+ -- Reset various fields from the last rendering state so they+ -- don't accumulate or affect this rendering.+ resetRs = rs & reportedExtentsL .~ mempty+ & observedNamesL .~ mempty+ & clickableNamesL .~ mempty++ (layerResults, !newRS) = flip runState resetRs $ sequence $ (\p -> runReaderT p ctx) <$> (\layerWidget -> do result <- render $ cropToContext layerWidget@@ -106,29 +113,31 @@ cropExtents :: Context n -> [Extent n] -> [Extent n] cropExtents ctx es = mapMaybe cropExtent es where- -- An extent is cropped in places where it is not within the- -- region described by the context.- --- -- If its entirety is outside the context region, it is dropped.- --- -- Otherwise its size is adjusted so that it is contained within- -- the context region. cropExtent (Extent n (Location (c, r)) (w, h)) =- -- Determine the new lower-right corner- let endCol = c + w- endRow = r + h- -- Then clamp the lower-right corner based on the- -- context- endCol' = min (ctx^.availWidthL) endCol- endRow' = min (ctx^.availHeightL) endRow- -- Then compute the new width and height from the- -- clamped lower-right corner.- w' = endCol' - c- h' = endRow' - r- e = Extent n (Location (c, r)) (w', h')- in if w' < 0 || h' < 0- then Nothing- else Just e+ -- Clamp the original extent's UL corner to the context.+ --+ -- Clamp the original extent's LR corner to the context.+ --+ -- Keep the modified extent (i.e. with clamped corners)+ -- only if the resulting extent has non-zero size in both+ -- dimensions.+ let nonEmpty = nonEmptyH && nonEmptyV+ nonEmptyH = newWidth > 0+ nonEmptyV = newHeight > 0+ newWidth = newEndCol - newStartCol+ newHeight = newEndRow - newStartRow+ (newStartCol, newStartRow) = clampCorner (c, r)+ (newEndCol, newEndRow) = clampCorner (c + w, r + h)+ clampCorner (cols, rows) =+ ( clampRange (ctx^.availWidthL) cols+ , clampRange (ctx^.availHeightL) rows+ )+ clampRange bound val =+ min bound $ max 0 val+ newExtent = Extent n (Location (newStartCol, newStartRow)) (newWidth, newHeight)+ in if nonEmpty+ then Just newExtent+ else Nothing cropBorders :: Context n -> BorderMap DynBorder -> BorderMap DynBorder cropBorders ctx = BM.crop Edges
src/Brick/Widgets/List.hs view
@@ -63,6 +63,9 @@ , listReverse , listModify + -- * Querying a list+ , listFindFirst+ -- * Attributes , listAttr , listSelectedAttr@@ -204,9 +207,9 @@ _ -> return () -- | Enable list movement with the vi keys with a fallback handler if--- none match. Use 'handleListEventVi' 'handleListEvent' in place of--- 'handleListEvent' to add the vi keys bindings to the standard ones.--- Movements handled include:+-- none match. Use 'handleListEventVi' in place of 'handleListEvent'+-- to add the vi keys bindings to the standard ones. Movements handled+-- include: -- -- * Up (k) -- * Down (j)@@ -577,6 +580,20 @@ -> GenericList n t e -> GenericList n t e listMoveToElement e = listFindBy (== e) . set listSelectedL Nothing++-- | Find the first element in the list that satisfies the specified+-- predicate. If such an element is found, return the resulting index+-- and element.+--+-- /O(n)/.+listFindFirst :: (Semigroup (t e), Splittable t, Traversable t)+ => (e -> Bool)+ -> GenericList n t e+ -> Maybe (Int, e)+listFindFirst f l =+ listSelectedElement $+ listFindBy f $+ set listSelectedL Nothing l -- | Starting from the currently-selected position, attempt to find -- and select the next element matching the predicate. If there are no
src/Brick/Widgets/ProgressBar.hs view
@@ -3,6 +3,7 @@ -- | This module provides a progress bar widget. module Brick.Widgets.ProgressBar ( progressBar+ , customProgressBar -- * Attributes , progressCompleteAttr , progressIncompleteAttr@@ -37,17 +38,42 @@ -> Float -- ^ The progress value. Should be between 0 and 1 inclusive. -> Widget n-progressBar mLabel progress =+progressBar = customProgressBar ' ' ' '++-- | Draw a progress bar with the specified (optional) label,+-- 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)+customProgressBar :: Char+ -- ^ Character to fill the completed part.+ -> Char+ -- ^ Character to fill the incomplete part.+ -> Maybe String+ -- ^ The label. If specified, this is shown in the center of+ -- the progress bar.+ -> Float+ -- ^ The progress value. Should be between 0 and 1 inclusive.+ -> Widget n+customProgressBar completeChar incompleteChar mLabel progress = Widget Greedy Fixed $ do c <- getContext let barWidth = c^.availWidthL label = fromMaybe "" mLabel labelWidth = safeWcswidth label spacesWidth = barWidth - labelWidth- leftPart = replicate (spacesWidth `div` 2) ' '- rightPart = replicate (barWidth - (labelWidth + length leftPart)) ' '+ leftWidth = spacesWidth `div` 2+ rightWidth = barWidth - labelWidth - leftWidth+ completeWidth = round $ progress * toEnum barWidth++ leftCompleteWidth = min leftWidth completeWidth+ leftIncompleteWidth = leftWidth - leftCompleteWidth+ leftPart = replicate leftCompleteWidth completeChar ++ replicate leftIncompleteWidth incompleteChar+ rightCompleteWidth = max 0 (completeWidth - labelWidth - leftWidth)+ rightIncompleteWidth = rightWidth - rightCompleteWidth+ rightPart = replicate rightCompleteWidth completeChar ++ replicate rightIncompleteWidth incompleteChar+ fullBar = leftPart <> label <> rightPart- completeWidth = round $ progress * toEnum (length fullBar) adjustedCompleteWidth = if completeWidth == length fullBar && progress < 1.0 then completeWidth - 1 else if completeWidth == 0 && progress > 0.0
src/Brick/Widgets/Table.hs view
@@ -31,6 +31,13 @@ -- * Rendering , renderTable++ -- * Low-level API+ , RenderedTableCells(..)+ , BorderConfiguration(..)+ , tableCellLayout+ , addBorders+ , alignColumns ) where @@ -90,11 +97,16 @@ , tableRows :: [[Widget n]] , defaultColumnAlignment :: ColumnAlignment , defaultRowAlignment :: RowAlignment- , drawSurroundingBorder :: Bool- , drawRowBorders :: Bool- , drawColumnBorders :: Bool+ , tableBorderConfiguration :: BorderConfiguration } +-- | A border configuration for a table.+data BorderConfiguration =+ BorderConfiguration { drawSurroundingBorder :: Bool+ , drawRowBorders :: Bool+ , drawColumnBorders :: Bool+ }+ -- | Construct a new table. -- -- The argument is the list of rows with the topmost row first, with@@ -148,27 +160,29 @@ t = Table { columnAlignments = mempty , rowAlignments = mempty , tableRows = rows- , drawSurroundingBorder = True- , drawRowBorders = True- , drawColumnBorders = True , defaultColumnAlignment = AlignLeft , defaultRowAlignment = AlignTop+ , tableBorderConfiguration =+ BorderConfiguration { drawSurroundingBorder = True+ , drawRowBorders = True+ , drawColumnBorders = True+ } } -- | Configure whether the table draws a border on its exterior. surroundingBorder :: Bool -> Table n -> Table n surroundingBorder b t =- t { drawSurroundingBorder = b }+ t { tableBorderConfiguration = (tableBorderConfiguration t) { drawSurroundingBorder = b } } -- | Configure whether the table draws borders between its rows. rowBorders :: Bool -> Table n -> Table n rowBorders b t =- t { drawRowBorders = b }+ t { tableBorderConfiguration = (tableBorderConfiguration t) { drawRowBorders = b } } -- | Configure whether the table draws borders between its columns. columnBorders :: Bool -> Table n -> Table n columnBorders b t =- t { drawColumnBorders = b }+ t { tableBorderConfiguration = (tableBorderConfiguration t) { drawColumnBorders = b } } -- | Align the specified column to the right. The argument is the column -- index, starting with zero. Silently does nothing if the index is out@@ -235,60 +249,104 @@ renderTable t = joinBorders $ Widget Fixed Fixed $ do- ctx <- getContext- cellResults <- forM (tableRows t) $ mapM render+ tableCellLayout t >>= addBorders >>= render - let maybeIntersperse f v = if f t then intersperse v else id- rowHeights = rowHeight <$> cellResults- colWidths = colWidth <$> byColumn- allRowAligns = (\i -> M.findWithDefault (defaultRowAlignment t) i (rowAlignments t)) <$>- [0..length rowHeights - 1]- allColAligns = (\i -> M.findWithDefault (defaultColumnAlignment t) i (columnAlignments t)) <$>- [0..length byColumn - 1]- rowHeight = maximum . fmap (imageHeight . image)- colWidth = maximum . fmap (imageWidth . image)- byColumn = transpose cellResults- toW = Widget Fixed Fixed . return- fillEmptyCell w h result =- if imageWidth (image result) == 0 && imageHeight (image result) == 0- then result { image = charFill (ctx^.attrL) ' ' w h }- else result- mkColumn (hAlign, width, colCells) =- let paddedCells = flip map (zip3 allRowAligns rowHeights colCells) $ \(vAlign, rHeight, cell) ->- applyColAlignment width hAlign $- applyRowAlignment rHeight vAlign $- toW $- fillEmptyCell width rHeight cell- maybeRowBorders = maybeIntersperse drawRowBorders (hLimit width hBorder)- in vBox $ maybeRowBorders paddedCells+-- | The result of performing table cell intermediate rendering and+-- layout.+data RenderedTableCells n =+ RenderedTableCells { renderedTableRows :: [[Widget n]]+ -- ^ The table's cells in row-major order.+ , renderedTableColumnWidths :: [Int]+ -- ^ The widths of the table's columns.+ , renderedTableRowHeights :: [Int]+ -- ^ The heights of the table's rows.+ , borderConfiguration :: BorderConfiguration+ -- ^ The border configuration to use.+ } - vBorders = mkVBorder <$> rowHeights- hBorders = mkHBorder <$> colWidths- mkHBorder w = hLimit w hBorder- mkVBorder h = vLimit h vBorder- topBorder =- hBox $ maybeIntersperse drawColumnBorders topT hBorders- bottomBorder =- hBox $ maybeIntersperse drawColumnBorders bottomT hBorders- leftBorder =- vBox $ topLeftCorner : maybeIntersperse drawRowBorders leftT vBorders <> [bottomLeftCorner]- rightBorder =- vBox $ topRightCorner : maybeIntersperse drawRowBorders rightT vBorders <> [bottomRightCorner]+-- | Augment rendered table cells with borders according to the+-- border configuration accompanying the cells.+addBorders :: RenderedTableCells n -> RenderM n (Widget n)+addBorders r = do+ let cfg = borderConfiguration r+ rows = renderedTableRows r+ rowHeights = renderedTableRowHeights r+ colWidths = renderedTableColumnWidths r - maybeWrap check f =- if check t then f else id- addSurroundingBorder body =- leftBorder <+> (topBorder <=> body <=> bottomBorder) <+> rightBorder- addColumnBorders =- let maybeAddCrosses = maybeIntersperse drawRowBorders cross- columnBorder = vBox $ maybeAddCrosses vBorders- in intersperse columnBorder+ contentWidth = sum colWidths+ contentHeight = sum rowHeights - let columns = mkColumn <$> zip3 allColAligns colWidths byColumn- body = hBox $- maybeWrap drawColumnBorders addColumnBorders columns- render $ maybeWrap drawSurroundingBorder addSurroundingBorder body+ hBorderLength = contentWidth + if drawColumnBorders cfg+ then max (length colWidths - 1) 0+ else 0+ vBorderHeight = contentHeight + if drawRowBorders cfg+ then max (length rowHeights - 1) 0+ else 0+ horizBorder = hLimit hBorderLength hBorder+ vertBorder = vLimit vBorderHeight vBorder + leftBorder =+ vBox [topLeftCorner, vertBorder, bottomLeftCorner]+ rightBorder =+ vBox [topRightCorner, vertBorder, bottomRightCorner]++ maybeWrap check f =+ if check cfg then f else id+ addSurroundingBorder b =+ leftBorder <+> (horizBorder <=> b <=> horizBorder) <+> rightBorder+ addRowBorders =+ intersperse horizBorder++ rowsWithColumnBorders = (\(h, row) -> hBox $ maybeColumnBorders h row) <$> zip rowHeights rows+ maybeColumnBorders height = maybeIntersperse cfg drawColumnBorders (vLimit height vBorder)+ body = vBox $+ maybeWrap drawRowBorders addRowBorders rowsWithColumnBorders++ return $ maybeWrap drawSurroundingBorder addSurroundingBorder body++tableCellLayout :: Table n -> RenderM n (RenderedTableCells n)+tableCellLayout t = do+ ctx <- getContext+ cellResults <- forM (tableRows t) $ mapM render++ let rowHeights = rowHeight <$> cellResults+ colWidths = colWidth <$> transpose cellResults+ numRows = length rowHeights+ numCols = if length cellResults >= 1+ then length (cellResults !! 0)+ else 0+ allRowAligns = (\i -> M.findWithDefault (defaultRowAlignment t) i (rowAlignments t)) <$>+ [0..numRows - 1]+ allColAligns = (\i -> M.findWithDefault (defaultColumnAlignment t) i (columnAlignments t)) <$>+ [0..numCols - 1]+ rowHeight = maximum . fmap (imageHeight . image)+ colWidth = maximum . fmap (imageWidth . image)++ toW = Widget Fixed Fixed . return+ fillEmptyCell w h result =+ if imageWidth (image result) == 0 && imageHeight (image result) == 0+ then result { image = charFill (ctx^.attrL) ' ' w h }+ else result+ mkRow (vAlign, height, rowCells) =+ let paddedCells = flip map (zip3 allColAligns colWidths rowCells) $ \(hAlign, width, cell) ->+ applyColAlignment width hAlign $+ applyRowAlignment height vAlign $+ toW $+ fillEmptyCell width height cell+ in paddedCells++ let rows = mkRow <$> zip3 allRowAligns rowHeights cellResults++ return $ RenderedTableCells { renderedTableRows = rows+ , renderedTableColumnWidths = colWidths+ , renderedTableRowHeights = rowHeights+ , borderConfiguration = tableBorderConfiguration t+ }++maybeIntersperse :: BorderConfiguration -> (BorderConfiguration -> Bool) -> Widget n -> [Widget n] -> [Widget n]+maybeIntersperse cfg f v | f cfg = intersperse v+ | otherwise = id+ topLeftCorner :: Widget n topLeftCorner = joinableBorder $ Edges False True False True @@ -301,20 +359,20 @@ bottomRightCorner :: Widget n bottomRightCorner = joinableBorder $ Edges True False True False -cross :: Widget n-cross = joinableBorder $ Edges True True True True--leftT :: Widget n-leftT = joinableBorder $ Edges True True False True--rightT :: Widget n-rightT = joinableBorder $ Edges True True True False--topT :: Widget n-topT = joinableBorder $ Edges False True True True--bottomT :: Widget n-bottomT = joinableBorder $ Edges True False True True+-- | Given a "table row" of widgets, align each one according to the+-- list of specified column alignments in columns of the specified+-- widths.+alignColumns :: [ColumnAlignment]+ -- ^ The column alignments to use for each widget,+ -- respectively.+ -> [Int]+ -- ^ The width of each column in terminal columns,+ -- respectively.+ -> [Widget n]+ -- ^ The column cells to align.+ -> [Widget n]+alignColumns as widths cells =+ (\(w, a, c) -> applyColAlignment w a c) <$> zip3 widths as cells applyColAlignment :: Int -> ColumnAlignment -> Widget n -> Widget n applyColAlignment width align w =
tests/List.hs view
@@ -348,6 +348,15 @@ in l' ^. listSelectedL == Just 1 && l'' ^. listSelectedL == Just 3 +prop_listFindFirst :: Bool+prop_listFindFirst =+ let v = L [1..5] :: L Int+ l = list () v 1+ result1 = listFindFirst even l+ result2 = listFindFirst (> 10) l+ in result1 == Just (1, 2) &&+ result2 == Nothing+ prop_listSelectedElement_lazy :: Bool prop_listSelectedElement_lazy = let v = L (1:2:3:4:undefined) :: L Int
tests/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}
tests/Render.hs view
@@ -10,6 +10,7 @@ import Data.Monoid #endif import qualified Graphics.Vty as V+import qualified Graphics.Vty.CrossPlatform.Testing as V import Brick.Widgets.Border (hBorder) import Control.Exception (SomeException, try) @@ -18,7 +19,7 @@ renderDisplay :: Ord n => [Widget n] -> IO () renderDisplay ws = do- outp <- V.outputForConfig V.defaultConfig+ outp <- V.mkDefaultOutput ctx <- V.displayContext outp region V.outputPicture ctx (renderWidget Nothing ws region) V.releaseDisplay outp