brick-0.18/0000755000000000000000000000000013117314670010725 5ustar0000000000000000brick-0.18/brick.cabal0000644000000000000000000002357713117314670013021 0ustar0000000000000000name: brick version: 0.18 synopsis: A declarative terminal user interface library description: Write terminal applications painlessly with 'brick'! You write an event handler and a drawing function and the library does the rest. . . > module Main where > > import Brick > > ui :: Widget () > ui = str "Hello, world!" > > main :: IO () > main = simpleMain ui . . To get started, see: . * . * The . * The demonstration programs in the 'programs' directory . . This package deprecates . license: BSD3 license-file: LICENSE author: Jonathan Daugherty maintainer: Jonathan Daugherty copyright: (c) Jonathan Daugherty 2015-2016 category: Graphics build-type: Simple cabal-version: >=1.10 Homepage: https://github.com/jtdaugherty/brick/ Bug-reports: https://github.com/jtdaugherty/brick/issues extra-doc-files: README.md, docs/guide.rst, CHANGELOG.md Source-Repository head type: git location: git://github.com/jtdaugherty/brick.git Flag demos Description: Build demonstration programs Default: False library default-language: Haskell2010 ghc-options: -Wall -fno-warn-unused-do-bind -O3 default-extensions: CPP hs-source-dirs: src exposed-modules: Brick Brick.AttrMap Brick.BChan Brick.Focus Brick.Main Brick.Markup Brick.Types Brick.Util Brick.Widgets.Border Brick.Widgets.Border.Style Brick.Widgets.Center Brick.Widgets.Core Brick.Widgets.Dialog Brick.Widgets.Edit Brick.Widgets.List Brick.Widgets.ProgressBar Data.Text.Markup other-modules: Brick.Types.TH Brick.Types.Internal Brick.Widgets.Internal build-depends: base <= 5, vty >= 5.15, transformers, data-clist >= 0.1, dlist, containers, microlens >= 0.3.0.0, microlens-th, microlens-mtl, vector, contravariant, stm >= 2.4, text, text-zipper >= 0.7.1, template-haskell, deepseq >= 1.3 && < 1.5 executable brick-readme-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 default-extensions: CPP main-is: ReadmeDemo.hs build-depends: base, brick, text executable brick-cache-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 default-extensions: CPP main-is: CacheDemo.hs build-depends: base, brick, vty >= 5.15, text, microlens >= 0.3.0.0, microlens-th executable brick-visibility-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: VisibilityDemo.hs build-depends: base, brick, vty >= 5.15, text, microlens >= 0.3.0.0, microlens-th executable brick-viewport-scroll-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 default-extensions: CPP main-is: ViewportScrollDemo.hs build-depends: base, brick, vty >= 5.15, text, microlens executable brick-dialog-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: DialogDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens executable brick-mouse-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: MouseDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens >= 0.3.0.0, microlens-th, text-zipper executable brick-layer-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: LayerDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens >= 0.3.0.0, microlens-th executable brick-suspend-resume-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: SuspendAndResumeDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens >= 0.3.0.0, microlens-th executable brick-padding-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: PaddingDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens executable brick-attr-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: AttrDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens executable brick-markup-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: MarkupDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens executable brick-list-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: ListDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens >= 0.3.0.0, vector executable brick-custom-event-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: CustomEventDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens >= 0.3.0.0, microlens-th executable brick-hello-world-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: HelloWorldDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens executable brick-edit-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-language: Haskell2010 main-is: EditDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, vector, microlens >= 0.3.0.0, microlens-th executable brick-border-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-extensions: CPP default-language: Haskell2010 main-is: BorderDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens executable brick-progressbar-demo if !flag(demos) Buildable: False hs-source-dirs: programs ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 default-extensions: CPP default-language: Haskell2010 main-is: ProgressBarDemo.hs build-depends: base <= 5, brick, vty >= 5.15, text, microlens brick-0.18/CHANGELOG.md0000644000000000000000000004534313117314670012547 0ustar0000000000000000 Brick changelog --------------- 0.18 ---- Package changes: * Added a dependency on data-clist. API changes: * Brick.Focus: removed the Functor instance for FocusRing. * Brick.Focus: re-implemented FocusRing in terms of the circular list data structure from data-clist. In addition, this change introduced "focusRingModify", which permits the user to use the data-clist API to directly manipulate the FocusRing's internals. This way brick doesn't have to re-invent the wheel on the focus ring behavior. 0.17.2 ------ Package changes: * Added programs/ReadmeDemo.hs and featured its output and code in the README to provide an early demonstration Library changes: * centerAbout now right- and bottom-pads its operand to behave consistently with h/vCenter 0.17.1 ------ Package changes: * Use Extra-Doc-Files instead of Data-Files for documentation files Bug fixes: * List: correctly update selected index in listInsert * Update example program in brick.cabal (thanks @timbod7) 0.17 ---- Package changes: * Updated to depend on Vty 5.15. * Updated to remove dependency on data-default. * Discontinued support for GHC versions prior to 7.10.1. API changes: * Removed Data.Default instances for AttrName, AttrMap, Result, and BorderStyle (use Monoid instances instead where possible). * Added defaultBorderStyle :: BorderStyle. * Added emptyResult :: Result n. 0.16 ---- This release includes a breaking API change: * Brick now uses bounded channels (Brick.BChan.BChan) for event communication rather than Control.Concurrent.Chan's unbounded channels to improve memory consumption for programs with runaway event production (thanks Joshua Chia) Other API changes: * Brick.List got a new function, listModify, for modifying the selected element (thanks @diegospd) Performance improvements: * hBox and vBox now use the more efficient DList data structure when rendering to improve performance for boxes with many elements (thanks Mitsutoshi Aoe) 0.15.2 ------ Bug fixes: * viewport: do not cull cursor locations on empty viewport contents (fixes #105) * User guide CounterEvent type fix (thanks @diegospd) 0.15.1 ------ Bug fixes: * List: fixed empty list validation in listReplace (thanks Joshua Chia) 0.15 ---- Demo changes: * MouseDemo: add an editor and use mouse events to move the cursor * MouseDemo: Enhance MouseDemo to show interaction between 'clickable' and viewports (thanks Kevin Quick) New features: * Editors now report mouse click events API changes: * Rename TerminalLocation row/column fields to avoid commonplace name clashes; rename row/column to locationRow/locationColumn (fixes #96) Bug fixes: * Core: make cropToContext also crop extents (fixes #101) * viewport: if the sub-widget is not rendered, also cull all extents and cursor locations Documentation changes: * User Guide updates: minor fixes, updates to content on custom widgets, wide character support, and examples (thanks skapazzo@inventati.org, Kevin Quick) 0.14 ---- This release added support for wide characters. In particular, wide characters can now be entered into the text editor widget and used in 'str' and 'txt' widgets. 0.13 ---- API changes: * Mouse mode is no longer enabled by default. * customMain's event channel parameter is now optional * FocusRing now provides a Functor instance (thanks Ian Jeffries) 0.12 ---- This release primarily adds support for mouse interaction. For details, see the Mouse Support section of the User Guide. This release also includes breaking API changes for the App type. Here's a migration guide: * Event handlers now take "BrickEvent n e" instead of "e", where "e" was the custom event type used before this change. To recover your own custom events, pattern-match on "AppEvent"; to recover Vty input events, pattern-match on "VtyEvent". * appLiftVtyEvent went away and can just be removed from your App record constructor. * If you aren't using the custom event type or were just using Vty's "Event" type as your App's event type, you can set your event type to just "e" because you'll now be able to get Vty events regardless of whether you use a custom event type. API changes: * Added the Widget combinator "clickable" to indicate that a widget should generate mouse click events * Added the Extent data type and the "reportExtent" widget combinator to report the positions and sizes of widgets * Rendering "Result" values now include reported extents and update their offsets (adds "extents" field and "extentsL" lens) * Added "lookupExtent", "findClickedExtents", and "clickedExtent" in EventM to find extents and check them for mouse clicks * Removed appLiftVtyEvent. Instead of wrapping Vty's events in your own type, you now get a "BrickEvent" that always contains Vty events but has the ability to embed *your* custom events. See the User Guide for details. * Added demo program MouseDemo.hs * Added demo program ProgressBarDemo.hs (thanks Kevin Quick) * Added mapAttrname, mapAttrNames, and overrideAttr functions (thanks Kevin Quick) * Make handleEventLensed polymorphic over event type to allow use with custom events (thanks Kevin Quick) * Added Ord constraint to some library startup functions Bug fixes: * Added Show instance for Editor, List (fixes #63) Documentation changes: * Updated documentation to use new "resource name" terminology to reduce confusion and better explain the purpose of names. * Updated user guide with sections on mouse support, the rendering cache, resource names, paste mode, and extents Package changes: * Depend on Vty 5.11.3 to get mouse mode support 0.11 ---- API changes: * Added getVtyHandle in EventM for obtaining the current Vty context. It returns Nothing when calling the appStartEvent handler but after that a context is always available. 0.10 ---- New features: * Added a rendering cache. To use the rendering cache, use the 'cached' widget combinator. This causes drawings of the specified widget to re-use a cached rendering until the rendering cache is invalidated with 'invalidateCacheEntry' or 'invalidateCache'. This change also includes programs/CacheDemo.hs. This change introduced an Ord constraint on the name type variable 'n'. * Added setTop and setLeft for setting viewport offsets directly in EventM. * Dialog event handlers now support left and right arrow keys (thanks Grégoire Charvet) Library changes: * On resizes brick now draws the application twice before handling the resize event. This change makes it possible for event handlers to get the latest viewport states on a resize rather than getting the most recent (but stale) versions as before, at the cost of a second redraw. Bug fixes: * We now use the most recent rendering state when setting up event handler viewport data. This mostly won't matter to anyone except in cases where a viewport name was expected to be in the viewport map but wasn't due to using stale rendering state to set up EventM. 0.9 --- Package changes: * Depend on text-zipper 0.7.1 API changes: * The editor widget state value is now polymorphic over the type of "string" value that can be edited, so you can now create editors over Text values as well as Strings. This is a breaking change but it only requires the addition of the string type variable to any uses of Editor. (thanks Jason Dagit and Getty Ritter) * Added some missing Eq and Show instances (thanks Grégoire Charvet) New features: * The editor now binds Control-U to delete to beginning of line (thanks Hans-Peter Deifel) Bug fixes: * List: avoid runtime exception by ensuring item height is always at least 1 0.8 --- API changes: * Center: added layer-friendly centering functions centerLayer, hCenterLayer, and vCenterLayer. Functionality changes: * Dialog now uses new layer-friendly centering functions. This makes it possible to overlay a Dialog on top of your UI when you use a Dialog rendering as a separate layer. * Updated the LayerDemo to demonstrate a centered layer. * The renderer now uses a default Vty Picture background of spaces with the default attribute, rather than using ClearBackground (the Vty default). This is to compensate for an unexpected attribute behavior in Vty when ClearBackgrounds (see https://github.com/coreyoconnor/vty/issues/95) 0.7 --- NOTE: this release includes many API changes. Please see the "Widget Names" section of the Brick User Guide for details on the fundamentals! API changes: * The "Name" type was removed. In its place we now have a name type variable ("n") attached to many types (including EventM, CursorLocation, App, Editor, List, and FocusRing). This change makes it possible to: * Avoid runtime errors due to name typos * Achieve compile-time guarantees about name matching and usage * Force widget functions to be name-agnostic by being polymorphic in their name type * Clean up focus handling by making it possible to pattern-match on cursor location names * The EditDemo demonstration program was updated to use a FocusRing. * Added the "Named" type class to Brick.Widgets.Core for types that store names. This type class is used to streamline the Focus interface; see Brick.Focus.withFocusRing and EditDemo.hs. * The List and Editor types are now parameterized on names. * The List widget is now focus-aware; its rendering function now takes a boolean indicating whether it should be rendered with focus. The List uses the following attributes now: * When not focused, the cursor is rendered with listSelectedAttr. * When focused, the cursor is rendered with listSelectedFocusedAttr. * The Editor widget is now focus-aware; its rendering function now takes a boolean indicating whether it should be rendered with focus. The Editor uses the following attributes now: * When not focused, the widget is rendered with editAttr. * When focused, the widget is rendered with editFocusedAttr. * The Dialog's name constructor parameter and lens were removed. * The 'viewport' function was modified to raise a runtime exception if the widget name it receives is used more than once during the rendering of a single frame. Miscellaneous: * Many modules now use conditional imports to silence redundancy warnings on GHCs with newer Preludes (e.g. including Monoid, Foldable, Traversable, Applicative, etc.) 0.6.4 ----- Bug fixes: * Add missing Functor instance for Next type (thanks Markus Hauck) 0.6.3 ----- Bug fixes: * List: the list now properly renders when the available height is not a multiple of the item height. Previously the list size would decrease relative to the available height. Now the list renders enough items to fill the space even if the top-most or bottom-most item is partially visible, which is the expected behavior. 0.6.2 ----- Bug fixes: * Editor: the 'editor' initial content parameter is now correctly split on newlines to ensure that the underlying editor zipper is initialized properly. (fixes #56; thanks @listx) 0.6.1 ----- Package changes: * Added lower bound for microlens >= 0.3.0.0 to fix build failure due to Field1 not being defined (thanks Markus Hauck) Documentation changes: * Updated user guide and README to link to and mention microlens instead of lens Misc: * Fixed a qualified import in the List demo to avoid ambiguity (thanks Alan Gilbert) 0.6 --- API changes: * Brick now uses the microlens family of packages instead of lens. This version of brick also depends on vty 5.5.0, which was modified to use microlens instead of lens. This change shouldn't impact functionality but will greatly reduce build times. 0.5.1 ----- Bug fixes: * Fix negative cropping in hCenter, vCenter, and cropResultToContext (fixes #52) * Remove unnecessary Eq constraint from listReplace (fixes #48; thanks sifmelcara) * Mention Google Group in README 0.5 --- Functionality changes: * Markup: make markup support multi-line strings (fixes #41) * brick-edit-demo: support shift-tab to switch editors * Core: improve box layout algorithm (when rendering boxes, track remaining space while rendering high-priority children to use successively more constrained primary dimensions) * Core: make fixed padding take precedence over padded widgets (fixes #42) Prior to this commit, padding a widget meant that if there was room after rendering the widget, the specified amount of padding would be added. This meant that under tight layout constraints padding would disappear before a padded widget would. This is often a desirable outcome but it also led to unexpected behavior when adding padding to a widget that grows greedily: fixed padding would never show up because it was placed in a box adjacent to the widget in question, and boxes always render greedy children before fixed ones. As a result fixed padding would disappear under these conditions. Instead, in the case of fixed padding, since we often intend to *guarantee* that padding is present, all of the padding combinators have been modified so that when the padded widget is rendered with fixed padding in the amount V, the widget is given V fewer rows/columns when it is rendered so that the padding always has room. 0.4.1 ----- Bug fixes: * Fixed a bug in the 'visible' combinator: If the size of the visibility request was larger than the available space, then the rendering of a viewport was toggling between two states, one with aligning on the end of the visibility request, and another one aligning on the start. This commit fixes it so that a visibility request is always aligned on the start if not enough space is available. (thanks Thomas Strobel ) Behavior changes: * Honor multiple 'visible' markers in a single viewport with preference on the innermost request (thanks Thomas Strobel ) 0.4 --- API changes: * Added Brick.Widgets.Core.unsafeLookupViewport to make certain kinds of custom widget implementations easier when viewport states are needed (thanks Markus Hauck ) * List: added listClear and listReverse functions (thanks Markus Hauck) * List: Derive instances for Functor, Foldable, Traversable (thanks Markus Hauck) Documentation changes: * Hyperlink "Data.Text.Markup" inside Brick.Markup haddock (thanks Markus Hauck) * Fix typo in 'Attribute Management' section of user guide (thanks Markus Hauck) 0.3.1 ----- Bug fixes: * EventM newtype again instances MonadIO (thanks Andrew Rademacher) 0.3 --- API changes: * Made EventM a newtype instead of a type alias * List: listReplace now takes the new selected index and no longer does element diffing Package changes: * Removed the dependency on the Diff package Misc: * Applied some hlint hints (thanks Markus Hauck ) * Fixed a typo in the README (thanks Markus Hauck ) * Improved the renderList documentation (thanks Profpatsch ) * Types: added an explicit import of Applicative for older GHCs 0.2.3 ----- 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 handled sanely (fixes #22; reported by Hans-Peter Deifel) 0.2.2 ----- Demo changes: * Improved the list demo by using characters instead of integers in the demo list and cleaned up item-adding code (thanks Jøhannes Lippmann ) 0.2.1 ----- Bug fixes: * List: * Fixed size policy of lists so that rather than being Fixed/Fixed, they are Greedy/Greedy. This resolves issues that arise when the box layout widget renders a list widget alongside a Fixed/Fixed one. (Closes issue #17, thanks Karl Voelker) * Scrolling: * vScrollPage actually scrolls vertically now rather than horizontally (Thanks Hans-Peter Deifel ) 0.2 --- API changes: * Added top-level `Brick` module that re-exports the most important modules in the library. * List: * Now instead of passing the item-drawing function to the `list` state constructor, it is passed to `renderList` * `renderList` now takes the row height of the list's item widgets. The list item-drawing function must respect this in order for scrolling to work properly. This change made it possible to optimize the list so that it only draws widgets visible in the viewport rather than rendering all of the list's items (even the ones off-screen). But to do this we must be able to tell in advance how high each one is, so we require this parameter. In addition this change means that lists no longer support items of different heights. * The list now uses Data.Vector instead of [a] to store items; this permits efficient slicing so we can do the optimized rendering described above. * The `HandleEvent` type class `handleEvent` method now runs in `EventM`. This permits event-handling code implemented in terms of `HandleEvent` to do get access to viewport state and to run IO code, making it just as powerful as code in the top-level `EventM` handler. * Many types were moved from `Brick.Widgets.Core` and `Brick.Main` to `Brick.Types`, making the former module merely a home for `Widget` constructors and combinators. * The `IsString` instance for `Widget` was removed; this might be reinstated later, but this package provides enough `IsString` instances that things can get confusing. * `EventM` is now reader monad over the most recent rendering pass's viewport state, in addition to being a state monad over viewport requests for the renderer. Added the `lookupViewport` function to provide access to the most recent viewport state. Exported the `Viewport` type and lenses. * Now that `handleEvent` is now an `EventM` action, composition with `continue` et al got a little messier when using lenses to update the application state. To help with this, there is now `handleEventLensed`. Bugfixes: * Lists now perform well with 10 items or a million (see above; fixes #7, thanks Simon Michael) * Added more haddock notes to `Brick.Widgets.Core` about growth policies. * Forced evaluation of render states to address a space leak in the renderer (fixes #14, thanks Sebastian Reuße ) * str: only reference string content that can be shown (eliminates a space leak, fixes #14, thanks Sebastian Reuße ) Misc: * Added a makefile for the user guide. * List: added support for Home and End keys (thanks Simon Michael) * Viewports: when rendering viewports, scroll requests from `EventM` are processed before visibility requests from the rendering process; this reverses this previous order of operations but permits user-supplied event handlers to reset viewports when desired. Package changes: * Added `deepseq` dependency 0.1 --- Initial release brick-0.18/LICENSE0000644000000000000000000000272613117314670011741 0ustar0000000000000000Copyright (c) 2015, Jonathan Daugherty. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of the contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. brick-0.18/README.md0000644000000000000000000001173013117314670012206 0ustar0000000000000000brick ----- [![Build Status](https://travis-ci.org/jtdaugherty/brick.svg?branch=master)](https://travis-ci.org/jtdaugherty/brick) `brick` is a Haskell terminal user interface programming library in the style of [gloss](http://hackage.haskell.org/package/gloss). This means you write a function that describes how your user interface should look, but the library takes care of a lot of the book-keeping that so commonly goes into writing such programs. `brick` exposes a declarative API. Unlike most GUI toolkits which require you to write a long and tedious sequence of "create a widget, now bind an event handler", `brick` just requires you to describe your interface using a set of declarative combinators. Then you provide a function to transform your application state when input or other kinds of events arrive. 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. This library deprecates [vty-ui](https://github.com/jtdaugherty/vty-ui). Example ------- Here's an example interface (see `programs/ReadmeDemo.hs`): ``` withBorderStyle unicode $ borderWithLabel (str "Hello!") $ (center (str "Left") <+> vBorder <+> center (str "Right")) ``` Result: ``` ┌─────────Hello!─────────┐ │ │ │ │ │ │ │ Left │ Right │ │ │ │ │ │ │ └────────────────────────┘ ``` Getting Started --------------- TLDR: ``` $ cabal sandbox init $ cabal install -j -f demos $ .cabal-sandbox/bin/brick-???-demo ``` To get started, see the [first few sections of the brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst). Feature Overview ---------------- `brick` comes with a bunch of widget types to get you started: * Vertical and horizontal box layout widgets * Basic single- and multi-line text editor widgets * List widget * Progress bar widget * Simple dialog box widget * Border-drawing widgets (put borders around or in between things) * Generic scrollable viewports * Extensible widget-building API * (And many more general-purpose layout control combinators) In addition, some of `brick`'s more powerful features may not be obvious right away: * All widgets can be arranged in predictable layouts so you don't have to worry about terminal resizes. * Attribute management is flexible and can be customized at runtime on a per-widget basis. Brick-Users Discussion ---------------------- The `brick-users` Google Group / e-mail list is a place to discuss library changes, give feedback, and ask questions. You can subscribe at: [https://groups.google.com/group/brick-users](https://groups.google.com/group/brick-users) Documentation ------------- Your documentation options, in recommended order, are: * [FAQ](https://github.com/jtdaugherty/brick/blob/master/FAQ.md) * [The 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) Status ------ `brick` is young and may be missing some essential features. There are some places were I have deliberately chosen to worry about performance later for the sake of spending more time on the design (and to wait on performance issues to arise first). `brick` is also something of an experimental project of mine and some aspects of the design involve trade-offs that are not entirely settled. In addition you can expect this library to follow a principle of fearless improvement: new versions will make (sometimes substantial) API changes if those changes really do make the library better. I will place more importance on getting the API right than on maintaining backwards compatibility. `brick` exports an extension API that makes it possible to make your own packages and widgets. If you use that, you'll also be helping to test whether the exported interface is usable and complete! 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. - Clearly describe the behavior you expected ... - ... and include a minimal demonstration program that exhibits the behavior you actually observed. Contributing ------------ If you decide to contribute, that's great! Here are some guidelines you should consider to make submitting patches easier for all concerned: - 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. - Please make changes consistent with the conventions I've used in the codebase. - Please adjust or provide Haddock and/or user guide documentation relevant to any changes you make. brick-0.18/Setup.hs0000644000000000000000000000005613117314670012362 0ustar0000000000000000import Distribution.Simple main = defaultMain brick-0.18/docs/0000755000000000000000000000000013117314670011655 5ustar0000000000000000brick-0.18/docs/guide.rst0000644000000000000000000014712313117314670013514 0ustar0000000000000000Brick User Guide ~~~~~~~~~~~~~~~~ .. contents:: `Table of Contents` Introduction ============ ``brick`` is a Haskell library for programming terminal user interfaces. Its main goal is to make terminal user interface development as painless and as direct as possible. ``brick`` builds on `vty`_; `vty` provides the terminal input and output interface and drawing primitives, while ``brick`` builds on those to provide a high-level application abstraction and combinators for expressing user interface layouts. This documentation is intended to provide a high-level overview of the library's design along with guidance for using it, but details on specific functions can be found in the Haddock documentation. The process of writing an application using ``brick`` entails writing two important functions: - A *drawing function* that turns your application state into a specification of how your interface should look, and - An *event handler* that takes your application state and an input event and decides whether to change the state or quit the program. We write drawing functions in ``brick`` using an extensive set of primitives and combinators to place text on the screen, set its attributes (e.g. foreground color), and express layout constraints (e.g. padding, centering, box layouts, scrolling viewports, etc.). These functions get packaged into a structure that we hand off to the ``brick`` library's main event loop. We'll cover that in detail in `The App Type`_. Installation ------------ ``brick`` can be installed in the "usual way," either by installing the latest `Hackage`_ release or by cloning the GitHub repository and building locally. To install from Hackage:: $ cabal update $ cabal install brick To clone and build locally:: $ git clone https://github.com/jtdaugherty/brick.git $ cd brick $ cabal sandbox init $ cabal install -j Building the Demonstration Programs ----------------------------------- ``brick`` includes a large collection of feature-specific demonstration programs. These programs are not built by default but can be built by passing the ``demos`` flag to ``cabal install``, e.g.:: $ cabal install brick -f demos Conventions =========== ``brick`` has some API conventions worth knowing about as you read this documentation and as you explore the library source and write your own programs. - Use of `microlens`_ packages: ``brick`` uses ``microlens`` family of packages internally and also exposes lenses for many types in the library. However, if you prefer not to use the lens interface in your program, all lens interfaces have non-lens equivalents exported by the same module. In general, the "``L``" suffix on something tells you it is a lens; the name without the "``L``" suffix is the non-lens version. You can get by without using ``brick``'s lens interface but your life will probably be much more pleasant once your application state becomes sufficiently complex if you use lenses to modify it (see `appHandleEvent: Handling Events`_). - Attribute names: some modules export attribute names (see `How Attributes Work`_) associated with user interface elements. These tend to end in an "``Attr``" suffix (e.g. ``borderAttr``). In addition, hierarchical relationships between attributes are documented in Haddock documentation. - Use of qualified Haskell identifiers: in this document, where sensible, I will use fully-qualified identifiers whenever I mention something for the first time or whenever I use something that is not part of ``brick``. Use of qualified names is not intended to produce executable examples, but rather to guide you in writing your ``import`` statements. The App Type ============ To use the library we must provide it with a value of type ``Brick.Main.App``. This type is a record type whose fields perform various functions: .. code:: haskell data App s e n = App { appDraw :: s -> [Widget n] , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n) , appHandleEvent :: s -> e -> EventM n (Next s) , appStartEvent :: s -> EventM n s , appAttrMap :: s -> AttrMap } The ``App`` type is parameterized over three types. These type variables will appear in the signatures of many library functions and types. They are: - The **application state type** ``s``: the type of data that will evolve over the course of the application's execution. Your application will provide the library with its starting value and event handling will transform it as the program executes. When a ``brick`` application exits, the final application state will be returned. - The **event type** ``e``: the type of custom application events that your application will need to produce and handle in ``appHandleEvent``. All applications will be provided with events from the underlying ``vty`` library, such as keyboard events or resize events; this type variable indicates the type of *additional* events the application will need. For more details, see `Using Your Own Event Type`_. - The **resource name type** ``n``: during application execution we sometimes need a way to refer to rendering state, such as the space taken up by a given widget, the state for a scrollable viewport, a mouse click, or a cursor position. For these situations we need a unique handle called a *resource name*. The type ``n`` specifies the name type the application will use to identify these bits of state produced and managed by the renderer. The resource name type must be provided by your application; for more details, see `Resource Names`_. The various fields of ``App`` will be described in the sections below. Running an Application ---------------------- To run an ``App``, we pass it to ``Brick.Main.defaultMain`` or ``Brick.Main.customMain`` along with an initial application state value: .. code:: haskell main :: IO () main = do let app = App { ... } initialState = ... finalState <- defaultMain app initialState -- Use finalState and exit The ``customMain`` function is for more advanced uses; for details see `Using Your Own Event Type`_. appDraw: Drawing an Interface ----------------------------- The value of ``appDraw`` is a function that turns the current application state into a list of *layers* of type ``Widget``, listed topmost first, that will make up the interface. Each ``Widget`` gets turned into a ``vty`` layer and the resulting layers are drawn to the terminal. The ``Widget`` type is the type of *drawing instructions*. The body of your drawing function will use one or more drawing functions to build or transform ``Widget`` values to describe your interface. These instructions will then be executed with respect to three things: - The size of the terminal: the size of the terminal determines how many ``Widget`` values behave. For example, fixed-size ``Widget`` values such as text strings behave the same under all conditions (and get cropped if the terminal is too small) but layout combinators such as ``Brick.Widgets.Core.vBox`` or ``Brick.Widgets.Center.center`` use the size of the terminal to determine how to lay other widgets out. See `How Widgets and Rendering Work`_. - The application's attribute map (``appAttrMap``): drawing functions requesting the use of attributes cause the attribute map to be consulted. See `How Attributes Work`_. - The state of scrollable viewports: the state of any scrollable viewports on the *previous* drawing will be considered. For more details, see `Viewports`_. The ``appDraw`` function is called when the event loop begins to draw the application as it initially appears. It is also called right after an event is processed by ``appHandleEvent``. Even though the function returns a specification of how to draw the entire screen, the underlying ``vty`` library goes to some trouble to efficiently update only the parts of the screen that have changed so you don't need to worry about this. Where do I find drawing functions? ********************************** The most important module providing drawing functions is ``Brick.Widgets.Core``. Beyond that, any module in the ``Brick.Widgets`` namespace provides specific kinds of functionality. appHandleEvent: Handling Events ------------------------------- The value of ``appHandleEvent`` is a function that decides how to modify the application state as a result of an event: .. code:: haskell appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s) The first parameter of type ``s`` is your application's state at the time the event arrives. ``appHandleEvent`` is responsible for deciding how to change the state based on the event and then return it. The second parameter of type ``BrickEvent n e`` is the event itself. The type variables ``n`` and ``e`` correspond to the *resource name type* and *event type* of your application, respectively, and must match the corresponding types in ``App`` and ``EventM``. The return value type ``Next s`` value describes what should happen after the event handler is finished. We have three choices: * ``Brick.Main.continue s``: continue executing the event loop with the specified application state ``s`` as the next value. Commonly this is where you'd modify the state based on the event and return it. * ``Brick.Main.halt s``: halt the event loop and return the final application state value ``s``. This state value is returned to the caller of ``defaultMain`` or ``customMain`` where it can be used prior to finally exiting ``main``. * ``Brick.Main.suspendAndResume act``: suspend the ``brick`` event loop and execute the specified ``IO`` action ``act``. The action ``act`` must be of type ``IO s``, so when it executes it must return the next application state. When ``suspendAndResume`` is used, the ``brick`` event loop is shut down and the terminal state is restored to its state when the ``brick`` event loop began execution. When it finishes executing, the event loop will be resumed using the returned state value. This is useful for situations where your program needs to suspend your interface and execute some other program that needs to gain control of the terminal (such as an external editor). The ``EventM`` monad is the event-handling monad. This monad is a transformer around ``IO`` so you are free to do I/O in this monad by using ``liftIO``. Beyond I/O, this monad is used to make scrolling requests to the renderer (see `Viewports`_) and obtain named extents (see `Extents`_). Keep in mind that time spent blocking in your event handler is time during which your UI is unresponsive, so consider this when deciding whether to have background threads do work instead of inlining the work in the event handler. Widget Event Handlers ********************* Event handlers are responsible for transforming the application state. While you can use ordinary methods to do this such as pattern matching and pure function calls, some widget state types such as the ones provided by the ``Brick.Widgets.List`` and ``Brick.Widgets.Edit`` modules provide their own widget-specific event-handling functions. For example, ``Brick.Widgets.Edit`` provides ``handleEditorEvent`` and ``Brick.Widgets.List`` provides ``handleListEvent``. Since these event handlers run in ``EventM``, they have access to rendering viewport states via ``Brick.Main.lookupViewport`` and the ``IO`` monad via ``liftIO``. To use these handlers in your program, invoke them on the relevant piece of state in your application state. In the following example we use an ``Edit`` state from ``Brick.Widgets.Edit``: .. code:: haskell data Name = Edit1 type MyState = Editor String Name myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState) myEvent s (VtyEvent e) = continue =<< handleEditorEvent e s This pattern works well enough when your application state has an event handler as shown in the ``Edit`` example above, but it can become unpleasant if the value on which you want to invoke a handler is embedded deeply within your application state. If you have chosen to generate lenses for your application state fields, you can use the convenience function ``handleEventLensed`` by specifying your state, a lens, and the event: .. code:: haskell data Name = Edit1 data MyState = MyState { _theEdit :: Editor String Name } makeLenses ''MyState myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState) myEvent s (VtyEvent e) = continue =<< handleEventLensed s theEdit handleEditorEvent e You might consider that preferable to the desugared version: .. code:: haskell myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState) myEvent s (VtyEvent e) = do newVal <- handleEditorEvent e (s^.theEdit) continue $ s & theEdit .~ newVal Using Your Own Event Type ************************* Since we often need to communicate application-specific events beyond Vty input events to the event handler, brick supports embedding your application's custom events in the stream of ``BrickEvent``s that your handler will receive. The type of these events is the type ``e`` mentioned in ``BrickEvent n e`` and ``App s e n``. Note: ordinarily your application will not have its own custom event type, so you can leave this type unused (e.g. ``App MyState e MyName``) or just set it to unit (``App MyState () MyName``). Here's an example of using a custom event type. Suppose that you'd like to be able to handle counter events in your event handler. First we define the counter event type: .. code:: haskell data CounterEvent = Counter Int With this type declaration we can now use counter events in our app by using the application type ``App s CounterEvent n``. To handle these events we'll just need to look for ``AppEvent`` values in the event handler: .. code:: haskell myEvent :: s -> BrickEvent n CounterEvent -> EventM n (Next s) myEvent s (AppEvent (CounterEvent i)) = ... The next step is to actually *generate* our custom events and inject them into the ``brick`` event stream so they make it to the event handler. To do that we need to create a ``BChan`` for our custom events, provide that ``BChan`` to ``brick``, and then send our events over that channel. Once we've created the channel with ``Brick.BChan.newBChan``, we provide it to ``brick`` with ``customMain`` instead of ``defaultMain``: .. code:: haskell main :: IO () main = do eventChan <- Brick.BChan.newBChan 10 finalState <- customMain (Graphics.Vty.mkVty Data.Default.defaultConfig) (Just eventChan) app initialState -- Use finalState and exit 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. With all of this in place, sending our custom events to the event handler is straightforward: .. code:: haskell counterThread :: Brick.BChan.BChan CounterEvent -> IO () counterThread chan = do Brick.BChan.writeBChan chan $ Counter 1 Bounded Channels **************** A ``BChan``, or *bounded channel*, can hold a limited number of items before attempts to write new items will block. In the call to ``newBChan`` above, the created channel has a capacity of 10 items. Use of a bounded channel ensures that if the program cannot process events quickly enough then there is a limit to how much memory will be used to store unprocessed events. Thus the chosen capacity should be large enough to buffer occasional spikes in event handling latency without inadvertently blocking custom event producers. Each application will have its own performance characteristics that determine the best bound for the event channel. In general, consider the performance of your event handler when choosing the channel capacity and design event producers so that they can block if the channel is full. Starting up: appStartEvent ************************** When an application starts, it may be desirable to perform some of the duties typically only possible when an event has arrived, such as setting up initial scrolling viewport state. Since such actions can only be performed in ``EventM`` and since we do not want to wait until the first event arrives to do this work in ``appHandleEvent``, the ``App`` type provides ``appStartEvent`` function for this purpose: .. code:: haskell appStartEvent :: s -> EventM n s This function takes the initial application state and returns it in ``EventM``, possibly changing it and possibly making viewport requests. This function is invoked once and only once, at application startup. For more details, see `Viewports`_. You will probably just want to use ``return`` as the implementation of this function for most applications. appChooseCursor: Placing the Cursor ----------------------------------- The rendering process for a ``Widget`` may return information about where that widget would like to place the cursor. For example, a text editor will need to report a cursor position. However, since a ``Widget`` may be a composite of many such cursor-placing widgets, we have to have a way of choosing which of the reported cursor positions, if any, is the one we actually want to honor. To decide which cursor placement to use, or to decide not to show one at all, we set the ``App`` type's ``appChooseCursor`` function: .. code:: haskell appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n) The event loop renders the interface and collects the ``Brick.Types.CursorLocation`` values produced by the rendering process and passes those, along with the current application state, to this function. Using your application state (to track which text input box is "focused," say) you can decide which of the locations to return or return ``Nothing`` if you do not want to show a cursor. Many widgets in the rendering process can request cursor placements, but it is up to our application to determine which one (if any) should be used. Since we can only show at most a single cursor in the terminal, we need to decide which location to show. One way is by looking at the resource name contained in the ``cursorLocationName`` field. The name value associated with a cursor location will be the name used to request the cursor position with ``Brick.Widgets.Core.showCursor``. ``Brick.Main`` provides various convenience functions to make cursor selection easy in common cases: * ``neverShowCursor``: never show any cursor. * ``showFirstCursor``: always show the first cursor request given; good for applications with only one cursor-placing widget. * ``showCursorNamed``: show the cursor with the specified resource name or show no cursor if the name was not associated with any requested cursor position. For example, this widget requests a cursor placement on the first "``o``" in "``foo``" associated with the cursor name "``myCursor``": .. code:: haskell data MyName = CustomName let w = showCursor CustomName (Brick.Types.Location (1, 0)) (Brick.Widgets.Core.str "foobar") The event handler for this application would use ``MyName`` as its resource name type ``n`` and would be able to pattern-match on ``CustomName`` to match cursor requests when this widget is rendered: .. code:: haskell myApp = App { ... , appChooseCursor = showCursorNamed CustomName } See the next section for more information on using names. Resource Names -------------- We saw above in `appChooseCursor: Placing the Cursor`_ that resource names are used to describe cursor locations. Resource names are also used to name other kinds of resources: * viewports (see `Viewports`_) * rendering extents (see `Extents`_) * mouse events (see `Mouse Support`_) Assigning names to these resource types allows us to distinguish between events based on the part of the interface to which an event is related. Your application must provide some type of name. For simple applications that don't make use of resource names, you may use ``()``. But if your application has more than one named resource, you *must* provide a type capable of assigning a unique name to every resource that needs one. A Note of Caution ***************** Resource names can be assigned to any of the resource types mentioned above, but some resource types--viewports, extents, the render cache, and cursor locations--form separate resource namespaces. So, for example, the same name can be assigned to both a viewport and an extent, since the ``brick`` API provides access to viewports and extents using separate APIs and data structures. However, if the same name is used for two resources of the same kind, it is undefined *which* of those you'll be getting access to when you go to use one of those resources in your event handler. For example, if the same name is assigned to two viewports: .. code:: haskell data Name = Viewport1 ui :: Widget Name ui = (viewport Viewport1 Vertical $ str "Foo") <+> (viewport Viewport1 Vertical $ str "Bar") <+> then in ``EventM`` when we attempt to scroll the viewport ``Viewport1`` we don't know which of the two uses of ``Viewport1`` will be affected: .. code:: haskell do let vp = viewportScroll Viewport1 vScrollBy vp 1 The solution is to ensure that for a given resource type (in this case viewport), a unique name is assigned in each use. .. code:: haskell data Name = Viewport1 | Viewport2 ui :: Widget Name ui = (viewport Viewport1 Vertical $ str "Foo") <+> (viewport Viewport2 Vertical $ str "Bar") <+> appAttrMap: Managing Attributes ------------------------------- In ``brick`` we use an *attribute map* to assign attibutes to elements of the interface. Rather than specifying specific attributes when drawing a widget (e.g. red-on-black text) we specify an *attribute name* that is an abstract name for the kind of thing we are drawing, e.g. "keyword" or "e-mail address." We then provide an attribute map which maps those attribute names to actual attributes. This approach lets us: * Change the attributes at runtime, letting the user change the attributes of any element of the application arbitrarily without forcing anyone to build special machinery to make this configurable; * Write routines to load saved attribute maps from disk; * Provide modular attribute behavior for third-party components, where we would not want to have to recompile third-party code just to change attributes, and where we would not want to have to pass in attribute arguments to third-party drawing functions. This lets us put the attribute mapping for an entire app, regardless of use of third-party widgets, in one place. To create a map we use ``Brick.AttrMap.attrMap``, e.g., .. code:: haskell App { ... , appAttrMap = const $ attrMap Graphics.Vty.defAttr [(someAttrName, fg blue)] } To use an attribute map, we specify the ``App`` field ``appAttrMap`` as the function to return the current attribute map each time rendering occurs. This function takes the current application state, so you may choose to store the attribute map in your application state. You may also choose not to bother with that and to just set ``appAttrMap = const someMap``. To draw a widget using an attribute name in the map, use ``Brick.Widgets.Core.withAttr``. For example, this draws a string with a ``blue`` background: .. code:: haskell let w = withAttr blueBg $ str "foobar" blueBg = attrName "blueBg" myMap = attrMap defAttr [ (blueBg, Brick.Util.bg Graphics.Vty.blue) ] For complete details on how attribute maps and attribute names work, see the Haddock documentation for the ``Brick.AttrMap`` module. See also `How Attributes Work`_. How Widgets and Rendering Work ============================== When ``brick`` renders a ``Widget``, the widget's rendering routine is evaluated to produce a ``vty`` ``Image`` of the widget. The widget's rendering routine runs with some information called the *rendering context* that contains: * The size of the area in which to draw things * The name of the current attribute to use to draw things * The map of attributes to use to look up attribute names * The active border style to use when drawing borders Available Rendering Area ------------------------ The most important element in the rendering context is the rendering area: This part of the context tells the widget being drawn how many rows and columns are available for it to consume. When rendering begins, the widget being rendered (i.e. a layer returned by an ``appDraw`` function) gets a rendering context whose rendering area is the size of the terminal. This size information is used to let widgets take up that space if they so choose. For example, a string "Hello, world!" will always take up one row and 13 columns, but the string "Hello, world!" *centered* will always take up one row and *all available columns*. How widgets use space when rendered is described in two pieces of information in each ``Widget``: the widget's horizontal and vertical growth policies. These fields have type ``Brick.Types.Size`` and can have the values ``Fixed`` and ``Greedy``. A widget advertising a ``Fixed`` size in a given dimension is a widget that will always consume the same number of rows or columns no matter how many it is given. Widgets can advertise different vertical and horizontal growth policies for example, the ``Brick.Widgets.Border.hCenter`` function centers a widget and is ``Greedy`` horizontally and defers to the widget it centers for vertical growth behavior. These size policies govern the box layout algorithm that is at the heart of every non-trivial drawing specification. When we use ``Brick.Widgets.Core.vBox`` and ``Brick.Widgets.Core.hBox`` to lay things out (or use their binary synonyms ``<=>`` and ``<+>``, respectively), the box layout algorithm looks at the growth policies of the widgets it receives to determine how to allocate the available space to them. For example, imagine that the terminal window is currently 10 rows high and 50 columns wide. We wish to render the following widget: .. code:: haskell let w = (str "Hello," <=> str "World!") Rendering this to the terminal will result in "Hello," and "World!" underneath it, with 8 rows unoccupied by anything. But if we wished to render a vertical border underneath those strings, we would write: .. code:: haskell let w = (str "Hello," <=> str "World!" <=> vBorder) Rendering this to the terminal will result in "Hello," and "World!" underneath it, with 8 rows remaining occupied by vertical border characters ("``|``") one column wide. The vertical border widget is designed to take up however many rows it was given, but rendering the box layout algorithm has to be careful about rendering such ``Greedy`` widgets because they won't leave room for anything else. Since the box widget cannot know the sizes of its sub-widgets until they are rendered, the ``Fixed`` widgets get rendered and their sizes are used to determine how much space is left for ``Greedy`` widgets. When using widgets it is important to understand their horizontal and vertical space behavior by knowing their ``Size`` values. Those should be made clear in the Haddock documentation. Limiting Rendering Area ----------------------- If you'd like to use a ``Greedy`` widget but want to limit how much space it consumes, you can turn it into a ``Fixed`` widget by using one of the *limiting combinators*, ``Brick.Widgets.Core.hLimit`` and ``Brick.Widgets.Core.vLimit``. These combinators take widgets and turn them into widgets with a ``Fixed`` size (in the relevant dimension) and run their rendering functions in a modified rendering context with a restricted rendering area. For example, the following will center a string in 30 columns, leaving room for something to be placed next to it as the terminal width changes: .. code:: haskell let w = hLimit 30 $ hCenter $ str "Hello, world!" The Attribute Map ----------------- The rendering context contains an attribute map (see `How Attributes Work`_ and `appAttrMap: Managing Attributes`_) which is used to look up attribute names from the drawing specification. The map originates from ``Brick.Main.appAttrMap`` and can be manipulated on a per-widget basis using ``Brick.Widgets.Core.updateAttrMap``. The Active Border Style ----------------------- Widgets in the ``Brick.Widgets.Border`` module draw border characters (horizontal, vertical, and boxes) between and around other widgets. To ensure that widgets across your application share a consistent visual style, border widgets consult the rendering context's *active border style*, a value of type ``Brick.Widgets.Border.Style``, to get the characters used to draw borders. The default border style is ``Brick.Widgets.Border.Style.unicode``. To change border styles, use the ``Brick.Widgets.Core.withBorderStyle`` combinator to wrap a widget and change the border style it uses when rendering. For example, this will use the ``ascii`` border style instead of ``unicode``: .. code:: haskell let w = withBorderStyle Brick.Widgets.Border.Style.ascii $ Brick.Widgets.Border.border $ str "Hello, world!" How Attributes Work =================== In addition to letting us map names to attributes, attribute maps provide hierarchical attribute inheritance: a more specific attribute derives any properties (e.g. background color) that it does not specify from more general attributes in hierarchical relationship to it, letting us customize only the parts of attributes that we want to change without having to repeat ourselves. For example, this draws a string with a foreground color of ``white`` on a background color of ``blue``: .. code:: haskell let w = withAttr specificAttr $ str "foobar" generalAttr = attrName "general" specificAttr = attrName "general" <> attrName "specific" myMap = attrMap defAttr [ (generalAttr, bg blue) , (specificAttr, fg white) ] Functions ``Brick.Util.fg`` and ``Brick.Util.bg`` specify partial attributes, and map lookups start with the desired name (``general/specific`` in this case) and walk up the name hierarchy (to ``general``), merging partial attribute settings as they go, letting already-specified attribute settings take precedence. Finally, any attribute settings not specified by map lookups fall back to the map's *default attribute*, specified above as ``Graphics.Vty.defAttr``. In this way, if you want everything in your application to have a ``blue`` background color, you only need to specify it *once*: in the attribute map's default attribute. Any other attribute names can merely customize the foreground color. In addition to using the attribute map provided by ``appAttrMap``, the map can be customized on a per-widget basis by using the attribute map combinators: * ``Brick.Widgets.Core.updateAttrMap`` * ``Brick.Widgets.Core.forceAttr`` * ``Brick.Widgets.Core.withDefAttr`` * ``Brick.Widgets.Core.overrideAttr`` Wide Character Support and the TextWidth class ============================================== Brick supports rendering wide characters in all widgets, and the brick editor supports entering and editing wide characters. Wide characters are those such as many Asian characters and emoji that need more than a single terminal column to be displayed. Brick relies on Vty's use of the `utf8proc`_ library to determine the column width of each character rendered. As a result of supporting wide characters, it is important to know that computing the length of a string to determine its screen width will *only* work for single-column characters. So, for example, if you want to support wide characters in your application, this will not work: .. code:: haskell let width = Data.Text.length t because if the string contains any wide characters, their widths will not be counted properly. In order to get this right, use the ``TextWidth`` type class to compute the width: .. code:: haskell let width = Brick.Widgets.Core.textWidth t The ``TextWidth`` type class uses Vty's character width routine (and thus ``utf8proc``) to compute the correct width. If you need to compute the width of a single character, use ``Graphics.Text.wcwidth``. Extents ======= When an application needs to know where a particular widget was drawn by the renderer, the application can request that the renderer record the *extent* of the widget--its upper-left corner and size--and provide it in an event handler. In the following example, the application needs to know where the bordered box containing "Foo" is rendered: .. code:: haskell ui = center $ border $ str "Foo" We don't want to have to care about the particulars of the layout to find out where the bordered box got placed during rendering. To get this information we request that the extent of the box be reported to us by the renderer using a resource name: .. code:: haskell data Name = FooBox ui = center $ reportExtent FooBox $ border $ str "Foo" Now, whenever the ``ui`` is rendered, the location and size of the bordered box containing "Foo" will be recorded. We can then look it up in event handlers in ``EventM``: .. code:: haskell do mExtent <- Brick.Main.lookupExtent FooBox case mExtent of Nothing -> ... Just (Extent _ upperLeft (width, height)) -> ... Paste Support ============= Some terminal emulators support "bracketed paste" support. This feature enables OS-level paste operations to send the pasted content as a single chunk of data and bypass the usual input processing that the application does. This enales more secure handling of pasted data since the application can detect that a pasted occurred and avoid processing the pasted data as ordinary keyboard input. For more information, see `bracketed paste mode`_. The Vty library used by brick provides support for bracketed pastes, but this mode must be enabled. To enable paste mode, we need to get access to the Vty library handle in ``EventM``: .. code:: haskell do vty <- Brick.Main.getVtyHandle case vty of Nothing -> return () Just v -> let output = outputIface v in when (supportsMode output BracketedPaste) $ liftIO $ setMode output BracketedPaste True Once enabled, paste mode will generate Vty ``EvPaste`` events. These events will give you the entire pasted content as a ``ByteString`` which you must decode yourself if, for example, you expect it to contain UTF-8 text data. Mouse Support ============= Some terminal emulators support mouse interaction. The Vty library used by brick provides these low-level events if mouse mode has been enabled. To enable mouse mode, we need to get access to the Vty library handle in ``EventM``: .. code:: haskell do vty <- Brick.Main.getVtyHandle case vty of Nothing -> return () Just v -> let output = outputIface vt in when (supportsMode output Mouse) $ liftIO $ setMode output Mouse True Bear in mind that some terminals do not support mouse interaction, so use Vty's ``getModeStatus`` to find out whether your terminal will provide mouse events. Also bear in mind that terminal users will usually expect to be able to interact with your application entirely without a mouse, so if you do choose to enable mouse interaction, consider using it to improve existing interactions rather than provide new functionality that cannot already be managed with a keyboard. Low-level Mouse Events ---------------------- Once mouse events have been enabled, Vty will generate ``EvMouseDown`` and ``EvMouseUp`` events containing the mouse button clicked, the location in the terminal, and any modifier keys pressed. .. code:: haskell handleEvent s (VtyEvent (EvMouseDown col row button mods) = ... Brick Mouse Events ------------------ Although these events may be adequate for your needs, ``brick`` provides a higher-level mouse event interface that ties into the drawing language. The disadvantage to the low-level interface described above is that you still need to determine *what* was clicked, i.e., the part of the interface that was under the mouse cursor. There are two ways to do this with ``brick``: with *extent checking* and *click reporting*. Extent checking *************** The *extent checking* approach entails requesting extents (see `Extents`_) for parts of your interface, then checking the Vty mouse click event's coordinates against one or more extents. The most direct way to do this is to check a specific extent: .. code:: haskell handleEvent s (VtyEvent (EvMouseDown col row _ _)) = do mExtent <- lookupExtent SomeExtent case mExtent of Nothing -> continue s Just e -> do if Brick.Main.clickedExtent (col, row) e then ... else ... This approach works well enough if you know which extent you're interested in checking, but what if there are many extents and you want to know which one was clicked? And what if those extents are in different layers? The next approach is to find all clicked extents: .. code:: haskell handleEvent s (VtyEvent (EvMouseDown col row _ _)) = do extents <- Brick.Main.findClickedExtents (col, row) -- Then check to see if a specific extent is in the list, or just -- take the first one in the list. This approach finds all clicked extents and returns them in a list with the following properties: * For extents ``A`` and ``B``, if ``A``'s layer is higher than ``B``'s layer, ``A`` comes before ``B`` in the list. * For extents ``A`` and ``B``, if ``A`` and ``B`` are in the same layer and ``A`` is contained within ``B``, ``A`` comes before ``B`` in the list. As a result, the extents are ordered in a natural way, starting with the most specific extents and proceeding to the most general. Click reporting *************** The *click reporting* approach is the most high-level approach offered by ``brick``. When rendering the interface we use ``Brick.Widgets.Core.clickable`` to request that a given widget generate ``MouseDown`` and ``MouseUp`` events when it is clicked. .. code:: haskell data Name = MyButton ui :: Widget Name ui = center $ clickable MyButton $ border $ str "Click me" handleEvent s (MouseDown MyButton button modifiers coords) = ... handleEvent s (MouseUp MyButton button coords) = ... This approach enables event handlers to use pattern matching to check for mouse clicks on specific regions; this uses extent reporting under the hood but makes it possible to denote which widgets are clickable in the interface description. The event's click coordinates are local to the widget being clicked. In the above example, a click on the upper-left corner of the border would result in coordinates of ``(0,0)``. Viewports ========= A *viewport* is a scrollable window onto a widget. Viewports have a *scrolling direction* of type ``Brick.Types.ViewportType`` which can be one of: * ``Horizontal``: the viewport can only scroll horizontally. * ``Vertical``: the viewport can only scroll vertically. * ``Both``: the viewport can scroll both horizontally and vertically. The ``Brick.Widgets.Core.viewport`` combinator takes another widget and embeds it in a named viewport. We name the viewport so that we can keep track of its scrolling state in the renderer, and so that you can make scrolling requests. The viewport's name is its handle for these operations (see `Scrolling Viewports in Event Handlers`_ and `Resource Names`_). **The viewport name must be unique across your application.** For example, the following puts a string in a horizontally-scrollable viewport: .. code:: haskell -- Assuming that App uses 'Name' for its resource names: data Name = Viewport1 let w = viewport Viewport1 Horizontal $ str "Hello, world!" A ``viewport`` specification means that the widget in the viewport will be placed in a viewport window that is ``Greedy`` in both directions (see `Available Rendering Area`_). This is suitable if we want the viewport size to be the size of the entire terminal window, but if we want to limit the size of the viewport, we might use limiting combinators (see `Limiting Rendering Area`_): .. code:: haskell let w = hLimit 5 $ vLimit 1 $ viewport Viewport1 Horizontal $ str "Hello, world!" Now the example produces a scrollable window one row high and five columns wide initially showing "Hello". The next two sections discuss the two ways in which this viewport can be scrolled. Scrolling Viewports in Event Handlers ------------------------------------- The most direct way to scroll a viewport is to make *scrolling requests* in the ``EventM`` event-handling monad. Scrolling requests ask the renderer to update the state of a viewport the next time the user interface is rendered. Those state updates will be made with respect to the *previous* viewport state, i.e., the state of the viewports as of the end of the most recent rendering. This approach is the best approach to use to scroll widgets that have no notion of a cursor. For cursor-based scrolling, see `Scrolling Viewports With Visibility Requests`_. To make scrolling requests, we first create a ``Brick.Main.ViewportScroll`` from a viewport name with ``Brick.Main.viewportScroll``: .. code:: haskell -- Assuming that App uses 'Name' for its resource names: data Name = Viewport1 let vp = viewportScroll Viewport1 The ``ViewportScroll`` record type contains a number of scrolling functions for making scrolling requests: .. code:: haskell hScrollPage :: Direction -> EventM n () hScrollBy :: Int -> EventM n () hScrollToBeginning :: EventM n () hScrollToEnd :: EventM n () vScrollPage :: Direction -> EventM n () vScrollBy :: Int -> EventM n () vScrollToBeginning :: EventM n () vScrollToEnd :: EventM n () In each case the scrolling function scrolls the viewport by the specified amount in the specified direction; functions prefixed with ``h`` scroll horizontally and functions prefixed with ``v`` scroll vertically. Scrolling operations do nothing when they don't make sense for the specified viewport; scrolling a ``Vertical`` viewport horizontally is a no-op, for example. Using ``viewportScroll`` we can write an event handler that scrolls the ``Viewport1`` viewport one column to the right: .. code:: haskell myHandler :: s -> e -> EventM n (Next s) myHandler s e = do let vp = viewportScroll Viewport1 hScrollBy vp 1 continue s Scrolling Viewports With Visibility Requests -------------------------------------------- When we need to scroll widgets only when a cursor in the viewport leaves the viewport's bounds, we need to use *visibility requests*. A visibility request is a hint to the renderer that some element of a widget inside a viewport should be made visible, i.e., that the viewport should be scrolled to bring the requested element into view. To use a visibility request to make a widget in a viewport visible, we simply wrap it with ``visible``: .. code:: haskell -- Assuming that App uses 'Name' for its resource names: data Name = Viewport1 let w = viewport Viewport1 Horizontal $ (visible $ str "Hello," <+> (str " world!") This example requests that the ``Viewport1`` viewport be scrolled so that "Hello," is visible. We could extend this example with a value in the application state indicating which word in our string should be visible and then use that to change which string gets wrapped with ``visible``; this is the basis of cursor-based scrolling. Note that a visibility request does not change the state of a viewport *if the requested widget is already visible*! This important detail is what makes visibility requests so powerful, because they can be used to capture various cursor-based scenarios: * The ``Brick.Widgets.Edit`` widget uses a visibility request to make its 1x1 cursor position visible, thus making the text editing widget fully scrollable *while being entirely scrolling-unaware*. * The ``Brick.Widgets.List`` widget uses a visibility request to make its selected item visible regardless of its size, which makes the list widget scrolling-unaware. Viewport Restrictions --------------------- Viewports impose one restriction: a viewport that is scrollable in some direction can only embed a widget that has a ``Fixed`` size in that direction. This extends to ``Both`` type viewports: they can only embed widgets that are ``Fixed`` in both directions. This restriction is because when viewports embed a widget, they relax the rendering area constraint in the rendering context, but doing so to a large enough number for ``Greedy`` widgets would result in a widget that is too big and not scrollable in a useful way. Violating this restriction will result in a runtime exception. The Rendering Cache =================== When widgets become expensive to render, ``brick`` provides a *rendering cache* that automatically caches and re-uses stored Vty images from previous renderings to avoid expensive renderings. To cache the rendering of a widget, just wrap it in the ``Brick.Widgets.Core.cached`` function: .. code:: haskell data Name = ExpensiveThing ui :: Widget Name ui = center $ cached ExpensiveThing $ 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 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 more sophisticated widgets might. Once ``cached`` has been used to store something in the rendering cache, periodic cache invalidation may be required. For example, if the cached widget is built from application state, the cache will need to be invalidated when the relevant state changes. The cache may also need to be invalidated when the terminal is resized. To invalidate the cache, we use the cache invalidation functions in ``EventM``: .. code:: haskell handleEvent s ... = do -- Invalidate just a single cache entry: Brick.Main.invalidateCacheEntry ExpensiveThing -- Invalidate the entire cache (useful on a resize): Brick.Main.invalidateCache Implementing Custom Widgets =========================== ``brick`` exposes all of the internals you need to implement your own widgets. Those internals, together with ``Graphics.Vty``, can be used to create widgets from the ground up. You'll need to implement your own widget if you can't write what you need in terms of existing combinators. For example, an ordinary widget like .. code:: haskell myWidget :: Widget n myWidget = str "Above" <=> str "Below" can be expressed with ``<=>`` and ``str`` and needs no custom behavior. But suppose we want to write a widget that renders some string followed by the number of columns in the space available to the widget. We can't do this without writing a custom widget because we need access to the rendering context. We can write such a widget as follows: .. code:: haskell customWidget :: String -> Widget n customWidget s = Widget Fixed Fixed $ do ctx <- getContext render $ str (s <> " " <> show (ctx^.availWidthL)) The ``Widget`` constructor takes the horizontal and vertical growth policies as described in `How Widgets and Rendering Work`_. Here we just provide ``Fixed`` for both because the widget will not change behavior if we give it more space. We then get the rendering context and append the context's available columns to the provided string. Lastly we call ``render`` to render the widget we made with ``str``. The ``render`` function returns a ``Brick.Types.Result`` value: .. code:: haskell data Result n = Result { image :: Graphics.Vty.Image , cursors :: [Brick.Types.CursorLocation n] , visibilityRequests :: [Brick.Types.VisibilityRequest] , extents :: [Extent n] } The rendering function runs in the ``RenderM`` monad, which gives us access to the rendering context (see `How Widgets and Rendering Work`_) via the ``Brick.Types.getContext`` function as shown above. The context tells us about the dimensions of the rendering area and the current attribute state of the renderer, among other things: .. code:: haskell data Context = Context { ctxAttrName :: AttrName , availWidth :: Int , availHeight :: Int , ctxBorderStyle :: BorderStyle , ctxAttrMap :: AttrMap } and has lens fields exported as described in `Conventions`_. As shown here, the job of the rendering function is to return a rendering result which means producing a ``vty`` ``Image``. In addition, if you so choose, you can also return one or more cursor positions in the ``cursors`` field of the ``Result`` as well as visibility requests (see `Viewports`_) in the ``visibilityRequests`` field. Returned visibility requests and cursor positions should be relative to the upper-left corner of your widget, ``Location (0, 0)``. When your widget is placed in others, such as boxes, the ``Result`` data you returned will be offset (as described in `Rendering Sub-Widgets`_) to result in correct coordinates once the entire interface has been rendered. Using the Rendering Context --------------------------- The most important fields of the context are the rendering area fields ``availWidth`` and ``availHeight``. These fields must be used to determine how much space your widget has to render. To perform an attribute lookup in the attribute map for the context's current attribute, use ``Brick.Types.attrL``. For example, to build a widget that always fills the available width and height with a fill character using the current attribute, we could write: .. code:: haskell myFill :: Char -> Widget n myFill ch = Widget Greedy Greedy $ do ctx <- getContext let a = ctx^.attrL return $ Result (Graphics.Vty.charFill a ch (ctx^.availWidthL) (ctx^.availHeightL)) [] [] Rendering Sub-Widgets --------------------- If your custom widget wraps another, then in addition to rendering the wrapped widget and augmenting its returned ``Result`` *it must also translate the resulting cursor locations, visibility requests, and extents*. This is vital to maintaining the correctness of rendering metadata as widget layout proceeds. To do so, use the ``Brick.Widgets.Core.addResultOffset`` function to offset the elements of a ``Result`` by a specified amount. The amount depends on the nature of the offset introduced by your wrapper widget's logic. Widgets are not required to respect the rendering context's width and height restrictions. Widgets may be embedded in viewports or translated so they must render without cropping to work in those scenarios. However, widgets rendering other widgets *should* enforce the rendering context's constraints to avoid using more space than is available. The ``Brick.Widgets.Core.cropToContext`` function is provided to make this easy: .. code:: haskell let w = cropToContext someWidget Widgets wrapped with ``cropToContext`` can be safely embedded in other widgets. If you don't want to crop in this way, you can use any of ``vty``'s cropping functions to operate on the ``Result`` image as desired. Sub-widgets may specify specific attribute name values influencing that sub-widget. If the custom widget utilizes its own attribute names but needs to render the sub-widget, it can use ``overrideAttr`` or ``mapAttrNames`` to convert its custom names to the names that the sub-widget uses for rendering its output. .. _vty: https://github.com/coreyoconnor/vty .. _Hackage: http://hackage.haskell.org/ .. _microlens: http://hackage.haskell.org/package/microlens .. _bracketed paste mode: https://cirw.in/blog/bracketed-paste .. _utf8proc: http://julialang.org/utf8proc/ brick-0.18/programs/0000755000000000000000000000000013117314670012557 5ustar0000000000000000brick-0.18/programs/AttrDemo.hs0000644000000000000000000000361013117314670014632 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Data.Monoid import Graphics.Vty ( Attr, white, blue, cyan, green, red, yellow , black ) import Brick.Main import Brick.Types ( Widget ) import Brick.Widgets.Core ( (<=>) , withAttr , vBox , str ) import Brick.Util (on, fg) import Brick.AttrMap (attrMap, AttrMap) ui :: Widget n ui = vBox [ str "This text uses the global default attribute." , withAttr "foundFull" $ str "Specifying an attribute name means we look it up in the attribute tree." , (withAttr "foundFgOnly" $ str ("When we find a value, we merge it with its parent in the attribute") <=> str "name tree all the way to the root (the global default).") , withAttr "missing" $ str "A missing attribute name just resumes the search at its parent." , withAttr ("general" <> "specific") $ str "In this way we build complete attribute values by using an inheritance scheme." , withAttr "foundFull" $ str "You can override everything ..." , withAttr "foundFgOnly" $ str "... or only you want to change and inherit the rest." , str "Attribute names are assembled with the Monoid append operation to indicate" , str "hierarchy levels, e.g. \"window\" <> \"title\"." ] globalDefault :: Attr globalDefault = white `on` blue theMap :: AttrMap theMap = attrMap globalDefault [ ("foundFull", white `on` green) , ("foundFgOnly", fg red) , ("general", yellow `on` black) , ("general" <> "specific", fg cyan) ] app :: App () e () app = App { appDraw = const [ui] , appHandleEvent = resizeOrQuit , appStartEvent = return , appAttrMap = const theMap , appChooseCursor = neverShowCursor } main :: IO () main = defaultMain app () brick-0.18/programs/BorderDemo.hs0000644000000000000000000000507713117314670015146 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Graphics.Vty as V import qualified Brick.Main as M import Brick.Util (fg, bg, on) import qualified Brick.AttrMap as A import Brick.Types ( Widget ) import Brick.Widgets.Core ( (<=>) , (<+>) , vLimit , hLimit , hBox , updateAttrMap , withBorderStyle , txt , str ) import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B import qualified Brick.Widgets.Border.Style as BS styles :: [(T.Text, BS.BorderStyle)] styles = [ ("ascii", BS.ascii) , ("unicode", BS.unicode) , ("unicode bold", BS.unicodeBold) , ("unicode rounded", BS.unicodeRounded) , ("custom", custom) , ("from 'x'", BS.borderStyleFromChar 'x') ] custom :: BS.BorderStyle custom = BS.BorderStyle { BS.bsCornerTL = '/' , BS.bsCornerTR = '\\' , BS.bsCornerBR = '/' , BS.bsCornerBL = '\\' , BS.bsIntersectFull = '.' , BS.bsIntersectL = '.' , BS.bsIntersectR = '.' , BS.bsIntersectT = '.' , BS.bsIntersectB = '.' , BS.bsHorizontal = '*' , BS.bsVertical = '!' } borderDemos :: [Widget ()] borderDemos = mkBorderDemo <$> styles mkBorderDemo :: (T.Text, BS.BorderStyle) -> Widget () mkBorderDemo (styleName, sty) = withBorderStyle sty $ B.borderWithLabel (str "label") $ vLimit 5 $ C.vCenter $ txt $ " " <> styleName <> " style " borderMappings :: [(A.AttrName, V.Attr)] borderMappings = [ (B.borderAttr, V.yellow `on` V.black) , (B.vBorderAttr, V.green `on` V.red) , (B.hBorderAttr, V.white `on` V.green) , (B.hBorderLabelAttr, fg V.blue) , (B.tlCornerAttr, bg V.red) , (B.trCornerAttr, bg V.blue) , (B.blCornerAttr, bg V.yellow) , (B.brCornerAttr, bg V.green) ] colorDemo :: Widget () colorDemo = updateAttrMap (A.applyAttrMappings borderMappings) $ B.borderWithLabel (str "title") $ hLimit 20 $ vLimit 5 $ C.center $ str "colors!" 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")) main :: IO () main = M.simpleMain ui brick-0.18/programs/CacheDemo.hs0000644000000000000000000000474713117314670014737 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Control.Monad (void) import Data.Monoid ((<>)) import qualified Graphics.Vty as V import qualified Brick.Types as T import qualified Brick.Main as M import qualified Brick.Widgets.Center as C import Brick.Types ( Widget , BrickEvent(..) ) import Brick.Widgets.Core ( vBox , padTopBottom , withDefAttr , cached , padBottom , str ) import Brick (on) import Brick.Widgets.Center ( hCenter ) import Brick.AttrMap ( AttrName , attrMap ) data Name = ExpensiveWidget deriving (Ord, Show, Eq) drawUi :: Int -> [Widget Name] drawUi i = [ui] where ui = C.vCenter $ vBox $ hCenter <$> [ str "This demo shows how cached widgets behave. The top widget below" , str "is cacheable, so once it's rendered, brick re-uses the rendering" , str "each time it is drawn. The bottom widget is not cacheable so it is" , str "drawn on every request. Brick supports cache invalidation to force" , str "a redraw of cached widgets; we can trigger that here with 'i'. Notice" , str "how state changes with '+' aren't reflected in the cached widget" , str "until the cache is invalidated with 'i'." , padTopBottom 1 $ cached ExpensiveWidget $ withDefAttr emphAttr $ str $ "This widget is cached (state = " <> show i <> ")" , padBottom (T.Pad 1) $ withDefAttr emphAttr $ str $ "This widget is not cached (state = " <> show i <> ")" , hCenter $ str "Press 'i' to invalidate the cache," , str "'+' to change the state value, and" , str "'Esc' to quit." ] appEvent :: Int -> BrickEvent Name e -> T.EventM Name (T.Next Int) appEvent i (VtyEvent (V.EvKey (V.KChar '+') [])) = M.continue $ i + 1 appEvent i (VtyEvent (V.EvKey (V.KChar 'i') [])) = M.invalidateCacheEntry ExpensiveWidget >> M.continue i appEvent i (VtyEvent (V.EvKey V.KEsc [])) = M.halt i appEvent i _ = M.continue i emphAttr :: AttrName emphAttr = "emphasis" app :: M.App Int e Name app = M.App { M.appDraw = drawUi , M.appStartEvent = return , M.appHandleEvent = appEvent , M.appAttrMap = const $ attrMap V.defAttr [(emphAttr, V.white `on` V.blue)] , M.appChooseCursor = M.neverShowCursor } main :: IO () main = void $ M.defaultMain app 0 brick-0.18/programs/CustomEventDemo.hs0000644000000000000000000000353613117314670016203 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main where import Lens.Micro ((^.), (&), (.~), (%~)) import Lens.Micro.TH (makeLenses) import Control.Monad (void, forever) import Control.Concurrent (threadDelay, forkIO) import Data.Monoid import qualified Graphics.Vty as V import Brick.BChan import Brick.Main ( App(..) , showFirstCursor , customMain , continue , halt ) import Brick.AttrMap ( attrMap ) import Brick.Types ( Widget , Next , EventM , BrickEvent(..) ) import Brick.Widgets.Core ( (<=>) , str ) data CustomEvent = Counter deriving Show data St = St { _stLastBrickEvent :: Maybe (BrickEvent () CustomEvent) , _stCounter :: Int } makeLenses ''St drawUI :: St -> [Widget ()] drawUI st = [a] where a = (str $ "Last event: " <> (show $ st^.stLastBrickEvent)) <=> (str $ "Counter value is: " <> (show $ st^.stCounter)) appEvent :: St -> BrickEvent () CustomEvent -> EventM () (Next St) appEvent st e = case e of VtyEvent (V.EvKey V.KEsc []) -> halt st VtyEvent _ -> continue $ st & stLastBrickEvent .~ (Just e) AppEvent Counter -> continue $ st & stCounter %~ (+1) & stLastBrickEvent .~ (Just e) _ -> continue st initialState :: St initialState = St { _stLastBrickEvent = Nothing , _stCounter = 0 } theApp :: App St CustomEvent () theApp = App { appDraw = drawUI , appChooseCursor = showFirstCursor , appHandleEvent = appEvent , appStartEvent = return , appAttrMap = const $ attrMap V.defAttr [] } main :: IO () main = do chan <- newBChan 10 forkIO $ forever $ do writeBChan chan Counter threadDelay 1000000 void $ customMain (V.mkVty V.defaultConfig) (Just chan) theApp initialState brick-0.18/programs/DialogDemo.hs0000644000000000000000000000330313117314670015116 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Data.Monoid import qualified Graphics.Vty as V import qualified Brick.Main as M import Brick.Types ( Widget , BrickEvent(..) ) import Brick.Widgets.Core ( padAll , str ) import qualified Brick.Widgets.Dialog as D import qualified Brick.Widgets.Center as C import qualified Brick.AttrMap as A import Brick.Util (on, bg) import qualified Brick.Types as T data Choice = Red | Blue | Green deriving Show drawUI :: D.Dialog Choice -> [Widget ()] drawUI d = [ui] where ui = D.renderDialog d $ C.hCenter $ padAll 1 $ str "This is the dialog body." appEvent :: D.Dialog Choice -> BrickEvent () e -> T.EventM () (T.Next (D.Dialog Choice)) appEvent d (VtyEvent ev) = case ev of V.EvKey V.KEsc [] -> M.halt d V.EvKey V.KEnter [] -> M.halt d _ -> M.continue =<< D.handleDialogEvent ev d appEvent d _ = M.continue d initialState :: D.Dialog Choice initialState = D.dialog (Just "Title") (Just (0, choices)) 50 where choices = [ ("Red", Red) , ("Blue", Blue) , ("Green", Green) ] theMap :: A.AttrMap theMap = A.attrMap V.defAttr [ (D.dialogAttr, V.white `on` V.blue) , (D.buttonAttr, V.black `on` V.white) , (D.buttonSelectedAttr, bg V.yellow) ] theApp :: M.App (D.Dialog Choice) e () theApp = M.App { M.appDraw = drawUI , M.appChooseCursor = M.showFirstCursor , M.appHandleEvent = appEvent , M.appStartEvent = return , M.appAttrMap = const theMap } main :: IO () main = do d <- M.defaultMain theApp initialState putStrLn $ "You chose: " <> show (D.dialogSelection d) brick-0.18/programs/EditDemo.hs0000644000000000000000000000537513117314670014617 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-} module Main where import Lens.Micro import Lens.Micro.TH import qualified Graphics.Vty as V import qualified Brick.Main as M import qualified Brick.Types as T import Brick.Widgets.Core ( (<+>) , (<=>) , hLimit , vLimit , str ) import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Edit as E import qualified Brick.AttrMap as A import qualified Brick.Focus as F import Brick.Util (on) data Name = Edit1 | Edit2 deriving (Ord, Show, Eq) data St = St { _focusRing :: F.FocusRing Name , _edit1 :: E.Editor String Name , _edit2 :: E.Editor String Name } makeLenses ''St drawUI :: St -> [T.Widget Name] drawUI st = [ui] where e1 = F.withFocusRing (st^.focusRing) E.renderEditor (st^.edit1) e2 = F.withFocusRing (st^.focusRing) E.renderEditor (st^.edit2) ui = C.center $ (str "Input 1 (unlimited): " <+> (hLimit 30 $ vLimit 5 e1)) <=> str " " <=> (str "Input 2 (limited to 2 lines): " <+> (hLimit 30 e2)) <=> str " " <=> str "Press Tab to switch between editors, Esc to quit." appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St) appEvent st (T.VtyEvent ev) = case ev of V.EvKey V.KEsc [] -> M.halt st V.EvKey (V.KChar '\t') [] -> M.continue $ st & focusRing %~ F.focusNext V.EvKey V.KBackTab [] -> M.continue $ st & focusRing %~ F.focusPrev _ -> M.continue =<< case F.focusGetCurrent (st^.focusRing) of Just Edit1 -> T.handleEventLensed st edit1 E.handleEditorEvent ev Just Edit2 -> T.handleEventLensed st edit2 E.handleEditorEvent ev Nothing -> return st appEvent st _ = M.continue st initialState :: St initialState = St (F.focusRing [Edit1, Edit2]) (E.editor Edit1 (str . unlines) Nothing "") (E.editor Edit2 (str . unlines) (Just 2) "") theMap :: A.AttrMap theMap = A.attrMap V.defAttr [ (E.editAttr, V.white `on` V.blue) , (E.editFocusedAttr, V.black `on` V.yellow) ] appCursor :: St -> [T.CursorLocation Name] -> Maybe (T.CursorLocation Name) appCursor = F.focusRingCursor (^.focusRing) theApp :: M.App St e Name theApp = M.App { M.appDraw = drawUI , M.appChooseCursor = appCursor , M.appHandleEvent = appEvent , M.appStartEvent = return , M.appAttrMap = const theMap } main :: IO () main = do st <- M.defaultMain theApp initialState putStrLn "In input 1 you entered:\n" putStrLn $ unlines $ E.getEditContents $ st^.edit1 putStrLn "In input 2 you entered:\n" putStrLn $ unlines $ E.getEditContents $ st^.edit2 brick-0.18/programs/HelloWorldDemo.hs0000644000000000000000000000015613117314670015775 0ustar0000000000000000module Main where import Brick ui :: Widget () ui = str "Hello, world!" main :: IO () main = simpleMain ui brick-0.18/programs/LayerDemo.hs0000644000000000000000000000503413117314670014776 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main where import Lens.Micro ((^.), (&), (%~)) import Lens.Micro.TH (makeLenses) import Control.Monad (void) import qualified Graphics.Vty as V import qualified Brick.Types as T import Brick.Types (locationRowL, locationColumnL, Widget) import qualified Brick.Main as M import qualified Brick.Widgets.Border as B import qualified Brick.Widgets.Center as C import Brick.Widgets.Core ( translateBy , str ) import Brick.AttrMap ( attrMap ) data St = St { _topLayerLocation :: T.Location , _bottomLayerLocation :: T.Location } makeLenses ''St drawUi :: St -> [Widget ()] drawUi st = [ C.centerLayer $ B.border $ str "This layer is centered but other\nlayers are placed underneath it." , topLayer st , bottomLayer st ] topLayer :: St -> Widget () topLayer st = translateBy (st^.topLayerLocation) $ B.border $ str "Top layer\n(Arrow keys move)" bottomLayer :: St -> Widget () bottomLayer st = translateBy (st^.bottomLayerLocation) $ B.border $ str "Bottom layer\n(Ctrl-arrow keys move)" appEvent :: St -> T.BrickEvent () e -> T.EventM () (T.Next St) appEvent st (T.VtyEvent (V.EvKey V.KDown [])) = M.continue $ st & topLayerLocation.locationRowL %~ (+ 1) appEvent st (T.VtyEvent (V.EvKey V.KUp [])) = M.continue $ st & topLayerLocation.locationRowL %~ (subtract 1) appEvent st (T.VtyEvent (V.EvKey V.KRight [])) = M.continue $ st & topLayerLocation.locationColumnL %~ (+ 1) appEvent st (T.VtyEvent (V.EvKey V.KLeft [])) = M.continue $ st & topLayerLocation.locationColumnL %~ (subtract 1) appEvent st (T.VtyEvent (V.EvKey V.KDown [V.MCtrl])) = M.continue $ st & bottomLayerLocation.locationRowL %~ (+ 1) appEvent st (T.VtyEvent (V.EvKey V.KUp [V.MCtrl])) = M.continue $ st & bottomLayerLocation.locationRowL %~ (subtract 1) appEvent st (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = M.continue $ st & bottomLayerLocation.locationColumnL %~ (+ 1) appEvent st (T.VtyEvent (V.EvKey V.KLeft [V.MCtrl])) = M.continue $ st & bottomLayerLocation.locationColumnL %~ (subtract 1) appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st appEvent st _ = M.continue st app :: M.App St e () app = M.App { M.appDraw = drawUi , M.appStartEvent = return , M.appHandleEvent = appEvent , M.appAttrMap = const $ attrMap V.defAttr [] , M.appChooseCursor = M.neverShowCursor } main :: IO () main = void $ M.defaultMain app $ St (T.Location (0, 0)) (T.Location (0, 0)) brick-0.18/programs/ListDemo.hs0000644000000000000000000000576113117314670014644 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Lens.Micro ((^.)) import Control.Monad (void) import Data.Monoid import Data.Maybe (fromMaybe) import qualified Graphics.Vty as V import qualified Brick.Main as M import qualified Brick.Types as T import qualified Brick.Widgets.Border as B import qualified Brick.Widgets.List as L import qualified Brick.Widgets.Center as C import qualified Brick.AttrMap as A import qualified Data.Vector as Vec import Brick.Types ( Widget ) import Brick.Widgets.Core ( (<+>) , str , vLimit , hLimit , vBox , withAttr ) import Brick.Util (fg, on) drawUI :: (Show a) => L.List () a -> [Widget ()] drawUI l = [ui] where label = str "Item " <+> cur <+> str " of " <+> total cur = case l^.(L.listSelectedL) of Nothing -> str "-" Just i -> str (show (i + 1)) total = str $ show $ Vec.length $ l^.(L.listElementsL) box = B.borderWithLabel label $ hLimit 25 $ vLimit 15 $ L.renderList listDrawElement True l ui = C.vCenter $ vBox [ C.hCenter box , str " " , C.hCenter $ str "Press +/- to add/remove list elements." , C.hCenter $ str "Press Esc to exit." ] appEvent :: L.List () Char -> T.BrickEvent () e -> T.EventM () (T.Next (L.List () Char)) appEvent l (T.VtyEvent e) = case e of V.EvKey (V.KChar '+') [] -> let el = nextElement (L.listElements l) pos = Vec.length $ l^.(L.listElementsL) in M.continue $ L.listInsert pos el l V.EvKey (V.KChar '-') [] -> case l^.(L.listSelectedL) of Nothing -> M.continue l Just i -> M.continue $ L.listRemove i l V.EvKey V.KEsc [] -> M.halt l ev -> M.continue =<< L.handleListEvent ev l where nextElement :: Vec.Vector Char -> Char nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z']) appEvent l _ = M.continue l listDrawElement :: (Show a) => Bool -> a -> Widget () listDrawElement sel a = let selStr s = if sel then withAttr customAttr (str $ "<" <> s <> ">") else str s in C.hCenter $ str "Item " <+> (selStr $ show a) initialState :: L.List () Char initialState = L.list () (Vec.fromList ['a','b','c']) 1 customAttr :: A.AttrName customAttr = L.listSelectedAttr <> "custom" theMap :: A.AttrMap theMap = A.attrMap V.defAttr [ (L.listAttr, V.white `on` V.blue) , (L.listSelectedAttr, V.blue `on` V.white) , (customAttr, fg V.cyan) ] theApp :: M.App (L.List () Char) e () theApp = M.App { M.appDraw = drawUI , M.appChooseCursor = M.showFirstCursor , M.appHandleEvent = appEvent , M.appStartEvent = return , M.appAttrMap = const theMap } main :: IO () main = void $ M.defaultMain theApp initialState brick-0.18/programs/MarkupDemo.hs0000644000000000000000000000216613117314670015164 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Data.Monoid ((<>)) import qualified Graphics.Vty as V import Brick.Main (App(..), defaultMain, resizeOrQuit, neverShowCursor) import Brick.Types ( Widget , Padding(..) ) import Brick.Widgets.Core ( (<=>) , (<+>) , padLeft ) import Brick.Util (on, fg) import Brick.Markup (markup, (@?)) import Brick.AttrMap (attrMap, AttrMap) import Data.Text.Markup ((@@)) ui :: Widget () ui = (m1 <=> m2) <+> (padLeft (Pad 1) m3) where m1 = markup $ ("Hello" @@ fg V.blue) <> ", " <> ("world!" @@ fg V.red) m2 = markup $ ("Hello" @? "keyword1") <> ", " <> ("world!" @? "keyword2") m3 = markup $ ("Hello," @? "keyword1") <> "\n" <> ("world!" @? "keyword2") theMap :: AttrMap theMap = attrMap V.defAttr [ ("keyword1", fg V.magenta) , ("keyword2", V.white `on` V.blue) ] app :: App () e () app = App { appDraw = const [ui] , appHandleEvent = resizeOrQuit , appAttrMap = const theMap , appStartEvent = return , appChooseCursor = neverShowCursor } main :: IO () main = defaultMain app () brick-0.18/programs/MouseDemo.hs0000644000000000000000000001240513117314670015012 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main where import Control.Applicative ((<$>)) import Lens.Micro ((^.), (&), (.~), (%~)) import Lens.Micro.TH (makeLenses) import Control.Monad (void) import Data.Monoid ((<>)) import qualified Graphics.Vty as V import qualified Brick.Types as T import Brick.AttrMap import Brick.Util import Brick.Types (Widget, ViewportType(Vertical)) import qualified Brick.Main as M import qualified Brick.Widgets.Edit as E import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B import Brick.Widgets.Core import Data.Text.Zipper (moveCursor) import Data.Tuple (swap) data Name = Info | Button1 | Button2 | Button3 | Prose | TextBox deriving (Show, Ord, Eq) data St = St { _clicked :: [T.Extent Name] , _lastReportedClick :: Maybe (Name, T.Location) , _prose :: String , _edit :: E.Editor String Name } makeLenses ''St drawUi :: St -> [Widget Name] drawUi st = [ buttonLayer st , proseLayer st , infoLayer st ] buttonLayer :: St -> Widget Name buttonLayer st = C.vCenterLayer $ C.hCenterLayer (padBottom (T.Pad 1) $ str "Click a button:") <=> C.hCenterLayer (hBox $ padLeftRight 1 <$> buttons) <=> C.hCenterLayer (padTopBottom 1 $ str "Or enter text and then click in this editor:") <=> C.hCenterLayer (vLimit 3 $ hLimit 50 $ E.renderEditor True (st^.edit)) where buttons = mkButton <$> buttonData buttonData = [ (Button1, "Button 1", "button1") , (Button2, "Button 2", "button2") , (Button3, "Button 3", "button3") ] mkButton (name, label, attr) = let wasClicked = (fst <$> st^.lastReportedClick) == Just name in clickable name $ withDefAttr attr $ B.border $ padTopBottom 1 $ padLeftRight (if wasClicked then 2 else 3) $ str (if wasClicked then "<" <> label <> ">" else label) proseLayer :: St -> Widget Name proseLayer st = B.border $ C.hCenterLayer $ vLimit 8 $ -- n.b. if clickable and viewport are inverted here, click event -- coordinates will only identify the viewable range, not the actual -- editor widget coordinates. viewport Prose Vertical $ clickable Prose $ vBox $ map str $ lines (st^.prose) infoLayer :: St -> Widget Name infoLayer st = T.Widget T.Fixed T.Fixed $ do c <- T.getContext let h = c^.T.availHeightL msg = case st^.lastReportedClick of Nothing -> "nothing" Just (name, T.Location l) -> show name <> " at " <> show l T.render $ translateBy (T.Location (0, h-1)) $ clickable Info $ withDefAttr "info" $ C.hCenter (str ("Last reported click: " <> msg)) appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St) appEvent st (T.MouseDown n _ _ loc) = do let T.Location pos = loc M.continue $ st & lastReportedClick .~ Just (n, loc) & edit %~ E.applyEdit (if n == TextBox then moveCursor (swap pos) else id) appEvent st (T.MouseUp _ _ _) = M.continue $ st & lastReportedClick .~ Nothing appEvent st (T.VtyEvent (V.EvMouseUp _ _ _)) = M.continue $ st & lastReportedClick .~ Nothing appEvent st (T.VtyEvent (V.EvKey V.KUp [V.MCtrl])) = M.vScrollBy (M.viewportScroll Prose) (-1) >> M.continue st appEvent st (T.VtyEvent (V.EvKey V.KDown [V.MCtrl])) = M.vScrollBy (M.viewportScroll Prose) 1 >> M.continue st appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st appEvent st (T.VtyEvent ev) = M.continue =<< T.handleEventLensed st edit E.handleEditorEvent ev appEvent st _ = M.continue st aMap :: AttrMap aMap = attrMap V.defAttr [ ("info", V.white `on` V.magenta) , ("button1", V.white `on` V.cyan) , ("button2", V.white `on` V.green) , ("button3", V.white `on` V.blue) , (E.editFocusedAttr, V.black `on` V.yellow) ] app :: M.App St e Name app = M.App { M.appDraw = drawUi , M.appStartEvent = return , M.appHandleEvent = appEvent , M.appAttrMap = const aMap , M.appChooseCursor = M.showFirstCursor } main :: IO () main = do let buildVty = do v <- V.mkVty =<< V.standardIOConfig V.setMode (V.outputIface v) V.Mouse True return v void $ M.customMain buildVty Nothing app $ St [] Nothing "Press Ctrl-up and Ctrl-down arrow keys to scroll, ESC to quit.\n\ \Observe the click coordinates identify the\n\ \underlying widget coordinates.\n\ \\n\ \Lorem ipsum dolor sit amet,\n\ \consectetur adipiscing elit,\n\ \sed do eiusmod tempor incididunt ut labore\n\ \et dolore magna aliqua.\n\ \ \n\ \Ut enim ad minim veniam\n\ \quis nostrud exercitation ullamco laboris\n\ \nisi ut aliquip ex ea commodo consequat.\n\ \\n\ \Duis aute irure dolor in reprehenderit\n\ \in voluptate velit esse cillum dolore eu fugiat nulla pariatur.\n\ \\n\ \Excepteur sint occaecat cupidatat not proident,\n\ \sunt in culpa qui officia deserunt mollit\n\ \anim id est laborum.\n" (E.editor TextBox (str . unlines) Nothing "") brick-0.18/programs/PaddingDemo.hs0000644000000000000000000000267413117314670015277 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Brick.Main (App(..), neverShowCursor, resizeOrQuit, defaultMain) import Brick.Types ( Widget , Padding(..) ) import Brick.Widgets.Core ( vBox , hBox , str , padAll , padLeft , padRight , padTop , padBottom , padTopBottom , padLeftRight ) import Brick.Widgets.Border as B import Brick.Widgets.Center as C import Brick.AttrMap (attrMap) import qualified Graphics.Vty as V ui :: Widget () ui = vBox [ hBox [ padLeft Max $ vCenter $ str "Left-padded" , B.vBorder , padRight Max $ vCenter $ str "Right-padded" ] , B.hBorder , hBox [ padTop Max $ hCenter $ str "Top-padded" , B.vBorder , padBottom Max $ hCenter $ str "Bottom-padded" ] , B.hBorder , hBox [ padLeftRight 2 $ str "Padded by 2 on left/right" , B.vBorder , vBox [ padTopBottom 1 $ str "Padded by 1 on top/bottom" , B.hBorder ] ] , B.hBorder , padAll 2 $ str "Padded by 2 on all sides" ] app :: App () e () app = App { appDraw = const [ui] , appHandleEvent = resizeOrQuit , appStartEvent = return , appAttrMap = const $ attrMap V.defAttr [] , appChooseCursor = neverShowCursor } main :: IO () main = defaultMain app () brick-0.18/programs/ProgressBarDemo.hs0000644000000000000000000000643413117314670016160 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad (void) import Data.Monoid import qualified Graphics.Vty as V import qualified Brick.AttrMap as A import qualified Brick.Main as M import qualified Brick.Types as T import qualified Brick.Widgets.ProgressBar as P import Brick.Types ( Widget ) import Brick.Widgets.Core ( (<+>), (<=>) , str , updateAttrMap , overrideAttr ) import Brick.Util (fg, bg, on, clamp) data MyAppState n = MyAppState { x, y, z :: Float } drawUI :: MyAppState () -> [Widget ()] drawUI p = [ui] where -- use mapAttrNames xBar = updateAttrMap (A.mapAttrNames [ (xDoneAttr, P.progressCompleteAttr) , (xToDoAttr, P.progressIncompleteAttr) ] ) $ bar $ x p -- or use individual mapAttrName calls yBar = updateAttrMap (A.mapAttrName yDoneAttr P.progressCompleteAttr . A.mapAttrName yToDoAttr P.progressIncompleteAttr) $ bar $ y p -- or use overrideAttr calls zBar = overrideAttr P.progressCompleteAttr zDoneAttr $ overrideAttr P.progressIncompleteAttr zToDoAttr $ bar $ z p lbl c = Just $ show $ fromEnum $ c * 100 bar v = P.progressBar (lbl v) v ui = (str "X: " <+> xBar) <=> (str "Y: " <+> yBar) <=> (str "Z: " <+> zBar) <=> str "" <=> str "Hit 'x', 'y', or 'z' to advance progress, or 'q' to quit" appEvent :: MyAppState () -> T.BrickEvent () e -> T.EventM () (T.Next (MyAppState ())) appEvent p (T.VtyEvent e) = let valid = clamp (0.0 :: Float) 1.0 in case e of V.EvKey (V.KChar 'x') [] -> M.continue $ p { x = valid $ x p + 0.05 } V.EvKey (V.KChar 'y') [] -> M.continue $ p { y = valid $ y p + 0.03 } V.EvKey (V.KChar 'z') [] -> M.continue $ p { z = valid $ z p + 0.02 } V.EvKey (V.KChar 'q') [] -> M.halt p _ -> M.continue p appEvent p _ = M.continue p initialState :: MyAppState () initialState = MyAppState 0.25 0.18 0.63 theBaseAttr :: A.AttrName theBaseAttr = A.attrName "theBase" xDoneAttr, xToDoAttr :: A.AttrName xDoneAttr = theBaseAttr <> A.attrName "X:done" xToDoAttr = theBaseAttr <> A.attrName "X:remaining" yDoneAttr, yToDoAttr :: A.AttrName yDoneAttr = theBaseAttr <> A.attrName "Y:done" yToDoAttr = theBaseAttr <> A.attrName "Y:remaining" zDoneAttr, zToDoAttr :: A.AttrName zDoneAttr = theBaseAttr <> A.attrName "Z:done" zToDoAttr = theBaseAttr <> A.attrName "Z:remaining" theMap :: A.AttrMap theMap = A.attrMap V.defAttr [ (theBaseAttr, bg V.brightBlack) , (xDoneAttr, V.black `on` V.white) , (xToDoAttr, V.white `on` V.black) , (yDoneAttr, V.magenta `on` V.yellow) , (zDoneAttr, V.blue `on` V.green) , (zToDoAttr, V.blue `on` V.red) , (P.progressIncompleteAttr, fg V.yellow) ] theApp :: M.App (MyAppState ()) e () theApp = M.App { M.appDraw = drawUI , M.appChooseCursor = M.showFirstCursor , M.appHandleEvent = appEvent , M.appStartEvent = return , M.appAttrMap = const theMap } main :: IO () main = void $ M.defaultMain theApp initialState brick-0.18/programs/ReadmeDemo.hs0000644000000000000000000000046613117314670015123 0ustar0000000000000000module Main where import Brick import Brick.Widgets.Center import Brick.Widgets.Border import Brick.Widgets.Border.Style ui :: Widget () ui = withBorderStyle unicode $ borderWithLabel (str "Hello!") $ (center (str "Left") <+> vBorder <+> center (str "Right")) main :: IO () main = simpleMain ui brick-0.18/programs/SuspendAndResumeDemo.hs0000644000000000000000000000304613117314670017150 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main where import Lens.Micro ((.~), (^.), (&)) import Lens.Micro.TH (makeLenses) import Control.Monad (void) import Data.Monoid import qualified Graphics.Vty as V import Brick.Main ( App(..), neverShowCursor, defaultMain , suspendAndResume, halt, continue ) import Brick.AttrMap ( attrMap ) import Brick.Types ( Widget , EventM , Next , BrickEvent(..) ) import Brick.Widgets.Core ( vBox , str ) data St = St { _stExternalInput :: String } makeLenses ''St drawUI :: St -> [Widget ()] drawUI st = [ui] where ui = vBox [ str $ "External input: \"" <> st^.stExternalInput <> "\"" , str "(Press Esc to quit or Space to ask for input)" ] appEvent :: St -> BrickEvent () e -> EventM () (Next St) appEvent st (VtyEvent e) = case e of V.EvKey V.KEsc [] -> halt st V.EvKey (V.KChar ' ') [] -> suspendAndResume $ do putStrLn "Suspended. Please enter something and press enter to resume:" s <- getLine return $ st & stExternalInput .~ s _ -> continue st appEvent st _ = continue st initialState :: St initialState = St { _stExternalInput = "" } theApp :: App St e () theApp = App { appDraw = drawUI , appChooseCursor = neverShowCursor , appHandleEvent = appEvent , appStartEvent = return , appAttrMap = const $ attrMap V.defAttr [] } main :: IO () main = void $ defaultMain theApp initialState brick-0.18/programs/ViewportScrollDemo.hs0000644000000000000000000000553613117314670016727 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Control.Monad (void) import Data.Monoid ((<>)) import qualified Graphics.Vty as V import qualified Brick.Types as T import qualified Brick.Main as M import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B import Brick.Types ( Widget , ViewportType(Horizontal, Vertical, Both) ) import Brick.AttrMap ( attrMap ) import Brick.Widgets.Core ( hLimit , vLimit , hBox , vBox , viewport , str ) data Name = VP1 | VP2 | VP3 deriving (Ord, Show, Eq) drawUi :: () -> [Widget Name] drawUi = const [ui] where ui = C.center $ B.border $ hLimit 60 $ vLimit 21 $ vBox [ pair, B.hBorder, singleton ] singleton = viewport VP3 Both $ vBox $ str "Press ctrl-arrow keys to scroll this viewport horizontally and vertically." : (str <$> [ "Line " <> show i | i <- [2..25::Int] ]) pair = hBox [ viewport VP1 Vertical $ vBox $ str "Press up and down arrow keys" : str "to scroll this viewport." : (str <$> [ "Line " <> (show i) | i <- [3..50::Int] ]) , B.vBorder , viewport VP2 Horizontal $ str "Press left and right arrow keys to scroll this viewport." ] vp1Scroll :: M.ViewportScroll Name vp1Scroll = M.viewportScroll VP1 vp2Scroll :: M.ViewportScroll Name vp2Scroll = M.viewportScroll VP2 vp3Scroll :: M.ViewportScroll Name vp3Scroll = M.viewportScroll VP3 appEvent :: () -> T.BrickEvent Name e -> T.EventM Name (T.Next ()) appEvent _ (T.VtyEvent (V.EvKey V.KDown [V.MCtrl])) = M.vScrollBy vp3Scroll 1 >> M.continue () appEvent _ (T.VtyEvent (V.EvKey V.KUp [V.MCtrl])) = M.vScrollBy vp3Scroll (-1) >> M.continue () appEvent _ (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = M.hScrollBy vp3Scroll 1 >> M.continue () appEvent _ (T.VtyEvent (V.EvKey V.KLeft [V.MCtrl])) = M.hScrollBy vp3Scroll (-1) >> M.continue () appEvent _ (T.VtyEvent (V.EvKey V.KDown [])) = M.vScrollBy vp1Scroll 1 >> M.continue () appEvent _ (T.VtyEvent (V.EvKey V.KUp [])) = M.vScrollBy vp1Scroll (-1) >> M.continue () appEvent _ (T.VtyEvent (V.EvKey V.KRight [])) = M.hScrollBy vp2Scroll 1 >> M.continue () appEvent _ (T.VtyEvent (V.EvKey V.KLeft [])) = M.hScrollBy vp2Scroll (-1) >> M.continue () appEvent _ (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt () appEvent _ _ = M.continue () app :: M.App () e Name app = M.App { M.appDraw = drawUi , M.appStartEvent = return , M.appHandleEvent = appEvent , M.appAttrMap = const $ attrMap V.defAttr [] , M.appChooseCursor = M.neverShowCursor } main :: IO () main = void $ M.defaultMain app () brick-0.18/programs/VisibilityDemo.hs0000644000000000000000000001042513117314670016051 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main where import Control.Monad (void) import Lens.Micro import Lens.Micro.TH import Data.Monoid import qualified Graphics.Vty as V import qualified Brick.Types as T import qualified Brick.Main as M import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B import Brick.AttrMap (AttrMap, AttrName, attrMap) import Brick.Util (on) import Brick.Types ( Widget , ViewportType(Horizontal, Vertical, Both) ) import Brick.Widgets.Core ( withAttr , hLimit , vLimit , hBox , vBox , viewport , str , visible ) data St = St { _vp1Index :: Int , _vp2Index :: Int , _vp3Index :: (Int, Int) } makeLenses ''St data Name = VP1 | VP2 | VP3 deriving (Show, Ord, Eq) vp1Size :: Int vp1Size = 15 vp2Size :: Int vp2Size = 15 vp3Size :: (Int, Int) vp3Size = (25, 25) selectedAttr :: AttrName selectedAttr = "selected" drawUi :: St -> [Widget Name] drawUi st = [ui] where ui = C.center $ hLimit 60 $ vLimit 30 $ vBox [ B.border $ vBox [ pair, B.hBorder, singleton ] , str $ "- Up/down arrow keys scroll the top-left viewport\n" <> "- Left/right arrow keys scroll the top-right viewport\n" <> "- Ctrl-arrow keys move the bottom viewport" ] singleton = viewport VP3 Both $ vBox $ do i <- [1..vp3Size^._1] let row = do j <- [1..vp3Size^._2] let mkItem = if (i, j) == st^.vp3Index then withAttr selectedAttr . visible else id return $ mkItem $ str $ "Item " <> show (i, j) <> " " return $ hBox row pair = hBox [ vp1, B.vBorder, vp2 ] vp1 = viewport VP1 Vertical $ vBox $ do i <- [1..vp1Size] let mkItem = if i == st^.vp1Index then withAttr selectedAttr . visible else id return $ mkItem $ str $ "Item " <> show i vp2 = viewport VP2 Horizontal $ hBox $ do i <- [1..vp2Size] let mkItem = if i == st^.vp2Index then withAttr selectedAttr . visible else id return $ mkItem $ str $ "Item " <> show i <> " " vp1Scroll :: M.ViewportScroll Name vp1Scroll = M.viewportScroll VP1 vp2Scroll :: M.ViewportScroll Name vp2Scroll = M.viewportScroll VP2 vp3Scroll :: M.ViewportScroll Name vp3Scroll = M.viewportScroll VP3 appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St) appEvent st (T.VtyEvent (V.EvKey V.KDown [V.MCtrl])) = M.continue $ st & vp3Index._1 %~ min (vp3Size^._1) . (+ 1) appEvent st (T.VtyEvent (V.EvKey V.KUp [V.MCtrl])) = M.continue $ st & vp3Index._1 %~ max 1 . subtract 1 appEvent st (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = M.continue $ st & vp3Index._2 %~ min (vp3Size^._1) . (+ 1) appEvent st (T.VtyEvent (V.EvKey V.KLeft [V.MCtrl])) = M.continue $ st & vp3Index._2 %~ max 1 . subtract 1 appEvent st (T.VtyEvent (V.EvKey V.KDown [])) = M.continue $ st & vp1Index %~ min vp1Size . (+ 1) appEvent st (T.VtyEvent (V.EvKey V.KUp [])) = M.continue $ st & vp1Index %~ max 1 . subtract 1 appEvent st (T.VtyEvent (V.EvKey V.KRight [])) = M.continue $ st & vp2Index %~ min vp2Size . (+ 1) appEvent st (T.VtyEvent (V.EvKey V.KLeft [])) = M.continue $ st & vp2Index %~ max 1 . subtract 1 appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st appEvent st _ = M.continue st theMap :: AttrMap theMap = attrMap V.defAttr [ (selectedAttr, V.black `on` V.yellow) ] app :: M.App St e Name app = M.App { M.appDraw = drawUi , M.appStartEvent = return , M.appHandleEvent = appEvent , M.appAttrMap = const theMap , M.appChooseCursor = M.neverShowCursor } initialState :: St initialState = St 1 1 (1, 1) main :: IO () main = void $ M.defaultMain app initialState brick-0.18/src/0000755000000000000000000000000013117314670011514 5ustar0000000000000000brick-0.18/src/Brick.hs0000644000000000000000000000054413117314670013105 0ustar0000000000000000-- | This module is provided as a convenience to import the most -- important parts of the API all at once. module Brick ( module Brick.Main , module Brick.Types , module Brick.Widgets.Core , module Brick.AttrMap , module Brick.Util ) where import Brick.Main import Brick.Types import Brick.Widgets.Core import Brick.AttrMap import Brick.Util brick-0.18/src/Brick/0000755000000000000000000000000013117314670012546 5ustar0000000000000000brick-0.18/src/Brick/AttrMap.hs0000644000000000000000000001553113117314670014457 0ustar0000000000000000-- | This module provides types and functions for managing an attribute -- map which maps attribute names ('AttrName') to attributes ('Attr'). -- This module is designed to be used with the 'OverloadedStrings' -- language extension to permit easy construction of 'AttrName' values -- and you should also use 'mappend' ('<>') to combine names. -- -- Attribute maps work by mapping hierarchical attribute names to -- attributes and inheriting parent names' attributes when child names -- specify partial attributes. Hierarchical names are created with 'mappend': -- -- @ -- let n = attrName "parent" <> attrName "child" -- @ -- -- Attribute names are mapped to attributes, but some attributes may -- be partial (specify only a foreground or background color). When -- attribute name lookups occur, the attribute corresponding to a more -- specific name ('parent <> child' as above) is sucessively merged with -- the parent attribute ('parent' as above) all the way to the "root" -- of the attribute map, the map's default attribute. In this way, more -- specific attributes inherit what they don't specify from more general -- attributes in the same hierarchy. This allows more modularity and -- less repetition in specifying how elements of your user interface -- take on different attributes. module Brick.AttrMap ( AttrMap , AttrName -- * Construction , attrMap , forceAttrMap , attrName -- * Finding attributes from names , attrMapLookup -- * Manipulating attribute maps , setDefault , applyAttrMappings , mergeWithDefault , mapAttrName , mapAttrNames ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) import Data.Monoid #endif import qualified Data.Map as M import Data.Maybe (catMaybes) import Data.List (inits) import Data.String (IsString(..)) import Graphics.Vty (Attr(..), MaybeDefault(..)) -- | An attribute name. Attribute names are hierarchical; use 'mappend' -- ('<>') to assemble them. Hierachy in an attribute name is used to -- represent increasing levels of specificity in referring to the -- attribute you want to use for a visual element, with names to the -- left being general and names to the right being more specific. For -- example: -- -- @ -- "window" <> "border" -- "window" <> "title" -- "header" <> "clock" <> "seconds" -- @ data AttrName = AttrName [String] deriving (Show, Eq, Ord) instance Monoid AttrName where mempty = AttrName [] mappend (AttrName as) (AttrName bs) = AttrName $ as `mappend` bs instance IsString AttrName where fromString = AttrName . (:[]) -- | An attribute map which maps 'AttrName' values to 'Attr' values. data AttrMap = AttrMap Attr (M.Map AttrName Attr) | ForceAttr Attr deriving Show -- | Create an attribute name from a string. attrName :: String -> AttrName attrName = AttrName . (:[]) -- | Create an attribute map. attrMap :: Attr -- ^ The map's default attribute to be returned when a name -- lookup fails, and the attribute that will be merged with -- successful lookups. -> [(AttrName, Attr)] -- ^ The map's initial contents. -> AttrMap attrMap theDefault pairs = AttrMap theDefault (M.fromList pairs) -- | Create an attribute map in which all lookups map to the same -- attribute. forceAttrMap :: Attr -> AttrMap forceAttrMap = ForceAttr -- | 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 -- the one specified here. Otherwise the attribute given here is merged -- with the attribute map's default attribute in that any aspect of the -- specified attribute that is not provided falls back to the map -- default. For example, -- -- @ -- mergeWithDefault (fg blue) $ attrMap (bg red) [] -- @ -- -- returns -- -- @ -- blue \`on\` red -- @ mergeWithDefault :: Attr -> AttrMap -> Attr mergeWithDefault _ (ForceAttr a) = a mergeWithDefault a (AttrMap d _) = combineAttrs d a -- | Look up the specified attribute name in the map. Map lookups -- proceed as follows. If the attribute map is forcing all lookups to a -- specific attribute, that attribute is returned. If the attribute name -- is empty, the map's default attribute is returned. If the attribute -- name is non-empty, very subsequence of names from the specified name -- are used to perform a lookup, and the results are combined as in -- 'mergeWithDefault', with more specific results taking precedence over -- less specific ones. -- -- For example: -- -- @ -- attrMapLookup ("foo" <> "bar") (attrMap a []) == a -- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", fg red)]) == red \`on\` blue -- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", red `on` cyan)]) == red \`on\` cyan -- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", fg red), ("foo", bg cyan)]) == red \`on\` cyan -- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo", fg red)]) == red \`on\` blue -- @ attrMapLookup :: AttrName -> AttrMap -> Attr attrMapLookup _ (ForceAttr a) = a attrMapLookup (AttrName []) (AttrMap theDefault _) = theDefault attrMapLookup (AttrName ns) (AttrMap theDefault m) = let results = catMaybes $ (\n -> M.lookup n m) <$> (AttrName <$> (inits ns)) in foldl combineAttrs theDefault results -- | Set the default attribute value in an attribute map. setDefault :: Attr -> AttrMap -> AttrMap setDefault _ (ForceAttr a) = ForceAttr a setDefault newDefault (AttrMap _ m) = AttrMap newDefault m combineAttrs :: Attr -> Attr -> Attr combineAttrs (Attr s1 f1 b1) (Attr s2 f2 b2) = Attr (s1 `combineMDs` s2) (f1 `combineMDs` f2) (b1 `combineMDs` b2) combineMDs :: MaybeDefault a -> MaybeDefault a -> MaybeDefault a combineMDs _ (SetTo v) = SetTo v combineMDs (SetTo v) _ = SetTo v combineMDs _ v = v -- | Insert a set of attribute mappings to an attribute map. applyAttrMappings :: [(AttrName, Attr)] -> AttrMap -> AttrMap applyAttrMappings _ (ForceAttr a) = ForceAttr a applyAttrMappings ms (AttrMap d m) = AttrMap d ((M.fromList ms) `M.union` m) -- | Update an attribute map such that a lookup of 'ontoName' returns -- the attribute value specified by 'fromName'. This is useful for -- composite widgets with specific attribute names mapping those names -- to the sub-widget's expected name when calling that sub-widget's -- rendering function. See the ProgressBarDemo for an example usage, -- and 'overrideAttr' for an alternate syntax. mapAttrName :: AttrName -> AttrName -> AttrMap -> AttrMap mapAttrName fromName ontoName inMap = applyAttrMappings [(ontoName, attrMapLookup fromName inMap)] inMap -- | Map several attributes to return the value associated with an -- alternate name. Applies 'mapAttrName' across a list of mappings. mapAttrNames :: [(AttrName, AttrName)] -> AttrMap -> AttrMap mapAttrNames names inMap = foldr (uncurry mapAttrName) inMap names brick-0.18/src/Brick/BChan.hs0000644000000000000000000000214613117314670014060 0ustar0000000000000000module Brick.BChan ( BChan , newBChan , writeBChan , readBChan , readBChan2 ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Concurrent.STM.TBQueue import Control.Monad.STM (atomically, orElse) -- | @BChan@ is an abstract type representing a bounded FIFO channel. data BChan a = BChan (TBQueue a) -- |Builds and returns a new instance of @BChan@. newBChan :: Int -- ^ maximum number of elements the channel can hold -> IO (BChan a) newBChan size = atomically $ BChan <$> newTBQueue size -- |Writes a value to a @BChan@; blocks if the channel is full. writeBChan :: BChan a -> a -> IO () writeBChan (BChan q) a = atomically $ writeTBQueue q a -- |Reads the next value from the @BChan@; blocks if necessary. readBChan :: BChan a -> IO a readBChan (BChan q) = atomically $ readTBQueue q -- |Reads the next value from either @BChan@, prioritizing the first @BChan@; -- blocks if necessary. readBChan2 :: BChan a -> BChan b -> IO (Either a b) readBChan2 (BChan q1) (BChan q2) = atomically $ (Left <$> readTBQueue q1) `orElse` (Right <$> readTBQueue q2) brick-0.18/src/Brick/Focus.hs0000644000000000000000000000675713117314670014200 0ustar0000000000000000-- | This module provides a type and functions for handling focus rings -- of widgets. Note that this interface is merely provided for managing -- the focus state for a sequence of resource names; it does not do -- anything beyond keep track of that. -- -- This interface is experimental. module Brick.Focus ( FocusRing , focusRing , focusNext , focusPrev , focusGetCurrent , focusRingCursor , withFocusRing , focusRingModify ) where import Lens.Micro ((^.)) import Data.Maybe (listToMaybe) import qualified Data.CircularList as C import Brick.Types import Brick.Widgets.Core (Named(..)) -- | A focus ring containing a sequence of resource names to focus and a -- currently-focused name. newtype FocusRing n = FocusRing (C.CList n) -- | Construct a focus ring from the list of resource names. focusRing :: [n] -> FocusRing n focusRing = FocusRing . C.fromList -- | Advance focus to the next widget in the ring. focusNext :: FocusRing n -> FocusRing n focusNext r@(FocusRing l) | C.isEmpty l = r | otherwise = FocusRing $ C.rotR l -- | Advance focus to the previous widget in the ring. focusPrev :: FocusRing n -> FocusRing n focusPrev r@(FocusRing l) | C.isEmpty l = r | otherwise = FocusRing $ C.rotL l -- | This function is a convenience function to look up a widget state -- value's resource name in a focus ring and set its focus setting -- according to the focus ring's state. This function determines whether -- a given widget state value is the focus of the ring and passes the -- resulting boolean to a rendering function, along with the state value -- (a), to produce whatever comes next (b). -- -- Focus-aware widgets have rendering functions that should be -- usable with this combinator; see 'Brick.Widgets.List.List' and -- 'Brick.Widgets.Edit.Edit'. withFocusRing :: (Eq n, Named a n) => FocusRing n -- ^ The focus ring to use as the source of focus state. -> (Bool -> a -> b) -- ^ A function that takes a value and its focus state. -> a -- ^ The wiget state value that we need to check for focus. -> b -- ^ The rest of the computation. withFocusRing ring f a = f (focusGetCurrent ring == Just (getName a)) a -- | Get the currently-focused resource name from the ring. If the ring -- is emtpy, return 'Nothing'. focusGetCurrent :: FocusRing n -> Maybe n focusGetCurrent (FocusRing l) = C.focus l -- | Modify the internal circular list structure of a focus ring -- directly. This function permits modification of the circular list -- using the rich Data.CircularList API. focusRingModify :: (C.CList n -> C.CList n) -> FocusRing n -> FocusRing n focusRingModify f (FocusRing l) = FocusRing $ f l -- | Cursor selection convenience function for use as an -- 'Brick.Main.appChooseCursor' value. focusRingCursor :: (Eq n) => (a -> FocusRing n) -- ^ The function used to get the focus ring out of your -- application state. -> a -- ^ Your application state. -> [CursorLocation n] -- ^ The list of available cursor positions. -> Maybe (CursorLocation n) -- ^ The cursor position, if any, that matches the -- resource name currently focused by the 'FocusRing'. focusRingCursor getRing st ls = listToMaybe $ filter isCurrent ls where isCurrent cl = cl^.cursorLocationNameL == (focusGetCurrent $ getRing st) brick-0.18/src/Brick/Main.hs0000644000000000000000000004514013117314670013772 0ustar0000000000000000module Brick.Main ( App(..) , defaultMain , customMain , simpleMain , resizeOrQuit -- * Event handler functions , continue , halt , suspendAndResume , lookupViewport , lookupExtent , findClickedExtents , clickedExtent , getVtyHandle -- ** Viewport scrolling , viewportScroll , ViewportScroll , vScrollBy , vScrollPage , vScrollToBeginning , vScrollToEnd , hScrollBy , hScrollPage , hScrollToBeginning , hScrollToEnd , setTop , setLeft -- * Cursor management functions , neverShowCursor , showFirstCursor , showCursorNamed -- * Rendering cache management , invalidateCacheEntry , invalidateCache ) where import Control.Exception (finally) import Lens.Micro ((^.), (&), (.~)) import Control.Monad (forever) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State import Control.Monad.Trans.Reader import Control.Concurrent (forkIO, killThread) #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) import Data.Monoid (mempty) #endif import Data.Maybe (listToMaybe) import qualified Data.Map as M import qualified Data.Set as S import Graphics.Vty ( Vty , Picture(..) , Cursor(..) , Event(..) , update , outputIface , displayBounds , shutdown , nextEvent , mkVty , defaultConfig ) import Graphics.Vty.Attributes (defAttr) import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan) import Brick.Types (Widget, EventM(..)) import Brick.Types.Internal import Brick.Widgets.Internal import Brick.AttrMap -- | The library application abstraction. Your application's operations -- are represented here and passed to one of the various main functions -- in this module. An application is in terms of an application state -- type 's', an application event type 'e', and a resource name type -- 'n'. In the simplest case 'e' is unused (left polymorphic or set to -- '()'), but you may define your own event type and use 'customMain' -- to provide custom events. The state type is the type of application -- state to be provided by you and iteratively modified by event -- handlers. The resource name type is the type of names you can assign -- to rendering resources such as viewports and cursor locations. data App s e n = App { appDraw :: s -> [Widget n] -- ^ This function turns your application state into a list of -- widget layers. The layers are listed topmost first. , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n) -- ^ This function chooses which of the zero or more cursor -- locations reported by the rendering process should be -- selected as the one to use to place the cursor. If this -- returns 'Nothing', no cursor is placed. The rationale here -- is that many widgets may request a cursor placement but your -- application state is what you probably want to use to decide -- which one wins. , appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s) -- ^ This function takes the current application state and an -- event and returns an action to be taken and a corresponding -- transformed application state. Possible options are -- 'continue', 'suspendAndResume', and 'halt'. , appStartEvent :: s -> EventM n s -- ^ This function gets called once just prior to the first -- drawing of your application. Here is where you can make -- initial scrolling requests, for example. , appAttrMap :: s -> AttrMap -- ^ The attribute map that should be used during rendering. } -- | The default main entry point which takes an application and an -- initial state and returns the final state returned by a 'halt' -- operation. defaultMain :: (Ord n) => App s e n -- ^ The application. -> s -- ^ The initial application state. -> IO s defaultMain app st = do customMain (mkVty defaultConfig) Nothing app st -- | A simple main entry point which takes a widget and renders it. This -- event loop terminates when the user presses any key, but terminal -- resize events cause redraws. simpleMain :: (Ord n) => Widget n -- ^ The widget to draw. -> IO () simpleMain w = let app = App { appDraw = const [w] , appHandleEvent = resizeOrQuit , appStartEvent = return , appAttrMap = const $ attrMap defAttr [] , appChooseCursor = neverShowCursor } in defaultMain app () -- | An event-handling function which continues execution of the event -- loop only when resize events occur; all other types of events trigger -- a halt. This is a convenience function useful as an 'appHandleEvent' -- value for simple applications using the 'Event' type that do not need -- to get more sophisticated user input. resizeOrQuit :: s -> BrickEvent n e -> EventM n (Next s) resizeOrQuit s (VtyEvent (EvResize _ _)) = continue s resizeOrQuit s _ = halt s data InternalNext n a = InternalSuspendAndResume (RenderState n) (IO a) | InternalHalt a readBrickEvent :: BChan (BrickEvent n e) -> BChan e -> IO (BrickEvent n e) readBrickEvent brickChan userChan = either id AppEvent <$> readBChan2 brickChan userChan runWithNewVty :: (Ord n) => IO Vty -> BChan (BrickEvent n e) -> Maybe (BChan e) -> App s e n -> RenderState n -> s -> IO (InternalNext n s) runWithNewVty buildVty brickChan mUserChan app initialRS initialSt = withVty buildVty $ \vty -> do pid <- forkIO $ supplyVtyEvents vty brickChan let readEvent = case mUserChan of Nothing -> readBChan brickChan Just uc -> readBrickEvent brickChan uc runInner rs st = do (result, newRS) <- runVty vty readEvent app st (rs & observedNamesL .~ S.empty & clickableNamesL .~ mempty) case result of SuspendAndResume act -> do killThread pid return $ InternalSuspendAndResume newRS act Halt s -> do killThread pid return $ InternalHalt s Continue s -> runInner newRS s runInner initialRS initialSt -- | The custom event loop entry point to use when the simpler ones -- don't permit enough control. customMain :: (Ord n) => IO Vty -- ^ An IO action to build a Vty handle. This is used to -- build a Vty handle whenever the event loop begins or is -- resumed after suspension. -> 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 customMain buildVty mUserChan app initialAppState = do let run rs st brickChan = do result <- runWithNewVty buildVty brickChan mUserChan app rs st case result of InternalHalt s -> return s InternalSuspendAndResume newRS action -> do newAppState <- action run newRS newAppState brickChan emptyES = ES [] [] eventRO = EventRO M.empty Nothing mempty (st, eState) <- runStateT (runReaderT (runEventM (appStartEvent app initialAppState)) eventRO) emptyES let initialRS = RS M.empty (esScrollRequests eState) S.empty mempty [] brickChan <- newBChan 20 run initialRS st brickChan supplyVtyEvents :: Vty -> BChan (BrickEvent n e) -> IO () supplyVtyEvents vty chan = forever $ do e <- nextEvent vty writeBChan chan $ VtyEvent e runVty :: (Ord n) => Vty -> IO (BrickEvent n e) -> App s e n -> s -> RenderState n -> IO (Next s, RenderState n) runVty vty readEvent app appState rs = do (firstRS, exts) <- renderApp vty app appState rs e <- readEvent (e', nextRS, nextExts) <- case e of -- If the event was a resize, redraw the UI to update the -- viewport states before we invoke the event handler since we -- want the event handler to have access to accurate viewport -- information. VtyEvent (EvResize _ _) -> do (rs', exts') <- renderApp vty app appState $ firstRS & observedNamesL .~ S.empty return (e, rs', exts') VtyEvent (EvMouseDown c r button mods) -> do let matching = findClickedExtents_ (c, r) exts case matching of (Extent n (Location (ec, er)) _ (Location (oC, oR)):_) -> -- If the clicked extent was registered as -- clickable, send a click event. Otherwise, just -- send the raw mouse event case n `elem` firstRS^.clickableNamesL of True -> do let localCoords = Location (lc, lr) lc = c - ec + oC lr = r - er + oR return (MouseDown n button mods localCoords, firstRS, exts) False -> return (e, firstRS, exts) _ -> return (e, firstRS, exts) VtyEvent (EvMouseUp c r button) -> do let matching = findClickedExtents_ (c, r) exts case matching of (Extent n (Location (ec, er)) _ (Location (oC, oR)):_) -> -- If the clicked extent was registered as -- clickable, send a click event. Otherwise, just -- send the raw mouse event case n `elem` firstRS^.clickableNamesL of True -> do let localCoords = Location (lc, lr) lc = c - ec + oC lr = r - er + oR return (MouseUp n button localCoords, firstRS, exts) False -> return (e, firstRS, exts) _ -> return (e, firstRS, exts) _ -> return (e, firstRS, exts) let emptyES = ES [] [] eventRO = EventRO (viewportMap nextRS) (Just vty) nextExts (next, eState) <- runStateT (runReaderT (runEventM (appHandleEvent app appState e')) eventRO) emptyES return (next, nextRS { rsScrollRequests = esScrollRequests eState , renderCache = applyInvalidations (cacheInvalidateRequests eState) $ renderCache nextRS }) applyInvalidations :: (Ord n) => [CacheInvalidateRequest n] -> M.Map n v -> M.Map n v applyInvalidations ns cache = foldr (.) id (mkFunc <$> ns) cache where mkFunc InvalidateEntire = const mempty mkFunc (InvalidateSingle n) = M.delete n -- | Given a viewport name, get the viewport's size and offset -- information from the most recent rendering. Returns 'Nothing' if -- no such state could be found, either because the name was invalid -- or because no rendering has occurred (e.g. in an 'appStartEvent' -- handler). lookupViewport :: (Ord n) => n -> EventM n (Maybe Viewport) lookupViewport n = EventM $ asks (M.lookup n . eventViewportMap) -- | Did the specified mouse coordinates (column, row) intersect the -- specified extent? clickedExtent :: (Int, Int) -> Extent n -> Bool clickedExtent (c, r) (Extent _ (Location (lc, lr)) (w, h) _) = c >= lc && c < (lc + w) && r >= lr && r < (lr + h) -- | Given a resource name, get the most recent rendering extent for the -- name (if any). lookupExtent :: (Eq n) => n -> EventM n (Maybe (Extent n)) lookupExtent n = EventM $ asks (listToMaybe . filter f . latestExtents) where f (Extent n' _ _ _) = n == n' -- | Given a mouse click location, return the extents intersected by the -- click. The returned extents are sorted such that the first extent in -- the list is the most specific extent and the last extent is the most -- generic (top-level). So if two extents A and B both intersected the -- mouse click but A contains B, then they would be returned [B, A]. findClickedExtents :: (Int, Int) -> EventM n [Extent n] findClickedExtents pos = EventM $ asks (findClickedExtents_ pos . latestExtents) findClickedExtents_ :: (Int, Int) -> [Extent n] -> [Extent n] findClickedExtents_ pos = reverse . filter (clickedExtent pos) -- | Get the Vty handle currently in use. getVtyHandle :: EventM n (Maybe Vty) getVtyHandle = EventM $ asks eventVtyHandle -- | Invalidate the rendering cache entry with the specified resource -- name. invalidateCacheEntry :: n -> EventM n () invalidateCacheEntry n = EventM $ do lift $ modify (\s -> s { cacheInvalidateRequests = InvalidateSingle n : cacheInvalidateRequests s }) -- | Invalidate the entire rendering cache. invalidateCache :: EventM n () invalidateCache = EventM $ do lift $ modify (\s -> s { cacheInvalidateRequests = InvalidateEntire : cacheInvalidateRequests s }) withVty :: IO Vty -> (Vty -> IO a) -> IO a withVty buildVty useVty = do vty <- buildVty useVty vty `finally` shutdown vty renderApp :: Vty -> App s e n -> s -> RenderState n -> IO (RenderState n, [Extent n]) renderApp vty app appState rs = do sz <- displayBounds $ outputIface vty let (newRS, pic, theCursor, exts) = renderFinal (appAttrMap app appState) (appDraw app appState) sz (appChooseCursor app appState) rs picWithCursor = case theCursor of Nothing -> pic { picCursor = NoCursor } Just cloc -> pic { picCursor = AbsoluteCursor (cloc^.locationColumnL) (cloc^.locationRowL) } update vty picWithCursor return (newRS, exts) -- | Ignore all requested cursor positions returned by the rendering -- process. This is a convenience function useful as an -- 'appChooseCursor' value when a simple application has no need to -- position the cursor. neverShowCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n) neverShowCursor = const $ const Nothing -- | Always show the first cursor, if any, returned by the rendering -- process. This is a convenience function useful as an -- 'appChooseCursor' value when a simple program has zero or more -- widgets that advertise a cursor position. showFirstCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n) showFirstCursor = const listToMaybe -- | Show the cursor with the specified resource name, if such a cursor -- location has been reported. showCursorNamed :: (Eq n) => n -> [CursorLocation n] -> Maybe (CursorLocation n) showCursorNamed name locs = let matches l = l^.cursorLocationNameL == Just name in listToMaybe $ filter matches locs -- | A viewport scrolling handle for managing the scroll state of -- viewports. data ViewportScroll n = ViewportScroll { viewportName :: n -- ^ The name of the viewport to be controlled by -- this scrolling handle. , hScrollPage :: Direction -> EventM n () -- ^ Scroll the viewport horizontally by one page in -- the specified direction. , hScrollBy :: Int -> EventM n () -- ^ Scroll the viewport horizontally by the -- specified number of rows or columns depending on -- the orientation of the viewport. , hScrollToBeginning :: EventM n () -- ^ Scroll horizontally to the beginning of the -- viewport. , hScrollToEnd :: EventM n () -- ^ Scroll horizontally to the end of the viewport. , vScrollPage :: Direction -> EventM n () -- ^ Scroll the viewport vertically by one page in -- the specified direction. , vScrollBy :: Int -> EventM n () -- ^ Scroll the viewport vertically by the specified -- number of rows or columns depending on the -- orientation of the viewport. , vScrollToBeginning :: EventM n () -- ^ Scroll vertically to the beginning of the viewport. , vScrollToEnd :: EventM n () -- ^ Scroll vertically to the end of the viewport. , setTop :: Int -> EventM n () -- ^ Set the top row offset of the viewport. , setLeft :: Int -> EventM n () -- ^ Set the left column offset of the viewport. } addScrollRequest :: (n, ScrollRequest) -> EventM n () addScrollRequest req = EventM $ do lift $ modify (\s -> s { esScrollRequests = req : esScrollRequests s }) -- | Build a viewport scroller for the viewport with the specified name. viewportScroll :: n -> ViewportScroll n viewportScroll n = ViewportScroll { viewportName = n , hScrollPage = \dir -> addScrollRequest (n, HScrollPage dir) , hScrollBy = \i -> addScrollRequest (n, HScrollBy i) , hScrollToBeginning = addScrollRequest (n, HScrollToBeginning) , hScrollToEnd = addScrollRequest (n, HScrollToEnd) , vScrollPage = \dir -> addScrollRequest (n, VScrollPage dir) , vScrollBy = \i -> addScrollRequest (n, VScrollBy i) , vScrollToBeginning = addScrollRequest (n, VScrollToBeginning) , vScrollToEnd = addScrollRequest (n, VScrollToEnd) , setTop = \i -> addScrollRequest (n, SetTop i) , setLeft = \i -> addScrollRequest (n, SetLeft i) } -- | Continue running the event loop with the specified application -- state. continue :: s -> EventM n (Next s) continue = return . Continue -- | Halt the event loop and return the specified application state as -- the final state value. halt :: s -> EventM n (Next s) halt = return . Halt -- | Suspend the event loop, save the terminal state, and run the -- specified action. When it returns an application state value, restore -- the terminal state, redraw the application from the new state, and -- resume the event loop. suspendAndResume :: IO s -> EventM n (Next s) suspendAndResume = return . SuspendAndResume brick-0.18/src/Brick/Markup.hs0000644000000000000000000000337013117314670014344 0ustar0000000000000000-- | This module provides an API for turning "markup" values into -- widgets. This module uses the "Data.Text.Markup" interface in this -- package to assign attributes to substrings in a text string; to -- manipulate markup using (for example) syntax highlighters, see that -- module. module Brick.Markup ( Markup , markup , (@?) , GetAttr(..) ) where import Lens.Micro ((.~), (&), (^.)) import Control.Monad (forM) import qualified Data.Text as T import Data.Text.Markup import Graphics.Vty (Attr, vertCat, horizCat, string) import Brick.AttrMap import Brick.Types -- | A type class for types that provide access to an attribute in the -- rendering monad. You probably won't need to instance this. class GetAttr a where -- | Where to get the attribute for this attribute metadata. getAttr :: a -> RenderM n Attr instance GetAttr Attr where getAttr a = do c <- getContext return $ mergeWithDefault a (c^.ctxAttrMapL) instance GetAttr AttrName where getAttr = lookupAttrName -- | Build a piece of markup from text with an assigned attribute name. -- When the markup is rendered, the attribute name will be looked up in -- the rendering context's 'AttrMap' to determine the attribute to use -- for this piece of text. (@?) :: T.Text -> AttrName -> Markup AttrName (@?) = (@@) -- | Build a widget from markup. markup :: (Eq a, GetAttr a) => Markup a -> Widget n markup m = Widget Fixed Fixed $ do let markupLines = markupToList m mkLine pairs = do is <- forM pairs $ \(t, aSrc) -> do a <- getAttr aSrc return $ string a $ T.unpack t return $ horizCat is lineImgs <- mapM mkLine markupLines return $ emptyResult & imageL .~ vertCat lineImgs brick-0.18/src/Brick/Types.hs0000644000000000000000000001127413117314670014213 0ustar0000000000000000-- | Basic types used by this library. {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Brick.Types ( -- * The Widget type Widget(..) -- * Location types and lenses , Location(..) , locL , TerminalLocation(..) , CursorLocation(..) , cursorLocationL , cursorLocationNameL -- * Viewports , Viewport(..) , ViewportType(..) , vpSize , vpTop , vpLeft -- * Event-handling types , EventM(..) , Next , BrickEvent(..) , handleEventLensed -- * Rendering infrastructure , RenderM , getContext -- ** The rendering context , Context(ctxAttrName, availWidth, availHeight, ctxBorderStyle, ctxAttrMap) , attrL , availWidthL , availHeightL , ctxAttrMapL , ctxAttrNameL , ctxBorderStyleL -- ** Rendering results , Result(..) , emptyResult , lookupAttrName , Extent(..) -- ** Rendering result lenses , imageL , cursorsL , visibilityRequestsL , extentsL -- ** Visibility requests , VisibilityRequest(..) , vrPositionL , vrSizeL -- * Making lenses , suffixLenses -- * Miscellaneous , Size(..) , Padding(..) , Direction(..) ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative import Data.Monoid (Monoid(..)) #endif import Lens.Micro (_1, _2, to, (^.), (&), (.~), Lens') import Lens.Micro.Type (Getting) import Control.Monad.Trans.State.Lazy import Control.Monad.Trans.Reader import Graphics.Vty (Attr) import Control.Monad.IO.Class import Brick.Types.TH import Brick.Types.Internal import Brick.AttrMap (AttrName, attrMapLookup) -- | The type of padding. data Padding = Pad Int -- ^ Pad by the specified number of rows or columns. | Max -- ^ Pad up to the number of available rows or columns. -- | A convenience function for handling events intended for values -- that are targets of lenses in your application state. This function -- obtains the target value of the specified lens, invokes 'handleEvent' -- on it, and stores the resulting transformed value back in the state -- using the lens. handleEventLensed :: a -- ^ The state value. -> Lens' a b -- ^ The lens to use to extract and store the target -- of the event. -> (e -> b -> EventM n b) -- ^ The event handler. -> e -- ^ The event to handle. -> EventM n a handleEventLensed v target handleEvent ev = do newB <- handleEvent ev (v^.target) return $ v & target .~ newB -- | The monad in which event handlers run. Although it may be tempting -- to dig into the reader value yourself, just use -- 'Brick.Main.lookupViewport'. newtype EventM n a = EventM { runEventM :: ReaderT (EventRO n) (StateT (EventState n) IO) a } deriving (Functor, Applicative, Monad, MonadIO) -- | Widget growth policies. These policies communicate to layout -- algorithms how a widget uses space when being rendered. These -- policies influence rendering order and space allocation in the box -- layout algorithm. data Size = Fixed -- ^ Fixed widgets take up the same amount of space no matter -- how much they are given (non-greedy). | Greedy -- ^ Greedy widgets take up all the space they are given. deriving (Show, Eq, Ord) -- | The type of widgets. data Widget n = Widget { hSize :: Size -- ^ This widget's horizontal growth policy , vSize :: Size -- ^ This widget's vertical growth policy , render :: RenderM n (Result n) -- ^ This widget's rendering function } -- | The type of the rendering monad. This monad is used by the -- library's rendering routines to manage rendering state and -- communicate rendering parameters to widgets' rendering functions. type RenderM n a = ReaderT Context (State (RenderState n)) a -- | Get the current rendering context. getContext :: RenderM n Context getContext = ask suffixLenses ''Context -- | The rendering context's current drawing attribute. attrL :: forall r. Getting r Context Attr attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL)) instance TerminalLocation (CursorLocation n) where locationColumnL = cursorLocationL._1 locationColumn = locationColumn . cursorLocation locationRowL = cursorLocationL._2 locationRow = locationRow . cursorLocation -- | Given an attribute name, obtain the attribute for the attribute -- name by consulting the context's attribute map. lookupAttrName :: AttrName -> RenderM n Attr lookupAttrName n = do c <- getContext return $ attrMapLookup n (c^.ctxAttrMapL) brick-0.18/src/Brick/Util.hs0000644000000000000000000000267313117314670014027 0ustar0000000000000000-- | Utility functions. module Brick.Util ( clamp , on , fg , bg , clOffset ) where import Lens.Micro ((&), (%~)) import Data.Monoid ((<>)) import Graphics.Vty import Brick.Types.Internal (Location(..), CursorLocation(..), cursorLocationL) -- | Given a minimum value and a maximum value, clamp a value to that -- range (values less than the minimum map to the minimum and values -- greater than the maximum map to the maximum). -- -- >>> clamp 1 10 11 -- 10 -- >>> clamp 1 10 2 -- 2 -- >>> clamp 5 10 1 -- 5 clamp :: (Ord a) => a -- ^ The minimum value -> a -- ^ The maximum value -> a -- ^ The value to clamp -> a clamp mn mx val = max mn (min val mx) -- | Build an attribute from a foreground color and a background color. -- Intended to be used infix. on :: Color -- ^ The foreground color -> Color -- ^ The background color -> Attr on f b = defAttr `withForeColor` f `withBackColor` b -- | Create an attribute from the specified foreground color (the -- background color is the "default"). fg :: Color -> Attr fg = (defAttr `withForeColor`) -- | Create an attribute from the specified background color (the -- background color is the "default"). bg :: Color -> Attr bg = (defAttr `withBackColor`) -- | Add a 'Location' offset to the specified 'CursorLocation'. clOffset :: CursorLocation n -> Location -> CursorLocation n clOffset cl off = cl & cursorLocationL %~ (<> off) brick-0.18/src/Brick/Types/0000755000000000000000000000000013117314670013652 5ustar0000000000000000brick-0.18/src/Brick/Types/Internal.hs0000644000000000000000000001612213117314670015764 0ustar0000000000000000{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-} module Brick.Types.Internal ( ScrollRequest(..) , VisibilityRequest(..) , vrPositionL , vrSizeL , Location(..) , locL , origin , TerminalLocation(..) , Viewport(..) , ViewportType(..) , RenderState(..) , Direction(..) , CursorLocation(..) , cursorLocationL , cursorLocationNameL , Context(..) , EventState(..) , EventRO(..) , Next(..) , Result(..) , Extent(..) , CacheInvalidateRequest(..) , BrickEvent(..) , rsScrollRequestsL , viewportMapL , clickableNamesL , renderCacheL , observedNamesL , vpSize , vpLeft , vpTop , imageL , cursorsL , extentsL , visibilityRequestsL , emptyResult ) where #if !MIN_VERSION_base(4,8,0) import Data.Monoid #endif import Lens.Micro (_1, _2, Lens') import Lens.Micro.TH (makeLenses) import Lens.Micro.Internal (Field1, Field2) import qualified Data.Set as S import qualified Data.Map as M import Graphics.Vty (Vty, Event, Button, Modifier, DisplayRegion, Image, emptyImage) import Brick.Types.TH import Brick.AttrMap (AttrName, AttrMap) import Brick.Widgets.Border.Style (BorderStyle) data ScrollRequest = HScrollBy Int | HScrollPage Direction | HScrollToBeginning | HScrollToEnd | VScrollBy Int | VScrollPage Direction | VScrollToBeginning | VScrollToEnd | SetTop Int | SetLeft Int data VisibilityRequest = VR { vrPosition :: Location , vrSize :: DisplayRegion } deriving (Show, Eq) -- | Describes the state of a viewport as it appears as its most recent -- rendering. data Viewport = VP { _vpLeft :: Int -- ^ The column offset of left side of the viewport. , _vpTop :: Int -- ^ The row offset of the top of the viewport. , _vpSize :: DisplayRegion -- ^ The size of the viewport. } deriving Show -- | The type of viewports that indicates the direction(s) in which a -- viewport is scrollable. data ViewportType = Vertical -- ^ Viewports of this type are scrollable only vertically. | Horizontal -- ^ Viewports of this type are scrollable only horizontally. | Both -- ^ Viewports of this type are scrollable vertically and horizontally. deriving (Show, Eq) data CacheInvalidateRequest n = InvalidateSingle n | InvalidateEntire data EventState n = ES { esScrollRequests :: [(n, ScrollRequest)] , cacheInvalidateRequests :: [CacheInvalidateRequest n] } -- | An extent of a named area: its size, location, and origin. data Extent n = Extent { extentName :: n , extentUpperLeft :: Location , extentSize :: (Int, Int) , extentOffset :: Location } deriving (Show) data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport , eventVtyHandle :: Maybe Vty , latestExtents :: [Extent n] } -- | The type of actions to take upon completion of an event handler. data Next a = Continue a | SuspendAndResume (IO a) | Halt a deriving Functor -- | Scrolling direction. data Direction = Up -- ^ Up/left | Down -- ^ Down/right deriving (Show, Eq) -- | A terminal screen location. data Location = Location { loc :: (Int, Int) -- ^ (Column, Row) } deriving (Show, Eq) suffixLenses ''Location instance Field1 Location Location Int Int where _1 = locL._1 instance Field2 Location Location Int Int where _2 = locL._2 -- | The class of types that behave like terminal locations. class TerminalLocation a where -- | Get the column out of the value locationColumnL :: Lens' a Int locationColumn :: a -> Int -- | Get the row out of the value locationRowL :: Lens' a Int locationRow :: a -> Int instance TerminalLocation Location where locationColumnL = _1 locationColumn (Location t) = fst t locationRowL = _2 locationRow (Location t) = snd t -- | The origin (upper-left corner). origin :: Location origin = Location (0, 0) instance Monoid Location where mempty = origin mappend (Location (w1, h1)) (Location (w2, h2)) = Location (w1+w2, h1+h2) -- | A cursor location. These are returned by the rendering process. data CursorLocation n = CursorLocation { cursorLocation :: !Location -- ^ The location , cursorLocationName :: !(Maybe n) -- ^ The name of the widget associated with the location } deriving Show -- | The type of result returned by a widget's rendering function. The -- result provides the image, cursor positions, and visibility requests -- that resulted from the rendering process. data Result n = Result { image :: Image -- ^ The final rendered image for a widget , cursors :: [CursorLocation n] -- ^ The list of reported cursor positions for the -- application to choose from , visibilityRequests :: [VisibilityRequest] -- ^ The list of visibility requests made by widgets rendered -- while rendering this one (used by viewports) , extents :: [Extent n] } deriving Show suffixLenses ''Result emptyResult :: Result n emptyResult = Result emptyImage [] [] [] -- | The type of events. data BrickEvent n e = VtyEvent Event -- ^ The event was a Vty event. | AppEvent e -- ^ The event was an application event. | MouseDown n Button [Modifier] Location -- ^ A mouse-down event on the specified region was -- received. | MouseUp n (Maybe Button) Location -- ^ A mouse-up event on the specified region was -- received. deriving (Show, Eq) data RenderState n = RS { viewportMap :: M.Map n Viewport , rsScrollRequests :: [(n, ScrollRequest)] , observedNames :: !(S.Set n) , renderCache :: M.Map n (Result n) , clickableNames :: [n] } -- | The rendering context. This tells widgets how to render: how much -- space they have in which to render, which attribute they should use -- to render, which bordering style should be used, and the attribute map -- available for rendering. data Context = Context { ctxAttrName :: AttrName , availWidth :: Int , availHeight :: Int , ctxBorderStyle :: BorderStyle , ctxAttrMap :: AttrMap } deriving Show suffixLenses ''RenderState suffixLenses ''VisibilityRequest suffixLenses ''CursorLocation makeLenses ''Viewport brick-0.18/src/Brick/Types/TH.hs0000644000000000000000000000131113117314670014515 0ustar0000000000000000module Brick.Types.TH ( suffixLenses ) where import qualified Language.Haskell.TH.Syntax as TH import qualified Language.Haskell.TH.Lib as TH import Lens.Micro ((&), (.~)) import Lens.Micro.TH (DefName(..), makeLensesWith, lensRules, lensField) -- | A template haskell function to build lenses for a record type. This -- function differs from the 'Control.Lens.makeLenses' function in that -- it does not require the record fields to be prefixed with underscores -- and it adds an "L" suffix to lens names to make it clear that they -- are lenses. suffixLenses :: TH.Name -> TH.DecsQ suffixLenses = makeLensesWith $ lensRules & lensField .~ (\_ _ name -> [TopName $ TH.mkName $ TH.nameBase name ++ "L"]) brick-0.18/src/Brick/Widgets/0000755000000000000000000000000013117314670014154 5ustar0000000000000000brick-0.18/src/Brick/Widgets/Border.hs0000644000000000000000000001070613117314670015731 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | This module provides border widgets: vertical borders, horizontal -- borders, and a box border wrapper widget. All functions in this -- module use the rendering context's active 'BorderStyle'; to change -- the 'BorderStyle', use 'withBorderStyle'. module Brick.Widgets.Border ( -- * Border wrapper border , borderWithLabel -- * Horizontal border , hBorder , hBorderWithLabel -- * Vertical border , vBorder -- * Drawing single border elements , borderElem -- * Border attribute names , borderAttr , vBorderAttr , hBorderAttr , hBorderLabelAttr , tlCornerAttr , trCornerAttr , blCornerAttr , brCornerAttr ) where import Data.Monoid ((<>)) #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Lens.Micro ((^.), to) import Graphics.Vty (imageHeight, imageWidth) import Brick.AttrMap import Brick.Types import Brick.Widgets.Core import Brick.Widgets.Center (hCenterWith) import Brick.Widgets.Border.Style (BorderStyle(..)) -- | The top-level border attribute name. borderAttr :: AttrName borderAttr = "border" -- | The vertical border attribute name. vBorderAttr :: AttrName vBorderAttr = borderAttr <> "vertical" -- | The horizontal border attribute name. hBorderAttr :: AttrName hBorderAttr = borderAttr <> "horizontal" -- | The attribute used for horizontal border labels. hBorderLabelAttr :: AttrName hBorderLabelAttr = hBorderAttr <> "label" -- | The attribute used for border box top-left corners. tlCornerAttr :: AttrName tlCornerAttr = borderAttr <> "corner" <> "tl" -- | The attribute used for border box top-right corners. trCornerAttr :: AttrName trCornerAttr = borderAttr <> "corner" <> "tr" -- | The attribute used for border box bottom-left corners. blCornerAttr :: AttrName blCornerAttr = borderAttr <> "corner" <> "bl" -- | The attribute used for border box bottom-right corners. brCornerAttr :: AttrName brCornerAttr = borderAttr <> "corner" <> "br" -- | Draw the specified border element using the active border style -- using 'borderAttr'. borderElem :: (BorderStyle -> Char) -> Widget n borderElem f = Widget Fixed Fixed $ do bs <- ctxBorderStyle <$> getContext render $ withAttr borderAttr $ str [f bs] -- | Put a border around the specified widget. border :: Widget n -> Widget n border = border_ Nothing -- | Put a border around the specified widget with the specified label -- widget placed in the middle of the top horizontal border. borderWithLabel :: Widget n -- ^ The label widget -> Widget n -- ^ The widget to put a border around -> Widget n borderWithLabel label = border_ (Just label) border_ :: Maybe (Widget n) -> Widget n -> Widget n border_ label wrapped = Widget (hSize wrapped) (vSize wrapped) $ do bs <- ctxBorderStyle <$> getContext c <- getContext middleResult <- render $ hLimit (c^.availWidthL - 2) $ vLimit (c^.availHeightL - 2) $ wrapped let top = (withAttr tlCornerAttr $ str [bsCornerTL bs]) <+> hBorder_ label <+> (withAttr trCornerAttr $ str [bsCornerTR bs]) bottom = (withAttr blCornerAttr $ str [bsCornerBL bs]) <+> hBorder <+> (withAttr brCornerAttr $ str [bsCornerBR bs]) middle = vBorder <+> (Widget Fixed Fixed $ return middleResult) <+> vBorder total = top <=> middle <=> bottom render $ hLimit (middleResult^.imageL.to imageWidth + 2) $ vLimit (middleResult^.imageL.to imageHeight + 2) $ total -- | A horizontal border. Fills all horizontal space. hBorder :: Widget n hBorder = hBorder_ Nothing -- | A horizontal border with a label placed in the center of the -- border. Fills all horizontal space. hBorderWithLabel :: Widget n -- ^ The label widget -> Widget n hBorderWithLabel label = hBorder_ (Just label) hBorder_ :: Maybe (Widget n) -> Widget n hBorder_ label = Widget Greedy Fixed $ do bs <- ctxBorderStyle <$> getContext let msg = maybe (str [bsHorizontal bs]) (withAttr hBorderLabelAttr) label render $ vLimit 1 $ withAttr hBorderAttr $ hCenterWith (Just $ bsHorizontal bs) msg -- | A vertical border. Fills all vertical space. vBorder :: Widget n vBorder = Widget Fixed Greedy $ do bs <- ctxBorderStyle <$> getContext render $ hLimit 1 $ withAttr vBorderAttr $ fill (bsVertical bs) brick-0.18/src/Brick/Widgets/Center.hs0000644000000000000000000001623713117314670015741 0ustar0000000000000000-- | This module provides combinators for centering other widgets. module Brick.Widgets.Center ( -- * Centering horizontally hCenter , hCenterWith , hCenterLayer -- * Centering vertically , vCenter , vCenterWith , vCenterLayer -- * Centering both horizontally and vertically , center , centerWith , centerLayer -- * Centering about an arbitrary origin , centerAbout ) where import Lens.Micro ((^.), (&), (.~), to) import Data.Maybe (fromMaybe) import Graphics.Vty (imageWidth, imageHeight, horizCat, charFill, vertCat, translateX, translateY) import Brick.Types import Brick.Widgets.Core -- | Center the specified widget horizontally. Consumes all available -- horizontal space. hCenter :: Widget n -> Widget n hCenter = hCenterWith Nothing -- | Center the specified widget horizontally using a Vty image -- translation. Consumes all available horizontal space. Unlike hCenter, -- this does not fill the surrounding space so it is suitable for use -- as a layer. Layers underneath this widget will be visible in regions -- surrounding the centered widget. hCenterLayer :: Widget n -> Widget n hCenterLayer p = Widget Greedy (vSize p) $ do result <- render p c <- getContext let rWidth = result^.imageL.to imageWidth leftPaddingAmount = max 0 $ (c^.availWidthL - rWidth) `div` 2 paddedImage = translateX leftPaddingAmount $ result^.imageL off = Location (leftPaddingAmount, 0) if leftPaddingAmount == 0 then return result else return $ addResultOffset off $ result & imageL .~ paddedImage -- | Center the specified widget horizontally. Consumes all available -- horizontal space. Uses the specified character to fill in the space -- to either side of the centered widget (defaults to space). hCenterWith :: Maybe Char -> Widget n -> Widget n hCenterWith mChar p = let ch = fromMaybe ' ' mChar in Widget Greedy (vSize p) $ do result <- render p c <- getContext let rWidth = result^.imageL.to imageWidth rHeight = result^.imageL.to imageHeight remainder = max 0 $ c^.availWidthL - (leftPaddingAmount * 2) leftPaddingAmount = max 0 $ (c^.availWidthL - rWidth) `div` 2 rightPaddingAmount = max 0 $ leftPaddingAmount + remainder leftPadding = charFill (c^.attrL) ch leftPaddingAmount rHeight rightPadding = charFill (c^.attrL) ch rightPaddingAmount rHeight paddedImage = horizCat [ leftPadding , result^.imageL , rightPadding ] off = Location (leftPaddingAmount, 0) if leftPaddingAmount == 0 && rightPaddingAmount == 0 then return result else return $ addResultOffset off $ result & imageL .~ paddedImage -- | Center a widget vertically. Consumes all vertical space. vCenter :: Widget n -> Widget n vCenter = vCenterWith Nothing -- | Center the specified widget vertically using a Vty image -- translation. Consumes all available vertical space. Unlike vCenter, -- this does not fill the surrounding space so it is suitable for use -- as a layer. Layers underneath this widget will be visible in regions -- surrounding the centered widget. vCenterLayer :: Widget n -> Widget n vCenterLayer p = Widget (hSize p) Greedy $ do result <- render p c <- getContext let rHeight = result^.imageL.to imageHeight topPaddingAmount = max 0 $ (c^.availHeightL - rHeight) `div` 2 paddedImage = translateY topPaddingAmount $ result^.imageL off = Location (0, topPaddingAmount) if topPaddingAmount == 0 then return result else return $ addResultOffset off $ result & imageL .~ paddedImage -- | Center a widget vertically. Consumes all vertical space. Uses the -- specified character to fill in the space above and below the centered -- widget (defaults to space). vCenterWith :: Maybe Char -> Widget n -> Widget n vCenterWith mChar p = let ch = fromMaybe ' ' mChar in Widget (hSize p) Greedy $ do result <- render p c <- getContext let rWidth = result^.imageL.to imageWidth rHeight = result^.imageL.to imageHeight remainder = max 0 $ c^.availHeightL - (topPaddingAmount * 2) topPaddingAmount = max 0 $ (c^.availHeightL - rHeight) `div` 2 bottomPaddingAmount = max 0 $ topPaddingAmount + remainder topPadding = charFill (c^.attrL) ch rWidth topPaddingAmount bottomPadding = charFill (c^.attrL) ch rWidth bottomPaddingAmount paddedImage = vertCat [ topPadding , result^.imageL , bottomPadding ] off = Location (0, topPaddingAmount) if topPaddingAmount == 0 && bottomPaddingAmount == 0 then return result else return $ addResultOffset off $ result & imageL .~ paddedImage -- | Center a widget both vertically and horizontally. Consumes all -- available vertical and horizontal space. center :: Widget n -> Widget n center = centerWith Nothing -- | Center a widget both vertically and horizontally. Consumes all -- available vertical and horizontal space. Uses the specified character -- to fill in the space around the centered widget (defaults to space). centerWith :: Maybe Char -> Widget n -> Widget n centerWith c = vCenterWith c . hCenterWith c -- | Center a widget both vertically and horizontally using a Vty image -- translation. Consumes all available vertical and horizontal space. -- Unlike center, this does not fill in the surrounding space with a -- character so it is usable as a layer. Any widget underneath this one -- will be visible in the region surrounding the centered widget. centerLayer :: Widget n -> Widget n centerLayer = vCenterLayer . hCenterLayer -- | Center the widget horizontally and vertically about the specified -- origin. centerAbout :: Location -> Widget n -> Widget n centerAbout l p = Widget Greedy Greedy $ do -- Compute translation offset so that loc is in the middle of the -- rendering area c <- getContext let centerW = c^.availWidthL `div` 2 centerH = c^.availHeightL `div` 2 off = Location ( centerW - l^.locationColumnL , centerH - l^.locationRowL ) result <- render $ translateBy off p -- Pad the result so it consumes available space let rightPaddingAmt = max 0 $ c^.availWidthL - imageWidth (result^.imageL) bottomPaddingAmt = max 0 $ c^.availHeightL - imageHeight (result^.imageL) rightPadding = charFill (c^.attrL) ' ' rightPaddingAmt (imageHeight $ result^.imageL) bottomPadding = charFill (c^.attrL) ' ' (imageWidth $ result^.imageL) bottomPaddingAmt paddedImg = horizCat [vertCat [result^.imageL, bottomPadding], rightPadding] return $ result & imageL .~ paddedImg brick-0.18/src/Brick/Widgets/Core.hs0000644000000000000000000011250513117314670015404 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} -- | This module provides the core widget combinators and rendering -- routines. Everything this library does is in terms of these basic -- primitives. module Brick.Widgets.Core ( -- * Basic rendering primitives TextWidth(..) , emptyWidget , raw , txt , str , fill -- * Padding , padLeft , padRight , padTop , padBottom , padLeftRight , padTopBottom , padAll -- * Box layout , (<=>) , (<+>) , hBox , vBox -- * Limits , hLimit , vLimit -- * Attribute management , withDefAttr , withAttr , forceAttr , overrideAttr , updateAttrMap -- * Border style management , withBorderStyle -- * Cursor placement , showCursor -- * Naming , Named(..) -- * Translation , translateBy -- * Cropping , cropLeftBy , cropRightBy , cropTopBy , cropBottomBy -- * Extent reporting , reportExtent , clickable -- * Scrollable viewports , viewport , visible , visibleRegion , unsafeLookupViewport , cached -- ** Adding offsets to cursor positions and visibility requests , addResultOffset -- ** Cropping results , cropToContext ) where #if MIN_VERSION_base(4,8,0) import Data.Monoid ((<>)) #else import Control.Applicative import Data.Monoid ((<>), mempty) #endif import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, ix, Lens') import Lens.Micro.Mtl (use, (%=)) import Control.Monad ((>=>),when) import Control.Monad.Trans.State.Lazy import Control.Monad.Trans.Reader import Control.Monad.Trans.Class (lift) import qualified Data.Foldable as F import qualified Data.Text as T import qualified Data.DList as DL import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Function as DF import Data.List (sortBy, partition) import qualified Graphics.Vty as V import Control.DeepSeq import Brick.Types import Brick.Types.Internal import Brick.Widgets.Border.Style import Brick.Util (clOffset, clamp) import Brick.AttrMap import Brick.Widgets.Internal -- | The class of text types that have widths measured in terminal -- columns. NEVER use 'length' etc. to measure the length of a string if -- you need to compute how much screen space it will occupy; always use -- 'textWidth'. class TextWidth a where textWidth :: a -> Int instance TextWidth T.Text where textWidth = V.wcswidth . T.unpack instance (F.Foldable f) => TextWidth (f Char) where textWidth = V.wcswidth . F.toList -- | The class of types that store interface element names. class Named a n where -- | Get the name of the specified value. getName :: a -> n -- | When rendering the specified widget, use the specified border style -- for any border rendering. withBorderStyle :: BorderStyle -> Widget n -> Widget n withBorderStyle bs p = Widget (hSize p) (vSize p) $ withReaderT (& ctxBorderStyleL .~ bs) (render p) -- | The empty widget. emptyWidget :: Widget n emptyWidget = raw V.emptyImage -- | Add an offset to all cursor locations, visbility requests, and -- extents in the specified rendering result. This function is critical -- for maintaining correctness in the rendering results as they are -- processed successively by box layouts and other wrapping combinators, -- since calls to this function result in converting from widget-local -- coordinates to (ultimately) terminal-global ones so they can be -- used by other combinators. You should call this any time you render -- something and then translate it or otherwise offset it from its -- original origin. addResultOffset :: Location -> Result n -> Result n addResultOffset off = addCursorOffset off . addVisibilityOffset off . addExtentOffset off addVisibilityOffset :: Location -> Result n -> Result n addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>) addExtentOffset :: Location -> Result n -> Result n addExtentOffset off r = r & extentsL.each %~ (\(Extent n l sz o) -> Extent n (off <> l) sz o) -- | Render the specified widget and record its rendering extent using -- the specified name (see also 'lookupExtent'). reportExtent :: n -> Widget n -> Widget n reportExtent n p = Widget (hSize p) (vSize p) $ do result <- render p let ext = Extent n (Location (0, 0)) sz (Location (0, 0)) sz = ( result^.imageL.to V.imageWidth , result^.imageL.to V.imageHeight ) return $ result & extentsL %~ (ext:) -- | Request mouse click events on the specified widget. clickable :: n -> Widget n -> Widget n clickable n p = Widget (hSize p) (vSize p) $ do clickableNamesL %= (n:) render $ reportExtent n p addCursorOffset :: Location -> Result n -> Result n addCursorOffset off r = let onlyVisible = filter isVisible isVisible l = l^.locationColumnL >= 0 && l^.locationRowL >= 0 in r & cursorsL %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs) unrestricted :: Int unrestricted = 100000 -- | Take a substring capable of fitting into the number of specified -- columns. This function takes character column widths into -- consideration. takeColumns :: Int -> String -> String takeColumns _ "" = "" takeColumns numCols (c:cs) = let w = V.safeWcwidth c in if w == numCols then [c] else if w < numCols then c : takeColumns (numCols - w) cs else "" -- | Build a widget from a 'String'. Breaks newlines up and space-pads -- short lines out to the length of the longest line. str :: String -> Widget n str s = Widget Fixed Fixed $ do c <- getContext let theLines = fixEmpty <$> (dropUnused . lines) s fixEmpty [] = " " fixEmpty l = l dropUnused l = takeColumns (availWidth c) <$> take (availHeight c) l case force theLines of [] -> return emptyResult [one] -> return $ emptyResult & imageL .~ (V.string (c^.attrL) one) multiple -> let maxLength = maximum $ V.safeWcswidth <$> multiple lineImgs = lineImg <$> multiple lineImg lStr = V.string (c^.attrL) (lStr ++ replicate (maxLength - V.safeWcswidth lStr) ' ') in return $ emptyResult & imageL .~ (V.vertCat lineImgs) -- | Build a widget from a one-line 'T.Text' value. Behaves the same as -- 'str'. txt :: T.Text -> Widget n txt = str . T.unpack -- | Pad the specified widget on the left. If max padding is used, this -- grows greedily horizontally; otherwise it defers to the padded -- widget. padLeft :: Padding -> Widget n -> Widget n padLeft padding p = let (f, sz) = case padding of Max -> (id, Greedy) Pad i -> (hLimit i, hSize p) in Widget sz (vSize p) $ do c <- getContext let lim = case padding of Max -> c^.availWidthL Pad i -> c^.availWidthL - i result <- render $ hLimit lim p render $ (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ') <+> (Widget Fixed Fixed $ return result) -- | Pad the specified widget on the right. If max padding is used, -- this grows greedily horizontally; otherwise it defers to the padded -- widget. padRight :: Padding -> Widget n -> Widget n padRight padding p = let (f, sz) = case padding of Max -> (id, Greedy) Pad i -> (hLimit i, hSize p) in Widget sz (vSize p) $ do c <- getContext let lim = case padding of Max -> c^.availWidthL Pad i -> c^.availWidthL - i result <- render $ hLimit lim p render $ (Widget Fixed Fixed $ return result) <+> (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ') -- | Pad the specified widget on the top. If max padding is used, this -- grows greedily vertically; otherwise it defers to the padded widget. padTop :: Padding -> Widget n -> Widget n padTop padding p = let (f, sz) = case padding of Max -> (id, Greedy) Pad i -> (vLimit i, vSize p) in Widget (hSize p) sz $ do c <- getContext let lim = case padding of Max -> c^.availHeightL Pad i -> c^.availHeightL - i result <- render $ vLimit lim p render $ (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ') <=> (Widget Fixed Fixed $ return result) -- | Pad the specified widget on the bottom. If max padding is used, -- this grows greedily vertically; otherwise it defers to the padded -- widget. padBottom :: Padding -> Widget n -> Widget n padBottom padding p = let (f, sz) = case padding of Max -> (id, Greedy) Pad i -> (vLimit i, vSize p) in Widget (hSize p) sz $ do c <- getContext let lim = case padding of Max -> c^.availHeightL Pad i -> c^.availHeightL - i result <- render $ vLimit lim p render $ (Widget Fixed Fixed $ return result) <=> (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ') -- | Pad a widget on the left and right. Defers to the padded widget for -- growth policy. padLeftRight :: Int -> Widget n -> Widget n padLeftRight c w = padLeft (Pad c) $ padRight (Pad c) w -- | Pad a widget on the top and bottom. Defers to the padded widget for -- growth policy. padTopBottom :: Int -> Widget n -> Widget n padTopBottom r w = padTop (Pad r) $ padBottom (Pad r) w -- | Pad a widget on all sides. Defers to the padded widget for growth -- policy. padAll :: Int -> Widget n -> Widget n padAll v w = padLeftRight v $ padTopBottom v w -- | Fill all available space with the specified character. Grows both -- horizontally and vertically. fill :: Char -> Widget n fill ch = Widget Greedy Greedy $ do c <- getContext return $ emptyResult & imageL .~ (V.charFill (c^.attrL) ch (c^.availWidthL) (c^.availHeightL)) -- | Vertical box layout: put the specified widgets one above the other -- 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). vBox :: [Widget n] -> Widget n vBox [] = emptyWidget vBox pairs = renderBox vBoxRenderer pairs -- | Horizontal box layout: put the specified widgets next to each other -- 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). hBox :: [Widget n] -> Widget n hBox [] = emptyWidget hBox pairs = renderBox hBoxRenderer pairs -- | The process of rendering widgets in a box layout is exactly the -- same except for the dimension under consideration (width vs. height), -- in which case all of the same operations that consider one dimension -- in the layout algorithm need to be switched to consider the other. -- Because of this we fill a BoxRenderer with all of the functions -- needed to consider the "primary" dimension (e.g. vertical if the -- box layout is vertical) as well as the "secondary" dimension (e.g. -- horizontal if the box layout is vertical). Doing this permits us to -- have one implementation for box layout and parameterizing on the -- orientation of all of the operations. data BoxRenderer n = BoxRenderer { contextPrimary :: Lens' Context Int , contextSecondary :: Lens' Context Int , imagePrimary :: V.Image -> Int , imageSecondary :: V.Image -> Int , limitPrimary :: Int -> Widget n -> Widget n , limitSecondary :: Int -> Widget n -> Widget n , primaryWidgetSize :: Widget n -> Size , concatenatePrimary :: [V.Image] -> V.Image , locationFromOffset :: Int -> Location , padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image } vBoxRenderer :: BoxRenderer n vBoxRenderer = BoxRenderer { contextPrimary = availHeightL , contextSecondary = availWidthL , imagePrimary = V.imageHeight , imageSecondary = V.imageWidth , limitPrimary = vLimit , limitSecondary = hLimit , primaryWidgetSize = vSize , concatenatePrimary = V.vertCat , locationFromOffset = Location . (0 ,) , padImageSecondary = \amt img a -> let p = V.charFill a ' ' amt (V.imageHeight img) in V.horizCat [img, p] } hBoxRenderer :: BoxRenderer n hBoxRenderer = BoxRenderer { contextPrimary = availWidthL , contextSecondary = availHeightL , imagePrimary = V.imageWidth , imageSecondary = V.imageHeight , limitPrimary = hLimit , limitSecondary = vLimit , primaryWidgetSize = hSize , concatenatePrimary = V.horizCat , locationFromOffset = Location . (, 0) , padImageSecondary = \amt img a -> let p = V.charFill a ' ' (V.imageWidth img) amt in V.vertCat [img, p] } -- | Render a series of widgets in a box layout in the order given. -- -- The growth policy of a box layout is the most unrestricted of the -- growth policies of the widgets it contains, so to determine the hSize -- and vSize of the box we just take the maximum (using the Ord instance -- for Size) of all of the widgets to be rendered in the box. -- -- Then the box layout algorithm proceeds as follows. We'll use -- the vertical case to concretely describe the algorithm, but the -- horizontal case can be envisioned just by exchanging all -- "vertical"/"horizontal" and "rows"/"columns", etc., in the -- description. -- -- The growth policies of the child widgets determine the order in which -- they are rendered, i.e., the order in which space in the box is -- allocated to widgets as the algorithm proceeds. This is because order -- matters: if we render greedy widgets first, there will be no space -- left for non-greedy ones. -- -- So we render all widgets with size 'Fixed' in the vertical dimension -- first. Each is rendered with as much room as the overall box has, but -- we assume that they will not be greedy and use it all. If they do, -- maybe it's because the terminal is small and there just isn't enough -- room to render everything. -- -- Then the remaining height is distributed evenly amongst all remaining -- (greedy) widgets and they are rendered in sub-boxes that are as high -- as this even slice of rows and as wide as the box is permitted to be. -- We only do this step at all if rendering the non-greedy widgets left -- us any space, i.e., if there were any rows left. -- -- After rendering the non-greedy and then greedy widgets, their images -- are sorted so that they are stored in the order the original widgets -- were given. All cursor locations and visibility requests in each -- sub-widget are translated according to the position of the sub-widget -- in the box. -- -- All images are padded to be as wide as the widest sub-widget to -- prevent attribute over-runs. Without this step the attribute used by -- a sub-widget may continue on in an undesirable fashion until it hits -- something with a different attribute. To prevent this and to behave -- in the least surprising way, we pad the image on the right with -- whitespace using the context's current attribute. -- -- Finally, the padded images are concatenated together vertically and -- returned along with the translated cursor positions and visibility -- requests. renderBox :: BoxRenderer n -> [Widget n] -> Widget n renderBox br ws = Widget (maximum $ hSize <$> ws) (maximum $ vSize <$> ws) $ do c <- getContext let pairsIndexed = zip [(0::Int)..] ws (his, lows) = partition (\p -> (primaryWidgetSize br $ snd p) == Fixed) pairsIndexed let availPrimary = c^.(contextPrimary br) availSecondary = c^.(contextSecondary br) renderHis _ prev [] = return $ DL.toList prev renderHis remainingPrimary prev ((i, prim):rest) = do result <- render $ limitPrimary br remainingPrimary $ limitSecondary br availSecondary $ cropToContext prim renderHis (remainingPrimary - (result^.imageL.(to $ imagePrimary br))) (DL.snoc prev (i, result)) rest renderedHis <- renderHis availPrimary DL.empty his renderedLows <- case lows of [] -> return [] ls -> do let remainingPrimary = c^.(contextPrimary br) - (sum $ (^._2.imageL.(to $ imagePrimary br)) <$> renderedHis) primaryPerLow = remainingPrimary `div` length ls padFirst = remainingPrimary - (primaryPerLow * length ls) secondaryPerLow = c^.(contextSecondary br) primaries = replicate (length ls) primaryPerLow & ix 0 %~ (+ padFirst) let renderLow ((i, prim), pri) = (i,) <$> (render $ limitPrimary br pri $ limitSecondary br secondaryPerLow $ cropToContext prim) if remainingPrimary > 0 then mapM renderLow (zip ls primaries) else return [] let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows allResults = snd <$> rendered allImages = (^.imageL) <$> allResults allPrimaries = imagePrimary br <$> allImages allTranslatedResults = (flip map) (zip [0..] allResults) $ \(i, result) -> let off = locationFromOffset br offPrimary offPrimary = sum $ take i allPrimaries in addResultOffset off result -- Determine the secondary dimension value to pad to. In a -- vertical box we want all images to be the same width to -- avoid attribute over-runs or blank spaces with the wrong -- attribute. In a horizontal box we want all images to have -- the same height for the same reason. maxSecondary = maximum $ imageSecondary br <$> allImages padImage img = padImageSecondary br (maxSecondary - imageSecondary br img) img (c^.attrL) paddedImages = padImage <$> allImages cropResultToContext $ Result (concatenatePrimary br paddedImages) (concat $ cursors <$> allTranslatedResults) (concat $ visibilityRequests <$> allTranslatedResults) (concat $ extents <$> allTranslatedResults) -- | Limit the space available to the specified widget to the specified -- number of columns. This is important for constraining the horizontal -- 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 .~ w) $ 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 .~ h) $ render $ cropToContext p -- | When drawing the specified widget, set the current attribute used -- for drawing to the one with the specified name. Note that the widget -- may use further calls to 'withAttr' to override this; if you really -- want to prevent that, use 'forceAttr'. Attributes used this way still -- get merged hierarchically and still fall back to the attribute map's -- default attribute. If you want to change the default attribute, use -- 'withDefAttr'. withAttr :: AttrName -> Widget n -> Widget n withAttr an p = Widget (hSize p) (vSize p) $ withReaderT (& ctxAttrNameL .~ an) (render p) -- | Update the attribute map while rendering the specified widget: set -- its new default attribute to the one that we get by looking up the -- specified attribute name in the map. withDefAttr :: AttrName -> Widget n -> Widget n withDefAttr an p = Widget (hSize p) (vSize p) $ do c <- getContext withReaderT (& ctxAttrMapL %~ (setDefault (attrMapLookup an (c^.ctxAttrMapL)))) (render p) -- | When rendering the specified widget, update the attribute map with -- the specified transformation. updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n updateAttrMap f p = Widget (hSize p) (vSize p) $ withReaderT (& ctxAttrMapL %~ f) (render p) -- | When rendering the specified widget, force all attribute lookups -- in the attribute map to use the value currently assigned to the -- specified attribute name. forceAttr :: AttrName -> Widget n -> Widget n forceAttr an p = Widget (hSize p) (vSize p) $ do c <- getContext withReaderT (& ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p) -- | Override the lookup of 'targetName' to return the attribute value -- associated with 'fromName' when rendering the specified widget. -- See also 'mapAttrName'. overrideAttr :: AttrName -> AttrName -> Widget n -> Widget n overrideAttr targetName fromName = updateAttrMap (mapAttrName fromName targetName) -- | Build a widget directly from a raw Vty image. raw :: V.Image -> Widget n raw img = Widget Fixed Fixed $ return $ emptyResult & imageL .~ img -- | Translate the specified widget by the specified offset amount. -- Defers to the translated widget for growth policy. translateBy :: Location -> Widget n -> Widget n translateBy off p = Widget (hSize p) (vSize p) $ do result <- render p return $ addResultOffset off $ result & imageL %~ (V.translate (off^.locationColumnL) (off^.locationRowL)) -- | Crop the specified widget on the left by the specified number of -- columns. Defers to the cropped widget for growth policy. cropLeftBy :: Int -> Widget n -> Widget n cropLeftBy cols p = Widget (hSize p) (vSize p) $ do result <- render p let amt = V.imageWidth (result^.imageL) - cols cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img return $ addResultOffset (Location (-1 * cols, 0)) $ result & imageL %~ cropped -- | Crop the specified widget on the right by the specified number of -- columns. Defers to the cropped widget for growth policy. cropRightBy :: Int -> Widget n -> Widget n cropRightBy cols p = Widget (hSize p) (vSize p) $ do result <- render p let amt = V.imageWidth (result^.imageL) - cols cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img return $ result & imageL %~ cropped -- | Crop the specified widget on the top by the specified number of -- rows. Defers to the cropped widget for growth policy. cropTopBy :: Int -> Widget n -> Widget n cropTopBy rows p = Widget (hSize p) (vSize p) $ do result <- render p let amt = V.imageHeight (result^.imageL) - rows cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img return $ addResultOffset (Location (0, -1 * rows)) $ result & imageL %~ cropped -- | Crop the specified widget on the bottom by the specified number of -- rows. Defers to the cropped widget for growth policy. cropBottomBy :: Int -> Widget n -> Widget n cropBottomBy rows p = Widget (hSize p) (vSize p) $ do result <- render p let amt = V.imageHeight (result^.imageL) - rows cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img return $ result & imageL %~ cropped -- | When rendering the specified widget, also register a cursor -- positioning request using the specified name and location. showCursor :: n -> Location -> Widget n -> Widget n showCursor n cloc p = Widget (hSize p) (vSize p) $ do result <- render p return $ result & cursorsL %~ (CursorLocation cloc (Just n):) hRelease :: Widget n -> Maybe (Widget n) hRelease p = case hSize p of Fixed -> Just $ Widget Greedy (vSize p) $ withReaderT (& availWidthL .~ unrestricted) (render p) Greedy -> Nothing vRelease :: Widget n -> Maybe (Widget n) vRelease p = case vSize p of Fixed -> Just $ Widget (hSize p) Greedy $ withReaderT (& availHeightL .~ unrestricted) (render p) Greedy -> Nothing -- | Render the specified widget. If the widget has an entry in the -- rendering cache using the specified name as the cache key, use the -- rendered version from the cache instead. If not, render the widget -- and update the cache. -- -- See also 'invalidateCacheEntry'. cached :: (Ord n) => n -> Widget n -> Widget n cached n w = Widget (hSize w) (vSize w) $ do result <- cacheLookup n case result of Just prevResult -> return prevResult Nothing -> do wResult <- render w cacheUpdate n wResult return wResult cacheLookup :: (Ord n) => n -> RenderM n (Maybe (Result n)) cacheLookup n = do cache <- lift $ gets (^.renderCacheL) return $ M.lookup n cache cacheUpdate :: (Ord n) => n -> Result n -> RenderM n () cacheUpdate n r = lift $ modify (& renderCacheL %~ M.insert n r) -- | Render the specified widget in a named viewport with the -- specified type. This permits widgets to be scrolled without being -- scrolling-aware. To make the most use of viewports, the specified -- widget should use the 'visible' combinator to make a "visibility -- request". This viewport combinator will then translate the resulting -- rendering to make the requested region visible. In addition, the -- 'Brick.Main.EventM' monad provides primitives to scroll viewports -- created by this function if 'visible' is not what you want. -- -- If a viewport receives more than one visibility request, then the -- visibility requests are merged with the inner visibility request -- taking preference. If a viewport receives more than one scrolling -- request from 'Brick.Main.EventM', all are honored in the order in -- which they are received. viewport :: (Ord n, Show n) => n -- ^ The name of the viewport (must be unique and stable for -- reliable behavior) -> ViewportType -- ^ The type of viewport (indicates the permitted scrolling -- direction) -> Widget n -- ^ The widget to be rendered in the scrollable viewport -> Widget n viewport vpname typ p = Widget Greedy Greedy $ do -- First, update the viewport size. c <- getContext let newVp = VP 0 0 newSize newSize = (c^.availWidthL, c^.availHeightL) doInsert (Just vp) = Just $ vp & vpSize .~ newSize doInsert Nothing = Just newVp let observeName :: (Ord n, Show n) => n -> RenderM n () observeName n = do observed <- use observedNamesL case S.member n observed of False -> observedNamesL %= S.insert n True -> error $ "Error: while rendering the interface, the name " <> show n <> " was seen more than once. You should ensure that all of the widgets " <> "in each interface have unique name values. This means either " <> "using a different name type or adding constructors to your " <> "existing one and using those to name your widgets. For more " <> "information, see the \"Resource Names\" section of the Brick User Guide." observeName vpname lift $ modify (& viewportMapL %~ (M.alter doInsert vpname)) -- Then render the sub-rendering with the rendering layout -- constraint released (but raise an exception if we are asked to -- render an infinitely-sized widget in the viewport's scrolling -- dimension) let release = case typ of Vertical -> vRelease Horizontal -> hRelease Both -> vRelease >=> hRelease released = case release p of Just w -> w Nothing -> case typ of Vertical -> error $ "tried to embed an infinite-height " <> "widget in vertical viewport " <> (show vpname) Horizontal -> error $ "tried to embed an infinite-width " <> "widget in horizontal viewport " <> (show vpname) Both -> error $ "tried to embed an infinite-width or " <> "infinite-height widget in 'Both' type " <> "viewport " <> (show vpname) initialResult <- render released -- If the rendering state includes any scrolling requests for this -- viewport, apply those reqs <- lift $ gets $ (^.rsScrollRequestsL) let relevantRequests = snd <$> filter (\(n, _) -> n == vpname) reqs when (not $ null relevantRequests) $ do Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname)) let updatedVp = applyRequests relevantRequests vp applyRequests [] v = v applyRequests (rq:rqs) v = case typ of Horizontal -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v Vertical -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v Both -> scrollTo Horizontal rq (initialResult^.imageL) $ scrollTo Vertical rq (initialResult^.imageL) $ applyRequests rqs v lift $ modify (& viewportMapL %~ (M.insert vpname updatedVp)) return () -- If the sub-rendering requested visibility, update the scroll -- state accordingly when (not $ null $ initialResult^.visibilityRequestsL) $ do Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname)) let rqs = initialResult^.visibilityRequestsL updateVp vp' rq = case typ of Both -> scrollToView Horizontal rq $ scrollToView Vertical rq vp' Horizontal -> scrollToView typ rq vp' Vertical -> scrollToView typ rq vp' lift $ modify (& viewportMapL %~ (M.insert vpname $ foldl updateVp vp rqs)) -- If the size of the rendering changes enough to make the -- viewport offsets invalid, reset them Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname)) let img = initialResult^.imageL fixTop v = if V.imageHeight img < v^.vpSize._2 then v & vpTop .~ 0 else v fixLeft v = if V.imageWidth img < v^.vpSize._1 then v & vpLeft .~ 0 else v updateVp = case typ of Both -> fixLeft . fixTop Horizontal -> fixLeft Vertical -> fixTop lift $ modify (& viewportMapL %~ (M.insert vpname (updateVp vp))) -- Get the viewport state now that it has been updated. Just vpFinal <- lift $ gets (M.lookup vpname . (^.viewportMapL)) -- Then perform a translation of the sub-rendering to fit into the -- viewport translated <- render $ translateBy (Location (-1 * vpFinal^.vpLeft, -1 * vpFinal^.vpTop)) $ Widget Fixed Fixed $ return initialResult -- Return the translated result with the visibility requests -- discarded let translatedSize = ( translated^.imageL.to V.imageWidth , translated^.imageL.to V.imageHeight ) case translatedSize of (0, 0) -> do let spaceFill = V.charFill (c^.attrL) ' ' (c^.availWidthL) (c^.availHeightL) return $ translated & imageL .~ spaceFill & visibilityRequestsL .~ mempty & extentsL .~ mempty _ -> render $ cropToContext $ padBottom Max $ padRight Max $ Widget Fixed Fixed $ return $ translated & visibilityRequestsL .~ mempty -- | Given a name, obtain the viewport for that name by consulting the -- viewport map in the rendering monad. NOTE! Some care must be taken -- when calling this function, since it only returns useful values -- after the viewport in question has been rendered. If you call this -- function during rendering before a viewport has been rendered, you -- may get nothing or you may get a stale version of the viewport. This -- is because viewports are updated during rendering and the one you are -- interested in may not have been rendered yet. So if you want to use -- this, be sure you know what you are doing. unsafeLookupViewport :: (Ord n) => n -> RenderM n (Maybe Viewport) unsafeLookupViewport name = lift $ gets (M.lookup name . (^.viewportMapL)) scrollTo :: ViewportType -> ScrollRequest -> V.Image -> Viewport -> Viewport scrollTo Both _ _ _ = error "BUG: called scrollTo on viewport type 'Both'" scrollTo Vertical req img vp = vp & vpTop .~ newVStart where newVStart = clamp 0 (V.imageHeight img - vp^.vpSize._2) adjustedAmt adjustedAmt = case req of VScrollBy amt -> vp^.vpTop + amt VScrollPage Up -> vp^.vpTop - vp^.vpSize._2 VScrollPage Down -> vp^.vpTop + vp^.vpSize._2 VScrollToBeginning -> 0 VScrollToEnd -> V.imageHeight img - vp^.vpSize._2 SetTop i -> i _ -> vp^.vpTop scrollTo Horizontal req img vp = vp & vpLeft .~ newHStart where newHStart = clamp 0 (V.imageWidth img - vp^.vpSize._1) adjustedAmt adjustedAmt = case req of HScrollBy amt -> vp^.vpLeft + amt HScrollPage Up -> vp^.vpLeft - vp^.vpSize._1 HScrollPage Down -> vp^.vpLeft + vp^.vpSize._1 HScrollToBeginning -> 0 HScrollToEnd -> V.imageWidth img - vp^.vpSize._1 SetLeft i -> i _ -> vp^.vpLeft scrollToView :: ViewportType -> VisibilityRequest -> Viewport -> Viewport scrollToView Both _ _ = error "BUG: called scrollToView on 'Both' type viewport" scrollToView Vertical rq vp = vp & vpTop .~ newVStart where curStart = vp^.vpTop curEnd = curStart + vp^.vpSize._2 reqStart = rq^.vrPositionL.locationRowL reqEnd = rq^.vrPositionL.locationRowL + rq^.vrSizeL._2 newVStart :: Int newVStart = if reqStart < vStartEndVisible then reqStart else vStartEndVisible vStartEndVisible = if reqEnd < curEnd then curStart else curStart + (reqEnd - curEnd) scrollToView Horizontal rq vp = vp & vpLeft .~ newHStart where curStart = vp^.vpLeft curEnd = curStart + vp^.vpSize._1 reqStart = rq^.vrPositionL.locationColumnL reqEnd = rq^.vrPositionL.locationColumnL + rq^.vrSizeL._1 newHStart :: Int newHStart = if reqStart < hStartEndVisible then reqStart else hStartEndVisible hStartEndVisible = if reqEnd < curEnd then curStart else curStart + (reqEnd - curEnd) -- | Request that the specified widget be made visible when it is -- rendered inside a viewport. This permits widgets (whose sizes and -- positions cannot be known due to being embedded in arbitrary layouts) -- to make a request for a parent viewport to locate them and scroll -- enough to put them in view. This, together with 'viewport', is what -- makes the text editor and list widgets possible without making them -- deal with the details of scrolling state management. -- -- This does nothing if not rendered in a viewport. visible :: Widget n -> Widget n visible p = Widget (hSize p) (vSize p) $ do result <- render p let imageSize = ( result^.imageL.to V.imageWidth , result^.imageL.to V.imageHeight ) -- The size of the image to be made visible in a viewport must have -- non-zero size in both dimensions. return $ if imageSize^._1 > 0 && imageSize^._2 > 0 then result & visibilityRequestsL %~ (VR (Location (0, 0)) imageSize :) else result -- | Similar to 'visible', request that a region (with the specified -- 'Location' as its origin and 'V.DisplayRegion' as its size) be made -- visible when it is rendered inside a viewport. The 'Location' is -- relative to the specified widget's upper-left corner of (0, 0). -- -- This does nothing if not rendered in a viewport. visibleRegion :: Location -> V.DisplayRegion -> Widget n -> Widget n visibleRegion vrloc sz p = Widget (hSize p) (vSize p) $ do result <- render p -- The size of the image to be made visible in a viewport must have -- non-zero size in both dimensions. return $ if sz^._1 > 0 && sz^._2 > 0 then result & visibilityRequestsL %~ (VR vrloc sz :) else result -- | Horizontal box layout: put the specified widgets next to each other -- in the specified order. Defers growth policies to the growth policies -- of both widgets. This operator is a binary version of 'hBox'. (<+>) :: Widget n -- ^ Left -> Widget n -- ^ Right -> Widget n (<+>) a b = hBox [a, b] -- | Vertical box layout: put the specified widgets one above the other -- in the specified order. Defers growth policies to the growth policies -- of both widgets. This operator is a binary version of 'vBox'. (<=>) :: Widget n -- ^ Top -> Widget n -- ^ Bottom -> Widget n (<=>) a b = vBox [a, b] brick-0.18/src/Brick/Widgets/Dialog.hs0000644000000000000000000001102113117314670015702 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} -- | This module provides a simple dialog widget. You get to pick the -- dialog title, if any, as well as its body and buttons. module Brick.Widgets.Dialog ( Dialog , dialogTitle , dialogButtons , dialogSelectedIndex , dialogWidth -- * Construction and rendering , dialog , renderDialog -- * Handling events , handleDialogEvent -- * Getting a dialog's current value , dialogSelection -- * Attributes , dialogAttr , buttonAttr , buttonSelectedAttr -- * Lenses , dialogButtonsL , dialogSelectedIndexL , dialogWidthL , dialogTitleL ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Lens.Micro import Data.Monoid import Data.List (intersperse) import Graphics.Vty.Input (Event(..), Key(..)) import Brick.Util (clamp) import Brick.Types import Brick.Widgets.Core import Brick.Widgets.Center import Brick.Widgets.Border import Brick.AttrMap -- | Dialogs present a window with a title (optional), a body, and -- buttons (optional). Dialog buttons are labeled with strings and map -- to values of type 'a', which you choose. -- -- Dialogs handle the following events by default with -- handleDialogEvent: -- -- * Tab or Right Arrow: select the next button -- * Shift-tab or Left Arrow: select the previous button data Dialog a = Dialog { dialogTitle :: Maybe String -- ^ The dialog title , dialogButtons :: [(String, a)] -- ^ The dialog button labels and values , dialogSelectedIndex :: Maybe Int -- ^ The currently selected dialog button index (if any) , dialogWidth :: Int -- ^ The maximum width of the dialog } suffixLenses ''Dialog handleDialogEvent :: Event -> Dialog a -> EventM n (Dialog a) handleDialogEvent ev d = return $ case ev of EvKey (KChar '\t') [] -> nextButtonBy 1 d EvKey KBackTab [] -> nextButtonBy (-1) d EvKey KRight [] -> nextButtonBy 1 d EvKey KLeft [] -> nextButtonBy (-1) d _ -> d -- | Create a dialog. dialog :: Maybe String -- ^ The dialog title -> Maybe (Int, [(String, a)]) -- ^ The currently-selected button index (starting at zero) and -- the button labels and values to use -> Int -- ^ The maximum width of the dialog -> Dialog a dialog title buttonData w = let (buttons, idx) = case buttonData of Nothing -> ([], Nothing) Just (_, []) -> ([], Nothing) Just (i, bs) -> (bs, Just $ clamp 0 (length bs - 1) i) in Dialog title buttons idx w -- | The default attribute of the dialog dialogAttr :: AttrName dialogAttr = "dialog" -- | The default attribute for all dialog buttons buttonAttr :: AttrName buttonAttr = "button" -- | The attribute for the selected dialog button (extends 'dialogAttr') buttonSelectedAttr :: AttrName buttonSelectedAttr = buttonAttr <> "selected" -- | Render a dialog with the specified body widget. This renders the -- dialog as a layer, which makes this suitable as a top-level layer in -- your rendering function to be rendered on top of the rest of your -- interface. renderDialog :: Dialog a -> Widget n -> Widget n renderDialog d body = let buttonPadding = str " " mkButton (i, (s, _)) = let att = if Just i == d^.dialogSelectedIndexL then buttonSelectedAttr else buttonAttr in withAttr att $ str $ " " <> s <> " " buttons = hBox $ intersperse buttonPadding $ mkButton <$> (zip [0..] (d^.dialogButtonsL)) doBorder = maybe border borderWithLabel (str <$> d^.dialogTitleL) in centerLayer $ withDefAttr dialogAttr $ hLimit (d^.dialogWidthL) $ doBorder $ vBox [ body , hCenter buttons ] nextButtonBy :: Int -> Dialog a -> Dialog a nextButtonBy amt d = let numButtons = length $ d^.dialogButtonsL in if numButtons == 0 then d else case d^.dialogSelectedIndexL of Nothing -> d & dialogSelectedIndexL .~ (Just 0) Just i -> d & dialogSelectedIndexL .~ (Just $ (i + amt) `mod` numButtons) -- | Obtain the value associated with the dialog's currently-selected -- button, if any. This function is probably what you want when someone -- presses 'Enter' in a dialog. dialogSelection :: Dialog a -> Maybe a dialogSelection d = case d^.dialogSelectedIndexL of Nothing -> Nothing Just i -> Just $ ((d^.dialogButtonsL) !! i)^._2 brick-0.18/src/Brick/Widgets/Edit.hs0000644000000000000000000001534513117314670015405 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -- | This module provides a basic text editor widget. You'll need to -- embed an 'Editor' in your application state and transform it with -- 'handleEvent' when relevant events arrive. To get the contents -- of the editor, just use 'getEditContents'. To modify it, use the -- 'Z.TextZipper' interface with 'applyEdit'. -- -- The editor's 'handleEditorEvent' function handles a set of basic -- input events that should suffice for most purposes; see the source -- for a complete list. -- -- Bear in mind that the editor provided by this module is intended to -- provide basic input support for brick applications but it is not -- intended to be a replacement for your favorite editor such as Vim or -- Emacs. It is also not suitable for building sophisticated editors. If -- you want to build your own editor, I suggest starting from scratch. module Brick.Widgets.Edit ( Editor(editContents, editorName, editDrawContents) -- * Constructing an editor , editor , editorText -- * Reading editor contents , getEditContents -- * Handling events , handleEditorEvent -- * Editing text , applyEdit -- * Lenses for working with editors , editContentsL , editDrawContentsL -- * Rendering editors , renderEditor -- * Attributes , editAttr , editFocusedAttr ) where import Data.Monoid import Lens.Micro import Graphics.Vty (Event(..), Key(..), Modifier(..)) import qualified Data.Text as T import qualified Data.Text.Zipper as Z hiding ( textZipper ) import qualified Data.Text.Zipper.Generic as Z import Brick.Types import Brick.Widgets.Core import Brick.AttrMap -- | Editor state. Editors support the following events by default: -- -- * Ctrl-a: go to beginning of line -- * Ctrl-e: go to end of line -- * Ctrl-d, Del: delete character at cursor position -- * Backspace: delete character prior to cursor position -- * Ctrl-k: delete all from cursor to end of line -- * Ctrl-u: delete all from cursor to beginning of line -- * Arrow keys: move cursor -- * Enter: break the current line at the cursor position data Editor t n = Editor { editContents :: Z.TextZipper t -- ^ The contents of the editor , editDrawContents :: [t] -> Widget n -- ^ The function the editor uses to draw its contents , editorName :: n -- ^ The name of the editor } suffixLenses ''Editor instance (Show t, Show n) => Show (Editor t n) where show e = concat [ "Editor { " , "editContents = " <> show (editContents e) , ", editorName = " <> show (editorName e) , "}" ] instance Named (Editor t n) n where getName = editorName handleEditorEvent :: (Eq t, Monoid t) => Event -> Editor t n -> EventM n (Editor t n) handleEditorEvent e ed = let f = case e of EvKey (KChar 'a') [MCtrl] -> Z.gotoBOL EvKey (KChar 'e') [MCtrl] -> Z.gotoEOL EvKey (KChar 'd') [MCtrl] -> Z.deleteChar EvKey (KChar 'k') [MCtrl] -> Z.killToEOL EvKey (KChar 'u') [MCtrl] -> Z.killToBOL EvKey KEnter [] -> Z.breakLine EvKey KDel [] -> Z.deleteChar EvKey (KChar c) [] | c /= '\t' -> Z.insertChar c EvKey KUp [] -> Z.moveUp EvKey KDown [] -> Z.moveDown EvKey KLeft [] -> Z.moveLeft EvKey KRight [] -> Z.moveRight EvKey KBS [] -> Z.deletePrevChar _ -> id in return $ applyEdit f ed -- | Construct an editor over 'Text' values editorText :: n -- ^ The editor's name (must be unique) -> ([T.Text] -> Widget n) -- ^ The content rendering function -> Maybe Int -- ^ The limit on the number of lines in the editor ('Nothing' -- means no limit) -> T.Text -- ^ The initial content -> Editor T.Text n editorText = editor -- | Construct an editor over 'String' values editor :: Z.GenericTextZipper a => n -- ^ The editor's name (must be unique) -> ([a] -> Widget n) -- ^ The content rendering function -> Maybe Int -- ^ The limit on the number of lines in the editor ('Nothing' -- means no limit) -> a -- ^ The initial content -> Editor a n editor name draw limit s = Editor (Z.textZipper (Z.lines s) limit) draw name -- | Apply an editing operation to the editor's contents. Bear in mind -- that you should only apply zipper operations that operate on the -- current line; the editor will only ever render the first line of -- text. applyEdit :: (Z.TextZipper t -> Z.TextZipper t) -- ^ The 'Data.Text.Zipper' editing transformation to apply -> Editor t n -> Editor t n applyEdit f e = e & editContentsL %~ f -- | The attribute assigned to the editor when it does not have focus. editAttr :: AttrName editAttr = "edit" -- | The attribute assigned to the editor when it has focus. Extends -- 'editAttr'. editFocusedAttr :: AttrName editFocusedAttr = editAttr <> "focused" -- | Get the contents of the editor. getEditContents :: Monoid t => Editor t n -> [t] getEditContents e = Z.getText $ e^.editContentsL -- | Turn an editor state value into a widget. This uses the editor's -- name for its scrollable viewport handle and the name is also used to -- report mouse events. renderEditor :: (Ord n, Show n, Monoid t, TextWidth t, Z.GenericTextZipper t) => Bool -- ^ Whether the editor has focus. It will report a cursor -- position if and only if it has focus. -> Editor t n -- ^ The editor. -> Widget n renderEditor foc e = let cp = Z.cursorPosition z z = e^.editContentsL toLeft = Z.take (cp^._2) (Z.currentLine z) cursorLoc = Location (textWidth toLeft, cp^._1) limit = case e^.editContentsL.to Z.getLineLimit of Nothing -> id Just lim -> vLimit lim atChar = charAtCursor $ e^.editContentsL atCharWidth = maybe 1 textWidth atChar in withAttr (if foc then editFocusedAttr else editAttr) $ limit $ viewport (e^.editorNameL) Both $ clickable (e^.editorNameL) $ (if foc then showCursor (e^.editorNameL) cursorLoc else id) $ visibleRegion cursorLoc (atCharWidth, 1) $ e^.editDrawContentsL $ getEditContents e charAtCursor :: (Z.GenericTextZipper t) => Z.TextZipper t -> Maybe t charAtCursor z = let col = snd $ Z.cursorPosition z curLine = Z.currentLine z toRight = Z.drop col curLine in if Z.length toRight > 0 then Just $ Z.take 1 toRight else Nothing brick-0.18/src/Brick/Widgets/Internal.hs0000644000000000000000000001035113117314670016264 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} module Brick.Widgets.Internal ( renderFinal , cropToContext , cropResultToContext ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Lens.Micro ((^.), (&), (%~)) import Control.Monad.Trans.State.Lazy import Control.Monad.Trans.Reader import Data.Maybe (catMaybes) import qualified Graphics.Vty as V import Brick.Types import Brick.Types.Internal import Brick.AttrMap import Brick.Widgets.Border.Style renderFinal :: AttrMap -> [Widget n] -> V.DisplayRegion -> ([CursorLocation n] -> Maybe (CursorLocation n)) -> RenderState n -> (RenderState n, V.Picture, Maybe (CursorLocation n), [Extent n]) renderFinal aMap layerRenders sz chooseCursor rs = (newRS, picWithBg, theCursor, concat layerExtents) where (layerResults, !newRS) = flip runState rs $ sequence $ (\p -> runReaderT p ctx) <$> (render <$> cropToContext <$> layerRenders) ctx = Context mempty (fst sz) (snd sz) defaultBorderStyle aMap pic = V.picForLayers $ uncurry V.resize sz <$> (^.imageL) <$> layerResults -- picWithBg is a workaround for runaway attributes. -- See https://github.com/coreyoconnor/vty/issues/95 picWithBg = pic { V.picBackground = V.Background ' ' V.defAttr } layerCursors = (^.cursorsL) <$> layerResults layerExtents = reverse $ (^.extentsL) <$> layerResults theCursor = chooseCursor $ concat layerCursors -- | After rendering the specified widget, crop its result image to the -- dimensions in the rendering context. cropToContext :: Widget n -> Widget n cropToContext p = Widget (hSize p) (vSize p) (render p >>= cropResultToContext) cropResultToContext :: Result n -> RenderM n (Result n) cropResultToContext result = do c <- getContext return $ result & imageL %~ cropImage c & cursorsL %~ cropCursors c & extentsL %~ cropExtents c cropImage :: Context -> V.Image -> V.Image cropImage c = V.crop (max 0 $ c^.availWidthL) (max 0 $ c^.availHeightL) cropCursors :: Context -> [CursorLocation n] -> [CursorLocation n] cropCursors ctx cs = catMaybes $ cropCursor <$> cs where -- A cursor location is removed if it is not within the region -- described by the context. cropCursor c | outOfContext c = Nothing | otherwise = Just c outOfContext c = or [ c^.cursorLocationL.locationRowL < 0 , c^.cursorLocationL.locationColumnL < 0 , c^.cursorLocationL.locationRowL >= ctx^.availHeightL , c^.cursorLocationL.locationColumnL >= ctx^.availWidthL ] cropExtents :: Context -> [Extent n] -> [Extent n] cropExtents ctx es = catMaybes $ 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 and upper left corner are adjusted so that -- they are contained within the context region. cropExtent (Extent n (Location (c, r)) (w, h) (Location (oC, oR))) = -- First, clamp the upper-left corner to at least (0, 0). let c' = max c 0 r' = max r 0 -- Compute deltas for the offset since if the upper-left -- corner moved, so should the offset. dc = c' - c dr = r' - r -- Then, determine the new lower-right corner based on -- the clamped corner. 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') (Location (oC + dc, oR + dr)) in if w' < 0 || h' < 0 then Nothing else Just e brick-0.18/src/Brick/Widgets/List.hs0000644000000000000000000002437513117314670015436 0ustar0000000000000000{-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable#-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} -- | This module provides a scrollable list type and functions for -- manipulating and rendering it. module Brick.Widgets.List ( List(listElements, listSelected, listName, listItemHeight) -- * Constructing a list , list -- * Rendering a list , renderList -- * Handling events , handleListEvent -- * Lenses , listElementsL , listSelectedL , listNameL , listItemHeightL -- * Manipulating a list , listMoveBy , listMoveTo , listMoveUp , listMoveDown , listInsert , listRemove , listReplace , listSelectedElement , listClear , listReverse , listModify -- * Attributes , listAttr , listSelectedAttr , listSelectedFocusedAttr ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>),(<*>),pure) import Data.Foldable (Foldable) import Data.Traversable (Traversable) #endif import Lens.Micro ((^.), (&), (.~), (%~), _2) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Graphics.Vty (Event(..), Key(..)) import qualified Data.Vector as V import Brick.Types import Brick.Main (lookupViewport) import Brick.Widgets.Core import Brick.Util (clamp) import Brick.AttrMap -- | List state. Lists have an element type 'e' that is the data stored -- by the list. Lists handle the following events by default: -- -- * Up/down arrow keys: move cursor of selected item -- * Page up / page down keys: move cursor of selected item by one page -- at a time (based on the number of items shown) -- * Home/end keys: move cursor of selected item to beginning or end of -- list data List n e = List { listElements :: !(V.Vector e) , listSelected :: !(Maybe Int) , listName :: n , listItemHeight :: Int } deriving (Functor, Foldable, Traversable, Show) suffixLenses ''List instance Named (List n e) n where getName = listName handleListEvent :: (Ord n) => Event -> List n e -> EventM n (List n e) handleListEvent e theList = case e of EvKey KUp [] -> return $ listMoveUp theList EvKey KDown [] -> return $ listMoveDown theList EvKey KHome [] -> return $ listMoveTo 0 theList EvKey KEnd [] -> return $ listMoveTo (V.length $ listElements theList) theList EvKey KPageDown [] -> do v <- lookupViewport (theList^.listNameL) case v of Nothing -> return theList Just vp -> return $ listMoveBy (vp^.vpSize._2 `div` theList^.listItemHeightL) theList EvKey KPageUp [] -> do v <- lookupViewport (theList^.listNameL) case v of Nothing -> return theList Just vp -> return $ listMoveBy (negate $ vp^.vpSize._2 `div` theList^.listItemHeightL) theList _ -> return theList -- | The top-level attribute used for the entire list. listAttr :: AttrName listAttr = "list" -- | The attribute used only for the currently-selected list item when -- the list does not have focus. Extends 'listAttr'. listSelectedAttr :: AttrName listSelectedAttr = listAttr <> "selected" -- | The attribute used only for the currently-selected list item when -- the list has focus. Extends 'listSelectedAttr'. listSelectedFocusedAttr :: AttrName listSelectedFocusedAttr = listSelectedAttr <> "focused" -- | Construct a list in terms of an element type 'e'. list :: n -- ^ The list name (must be unique) -> V.Vector e -- ^ The initial list contents -> Int -- ^ The list item height in rows (all list item widgets must be -- this high) -> List n e list name es h = let selIndex = if V.null es then Nothing else Just 0 safeHeight = max 1 h in List es selIndex name safeHeight -- | Turn a list state value into a widget given an item drawing -- function. renderList :: (Ord n, Show n) => (Bool -> e -> Widget n) -- ^ Rendering function, True for the selected element -> Bool -- ^ Whether the list has focus -> List n e -- ^ The List to be rendered -> Widget n -- ^ rendered widget renderList drawElem foc l = withDefAttr listAttr $ drawListElements foc l drawElem drawListElements :: (Ord n, Show n) => Bool -> List n e -> (Bool -> e -> Widget n) -> Widget n drawListElements foc l drawElem = Widget Greedy Greedy $ do c <- getContext let es = V.slice start num (l^.listElementsL) idx = fromMaybe 0 (l^.listSelectedL) start = max 0 $ idx - numPerHeight + 1 num = min (numPerHeight * 2) (V.length (l^.listElementsL) - start) -- The number of items to show is the available height divided by -- the item height... initialNumPerHeight = (c^.availHeightL) `div` (l^.listItemHeightL) -- ... but if the available height leaves a remainder of -- an item height then we need to ensure that we render an -- extra item to show a partial item at the top or bottom to -- give the expected result when an item is more than one -- row high. (Example: 5 rows available with item height -- of 3 yields two items: one fully rendered, the other -- rendered with only its top 2 or bottom 2 rows visible, -- depending on how the viewport state changes.) numPerHeight = initialNumPerHeight + if initialNumPerHeight * (l^.listItemHeightL) == c^.availHeightL then 0 else 1 off = start * (l^.listItemHeightL) drawnElements = flip V.imap es $ \i e -> let isSelected = Just (i + start) == l^.listSelectedL elemWidget = drawElem isSelected e selItemAttr = if foc then withDefAttr listSelectedFocusedAttr else withDefAttr listSelectedAttr makeVisible = if isSelected then visible . selItemAttr else id in makeVisible elemWidget render $ viewport (l^.listNameL) Vertical $ translateBy (Location (0, off)) $ vBox $ V.toList drawnElements -- | Insert an item into a list at the specified position. listInsert :: Int -- ^ The position at which to insert (0 <= i <= size) -> e -- ^ The element to insert -> List n e -> List n e listInsert pos e l = let safePos = clamp 0 (V.length es) pos es = l^.listElementsL newSel = case l^.listSelectedL of Nothing -> 0 Just s -> if safePos <= s then s + 1 else s (front, back) = V.splitAt safePos es in l & listSelectedL .~ Just newSel & listElementsL .~ (front V.++ (e `V.cons` back)) -- | Remove an element from a list at the specified position. listRemove :: Int -- ^ The position at which to remove an element (0 <= i < size) -> List n e -> List n e listRemove pos l | V.null (l^.listElementsL) = l | pos /= clamp 0 (V.length (l^.listElementsL) - 1) pos = l | otherwise = let newSel = case l^.listSelectedL of Nothing -> 0 Just s | pos == 0 -> 0 | pos == s -> pos - 1 | pos < s -> s - 1 | otherwise -> s (front, back) = V.splitAt pos es es' = front V.++ V.tail back es = l^.listElementsL in l & listSelectedL .~ (if V.null es' then Nothing else Just newSel) & listElementsL .~ es' -- | Replace the contents of a list with a new set of elements and -- update the new selected index. If the list is empty, empty selection is used -- instead. Otherwise, if the specified selected index (via 'Just') is not in -- the list bounds, zero is used instead. listReplace :: V.Vector e -> Maybe Int -> List n e -> List n e listReplace es idx l = let newSel = if V.null es then Nothing else clamp 0 (V.length es - 1) <$> idx in l & listSelectedL .~ newSel & listElementsL .~ es -- | Move the list selected index up by one. (Moves the cursor up, -- subtracts one from the index.) listMoveUp :: List n e -> List n e listMoveUp = listMoveBy (-1) -- | Move the list selected index down by one. (Moves the cursor down, -- adds one to the index.) listMoveDown :: List n e -> List n e listMoveDown = listMoveBy 1 -- | Move the list selected index by the specified amount, subject to -- validation. listMoveBy :: Int -> List n e -> List n e listMoveBy amt l = let newSel = clamp 0 (V.length (l^.listElementsL) - 1) <$> (amt +) <$> (l^.listSelectedL) in l & listSelectedL .~ newSel -- | Set the selected index for a list to the specified index, subject -- to validation. listMoveTo :: Int -> List n e -> List n e listMoveTo pos l = let len = V.length (l^.listElementsL) newSel = clamp 0 (len - 1) $ if pos < 0 then len - pos else pos in l & listSelectedL .~ if len > 0 then Just newSel else Nothing -- | Return a list's selected element, if any. listSelectedElement :: List n e -> Maybe (Int, e) listSelectedElement l = do sel <- l^.listSelectedL return (sel, (l^.listElementsL) V.! sel) -- | Remove all elements from the list and clear the selection. listClear :: List n e -> List n e listClear l = l & listElementsL .~ V.empty & listSelectedL .~ Nothing -- | Reverse the list. The element selected before the reversal will -- again be the selected one. listReverse :: List n e -> List n e listReverse theList = theList & listElementsL %~ V.reverse & listSelectedL .~ newSel where n = V.length (listElements theList) newSel = (-) <$> pure (n-1) <*> listSelected theList -- | Apply a function to the selected element. If no element is selected -- the list is not modified. listModify :: (e -> e) -> List n e -> List n e listModify f l = case listSelectedElement l of Nothing -> l Just (n,e) -> let es = V.update (l^.listElementsL) (return (n, f e)) in listReplace es (Just n) l brick-0.18/src/Brick/Widgets/ProgressBar.hs0000644000000000000000000000347313117314670016750 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | This module provides a progress bar widget. module Brick.Widgets.ProgressBar ( progressBar -- * Attributes , progressCompleteAttr , progressIncompleteAttr ) where import Lens.Micro ((^.)) import Data.Maybe (fromMaybe) import Data.Monoid import Graphics.Vty (safeWcswidth) import Brick.Types import Brick.AttrMap import Brick.Widgets.Core -- | The attribute of the completed portion of the progress bar. progressCompleteAttr :: AttrName progressCompleteAttr = "progressComplete" -- | The attribute of the incomplete portion of the progress bar. progressIncompleteAttr :: AttrName progressIncompleteAttr = "progressIncomplete" -- | Draw a progress bar with the specified (optional) label and -- progress value. This fills available horizontal space and is one row -- high. progressBar :: 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 progressBar 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)) ' ' fullBar = leftPart <> label <> rightPart completeWidth = round $ progress * toEnum (length fullBar) completePart = take completeWidth fullBar incompletePart = drop completeWidth fullBar render $ (withAttr progressCompleteAttr $ str completePart) <+> (withAttr progressIncompleteAttr $ str incompletePart) brick-0.18/src/Brick/Widgets/Border/0000755000000000000000000000000013117314670015371 5ustar0000000000000000brick-0.18/src/Brick/Widgets/Border/Style.hs0000644000000000000000000001044613117314670017032 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | This module provides styles for borders as used in terminal -- applications. Your mileage may vary on some of the fancier styles -- due to varying support for some border characters in the fonts your -- users may be using. Because of this, we provide the 'ascii' style in -- addition to the Unicode styles. The 'unicode' style is also a safe -- bet. -- -- To use these in your widgets, see -- 'Brick.Widgets.Core.withBorderStyle'. By default, widgets rendered -- without a specified border style use 'unicode' via the 'Default' -- instance provided by 'BorderStyle'. module Brick.Widgets.Border.Style ( BorderStyle(..) , borderStyleFromChar , ascii , unicode , unicodeBold , unicodeRounded , defaultBorderStyle ) where -- | A border style for use in any widget that needs to render borders -- in a consistent style. data BorderStyle = BorderStyle { bsCornerTL :: Char -- ^ Top-left corner character , bsCornerTR :: Char -- ^ Top-right corner character , bsCornerBR :: Char -- ^ Bottom-right corner character , bsCornerBL :: Char -- ^ Bottom-left corner character , bsIntersectFull :: Char -- ^ Full intersection (cross) , bsIntersectL :: Char -- ^ Left side of a horizontal border intersecting a vertical one , bsIntersectR :: Char -- ^ Right side of a horizontal border intersecting a vertical one , bsIntersectT :: Char -- ^ Top of a vertical border intersecting a horizontal one , bsIntersectB :: Char -- ^ Bottom of a vertical border intersecting a horizontal one , bsHorizontal :: Char -- ^ Horizontal border character , bsVertical :: Char -- ^ Vertical border character } deriving (Show, Read, Eq) defaultBorderStyle :: BorderStyle defaultBorderStyle = unicode -- | Make a border style using the specified character everywhere. borderStyleFromChar :: Char -> BorderStyle borderStyleFromChar c = BorderStyle c c c c c c c c c c c -- |An ASCII border style which will work in any terminal. ascii :: BorderStyle ascii = BorderStyle { bsCornerTL = '+' , bsCornerTR = '+' , bsCornerBR = '+' , bsCornerBL = '+' , bsIntersectFull = '+' , bsIntersectL = '+' , bsIntersectR = '+' , bsIntersectT = '+' , bsIntersectB = '+' , bsHorizontal = '-' , bsVertical = '|' } -- |A unicode border style with real corner and intersection characters. unicode :: BorderStyle unicode = BorderStyle { bsCornerTL = '┌' , bsCornerTR = '┐' , bsCornerBR = '┘' , bsCornerBL = '└' , bsIntersectFull = '┼' , bsIntersectL = '├' , bsIntersectR = '┤' , bsIntersectT = '┬' , bsIntersectB = '┴' , bsHorizontal = '─' , bsVertical = '│' } -- |A unicode border style in a bold typeface. unicodeBold :: BorderStyle unicodeBold = BorderStyle { bsCornerTL = '┏' , bsCornerTR = '┓' , bsCornerBR = '┛' , bsCornerBL = '┗' , bsIntersectFull = '╋' , bsIntersectL = '┣' , bsIntersectR = '┫' , bsIntersectT = '┳' , bsIntersectB = '┻' , bsHorizontal = '━' , bsVertical = '┃' } -- |A unicode border style with rounded corners. unicodeRounded :: BorderStyle unicodeRounded = BorderStyle { bsCornerTL = '╭' , bsCornerTR = '╮' , bsCornerBR = '╯' , bsCornerBL = '╰' , bsIntersectFull = '┼' , bsIntersectL = '├' , bsIntersectR = '┤' , bsIntersectT = '┬' , bsIntersectB = '┴' , bsHorizontal = '─' , bsVertical = '│' } brick-0.18/src/Data/0000755000000000000000000000000013117314670012365 5ustar0000000000000000brick-0.18/src/Data/Text/0000755000000000000000000000000013117314670013311 5ustar0000000000000000brick-0.18/src/Data/Text/Markup.hs0000644000000000000000000000557613117314670015121 0ustar0000000000000000-- | This module provides an API for "marking up" text with arbitrary -- values. A piece of markup can then be converted to a list of pairs -- representing the sequences of characters assigned the same markup -- value. -- -- This interface is experimental. Don't use this for your full-file -- syntax highlighter just yet! module Data.Text.Markup ( Markup , markupToList , markupSet , fromList , fromText , toText , (@@) ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) import Data.Monoid #endif import Data.String (IsString(..)) import qualified Data.Text as T -- | Markup with metadata type 'a' assigned to each character. data Markup a = Markup [(Char, a)] deriving Show instance Monoid (Markup a) where mempty = Markup mempty mappend (Markup t1) (Markup t2) = Markup (t1 `mappend` t2) instance (Monoid a) => IsString (Markup a) where fromString = fromText . T.pack -- | Build a piece of markup; assign the specified metadata to every -- character in the specified text. (@@) :: T.Text -> a -> Markup a t @@ val = Markup [(c, val) | c <- T.unpack t] -- | Build markup from text with the default metadata. fromText :: (Monoid a) => T.Text -> Markup a fromText = (@@ mempty) -- | Extract the text from markup, discarding the markup metadata. toText :: (Eq a) => Markup a -> T.Text toText = T.concat . (fst <$>) . concat . markupToList -- | Set the metadata for a range of character positions in a piece of -- markup. This is useful for, e.g., syntax highlighting. markupSet :: (Eq a) => (Int, Int) -> a -> Markup a -> Markup a markupSet (start, len) val m@(Markup l) = if start < 0 || start + len > length l then m else newM where newM = Markup $ theHead ++ theNewEntries ++ theTail (theHead, theLongTail) = splitAt start l (theOldEntries, theTail) = splitAt len theLongTail theNewEntries = zip (fst <$> theOldEntries) (repeat val) -- | Convert markup to a list of lines. Each line is represented by a -- list of pairs in which each pair contains the longest subsequence of -- characters having the same metadata. markupToList :: (Eq a) => Markup a -> [[(T.Text, a)]] markupToList (Markup thePairs) = toList <$> toLines [] [] thePairs where toLines ls cur [] = ls ++ [cur] toLines ls cur ((ch, val):rest) | ch == '\n' = toLines (ls ++ [cur]) [] rest | otherwise = toLines ls (cur ++ [(ch, val)]) rest toList [] = [] toList ((ch, val):rest) = (T.pack $ ch : (fst <$> matching), val) : toList remaining where (matching, remaining) = break (\(_, v) -> v /= val) rest -- | Convert a list of text and metadata pairs into markup. fromList :: [(T.Text, a)] -> Markup a fromList pairs = Markup $ concatMap (\(t, val) -> [(c, val) | c <- T.unpack t]) pairs