brick 1.6 → 2.12
raw patch · 64 files changed
Files
- CHANGELOG.md +254/−1
- LICENSE +1/−1
- README.md +77/−52
- brick.cabal +60/−99
- docs/guide.rst +30/−11
- 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 +16/−13
- programs/CustomEventDemo.hs +3/−4
- programs/FormDemo.hs +3/−1
- programs/LayerDemo.hs +8/−8
- programs/ProgressBarDemo.hs +48/−4
- 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 +31/−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/Center.hs +1/−1
- src/Brick/Widgets/Core.hs +216/−127
- src/Brick/Widgets/Edit.hs +2/−2
- src/Brick/Widgets/FileBrowser.hs +74/−36
- src/Brick/Widgets/Internal.hs +32/−24
- src/Brick/Widgets/List.hs +20/−3
- src/Brick/Widgets/ProgressBar.hs +30/−4
- tests/List.hs +9/−0
- tests/Main.hs +1/−0
- tests/Render.hs +2/−1
CHANGELOG.md view
@@ -2,6 +2,259 @@ 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 --- @@ -1619,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
@@ -13,7 +13,9 @@ 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 -------@@ -48,64 +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 |-| [`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 |-| [`hic-hac-hoe`](https://github.com/blastwind/hic-hac-hoe) | Play tic tac toe in terminal! |-| [`babel-cards`](https://github.com/srhoulam/babel-cards) | A TUI spaced-repetition memorization tool. Similar to Anki. |-| [`codenames-haskell`](https://github.com/VigneshN1997/codenames-haskell) | An implementation of the Codenames game |-| [`haradict`](https://github.com/srhoulam/haradict) | A TUI Arabic dictionary powered by [ElixirFM](https://github.com/otakar-smrz/elixir-fm) |--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 |-| [`brick-panes`](https://github.com/kquick/brick-panes) [[Hackage]](https://hackage.haskell.org/package/brick-panes) | A Brick overlay library providing composition and isolation of screen areas for TUI apps. |--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 ---------------@@ -126,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@@ -141,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@@ -176,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 ... @@ -196,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.@@ -203,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.6+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,7 @@ main-is: AttrDemo.hs build-depends: base, brick,- vty,- text,- microlens+ vty executable brick-tabular-list-demo if !flag(demos)@@ -425,11 +394,9 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-mtl, microlens-th,- mtl, vector executable brick-list-demo@@ -442,7 +409,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-mtl, mtl,@@ -458,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@@ -474,7 +453,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-th, microlens-mtl@@ -487,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)@@ -500,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)@@ -515,9 +487,6 @@ build-depends: base, brick, vty,- text,- vector,- mtl, microlens >= 0.3.0.0, microlens-th, microlens-mtl@@ -532,9 +501,6 @@ build-depends: base, brick, vty,- text,- vector,- mtl, microlens >= 0.3.0.0, microlens-th, microlens-mtl@@ -550,8 +516,7 @@ build-depends: base, brick, vty,- text,- microlens+ text executable brick-dynamic-border-demo if !flag(demos)@@ -562,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)@@ -578,8 +540,6 @@ build-depends: base, brick, vty,- text,- microlens, microlens-mtl, microlens-th @@ -596,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 ----------------------------------- @@ -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,13 +66,14 @@ B.borderWithLabel (str "label") $ vLimit 5 $ C.vCenter $- txt $ " " <> styleName <> " style "+ padLeftRight 2 $+ txt $ styleName <> " style" titleAttr :: A.AttrName titleAttr = A.attrName "title" -borderMappings :: [(A.AttrName, V.Attr)]-borderMappings =+attrs :: [(A.AttrName, V.Attr)]+attrs = [ (B.borderAttr, V.yellow `on` V.black) , (B.vBorderAttr, fg V.cyan) , (B.hBorderAttr, fg V.magenta)@@ -80,7 +82,7 @@ colorDemo :: Widget () colorDemo =- updateAttrMap (A.applyAttrMappings borderMappings) $+ updateAttrMap (A.applyAttrMappings attrs) $ B.borderWithLabel (withAttr titleAttr $ str "title") $ hLimit 20 $ vLimit 5 $@@ -89,13 +91,14 @@ ui :: Widget () ui =- hBox borderDemos- <=> B.hBorder- <=> colorDemo- <=> B.hBorderWithLabel (str "horizontal border label")- <=> (C.center (str "Left of vertical border")- <+> B.vBorder- <+> C.center (str "Right of vertical border"))+ vBox [ hBox borderDemos+ , B.hBorder+ , colorDemo+ , B.hBorderWithLabel (str "horizontal border label")+ , (C.center (str "Left of vertical border")+ <+> B.vBorder+ <+> C.center (str "Right of vertical border"))+ ] main :: IO () main = M.simpleMain ui
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/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/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@@ -73,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)@@ -122,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.@@ -131,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@@ -234,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/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@@ -337,7 +340,7 @@ -- input text should not contain escape sequences or carriage returns. txt :: T.Text -> Widget n txt s =- -- Althoguh vty Image uses lazy Text internally, using lazy text at this+ -- 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.@@ -485,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@@ -495,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@@ -690,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@@ -713,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 @@ -728,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)@@ -759,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@@ -809,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@@ -820,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@@ -844,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@@ -992,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.@@ -1034,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@@ -1053,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@@ -1064,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.@@ -1087,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.@@ -1109,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.@@ -1132,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.@@ -1204,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)@@ -1236,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.@@ -1294,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@@ -1324,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@@ -1392,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 @@ -1493,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)@@ -1506,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)@@ -1560,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,@@ -1569,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.@@ -1585,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@@ -1611,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@@ -1643,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@@ -1667,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@@ -1684,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@@ -1711,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@@ -1742,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/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,7 +8,7 @@ ) where -import Lens.Micro ((^.), (&), (%~))+import Lens.Micro ((^.), (&), (%~), (.~)) import Lens.Micro.Mtl ((%=)) import Control.Monad import Control.Monad.State.Strict@@ -35,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@@ -107,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
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