brick (empty) → 0.1
raw patch · 36 files changed
+4905/−0 lines, 36 filesdep +Diffdep +basedep +bricksetup-changed
Dependencies added: Diff, base, brick, containers, contravariant, data-default, lens, template-haskell, text, text-zipper, transformers, vector, vty
Files
- CHANGELOG.md +7/−0
- LICENSE +30/−0
- README.md +120/−0
- Setup.hs +2/−0
- brick.cabal +271/−0
- docs/guide.rst +824/−0
- programs/AttrDemo.hs +62/−0
- programs/BorderDemo.hs +95/−0
- programs/CustomEventDemo.hs +75/−0
- programs/DialogDemo.hs +62/−0
- programs/EditDemo.hs +96/−0
- programs/HelloWorldDemo.hs +11/−0
- programs/LayerDemo.hs +67/−0
- programs/ListDemo.hs +91/−0
- programs/MarkupDemo.hs +40/−0
- programs/PaddingDemo.hs +57/−0
- programs/SuspendAndResumeDemo.hs +62/−0
- programs/ViewportScrollDemo.hs +84/−0
- programs/VisibilityDemo.hs +134/−0
- src/Brick/AttrMap.hs +168/−0
- src/Brick/Focus.hs +68/−0
- src/Brick/Main.hs +305/−0
- src/Brick/Markup.hs +54/−0
- src/Brick/Types.hs +89/−0
- src/Brick/Types/TH.hs +18/−0
- src/Brick/Util.hs +59/−0
- src/Brick/Widgets/Border.hs +142/−0
- src/Brick/Widgets/Border/Style.hs +123/−0
- src/Brick/Widgets/Center.hs +108/−0
- src/Brick/Widgets/Core.hs +96/−0
- src/Brick/Widgets/Dialog.hs +141/−0
- src/Brick/Widgets/Edit.hs +122/−0
- src/Brick/Widgets/Internal.hs +877/−0
- src/Brick/Widgets/List.hs +223/−0
- src/Brick/Widgets/ProgressBar.hs +48/−0
- src/Data/Text/Markup.hs +74/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@++Brick changelog+---------------++0.1+---+Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (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.
+ README.md view
@@ -0,0 +1,120 @@+brick+-----++[](https://travis-ci.org/jtdaugherty/brick)++`brick` is a terminal user interface programming+library written in Haskell, 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 -- even the bits that are stateful -- using a set of+declarative combinators. Then you provide a function to transform your+own application state when input (or other kinds of) events arrive.++Under the hood, this library builds upon [vty](http://hackage.haskell.org/package/vty).++This library deprecates [vty-ui](https://github.com/jtdaugherty/vty-ui).++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.+ * Most widgets can be made scrollable *for free*.+ * Attribute management is flexible and can be customized at runtime on+ a per-widget basis.++`brick` exports [lens](http://github.com/ekmett/lens) and non-`lens`+interfaces for most things, so you can get the full power of `lens` if+you want it or use plain Haskell if you don't. If a `brick` library+function named `thing` has a `lens` version, the `lens` version is named+`thingL`.++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](docs/guide.rst).++Documentation+-------------++Your documentation options, in recommended order, are:++* [FAQ](FAQ.md)+* [The brick user guide](docs/guide.rst)+* Haddock (all modules)+* [Demo programs](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` 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!++The development of this library has revealed some bugs in `vty`, and+I've tried to report those as I go. If they haven't been resolved,+you'll see them arise when using `brick`.++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. Even better, the output of `cabal freeze` would probably be+ helpful in making the problem reproducible.++ - Clearly describe the behavior you expected ...++ - ... and include a mininal 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.+ - If you make changes, try to make them consistent with the syntactic+ conventions I've used in the codebase.+ - Please provide Haddock and/or user guide documentation for any+ changes you make.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ brick.cabal view
@@ -0,0 +1,271 @@+name: brick+version: 0.1+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.Main (simpleMain)+ > import Brick.Widgets.Core (Widget, str)+ >+ > ui :: Widget+ > ui = str "Hello, world!"+ >+ > main :: IO ()+ > main = simpleMain ui+ .+ .+ To get started, see:+ .+ * <https://github.com/jtdaugherty/brick/blob/master/README.md The README>+ .+ * The <https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst Brick user guide>+ .+ * The demonstration programs in the 'programs' directory+ .+ .+ This package deprecates <http://hackage.haskell.org/package/vty-ui vty-ui>.+license: BSD3+license-file: LICENSE+author: Jonathan Daugherty <cygnus@foobox.com>+maintainer: Jonathan Daugherty <cygnus@foobox.com>+copyright: (c) Jonathan Daugherty 2015+category: Graphics+build-type: Simple+cabal-version: >=1.10+Homepage: https://github.com/jtdaugherty/brick/+Bug-reports: https://github.com/jtdaugherty/brick/issues++data-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+ hs-source-dirs: src+ exposed-modules:+ Brick.AttrMap+ 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.Widgets.Internal++ build-depends: base <= 5,+ vty >= 5.3.1,+ transformers,+ data-default,+ Diff,+ containers,+ lens,+ vector,+ contravariant,+ text,+ text-zipper >= 0.2.1,+ template-haskell++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.3.1,+ data-default,+ text,+ lens++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+ main-is: ViewportScrollDemo.hs+ build-depends: base,+ brick,+ vty >= 5.3.1,+ data-default,+ text,+ lens++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.3.1,+ data-default,+ text,+ lens++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.3.1,+ data-default,+ text,+ lens++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.3.1,+ data-default,+ text,+ lens++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.3.1,+ data-default,+ text,+ lens++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.3.1,+ data-default,+ text,+ lens++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.3.1,+ data-default,+ text,+ lens++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.3.1,+ data-default,+ text,+ lens++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.3.1,+ data-default,+ text,+ lens++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.3.1,+ data-default,+ text,+ lens++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.3.1,+ data-default,+ text,+ lens++executable brick-border-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: BorderDemo.hs+ build-depends: base <= 5,+ brick,+ vty >= 5.3.1,+ data-default,+ text,+ lens
+ docs/guide.rst view
@@ -0,0 +1,824 @@+Brick 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 `lens`_: ``brick`` uses ``lens`` functions 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 names: in this document, where sensible, I will use+ fully-qualified names whenever I mention something for the first time+ or whenever I use something that is not part of ``brick``. Use of+ names in this way 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 =+ App { appDraw :: s -> [Widget]+ , appChooseCursor :: s -> [CursorLocation] -> Maybe CursorLocation+ , appHandleEvent :: s -> e -> EventM (Next s)+ , appStartEvent :: s -> EventM s+ , appAttrMap :: s -> AttrMap+ , appLiftVtyEvent :: Event -> e+ }++The ``App`` type is polymorphic over two types: your application state+type ``s`` and event type ``e``.++The application state type is the type of data that will evolve over the+course of the application's execution; we will provide the library with+its starting value and event handling will transform it as the program+executes.++The event type is the type of events that your event handler+(``appHandleEvent``) will handle. The underlying ``vty`` library+provides ``Graphics.Vty.Event`` and this forms the basis of all events+we will handle with ``brick`` applications. The+``Brick.Main.defaultMain`` function expects an ``App s Event`` since+this is a common case.++However, we often need to extend our notion of events beyond those+originating from the keyboard. Imagine an application with multiple+threads and network or disk I/O. Such an application will need to have+its own internal events to pass to the event handler as (for example)+network data arrives. To accommodate this we allow an ``App`` to use an+event type of your own design, so long as it provides a constructor for+``vty``'s ``Event`` type (``appLiftVtyEvent``). For more details, see+`Using Your Own Event Type`_.++The various fields of ``App`` will be described in the sections below.++To run an ``App``, we pass it to ``Brick.Main.defaultMain`` or+``Brick.Main.customMain`` along with an initial application state value.++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. It also decides whether+to continue program execution. The function takes the current+application state and the event and returns the *next application+state*:++.. code:: haskell++ appHandleEvent :: s -> e -> EventM (Next s)++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 just used to make scrolling+requests to the renderer (see `Viewports`_). 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.++The ``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).++Using Your Own Event Type+*************************++Since we often need to communicate application-specific events+beyond input events to the event handler, the ``App`` type is+polymorphic over the event type we want to handle. If we use+``Brick.Main.defaultMain`` to run our ``App``, we have to use+``Graphics.Vty.Event`` as our event type. But if our application has+other event-handling needs, we need to use our own event type.++To do this, we first define an event type:++.. code:: haskell++ data CustomEvent =+ VtyEvent Graphics.Vty.Event+ | CustomEvent1+ | CustomEvent2++Our custom event type *must* provide a constructor capable of taking+a ``Graphics.Vty.Event`` value. This allows the ``brick`` event loop+to send us ``vty`` events in the midst of our custom ones. To allow+``brick`` to do this, we provide this constructor as the value of+``appLiftVtyEvent``. This way, ``brick`` can wrap a ``vty`` event using+our custom event type and then pass it to our event handler (which takes+``CustomEvent`` values). In this case we'd set ``appLiftVtyEvent =+VtyEvent``.++Once we have set ``appLiftVtyEvent`` in this way, we also need to set up+a mechanism for getting our custom events into the ``brick`` event loop+from other threads. To do this we use a ``Control.Concurrent.Chan`` and+call ``Brick.Main.customMain`` instead of ``Brick.Main.defaultMain``:++.. code:: haskell++ main :: IO ()+ main = do+ eventChan <- Control.Concurrent.newChan+ finalState <- customMain (Graphics.Vty.mkVty Data.Default.def) eventChan app initialState+ -- Use finalState and exit++Beyond just the application and its initial state, 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.++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 s++This function takes the initial application state and returns it in+``EventM``, possibly changing it and possibly making viewport requests.+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] -> Maybe CursorLocation++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.++We decide which location to show by looking at the ``Brick.Types.Name``+value contained in the ``cursorLocationName`` field. The ``Name``+value associated with a cursor location will be the ``Name`` of the+``Widget`` that requested it; this is why constructors for widgets like+``Brick.Widgets.Edit.editor`` require a ``Name`` parameter. The ``Name``+lets us distinguish between many cursor-placing widgets of the same+type.++``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 name or+ ``Nothing`` if it is not requested.++Widgets request cursor placement by using the+``Brick.Widgets.Core.showCursor`` combinator. For example, this widget+places a cursor on the first "``o``" in "``foo``" assocated with the+cursor name "``myCursor``":++.. code:: haskell++ let w = showCursor (Name "myCursor") (Brick.Types.Location (1, 0))+ (Brick.Widgets.Core.str "foobar")++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.Widgets.Core.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 the 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``++Viewports+=========++A *viewport* is a scrollable window onto another widget. Viewports have+a *scrolling direction* of type ``Brick.Widgets.Core.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`_). *The viewport+name must be unique across your interface.*++For example, the following puts a string in a horizontally-scrollable+viewport:++.. code:: haskell++ let w = viewport (Name "myViewport") Horizontal $ str "Hello, world!"++The above example is incomplete. 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 embed this scrollable viewport+somewhere in our interface, we want to control its dimensions. To do so,+we use the limiting combinators (see `Limiting Rendering Area`_):++.. code:: haskell++ let w = hLimit 5 $+ vLimit 1 $+ viewport (Name "myViewport") 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+render 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. 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++ let vp = viewportScroll (Name "myViewport")++The ``ViewportScroll`` record type contains a number of scrolling+functions for making scrolling requests:++.. code:: haskell++ hScrollPage :: Direction -> EventM ()+ hScrollBy :: Int -> EventM ()+ hScrollToBeginning :: EventM ()+ hScrollToEnd :: EventM ()+ vScrollPage :: Direction -> EventM ()+ vScrollBy :: Int -> EventM ()+ vScrollToBeginning :: EventM ()+ vScrollToEnd :: EventM ()++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`` and the ``myViewport`` example given above, we+can write an event handler that scrolls the "Hello, world!" viewport one+column to the right:++.. code:: haskell++ myHandler :: s -> e -> EventM (Next s)+ myHandler s e = do+ let vp = viewportScroll (Name "myViewport")+ 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++ let w = viewport (Name "myViewport") Horizontal $+ (visible $ str "Hello," <+> (str " world!")++This example requests that the "``myViewport``" 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 both scrolling-unaware and also makes it support+ variable-height items for free.++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.++Implementing Your Own 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. We start by writing a constructor+function:++.. code:: haskell++ myWidget :: ... -> Widget+ myWidget ... =+ Widget Fixed Fixed $ do+ ...++We specify the horizontal and vertical growth policies of the widget+as ``Fixed`` in this example, although they should be specified+appropriately (see `How Widgets and Rendering Work`_). Lastly we specify+the *rendering function*, a function of type++.. code:: haskell++ render :: RenderM Result++which is a function returning a ``Brick.Widgets.Core.Result``:++.. code:: haskell++ data Result =+ Result { image :: Graphics.Vty.Image+ , cursors :: [Brick.Types.CursorLocation]+ , visibilityRequests :: [Brick.Widgets.Core.VisibilityRequest]+ }++The ``RenderM`` monad gives us access to the rendering context (see `How+Widgets and Rendering Work`_) via the ``Brick.Widgets.Core.getContext``+function. The context type is:++.. code:: haskell++ data Context =+ Context { ctxAttrName :: AttrName+ , availWidth :: Int+ , availHeight :: Int+ , ctxBorderStyle :: BorderStyle+ , ctxAttrMap :: AttrMap+ }++and has `lens` fields exported as described in `Conventions`_.++The job of the rendering function is to return a rendering result which,+at a minimum, 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.Widgets.Core.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+ myFill ch =+ Widget Greedy Greedy $ do+ ctx <- getContext+ let a = ctx^.attrL+ return $ Result (Graphics.Vty.charFill ch a (ctx^.availWidth) (ctx^.availHeight))+ [] []++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 and visibility requests*.+This is vital to maintaining the correctness of cursor locations and+visbility locations 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.++.. _vty: https://github.com/coreyoconnor/vty+.. _Hackage: http://hackage.haskell.org/+.. _lens: http://hackage.haskell.org/package/lens
+ programs/AttrDemo.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Data.Monoid+import Graphics.Vty+ ( Event, Attr, white, blue, cyan, green, red, yellow+ , black+ )++import Brick.Main+import Brick.Widgets.Core+ ( Widget+ , (<=>)+ , withAttr+ , vBox+ )+import Brick.Util (on, fg)+import Brick.AttrMap (attrMap, AttrMap)++ui :: Widget+ui =+ vBox [ "This text uses the global default attribute."+ , withAttr "foundFull"+ "Specifying an attribute name means we look it up in the attribute tree."+ , withAttr "foundFgOnly"+ ("When we find a value, we merge it with its parent in the attribute"+ <=> "name tree all the way to the root (the global default).")+ , withAttr "missing"+ "A missing attribute name just resumes the search at its parent."+ , withAttr ("general" <> "specific")+ "In this way we build complete attribute values by using an inheritance scheme."+ , withAttr "foundFull"+ "You can override everything ..."+ , withAttr "foundFgOnly"+ "... or only you want to change and inherit the rest."+ , "Attribute names are assembled with the Monoid append operation to indicate"+ , "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 () Event+app =+ App { appDraw = const [ui]+ , appHandleEvent = resizeOrQuit+ , appStartEvent = return+ , appAttrMap = const theMap+ , appChooseCursor = neverShowCursor+ , appLiftVtyEvent = id+ }++main :: IO ()+main = defaultMain app ()
+ programs/BorderDemo.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Applicative ((<$>))+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.Widgets.Core+ ( Widget+ , (<=>)+ , (<+>)+ , vLimit+ , hLimit+ , hBox+ , updateAttrMap+ , withBorderStyle+ , txt+ )+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 "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 "title" $+ hLimit 20 $+ vLimit 5 $+ C.center $+ "colors!"++ui :: Widget+ui =+ hBox borderDemos+ <=> B.hBorder+ <=> colorDemo+ <=> B.hBorderWithLabel "horizontal border label"+ <=> (C.center "Left of vertical border"+ <+> B.vBorder+ <+> C.center "Right of vertical border")++main :: IO ()+main = M.simpleMain ui
+ programs/CustomEventDemo.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Control.Lens (makeLenses, (^.), (&), (.~), (%~))+import Control.Monad (void, forever)+import Control.Concurrent (newChan, writeChan, threadDelay, forkIO)+import Data.Default+import Data.Monoid+import qualified Graphics.Vty as V++import Brick.Main+ ( App(..)+ , Next+ , EventM+ , showFirstCursor+ , customMain+ , continue+ , halt+ )+import Brick.Widgets.Core+ ( Widget+ , (<=>)+ , str+ )++data St =+ St { _stLastVtyEvent :: Maybe V.Event+ , _stCounter :: Int+ }++makeLenses ''St++data CustomEvent = VtyEvent V.Event+ | Counter++drawUI :: St -> [Widget]+drawUI st = [a]+ where+ a = (str $ "Last Vty event: " <> (show $ st^.stLastVtyEvent))+ <=>+ (str $ "Counter value is: " <> (show $ st^.stCounter))++appEvent :: St -> CustomEvent -> EventM (Next St)+appEvent st e =+ case e of+ VtyEvent (V.EvKey V.KEsc []) -> halt st+ VtyEvent ev -> continue $ st & stLastVtyEvent .~ (Just ev)+ Counter -> continue $ st & stCounter %~ (+1)++initialState :: St+initialState =+ St { _stLastVtyEvent = Nothing+ , _stCounter = 0+ }++theApp :: App St CustomEvent+theApp =+ App { appDraw = drawUI+ , appChooseCursor = showFirstCursor+ , appHandleEvent = appEvent+ , appStartEvent = return+ , appAttrMap = def+ , appLiftVtyEvent = VtyEvent+ }++main :: IO ()+main = do+ chan <- newChan++ forkIO $ forever $ do+ writeChan chan Counter+ threadDelay 1000000++ void $ customMain (V.mkVty def) chan theApp initialState
+ programs/DialogDemo.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Data.Monoid+import qualified Graphics.Vty as V++import qualified Brick.Main as M+import Brick.Widgets.Core+ ( Widget+ , 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 -> V.Event -> M.EventM (M.Next (D.Dialog Choice))+appEvent d ev =+ case ev of+ V.EvKey V.KEsc [] -> M.halt d+ V.EvKey V.KEnter [] -> M.halt d+ _ -> M.continue $ T.handleEvent ev d++initialState :: D.Dialog Choice+initialState = D.dialog "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) V.Event+theApp =+ M.App { M.appDraw = drawUI+ , M.appChooseCursor = M.showFirstCursor+ , M.appHandleEvent = appEvent+ , M.appStartEvent = return+ , M.appAttrMap = const theMap+ , M.appLiftVtyEvent = id+ }++main :: IO ()+main = do+ d <- M.defaultMain theApp initialState+ putStrLn $ "You chose: " <> show (D.dialogSelection d)
+ programs/EditDemo.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+module Main where++import Control.Lens+import qualified Graphics.Vty as V++import qualified Brick.Main as M+import qualified Brick.Types as T+import Brick.Widgets.Core+ ( Widget+ , (<+>)+ , (<=>)+ , hLimit+ , vLimit+ , str+ )+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Edit as E+import qualified Brick.AttrMap as A+import Brick.Util (on)++data St =+ St { _currentEditor :: T.Name+ , _edit1 :: E.Editor+ , _edit2 :: E.Editor+ }++makeLenses ''St++firstEditor :: T.Name+firstEditor = "edit1"++secondEditor :: T.Name+secondEditor = "edit2"++switchEditors :: St -> St+switchEditors st =+ let next = if st^.currentEditor == firstEditor+ then secondEditor else firstEditor+ in st & currentEditor .~ next++currentEditorL :: St -> Lens' St E.Editor+currentEditorL st =+ if st^.currentEditor == firstEditor+ then edit1+ else edit2++drawUI :: St -> [Widget]+drawUI st = [ui]+ where+ ui = C.center $ ("Input 1 (unlimited): " <+> (hLimit 30 $ vLimit 5 $ E.renderEditor $ st^.edit1)) <=>+ " " <=>+ ("Input 2 (limited to 2 lines): " <+> (hLimit 30 $ E.renderEditor $ st^.edit2)) <=>+ " " <=>+ "Press Tab to switch between editors, Esc to quit."++appEvent :: St -> V.Event -> M.EventM (M.Next St)+appEvent st ev =+ case ev of+ V.EvKey V.KEsc [] -> M.halt st+ V.EvKey (V.KChar '\t') [] -> M.continue $ switchEditors st+ _ -> M.continue $ st & currentEditorL st %~ T.handleEvent ev++initialState :: St+initialState =+ St firstEditor+ (E.editor firstEditor (str . unlines) Nothing "")+ (E.editor secondEditor (str . unlines) (Just 2) "")++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+ [ (E.editAttr, V.white `on` V.blue)+ ]++appCursor :: St -> [T.CursorLocation] -> Maybe T.CursorLocation+appCursor st = M.showCursorNamed (st^.currentEditor)++theApp :: M.App St V.Event+theApp =+ M.App { M.appDraw = drawUI+ , M.appChooseCursor = appCursor+ , M.appHandleEvent = appEvent+ , M.appStartEvent = return+ , M.appAttrMap = const theMap+ , M.appLiftVtyEvent = id+ }++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
+ programs/HelloWorldDemo.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Brick.Main (simpleMain)+import Brick.Widgets.Core (Widget)++ui :: Widget+ui = "Hello, world!"++main :: IO ()+main = simpleMain ui
+ programs/LayerDemo.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Control.Lens (makeLenses, (^.), (&), (%~))+import Control.Monad (void)+import Data.Default+import qualified Graphics.Vty as V++import qualified Brick.Types as T+import Brick.Types (rowL, columnL)+import qualified Brick.Main as M+import qualified Brick.Widgets.Border as B+import Brick.Widgets.Core+ ( Widget+ , translateBy+ )++data St =+ St { _topLayerLocation :: T.Location+ , _bottomLayerLocation :: T.Location+ }++makeLenses ''St++drawUi :: St -> [Widget]+drawUi st =+ [ topLayer st+ , bottomLayer st+ ]++topLayer :: St -> Widget+topLayer st =+ translateBy (st^.topLayerLocation) $+ B.border "Top layer\n(Arrow keys move)"++bottomLayer :: St -> Widget+bottomLayer st =+ translateBy (st^.bottomLayerLocation) $+ B.border "Bottom layer\n(Ctrl-arrow keys move)"++appEvent :: St -> V.Event -> M.EventM (M.Next St)+appEvent st (V.EvKey V.KDown []) = M.continue $ st & topLayerLocation.rowL %~ (+ 1)+appEvent st (V.EvKey V.KUp []) = M.continue $ st & topLayerLocation.rowL %~ (subtract 1)+appEvent st (V.EvKey V.KRight []) = M.continue $ st & topLayerLocation.columnL %~ (+ 1)+appEvent st (V.EvKey V.KLeft []) = M.continue $ st & topLayerLocation.columnL %~ (subtract 1)++appEvent st (V.EvKey V.KDown [V.MCtrl]) = M.continue $ st & bottomLayerLocation.rowL %~ (+ 1)+appEvent st (V.EvKey V.KUp [V.MCtrl]) = M.continue $ st & bottomLayerLocation.rowL %~ (subtract 1)+appEvent st (V.EvKey V.KRight [V.MCtrl]) = M.continue $ st & bottomLayerLocation.columnL %~ (+ 1)+appEvent st (V.EvKey V.KLeft [V.MCtrl]) = M.continue $ st & bottomLayerLocation.columnL %~ (subtract 1)++appEvent st (V.EvKey V.KEsc []) = M.halt st+appEvent st _ = M.continue st++app :: M.App St V.Event+app =+ M.App { M.appDraw = drawUi+ , M.appStartEvent = return+ , M.appHandleEvent = appEvent+ , M.appAttrMap = const def+ , M.appLiftVtyEvent = id+ , M.appChooseCursor = M.neverShowCursor+ }++main :: IO ()+main = void $ M.defaultMain app $ St (T.Location (0, 0)) (T.Location (0, 0))
+ programs/ListDemo.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Lens ((^.))+import Control.Monad (void)+import Data.Monoid+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 Brick.Widgets.Core+ ( Widget+ , (<+>)+ , str+ , vLimit+ , hLimit+ , vBox+ , withAttr+ )+import Brick.Util (fg, on)++drawUI :: L.List Int -> [Widget]+drawUI l = [ui]+ where+ label = "Item " <+> cur <+> " of " <+> total+ cur = case l^.(L.listSelectedL) of+ Nothing -> "-"+ Just i -> str (show (i + 1))+ total = str $ show $ length $ l^.(L.listElementsL)+ box = B.borderWithLabel label $+ hLimit 25 $+ vLimit 15 $+ L.renderList l+ ui = C.vCenter $ vBox [ C.hCenter box+ , " "+ , C.hCenter "Press +/- to add/remove list elements."+ , C.hCenter "Press Esc to exit."+ ]++appEvent :: L.List Int -> V.Event -> M.EventM (M.Next (L.List Int))+appEvent l e =+ case e of+ V.EvKey (V.KChar '+') [] ->+ let el = length $ l^.(L.listElementsL)+ in M.continue $ L.listInsert el 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 $ T.handleEvent ev l++listDrawElement :: Bool -> Int -> Widget+listDrawElement sel i =+ let selStr s = if sel+ then withAttr customAttr (str $ "<" <> s <> ">")+ else str s+ in C.hCenter $ "Item " <+> (selStr $ show i)++initialState :: L.List Int+initialState = L.list (T.Name "list") listDrawElement [0, 1, 2]++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 Int) V.Event+theApp =+ M.App { M.appDraw = drawUI+ , M.appChooseCursor = M.showFirstCursor+ , M.appHandleEvent = appEvent+ , M.appStartEvent = return+ , M.appAttrMap = const theMap+ , M.appLiftVtyEvent = id+ }++main :: IO ()+main = void $ M.defaultMain theApp initialState
+ programs/MarkupDemo.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Data.Monoid ((<>))+import qualified Graphics.Vty as V++import Brick.Main (App(..), defaultMain, resizeOrQuit, neverShowCursor)+import Brick.Widgets.Core+ ( Widget+ , (<=>)+ )+import Brick.Util (on, fg)+import Brick.Markup (markup, (@?))+import Brick.AttrMap (attrMap, AttrMap)+import Data.Text.Markup ((@@))++ui :: Widget+ui = m1 <=> m2+ where+ m1 = markup $ ("Hello" @@ fg V.blue) <> ", " <> ("world!" @@ fg V.red)+ m2 = markup $ ("Hello" @? "keyword1") <> ", " <> ("world!" @? "keyword2")++theMap :: AttrMap+theMap = attrMap V.defAttr+ [ ("keyword1", fg V.magenta)+ , ("keyword2", V.white `on` V.blue)+ ]++app :: App () V.Event+app =+ App { appDraw = const [ui]+ , appHandleEvent = resizeOrQuit+ , appAttrMap = const theMap+ , appStartEvent = return+ , appChooseCursor = neverShowCursor+ , appLiftVtyEvent = id+ }++main :: IO ()+main = defaultMain app ()
+ programs/PaddingDemo.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Data.Default+import qualified Graphics.Vty as V++import Brick.Main (App(..), neverShowCursor, resizeOrQuit, defaultMain)+import Brick.Widgets.Core+ ( Widget+ , vBox+ , hBox+ , Padding(..)+ , padAll+ , padLeft+ , padRight+ , padTop+ , padBottom+ , padTopBottom+ , padLeftRight+ )+import Brick.Widgets.Border as B+import Brick.Widgets.Center as C++ui :: Widget+ui =+ vBox [ hBox [ padLeft Max $ vCenter "Left-padded"+ , B.vBorder+ , padRight Max $ vCenter "Right-padded"+ ]+ , B.hBorder+ , hBox [ padTop Max $ hCenter "Top-padded"+ , B.vBorder+ , padBottom Max $ hCenter "Bottom-padded"+ ]+ , B.hBorder+ , hBox [ padLeftRight 2 "Padded by 2 on left/right"+ , B.vBorder+ , vBox [ padTopBottom 1 "Padded by 1 on top/bottom"+ , B.hBorder+ ]+ ]+ , B.hBorder+ , padAll 2 "Padded by 2 on all sides"+ ]++app :: App () V.Event+app =+ App { appDraw = const [ui]+ , appHandleEvent = resizeOrQuit+ , appStartEvent = return+ , appAttrMap = const def+ , appChooseCursor = neverShowCursor+ , appLiftVtyEvent = id+ }++main :: IO ()+main = defaultMain app ()
+ programs/SuspendAndResumeDemo.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Control.Lens (makeLenses, (.~), (^.), (&))+import Control.Monad (void)+import Data.Monoid+import Data.Default+import qualified Graphics.Vty as V++import Brick.Main+ ( App(..), neverShowCursor, defaultMain+ , suspendAndResume, halt, continue+ , EventM, Next+ )+import Brick.Widgets.Core+ ( Widget+ , vBox+ , str+ )++data St =+ St { _stExternalInput :: String+ }++makeLenses ''St++drawUI :: St -> [Widget]+drawUI st = [ui]+ where+ ui = vBox [ str $ "External input: \"" <> st^.stExternalInput <> "\""+ , "(Press Esc to quit or Space to ask for input)"+ ]++appEvent :: St -> V.Event -> EventM (Next St)+appEvent st 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++initialState :: St+initialState =+ St { _stExternalInput = ""+ }++theApp :: App St V.Event+theApp =+ App { appDraw = drawUI+ , appChooseCursor = neverShowCursor+ , appHandleEvent = appEvent+ , appStartEvent = return+ , appAttrMap = const def+ , appLiftVtyEvent = id+ }++main :: IO ()+main = do+ void $ defaultMain theApp initialState
+ programs/ViewportScrollDemo.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Control.Applicative+import Control.Monad (void)+import Data.Monoid+import Data.Default+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.Widgets.Core+ ( Widget+ , ViewportType(Horizontal, Vertical, Both)+ , hLimit+ , vLimit+ , hBox+ , vBox+ , viewport+ , str+ )++vp1Name :: T.Name+vp1Name = "demo1"++vp2Name :: T.Name+vp2Name = "demo2"++vp3Name :: T.Name+vp3Name = "demo3"++drawUi :: () -> [Widget]+drawUi = const [ui]+ where+ ui = C.center $ B.border $ hLimit 60 $ vLimit 21 $+ vBox [ pair, B.hBorder, singleton ]+ singleton = viewport vp3Name Both $+ vBox $ "Press ctrl-arrow keys to scroll this viewport horizontally and vertically."+ : (str <$> [ "Line " <> show i | i <- [2..25::Int] ])+ pair = hBox [ viewport vp1Name Vertical $+ vBox $ "Press up and down arrow keys" :+ "to scroll this viewport." :+ (str <$> [ "Line " <> (show i) | i <- [3..50::Int] ])+ , B.vBorder+ , viewport vp2Name Horizontal+ "Press left and right arrow keys to scroll this viewport."+ ]++vp1Scroll :: M.ViewportScroll+vp1Scroll = M.viewportScroll vp1Name++vp2Scroll :: M.ViewportScroll+vp2Scroll = M.viewportScroll vp2Name++vp3Scroll :: M.ViewportScroll+vp3Scroll = M.viewportScroll vp3Name++appEvent :: () -> V.Event -> M.EventM (M.Next ())+appEvent _ (V.EvKey V.KDown [V.MCtrl]) = M.vScrollBy vp3Scroll 1 >> M.continue ()+appEvent _ (V.EvKey V.KUp [V.MCtrl]) = M.vScrollBy vp3Scroll (-1) >> M.continue ()+appEvent _ (V.EvKey V.KRight [V.MCtrl]) = M.hScrollBy vp3Scroll 1 >> M.continue ()+appEvent _ (V.EvKey V.KLeft [V.MCtrl]) = M.hScrollBy vp3Scroll (-1) >> M.continue ()+appEvent _ (V.EvKey V.KDown []) = M.vScrollBy vp1Scroll 1 >> M.continue ()+appEvent _ (V.EvKey V.KUp []) = M.vScrollBy vp1Scroll (-1) >> M.continue ()+appEvent _ (V.EvKey V.KRight []) = M.hScrollBy vp2Scroll 1 >> M.continue ()+appEvent _ (V.EvKey V.KLeft []) = M.hScrollBy vp2Scroll (-1) >> M.continue ()+appEvent _ (V.EvKey V.KEsc []) = M.halt ()+appEvent _ _ = M.continue ()++app :: M.App () V.Event+app =+ M.App { M.appDraw = drawUi+ , M.appStartEvent = return+ , M.appHandleEvent = appEvent+ , M.appAttrMap = const def+ , M.appLiftVtyEvent = id+ , M.appChooseCursor = M.neverShowCursor+ }++main :: IO ()+main = void $ M.defaultMain app ()
+ programs/VisibilityDemo.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Control.Monad (void)+import Control.Lens+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.Widgets.Core+ ( Widget+ , ViewportType(Horizontal, Vertical, Both)+ , withAttr+ , hLimit+ , vLimit+ , hBox+ , vBox+ , viewport+ , str+ , visible+ )++data St =+ St { _vp1Index :: Int+ , _vp2Index :: Int+ , _vp3Index :: (Int, Int)+ }++makeLenses ''St++vp1Name :: T.Name+vp1Name = "demo1"++vp1Size :: Int+vp1Size = 15++vp2Name :: T.Name+vp2Name = "demo2"++vp2Size :: Int+vp2Size = 15++vp3Name :: T.Name+vp3Name = "demo3"++vp3Size :: (Int, Int)+vp3Size = (25, 25)++selectedAttr :: AttrName+selectedAttr = "selected"++drawUi :: St -> [Widget]+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 vp3Name 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 vp1Name 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 vp2Name 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+vp1Scroll = M.viewportScroll vp1Name++vp2Scroll :: M.ViewportScroll+vp2Scroll = M.viewportScroll vp2Name++vp3Scroll :: M.ViewportScroll+vp3Scroll = M.viewportScroll vp3Name++appEvent :: St -> V.Event -> M.EventM (M.Next St)+appEvent st (V.EvKey V.KDown [V.MCtrl]) = M.continue $ st & vp3Index._1 %~ min (vp3Size^._1) . (+ 1)+appEvent st (V.EvKey V.KUp [V.MCtrl]) = M.continue $ st & vp3Index._1 %~ max 1 . subtract 1+appEvent st (V.EvKey V.KRight [V.MCtrl]) = M.continue $ st & vp3Index._2 %~ min (vp3Size^._1) . (+ 1)+appEvent st (V.EvKey V.KLeft [V.MCtrl]) = M.continue $ st & vp3Index._2 %~ max 1 . subtract 1+appEvent st (V.EvKey V.KDown []) = M.continue $ st & vp1Index %~ min vp1Size . (+ 1)+appEvent st (V.EvKey V.KUp []) = M.continue $ st & vp1Index %~ max 1 . subtract 1+appEvent st (V.EvKey V.KRight []) = M.continue $ st & vp2Index %~ min vp2Size . (+ 1)+appEvent st (V.EvKey V.KLeft []) = M.continue $ st & vp2Index %~ max 1 . subtract 1+appEvent st (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 V.Event+app =+ M.App { M.appDraw = drawUi+ , M.appStartEvent = return+ , M.appHandleEvent = appEvent+ , M.appAttrMap = const theMap+ , M.appLiftVtyEvent = id+ , M.appChooseCursor = M.neverShowCursor+ }++initialState :: St+initialState = St 1 1 (1, 1)++main :: IO ()+main = void $ M.defaultMain app initialState
+ src/Brick/AttrMap.hs view
@@ -0,0 +1,168 @@+-- | 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+ )+where++import Control.Applicative ((<$>))+import qualified Data.Map as M+import Data.Monoid+import Data.Maybe (catMaybes)+import Data.List (inits)+import Data.String (IsString(..))+import Data.Default (Default(..))++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 Default AttrName where+ def = mempty++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++instance Default AttrMap where+ def = AttrMap def mempty++-- | 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)
+ src/Brick/Focus.hs view
@@ -0,0 +1,68 @@+-- | 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 widget names; it does not do+-- anything beyond keep track of that.+--+-- This interface is experimental.+module Brick.Focus+ ( FocusRing+ , focusRing+ , focusNext+ , focusPrev+ , focusGetCurrent+ , focusRingCursor+ )+where++import Control.Lens ((^.))+import Data.Maybe (listToMaybe)++import Brick.Types++-- | A focus ring containing a sequence of widget names to focus and a+-- currently-focused widget name.+data FocusRing = FocusRingEmpty+ | FocusRingNonempty ![Name] !Int++-- | Construct a focus ring from the list of names.+focusRing :: [Name] -> FocusRing+focusRing [] = FocusRingEmpty+focusRing names = FocusRingNonempty names 0++-- | Advance focus to the next widget in the ring.+focusNext :: FocusRing -> FocusRing+focusNext FocusRingEmpty = FocusRingEmpty+focusNext (FocusRingNonempty ns i) = FocusRingNonempty ns i'+ where+ i' = (i + 1) `mod` (length ns)++-- | Advance focus to the previous widget in the ring.+focusPrev :: FocusRing -> FocusRing+focusPrev FocusRingEmpty = FocusRingEmpty+focusPrev (FocusRingNonempty ns i) = FocusRingNonempty ns i'+ where+ i' = (i + (length ns) - 1) `mod` (length ns)++-- | Get the currently-focused widget name from the ring. If the ring is+-- emtpy, return 'Nothing'.+focusGetCurrent :: FocusRing -> Maybe Name+focusGetCurrent FocusRingEmpty = Nothing+focusGetCurrent (FocusRingNonempty ns i) = Just $ ns !! i++-- | Cursor selection convenience function for use as an+-- 'Brick.Main.appChooseCursor' value.+focusRingCursor :: (a -> FocusRing)+ -- ^ The function used to get the focus ring out of your+ -- application state.+ -> a+ -- ^ Your application state.+ -> [CursorLocation]+ -- ^ The list of available cursor positions.+ -> Maybe CursorLocation+ -- ^ The cursor position, if any, that matches the name+ -- currently focused by the 'FocusRing'.+focusRingCursor getRing st ls =+ listToMaybe $ filter isCurrent ls+ where+ isCurrent cl = cl^.cursorLocationNameL ==+ (focusGetCurrent $ getRing st)
+ src/Brick/Main.hs view
@@ -0,0 +1,305 @@+module Brick.Main+ ( App(..)+ , defaultMain+ , customMain+ , simpleMain+ , resizeOrQuit++ -- * Event handler functions+ , EventM+ , Next+ , continue+ , halt+ , suspendAndResume++ -- ** Viewport scrolling+ , viewportScroll+ , ViewportScroll+ , vScrollBy+ , vScrollPage+ , vScrollToBeginning+ , vScrollToEnd+ , hScrollBy+ , hScrollPage+ , hScrollToBeginning+ , hScrollToEnd++ -- * Cursor management functions+ , neverShowCursor+ , showFirstCursor+ , showCursorNamed+ )+where++import Control.Exception (finally)+import Control.Lens ((^.))+import Control.Monad (forever)+import Control.Monad.Trans.State+import Control.Concurrent (forkIO, Chan, newChan, readChan, writeChan, killThread)+import Data.Default+import Data.Maybe (listToMaybe)+import qualified Data.Map as M+import Graphics.Vty+ ( Vty+ , Picture(..)+ , Cursor(..)+ , Event(..)+ , update+ , outputIface+ , displayBounds+ , shutdown+ , nextEvent+ , mkVty+ )++import Brick.Widgets.Core (Widget)+import Brick.Widgets.Internal (renderFinal, RenderState(..), ScrollRequest(..), Direction(..))+import Brick.Types (rowL, columnL, CursorLocation(..), cursorLocationNameL, Name(..))+import Brick.AttrMap++-- | The type of actions to take in an event handler.+data Next a = Continue a+ | SuspendAndResume (IO a)+ | Halt a++-- | 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' and an application event type 'e'. In the simplest case 'e' is+-- vty's 'Event' type, but you may define your own event type, permitted+-- that it has a constructor for wrapping Vty events, so that Vty events+-- can be handled by your event loop.+data App s e =+ App { appDraw :: s -> [Widget]+ -- ^ This function turns your application state into a list of+ -- widget layers. The layers are listed topmost first.+ , appChooseCursor :: s -> [CursorLocation] -> Maybe CursorLocation+ -- ^ 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 -> e -> EventM (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 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.+ , appLiftVtyEvent :: Event -> e+ -- ^ The event constructor to use to wrap Vty events in your own+ -- event type. For example, if the application's event type is+ -- 'Event', this is just 'id'.+ }++-- | The monad in which event handlers run.+type EventM a = StateT EventState IO a++type EventState = [(Name, ScrollRequest)]++-- | The default main entry point which takes an application and an+-- initial state and returns the final state returned by a 'halt'+-- operation.+defaultMain :: App s Event+ -- ^ The application.+ -> s+ -- ^ The initial application state.+ -> IO s+defaultMain app st = do+ chan <- newChan+ customMain (mkVty def) chan 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 :: Widget+ -- ^ The widget to draw.+ -> IO ()+simpleMain w =+ let app = App { appDraw = const [w]+ , appHandleEvent = resizeOrQuit+ , appStartEvent = return+ , appAttrMap = def+ , appLiftVtyEvent = id+ , 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 -> Event -> EventM (Next s)+resizeOrQuit s (EvResize _ _) = continue s+resizeOrQuit s _ = halt s++data InternalNext a = InternalSuspendAndResume RenderState (IO a)+ | InternalHalt a++runWithNewVty :: IO Vty -> Chan e -> App s e -> RenderState -> s -> IO (InternalNext s)+runWithNewVty buildVty chan app initialRS initialSt = do+ withVty buildVty $ \vty -> do+ pid <- forkIO $ supplyVtyEvents vty (appLiftVtyEvent app) chan+ let runInner rs st = do+ (result, newRS) <- runVty vty chan app st rs+ 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 :: 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.+ -> Chan e+ -- ^ An event channel for sending custom events to the event+ -- loop (you write to this channel, the event loop reads from+ -- it).+ -> App s e+ -- ^ The application.+ -> s+ -- ^ The initial application state.+ -> IO s+customMain buildVty chan app initialAppState = do+ let run rs st = do+ result <- runWithNewVty buildVty chan app rs st+ case result of+ InternalHalt s -> return s+ InternalSuspendAndResume newRS action -> do+ newAppState <- action+ run newRS newAppState++ (st, initialScrollReqs) <- runStateT (appStartEvent app initialAppState) []+ let initialRS = RS M.empty initialScrollReqs+ run initialRS st++supplyVtyEvents :: Vty -> (Event -> e) -> Chan e -> IO ()+supplyVtyEvents vty mkEvent chan =+ forever $ do+ e <- nextEvent vty+ writeChan chan $ mkEvent e++runVty :: Vty -> Chan e -> App s e -> s -> RenderState -> IO (Next s, RenderState)+runVty vty chan app appState rs = do+ firstRS <- renderApp vty app appState rs+ e <- readChan chan+ (next, scrollReqs) <- runStateT (appHandleEvent app appState e) []+ return (next, firstRS { scrollRequests = scrollReqs })++withVty :: IO Vty -> (Vty -> IO a) -> IO a+withVty buildVty useVty = do+ vty <- buildVty+ useVty vty `finally` shutdown vty++renderApp :: Vty -> App s e -> s -> RenderState -> IO RenderState+renderApp vty app appState rs = do+ sz <- displayBounds $ outputIface vty+ let (newRS, pic, theCursor) = renderFinal (appAttrMap app appState)+ (appDraw app appState)+ sz+ (appChooseCursor app appState)+ rs+ picWithCursor = case theCursor of+ Nothing -> pic { picCursor = NoCursor }+ Just loc -> pic { picCursor = Cursor (loc^.columnL) (loc^.rowL) }++ update vty picWithCursor++ return newRS++-- | 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] -> Maybe CursorLocation+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] -> Maybe CursorLocation+showFirstCursor = const listToMaybe++-- | Show the cursor with the specified name, if such a cursor location+-- has been reported.+showCursorNamed :: Name -> [CursorLocation] -> Maybe CursorLocation+showCursorNamed name locs =+ let matches loc = loc^.cursorLocationNameL == Just name+ in listToMaybe $ filter matches locs++-- | A viewport scrolling handle for managing the scroll state of+-- viewports.+data ViewportScroll =+ ViewportScroll { viewportName :: Name+ -- ^ The name of the viewport to be controlled by+ -- this scrolling handle.+ , hScrollPage :: Direction -> EventM ()+ -- ^ Scroll the viewport horizontally by one page in+ -- the specified direction.+ , hScrollBy :: Int -> EventM ()+ -- ^ Scroll the viewport horizontally by the+ -- specified number of rows or columns depending on+ -- the orientation of the viewport.+ , hScrollToBeginning :: EventM ()+ -- ^ Scroll horizontally to the beginning of the+ -- viewport.+ , hScrollToEnd :: EventM ()+ -- ^ Scroll horizontally to the end of the viewport.+ , vScrollPage :: Direction -> EventM ()+ -- ^ Scroll the viewport vertically by one page in+ -- the specified direction.+ , vScrollBy :: Int -> EventM ()+ -- ^ Scroll the viewport vertically by the specified+ -- number of rows or columns depending on the+ -- orientation of the viewport.+ , vScrollToBeginning :: EventM ()+ -- ^ Scroll vertically to the beginning of the viewport.+ , vScrollToEnd :: EventM ()+ -- ^ Scroll vertically to the end of the viewport.+ }++-- | Build a viewport scroller for the viewport with the specified name.+viewportScroll :: Name -> ViewportScroll+viewportScroll n =+ ViewportScroll { viewportName = n+ , hScrollPage = \dir -> modify ((n, HScrollPage dir) :)+ , hScrollBy = \i -> modify ((n, HScrollBy i) :)+ , hScrollToBeginning = modify ((n, HScrollToBeginning) :)+ , hScrollToEnd = modify ((n, HScrollToEnd) :)+ , vScrollPage = \dir -> modify ((n, HScrollPage dir) :)+ , vScrollBy = \i -> modify ((n, VScrollBy i) :)+ , vScrollToBeginning = modify ((n, VScrollToBeginning) :)+ , vScrollToEnd = modify ((n, VScrollToEnd) :)+ }++-- | Continue running the event loop with the specified application+-- state.+continue :: s -> EventM (Next s)+continue = return . Continue++-- | Halt the event loop and return the specified application state as+-- the final state value.+halt :: s -> EventM (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 (Next s)+suspendAndResume = return . SuspendAndResume
+ src/Brick/Markup.hs view
@@ -0,0 +1,54 @@+-- | 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 Control.Lens ((.~), (&), (^.))+import Control.Monad (forM)+import qualified Data.Text as T+import Data.Text.Markup+import Data.Default (def)++import Graphics.Vty (Attr, horizCat, string)++import Brick.Widgets.Core+import Brick.AttrMap++-- | 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 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+markup m =+ Widget Fixed Fixed $ do+ let pairs = markupToList m+ imgs <- forM pairs $ \(t, aSrc) -> do+ a <- getAttr aSrc+ return $ string a $ T.unpack t+ return $ def & imageL .~ horizCat imgs
+ src/Brick/Types.hs view
@@ -0,0 +1,89 @@+-- | Basic types used by this library.+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Brick.Types+ ( Location(..)+ , locL+ , TerminalLocation(..)+ , CursorLocation(..)+ , cursorLocationL+ , cursorLocationNameL+ , HandleEvent(..)+ , Name(..)+ , suffixLenses+ )+where++import Control.Lens+import Data.String+import Data.Monoid (Monoid(..))+import Graphics.Vty (Event)++import Brick.Types.TH++-- | A terminal screen location.+data Location = Location { loc :: (Int, Int)+ -- ^ (Column, Row)+ }+ deriving Show++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+ columnL :: Lens' a Int+ column :: a -> Int+ -- | Get the row out of the value+ rowL :: Lens' a Int+ row :: a -> Int++instance TerminalLocation Location where+ columnL = _1+ column (Location t) = fst t+ rowL = _2+ row (Location t) = snd t++-- | Names of things. Used to name cursor locations, widgets, and+-- viewports.+newtype Name = Name String+ deriving (Eq, Show, Ord)++instance IsString Name where+ fromString = Name++-- | 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 =+ CursorLocation { cursorLocation :: !Location+ -- ^ The location+ , cursorLocationName :: !(Maybe Name)+ -- ^ The name of the widget associated with the location+ }+ deriving Show++suffixLenses ''CursorLocation++instance TerminalLocation CursorLocation where+ columnL = cursorLocationL._1+ column = column . cursorLocation+ rowL = cursorLocationL._2+ row = row . cursorLocation++-- | The class of types that provide some basic event-handling.+class HandleEvent a where+ -- | Handle a Vty event+ handleEvent :: Event -> a -> a
+ src/Brick/Types/TH.hs view
@@ -0,0 +1,18 @@+module Brick.Types.TH+ ( suffixLenses+ )+where++import qualified Language.Haskell.TH.Syntax as TH+import qualified Language.Haskell.TH.Lib as TH++import Control.Lens (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"])
+ src/Brick/Util.hs view
@@ -0,0 +1,59 @@+-- | Utility functions.+module Brick.Util+ ( clamp+ , on+ , fg+ , bg+ , clOffset+ )+where++import Control.Lens ((&), (%~))+import Data.Monoid ((<>))+import Graphics.Vty++import Brick.Types (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 -> Location -> CursorLocation+clOffset cl off = cl & cursorLocationL %~ (<> off)
+ src/Brick/Widgets/Border.hs view
@@ -0,0 +1,142 @@+{-# 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 Control.Applicative ((<$>))+import Control.Lens ((^.), to)+import Data.Monoid ((<>))+import Graphics.Vty (imageHeight, imageWidth)++import Brick.AttrMap+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+borderElem f =+ Widget Fixed Fixed $ do+ bs <- ctxBorderStyle <$> getContext+ render $ withAttr borderAttr $ str [f bs]++-- | Put a border around the specified widget.+border :: Widget -> Widget+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+ -- ^ The label widget+ -> Widget+ -- ^ The widget to put a border around+ -> Widget+borderWithLabel label = border_ (Just label)++border_ :: Maybe Widget -> Widget -> Widget+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+hBorder = hBorder_ Nothing++-- | A horizontal border with a label placed in the center of the+-- border. Fills all horizontal space.+hBorderWithLabel :: Widget+ -- ^ The label widget+ -> Widget+hBorderWithLabel label = hBorder_ (Just label)++hBorder_ :: Maybe Widget -> Widget+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+vBorder =+ Widget Fixed Greedy $ do+ bs <- ctxBorderStyle <$> getContext+ render $ hLimit 1 $ withAttr vBorderAttr $ fill (bsVertical bs)
+ src/Brick/Widgets/Border/Style.hs view
@@ -0,0 +1,123 @@+{-# 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+ )+where++import Data.Default++-- | 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)++instance Default BorderStyle where+ def = 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 = '│'+ }
+ src/Brick/Widgets/Center.hs view
@@ -0,0 +1,108 @@+-- | This module provides combinators for centering other widgets.+module Brick.Widgets.Center+ ( -- * Centering horizontally+ hCenter+ , hCenterWith+ -- * Centering vertically+ , vCenter+ , vCenterWith+ -- * Centering both horizontally and vertically+ , center+ , centerWith+ -- * Centering about an arbitrary origin+ , centerAbout+ )+where++import Control.Lens ((^.), (&), (.~), to)+import Graphics.Vty (imageWidth, imageHeight, horizCat, charFill, vertCat)++import Brick.Types+import Brick.Widgets.Core++-- | Center the specified widget horizontally. Consumes all available+-- horizontal space.+hCenter :: Widget -> Widget+hCenter = hCenterWith Nothing++-- | 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 -> Widget+hCenterWith mChar p =+ let ch = maybe ' ' id mChar+ in Widget Greedy (vSize p) $ do+ result <- render p+ c <- getContext+ let rWidth = result^.imageL.to imageWidth+ rHeight = result^.imageL.to imageHeight+ remainder = c^.availWidthL - (leftPaddingAmount * 2)+ leftPaddingAmount = (c^.availWidthL - rWidth) `div` 2+ rightPaddingAmount = 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 -> Widget+vCenter = vCenterWith Nothing++-- | 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 -> Widget+vCenterWith mChar p =+ let ch = maybe ' ' id mChar+ in Widget (hSize p) Greedy $ do+ result <- render p+ c <- getContext+ let rWidth = result^.imageL.to imageWidth+ rHeight = result^.imageL.to imageHeight+ remainder = c^.availHeightL - (topPaddingAmount * 2)+ topPaddingAmount = (c^.availHeightL - rHeight) `div` 2+ bottomPaddingAmount = 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 -> Widget+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 -> Widget+centerWith c = vCenterWith c . hCenterWith c++-- | Center the widget horizontally and vertically about the specified+-- origin.+centerAbout :: Location -> Widget -> Widget+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^.columnL+ , centerH - l^.rowL+ )+ render $ translateBy off p
+ src/Brick/Widgets/Core.hs view
@@ -0,0 +1,96 @@+-- | 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+ ( Widget(..)+ , Size(..)++ -- * Basic rendering primitives+ , emptyWidget+ , raw+ , txt+ , str+ , fill++ -- * Padding+ , Padding(..)+ , padLeft+ , padRight+ , padTop+ , padBottom+ , padLeftRight+ , padTopBottom+ , padAll++ -- * Box layout+ , (<=>)+ , (<+>)+ , hBox+ , vBox++ -- * Limits+ , hLimit+ , vLimit++ -- * Attribute mangement+ , withDefAttr+ , withAttr+ , forceAttr+ , updateAttrMap++ -- * Border style management+ , withBorderStyle++ -- * Cursor placement+ , showCursor++ -- * Translation+ , translateBy++ -- * Cropping+ , cropLeftBy+ , cropRightBy+ , cropTopBy+ , cropBottomBy++ -- * Scrollable viewports+ , ViewportType(..)+ , viewport+ , visible+ , visibleRegion++ -- * Rendering infrastructure+ , RenderM+ , getContext+ , lookupAttrName++ -- ** The rendering context+ , Context(ctxAttrName, availWidth, availHeight, ctxBorderStyle, ctxAttrMap)+ , attrL+ , availWidthL+ , availHeightL+ , ctxAttrMapL+ , ctxAttrNameL+ , ctxBorderStyleL++ -- ** Rendering results+ , Result(..)+ -- ** Result lenses+ , imageL+ , cursorsL+ , visibilityRequestsL+ -- ** Visibility requests+ , VisibilityRequest(..)+ , vrPositionL+ , vrSizeL+ -- ** Adding offsets to cursor positions and visibility requests+ , addResultOffset+ -- ** Cropping results+ , cropToContext++ -- * Misc+ , Direction(..)+ )+where++import Brick.Widgets.Internal
+ src/Brick/Widgets/Dialog.hs view
@@ -0,0 +1,141 @@+{-# 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+ , dialogName+ , dialogButtons+ , dialogSelectedIndex+ , dialogWidth+ -- * Construction and rendering+ , dialog+ , renderDialog+ -- * Getting a dialog's current value+ , dialogSelection+ -- * Attributes+ , dialogAttr+ , buttonAttr+ , buttonSelectedAttr+ -- * Lenses+ , dialogNameL+ , dialogButtonsL+ , dialogSelectedIndexL+ , dialogWidthL+ , dialogTitleL+ )+where++import Control.Lens+import Control.Applicative+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). They provide a 'HandleEvent' instance that knows+-- about Tab and Shift-Tab for changing which button is active. Dialog+-- buttons are labeled with strings and map to values of type 'a', which+-- you choose.+--+-- Dialogs handle the following events by default:+--+-- * Tab: selecte the next button+-- * Shift-tab: select the previous button+data Dialog a =+ Dialog { dialogName :: Name+ -- ^ The dialog name+ , 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++instance HandleEvent (Dialog a) where+ handleEvent ev d =+ case ev of+ EvKey (KChar '\t') [] -> nextButtonBy 1 d+ EvKey KBackTab [] -> nextButtonBy (-1) d+ _ -> d++-- | Create a dialog.+dialog :: Name+ -- ^ The dialog name, provided so that you can use this as a+ -- basis for viewport names in the dialog if desired+ -> 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 name 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 name 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.+renderDialog :: Dialog a -> Widget -> Widget+renderDialog d body =+ let buttonPadding = " "+ 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 center $+ 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
+ src/Brick/Widgets/Edit.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+-- | This module provides a basic single-line 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 'HandleEvent' instance handles a set of basic input+-- events that should suffice for most purposes; see the source for a+-- complete list.+module Brick.Widgets.Edit+ ( Editor(editContents, editorName, editDrawContents)+ -- * Constructing an editor+ , editor+ -- * Reading editor contents+ , getEditContents+ -- * Editing text+ , applyEdit+ -- * Lenses for working with editors+ , editContentsL+ , editDrawContentsL+ -- * Rendering editors+ , renderEditor+ -- * Attributes+ , editAttr+ )+where++import Control.Lens+import Graphics.Vty (Event(..), Key(..), Modifier(..))++import qualified Data.Text.Zipper 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+-- * Arrow keys: move cursor+-- * Enter: break the current line at the cursor position+data Editor =+ Editor { editContents :: Z.TextZipper String+ -- ^ The contents of the editor+ , editDrawContents :: [String] -> Widget+ -- ^ The function the editor uses to draw its contents+ , editorName :: Name+ -- ^ The name of the editor+ }++suffixLenses ''Editor++instance HandleEvent Editor where+ handleEvent 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 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 applyEdit f ed++-- | Construct an editor.+editor :: Name+ -- ^ The editor's name (must be unique)+ -> ([String] -> Widget)+ -- ^ The content rendering function+ -> Maybe Int+ -- ^ The limit on the number of lines in the editor ('Nothing'+ -- means no limit)+ -> String+ -- ^ The initial content+ -> Editor+editor name draw limit s = Editor (Z.stringZipper [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 String -> Z.TextZipper String)+ -- ^ The 'Data.Text.Zipper' editing transformation to apply+ -> Editor+ -> Editor+applyEdit f e = e & editContentsL %~ f++-- | The attribute assigned to the editor+editAttr :: AttrName+editAttr = "edit"++-- | Get the contents of the editor.+getEditContents :: Editor -> [String]+getEditContents e = Z.getText $ e^.editContentsL++-- | Turn an editor state value into a widget+renderEditor :: Editor -> Widget+renderEditor e =+ let cp = Z.cursorPosition $ e^.editContentsL+ cursorLoc = Location (cp^._2, cp^._1)+ limit = case e^.editContentsL.to Z.getLineLimit of+ Nothing -> id+ Just lim -> vLimit lim+ in withAttr editAttr $+ limit $+ viewport (e^.editorNameL) Both $+ showCursor (e^.editorNameL) cursorLoc $+ visibleRegion cursorLoc (1, 1) $+ e^.editDrawContentsL $+ getEditContents e
+ src/Brick/Widgets/Internal.hs view
@@ -0,0 +1,877 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TemplateHaskell #-}+module Brick.Widgets.Internal+ ( Result(..)+ , visibilityRequestsL+ , imageL+ , cursorsL+ , addResultOffset++ , VisibilityRequest(..)+ , vrPositionL+ , vrSizeL++ , RenderState(..)+ , ScrollRequest(..)+ , Direction(..)++ , renderFinal+ , Widget(..)+ , Size(..)+ , RenderM++ , Context(ctxAttrName, availWidth, availHeight, ctxBorderStyle, ctxAttrMap)+ , lookupAttrName+ , getContext+ , attrL+ , availWidthL+ , availHeightL+ , ctxAttrMapL+ , ctxAttrNameL+ , ctxBorderStyleL+ , cropToContext++ , withBorderStyle++ , ViewportType(..)++ , txt+ , str+ , fill++ , Padding(..)+ , padLeft+ , padRight+ , padTop+ , padBottom+ , padLeftRight+ , padTopBottom+ , padAll++ , emptyWidget+ , hBox+ , vBox+ , (<=>)+ , (<+>)++ , hLimit+ , vLimit+ , withDefAttr+ , withAttr+ , forceAttr+ , updateAttrMap+ , raw+ , translateBy+ , cropLeftBy+ , cropRightBy+ , cropTopBy+ , cropBottomBy+ , showCursor+ , viewport+ , visible+ , visibleRegion+ )+where++import Control.Applicative+import Control.Lens (makeLenses, (^.), (.~), (&), (%~), to, _1, _2, each, to, ix)+import Control.Monad (when)+import Control.Monad.Trans.State.Lazy+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Class (lift)+import qualified Data.Text as T+import Data.Default+import Data.Functor.Contravariant+import Data.Monoid ((<>), mempty)+import qualified Data.Map as M+import qualified Data.Function as DF+import Data.List (sortBy, partition)+import Control.Lens (Lens')+import Data.String (IsString(..))+import qualified Graphics.Vty as V++import Brick.Types+import Brick.Widgets.Border.Style+import Brick.Util (clOffset)+import Brick.AttrMap+import Brick.Util (clamp)++data VisibilityRequest =+ VR { vrPosition :: Location+ , vrSize :: V.DisplayRegion+ }+ 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++data Viewport =+ VP { _vpLeft :: Int+ , _vpTop :: Int+ , _vpSize :: V.DisplayRegion+ }+ 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 =+ Result { image :: V.Image+ -- ^ The final rendered image for a widget+ , cursors :: [CursorLocation]+ -- ^ 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)+ }+ deriving Show++-- | 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 bordring style should be used, and the attribute map+-- available for rendering.+data Context =+ Context { ctxAttrName :: AttrName+ , availWidth :: Int+ , availHeight :: Int+ , ctxBorderStyle :: BorderStyle+ , ctxAttrMap :: AttrMap+ }++-- | 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 a = ReaderT Context (State RenderState) a++-- | 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 =+ Widget { hSize :: Size+ -- ^ This widget's horizontal growth policy+ , vSize :: Size+ -- ^ This widget's vertical growth policy+ , render :: RenderM Result+ -- ^ This widget's rendering function+ }++-- | Scrolling direction.+data Direction = Up+ -- ^ Up/left+ | Down+ -- ^ Down/right++data ScrollRequest = HScrollBy Int+ | HScrollPage Direction+ | HScrollToBeginning+ | HScrollToEnd+ | VScrollBy Int+ | VScrollPage Direction+ | VScrollToBeginning+ | VScrollToEnd++data RenderState =+ RS { viewportMap :: M.Map Name Viewport+ , scrollRequests :: [(Name, ScrollRequest)]+ }++suffixLenses ''Result+suffixLenses ''Context+suffixLenses ''VisibilityRequest+suffixLenses ''RenderState++makeLenses ''Viewport++instance IsString Widget where+ fromString = str++instance Default Result where+ def = Result V.emptyImage [] []++-- | Get the current rendering context.+getContext :: RenderM Context+getContext = ask++-- | When rendering the specified widget, use the specified border style+-- for any border rendering.+withBorderStyle :: BorderStyle -> Widget -> Widget+withBorderStyle bs p = Widget (hSize p) (vSize p) $ withReaderT (& ctxBorderStyleL .~ bs) (render p)++-- | The empty widget.+emptyWidget :: Widget+emptyWidget = raw V.emptyImage++renderFinal :: AttrMap+ -> [Widget]+ -> V.DisplayRegion+ -> ([CursorLocation] -> Maybe CursorLocation)+ -> RenderState+ -> (RenderState, V.Picture, Maybe CursorLocation)+renderFinal aMap layerRenders sz chooseCursor rs = (newRS, pic, theCursor)+ where+ (layerResults, newRS) = flip runState rs $ sequence $+ (\p -> runReaderT p ctx) <$>+ (render <$> cropToContext <$> layerRenders)+ ctx = Context def (fst sz) (snd sz) def aMap+ pic = V.picForLayers $ uncurry V.resize sz <$> (^.imageL) <$> layerResults+ layerCursors = (^.cursorsL) <$> layerResults+ theCursor = chooseCursor $ concat layerCursors++-- | Add an offset to all cursor locations and visbility requests+-- 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 -> Result+addResultOffset off = addCursorOffset off . addVisibilityOffset off++addVisibilityOffset :: Location -> Result -> Result+addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)++addCursorOffset :: Location -> Result -> Result+addCursorOffset off r =+ let onlyVisible = filter isVisible+ isVisible l = l^.columnL >= 0 && l^.rowL >= 0+ in r & cursorsL %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs)++unrestricted :: Int+unrestricted = 100000++-- | The rendering context's current drawing attribute.+attrL :: (Contravariant f, Functor f) => (V.Attr -> f V.Attr) -> Context -> f Context+attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL))++-- | Given an attribute name, obtain the attribute for the attribute+-- name by consulting the context's attribute map.+lookupAttrName :: AttrName -> RenderM V.Attr+lookupAttrName n = do+ c <- getContext+ return $ attrMapLookup n (c^.ctxAttrMapL)++-- | 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+str s =+ Widget Fixed Fixed $ do+ c <- getContext+ let theLines = lines s+ fixEmpty [] = " "+ fixEmpty l = l+ case fixEmpty <$> theLines of+ [] -> return def+ [one] -> return $ def & imageL .~ (V.string (c^.attrL) one)+ multiple ->+ let maxLength = maximum $ length <$> multiple+ lineImgs = lineImg <$> multiple+ lineImg lStr = V.string (c^.attrL) (lStr ++ replicate (maxLength - length lStr) ' ')+ in return $ def & imageL .~ (V.vertCat lineImgs)++-- | Build a widget from a 'T.Text' value. Behaves the same as 'str'.+txt :: T.Text -> Widget+txt = str . T.unpack++-- | 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.++-- | Pad the specified widget on the left.+padLeft :: Padding -> Widget -> Widget+padLeft padding p =+ let (f, sz) = case padding of+ Max -> (id, Greedy)+ Pad i -> (hLimit i, hSize p)+ in Widget sz (vSize p) $ do+ result <- render p+ render $ (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ') <+>+ (Widget Fixed Fixed $ return result)++-- | Pad the specified widget on the right.+padRight :: Padding -> Widget -> Widget+padRight padding p =+ let (f, sz) = case padding of+ Max -> (id, Greedy)+ Pad i -> (hLimit i, hSize p)+ in Widget sz (vSize p) $ do+ result <- render p+ render $ (Widget Fixed Fixed $ return result) <+>+ (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ')++-- | Pad the specified widget on the top.+padTop :: Padding -> Widget -> Widget+padTop padding p =+ let (f, sz) = case padding of+ Max -> (id, Greedy)+ Pad i -> (vLimit i, vSize p)+ in Widget (hSize p) sz $ do+ result <- render p+ render $ (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ') <=>+ (Widget Fixed Fixed $ return result)++-- | Pad the specified widget on the bottom.+padBottom :: Padding -> Widget -> Widget+padBottom padding p =+ let (f, sz) = case padding of+ Max -> (id, Greedy)+ Pad i -> (vLimit i, vSize p)+ in Widget (hSize p) sz $ do+ result <- render p+ render $ (Widget Fixed Fixed $ return result) <=>+ (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ')++-- | Pad a widget on the left and right.+padLeftRight :: Int -> Widget -> Widget+padLeftRight c w = padLeft (Pad c) $ padRight (Pad c) w++-- | Pad a widget on the top and bottom.+padTopBottom :: Int -> Widget -> Widget+padTopBottom r w = padTop (Pad r) $ padBottom (Pad r) w++-- | Pad a widget on all sides.+padAll :: Int -> Widget -> Widget+padAll v w = padLeftRight v $ padTopBottom v w++-- | Fill all available space with the specified character. Grows both+-- horizontally and vertically.+fill :: Char -> Widget+fill ch =+ Widget Greedy Greedy $ do+ c <- getContext+ return $ def & 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 both widgets.+vBox :: [Widget] -> Widget+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 both widgets.+hBox :: [Widget] -> Widget+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 =+ BoxRenderer { contextPrimary :: Lens' Context Int+ , contextSecondary :: Lens' Context Int+ , imagePrimary :: V.Image -> Int+ , imageSecondary :: V.Image -> Int+ , limitPrimary :: Int -> Widget -> Widget+ , limitSecondary :: Int -> Widget -> Widget+ , primaryWidgetSize :: Widget -> Size+ , concatenatePrimary :: [V.Image] -> V.Image+ , locationFromOffset :: Int -> Location+ , padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image+ }++vBoxRenderer :: BoxRenderer+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+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 -> [Widget] -> Widget+renderBox br ws = do+ 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++ renderedHis <- mapM (\(i, prim) -> (i,) <$> render prim) 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)++-- | 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.+hLimit :: Int -> Widget -> Widget+hLimit w p =+ Widget Fixed (vSize p) $ do+ 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.+vLimit :: Int -> Widget -> Widget+vLimit h p =+ Widget (hSize p) Fixed $ do+ 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 -> Widget+withAttr an p =+ Widget (hSize p) (vSize p) $ do+ 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 -> Widget+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 -> Widget+updateAttrMap f p =+ Widget (hSize p) (vSize p) $ do+ 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 -> Widget+forceAttr an p =+ Widget (hSize p) (vSize p) $ do+ c <- getContext+ withReaderT (& ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p)++-- | Build a widget directly from a raw Vty image.+raw :: V.Image -> Widget+raw img = Widget Fixed Fixed $ return $ def & imageL .~ img++-- | Translate the specified widget by the specified offset amount.+translateBy :: Location -> Widget -> Widget+translateBy off p =+ Widget (hSize p) (vSize p) $ do+ result <- render p+ return $ addResultOffset off+ $ result & imageL %~ (V.translate (off^.columnL) (off^.rowL))++cropResultToContext :: Result -> RenderM Result+cropResultToContext result = do+ c <- getContext+ return $ result & imageL %~ (V.crop (c^.availWidthL) (c^.availHeightL))++-- | After rendering the specified widget, crop its result image to the+-- dimensions in the rendering context.+cropToContext :: Widget -> Widget+cropToContext p =+ Widget (hSize p) (vSize p) $ (render p >>= cropResultToContext)++-- | Crop the specified widget on the left by the specified number of+-- columns.+cropLeftBy :: Int -> Widget -> Widget+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.+cropRightBy :: Int -> Widget -> Widget+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.+cropTopBy :: Int -> Widget -> Widget+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.+cropBottomBy :: Int -> Widget -> Widget+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 :: Name -> Location -> Widget -> Widget+showCursor n cloc p =+ Widget (hSize p) (vSize p) $ do+ result <- render p+ return $ result & cursorsL %~ (CursorLocation cloc (Just n):)++hRelease :: Widget -> Maybe Widget+hRelease p =+ case hSize p of+ Fixed -> Just $ Widget Greedy (vSize p) $ withReaderT (& availWidthL .~ unrestricted) (render p)+ Greedy -> Nothing++vRelease :: Widget -> Maybe Widget+vRelease p =+ case vSize p of+ Fixed -> Just $ Widget (hSize p) Greedy $ withReaderT (& availHeightL .~ unrestricted) (render p)+ Greedy -> Nothing++-- | 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, only the+-- first is honored. 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 :: Name+ -- ^ The name of the viewport (must be unique and stable for+ -- reliable behavior)+ -> ViewportType+ -- ^ The type of viewport (indicates the permitted scrolling+ -- direction)+ -> Widget+ -- ^ The widget to be rendered in the scrollable viewport+ -> Widget+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++ 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 Name vpn = vpname+ release = case typ of+ Vertical -> vRelease+ Horizontal -> hRelease+ Both -> \w -> vRelease w >>= 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 vpn)+ Horizontal -> error $ "tried to embed an infinite-width widget in horizontal viewport " <> (show vpn)+ Both -> error $ "tried to embed an infinite-width or infinite-height widget in 'Both' type viewport " <> (show vpn)++ initialResult <- render released++ -- 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 rq = head $ initialResult^.visibilityRequestsL+ updatedVp = 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 updatedVp))++ -- If the rendering state includes any scrolling requests for this+ -- viewport, apply those+ reqs <- lift $ gets $ (^.scrollRequestsL)+ 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 ()++ -- Get the viewport state now that it has been updated.+ Just vp <- lift $ gets (M.lookup vpname . (^.viewportMapL))++ -- Then perform a translation of the sub-rendering to fit into the+ -- viewport+ translated <- render $ translateBy (Location (-1 * vp^.vpLeft, -1 * vp^.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) -> return $ translated & imageL .~ (V.charFill (c^.attrL) ' ' (c^.availWidthL) (c^.availHeightL))+ & visibilityRequestsL .~ mempty+ _ -> render $ cropToContext+ $ padBottom Max+ $ padRight Max+ $ Widget Fixed Fixed $ return $ translated & visibilityRequestsL .~ mempty++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+ _ -> 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+ _ -> 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.rowL++ reqEnd = rq^.vrPositionL.rowL + rq^.vrSizeL._2+ newVStart :: Int+ newVStart = if reqStart < curStart+ then reqStart+ else if reqStart > curEnd || reqEnd > curEnd+ then reqEnd - vp^.vpSize._2+ else curStart+scrollToView Horizontal rq vp = vp & vpLeft .~ newHStart+ where+ curStart = vp^.vpLeft+ curEnd = curStart + vp^.vpSize._1+ reqStart = rq^.vrPositionL.columnL++ reqEnd = rq^.vrPositionL.columnL + rq^.vrSizeL._1+ newHStart :: Int+ newHStart = if reqStart < curStart+ then reqStart+ else if reqStart > curEnd || reqEnd > curEnd+ then reqEnd - vp^.vpSize._1+ else curStart++-- | 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 -> Widget+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 -> Widget+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+ -- ^ Left+ -> Widget+ -- ^ Right+ -> Widget+(<+>) 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+ -- ^ Top+ -> Widget+ -- ^ Bottom+ -> Widget+(<=>) a b = vBox [a, b]
+ src/Brick/Widgets/List.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+-- | This module provides a scrollable list type and functions for+-- manipulating and rendering it.+module Brick.Widgets.List+ ( List(listElements, listSelected, listName, listElementDraw)++ -- * Consructing a list+ , list++ -- * Rendering a list+ , renderList++ -- * Lenses+ , listElementsL+ , listSelectedL+ , listNameL++ -- * Manipulating a list+ , listMoveBy+ , listMoveTo+ , listMoveUp+ , listMoveDown+ , listInsert+ , listRemove+ , listReplace+ , listSelectedElement++ -- * Attributes+ , listAttr+ , listSelectedAttr+ )+where++import Control.Applicative ((<$>))+import Control.Lens ((^.), (&), (.~))+import Data.Monoid ((<>))+import Data.Maybe (fromMaybe)+import qualified Data.Algorithm.Diff as D+import Graphics.Vty (Event(..), Key(..))++import Brick.Types+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+data List e =+ List { listElements :: ![e]+ , listElementDraw :: Bool -> e -> Widget+ , listSelected :: !(Maybe Int)+ , listName :: Name+ }++suffixLenses ''List++instance HandleEvent (List e) where+ handleEvent e theList = f theList+ where+ f = case e of+ EvKey KUp [] -> listMoveUp+ EvKey KDown [] -> listMoveDown+ _ -> id++-- | The top-level attribute used for the entire list.+listAttr :: AttrName+listAttr = "list"++-- | The attribute used only for the currently-selected list item.+-- Extends 'listAttr'.+listSelectedAttr :: AttrName+listSelectedAttr = listAttr <> "selected"++-- | Construct a list in terms of an element type 'e'.+list :: Name+ -- ^ The list name (must be unique)+ -> (Bool -> e -> Widget)+ -- ^ The item rendering function (takes the item and whether it is+ -- currently selected)+ -> [e]+ -- ^ The initial list contents+ -> List e+list name draw es =+ let selIndex = if null es then Nothing else Just 0+ in List es draw selIndex name++-- | Turn a list state value into a widget.+renderList :: List e -> Widget+renderList l = withDefAttr listAttr $+ viewport (l^.listNameL) Vertical $+ vBox $+ drawListElements l++drawListElements :: List e -> [Widget]+drawListElements l = drawnElements+ where+ es = l^.listElementsL+ drawnElements = (flip map) (zip [0..] es) $ \(i, e) ->+ let isSelected = Just i == l^.listSelectedL+ elemWidget = (l^.listElementDrawL) isSelected e+ makeVisible = if isSelected+ then (visible . withDefAttr listSelectedAttr)+ else id+ in makeVisible elemWidget++-- | 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 e+ -> List e+listInsert pos e l =+ let safePos = clamp 0 (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) = splitAt safePos es+ in l & listSelectedL .~ Just newSel+ & listElementsL .~ (front ++ (e : 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 e+ -> List e+listRemove pos l | null (l^.listElementsL) = l+ | pos /= clamp 0 (length (l^.listElementsL) - 1) pos = l+ | otherwise =+ let newSel = case l^.listSelectedL of+ Nothing -> 0+ Just s -> if pos == 0+ then 0+ else if pos == s+ then pos - 1+ else if pos < s+ then s - 1+ else s+ (front, back) = splitAt pos es+ es' = front ++ tail back+ es = l^.listElementsL+ in l & listSelectedL .~ (if null es' then Nothing else Just newSel)+ & listElementsL .~ es'++-- | Replace the contents of a list with a new set of elements but+-- preserve the currently selected index.+listReplace :: Eq e => [e] -> List e -> List e+listReplace es' l | es' == l^.listElementsL = l+ | otherwise =+ let sel = fromMaybe 0 (l^.listSelectedL)+ getNewSel es = case (null es, null es') of+ (_, True) -> Nothing+ (True, False) -> Just 0+ (False, False) -> Just (maintainSel es es' sel)+ newSel = getNewSel (l^.listElementsL)++ 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 e -> List e+listMoveUp = listMoveBy (-1)++-- | Move the list selected index down by one. (Moves the cursor down,+-- adds one to the index.)+listMoveDown :: List e -> List e+listMoveDown = listMoveBy 1++-- | Move the list selected index by the specified amount, subject to+-- validation.+listMoveBy :: Int -> List e -> List e+listMoveBy amt l =+ let newSel = clamp 0 (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 e -> List e+listMoveTo pos l =+ let len = 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 e -> Maybe (Int, e)+listSelectedElement l = do+ sel <- l^.listSelectedL+ return (sel, (l^.listElementsL) !! sel)++-- Assuming `xs` is an existing list that we want to update to match the+-- state of `ys`. Given a selected index in `xs`, the goal is to compute+-- the corresponding index in `ys`.+maintainSel :: (Eq e) => [e] -> [e] -> Int -> Int+maintainSel xs ys sel = let hunks = D.getDiff xs ys+ in merge 0 sel hunks++merge :: (Eq e) => Int -> Int -> [D.Diff e] -> Int+merge _ sel [] = sel+merge idx sel (h:hs) | idx > sel = sel+ | otherwise = case h of+ D.Both _ _ -> merge sel (idx + 1) hs++ -- element removed in new list+ D.First _ -> let newSel = if idx < sel+ then sel - 1+ else sel+ in merge newSel idx hs++ -- element added in new list+ D.Second _ -> let newSel = if idx <= sel+ then sel + 1+ else sel+ in merge newSel (idx + 1) hs
+ src/Brick/Widgets/ProgressBar.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module provides a progress bar widget.+module Brick.Widgets.ProgressBar+ ( progressBar+ -- * Attributes+ , progressCompleteAttr+ , progressIncompleteAttr+ )+where++import Control.Lens ((^.))+import Data.Monoid++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+progressBar mLabel progress =+ Widget Greedy Fixed $ do+ c <- getContext+ let barWidth = c^.availWidthL+ label = maybe "" id mLabel+ labelWidth = length label+ spacesWidth = barWidth - labelWidth+ leftPart = replicate (spacesWidth `div` 2) ' '+ rightPart = replicate (barWidth - (labelWidth + length leftPart)) ' '+ fullBar = leftPart <> label <> rightPart+ completeWidth = round $ progress * toEnum barWidth+ completePart = take completeWidth fullBar+ incompletePart = drop completeWidth fullBar+ render $ (withAttr progressCompleteAttr $ str completePart) <+>+ (withAttr progressIncompleteAttr $ str incompletePart)
+ src/Data/Text/Markup.hs view
@@ -0,0 +1,74 @@+-- | 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++import Control.Applicative ((<$>))+import Data.Default (Default, def)+import Data.Monoid+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 (Default 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 :: (Default a) => T.Text -> Markup a+fromText = (@@ def)++-- | Extract the text from markup, discarding the markup metadata.+toText :: (Eq a) => Markup a -> T.Text+toText = T.concat . (fst <$>) . 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 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 thePairs+ where+ 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