brick 2.5 → 2.12
raw patch · 22 files changed
Files
- CHANGELOG.md +97/−1
- LICENSE +1/−1
- README.md +15/−6
- brick.cabal +41/−70
- docs/guide.rst +10/−2
- programs/AnimationDemo.hs +223/−0
- programs/CustomEventDemo.hs +2/−1
- programs/LayerDemo.hs +8/−8
- programs/TailDemo.hs +2/−1
- src/Brick/Animation.hs +588/−0
- src/Brick/Animation/Clock.hs +64/−0
- src/Brick/BorderMap.hs +2/−0
- src/Brick/Main.hs +4/−0
- src/Brick/Types/Common.hs +7/−2
- src/Brick/Types/Internal.hs +46/−46
- src/Brick/Widgets/Center.hs +1/−1
- src/Brick/Widgets/Core.hs +44/−39
- src/Brick/Widgets/Edit.hs +1/−1
- src/Brick/Widgets/FileBrowser.hs +42/−8
- src/Brick/Widgets/Internal.hs +32/−24
- src/Brick/Widgets/List.hs +17/−0
- tests/List.hs +9/−0
CHANGELOG.md view
@@ -2,6 +2,102 @@ Brick changelog --------------- +2.12+----++Package changes:++* Raised upper bound on microlens to allow building with 0.5.++2.11+----++Bug fixes:++* Fixed a bug in FileBrowser: if a user pressed Enter when the cursor+ was on a selected entry, it was omitted from the list of+ selected browser entries. As part of this change, the function+ `actionFileBrowserSelectCurrent` previously toggled the selection+ of the entry at the cursor, but should have selected it instead.+ It now does so, and a new function for toggling was introduced:+ `actionFileBrowserToggleCurrent`.++Other changes:++* Upper bounds on `base` and `microlens` were adjusted.++2.10+----++* Updated `brick` to build with `microlens == 0.5.0.0` which moved its+ Field* classes to `Lens.Micro.FieldN`.++2.9+---++API changes:+* Added `Brick.Widgets.List.listFindFirst` function.++2.8.3+-----++Bug fixes:++* Fixed a bug that completely broke `makeVisible` that was introduced+ in brick 2.6.+* Fixed context cropping in `cropRightBy` and `cropBottomBy`.++2.8.2+-----++* Updated `Brick.Widgets.Core` functions `cropBottomBy`, `cropToBy`,+ `cropLeftBy`, and `cropRightBy` to properly perform result cropping to+ actually address the internal bug fixed in 2.8.1.++2.8.1+-----++* Fixed a long-standing bug in `cropToContext` that resulted in some+ extents getting left around when they should be dropped, possibly+ leading to application bugs when handling mouse clicks in extent+ regions that should have been removed from the rendering result.++2.8+---++Behavior changes:+* `FileBrowser` file marking with `Space` now honors the file browser's+ configured file selector predicate.+* `FileBrowser` file marking with `Space` and `Enter` now toggles file+ selection rather than just selecting files, allowing for selected+ files to be unselected.++2.7+---++This release adds `Brick.Animation`, a module providing infrastructure+for adding animations to Brick interfaces. See the Haddock documentation+in `Brick.Animation` for full details; see `programs/AnimationDemo.hs`+for a working example.++2.6+---++Behavior changes:+ * `Brick.Widgets.Core.relativeTo` now draws nothing if the requested+ extent is not found. Previously it would draw the specified widget in+ the upper-left corner of the layer.++Bug fixes:+ * Fixed the conditional import in `BorderMap` (#519)+ * `Brick.Widgets.Center.hCenterWith` now properly accounts for centered+ image width when computing additional right padding (#520)+ * The Brick renderer now properly resets some render-specific state+ in between renderings that was previously kept around, avoiding+ preservation of stale extents across renderings+ * `brick-tail-demo` and `brick-custom-event-demo` now shut down Vty+ properly+ 2.5 --- @@ -1776,7 +1872,7 @@ Bug fixes: * Fixed viewport behavior when the image in a viewport reduces its size enough to render the viewport offsets invalid. Before, this behavior- caused a crash during image croppin in vty; now the behavior is+ caused a crash during image cropping in vty; now the behavior is handled sanely (fixes #22; reported by Hans-Peter Deifel) 0.2.2
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015-2018, Jonathan Daugherty.+Copyright (c) 2015-2025, Jonathan Daugherty. All rights reserved. Redistribution and use in source and binary forms, with or without
README.md view
@@ -53,10 +53,11 @@ | [`2048Haskell`](https://github.com/8Gitbrix/2048Haskell) | An implementation of the 2048 game | | [`babel-cards`](https://github.com/srhoulam/babel-cards) | A TUI spaced-repetition memorization tool. Similar to Anki. | | [`bhoogle`](https://github.com/andrevdm/bhoogle) | A [Hoogle](https://www.haskell.org/hoogle/) client |+| [`bollama`](https://github.com/andrevdm/bollama) | A simple [Ollama](https://ollama.com/) TUI | | [`brewsage`](https://github.com/gerdreiss/brewsage#readme) | A TUI for Homebrew | | [`brick-trading-journal`](https://codeberg.org/amano.kenji/brick-trading-journal) | A TUI program that calculates basic statistics from trades | | [`Brickudoku`](https://github.com/Thecentury/brickudoku) | A hybrid of Tetris and Sudoku |-| [`cbookview`](https://github.com/mlang/chessIO) | A TUI for exploring polyglot chess opening book files |+| [`cbookview`](https://github.com/mlang/cbookview) | A TUI for exploring polyglot chess opening book files | | [`clifm`](https://github.com/pasqu4le/clifm) | A file manager | | [`codenames-haskell`](https://github.com/VigneshN1997/codenames-haskell) | An implementation of the Codenames game | | [`fifteen`](https://github.com/benjaminselfridge/fifteen) | An implementation of the [15 puzzle](https://en.wikipedia.org/wiki/15_puzzle) |@@ -72,11 +73,13 @@ | [`hledger-iadd`](http://github.com/rootzlevel/hledger-iadd) | An interactive terminal UI for adding hledger journal entries | | [`hledger-ui`](https://github.com/simonmichael/hledger) | A terminal UI for the hledger accounting system. | | [`homodoro`](https://github.com/c0nradLC/homodoro) | A terminal application to use the pomodoro technique and keep track of daily tasks |+| [`hskanban`](https://github.com/vincentaxhe/hskanban) | A Kanban organizer | | [`htyper`](https://github.com/Simon-Hostettler/htyper) | A typing speed test program | | [`hyahtzee2`](https://github.com/DamienCassou/hyahtzee2#readme) | Famous Yahtzee dice game | | [`kpxhs`](https://github.com/akazukin5151/kpxhs) | An interactive [Keepass](https://github.com/keepassxreboot/keepassxc/) database viewer | | [`matterhorn`](https://github.com/matterhorn-chat/matterhorn) | A client for [Mattermost](https://about.mattermost.com/) | | [`maze`](https://github.com/benjaminselfridge/maze) | A Brick-based maze game |+| [`monad-torrent`](https://github.com/davorluc/monad-torrent) | A simple and minimal torrent client | | [`monalog`](https://github.com/goosedb/Monalog) | Terminal logs observer | | [`mushu`](https://github.com/elaye/mushu) | An `MPD` client | | [`mywork`](https://github.com/kquick/mywork) [[Hackage]](https://hackage.haskell.org/package/mywork) | A tool to keep track of the projects you are working on |@@ -89,6 +92,7 @@ | [`summoner-tui`](https://github.com/kowainik/summoner/tree/master/summoner-tui) | An interactive frontend to the Summoner tool | | [`swarm`](https://github.com/byorgey/swarm/) | A 2D programming and resource gathering game | | [`tart`](https://github.com/jtdaugherty/tart) | A mouse-driven ASCII art drawing program |+| [`tick-tock-tui`](https://github.com/sectore/tick-tock-tui) | A stylish TUI app to handle Bitcoin data provided by [Mempool REST API](https://mempool.space/docs/api/rest) incl. blocks, fees and price converter. | | [`tetris`](https://github.com/SamTay/tetris) | An implementation of the Tetris game | | [`thock`](https://github.com/rmehri01/thock) | A modern TUI typing game featuring online racing against friends | | [`timeloop`](https://github.com/cdupont/timeloop) | A time-travelling demonstrator |@@ -101,12 +105,14 @@ | [`wrapping-editor`](https://github.com/ta0kira/wrapping-editor) | An embeddable editor with support for Brick | | [`youbrick`](https://github.com/florentc/youbrick) | A feed aggregator and launcher for Youtube channels | -These third-party packages also extend `brick`:+These additional packages also extend `brick`: -| Project | Description |-| ------- | ----------- |-| [`brick-filetree`](https://github.com/ChrisPenner/brick-filetree) [[Hackage]](http://hackage.haskell.org/package/brick-filetree) | A widget for exploring a directory tree and selecting or flagging files and directories |-| [`brick-panes`](https://github.com/kquick/brick-panes) [[Hackage]](https://hackage.haskell.org/package/brick-panes) | A Brick overlay library providing composition and isolation of screen areas for TUI apps. |+| Project | Description | Hackage |+| ------- | ----------- | ------- |+| [`brick-filetree`](https://github.com/ChrisPenner/brick-filetree) | A widget for exploring a directory tree and selecting or flagging files and directories | [Hackage](https://hackage.haskell.org/package/brick-filetree) |+| [`brick-panes`](https://github.com/kquick/brick-panes) | A Brick overlay library providing composition and isolation of screen areas for TUI apps. | [Hackage](https://hackage.haskell.org/package/brick-panes) |+| [`brick-calendar`](https://github.com/ldgrp/brick-calendar) | A library providing a calendar widget for Brick-based applications. | [Hackage](https://hackage.haskell.org/package/brick-calendar) |+| [`brick-skylighting`](https://github.com/jtdaugherty/brick-skylighting) | A library providing integration support for [Skylighting](https://hackage.haskell.org/package/skylighting)-based syntax highlighting. | [Hackage](https://hackage.haskell.org/package/brick-skylighting) | Getting Started ---------------@@ -142,6 +148,7 @@ * Progress bar widget * Simple dialog box widget * Border-drawing widgets (put borders around or in between things)+ * Animation support * Generic scrollable viewports and viewport scroll bars * General-purpose layout control combinators * Extensible widget-building API@@ -207,6 +214,8 @@ If you decide to contribute, that's great! Here are some guidelines you should consider to make submitting patches easier for all concerned: + - Patches written completely or partially by AI are unlikely to be+ accepted. - If you want to take on big things, talk to me first; let's have a design/vision discussion before you start coding. Create a GitHub issue and we can use that as the place to hash things out.
brick.cabal view
@@ -1,5 +1,5 @@ name: brick-version: 2.5+version: 2.12 synopsis: A declarative terminal user interface library description: Write terminal user interfaces (TUIs) painlessly with 'brick'! You@@ -32,7 +32,7 @@ license-file: LICENSE author: Jonathan Daugherty <cygnus@foobox.com> maintainer: Jonathan Daugherty <cygnus@foobox.com>-copyright: (c) Jonathan Daugherty 2015-2024+copyright: (c) Jonathan Daugherty 2015-2025 category: Graphics build-type: Simple cabal-version: 1.18@@ -46,8 +46,10 @@ || == 9.0.2 || == 9.2.8 || == 9.4.8- || == 9.6.3- || == 9.8.1+ || == 9.6.7+ || == 9.8.4+ || == 9.10.3+ || == 9.12.2 extra-doc-files: README.md, docs/guide.rst,@@ -57,7 +59,7 @@ Source-Repository head type: git- location: git://github.com/jtdaugherty/brick.git+ location: http://github.com/jtdaugherty/brick Flag demos Description: Build demonstration programs@@ -70,6 +72,7 @@ hs-source-dirs: src exposed-modules: Brick+ Brick.Animation Brick.AttrMap Brick.BChan Brick.BorderMap@@ -98,13 +101,14 @@ Brick.Widgets.Table Data.IMap other-modules:+ Brick.Animation.Clock Brick.Types.Common Brick.Types.TH Brick.Types.EventM Brick.Types.Internal Brick.Widgets.Internal - build-depends: base >= 4.9.0.0 && < 4.21.0.0,+ build-depends: base >= 4.9.0.0 && < 4.23.0.0, vty >= 6.0, vty-crossplatform, bimap >= 0.5 && < 0.6,@@ -113,7 +117,7 @@ exceptions >= 0.10.0, filepath, containers >= 0.5.7,- microlens >= 0.3.0.0,+ microlens >= 0.3.0.0 && < 0.6, microlens-th, microlens-mtl, mtl,@@ -126,7 +130,10 @@ deepseq >= 1.3 && < 1.6, unix-compat, bytestring,- word-wrap >= 0.2+ word-wrap >= 0.2,+ unordered-containers,+ hashable,+ time executable brick-custom-keybinding-demo if !flag(demos)@@ -154,9 +161,7 @@ default-extensions: CPP main-is: TableDemo.hs build-depends: base,- brick,- text,- vty+ brick executable brick-tail-demo if !flag(demos)@@ -170,7 +175,6 @@ brick, text, vty,- vty-crossplatform, random, microlens-th, microlens-mtl@@ -184,8 +188,7 @@ default-extensions: CPP main-is: ReadmeDemo.hs build-depends: base,- brick,- text+ brick executable brick-file-browser-demo if !flag(demos)@@ -227,7 +230,6 @@ main-is: TextWrapDemo.hs build-depends: base, brick,- text, word-wrap executable brick-cache-demo@@ -241,9 +243,6 @@ build-depends: base, brick, vty,- text,- microlens >= 0.3.0.0,- microlens-th, mtl executable brick-visibility-demo@@ -256,7 +255,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-th, microlens-mtl@@ -273,8 +271,6 @@ brick, vty, vty-crossplatform,- text,- microlens, microlens-mtl, microlens-th @@ -288,9 +284,7 @@ main-is: ViewportScrollDemo.hs build-depends: base, brick,- vty,- text,- microlens+ vty executable brick-dialog-demo if !flag(demos)@@ -301,9 +295,7 @@ main-is: DialogDemo.hs build-depends: base, brick,- vty,- text,- microlens+ vty executable brick-mouse-demo if !flag(demos)@@ -315,11 +307,9 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-th, microlens-mtl,- text-zipper, mtl executable brick-layer-demo@@ -332,7 +322,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-th, microlens-mtl@@ -347,7 +336,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-th @@ -360,9 +348,7 @@ main-is: CroppingDemo.hs build-depends: base, brick,- vty,- text,- microlens+ vty executable brick-padding-demo if !flag(demos)@@ -373,9 +359,7 @@ main-is: PaddingDemo.hs build-depends: base, brick,- vty,- text,- microlens+ vty executable brick-theme-demo if !flag(demos)@@ -387,9 +371,7 @@ build-depends: base, brick, vty,- text,- mtl,- microlens+ mtl executable brick-attr-demo if !flag(demos)@@ -400,9 +382,7 @@ main-is: AttrDemo.hs build-depends: base, brick,- vty,- text,- microlens+ vty executable brick-tabular-list-demo if !flag(demos)@@ -414,11 +394,9 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-mtl, microlens-th,- mtl, vector executable brick-list-demo@@ -431,7 +409,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-mtl, mtl,@@ -447,12 +424,25 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-mtl, mtl, vector +executable brick-animation-demo+ if !flag(demos)+ Buildable: False+ hs-source-dirs: programs+ ghc-options: -threaded -Wall -Wcompat -O2+ default-language: Haskell2010+ main-is: AnimationDemo.hs+ build-depends: base,+ brick,+ vty,+ vty-crossplatform,+ containers,+ microlens-platform+ executable brick-custom-event-demo if !flag(demos) Buildable: False@@ -463,7 +453,6 @@ build-depends: base, brick, vty,- text, microlens >= 0.3.0.0, microlens-th, microlens-mtl@@ -476,10 +465,7 @@ default-language: Haskell2010 main-is: FillDemo.hs build-depends: base,- brick,- vty,- text,- microlens+ brick executable brick-hello-world-demo if !flag(demos)@@ -489,10 +475,7 @@ default-language: Haskell2010 main-is: HelloWorldDemo.hs build-depends: base,- brick,- vty,- text,- microlens+ brick executable brick-edit-demo if !flag(demos)@@ -504,9 +487,6 @@ build-depends: base, brick, vty,- text,- vector,- mtl, microlens >= 0.3.0.0, microlens-th, microlens-mtl@@ -521,9 +501,6 @@ build-depends: base, brick, vty,- text,- vector,- mtl, microlens >= 0.3.0.0, microlens-th, microlens-mtl@@ -539,8 +516,7 @@ build-depends: base, brick, vty,- text,- microlens+ text executable brick-dynamic-border-demo if !flag(demos)@@ -551,10 +527,7 @@ default-language: Haskell2010 main-is: DynamicBorderDemo.hs build-depends: base <= 5,- brick,- vty,- text,- microlens+ brick executable brick-progressbar-demo if !flag(demos)@@ -567,8 +540,6 @@ build-depends: base, brick, vty,- text,- microlens, microlens-mtl, microlens-th
docs/guide.rst view
@@ -1966,6 +1966,14 @@ so by consulting the ``ctxDynBorders`` field of the rendering context before writing to your ``Result``'s ``borders`` field. +Animations+==========++Brick provides animation support in ``Brick.Animation``. See the Haddock+documentation in that module for a complete explanation of the API; see+``programs/AnimationDemo.hs`` (``brick-animation-demo``) for a working+example.+ The Rendering Cache =================== @@ -1985,8 +1993,8 @@ border $ str "This will be cached" -In the example above, the first time the ``border $ str "This will be-cached"`` widget is rendered, the resulting Vty image will be stored+In the example above, the first time the ``border $ str "This will be cached"``+widget is rendered, the resulting Vty image will be stored in the rendering cache under the key ``ExpensiveThing``. On subsequent renderings the cached Vty image will be used instead of re-rendering the widget. This example doesn't need caching to improve performance, but
+ programs/AnimationDemo.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+module Main where++import Control.Monad (void)+import Lens.Micro.Platform+import Data.List (intersperse)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Data.Map as M+import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)++import Brick.BChan+import Brick.Util (fg)+import Brick.Main (App(..), neverShowCursor, customMain, halt)+import Brick.AttrMap (AttrName, AttrMap, attrMap, attrName)+import Brick.Types (Widget, EventM, BrickEvent(..), Location(..))+import Brick.Widgets.Border (border)+import Brick.Widgets.Center (center)+import Brick.Widgets.Core ((<+>), str, vBox, hBox, hLimit, vLimit, translateBy, withDefAttr)+import qualified Brick.Animation as A++data CustomEvent =+ AnimationUpdate (EventM () St ())+ -- ^ The state update constructor required by the animation API++data St =+ St { _stAnimationManager :: A.AnimationManager St CustomEvent ()+ -- ^ The animation manager that will run all of our animations+ , _animation1 :: Maybe (A.Animation St ())+ , _animation2 :: Maybe (A.Animation St ())+ , _animation3 :: Maybe (A.Animation St ())+ , _clickAnimations :: M.Map Location (A.Animation St ())+ -- ^ The various fields for storing animation states. For mouse+ -- animations, we store animations for each screen location that+ -- was clicked.+ }++makeLenses ''St++drawUI :: St -> [Widget ()]+drawUI st = drawClickAnimations st <> [drawAnimations st]++drawClickAnimations :: St -> [Widget ()]+drawClickAnimations st =+ drawClickAnimation st <$> M.toList (st^.clickAnimations)++drawClickAnimation :: St -> (Location, A.Animation St ()) -> Widget ()+drawClickAnimation st (l, a) =+ translateBy l $+ A.renderAnimation (const $ str " ") st (Just a)++drawAnimations :: St -> Widget ()+drawAnimations st =+ let animStatus label key a =+ str (label <> ": ") <+>+ maybe (str "Not running") (const $ str "Running") a <+>+ str (" (Press " <> key <> " to toggle)")+ statusMessages = statusMessage <$> zip [(0::Int)..] animations+ statusMessage (i, (c, config)) =+ animStatus ("Animation #" <> (show $ i + 1)) [c]+ (st^.(animationTarget config))+ animationDrawings = hBox $ intersperse (str " ") $+ drawSingleAnimation <$> animations+ drawSingleAnimation (_, config) =+ A.renderAnimation (const $ str " ") st (st^.(animationTarget config))+ in vBox [ str "Click and drag the mouse or press keys to start animations."+ , str " "+ , vBox statusMessages+ , animationDrawings+ ]++clip1 :: A.Clip a ()+clip1 = A.newClip_ $ str <$> [".", "o", "O", "^", " "]++clip2 :: A.Clip a ()+clip2 = A.newClip_ $ str <$> ["|", "/", "-", "\\"]++clip3 :: A.Clip a ()+clip3 =+ A.newClip_ $+ (hLimit 9 . vLimit 9 . border . center) <$>+ [ border $ str " "+ , border $ vBox $ replicate 3 $ str $ replicate 3 ' '+ , border $ vBox $ replicate 5 $ str $ replicate 5 ' '+ ]++mouseClickClip :: A.Clip a ()+mouseClickClip =+ A.newClip_+ [ withDefAttr attr6 $ str "0"+ , withDefAttr attr5 $ str "O"+ , withDefAttr attr4 $ str "o"+ , withDefAttr attr3 $ str "•"+ , withDefAttr attr2 $ str "*"+ , withDefAttr attr2 $ str "."+ ]++attr6 :: AttrName+attr6 = attrName "attr6"++attr5 :: AttrName+attr5 = attrName "attr5"++attr4 :: AttrName+attr4 = attrName "attr4"++attr3 :: AttrName+attr3 = attrName "attr3"++attr2 :: AttrName+attr2 = attrName "attr2"++attr1 :: AttrName+attr1 = attrName "attr1"++attrs :: AttrMap+attrs =+ attrMap V.defAttr+ [ (attr6, fg V.white)+ , (attr5, fg V.brightYellow)+ , (attr4, fg V.brightGreen)+ , (attr3, fg V.cyan)+ , (attr2, fg V.blue)+ , (attr1, fg V.black)+ ]++-- | Animation settings grouped together for lookup by keystroke.+data AnimationConfig =+ AnimationConfig { animationTarget :: Lens' St (Maybe (A.Animation St ()))+ , animationClip :: A.Clip St ()+ , animationFrameTime :: Integer+ , animationMode :: A.RunMode+ }++animations :: [(Char, AnimationConfig)]+animations =+ [ ('1', AnimationConfig animation1 clip1 1000 A.Loop)+ , ('2', AnimationConfig animation2 clip2 100 A.Loop)+ , ('3', AnimationConfig animation3 clip3 100 A.Once)+ ]++-- | Start the animation specified by this config.+startAnimationFromConfig :: AnimationConfig -> EventM () St ()+startAnimationFromConfig config = do+ mgr <- use stAnimationManager+ A.startAnimation mgr (animationClip config)+ (animationFrameTime config)+ (animationMode config)+ (animationTarget config)++-- | If the animation specified in this config is not running, start it.+-- Otherwise stop it.+toggleAnimationFromConfig :: AnimationConfig -> EventM () St ()+toggleAnimationFromConfig config = do+ mgr <- use stAnimationManager+ mOld <- use (animationTarget config)+ case mOld of+ Just a -> A.stopAnimation mgr a+ Nothing -> startAnimationFromConfig config++-- | Start a new mouse click animation at the specified location if one+-- is not already running there.+startMouseClickAnimation :: Location -> EventM () St ()+startMouseClickAnimation l = do+ mgr <- use stAnimationManager+ a <- use (clickAnimations.at l)+ case a of+ Just {} -> return ()+ Nothing -> A.startAnimation mgr mouseClickClip 100 A.Once (clickAnimations.at l)++appEvent :: BrickEvent () CustomEvent -> EventM () St ()+appEvent e = do+ case e of+ -- A mouse click starts an animation at the click location.+ VtyEvent (V.EvMouseDown col row _ _) ->+ startMouseClickAnimation (Location (col, row))++ -- If we got a character keystroke, see if there is a specific+ -- animation mapped to that character and toggle the resulting+ -- animation.+ VtyEvent (V.EvKey (V.KChar c) [])+ | Just aConfig <- lookup c animations ->+ toggleAnimationFromConfig aConfig++ -- Apply a state update from the animation manager.+ AppEvent (AnimationUpdate act) -> act++ VtyEvent (V.EvKey V.KEsc []) -> halt++ _ -> return ()++theApp :: App St CustomEvent ()+theApp =+ App { appDraw = drawUI+ , appChooseCursor = neverShowCursor+ , appHandleEvent = appEvent+ , appStartEvent = return ()+ , appAttrMap = const attrs+ }++main :: IO ()+main = do+ chan <- newBChan 10+ mgr <- A.startAnimationManager 50 chan AnimationUpdate++ let initialState =+ St { _stAnimationManager = mgr+ , _animation1 = Nothing+ , _animation2 = Nothing+ , _animation3 = Nothing+ , _clickAnimations = mempty+ }+ buildVty = do+ v <- mkVty V.defaultConfig+ V.setMode (V.outputIface v) V.Mouse True+ return v++ initialVty <- buildVty+ void $ customMain initialVty buildVty (Just chan) theApp initialState
programs/CustomEventDemo.hs view
@@ -82,4 +82,5 @@ writeBChan chan Counter threadDelay 1000000 - void $ customMainWithDefaultVty (Just chan) theApp initialState+ (_, vty) <- customMainWithDefaultVty (Just chan) theApp initialState+ V.shutdown vty
programs/LayerDemo.hs view
@@ -46,8 +46,8 @@ [ C.centerLayer $ B.border $ str "This layer is centered but other\nlayers are placed underneath it." , arrowLayer- , middleLayer st- , bottomLayer st+ , middleLayer (st^.middleLayerLocation)+ , bottomLayer (st^.bottomLayerLocation) ] arrowLayer :: Widget Name@@ -59,15 +59,15 @@ withDefAttr arrowAttr $ str msg -middleLayer :: St -> Widget Name-middleLayer st =- translateBy (st^.middleLayerLocation) $+middleLayer :: Location -> Widget Name+middleLayer l =+ translateBy l $ reportExtent MiddleLayerElement $ B.border $ str "Middle layer\n(Arrow keys move)" -bottomLayer :: St -> Widget Name-bottomLayer st =- translateBy (st^.bottomLayerLocation) $+bottomLayer :: Location -> Widget Name+bottomLayer l =+ translateBy l $ B.border $ str "Bottom layer\n(Ctrl-arrow keys move)" appEvent :: T.BrickEvent Name e -> T.EventM Name St ()
programs/TailDemo.hs view
@@ -147,4 +147,5 @@ -- Run thread to simulate incoming data void $ forkIO $ generateLines chan - void $ customMainWithDefaultVty (Just chan) app initialState+ (_, vty) <- customMainWithDefaultVty (Just chan) app initialState+ V.shutdown vty
+ src/Brick/Animation.hs view
@@ -0,0 +1,588 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+-- | This module provides some infrastructure for adding animations to+-- Brick applications. See @programs/AnimationDemo.hs@ for a complete+-- working example of this API.+--+-- At a high level, this works as follows:+--+-- This module provides a threaded animation manager that manages a set+-- of running animations. The application creates the manager and starts+-- animations, which automatically loop or run once, depending on their+-- configuration. Each animation has some state in the application's+-- state that is automatically managed by the animation manager using a+-- lens-based API. Whenever animations need to be redrawn, the animation+-- manager sends a custom event with a state update to the application,+-- which must be evaluated by the main event loop to update animation+-- states. Each animation is associated with a 'Clip' -- sequence of+-- frames -- which may be static or may be built from the application+-- state at rendering time.+--+-- To use this module:+--+-- * Use a custom event type @e@ in your 'Brick.Main.App' and give the+-- event type a constructor @EventM n s () -> e@ (where @s@ and+-- @n@ are those in @App s e n@). This will require the use of+-- 'Brick.Main.customMain' and will also require the creation of a+-- 'Brick.BChan.BChan' for custom events.+--+-- * Add an 'AnimationManager' field to the application state @s@.+--+-- * Create an 'AnimationManager' at startup with+-- 'startAnimationManager', providing the custom event constructor and+-- 'BChan' created above. Store the manager in the application state.+--+-- * For each animation you want to run at any given time, add a field+-- to the application state of type @Maybe (Animation s n)@,+-- initialized to 'Nothing'. A value of 'Nothing' indicates that the+-- animation is not running.+--+-- * Ensure that each animation state field in @s@ has a lens, usually+-- by using 'Lens.Micro.TH.makeLenses'.+--+-- * Start new animations in 'EventM' with 'startAnimation'; stop them+-- with 'stopAnimation'. Supply clips for new animations with+-- 'newClip', 'newClip_', and the clip transformation functions.+--+-- * Call 'renderAnimation' in 'Brick.Main.appDraw' for each animation in the+-- application state.+--+-- * If needed, stop the animation manager with 'stopAnimationManager'.+--+-- See 'AnimationManager' and the docs for the rest of this module for+-- details.+module Brick.Animation+ ( -- * Animation managers+ AnimationManager+ , startAnimationManager+ , stopAnimationManager+ , minTickTime++ -- * Animations+ , Animation+ , animationFrameIndex++ -- * Starting and stopping animations+ , RunMode(..)+ , startAnimation+ , stopAnimation++ -- * Rendering animations+ , renderAnimation++ -- * Creating clips+ , Clip+ , newClip+ , newClip_+ , clipLength++ -- * Transforming clips+ , pingPongClip+ , reverseClip+ )+where++import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread, myThreadId)+import qualified Control.Concurrent.STM as STM+import Control.Monad (forever, when)+import Control.Monad.State.Strict+import Data.Foldable (foldrM)+import Data.Hashable (Hashable)+import qualified Data.HashMap.Strict as HM+import Data.Maybe (fromMaybe)+import qualified Data.Vector as V+import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just)+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl++import Brick.BChan+import Brick.Types (EventM, Widget)+import qualified Brick.Animation.Clock as C++-- | A sequence of a animation frames.+newtype Clip s n = Clip (V.Vector (s -> Widget n))+ deriving (Semigroup)++-- | Get the number of frames in a clip.+clipLength :: Clip s n -> Int+clipLength (Clip fs) = V.length fs++-- | Build a clip.+--+-- Each frame in a clip is represented by a function from a state to a+-- 'Widget'. This allows applications to determine on a per-frame basis+-- what should be drawn in an animation based on application state, if+-- desired, in the same style as 'Brick.Main.appDraw'.+--+-- If the provided list is empty, this calls 'error'.+newClip :: [s -> Widget n] -> Clip s n+newClip [] = error "clip: got an empty list"+newClip fs = Clip $ V.fromList fs++-- | Like 'newClip' but for static frames.+newClip_ :: [Widget n] -> Clip s n+newClip_ ws = newClip $ const <$> ws++-- | Extend a clip so that when the end of the original clip is reached,+-- it continues in reverse order to create a loop.+--+-- For example, if this is given a clip with frames A, B, C, and D, then+-- this returns a clip with frames A, B, C, D, C, and B.+--+-- If the given clip contains less than two frames, this is equivalent+-- to 'id'.+pingPongClip :: Clip s n -> Clip s n+pingPongClip (Clip fs) | V.length fs >= 2 =+ Clip $ fs <> V.reverse (V.init $ V.tail fs)+pingPongClip c = c++-- | Reverse a clip.+reverseClip :: Clip s n -> Clip s n+reverseClip (Clip fs) = Clip $ V.reverse fs++data AnimationManagerRequest s n =+ Tick C.Time+ | StartAnimation (Clip s n) Integer RunMode (Traversal' s (Maybe (Animation s n)))+ -- ^ Clip, frame duration in milliseconds, run mode, updater+ | StopAnimation (Animation s n)+ | Shutdown++-- | The running mode for an animation.+data RunMode =+ Once+ -- ^ Run the animation once and then end+ | Loop+ -- ^ Run the animation in a loop forever+ deriving (Eq, Show, Ord)++newtype AnimationID = AnimationID Int+ deriving (Eq, Ord, Show, Hashable)++-- | The state of a running animation.+--+-- Put one of these (wrapped in 'Maybe') in your application state for+-- each animation that you'd like to run concurrently.+data Animation s n =+ Animation { animationFrameIndex :: Int+ -- ^ The animation's current frame index, provided for+ -- convenience. Applications won't need to access this in+ -- most situations; use 'renderAnimation' instead.+ , animationID :: AnimationID+ -- ^ The animation's internally-managed ID+ , animationClip :: Clip s n+ -- ^ The animation's clip+ }++-- | Render an animation.+renderAnimation :: (s -> Widget n)+ -- ^ The fallback function to use for drawing if the+ -- animation is not running+ -> s+ -- ^ The state to provide when rendering the animation's+ -- current frame+ -> Maybe (Animation s n)+ -- ^ The animation state itself+ -> Widget n+renderAnimation fallback input mAnim =+ draw input+ where+ draw = fromMaybe fallback $ do+ a <- mAnim+ let idx = animationFrameIndex a+ Clip fs = animationClip a+ fs V.!? idx++data AnimationState s n =+ AnimationState { _animationStateID :: AnimationID+ , _animationNumFrames :: Int+ , _animationCurrentFrame :: Int+ , _animationFrameMilliseconds :: Integer+ , _animationRunMode :: RunMode+ , animationFrameUpdater :: Traversal' s (Maybe (Animation s n))+ , _animationNextFrameTime :: C.Time+ }++makeLenses ''AnimationState++-- | A manager for animations. The type variables for this type are the+-- same as those for 'Brick.Main.App'.+--+-- This asynchronously manages a set of running animations, advancing+-- each one over time. When a running animation's current frame needs+-- to be changed, the manager sends an 'EventM' update for that+-- animation to the application's event loop to perform the update to+-- the animation in the application state. The manager will batch such+-- updates if more than one animation needs to be changed at a time.+--+-- The manager has a /tick duration/ in milliseconds which is the+-- resolution at which animations are checked to see if they should+-- be updated. Animations also have their own frame duration in+-- milliseconds. For example, if a manager has a tick duration of 50+-- milliseconds and is running an animation with a frame duration of 100+-- milliseconds, then the manager will advance that animation by one+-- frame every two ticks. On the other hand, if a manager has a tick+-- duration of 100 milliseconds and is running an animation with a frame+-- duration of 50 milliseconds, the manager will advance that animation+-- by two frames on each tick.+--+-- Animation managers are started with 'startAnimationManager' and+-- stopped with 'stopAnimationManager'.+--+-- Animations are started with 'startAnimation' and stopped with+-- 'stopAnimation'. Each animation must be associated with an+-- application state field accessible with a traversal given to+-- 'startAnimation'.+--+-- When an animation is started, every time it advances a frame, and+-- when it is ended, the manager communicates these changes to the+-- application by using the custom event constructor provided to+-- 'startAnimationManager'. The manager uses that to schedule a state+-- update which the application is responsible for evaluating. The state+-- updates are built from the traversals provided to 'startAnimation'.+--+-- The manager-updated 'Animation' values in the application state are+-- then drawn with 'renderAnimation'.+--+-- Animations in 'Loop' mode are run forever until stopped with+-- 'stopAnimation'; animations in 'Once' mode run once and are removed+-- from the application state (set to 'Nothing') when they finish. All+-- state updates to the application state are performed by the manager's+-- custom event mechanism; the application never needs to directly+-- modify the 'Animation' application state fields except to initialize+-- them to 'Nothing'.+--+-- There is nothing here to prevent an application from running multiple+-- managers, each at a different tick rate. That may have performance+-- consequences, though, due to the loss of batch efficiency in state+-- updates, so we recommend using only one manager per application at a+-- sufficiently short tick duration.+data AnimationManager s e n =+ AnimationManager { animationMgrRequestThreadId :: ThreadId+ , animationMgrTickThreadId :: ThreadId+ , animationMgrOutputChan :: BChan e+ , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s n)+ , animationMgrEventConstructor :: EventM n s () -> e+ , animationMgrRunning :: STM.TVar Bool+ }++tickThreadBody :: Int+ -> STM.TChan (AnimationManagerRequest s n)+ -> IO ()+tickThreadBody tickMilliseconds outChan = do+ let nextTick = C.addOffset tickOffset+ tickOffset = C.offsetFromMs $ toInteger tickMilliseconds+ go targetTime = do+ now <- C.getTime+ STM.atomically $ STM.writeTChan outChan $ Tick now++ -- threadDelay does not guarantee that we will wake up on+ -- time; it only ensures that we won't wake up earlier than+ -- requested. Since we can therefore oversleep, instead of+ -- always sleeping for tickMilliseconds (which would cause+ -- us to drift off of schedule as delays accumulate) we+ -- determine sleep time by measuring the distance between+ -- now and the next scheduled tick. This is still unreliable+ -- as we can still oversleep, but it keeps the oversleeping+ -- under control over time. It means most ticks may be+ -- slightly late (about 1-2 milliseconds is common) but this+ -- will prevent that per-tick error from accumulating.+ let nextTickTime = nextTick targetTime+ sleepMs = fromInteger $+ C.offsetToMs $+ C.subtractTime nextTickTime now++ -- threadDelay works microseconds.+ threadDelay $ sleepMs * 1000+ go nextTickTime++ go =<< C.getTime++setNextFrameTime :: C.Time -> AnimationState s n -> AnimationState s n+setNextFrameTime t a = a & animationNextFrameTime .~ t++data ManagerState s e n =+ ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s n)+ , _managerStateOutChan :: BChan e+ , _managerStateEventBuilder :: EventM n s () -> e+ , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s n)+ , _managerStateIDVar :: STM.TVar AnimationID+ }++makeLenses ''ManagerState++animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s n)+ -> BChan e+ -> (EventM n s () -> e)+ -> IO ()+animationManagerThreadBody inChan outChan mkEvent = do+ idVar <- STM.newTVarIO $ AnimationID 1+ let initial = ManagerState { _managerStateInChan = inChan+ , _managerStateOutChan = outChan+ , _managerStateEventBuilder = mkEvent+ , _managerStateAnimations = mempty+ , _managerStateIDVar = idVar+ }+ evalStateT runManager initial++type ManagerM s e n a = StateT (ManagerState s e n) IO a++getNextManagerRequest :: ManagerM s e n (AnimationManagerRequest s n)+getNextManagerRequest = do+ inChan <- use managerStateInChan+ liftIO $ STM.atomically $ STM.readTChan inChan++sendApplicationStateUpdate :: EventM n s () -> ManagerM s e n ()+sendApplicationStateUpdate act = do+ outChan <- use managerStateOutChan+ mkEvent <- use managerStateEventBuilder+ liftIO $ writeBChan outChan $ mkEvent act++removeAnimation :: AnimationID -> ManagerM s e n ()+removeAnimation aId =+ managerStateAnimations %= HM.delete aId++lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (AnimationState s n))+lookupAnimation aId =+ HM.lookup aId <$> use managerStateAnimations++insertAnimation :: AnimationState s n -> ManagerM s e n ()+insertAnimation a =+ managerStateAnimations %= HM.insert (a^.animationStateID) a++getNextAnimationID :: ManagerM s e n AnimationID+getNextAnimationID = do+ var <- use managerStateIDVar+ liftIO $ STM.atomically $ do+ AnimationID i <- STM.readTVar var+ let next = AnimationID $ i + 1+ STM.writeTVar var next+ return $ AnimationID i++runManager :: ManagerM s e n ()+runManager = forever $ do+ getNextManagerRequest >>= handleManagerRequest++handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n ()+handleManagerRequest (StartAnimation clip frameMs runMode updater) = do+ aId <- getNextAnimationID+ now <- liftIO C.getTime+ let next = C.addOffset frameOffset now+ frameOffset = C.offsetFromMs frameMs+ a = AnimationState { _animationStateID = aId+ , _animationNumFrames = clipLength clip+ , _animationCurrentFrame = 0+ , _animationFrameMilliseconds = frameMs+ , _animationRunMode = runMode+ , animationFrameUpdater = updater+ , _animationNextFrameTime = next+ }++ insertAnimation a+ sendApplicationStateUpdate $ updater .= Just (Animation { animationID = aId+ , animationFrameIndex = 0+ , animationClip = clip+ })+handleManagerRequest (StopAnimation a) = do+ let aId = animationID a+ mA <- lookupAnimation aId+ case mA of+ Nothing -> return ()+ Just aState -> do+ -- Remove the animation from the manager+ removeAnimation aId++ -- Set the current animation state in the application state+ -- to none+ sendApplicationStateUpdate $ clearStateAction aState+handleManagerRequest Shutdown = do+ as <- HM.elems <$> use managerStateAnimations++ let updater = sequence_ $ clearStateAction <$> as+ when (not $ null as) $ do+ sendApplicationStateUpdate updater++ liftIO $ myThreadId >>= killThread+handleManagerRequest (Tick tickTime) = do+ -- Check all animation states for frame advances+ -- based on the relationship between the tick time+ -- and each animation's next frame time+ mUpdateAct <- checkAnimations tickTime+ case mUpdateAct of+ Nothing -> return ()+ Just act -> sendApplicationStateUpdate act++clearStateAction :: AnimationState s n -> EventM n s ()+clearStateAction a = animationFrameUpdater a .= Nothing++frameUpdateAction :: AnimationState s n -> EventM n s ()+frameUpdateAction a =+ animationFrameUpdater a._Just %=+ (\an -> an { animationFrameIndex = a^.animationCurrentFrame })++updateAnimationState :: C.Time -> AnimationState s n -> AnimationState s n+updateAnimationState now a =+ let differenceMs = C.offsetToMs $+ C.subtractTime now (a^.animationNextFrameTime)+ numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds))+ newNextTime = C.addOffset (C.offsetFromMs $ numFrames * (a^.animationFrameMilliseconds))+ (a^.animationNextFrameTime)++ -- The new frame is obtained by advancing from the current frame by+ -- numFrames.+ in setNextFrameTime newNextTime $ advanceBy numFrames a++checkAnimations :: C.Time -> ManagerM s e n (Maybe (EventM n s ()))+checkAnimations now = do+ let go a updaters = do+ result <- checkAnimation now a+ return $ case result of+ Nothing -> updaters+ Just u -> u : updaters++ anims <- use managerStateAnimations+ updaters <- foldrM go [] anims++ case updaters of+ [] -> return Nothing+ _ -> return $ Just $ sequence_ updaters++-- For each active animation, check to see if the animation's next frame+-- time has passed. If it has, advance its frame counter as appropriate+-- and schedule its frame index to be updated in the application state.+checkAnimation :: C.Time -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ()))+checkAnimation now a+ | isFinished a = do+ -- This animation completed in a previous check, so clear it+ -- from the manager and the application state.+ removeAnimation (a^.animationStateID)+ return $ Just $ clearStateAction a+ | (now < a^.animationNextFrameTime) =+ -- This animation is not due for an update, so don't do+ -- anything.+ return Nothing+ | otherwise = do+ -- This animation is still running, so determine how many frames+ -- have elapsed for it and then advance the frame index based+ -- the elapsed time. Also set its next frame time.+ let a' = updateAnimationState now a+ managerStateAnimations %= HM.insert (a'^.animationStateID) a'+ return $ Just $ frameUpdateAction a'++isFinished :: AnimationState s n -> Bool+isFinished a =+ case a^.animationRunMode of+ Once -> a^.animationCurrentFrame == a^.animationNumFrames - 1+ Loop -> False++advanceBy :: Integer -> AnimationState s n -> AnimationState s n+advanceBy n a+ | n <= 0 = a+ | otherwise =+ advanceBy (n - 1) $+ advanceByOne a++advanceByOne :: AnimationState s n -> AnimationState s n+advanceByOne a =+ if a^.animationCurrentFrame == a^.animationNumFrames - 1+ then case a^.animationRunMode of+ Loop -> a & animationCurrentFrame .~ 0+ Once -> a+ else a & animationCurrentFrame %~ (+ 1)++-- | The minimum tick duration in milliseconds allowed by+-- 'startAnimationManager'.+minTickTime :: Int+minTickTime = 25++-- | Start a new animation manager. For full details about how managers+-- work, see 'AnimationManager'.+--+-- If the specified tick duration is less than 'minTickTime', this will+-- call 'error'. This bound is in place to prevent API misuse leading to+-- ticking so fast that the terminal can't keep up with redraws.+startAnimationManager :: (MonadIO m)+ => Int+ -- ^ The tick duration for this manager in milliseconds+ -> BChan e+ -- ^ The event channel to use to send updates to+ -- the application (i.e. the same one given to+ -- e.g. 'Brick.Main.customVty')+ -> (EventM n s () -> e)+ -- ^ A constructor for building custom events+ -- that perform application state updates. The+ -- application must evaluate these custom events'+ -- 'EventM' actions in order to record animation+ -- updates in the application state.+ -> m (AnimationManager s e n)+startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickTime =+ error $ "startAnimationManager: tick duration too small (minimum is " <> show minTickTime <> ")"+startAnimationManager tickMilliseconds outChan mkEvent = liftIO $ do+ inChan <- STM.newTChanIO+ reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent+ tickTid <- forkIO $ tickThreadBody tickMilliseconds inChan+ runningVar <- STM.newTVarIO True+ return $ AnimationManager { animationMgrRequestThreadId = reqTid+ , animationMgrTickThreadId = tickTid+ , animationMgrEventConstructor = mkEvent+ , animationMgrOutputChan = outChan+ , animationMgrInputChan = inChan+ , animationMgrRunning = runningVar+ }++-- | Execute the specified action only when this manager is running.+whenRunning :: (MonadIO m) => AnimationManager s e n -> IO () -> m ()+whenRunning mgr act = do+ running <- liftIO $ STM.atomically $ STM.readTVar (animationMgrRunning mgr)+ when running $ liftIO act++-- | Stop the animation manager, ending all running animations.+stopAnimationManager :: (MonadIO m) => AnimationManager s e n -> m ()+stopAnimationManager mgr =+ whenRunning mgr $ do+ tellAnimationManager mgr Shutdown+ killThread $ animationMgrTickThreadId mgr+ STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False++-- | Send a request to an animation manager.+tellAnimationManager :: (MonadIO m)+ => AnimationManager s e n+ -- ^ The manager+ -> AnimationManagerRequest s n+ -- ^ The request to send+ -> m ()+tellAnimationManager mgr req =+ liftIO $+ STM.atomically $+ STM.writeTChan (animationMgrInputChan mgr) req++-- | Start a new animation at its first frame.+--+-- This will result in an application state update to initialize the+-- animation state at the provided traversal's location.+startAnimation :: (MonadIO m)+ => AnimationManager s e n+ -- ^ The manager to run the animation+ -> Clip s n+ -- ^ The frames for the animation+ -> Integer+ -- ^ The animation's frame duration in milliseconds+ -> RunMode+ -- ^ The animation's run mode+ -> Traversal' s (Maybe (Animation s n))+ -- ^ Where in the application state to manage this+ -- animation's state+ -> m ()+startAnimation mgr frames frameMs runMode updater =+ tellAnimationManager mgr $ StartAnimation frames frameMs runMode updater++-- | Stop an animation.+--+-- This will result in an application state update to remove the+-- animation state.+stopAnimation :: (MonadIO m)+ => AnimationManager s e n+ -> Animation s n+ -> m ()+stopAnimation mgr a =+ tellAnimationManager mgr $ StopAnimation a
+ src/Brick/Animation/Clock.hs view
@@ -0,0 +1,64 @@+-- | This module provides an API for working with+-- 'Data.Time.Clock.System.SystemTime' values similar to that of+-- 'Data.Time.Clock.UTCTime'. @SystemTime@s are more efficient to+-- obtain than @UTCTime@s, which is important to avoid animation+-- tick thread delays associated with expensive clock reads. In+-- addition, the @UTCTime@-based API provides unpleasant @Float@-based+-- conversions. Since the @SystemTime@-based API doesn't provide some+-- of the operations we need, and since it is easier to work with at+-- millisecond granularity, it is extended here for internal use.+module Brick.Animation.Clock+ ( Time+ , getTime+ , addOffset+ , subtractTime++ , Offset+ , offsetFromMs+ , offsetToMs+ )+where++import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Data.Time.Clock.System as C++newtype Time = Time C.SystemTime+ deriving (Ord, Eq)++-- | Signed difference in milliseconds+newtype Offset = Offset Integer+ deriving (Ord, Eq)++offsetFromMs :: Integer -> Offset+offsetFromMs = Offset++offsetToMs :: Offset -> Integer+offsetToMs (Offset ms) = ms++getTime :: (MonadIO m) => m Time+getTime = Time <$> liftIO C.getSystemTime++addOffset :: Offset -> Time -> Time+addOffset (Offset ms) (Time (C.MkSystemTime s ns)) =+ Time $ C.MkSystemTime (fromInteger s') (fromInteger ns')+ where+ -- Note that due to the behavior of divMod, this works even when+ -- the offset is negative: the number of seconds is decremented+ -- and the remainder of nanoseconds is correct.+ s' = newSec + toInteger s+ (newSec, ns') = (nsPerMs * ms + toInteger ns)+ `divMod` (msPerS * nsPerMs)++subtractTime :: Time -> Time -> Offset+subtractTime t1 t2 = Offset $ timeToMs t1 - timeToMs t2++timeToMs :: Time -> Integer+timeToMs (Time (C.MkSystemTime s ns)) =+ (toInteger s) * msPerS ++ (toInteger ns) `div` nsPerMs++nsPerMs :: Integer+nsPerMs = 1000000++msPerS :: Integer+msPerS = 1000
src/Brick/BorderMap.hs view
@@ -17,7 +17,9 @@ ) where import Brick.Types.Common (Edges(..), Location(..), eTopL, eBottomL, eRightL, eLeftL, origin)+#if !(MIN_VERSION_base(4,18,0)) import Control.Applicative (liftA2)+#endif import Data.IMap (IMap, Run(Run)) import GHC.Generics import Control.DeepSeq
src/Brick/Main.hs view
@@ -238,6 +238,10 @@ -- | Like 'customMainWithVty', except that Vty is initialized with the -- default configuration.+--+-- The returned 'Vty' handle still has control of the terminal. The+-- caller is responsible for calling 'shutdown' to restore the terminal+-- state. customMainWithDefaultVty :: (Ord n) => Maybe (BChan e) -- ^ An event channel for sending custom
src/Brick/Types/Common.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE CPP #-} module Brick.Types.Common ( Location(..) , locL@@ -16,10 +17,14 @@ import GHC.Generics import Control.DeepSeq import Lens.Micro (_1, _2)+#if MIN_VERSION_microlens(0,5,0)+import Lens.Micro.FieldN (Field1, Field2)+#else import Lens.Micro.Internal (Field1, Field2)+#endif -- | A terminal screen location.-data Location = Location { loc :: (Int, Int)+data Location = Location { loc :: !(Int, Int) -- ^ (Column, Row) } deriving (Show, Eq, Ord, Read, Generic, NFData)@@ -43,7 +48,7 @@ mempty = origin mappend = (Sem.<>) -data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a }+data Edges a = Edges { eTop, eBottom, eLeft, eRight :: !a } deriving (Eq, Ord, Read, Show, Functor, Generic, NFData) suffixLenses ''Edges
src/Brick/Types/Internal.hs view
@@ -103,16 +103,16 @@ import Brick.AttrMap (AttrName, AttrMap) import Brick.Widgets.Border.Style (BorderStyle) -data ScrollRequest = HScrollBy Int- | HScrollPage Direction+data ScrollRequest = HScrollBy !Int+ | HScrollPage !Direction | HScrollToBeginning | HScrollToEnd- | VScrollBy Int- | VScrollPage Direction+ | VScrollBy !Int+ | VScrollPage !Direction | VScrollToBeginning | VScrollToEnd- | SetTop Int- | SetLeft Int+ | SetTop !Int+ | SetLeft !Int deriving (Read, Show, Generic, NFData) -- | Widget size policies. These policies communicate how a widget uses@@ -131,9 +131,9 @@ -- | The type of widgets. data Widget n =- Widget { hSize :: Size+ Widget { hSize :: !Size -- ^ This widget's horizontal growth policy- , vSize :: Size+ , vSize :: !Size -- ^ This widget's vertical growth policy , render :: RenderM n (Result n) -- ^ This widget's rendering function@@ -230,21 +230,21 @@ } data VisibilityRequest =- VR { vrPosition :: Location- , vrSize :: DisplayRegion+ VR { vrPosition :: !Location+ , vrSize :: !DisplayRegion } deriving (Show, Eq, Read, Generic, NFData) -- | Describes the state of a viewport as it appears as its most recent -- rendering. data Viewport =- VP { _vpLeft :: Int+ VP { _vpLeft :: !Int -- ^ The column offset of left side of the viewport.- , _vpTop :: Int+ , _vpTop :: !Int -- ^ The row offset of the top of the viewport.- , _vpSize :: DisplayRegion+ , _vpSize :: !DisplayRegion -- ^ The size of the viewport.- , _vpContentSize :: DisplayRegion+ , _vpContentSize :: !DisplayRegion -- ^ The size of the contents of the viewport. } deriving (Show, Read, Generic, NFData)@@ -274,9 +274,9 @@ } data VtyContext =- VtyContext { vtyContextBuilder :: IO Vty- , vtyContextHandle :: Vty- , vtyContextThread :: ThreadId+ VtyContext { vtyContextBuilder :: !(IO Vty)+ , vtyContextHandle :: !Vty+ , vtyContextThread :: !ThreadId , vtyContextPutEvent :: Event -> IO () } @@ -330,27 +330,27 @@ -- | A border character has four segments, one extending in each direction -- (horizontally and vertically) from the center of the character. data BorderSegment = BorderSegment- { bsAccept :: Bool+ { bsAccept :: !Bool -- ^ Would this segment be willing to be drawn if a neighbor wanted to -- connect to it?- , bsOffer :: Bool+ , bsOffer :: !Bool -- ^ Does this segment want to connect to its neighbor?- , bsDraw :: Bool+ , bsDraw :: !Bool -- ^ Should this segment be represented visually? } deriving (Eq, Ord, Read, Show, Generic, NFData) -- | Information about how to redraw a dynamic border character when it abuts -- another dynamic border character. data DynBorder = DynBorder- { dbStyle :: BorderStyle+ { dbStyle :: !BorderStyle -- ^ The 'Char's to use when redrawing the border. Also used to filter -- connections: only dynamic borders with equal 'BorderStyle's will connect -- to each other.- , dbAttr :: Attr+ , dbAttr :: !Attr -- ^ What 'Attr' to use to redraw the border character. Also used to filter -- connections: only dynamic borders with equal 'Attr's will connect to -- each other.- , dbSegments :: Edges BorderSegment+ , dbSegments :: !(Edges BorderSegment) } deriving (Eq, Read, Show, Generic, NFData) -- | The type of result returned by a widget's rendering function. The@@ -394,23 +394,23 @@ } -- | The type of events.-data BrickEvent n e = VtyEvent Event+data BrickEvent n e = VtyEvent !Event -- ^ The event was a Vty event.- | AppEvent e+ | AppEvent !e -- ^ The event was an application event.- | MouseDown n Button [Modifier] Location+ | MouseDown !n !Button ![Modifier] !Location -- ^ A mouse-down event on the specified region was -- received. The 'n' value is the resource name of -- the clicked widget (see 'clickable').- | MouseUp n (Maybe Button) Location+ | MouseUp !n !(Maybe Button) !Location -- ^ A mouse-up event on the specified region was -- received. The 'n' value is the resource name of -- the clicked widget (see 'clickable'). deriving (Show, Eq, Ord) -data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport- , latestExtents :: [Extent n]- , oldState :: RenderState n+data EventRO n = EventRO { eventViewportMap :: !(M.Map n Viewport)+ , latestExtents :: ![Extent n]+ , oldState :: !(RenderState n) } -- | Clickable elements of a scroll bar.@@ -432,22 +432,22 @@ -- to render, which bordering style should be used, and the attribute map -- available for rendering. data Context n =- Context { ctxAttrName :: AttrName- , availWidth :: Int- , availHeight :: Int- , windowWidth :: Int- , windowHeight :: Int- , ctxBorderStyle :: BorderStyle- , ctxAttrMap :: AttrMap- , ctxDynBorders :: Bool- , ctxVScrollBarOrientation :: Maybe VScrollBarOrientation- , ctxVScrollBarRenderer :: Maybe (VScrollbarRenderer n)- , ctxHScrollBarOrientation :: Maybe HScrollBarOrientation- , ctxHScrollBarRenderer :: Maybe (HScrollbarRenderer n)- , ctxVScrollBarShowHandles :: Bool- , ctxHScrollBarShowHandles :: Bool- , ctxVScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n)- , ctxHScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n)+ Context { ctxAttrName :: !AttrName+ , availWidth :: !Int+ , availHeight :: !Int+ , windowWidth :: !Int+ , windowHeight :: !Int+ , ctxBorderStyle :: !BorderStyle+ , ctxAttrMap :: !AttrMap+ , ctxDynBorders :: !Bool+ , ctxVScrollBarOrientation :: !(Maybe VScrollBarOrientation)+ , ctxVScrollBarRenderer :: !(Maybe (VScrollbarRenderer n))+ , ctxHScrollBarOrientation :: !(Maybe HScrollBarOrientation)+ , ctxHScrollBarRenderer :: !(Maybe (HScrollbarRenderer n))+ , ctxVScrollBarShowHandles :: !Bool+ , ctxHScrollBarShowHandles :: !Bool+ , ctxVScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n))+ , ctxHScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n)) } suffixLenses ''RenderState
src/Brick/Widgets/Center.hs view
@@ -60,7 +60,7 @@ c <- getContext let rWidth = result^.imageL.to imageWidth rHeight = result^.imageL.to imageHeight- remainder = max 0 $ c^.availWidthL - (leftPaddingAmount * 2)+ remainder = max 0 $ c^.availWidthL - (rWidth + (leftPaddingAmount * 2)) leftPaddingAmount = max 0 $ (c^.availWidthL - rWidth) `div` 2 rightPaddingAmount = max 0 $ leftPaddingAmount + remainder leftPadding = charFill (c^.attrL) ch leftPaddingAmount rHeight
src/Brick/Widgets/Core.hs view
@@ -340,7 +340,7 @@ -- input text should not contain escape sequences or carriage returns. txt :: T.Text -> Widget n txt s =- -- Althoguh vty Image uses lazy Text internally, using lazy text at this+ -- Although vty Image uses lazy Text internally, using lazy text at this -- level may not be an improvement. Indeed it can be much worse, due -- the overhead of lazy Text being significant compared to the typically -- short string content used to compose UIs.@@ -719,12 +719,11 @@ (concatMap extents allTranslatedResults) newBorders -catDynBorder- :: Lens' (Edges BorderSegment) BorderSegment- -> Lens' (Edges BorderSegment) BorderSegment- -> DynBorder- -> DynBorder- -> Maybe DynBorder+catDynBorder :: Lens' (Edges BorderSegment) BorderSegment+ -> Lens' (Edges BorderSegment) BorderSegment+ -> DynBorder+ -> DynBorder+ -> Maybe DynBorder catDynBorder towardsA towardsB a b -- Currently, we check if the 'BorderStyle's are exactly the same. In the -- future, it might be nice to relax this restriction. For example, if a@@ -742,12 +741,11 @@ = Just (a & dbSegmentsL.towardsB.bsDrawL .~ True) | otherwise = Nothing -catDynBorders- :: Lens' (Edges BorderSegment) BorderSegment- -> Lens' (Edges BorderSegment) BorderSegment- -> I.IMap DynBorder- -> I.IMap DynBorder- -> I.IMap DynBorder+catDynBorders :: Lens' (Edges BorderSegment) BorderSegment+ -> Lens' (Edges BorderSegment) BorderSegment+ -> I.IMap DynBorder+ -> I.IMap DynBorder+ -> I.IMap DynBorder catDynBorders towardsA towardsB am bm = I.mapMaybe id $ I.intersectionWith (catDynBorder towardsA towardsB) am bm @@ -757,9 +755,8 @@ -- images to keep the image in sync with the border information. -- -- The input borders are assumed to be disjoint. This property is not checked.-catBorders- :: (border ~ BM.BorderMap DynBorder, rewrite ~ I.IMap V.Image)- => BoxRenderer n -> border -> border -> ((rewrite, rewrite), border)+catBorders :: (border ~ BM.BorderMap DynBorder, rewrite ~ I.IMap V.Image)+ => BoxRenderer n -> border -> border -> ((rewrite, rewrite), border) catBorders br r l = if lCoord + 1 == rCoord then ((lRe, rRe), lr') else ((I.empty, I.empty), lr)@@ -788,20 +785,20 @@ -- overlap and are strictly increasing in the primary direction), produce: a -- list of rewrites for the lo and hi directions of each border, respectively, -- and the borders describing the fully concatenated object.-catAllBorders ::- BoxRenderer n ->- [BM.BorderMap DynBorder] ->- ([(I.IMap V.Image, I.IMap V.Image)], BM.BorderMap DynBorder)+catAllBorders :: BoxRenderer n+ -> [BM.BorderMap DynBorder]+ -> ([(I.IMap V.Image, I.IMap V.Image)], BM.BorderMap DynBorder) catAllBorders _ [] = ([], BM.empty) catAllBorders br (bm:bms) = (zip ([I.empty]++los) (his++[I.empty]), bm') where (rewrites, bm') = runState (traverse (state . catBorders br) bms) bm (his, los) = unzip rewrites -rewriteEdge ::- (Int -> V.Image -> V.Image) ->- (Int -> V.Image -> V.Image) ->- ([V.Image] -> V.Image) ->- I.IMap V.Image -> V.Image -> V.Image+rewriteEdge :: (Int -> V.Image -> V.Image)+ -> (Int -> V.Image -> V.Image)+ -> ([V.Image] -> V.Image)+ -> I.IMap V.Image+ -> V.Image+ -> V.Image rewriteEdge splitLo splitHi combine = (combine .) . go . offsets 0 . I.unsafeToAscList where -- convert absolute positions into relative ones@@ -1084,15 +1081,16 @@ -- | Given a widget, translate it to position it relative to the -- upper-left coordinates of a reported extent with the specified -- positioning offset. If the specified name has no reported extent,--- this just draws the specified widget with no special positioning.+-- this draws nothing on the basis that it only makes sense to draw what+-- was requested when the relative position can be known. -- -- This is only useful for positioning something in a higher layer -- relative to a reported extent in a lower layer. Any other use is--- likely to result in the specified widget being rendered as-is with--- no translation. This is because this function relies on information--- about lower layer renderings in order to work; using it with a--- resource name that wasn't rendered in a lower layer will result in--- this being equivalent to @id@.+-- likely to result in the specified widget not being rendered. This+-- is because this function relies on information about lower layer+-- renderings in order to work; using it with a resource name that+-- wasn't rendered in a lower layer will result in this being equivalent+-- to @emptyWidget@. -- -- For example, if you have two layers @topLayer@ and @bottomLayer@, -- then a widget drawn in @bottomLayer@ with @reportExtent Foo@ can be@@ -1103,7 +1101,7 @@ Widget (hSize w) (vSize w) $ do mExt <- lookupReportedExtent n case mExt of- Nothing -> render w+ Nothing -> render emptyWidget Just ext -> render $ translateBy (extentUpperLeft ext <> off) w -- | Crop the specified widget on the left by the specified number of@@ -1114,8 +1112,11 @@ result <- render p let amt = V.imageWidth (result^.imageL) - cols cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img- return $ addResultOffset (Location (-1 * cols, 0))- $ result & imageL %~ cropped+ render $ Widget (hSize p) (vSize p) $+ withReaderT (availWidthL .~ amt) $+ cropResultToContext $+ addResultOffset (Location (-1 * cols, 0)) $+ result & imageL %~ cropped -- | Crop the specified widget to the specified size from the left. -- Defers to the cropped widget for growth policy.@@ -1137,7 +1138,8 @@ result <- render p let amt = V.imageWidth (result^.imageL) - cols cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img- return $ result & imageL %~ cropped+ withReaderT (availWidthL .~ amt) $+ cropResultToContext $ result & imageL %~ cropped -- | Crop the specified widget to the specified size from the right. -- Defers to the cropped widget for growth policy.@@ -1159,8 +1161,11 @@ result <- render p let amt = V.imageHeight (result^.imageL) - rows cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img- return $ addResultOffset (Location (0, -1 * rows))- $ result & imageL %~ cropped+ render $ Widget (hSize p) (vSize p) $+ withReaderT (availHeightL .~ amt) $+ cropResultToContext $+ addResultOffset (Location (0, -1 * rows)) $+ result & imageL %~ cropped -- | Crop the specified widget to the specified size from the top. -- Defers to the cropped widget for growth policy.@@ -1182,7 +1187,8 @@ result <- render p let amt = V.imageHeight (result^.imageL) - rows cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img- return $ result & imageL %~ cropped+ withReaderT (availHeightL .~ amt) $+ cropResultToContext $ result & imageL %~ cropped -- | Crop the specified widget to the specified size from the bottom. -- Defers to the cropped widget for growth policy.@@ -1253,7 +1259,6 @@ renderedClickables renderResult = do allClickables <- use clickableNamesL return [extentName e | e <- renderResult^.extentsL, extentName e `elem` allClickables]- cacheLookup :: (Ord n) => n -> RenderM n (Maybe ([n], Result n)) cacheLookup n = do
src/Brick/Widgets/Edit.hs view
@@ -169,7 +169,7 @@ -> Editor T.Text n editorText = editor --- | Construct an editor over 'String' values+-- | Construct an editor over generic text values editor :: Z.GenericTextZipper a => n -- ^ The editor's name (must be unique)
src/Brick/Widgets/FileBrowser.hs view
@@ -71,6 +71,7 @@ , actionFileBrowserBeginSearch , actionFileBrowserSelectEnter , actionFileBrowserSelectCurrent+ , actionFileBrowserToggleCurrent , actionFileBrowserListPageUp , actionFileBrowserListPageDown , actionFileBrowserListHalfPageUp@@ -158,7 +159,7 @@ import qualified Data.Set as Set import qualified Data.Vector as V import Lens.Micro-import Lens.Micro.Mtl ((%=))+import Lens.Micro.Mtl ((%=), use) import Lens.Micro.TH (lensRules, generateUpdateableOptics) import qualified Graphics.Vty as Vty import qualified System.Directory as D@@ -602,7 +603,7 @@ -- -- * @/@: 'actionFileBrowserBeginSearch' -- * @Enter@: 'actionFileBrowserSelectEnter'--- * @Space@: 'actionFileBrowserSelectCurrent'+-- * @Space@: 'actionFileBrowserToggleCurrent' -- * @g@: 'actionFileBrowserListTop' -- * @G@: 'actionFileBrowserListBottom' -- * @j@: 'actionFileBrowserListNext'@@ -625,6 +626,10 @@ actionFileBrowserSelectCurrent = selectCurrentEntry +actionFileBrowserToggleCurrent :: EventM n (FileBrowser n) ()+actionFileBrowserToggleCurrent =+ toggleCurrentEntrySelected+ actionFileBrowserListPageUp :: Ord n => EventM n (FileBrowser n) () actionFileBrowserListPageUp = zoom fileBrowserEntriesL listMovePageUp@@ -697,8 +702,8 @@ -- Select file or enter directory actionFileBrowserSelectEnter Vty.EvKey (Vty.KChar ' ') [] ->- -- Select entry- actionFileBrowserSelectCurrent+ -- Toggle selected status of current entry+ actionFileBrowserToggleCurrent _ -> handleFileBrowserEventCommon e @@ -728,9 +733,29 @@ _ -> zoom fileBrowserEntriesL $ handleListEvent e -markSelected :: FileInfo -> EventM n (FileBrowser n) ()-markSelected e = fileBrowserSelectedFilesL %= Set.insert (fileInfoFilename e)+toggleSelected :: FileInfo -> EventM n (FileBrowser n) ()+toggleSelected e = do+ sel <- fileBrowserIsSelected e+ if sel+ then fileBrowserRemoveSelected e+ else fileBrowserAddSelected e +fileBrowserIsSelected :: FileInfo -> EventM n (FileBrowser n) Bool+fileBrowserIsSelected e = do+ fs <- use fileBrowserSelectedFilesL+ let fName = fileInfoFilename e+ return $ Set.member fName fs++fileBrowserAddSelected :: FileInfo -> EventM n (FileBrowser n) ()+fileBrowserAddSelected e = do+ let fName = fileInfoFilename e+ fileBrowserSelectedFilesL %= Set.insert fName++fileBrowserRemoveSelected :: FileInfo -> EventM n (FileBrowser n) ()+fileBrowserRemoveSelected e = do+ let fName = fileInfoFilename e+ fileBrowserSelectedFilesL %= Set.delete fName+ -- | If the browser's current entry is selectable according to -- @fileBrowserSelectable@, add it to the selection set and return. -- If not, and if the entry is a directory or a symlink targeting a@@ -742,14 +767,23 @@ b <- get for_ (fileBrowserCursor b) $ \entry -> if fileBrowserSelectable b entry- then markSelected entry+ then fileBrowserAddSelected entry else when (selectDirectories entry) $ put =<< liftIO (setWorkingDirectory (fileInfoFilePath entry) b) selectCurrentEntry :: EventM n (FileBrowser n) () selectCurrentEntry = do b <- get- for_ (fileBrowserCursor b) markSelected+ for_ (fileBrowserCursor b) $ \entry ->+ when (fileBrowserSelectable b entry) $+ fileBrowserAddSelected entry++toggleCurrentEntrySelected :: EventM n (FileBrowser n) ()+toggleCurrentEntrySelected = do+ b <- get+ for_ (fileBrowserCursor b) $ \entry ->+ when (fileBrowserSelectable b entry) $+ toggleSelected entry -- | Render a file browser. This renders a list of entries in the -- working directory, a cursor to select from among the entries, a
src/Brick/Widgets/Internal.hs view
@@ -8,7 +8,7 @@ ) where -import Lens.Micro ((^.), (&), (%~))+import Lens.Micro ((^.), (&), (%~), (.~)) import Lens.Micro.Mtl ((%=)) import Control.Monad import Control.Monad.State.Strict@@ -35,7 +35,13 @@ renderFinal aMap layerRenders (w, h) chooseCursor rs = (newRS, picWithBg, theCursor, concat layerExtents) where- (layerResults, !newRS) = flip runState rs $ sequence $+ -- Reset various fields from the last rendering state so they+ -- don't accumulate or affect this rendering.+ resetRs = rs & reportedExtentsL .~ mempty+ & observedNamesL .~ mempty+ & clickableNamesL .~ mempty++ (layerResults, !newRS) = flip runState resetRs $ sequence $ (\p -> runReaderT p ctx) <$> (\layerWidget -> do result <- render $ cropToContext layerWidget@@ -107,29 +113,31 @@ cropExtents :: Context n -> [Extent n] -> [Extent n] cropExtents ctx es = mapMaybe cropExtent es where- -- An extent is cropped in places where it is not within the- -- region described by the context.- --- -- If its entirety is outside the context region, it is dropped.- --- -- Otherwise its size is adjusted so that it is contained within- -- the context region. cropExtent (Extent n (Location (c, r)) (w, h)) =- -- Determine the new lower-right corner- let endCol = c + w- endRow = r + h- -- Then clamp the lower-right corner based on the- -- context- endCol' = min (ctx^.availWidthL) endCol- endRow' = min (ctx^.availHeightL) endRow- -- Then compute the new width and height from the- -- clamped lower-right corner.- w' = endCol' - c- h' = endRow' - r- e = Extent n (Location (c, r)) (w', h')- in if w' < 0 || h' < 0- then Nothing- else Just e+ -- Clamp the original extent's UL corner to the context.+ --+ -- Clamp the original extent's LR corner to the context.+ --+ -- Keep the modified extent (i.e. with clamped corners)+ -- only if the resulting extent has non-zero size in both+ -- dimensions.+ let nonEmpty = nonEmptyH && nonEmptyV+ nonEmptyH = newWidth > 0+ nonEmptyV = newHeight > 0+ newWidth = newEndCol - newStartCol+ newHeight = newEndRow - newStartRow+ (newStartCol, newStartRow) = clampCorner (c, r)+ (newEndCol, newEndRow) = clampCorner (c + w, r + h)+ clampCorner (cols, rows) =+ ( clampRange (ctx^.availWidthL) cols+ , clampRange (ctx^.availHeightL) rows+ )+ clampRange bound val =+ min bound $ max 0 val+ newExtent = Extent n (Location (newStartCol, newStartRow)) (newWidth, newHeight)+ in if nonEmpty+ then Just newExtent+ else Nothing cropBorders :: Context n -> BorderMap DynBorder -> BorderMap DynBorder cropBorders ctx = BM.crop Edges
src/Brick/Widgets/List.hs view
@@ -63,6 +63,9 @@ , listReverse , listModify + -- * Querying a list+ , listFindFirst+ -- * Attributes , listAttr , listSelectedAttr@@ -577,6 +580,20 @@ -> GenericList n t e -> GenericList n t e listMoveToElement e = listFindBy (== e) . set listSelectedL Nothing++-- | Find the first element in the list that satisfies the specified+-- predicate. If such an element is found, return the resulting index+-- and element.+--+-- /O(n)/.+listFindFirst :: (Semigroup (t e), Splittable t, Traversable t)+ => (e -> Bool)+ -> GenericList n t e+ -> Maybe (Int, e)+listFindFirst f l =+ listSelectedElement $+ listFindBy f $+ set listSelectedL Nothing l -- | Starting from the currently-selected position, attempt to find -- and select the next element matching the predicate. If there are no
tests/List.hs view
@@ -348,6 +348,15 @@ in l' ^. listSelectedL == Just 1 && l'' ^. listSelectedL == Just 3 +prop_listFindFirst :: Bool+prop_listFindFirst =+ let v = L [1..5] :: L Int+ l = list () v 1+ result1 = listFindFirst even l+ result2 = listFindFirst (> 10) l+ in result1 == Just (1, 2) &&+ result2 == Nothing+ prop_listSelectedElement_lazy :: Bool prop_listSelectedElement_lazy = let v = L (1:2:3:4:undefined) :: L Int