vty 5.14 → 5.15
raw patch · 82 files changed
+2157/−2175 lines, 82 filesdep −data-defaultdep ~base
Dependencies removed: data-default
Dependency ranges changed: base
Files
- AUTHORS +4/−2
- CHANGELOG +0/−367
- CHANGELOG.md +428/−0
- Demo.hs +0/−84
- ModeDemo.hs +0/−53
- README.md +70/−52
- TODO +0/−15
- demos/Demo.hs +82/−0
- demos/ModeDemo.hs +53/−0
- dist/build/verify-attribute-opsStub/verify-attribute-opsStub-tmp/verify-attribute-opsStub.hs +0/−5
- dist/build/verify-crop-span-generationStub/verify-crop-span-generationStub-tmp/verify-crop-span-generationStub.hs +0/−5
- dist/build/verify-display-attributesStub/verify-display-attributesStub-tmp/verify-display-attributesStub.hs +0/−5
- dist/build/verify-empty-image-propsStub/verify-empty-image-propsStub-tmp/verify-empty-image-propsStub.hs +0/−5
- dist/build/verify-eval-terminfo-capsStub/verify-eval-terminfo-capsStub-tmp/verify-eval-terminfo-capsStub.hs +0/−5
- dist/build/verify-image-opsStub/verify-image-opsStub-tmp/verify-image-opsStub.hs +0/−5
- dist/build/verify-image-transStub/verify-image-transStub-tmp/verify-image-transStub.hs +0/−5
- dist/build/verify-inlineStub/verify-inlineStub-tmp/verify-inlineStub.hs +0/−5
- dist/build/verify-layers-span-generationStub/verify-layers-span-generationStub-tmp/verify-layers-span-generationStub.hs +0/−5
- dist/build/verify-parse-terminfo-capsStub/verify-parse-terminfo-capsStub-tmp/verify-parse-terminfo-capsStub.hs +0/−5
- dist/build/verify-simple-span-generationStub/verify-simple-span-generationStub-tmp/verify-simple-span-generationStub.hs +0/−5
- dist/build/verify-terminalStub/verify-terminalStub-tmp/verify-terminalStub.hs +0/−5
- dist/build/verify-using-mock-terminalStub/verify-using-mock-terminalStub-tmp/verify-using-mock-terminalStub.hs +0/−5
- dist/build/verify-utf8-widthStub/verify-utf8-widthStub-tmp/verify-utf8-widthStub.hs +0/−5
- src/Codec/Binary/UTF8/Debug.hs +3/−4
- src/Data/Terminfo/Eval.hs +12/−20
- src/Data/Terminfo/Parse.hs +41/−50
- src/Graphics/Text/Width.hs +17/−13
- src/Graphics/Vty.hs +55/−68
- src/Graphics/Vty/Attributes.hs +71/−79
- src/Graphics/Vty/Attributes/Color.hs +69/−20
- src/Graphics/Vty/Attributes/Color240.hs +10/−10
- src/Graphics/Vty/Config.hs +45/−57
- src/Graphics/Vty/Debug.hs +8/−9
- src/Graphics/Vty/Debug/Image.hs +1/−1
- src/Graphics/Vty/DisplayAttributes.hs +18/−30
- src/Graphics/Vty/Error.hs +3/−3
- src/Graphics/Vty/Image.hs +170/−108
- src/Graphics/Vty/Image/Internal.hs +60/−64
- src/Graphics/Vty/Inline.hs +38/−42
- src/Graphics/Vty/Inline/Unsafe.hs +4/−14
- src/Graphics/Vty/Input.hs +94/−115
- src/Graphics/Vty/Input/Classify.hs +17/−19
- src/Graphics/Vty/Input/Classify/Parse.hs +8/−7
- src/Graphics/Vty/Input/Classify/Types.hs +3/−2
- src/Graphics/Vty/Input/Events.hs +9/−7
- src/Graphics/Vty/Input/Loop.hs +25/−20
- src/Graphics/Vty/Input/Mouse.hs +6/−5
- src/Graphics/Vty/Input/Paste.hs +5/−4
- src/Graphics/Vty/Input/Terminfo.hs +28/−29
- src/Graphics/Vty/Input/Terminfo/ANSIVT.hs +20/−19
- src/Graphics/Vty/Output.hs +39/−39
- src/Graphics/Vty/Output/Interface.hs +94/−86
- src/Graphics/Vty/Output/Mock.hs +33/−22
- src/Graphics/Vty/Output/TerminfoBased.hs +106/−104
- src/Graphics/Vty/Output/XTermColor.hs +13/−21
- src/Graphics/Vty/Picture.hs +54/−40
- src/Graphics/Vty/PictureToSpans.hs +58/−71
- src/Graphics/Vty/Prelude.hs +0/−18
- src/Graphics/Vty/Span.hs +38/−44
- test/Verify.hs +20/−31
- test/Verify/Data/Terminfo/Parse.hs +17/−17
- test/Verify/Graphics/Vty/Attributes.hs +7/−7
- test/Verify/Graphics/Vty/DisplayAttributes.hs +5/−5
- test/Verify/Graphics/Vty/Image.hs +18/−18
- test/Verify/Graphics/Vty/Output.hs +5/−7
- test/Verify/Graphics/Vty/Picture.hs +13/−13
- test/Verify/Graphics/Vty/Prelude.hs +5/−7
- test/Verify/Graphics/Vty/Span.hs +6/−6
- test/VerifyConfig.hs +1/−3
- test/VerifyCropSpanGeneration.hs +2/−3
- test/VerifyEmptyImageProps.hs +1/−1
- test/VerifyEvalTerminfoCaps.hs +13/−12
- test/VerifyImageOps.hs +25/−26
- test/VerifyImageTrans.hs +1/−1
- test/VerifyLayersSpanGeneration.hs +9/−7
- test/VerifyOutput.hs +7/−8
- test/VerifyParseTerminfoCaps.hs +3/−4
- test/VerifySimpleSpanGeneration.hs +8/−8
- test/VerifyUsingMockInput.hs +22/−21
- test/VerifyUsingMockTerminal.hs +23/−15
- test/VerifyUtf8Width.hs +2/−0
- vty.cabal +32/−48
AUTHORS view
@@ -1,4 +1,6 @@-The following people should be thanked for contributing to the vty library:+The following people should be thanked for contributing to the vty+library:+ * Andrea Vezzosi * Corey O'Connor * Emily Backes@@ -17,4 +19,4 @@ * Yoshikuni Jujo * Dmitry Ivanov -Plus others.. Check the git log for a full list.+Plus others.. Check the git log and CHANGELOG.md for a full list.
− CHANGELOG
@@ -1,367 +0,0 @@-5.14- - addMaybeClippedJoin: instead of raising an exception when the join- is totally clipped, just reduce the clip amount and continue- - addMaybeClipped: skip blit of joins when their primary dimension is- zero- - 'string' and related text functions no longer treat an empty string- as an empty image (thanks Chris Penner). This means that now it is- possible to use 'str ""' as a non-empty image with height 1.--5.13- - Reverted changes in 5.12 due to disagreements between terminal emulators- and utf8proc; for more details, please see the ticket discussion at- https://github.com/coreyoconnor/vty/issues/115--5.12- - Replaced 'wcwidth' with a call to the utf8proc library's character- width function, which is much more up to date (by several Unicode- versions) and returns the right width for a much larger set of- characters.- - Added a bundled version of the utf8proc C library.--5.11.3- - Fix mouse event offsets in mouse-up events--5.11.2- - Mouse events were modified so that the upper-left corner of the window is- (0,0) rather than (1,1).--5.11.1- - Add Generic instance for Image- - nextEvent: stop trying to refresh on a resize event (fixes segfault- on refresh with normal cursor positioning mode)- - Remove redundant clause from clipForCharWidth (thanks Eric Mertens)- - Update maintainer--5.11- - Vty now raises a VtyConfigurationError exception when the TERM- evironment variable is missing (thanks Eric Mertens)- - Graphics.Vty.Config got an explicit export list to avoid accidentally- exporting internal types (thanks Eric Mertens)--5.10- - Add absolute cursor positioning mode AbsoluteCursor to Cursor. This- mode provides greater control over cursor positioning by bypassing- the logical positioning provided by default. Rather than positioning- the cursor by looking at the widths of characters involved, this- constructor lets you provide a physical row and column instead. This- is useful in more sophisticated programs. (thanks Eric Mertens)- - Added a new Generic-derived config parser (thanks Eric Mertens)- - Fixed the MShift case in the configuration file parser (thanks Eric- Mertens)- - Fixed wcwidth import and matched safeWcswidth to its documented- behavior. Previously vty_mk_wcwidth was being imported with- the wrong type causing the -1 return value to be mapped to the- wrong Int value. Additionally safeWcswidth was using the unsafe- character width function and only ensuring that the final result was- non-negative. (thanks Eric Mertens)--5.9.1- - Vty now only emits UTF8 charset sequences in terminals without a- preexisting UTF8 declaration to avoid emitting garbage sequences- (fixes #89)--5.9- - Added new Output methods supportsBell and ringTerminalBell to find out- whether the output device has an audio bell and to ring it (see #102)--5.8.1- - Fixed "refresh" to work as advertised (see #104)--5.8- - API change: EvPaste input event now provides paste data as a raw- ByteString rather than a String to allow the application to decode- how best to decode it--5.7.1- - ModeDemo: added an explicit Control.Applicative import for older GHCs--5.7- - Mouse and paste modes are now off by default.- - The Config type got new fields: mouseMode and bracketedPasteMode. These- determine whether these modes are enabled initially (for terminals- that support them).- - Added a Mode type for modal terminal features (mouse events, bracketed- paste mode) that is used with new Output interface functions:- * supportsMode :: Mode -> Bool tells whether the device supports a- mode- * setMode :: Mode -> Bool -> IO () turns a mode on or off- * getModeStatus :: Mode -> IO Bool tells you whether a mode is on or- off- - Added a new demo program, ModeDemo.hs, to demonstrate usage of modes--5.6- - Added support for normal and extended mouse modes in Xterm-like- terminals via the MouseDown and MouseUp Event constructors- - Added support for bracketed paste mode in Xterm-like terminals via- the EvPaste event constructor- - Added derived Show instances for Event and Button (thanks Felix- Hirn)- - Now TERM values containing "screen" will automatically use the- XtermColor driver rather than just TerminfoBased--5.5.0- - Replaced lens dependency with microlens, microlens-mtl, microlens-th dependencies. Issue #90- - Thanks Jonathan Daugherty- - Cabal corrections.- - Thanks Lennart Spitzner--5.4.0- - Changed eventChannel of Graphics.Vty.Input from Chan to TChan. This enables clients to query if- there are no pending events. The Graphics.Vty interface nextEvent is unchanged. Clients that use- eventChannel directly will require updating.- https://github.com/coreyoconnor/vty/issues/60-5.3.1- - Reverted cabal file to depend on Cabal >= 1.18 instead of 1.20 due- to possibly breaking this on reasonable GHC versions--5.3- - Upgraded QuickCheck dependency to 2.7- - The standard IO Config (standardIOConfig) was overriding any provided application config.- In addition, the inputFd and outputFd could not be changed if mkVty was used.- Fixed.- - Correct handling of display attributes at end of line. The output attributes are set to default- at the end of content for the line and at the start of a new line. Previously the current- attribute would extend to the next start of content. This was odd to reason about and was the- cause of https://github.com/coreyoconnor/vty/issues/76- IIRC Yi requires the old behavior to display the selection region correctly.- - shutdown of the input thread is now performed using killThread and synchronization on an MVar.- For correct handling of the terminal read vmin and vtime the read must be a blocking read on an- OS thread. This places a threadWaitRead, which will be interrupted by the killThread, prior to- the uninterruptable read. An alternative would be to re-import the read foreign call as- interruptable.--5.2.11- - deepseq bounds increased for tests.- - Clean up warnings when compiling on 7.10- - Thanks Eric Mertens- - Avoid discarding input bytes after multi-byte encoded codepoint- - Thanks Eric Mertens--5.2.10- - "str" now returns EmptyImage for empty strings to match behavior of other string-like Image constructors (fixes #74)- - Thanks Jonathan Daugherty--5.2.9- - dependency version bumps- - https://github.com/coreyoconnor/vty/pull/71- - https://github.com/coreyoconnor/vty/pull/70- - Correct/Simplify the example code- - Thanks glguy- - https://github.com/coreyoconnor/vty/pull/69--5.2.8- - blaze-builder, lens, utf8-string version constraint bump- - Thanks glguy- - https://github.com/coreyoconnor/vty/pull/67- - Do not differentiate based on TERM_PROGRAM- - https://github.com/coreyoconnor/vty/issues/68--5.2.7- - lens and deepseq constraint bump + misc- - Thanks ethercrow- - https://github.com/coreyoconnor/vty/pull/66--5.2.6- - lens constraint bump- - Thanks alexander-b!- - https://github.com/coreyoconnor/vty/pull/64--5.2.5- - lens and random version constraint bump.- - Thanks RyanGlScott!- - https://github.com/coreyoconnor/vty/pull/62--5.2.4- - removed -fpic from cc-options. No longer required.- - https://github.com/coreyoconnor/vty/issues/61- - https://ghc.haskell.org/trac/ghc/ticket/9657- - Thanks Fuuzetsu!--5.2.3- - evaluate/compile the input parsing table once instead of each keystroke.- - https://github.com/coreyoconnor/vty/pull/59- - Thanks ethercrow!--5.2.2- - When looking at input for an event, don't look too deep.- - https://github.com/coreyoconnor/vty/pull/57- - Thanks ethercrow!--5.2.1- - Bump upper version bound for lens to 4.5. Thanks markus1189!--5.2.0- - Config structure now specifies file descriptor to use. The default is stdInput and stdOutput- file descriptors. Previously Vty used stdInput for input and the follow code for output:- - hDuplicate stdout >>= handleToFd >>= (`hSetBuffering` NoBuffering)- - the difference was required by Vty.Inline. Now, Vty.Inline uses the Config structure options- to acheive the same effect.- - removed: derivedVtime, derivedVmin, inputForCurrentTerminal, inputForNameAndIO,- outputForCurrentTerminal, outputForNameAndIO- - added: inputForConfig, outputForConfig- - updates to vty-rogue from jtdaugherty. Thanks!- - the oldest version of GHC tested to support vty is 7.6.2.- - the oldest version of GHC that vty compiles under is 7.4.2--5.1.4- - merged https://github.com/coreyoconnor/vty/pull/51 thanks trofi!--5.1.1- - merged https://github.com/coreyoconnor/vty/pull/48 thanks sjmielke!- - jtdaugherty resolved a number of compiler warnings. Thanks!--5.1.0- - vmin and vtime can be specified however the application requires. See Graphics.Vty.Config.- - fixed the processing of input when vmin is set > 1.--5.0.0- - The naming convention now matches:- - http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions- - all projects using vty for input must be compiled with -threaded. Please notify vty author if- this is not acceptable.- - mkVtyEscDelay has been removed. Use "mkVty def". Which initialized vty with the default- configuration.- - input handling changes- - KASCII is now KChar- - KPN5 is now KCenter- - tests exist.- - Applications can add to the input tables by setting inputMap of the Config.- See Graphics.Vty.Config- - Users can define input table extensions that will apply to all vty applications.- See Graphics.Vty.Config- - terminal timing is now handled by selecting an appropriate VTIME. Previously this was- implemented within Vty itself. This reduced complexity in vty but provides a different meta- key behavior and implies a requirement on -threaded.- - The time vty will wait to verify an ESC byte means a single ESC key is the- singleEscPeriod of the Input Config structure.- - removed the typeclass based terminal and display context interface in favor of a data- structure of properties interface.- - renamed the Terminal interface to Output- - The default picture for an image now uses the "clear" background. This background fills- background spans with spaces or just ends the line.- - Previously the background defaulted to the space character. This causes issues copying- text from a text editor. The text would end up with extra spaces at the end of the line.- - Layer support- - Each layer is an image.- - The layers for a picture are a list of images.- - The first image is the top-most layer. The images are ordered from top to bottom.- - The transparent areas for a layer are the backgroundFill areas. backgroundFill is- added to pad images when images of different sizes are joined.- - If the background is clear there is no background layer.- - If there is a background character then the bottom layer is the background layer.- - emptyPicture is a Picture with no layers and no cursor- - addToTop and addToBottom add a layer to the top and bottom of the given Picture.- - compatibility improvements:- - terminfo based terminals with no cursor support are silently accepted. The cursor- visibility changes in the Picture will have no effect.- - alternate (setf/setb) color maps supported. Though colors beyond the first 8 are just a- guess.- - added "rgbColor" for easy support of RGB specified colors.- - Both applications and users can add to the mapping used to translate from input bytes to- events.- - Additional information about input and output process can be appended to a debug log- - Set environment variable VTY_DEBUG_LOG to path of debug log- - Or use "debugLog <path>" config directive- - Or set 'debugLog' property of the Config provided to mkVty.- - examples moved to vty-examples package. See test directory for cabal file.- - vty-interactive-terminal-test- - interactive test. Useful for building a bug report for vty's author.- - test/interactive_terminal_test.hs- - vty-event-echo- - view a input event log for vty. Example of interacting with user.- - test/EventEcho.hs- - vty-rogue- - The start of a rogue-like game. Example of layers and image build operations.- - test/Rogue.hs- - vty-benchmark- - benchmarks vty. A series of tests that push random pictures to the terminal. The- random pictures are generated using QuickCheck. The same generators used in the- automated tests.- - test/benchmark.hs--4.7.0.0- - API changes:- - Added Graphics.Vty.Image.crop: Ensure an image is no larger than the specified size.- - Added Graphics.Vty.Image.pad: Ensure an image is no smaller than the specified size.- - Added Graphics.Vty.Image.translate: Offset an image.- - Thanks Ben Boeckel <MathStuf@gmail.com> for these features.--4.3.0.0--4.2.1.0- - API changes:- - Attr record accessor fore_color changed to attr_fore_color- - Attr record accessor back_color changed to attr_back_color- - Attr record accessor style changed to attr_style- - Added an "inline" display attribute changing DSL:- - put_attr_change applies a display attribute change immediately to a terminal- - For instance, can be used to change the display attrbiutes of text output via putStrLn- and putStr. EX: "put_attr_change $ back_color red" will set the- background color to red.- - Changes do not apply to a Picture output via output_picture.- - See Graphics.Vty.Inline- - Moved all IO actions into any monad an instance of MonadIO--4.0.0.1- - binding for mk_wcswidth was incorrect. Most platforms just magically worked due to- coincidence.--4.0.0- - API changes:- - "getSize" has been removed. Use "terminal vty >>= display_bounds" where "vty" is an- instance of the Vty data structure.- - added a "terminal" field to the Vty data structure. Accesses the TerminalHandle associated- with the Vty instance.- - Graphics.Vty.Types has undergone a number of changes. Summary:- - Partitioned into Graphics.Vty.Attributes for display attributes. Graphics.Vty.Image for- image combinators. Graphics.Vty.Picture for final picture construction.- - Graphics.Vty.Attributes:- - "setFG" and "setBG" are now "with_fore_color" and "with_back_color"- - All other "set.." equations similarly replaced.- - "attr" is now "def_attr", short for "default display attributes" Also added a- "current_attr" for "currently applied display attributes"- - Graphics.Vty.Image:- - "horzcat" is now "horiz_cat"- - "vertcat" is now "vert_cat"- - "renderBS" is now "utf8_bytestring"- - "renderChar" is now "char"- - "renderFill" is now "char_fill"- - added a "utf8_string" and "string" (AKA "iso_10464_string") for UTF-8 encoded Strings- and ISO-10464 encoded Strings. String literals in GHC have an ISO-10464 runtime- representation.- - Graphics.Vty.Picture:- - exports Graphics.Vty.Image- - "pic" is now "pic_for_image"- - added API for setting background fill pattern.- - Completely rewritten output backend.- - Efficient, scanline style output span generator. Has not been fully optimized, but good- enough.- - The details required to display the desired picture on a terminal are well encapsulated.- - Terminfo based display terminal implementation. With specialized derivitives for xterm,- Terminal.app, and iTerm.app.- - Attempts to robustly handle even terminals that don't support all display attributes.- - I've tested the following terminals with success: iTerm.app, Terminal.app, xterm,- rxvt, mlterm, Eterm, gnome-terminal, konsole, screen, linux vty. Hopefully you will be- as successfull.- - Improved unicode support. Double wide characters will display as expected.- - 256 color support. See Graphics.Vty.Attributes.Color240. The actual output color is adjusted- according to the number of colors the terminal supports.- - The Graphics.Vty.Image combinators no longer require matching dimensions to arguments.- Unspecified areas are filled in with a user-customizable background pattern. See- Graphics.Vty.Picture.- - output images are always cropped to display size.- - Significant code coverage by QuickCheck tests. An interactive test for those final properties- that couldn't be automatically verified.-- issues resolved:- - "gnome terminal displays non-basic attributes as strikethrough"- - http://trac.haskell.org/vty/ticket/14- - "Multi-byte characters are not displayed correctly on update"- - http://trac.haskell.org/vty/ticket/10- - "Redraw does not handle rendering a line that extends beyond screen width characters"- - http://trac.haskell.org/vty/ticket/13- - "The <|> and <-> combinators should be more forgiving of mismatched dimensions"- - http://trac.haskell.org/vty/ticket/9- - "256-color support"- - http://trac.haskell.org/vty/ticket/19
+ CHANGELOG.md view
@@ -0,0 +1,428 @@+5.15+Package changes:+ - Discontinued support for GHC versions prior to 7.10.1.+ - Removed instructions and configuration for Stack builds since they+ are no longer supported.+ - Clarified README mention of (lack of) Windows support (contributors+ wanted, though!)+ - Removed dependency on data-default (see below).++API changes:+ - Moved color definitions from Attributes to Color module.+ - In lieu of data-default (Default) instances for Attr and Config, use+ 'defAttr' and the new 'defaultConfig' (or 'mempty') instead of 'def'.+ - Graphics.Vty.Output no longer re-exports+ Graphics.Vty.Output.Interface.+ - Removed Graphics.Vty.Prelude module and moved DisplayRegion and its+ accessors to Graphics.Vty.Image.+ - Graphics.Vty.Image no longer re-exports Graphics.Vty.Attributes.+ - Graphics.Vty.Picture no longer re-exports Graphics.Vty.Image.++5.14+ - addMaybeClippedJoin: instead of raising an exception when the join+ is totally clipped, just reduce the clip amount and continue+ - addMaybeClipped: skip blit of joins when their primary dimension is+ zero+ - 'string' and related text functions no longer treat an empty string+ as an empty image (thanks Chris Penner). This means that now it is+ possible to use 'str ""' as a non-empty image with height 1.++5.13+ - Reverted changes in 5.12 due to disagreements between terminal+ emulators and utf8proc; for more details, please see the ticket+ discussion at+ https://github.com/coreyoconnor/vty/issues/115++5.12+ - Replaced 'wcwidth' with a call to the utf8proc library's character+ width function, which is much more up to date (by several Unicode+ versions) and returns the right width for a much larger set of+ characters.+ - Added a bundled version of the utf8proc C library.++5.11.3+ - Fix mouse event offsets in mouse-up events++5.11.2+ - Mouse events were modified so that the upper-left corner of the+ window is (0,0) rather than (1,1).++5.11.1+ - Add Generic instance for Image+ - nextEvent: stop trying to refresh on a resize event (fixes segfault+ on refresh with normal cursor positioning mode)+ - Remove redundant clause from clipForCharWidth (thanks Eric Mertens)+ - Update maintainer++5.11+ - Vty now raises a VtyConfigurationError exception when the TERM+ evironment variable is missing (thanks Eric Mertens)+ - Graphics.Vty.Config got an explicit export list to avoid accidentally+ exporting internal types (thanks Eric Mertens)++5.10+ - Add absolute cursor positioning mode AbsoluteCursor to Cursor. This+ mode provides greater control over cursor positioning by bypassing+ the logical positioning provided by default. Rather than positioning+ the cursor by looking at the widths of characters involved, this+ constructor lets you provide a physical row and column instead. This+ is useful in more sophisticated programs. (thanks Eric Mertens)+ - Added a new Generic-derived config parser (thanks Eric Mertens)+ - Fixed the MShift case in the configuration file parser (thanks Eric+ Mertens)+ - Fixed wcwidth import and matched safeWcswidth to its documented+ behavior. Previously vty_mk_wcwidth was being imported with+ the wrong type causing the -1 return value to be mapped to the+ wrong Int value. Additionally safeWcswidth was using the unsafe+ character width function and only ensuring that the final result was+ non-negative. (thanks Eric Mertens)++5.9.1+ - Vty now only emits UTF8 charset sequences in terminals without a+ preexisting UTF8 declaration to avoid emitting garbage sequences+ (fixes #89)++5.9+ - Added new Output methods supportsBell and ringTerminalBell to find+ out whether the output device has an audio bell and to ring it (see+ #102)++5.8.1+ - Fixed "refresh" to work as advertised (see #104)++5.8+ - API change: EvPaste input event now provides paste data as a raw+ ByteString rather than a String to allow the application to decode+ how best to decode it++5.7.1+ - ModeDemo: added an explicit Control.Applicative import for older+ GHCs++5.7+ - Mouse and paste modes are now off by default.+ - The Config type got new fields: mouseMode and bracketedPasteMode.+ These determine whether these modes are enabled initially (for+ terminals that support them).+ - Added a Mode type for modal terminal features (mouse events,+ bracketed paste mode) that is used with new Output interface+ functions:+ * supportsMode :: Mode -> Bool tells whether the device supports a+ mode+ * setMode :: Mode -> Bool -> IO () turns a mode on or off+ * getModeStatus :: Mode -> IO Bool tells you whether a mode is on or+ off+ - Added a new demo program, ModeDemo.hs, to demonstrate usage of modes++5.6+ - Added support for normal and extended mouse modes in Xterm-like+ terminals via the MouseDown and MouseUp Event constructors+ - Added support for bracketed paste mode in Xterm-like terminals via+ the EvPaste event constructor+ - Added derived Show instances for Event and Button (thanks Felix+ Hirn)+ - Now TERM values containing "screen" will automatically use the+ XtermColor driver rather than just TerminfoBased++5.5.0+ - Replaced lens dependency with microlens, microlens-mtl, microlens-th+ dependencies. Issue #90+ - Thanks Jonathan Daugherty+ - Cabal corrections.+ - Thanks Lennart Spitzner++5.4.0+ - Changed eventChannel of Graphics.Vty.Input from Chan to TChan.+ This enables clients to query if there are no pending events. The+ Graphics.Vty interface nextEvent is unchanged. Clients that use+ eventChannel directly will require updating.+ https://github.com/coreyoconnor/vty/issues/60+5.3.1+ - Reverted cabal file to depend on Cabal >= 1.18 instead of 1.20 due+ to possibly breaking this on reasonable GHC versions++5.3+ - Upgraded QuickCheck dependency to 2.7+ - The standard IO Config (standardIOConfig) was overriding any+ provided application config. In addition, the inputFd and outputFd+ could not be changed if mkVty was used. Fixed.+ - Correct handling of display attributes at end of line. The output+ attributes are set to default at the end of content for the line and+ at the start of a new line. Previously the current attribute would+ extend to the next start of content. This was odd to reason about+ and was the cause of https://github.com/coreyoconnor/vty/issues/76+ IIRC Yi requires the old behavior to display the selection region+ correctly.+ - shutdown of the input thread is now performed using killThread and+ synchronization on an MVar. For correct handling of the terminal+ read vmin and vtime the read must be a blocking read on an OS+ thread. This places a threadWaitRead, which will be interrupted by+ the killThread, prior to the uninterruptable read. An alternative+ would be to re-import the read foreign call as interruptable.++5.2.11+ - deepseq bounds increased for tests.+ - Clean up warnings when compiling on 7.10+ - Thanks Eric Mertens+ - Avoid discarding input bytes after multi-byte encoded codepoint+ - Thanks Eric Mertens++5.2.10+ - "str" now returns EmptyImage for empty strings to match behavior of+ other string-like Image constructors (fixes #74)+ - Thanks Jonathan Daugherty++5.2.9+ - dependency version bumps+ - https://github.com/coreyoconnor/vty/pull/71+ - https://github.com/coreyoconnor/vty/pull/70+ - Correct/Simplify the example code+ - Thanks glguy+ - https://github.com/coreyoconnor/vty/pull/69++5.2.8+ - blaze-builder, lens, utf8-string version constraint bump+ - Thanks glguy+ - https://github.com/coreyoconnor/vty/pull/67+ - Do not differentiate based on TERM_PROGRAM+ - https://github.com/coreyoconnor/vty/issues/68++5.2.7+ - lens and deepseq constraint bump + misc+ - Thanks ethercrow+ - https://github.com/coreyoconnor/vty/pull/66++5.2.6+ - lens constraint bump+ - Thanks alexander-b!+ - https://github.com/coreyoconnor/vty/pull/64++5.2.5+ - lens and random version constraint bump.+ - Thanks RyanGlScott!+ - https://github.com/coreyoconnor/vty/pull/62++5.2.4+ - removed -fpic from cc-options. No longer required.+ - https://github.com/coreyoconnor/vty/issues/61+ - https://ghc.haskell.org/trac/ghc/ticket/9657+ - Thanks Fuuzetsu!++5.2.3+ - evaluate/compile the input parsing table once instead of each+ keystroke.+ - https://github.com/coreyoconnor/vty/pull/59+ - Thanks ethercrow!++5.2.2+ - When looking at input for an event, don't look too deep.+ - https://github.com/coreyoconnor/vty/pull/57+ - Thanks ethercrow!++5.2.1+ - Bump upper version bound for lens to 4.5. Thanks markus1189!++5.2.0+ - Config structure now specifies file descriptor to use. The default+ is stdInput and stdOutput file descriptors. Previously Vty used+ stdInput for input and the follow code for output:+ - hDuplicate stdout >>= handleToFd >>= (`hSetBuffering`+ NoBuffering)+ - the difference was required by Vty.Inline. Now, Vty.Inline uses+ the Config structure options to acheive the same effect.+ - removed: derivedVtime, derivedVmin, inputForCurrentTerminal,+ inputForNameAndIO, outputForCurrentTerminal, outputForNameAndIO+ - added: inputForConfig, outputForConfig+ - updates to vty-rogue from jtdaugherty. Thanks!+ - the oldest version of GHC tested to support vty is 7.6.2.+ - the oldest version of GHC that vty compiles under is 7.4.2++5.1.4+ - merged https://github.com/coreyoconnor/vty/pull/51 thanks trofi!++5.1.1+ - merged https://github.com/coreyoconnor/vty/pull/48 thanks sjmielke!+ - jtdaugherty resolved a number of compiler warnings. Thanks!++5.1.0+ - vmin and vtime can be specified however the application requires.+ See Graphics.Vty.Config.+ - fixed the processing of input when vmin is set > 1.++5.0.0+ - The naming convention now matches:+ - http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions+ - all projects using vty for input must be compiled with -threaded.+ Please notify vty author if this is not acceptable.+ - mkVtyEscDelay has been removed. Use "mkVty def". Which initialized+ vty with the default configuration.+ - input handling changes+ - KASCII is now KChar+ - KPN5 is now KCenter+ - tests exist.+ - Applications can add to the input tables by setting inputMap of+ the Config. See Graphics.Vty.Config+ - Users can define input table extensions that will apply to all vty+ applications. See Graphics.Vty.Config+ - terminal timing is now handled by selecting an appropriate VTIME.+ Previously this was implemented within Vty itself. This reduced+ complexity in vty but provides a different meta key behavior and+ implies a requirement on -threaded.+ - The time vty will wait to verify an ESC byte means a single ESC+ key is the singleEscPeriod of the Input Config structure.+ - removed the typeclass based terminal and display context interface+ in favor of a data structure of properties interface.+ - renamed the Terminal interface to Output+ - The default picture for an image now uses the "clear" background.+ This background fills background spans with spaces or just ends the+ line.+ - Previously the background defaulted to the space character. This+ causes issues copying text from a text editor. The text would end+ up with extra spaces at the end of the line.+ - Layer support+ - Each layer is an image.+ - The layers for a picture are a list of images.+ - The first image is the top-most layer. The images are ordered from+ top to bottom.+ - The transparent areas for a layer are the backgroundFill areas.+ backgroundFill is added to pad images when images of different+ sizes are joined.+ - If the background is clear there is no background layer.+ - If there is a background character then the bottom layer is the+ background layer.+ - emptyPicture is a Picture with no layers and no cursor+ - addToTop and addToBottom add a layer to the top and bottom of the+ given Picture.+ - compatibility improvements:+ - terminfo based terminals with no cursor support are silently+ accepted. The cursor visibility changes in the Picture will have+ no effect.+ - alternate (setf/setb) color maps supported. Though colors beyond+ the first 8 are just a guess.+ - added "rgbColor" for easy support of RGB specified colors.+ - Both applications and users can add to the mapping used to+ translate from input bytes to events.+ - Additional information about input and output process can be+ appended to a debug log+ - Set environment variable VTY_DEBUG_LOG to path of debug log+ - Or use "debugLog <path>" config directive+ - Or set 'debugLog' property of the Config provided to mkVty.+ - examples moved to vty-examples package. See test directory for cabal+ file.+ - vty-interactive-terminal-test+ - interactive test. Useful for building a bug report for vty's+ author.+ - test/interactive_terminal_test.hs+ - vty-event-echo+ - view a input event log for vty. Example of interacting with+ user.+ - test/EventEcho.hs+ - vty-rogue+ - The start of a rogue-like game. Example of layers and image+ build operations.+ - test/Rogue.hs+ - vty-benchmark+ - benchmarks vty. A series of tests that push random pictures to+ the terminal. The random pictures are generated using+ QuickCheck. The same generators used in the automated tests.+ - test/benchmark.hs++4.7.0.0+ - API changes:+ - Added Graphics.Vty.Image.crop: Ensure an image is no larger+ than the specified size.+ - Added Graphics.Vty.Image.pad: Ensure an image is no smaller+ than the specified size.+ - Added Graphics.Vty.Image.translate: Offset an image.+ - Thanks Ben Boeckel <MathStuf@gmail.com> for these features.++4.3.0.0++4.2.1.0+ - API changes:+ - Attr record accessor fore_color changed to attr_fore_color+ - Attr record accessor back_color changed to attr_back_color+ - Attr record accessor style changed to attr_style+ - Added an "inline" display attribute changing DSL:+ - put_attr_change applies a display attribute change+ immediately to a terminal+ - For instance, can be used to change the display attrbiutes+ of text output via putStrLn and putStr. EX:+ "put_attr_change $ back_color red" will set the background+ color to red.+ - Changes do not apply to a Picture output via output_picture.+ - See Graphics.Vty.Inline+ - Moved all IO actions into any monad an instance of MonadIO++4.0.0.1+ - binding for mk_wcswidth was incorrect. Most platforms just+ magically worked due to coincidence.++4.0.0+ - API changes:+ - "getSize" has been removed. Use "terminal vty >>= display_bounds"+ where "vty" is an instance of the Vty data structure.+ - added a "terminal" field to the Vty data structure. Accesses the+ TerminalHandle associated with the Vty instance.+ - Graphics.Vty.Types has undergone a number of changes. Summary:+ - Partitioned into Graphics.Vty.Attributes for display attributes.+ Graphics.Vty.Image for image combinators. Graphics.Vty.Picture+ for final picture construction.+ - Graphics.Vty.Attributes:+ - "setFG" and "setBG" are now "with_fore_color" and+ "with_back_color"+ - All other "set.." equations similarly replaced.+ - "attr" is now "def_attr", short for "default display attributes"+ Also added a "current_attr" for "currently applied display+ attributes"+ - Graphics.Vty.Image:+ - "horzcat" is now "horiz_cat"+ - "vertcat" is now "vert_cat"+ - "renderBS" is now "utf8_bytestring"+ - "renderChar" is now "char"+ - "renderFill" is now "char_fill"+ - added a "utf8_string" and "string" (AKA "iso_10464_string") for+ UTF-8 encoded Strings and ISO-10464 encoded Strings. String+ literals in GHC have an ISO-10464 runtime representation.+ - Graphics.Vty.Picture:+ - exports Graphics.Vty.Image+ - "pic" is now "pic_for_image"+ - added API for setting background fill pattern.+ - Completely rewritten output backend.+ - Efficient, scanline style output span generator. Has not been+ fully optimized, but good enough.+ - The details required to display the desired picture on a+ terminal are well encapsulated.+ - Terminfo based display terminal implementation. With specialized+ derivitives for xterm, Terminal.app, and iTerm.app.+ - Attempts to robustly handle even terminals that don't+ support all display attributes.+ - I've tested the following terminals with success: iTerm.app,+ Terminal.app, xterm, rxvt, mlterm, Eterm, gnome-terminal,+ konsole, screen, linux vty. Hopefully you will be as+ successfull.+ - Improved unicode support. Double wide characters will display as+ expected.+ - 256 color support. See Graphics.Vty.Attributes.Color240. The actual+ output color is adjusted according to the number of colors the+ terminal supports.+ - The Graphics.Vty.Image combinators no longer require matching+ dimensions to arguments. Unspecified areas are filled in with a+ user-customizable background pattern. See Graphics.Vty.Picture.+ - output images are always cropped to display size.+ - Significant code coverage by QuickCheck tests. An interactive test+ for those final properties that couldn't be automatically verified.++Issues resolved:+ - "gnome terminal displays non-basic attributes as strikethrough"+ - http://trac.haskell.org/vty/ticket/14+ - "Multi-byte characters are not displayed correctly on update"+ - http://trac.haskell.org/vty/ticket/10+ - "Redraw does not handle rendering a line that extends beyond screen+ width characters"+ - http://trac.haskell.org/vty/ticket/13+ - "The <|> and <-> combinators should be more forgiving of mismatched+ dimensions"+ - http://trac.haskell.org/vty/ticket/9+ - "256-color support"+ - http://trac.haskell.org/vty/ticket/19
− Demo.hs
@@ -1,84 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Main where--import Graphics.Vty--import Control.Applicative hiding ((<|>))-import Control.Arrow-import Control.Monad.RWS--import Data.Default (def)-import Data.Sequence (Seq, (<|) )-import qualified Data.Sequence as Seq-import Data.Foldable--eventBufferSize = 1000--type App = RWST Vty () (Seq String) IO--main = do- vty <- if True -- change to false for emacs-like input processing- then mkVty def- else mkVty (def { vmin = Just 2, vtime = Just 300 } )- _ <- execRWST (vtyInteract False) vty Seq.empty- shutdown vty--vtyInteract :: Bool -> App ()-vtyInteract shouldExit = do- updateDisplay- unless shouldExit $ handleNextEvent >>= vtyInteract--introText = vertCat $ map (string defAttr)- [ "this line is hidden by the top layer"- , "The vty demo program will echo the events generated by the pressed keys."- , "Below there is a 240 color box."- , "Followed by a description of the 16 color pallete."- , "If the 240 color box is not visible then the terminal"- , "claims 240 colors are not supported."- , "Try setting TERM to xterm-256color"- , "This text is on a lower layer than the event list."- , "Which means it'll be hidden soon."- , "Bye!"- , "Great Faith in the ¯\\_(ツ)_/¯"- , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯"- ]--colorbox_240 :: Image-colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages- where- colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]- splitColorImages [] = []- splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))--colorbox_16 :: Image-colorbox_16 = border <|> column0 <|> border <|> column1 <|> border <|> column2 <|> border- where- column0 = vertCat $ map lineWithColor normal- column1 = vertCat $ map lineWithColor bright- border = vertCat $ replicate (length normal) $ string defAttr " | "- column2 = vertCat $ map (string defAttr . snd) normal- lineWithColor (c, cName) = string (defAttr `withForeColor` c) cName- normal = zip [ black, red, green, yellow, blue, magenta, cyan, white ]- [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]- bright = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue- , brightMagenta, brightCyan, brightWhite ]- [ "bright black", "bright red", "bright green", "bright yellow"- , "bright blue", "bright magenta", "bright cyan", "bright white" ]--updateDisplay :: App ()-updateDisplay = do- let info = string (defAttr `withForeColor` black `withBackColor` green)- "Press ESC to exit. Events for keys below."- eventLog <- foldMap (string defAttr) <$> get- let pic = picForImage (info <-> eventLog)- `addToBottom` (introText <-> colorbox_240 <|> colorbox_16)- vty <- ask- liftIO $ update vty pic--handleNextEvent = ask >>= liftIO . nextEvent >>= handleEvent- where- handleEvent e = do- modify $ (<|) (show e) >>> Seq.take eventBufferSize- return $ e == EvKey KEsc []-
− ModeDemo.hs
@@ -1,53 +0,0 @@-module Main where--import Control.Applicative-import Data.Monoid--import Graphics.Vty--mkUI :: (Bool, Bool, Bool, Bool) -> Maybe Event -> Image-mkUI (m, ms, p, ps) e =- vertCat [ string defAttr $ "Mouse mode supported: " <> show m- , string defAttr $ "Mouse mode status: " <> show ms- , string defAttr " "- , string defAttr $ "Paste mode supported: " <> show p- , string defAttr $ "Paste mode status: " <> show ps- , string defAttr " "- , string defAttr $ "Last event: " <> show e- , string defAttr " "- , string defAttr "Press 'm' to toggle mouse mode, 'p' to toggle paste mode, and 'q' to quit."- ]--main :: IO ()-main = do- cfg <- standardIOConfig- vty <- mkVty cfg-- let renderUI lastE = do- let output = outputIface vty- info <- (,,,) <$> (pure $ supportsMode output Mouse)- <*> getModeStatus output Mouse- <*> (pure $ supportsMode output BracketedPaste)- <*> getModeStatus output BracketedPaste- return $ picForImage $ mkUI info lastE-- let go lastE = do- pic <- renderUI lastE- update vty pic- e <- nextEvent vty- case e of- EvKey (KChar 'q') [] -> return ()- EvKey (KChar 'm') [] -> do- let output = outputIface vty- enabled <- getModeStatus output Mouse- setMode output Mouse (not enabled)- go (Just e)- EvKey (KChar 'p') [] -> do- let output = outputIface vty- enabled <- getModeStatus output BracketedPaste- setMode output BracketedPaste (not enabled)- go (Just e)- _ -> go (Just e)-- go Nothing- shutdown vty
README.md view
@@ -1,8 +1,8 @@-[](https://travis-ci.org/coreyoconnor/vty)--`vty` is a terminal interface library.+[](https://travis-ci.org/jtdaugherty/vty) -This project is hosted on github.com: https://github.com/coreyoconnor/vty+`vty` is a terminal interface library. It provides a high-level+interface for doing terminal I/O. Vty is supported on GHC versions+7.10.1 and up. Install via `git` with: @@ -18,55 +18,41 @@ # Features -* Support for a large number of terminals. vt100, ansi, hurd, linux, screen etc- etc. Anything with a sufficient terminfo entry.+* Supports a large number of terminals. vt100, ansi, hurd, linux,+ screen, etc., or anything with a sufficient terminfo entry. * Automatic handling of window resizes. -* If the terminal support UTF-8 then vty supports Unicode output.+* Unicode output on terminals with UTF-8 support. -* Handles multi-column glyphs. (Requires user to properly configure terminal.)+* Handles multi-column glyphs. (Requires user to properly configure+ terminal.) -* Efficient output. Output buffering and terminal state changes are minimized.+* Efficient output. Output buffering and terminal state changes are+ minimized. -* Minimizes repaint area. Virtually eliminating the flicker problems that- plagues ncurses programs.+* Minimizes repaint area, which virtually eliminates the flicker+ problems that plague ncurses programs. -* A pure, compositional interface for efficiently constructing display images.+* A pure, compositional interface for efficiently constructing display+ images. * Automatically decodes keyboard keys into (key,[modifier]) tuples. * Automatically supports refresh on Ctrl-L. -* Automatically supports timeout after for lone ESC. The timeout is+* Supports a keypress timeout after for lone ESC. The timeout is customizable. -* Interface is designed for easy compatible extension.--* Supports ANSI graphics modes (SGR as defined in console_codes(4)) with a- type-safe interface. Gracefull fallback for terminals that do not support, or- partially support the standard ANSI graphics modes.--* Properly handles cleanup, but not due to signals.--* Comprehensive test suite.--# Known Issues--* Terminals have numerous quirks and bugs. vty picks what works best for the- author in ambigious, or buggy situations.--* Signal handling of STOP, TERM and INT are non existent.+* The interface is designed for easy extension. -* The character encoding of the terminal is assumed to be UTF-8 if- unicode is used.+* Supports ANSI graphics modes (SGR as defined in `console_codes(4)`)+ with a type-safe interface and graceful fallback for terminals+ with limited or nonexistent support for such modes. -* Terminfo is assumed to be correct unless there is an override configured.- Some terminals will not have correct special key support (shifted F10 etc).- See Config for customizing vty's behavior for a particular terminal.+* Properly handles cleanup (but not due to signals). -* Uses the TIOCGWINSZ ioctl to find the current window size, which appears to be- limited to Linux and BSD.+* Provides a comprehensive test suite. * Supports "normal" and "extended" (SGR) mouse modes as described at http://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking@@ -78,20 +64,32 @@ ## Posix Terminals -Uses terminfo to determine terminal protocol. With some special rules to handle-some omissions from terminfo.+Uses terminfo to determine terminal protocol. With some special rules to+handle some omissions from terminfo. ## Windows -cygwin only.+Unsupported (but contributions and testing here are very welcome!) +# 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, make them consistent with the syntactic+ conventions already used in the codebase.+ - Please provide Haddock documentation for any changes you make.+ # Development Notes ## Under NixOS ### Using cabal -After installing ncurses to user env.+After installing `ncurses` to the user environment: ~~~ LIBRARY_PATH=$HOME/.nix-profile/lib/ cabal configure --enable-tests --extra-lib-dirs=$HOME/.nix-profile/lib@@ -99,18 +97,10 @@ LIBRARY_PATH=$HOME/.nix-profile/lib/ cabal test ~~~ -### Using stack--~~~-stack build-stack test-stack install-~~~--## Coverage+## Code Coverage -As of last testing, profiling causes issues with coverage when enabled. To-evaluate coverage configure as follows:+As of last testing, profiling causes issues with coverage when enabled.+To evaluate coverage, configure as follows: ~~~ rm -rf dist ; cabal configure --enable-tests --enable-library-coverage \@@ -120,9 +110,37 @@ ## Profiling - ~~~ rm -rf dist ; cabal configure --enable-tests --disable-library-coverage \ --enable-library-profiling \ --enable-executable-profiling ~~~++# Known Issues++* Terminals have numerous quirks and bugs. Vty picks what works best for+ the author in ambiguous or buggy situations.++* Signal handling of STOP, TERM and INT are nonexistent.++* The character encoding of the terminal is assumed to be UTF-8 if+ unicode is used.++* Terminfo is assumed to be correct unless there is an override+ configured. Some terminals will not have correct special key support+ (shifted F10 etc). See `Config` for customizing vty's behavior for a+ particular terminal.++* Uses the `TIOCGWINSZ` ioctl to find the current window size, which+ appears to be limited to Linux and BSD.++# Sources++Good sources of documentation for terminal programming are:++* https://github.com/b4winckler/vim/blob/master/src/term.c+* http://invisible-island.net/xterm/ctlseqs/ctlseqs.html+* http://ulisse.elettra.trieste.it/services/doc/serial/config.html+* http://www.leonerd.org.uk/hacks/hints/xterm-8bit.html+* http://www.unixwiz.net/techtips/termios-vmin-vtime.html+* http://vt100.net/docs/vt100-ug/chapter3.html
− TODO
@@ -1,15 +0,0 @@-- Improve input handling- - base off of haskeline input system. The haskeline input system appears to be excellent and- satisfy all of Vty's input requirements. The current haskeline distribution does not appear to- export the required modules. Either:- 0. Add the required exports to the haskeline distribution. - - fine for development but complicates the UI for production clients. Though, exposing- the modules would only complicate the appearance of haskeline's interface. - 1. Partition the backend of haskeline into a separate package usable by both vty and- haskeline.-- use compact-string for character encoding handling-- Custom cursor appearance handling?- - specific color?- - reverse video?- - auto?-
+ demos/Demo.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE FlexibleContexts #-}+module Main where++import Graphics.Vty++import Control.Applicative hiding ((<|>))+import Control.Arrow+import Control.Monad.RWS++import Data.Sequence (Seq, (<|) )+import qualified Data.Sequence as Seq+import Data.Foldable++eventBufferSize = 1000++type App = RWST Vty () (Seq String) IO++main = do+ vty <- if True -- change to false for emacs-like input processing+ then mkVty defaultConfig+ else mkVty (defaultConfig { vmin = Just 2, vtime = Just 300 } )+ _ <- execRWST (vtyInteract False) vty Seq.empty+ shutdown vty++vtyInteract :: Bool -> App ()+vtyInteract shouldExit = do+ updateDisplay+ unless shouldExit $ handleNextEvent >>= vtyInteract++introText = vertCat $ map (string defAttr)+ [ "this line is hidden by the top layer"+ , "The vty demo program will echo the events generated by the pressed keys."+ , "Below there is a 240 color box."+ , "Followed by a description of the 16 color pallete."+ , "If the 240 color box is not visible then the terminal"+ , "claims 240 colors are not supported."+ , "Try setting TERM to xterm-256color"+ , "This text is on a lower layer than the event list."+ , "Which means it'll be hidden soon."+ , "Bye!"+ , "Great Faith in the ¯\\_(ツ)_/¯"+ , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯"+ ]++colorbox_240 :: Image+colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages+ where+ colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]+ splitColorImages [] = []+ splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))++colorbox_16 :: Image+colorbox_16 = border <|> column0 <|> border <|> column1 <|> border <|> column2 <|> border+ where+ column0 = vertCat $ map lineWithColor normal+ column1 = vertCat $ map lineWithColor bright+ border = vertCat $ replicate (length normal) $ string defAttr " | "+ column2 = vertCat $ map (string defAttr . snd) normal+ lineWithColor (c, cName) = string (defAttr `withForeColor` c) cName+ normal = zip [ black, red, green, yellow, blue, magenta, cyan, white ]+ [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]+ bright = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue+ , brightMagenta, brightCyan, brightWhite ]+ [ "bright black", "bright red", "bright green", "bright yellow"+ , "bright blue", "bright magenta", "bright cyan", "bright white" ]++updateDisplay :: App ()+updateDisplay = do+ let info = string (defAttr `withForeColor` black `withBackColor` green)+ "Press ESC to exit. Events for keys below."+ eventLog <- foldMap (string defAttr) <$> get+ let pic = picForImage (info <-> eventLog)+ `addToBottom` (introText <-> colorbox_240 <|> colorbox_16)+ vty <- ask+ liftIO $ update vty pic++handleNextEvent = ask >>= liftIO . nextEvent >>= handleEvent+ where+ handleEvent e = do+ modify $ (<|) (show e) >>> Seq.take eventBufferSize+ return $ e == EvKey KEsc []+
+ demos/ModeDemo.hs view
@@ -0,0 +1,53 @@+module Main where++import Control.Applicative+import Data.Monoid++import Graphics.Vty++mkUI :: (Bool, Bool, Bool, Bool) -> Maybe Event -> Image+mkUI (m, ms, p, ps) e =+ vertCat [ string defAttr $ "Mouse mode supported: " <> show m+ , string defAttr $ "Mouse mode status: " <> show ms+ , string defAttr " "+ , string defAttr $ "Paste mode supported: " <> show p+ , string defAttr $ "Paste mode status: " <> show ps+ , string defAttr " "+ , string defAttr $ "Last event: " <> show e+ , string defAttr " "+ , string defAttr "Press 'm' to toggle mouse mode, 'p' to toggle paste mode, and 'q' to quit."+ ]++main :: IO ()+main = do+ cfg <- standardIOConfig+ vty <- mkVty cfg++ let renderUI lastE = do+ let output = outputIface vty+ info <- (,,,) <$> (pure $ supportsMode output Mouse)+ <*> getModeStatus output Mouse+ <*> (pure $ supportsMode output BracketedPaste)+ <*> getModeStatus output BracketedPaste+ return $ picForImage $ mkUI info lastE++ let go lastE = do+ pic <- renderUI lastE+ update vty pic+ e <- nextEvent vty+ case e of+ EvKey (KChar 'q') [] -> return ()+ EvKey (KChar 'm') [] -> do+ let output = outputIface vty+ enabled <- getModeStatus output Mouse+ setMode output Mouse (not enabled)+ go (Just e)+ EvKey (KChar 'p') [] -> do+ let output = outputIface vty+ enabled <- getModeStatus output BracketedPaste+ setMode output BracketedPaste (not enabled)+ go (Just e)+ _ -> go (Just e)++ go Nothing+ shutdown vty
− dist/build/verify-attribute-opsStub/verify-attribute-opsStub-tmp/verify-attribute-opsStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyAttributeOps ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-crop-span-generationStub/verify-crop-span-generationStub-tmp/verify-crop-span-generationStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyCropSpanGeneration ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-display-attributesStub/verify-display-attributesStub-tmp/verify-display-attributesStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyDisplayAttributes ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-empty-image-propsStub/verify-empty-image-propsStub-tmp/verify-empty-image-propsStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyEmptyImageProps ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-eval-terminfo-capsStub/verify-eval-terminfo-capsStub-tmp/verify-eval-terminfo-capsStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyEvalTerminfoCaps ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-image-opsStub/verify-image-opsStub-tmp/verify-image-opsStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyImageOps ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-image-transStub/verify-image-transStub-tmp/verify-image-transStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyImageTrans ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-inlineStub/verify-inlineStub-tmp/verify-inlineStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyInline ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-layers-span-generationStub/verify-layers-span-generationStub-tmp/verify-layers-span-generationStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyLayersSpanGeneration ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-parse-terminfo-capsStub/verify-parse-terminfo-capsStub-tmp/verify-parse-terminfo-capsStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyParseTerminfoCaps ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-simple-span-generationStub/verify-simple-span-generationStub-tmp/verify-simple-span-generationStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifySimpleSpanGeneration ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-terminalStub/verify-terminalStub-tmp/verify-terminalStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyOutput ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-using-mock-terminalStub/verify-using-mock-terminalStub-tmp/verify-using-mock-terminalStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyUsingMockTerminal ( tests )-main :: IO ()-main = stubMain tests
− dist/build/verify-utf8-widthStub/verify-utf8-widthStub-tmp/verify-utf8-widthStub.hs
@@ -1,5 +0,0 @@-module Main ( main ) where-import Distribution.Simple.Test.LibV09 ( stubMain )-import VerifyUtf8Width ( tests )-main :: IO ()-main = stubMain tests
src/Codec/Binary/UTF8/Debug.hs view
@@ -1,7 +1,6 @@ {-# OPTIONS_HADDOCK hide #-} -- Copyright 2009 Corey O'Connor-module Codec.Binary.UTF8.Debug - where+module Codec.Binary.UTF8.Debug where import Codec.Binary.UTF8.String ( encode ) @@ -9,8 +8,8 @@ import Numeric --- | Converts an array of ISO-10646 characters (Char type) to an array of Word8 bytes that is the--- corresponding UTF8 byte sequence+-- | Converts an array of ISO-10646 characters (Char type) to an array+-- of Word8 bytes that is the corresponding UTF8 byte sequence utf8FromIso :: [Int] -> [Word8] utf8FromIso = encode . map toEnum
src/Data/Terminfo/Eval.hs view
@@ -1,18 +1,14 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK hide #-} -#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif--{- Evaluates the paramaterized terminfo string capability with the given parameters.- -- -}-module Data.Terminfo.Eval (writeCapExpr)- where+-- | Evaluates the paramaterized terminfo string capability with the+-- given parameters.+module Data.Terminfo.Eval+ ( writeCapExpr+ )+where import Blaze.ByteString.Builder.Word import Blaze.ByteString.Builder@@ -27,10 +23,6 @@ import qualified Data.Vector.Unboxed as Vector -#if !(MIN_VERSION_base(4,8,0))-import Data.Word-#endif- -- | capability evaluator state data EvalState = EvalState { evalStack :: ![CapParam]@@ -83,7 +75,7 @@ p <- pop forM_ (show p) $ tell.writeWord8.toEnum.fromEnum writeCapOp CharOut = do- pop >>= tell.writeWord8.toEnum.fromEnum + pop >>= tell.writeWord8.toEnum.fromEnum writeCapOp (PushParam pn) = do readParam pn >>= push writeCapOp (PushValue v) = do@@ -91,13 +83,14 @@ writeCapOp (Conditional expr parts) = do writeCapOps expr writeContitionalParts parts- where + where writeContitionalParts [] = return () writeContitionalParts ((trueOps, falseOps) : falseParts) = do -- (man 5 terminfo)- -- Usually the %? expr part pushes a value onto the stack, and %t pops it from the- -- stack, testing if it is nonzero (true). If it is zero (false), control- -- passes to the %e (else) part.+ -- Usually the %? expr part pushes a value onto the stack,+ -- and %t pops it from the stack, testing if it is nonzero+ -- (true). If it is zero (false), control passes to the %e+ -- (else) part. v <- pop if v /= 0 then writeCapOps trueOps@@ -137,4 +130,3 @@ v1 <- pop v0 <- pop push $ if v0 > v1 then 1 else 0-
src/Data/Terminfo/Parse.hs view
@@ -1,18 +1,14 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NamedFieldPuns #-} {-# OPTIONS_GHC -funbox-strict-fields -O #-} -#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif--module Data.Terminfo.Parse ( module Data.Terminfo.Parse- , Text.Parsec.ParseError- )- where+module Data.Terminfo.Parse+ ( module Data.Terminfo.Parse+ , Text.Parsec.ParseError+ )+where import Control.Monad ( liftM ) import Control.DeepSeq@@ -24,10 +20,6 @@ import Text.Parsec -#if !(MIN_VERSION_base(4,8,0))-import Data.Monoid-#endif- data CapExpression = CapExpression { capOps :: !CapOps , capBytes :: !(Vector.Vector Word8)@@ -46,21 +38,21 @@ hexDump = foldr (\b s -> showHex b s) "" instance NFData CapExpression where- rnf (CapExpression ops !_bytes !str !c !pOps) + rnf (CapExpression ops !_bytes !str !c !pOps) = rnf ops `seq` rnf str `seq` rnf c `seq` rnf pOps type CapParam = Word type CapOps = [CapOp]-data CapOp = +data CapOp = Bytes !Int !Int -- offset count | DecOut | CharOut- -- This stores a 0-based index to the parameter. However the operation that implies this op is- -- 1-based+ -- This stores a 0-based index to the parameter. However the+ -- operation that implies this op is 1-based | PushParam !Word | PushValue !Word- -- The conditional parts are the sequence of (%t expression, %e expression) pairs.- -- The %e expression may be NOP- | Conditional + -- The conditional parts are the sequence of (%t expression, %e+ -- The expression) pairs. %e expression may be NOP+ | Conditional { conditionalExpr :: !CapOps , conditionalParts :: ![(CapOps, CapOps)] }@@ -72,8 +64,8 @@ instance NFData CapOp where rnf (Bytes offset byteCount ) = rnf offset `seq` rnf byteCount rnf (PushParam pn) = rnf pn- rnf (PushValue v) = rnf v - rnf (Conditional cExpr cParts) = rnf cExpr `seq` rnf cParts + rnf (PushValue v) = rnf v+ rnf (Conditional cExpr cParts) = rnf cExpr `seq` rnf cParts rnf BitwiseOr = () rnf BitwiseXOr = () rnf BitwiseAnd = ()@@ -94,11 +86,11 @@ rnf IncFirstTwo = () parseCapExpression :: String -> Either ParseError CapExpression-parseCapExpression capString = +parseCapExpression capString = let v = runParser capExpressionParser initialBuildState- "terminfo cap" - capString + "terminfo cap"+ capString in case v of Left e -> Left e Right buildResults -> Right $ constructCapExpression capString buildResults@@ -107,27 +99,27 @@ constructCapExpression capString buildResults = let expr = CapExpression { capOps = outCapOps buildResults- -- The cap bytes are the lower 8 bits of the input string's characters.- -- \todo Verify the input string actually contains an 8bit byte per character.+ -- The cap bytes are the lower 8 bits of the input+ -- string's characters. , capBytes = Vector.fromList $ map (toEnum.fromEnum) capString , sourceString = capString , paramCount = outParamCount buildResults , paramOps = outParamOps buildResults- } + } in rnf expr `seq` expr -type CapParser a = Parsec String BuildState a +type CapParser a = Parsec String BuildState a capExpressionParser :: CapParser BuildResults capExpressionParser = do- rs <- many $ paramEscapeParser <|> bytesOpParser + rs <- many $ paramEscapeParser <|> bytesOpParser return $ mconcat rs paramEscapeParser :: CapParser BuildResults paramEscapeParser = do _ <- char '%' incOffset 1- literalPercentParser <|> paramOpParser + literalPercentParser <|> paramOpParser literalPercentParser :: CapParser BuildResults literalPercentParser = do@@ -138,7 +130,7 @@ paramOpParser :: CapParser BuildResults paramOpParser- = incrementOpParser + = incrementOpParser <|> pushOpParser <|> decOutParser <|> charOutParser@@ -179,16 +171,16 @@ _ <- char '?' incOffset 1 condPart <- manyExpr conditionalTrueParser- parts <- manyP + parts <- manyP ( do truePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser- , conditionalFalseParser + , conditionalFalseParser ] falsePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser , conditionalTrueParser ] return ( truePart, falsePart )- ) + ) conditionalEndParser let trueParts = map fst parts@@ -208,10 +200,10 @@ return $ BuildResults n'' [ Conditional cond condParts ] pOps - where - manyP !p !end = choice + where+ manyP !p !end = choice [ try end >> return []- , do !v <- p + , do !v <- p !vs <- manyP p end return $! v : vs ]@@ -233,7 +225,7 @@ incOffset 2 bitwiseOpParser :: CapParser BuildResults-bitwiseOpParser +bitwiseOpParser = bitwiseOrParser <|> bitwiseAndParser <|> bitwiseXorParser@@ -257,9 +249,9 @@ return $ BuildResults 0 [ BitwiseXOr ] [ ] arithOpParser :: CapParser BuildResults-arithOpParser - = plusOp - <|> minusOp +arithOpParser+ = plusOp+ <|> minusOp where plusOp = do _ <- char '+'@@ -282,10 +274,10 @@ return $ BuildResults 0 [ PushValue n ] [ ] compareOpParser :: CapParser BuildResults-compareOpParser +compareOpParser = compareEqOp- <|> compareLtOp - <|> compareGtOp + <|> compareLtOp+ <|> compareGtOp where compareEqOp = do _ <- char '='@@ -313,14 +305,14 @@ charConstParser :: CapParser BuildResults charConstParser = do _ <- char '\''- charValue <- liftM (toEnum . fromEnum) anyChar + charValue <- liftM (toEnum . fromEnum) anyChar _ <- char '\'' incOffset 3 return $ BuildResults 0 [ PushValue charValue ] [ ] -data BuildState = BuildState +data BuildState = BuildState { nextOffset :: Int- } + } incOffset :: Int -> CapParser () incOffset n = do@@ -339,10 +331,9 @@ instance Monoid BuildResults where mempty = BuildResults 0 [] []- v0 `mappend` v1 + v0 `mappend` v1 = BuildResults { outParamCount = (outParamCount v0) `max` (outParamCount v1) , outCapOps = (outCapOps v0) `mappend` (outCapOps v1) , outParamOps = (outParamOps v0) `mappend` (outParamOps v1) }-
src/Graphics/Text/Width.hs view
@@ -1,12 +1,13 @@ -- Copyright 2009 Corey O'Connor {-# OPTIONS_GHC -D_XOPEN_SOURCE #-} {-# LANGUAGE ForeignFunctionInterface #-}-module Graphics.Text.Width ( wcwidth- , wcswidth- , safeWcwidth- , safeWcswidth- )- where+module Graphics.Text.Width+ ( wcwidth+ , wcswidth+ , safeWcwidth+ , safeWcswidth+ )+where foreign import ccall unsafe "vty_mk_wcwidth" wcwidth :: Char -> Int @@ -14,16 +15,19 @@ wcswidth = sum . map wcwidth -- XXX: Characters with unknown widths occupy 1 column?--- --- Not sure if this is actually correct. I presume there is a replacement character that is output--- by the terminal instead of the character and this replacement character is 1 column wide. If this--- is not true for all terminals then a per-terminal replacement character width needs to be--- implemented.+--+-- Not sure if this is actually correct. I presume there is a+-- replacement character that is output by the terminal instead of the+-- character and this replacement character is 1 column wide. If this is+-- not true for all terminals then a per-terminal replacement character+-- width needs to be implemented. --- | Returns the display width of a character. Assumes all characters with unknown widths are 0 width+-- | Returns the display width of a character. Assumes all characters+-- with unknown widths are 0 width. safeWcwidth :: Char -> Int safeWcwidth = max 0 . wcwidth --- | Returns the display width of a string. Assumes all characters with unknown widths are 0 width+-- | Returns the display width of a string. Assumes all characters with+-- unknown widths are 0 width. safeWcswidth :: String -> Int safeWcswidth = sum . map safeWcwidth
src/Graphics/Vty.hs view
@@ -1,17 +1,14 @@--- | Vty supports input and output to terminal devices.------ - Input to the terminal is provided to the app as a sequence of 'Event's.------ - The output is defined by a 'Picture'. Which is one or more layers of 'Image's.------ - The module "Graphics.Vty.Image" provides a number of constructor equations that will build--- correct 'Image' values. See 'string', '<|>', and '<->' for starters.+-- | Vty provides interfaces for both terminal input and terminal+-- output. ----- - The constructors in "Graphics.Vty.Image.Internal" should not be used.+-- - Input to the terminal is provided to the Vty application as a+-- sequence of 'Event's. ----- - 'Image's can be styled using 'Attr'. See "Graphics.Vty.Attributes".--- --- See the vty-examples package for a number of examples.+-- - Output is provided to Vty by the application in the form of a+-- 'Picture'. A 'Picture' is one or more layers of 'Image's.+-- 'Image' values can be built by the various constructors in+-- "Graphics.Vty.Image". Output can be syled using 'Attr' (attribute)+-- values in the "Graphics.Vty.Attributes" module. -- -- @ -- import "Graphics.Vty"@@ -28,89 +25,80 @@ -- 'shutdown' vty -- 'print' (\"Last event was: \" '++' 'show' e) -- @--- --- Good sources of documentation for terminal programming are:------ - <https://github.com/b4winckler/vim/blob/master/src/term.c>------ - <http://invisible-island.net/xterm/ctlseqs/ctlseqs.html>------ - <http://ulisse.elettra.trieste.it/services/doc/serial/config.html>------ - <http://www.leonerd.org.uk/hacks/hints/xterm-8bit.html>------ - <http://www.unixwiz.net/techtips/termios-vmin-vtime.html>------ - <http://vt100.net/docs/vt100-ug/chapter3.html vt100 control sequences>-module Graphics.Vty ( Vty(..)- , mkVty- , module Graphics.Vty.Config- , module Graphics.Vty.Input- , module Graphics.Vty.Output- , module Graphics.Vty.Picture- , DisplayRegion- , Mode(..)- ) - where--import Graphics.Vty.Prelude+module Graphics.Vty+ ( Vty(..)+ , mkVty+ , Mode(..)+ , module Graphics.Vty.Config+ , module Graphics.Vty.Input+ , module Graphics.Vty.Output+ , module Graphics.Vty.Output.Interface+ , module Graphics.Vty.Picture+ , module Graphics.Vty.Image+ , module Graphics.Vty.Attributes+ )+where import Graphics.Vty.Config import Graphics.Vty.Input import Graphics.Vty.Output import Graphics.Vty.Output.Interface import Graphics.Vty.Picture+import Graphics.Vty.Image+import Graphics.Vty.Attributes import Control.Concurrent.STM import Data.IORef import Data.Monoid --- | The main object. At most one should be created.+-- | A Vty value represents a handle to the Vty library that the+-- application must create in order to use Vty. -- -- The use of Vty typically follows this process: ----- 0. initialize vty------ 1. use the update equation of Vty to display a picture+-- 1. Initialize vty ----- 2. repeat+-- 2. Use 'update' to display a picture. ----- 3. shutdown vty.+-- 3. Use 'nextEvent' to get the next input event. ----- An alternative to tracking the Vty instance is to use 'withVty' in "Graphics.Vty.Inline.Unsafe".+-- 4. Depending on the event, go to 2 or 5. ----- This does not assure any thread safety. In theory, as long as an update action is not executed--- when another update action is already then it's safe to call this on multiple threads.+-- 5. Shutdown vty. ----- \todo Remove explicit `shutdown` requirement.-data Vty = Vty - { -- | Outputs the given Picture. Equivalent to 'outputPicture' applied to a display context- -- implicitly managed by Vty. The managed display context is reset on resize.+-- Operations on Vty handles are not thread-safe.+data Vty = Vty+ { -- | Outputs the given 'Picture'. update :: Picture -> IO ()- -- | Get one Event object, blocking if necessary. This will refresh the terminal if the event- -- is a 'EvResize'.+ -- | Get one 'Event' object, blocking if none are available. This+ -- will refresh the terminal if the event is a 'EvResize'. , nextEvent :: IO Event- -- | The input interface. See 'Input'+ -- | The input interface. See 'Input'. , inputIface :: Input- -- | The output interface. See 'Output'+ -- | The output interface. See 'Output'. , outputIface :: Output- -- | Refresh the display. 'nextEvent' will refresh the display if a resize occurs.- -- If other programs output to the terminal and mess up the display then the application might- -- want to force a refresh.+ -- | Refresh the display. 'nextEvent' will refresh the display if+ -- a resize occurs, but this can be used to refresh the display+ -- explicitly. If other programs output to the terminal and mess+ -- up the display then the application might want to force a+ -- refresh using this function. , refresh :: IO ()- -- | Clean up after vty.- -- The above methods will throw an exception if executed after this is executed.- , shutdown :: IO () + -- | Clean up after vty. A call to this function is necessary to+ -- cleanly restore the terminal state before application exit. The+ -- above methods will throw an exception if executed after this is+ -- executed.+ , shutdown :: IO () } --- | Set up the state object for using vty. At most one state object should be--- created at a time for a given terminal device.+-- | Create a Vty handle. At most one handle should be created at a time+-- for a given terminal device. ----- The specified config is added to the 'userConfig'. With the 'userConfig' taking precedence.--- See "Graphics.Vty.Config"+-- The specified configuration is added to the the configuration+-- loaded by 'userConfig' with the 'userConfig' configuration taking+-- precedence. See "Graphics.Vty.Config". ----- For most applications @mkVty def@ is sufficient.+-- For most applications @mkVty defaultConfig@ is sufficient. mkVty :: Config -> IO Vty mkVty appConfig = do config <- (<> appConfig) <$> userConfig@@ -157,7 +145,7 @@ maybe (return ()) innerUpdate mPic let gkey = do k <- atomically $ readTChan $ _eventChannel input- case k of + case k of (EvResize _ _) -> displayBounds out >>= return . (\(w,h)-> EvResize w h) _ -> return k@@ -169,4 +157,3 @@ , refresh = innerRefresh , shutdown = shutdownIo }-
src/Graphics/Vty/Attributes.hs view
@@ -1,68 +1,83 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} -#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif- -- | Display attributes ----- Typically the values 'defAttr' or 'currentAttr' are modified to form attributes:+-- Attributes have three components: a foreground color, a background+-- color, and a style mask. The simplest attribute is the default+-- attribute, or 'defAttr'. Attributes can be modified with+-- 'withForeColor', 'withBackColor', and 'withStyle', e.g., -- -- @ -- defAttr `withForeColor` red -- @ ----- Is the attribute that will set the foreground color to red and the background color to the--- default.------ This can then be used to build an image wiht a red foreground like so:+-- 'Image' constructors often require an 'Attr' to indicate the+-- attributes used in the image, e.g., -- -- @--- string (defAttr `withForeColor` red) "this text will be red"+-- string (defAttr `withForeColor` red) "this text will be red" -- @ ----- The default attributes set by 'defAttr' have a presentation determined by the terminal. This is--- not something VTY can control. The user is free to define the color scheme of the terminal as--- they see fit. Up to the limits of the terminal anyways.------ The value 'currentAttr' will keep the attributes of whatever was output previously.+-- The appearance of 'Image's using 'defAttr' is determined by the The+-- terminal, so this is not something VTY can control. The user is free+-- to The define the color scheme of the terminal as they see fit. ----- \todo This API is very verbose IMO. I'd like something more succinct.-module Graphics.Vty.Attributes ( module Graphics.Vty.Attributes- , module Graphics.Vty.Attributes.Color- , module Graphics.Vty.Attributes.Color240- )- where+-- The value 'currentAttr' will keep the attributes of whatever was+-- output previously.+module Graphics.Vty.Attributes+ ( Attr(..)+ , FixedAttr(..)+ , MaybeDefault(..)+ , defAttr+ , currentAttr + -- * Styles+ , Style+ , withStyle+ , standout+ , underline+ , reverseVideo+ , blink+ , dim+ , bold+ , defaultStyleMask+ , styleMask+ , hasStyle++ -- * Setting attribute colors+ , withForeColor+ , withBackColor++ -- * Colors+ , module Graphics.Vty.Attributes.Color+ , module Graphics.Vty.Attributes.Color240+ )+where+ import Data.Bits-import Data.Default import Data.Word import Graphics.Vty.Attributes.Color import Graphics.Vty.Attributes.Color240 -#if !(MIN_VERSION_base(4,8,0))-import Data.Monoid-#endif---- | A display attribute defines the Color and Style of all the characters rendered after the--- attribute is applied.+-- | A display attribute defines the Color and Style of all the+-- characters rendered after the attribute is applied. ----- At most 256 colors, picked from a 240 and 16 color palette, are possible for the background and--- foreground. The 240 colors and 16 colors are points in different palettes. See Color for more--- information.+-- At most 256 colors, picked from a 240 and 16 color palette, are+-- possible for the background and foreground. The 240 colors and+-- 16 colors are points in different palettes. See Color for more+-- information. data Attr = Attr { attrStyle :: !(MaybeDefault Style) , attrForeColor :: !(MaybeDefault Color) , attrBackColor :: !(MaybeDefault Color) } deriving ( Eq, Show, Read ) --- This could be encoded into a single 32 bit word. The 32 bit word is first divided--- into 4 groups of 8 bits where: The first group codes what action should be taken with regards to--- the other groups.+-- This could be encoded into a single 32 bit word. The 32 bit word is+-- first divided into 4 groups of 8 bits where: The first group codes+-- what action should be taken with regards to the other groups. -- XXYYZZ__ -- XX - style action -- 00 => reset to default@@ -93,22 +108,24 @@ instance Monoid Attr where mempty = Attr mempty mempty mempty- mappend attr0 attr1 = + mappend attr0 attr1 = Attr ( attrStyle attr0 `mappend` attrStyle attr1 ) ( attrForeColor attr0 `mappend` attrForeColor attr1 ) ( attrBackColor attr0 `mappend` attrBackColor attr1 ) --- | Specifies the display attributes such that the final style and color values do not depend on--- the previously applied display attribute. The display attributes can still depend on the--- terminal's default colors (unfortunately).+-- | Specifies the display attributes such that the final style and+-- color values do not depend on the previously applied display+-- attribute. The display attributes can still depend on the terminal's+-- default colors (unfortunately). data FixedAttr = FixedAttr { fixedStyle :: !Style , fixedForeColor :: !(Maybe Color) , fixedBackColor :: !(Maybe Color) } deriving ( Eq, Show ) --- | The style and color attributes can either be the terminal defaults. Or be equivalent to the--- previously applied style. Or be a specific value.+-- | The style and color attributes can either be the terminal defaults.+-- Or be equivalent to the previously applied style. Or be a specific+-- value. data MaybeDefault v where Default :: MaybeDefault v KeepCurrent :: MaybeDefault v@@ -130,31 +147,9 @@ mappend ( SetTo v ) KeepCurrent = SetTo v mappend ( SetTo _ ) ( SetTo v ) = SetTo v --- | Standard 8-color ANSI terminal color codes.-black, red, green, yellow, blue, magenta, cyan, white :: Color-black = ISOColor 0-red = ISOColor 1-green = ISOColor 2-yellow = ISOColor 3-blue = ISOColor 4-magenta= ISOColor 5-cyan = ISOColor 6-white = ISOColor 7---- | Bright/Vivid variants of the standard 8-color ANSI -brightBlack, brightRed, brightGreen, brightYellow :: Color-brightBlue, brightMagenta, brightCyan, brightWhite :: Color-brightBlack = ISOColor 8-brightRed = ISOColor 9-brightGreen = ISOColor 10-brightYellow = ISOColor 11-brightBlue = ISOColor 12-brightMagenta= ISOColor 13-brightCyan = ISOColor 14-brightWhite = ISOColor 15---- | Styles are represented as an 8 bit word. Each bit in the word is 1 if the style attribute--- assigned to that bit should be applied and 0 if the style attribute should not be applied.+-- | Styles are represented as an 8 bit word. Each bit in the word is 1+-- if the style attribute assigned to that bit should be applied and 0+-- if the style attribute should not be applied. type Style = Word8 -- | The 6 possible style attributes:@@ -171,8 +166,8 @@ -- -- * bold/bright ----- ( The invisible, protect, and altcharset display attributes some terminals support are not--- supported via VTY.)+-- (The invisible, protect, and altcharset display attributes some+-- terminals support are not supported via VTY.) standout, underline, reverseVideo, blink, dim, bold :: Style standout = 0x01 underline = 0x02@@ -185,7 +180,7 @@ defaultStyleMask = 0x00 styleMask :: Attr -> Word8-styleMask attr +styleMask attr = case attrStyle attr of Default -> 0 KeepCurrent -> 0@@ -207,21 +202,18 @@ withStyle :: Attr -> Style -> Attr withStyle attr styleFlag = attr { attrStyle = SetTo $ styleMask attr .|. styleFlag } --- | Sets the style, background color and foreground color to the default values for the terminal.--- There is no easy way to determine what the default background and foreground colors are.+-- | Sets the style, background color and foreground color to the+-- default values for the terminal. There is no easy way to determine+-- what the default background and foreground colors are. defAttr :: Attr defAttr = Attr Default Default Default -instance Default Attr where- def = defAttr---- | Keeps the style, background color and foreground color that was previously set. Used to--- override some part of the previous style.+-- | Keeps the style, background color and foreground color that was+-- previously set. Used to override some part of the previous style. -- -- EG: current_style `withForeColor` brightMagenta ----- Would be the currently applied style (be it underline, bold, etc) but with the foreground color--- set to brightMagenta.+-- Would be the currently applied style (be it underline, bold, etc) but+-- with the foreground color set to brightMagenta. currentAttr :: Attr currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent-
src/Graphics/Vty/Attributes/Color.hs view
@@ -1,16 +1,39 @@-module Graphics.Vty.Attributes.Color where+module Graphics.Vty.Attributes.Color+ ( Color(..)+ , black+ , red+ , green+ , yellow+ , blue+ , magenta+ , cyan+ , white+ , brightBlack+ , brightRed+ , brightGreen+ , brightYellow+ , brightBlue+ , brightMagenta+ , brightCyan+ , brightWhite+ )+where+ import Data.Word -- | Abstract data type representing a color.--- --- Currently the foreground and background color are specified as points in either a: ----- * 16 color palette. Where the first 8 colors are equal to the 8 colors of the ISO 6429 (ANSI) 8--- color palette and the second 8 colors are bright/vivid versions of the first 8 colors.+-- Currently the foreground and background color are specified as points+-- in either a: ----- * 240 color palette. This palette is a regular sampling of the full RGB colorspace for the first--- 224 colors. The remaining 16 colors is a greyscale palette.--- +-- * 16 color palette. Where the first 8 colors are equal to the 8+-- colors of the ISO 6429 (ANSI) 8 color palette and the second 8+-- colors are bright/vivid versions of the first 8 colors.+--+-- * 240 color palette. This palette is a regular sampling of the full+-- RGB colorspace for the first 224 colors. The remaining 16 colors is+-- a greyscale palette.+-- -- The 8 ISO 6429 (ANSI) colors are as follows: -- -- 0. black@@ -29,23 +52,49 @@ -- -- 7. white ----- The mapping from points in the 240 color palette to colors actually displayable by the terminal--- depends on the number of colors the terminal claims to support. Which is usually determined by--- the terminfo "colors" property. If this property is not being accurately reported then the color--- reproduction will be incorrect.+-- The mapping from points in the 240 color palette to colors actually+-- displayable by the terminal depends on the number of colors the+-- terminal claims to support. Which is usually determined by the+-- terminfo "colors" property. If this property is not being accurately+-- reported then the color reproduction will be incorrect. ----- If the terminal reports <= 16 colors then the 240 color palette points are only mapped to the 8--- color pallete. I'm not sure of the RGB points for the "bright" colors which is why they are not--- addressable via the 240 color palette. +-- If the terminal reports <= 16 colors then the 240 color palette+-- points are only mapped to the 8 color pallete. I'm not sure of+-- the RGB points for the "bright" colors which is why they are not+-- addressable via the 240 color palette. ----- If the terminal reports > 16 colors then the 240 color palette points are mapped to the nearest--- points in a ("color count" - 16) subsampling of the 240 color palette.+-- If the terminal reports > 16 colors then the 240 color palette+-- points are mapped to the nearest points in a ("color count" - 16)+-- subsampling of the 240 color palette. ----- All of this assumes the terminals are behaving similarly to xterm and rxvt when handling colors.--- And that the individual colors have not been remapped by the user. There may be a way to verify--- this through terminfo but I don't know it.+-- All of this assumes the terminals are behaving similarly to xterm and+-- rxvt when handling colors. And that the individual colors have not+-- been remapped by the user. There may be a way to verify this through+-- terminfo but I don't know it. -- -- Seriously, terminal color support is INSANE. data Color = ISOColor !Word8 | Color240 !Word8 deriving ( Eq, Show, Read ) +-- | Standard 8-color ANSI terminal color codes.+black, red, green, yellow, blue, magenta, cyan, white :: Color+black = ISOColor 0+red = ISOColor 1+green = ISOColor 2+yellow = ISOColor 3+blue = ISOColor 4+magenta= ISOColor 5+cyan = ISOColor 6+white = ISOColor 7++-- | Bright/Vivid variants of the standard 8-color ANSI+brightBlack, brightRed, brightGreen, brightYellow :: Color+brightBlue, brightMagenta, brightCyan, brightWhite :: Color+brightBlack = ISOColor 8+brightRed = ISOColor 9+brightGreen = ISOColor 10+brightYellow = ISOColor 11+brightBlue = ISOColor 12+brightMagenta= ISOColor 13+brightCyan = ISOColor 14+brightWhite = ISOColor 15
src/Graphics/Vty/Attributes/Color240.hs view
@@ -1,16 +1,17 @@-{-- - This header file was generated by ./256colres.pl- -}-module Graphics.Vty.Attributes.Color240 where+-- This header file was generated by ./256colres.pl+module Graphics.Vty.Attributes.Color240+ ( rgbColor+ )+where import Graphics.Vty.Attributes.Color import Text.Printf --- | RGB color to 240 color palette.------ generated from 256colres.pl which is forked from xterm 256colres.pl--- todo: all values get clamped high.+-- Note: rgbColor's mapping from RGB to 240 colors was generated from+-- 256colres.pl which is forked from xterm 256colres.pl.++-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple. rgbColor :: Integral i => i -> i -> i -> Color rgbColor r g b | r < 0 && g < 0 && b < 0 = error "rgbColor with negative color component intensity"@@ -254,8 +255,7 @@ | r <= 255 && g <= 255 && b <= 175 = Color240 213 | r <= 255 && g <= 255 && b <= 215 = Color240 214 | r <= 255 && g <= 255 && b <= 255 = Color240 215- | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette." + | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette." (fromIntegral r :: Int) (fromIntegral g :: Int) (fromIntegral b :: Int))-
src/Graphics/Vty/Config.hs view
@@ -1,23 +1,13 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ScopedTypeVariables #-}--- | A 'Config' can be provided to mkVty to customize the applications use of vty. A config file can--- be used to customize vty for a user's system.------ The 'Config' provided is mappend'd to 'Config's loaded from @'getAppUserDataDirectory'/config@--- and @$VTY_CONFIG_FILE@. The @$VTY_CONFIG_FILE@ takes precedence over the @config@ file or the--- application provided 'Config'.------ Lines in config files that fail to parse are ignored. Later entries take precedence over--- earlier.+-- | Vty supports a configuration file format and associated 'Config'+-- data type. The 'Config' can be provided to 'mkVty' to customize the+-- application's use of Vty. ----- For all directives:--- --- @--- string := \"\\\"\" chars+ \"\\\"\"--- @+-- Lines in config files that fail to parse are ignored. Later entries+-- take precedence over earlier ones. -- -- = Debug --@@ -29,8 +19,8 @@ -- \"debugLog\" string -- @ ----- The value of the environment variable @VTY_DEBUG_LOG@ is equivalent to a debugLog entry at the--- end of the last config file.+-- The value of the environment variable @VTY_DEBUG_LOG@ is equivalent+-- to a debugLog entry at the end of the last config file. -- -- = Input Processing --@@ -40,14 +30,14 @@ -- -- @ -- \"map\" term string key modifier_list--- where +-- where -- key := KEsc | KChar Char | KBS ... (same as 'Key') -- modifier_list := \"[\" modifier+ \"]\" -- modifier := MShift | MCtrl | MMeta | MAlt -- term := "_" | string -- @ ----- EG: If the contents are+-- E.g., if the contents are -- -- @ -- map _ \"\\ESC[B\" KUp []@@ -55,16 +45,15 @@ -- map \"xterm\" \"\\ESC[D\" KLeft [] -- @ ----- Then the bytes @\"\\ESC[B\"@ will result in the KUp event on all terminals. The bytes--- @\"\\ESC[1;3B\"@ will result in the event KDown with the MAlt modifier on all terminals.--- The bytes @\"\\ESC[D\"@ will result in the KLeft event when @TERM@ is @xterm@.------ If a debug log is requested then vty will output the current input table to the log in the above--- format.------ Set VTY_DEBUG_LOG. Run vty. Check debug log for incorrect mappings. Add corrected mappings to--- .vty/config+-- Then the bytes @\"\\ESC[B\"@ will result in the KUp event on all+-- terminals. The bytes @\"\\ESC[1;3B\"@ will result in the event KDown+-- with the MAlt modifier on all terminals. The bytes @\"\\ESC[D\"@ will+-- result in the KLeft event when @TERM@ is @xterm@. --+-- If a debug log is requested then vty will output the current input+-- table to the log in the above format. A workflow for using this is+-- to set @VTY_DEBUG_LOG@. Run the application. Check the debug log for+-- incorrect mappings. Add corrected mappings to @$HOME/.vty/config@. module Graphics.Vty.Config ( InputMap , Config(..)@@ -74,13 +63,11 @@ , standardIOConfig , runParseConfig , parseConfigFile- ) where+ , defaultConfig+ )+where -#if __GLASGOW_HASKELL__ > 704 import Prelude-#else-import Prelude hiding (catch)-#endif import Control.Applicative hiding (many) @@ -88,7 +75,6 @@ import Control.Monad (liftM, guard, void) import qualified Data.ByteString as BS-import Data.Default import Data.Monoid import Data.Typeable (Typeable) @@ -111,14 +97,14 @@ deriving (Show, Eq, Typeable) instance Exception VtyConfigurationError where-#if MIN_VERSION_base(4,8,0) displayException VtyMissingTermEnvVar = "TERM environment variable not set"-#endif --- | Mappings from input bytes to event in the order specified. Later entries take precedence over--- earlier in the case multiple entries have the same byte string.+-- | Mappings from input bytes to event in the order specified. Later+-- entries take precedence over earlier in the case multiple entries+-- have the same byte string. type InputMap = [(Maybe String, String, Event)] +-- | A Vty configuration. data Config = Config { -- | The default is 1 character.@@ -131,22 +117,25 @@ , bracketedPasteMode :: Maybe Bool -- | Debug information is appended to this file if not Nothing. , debugLog :: Maybe FilePath- -- | The (input byte, output event) pairs extend the internal input table of VTY and the table- -- from terminfo.+ -- | The (input byte, output event) pairs extend the internal input+ -- table of VTY and the table from terminfo. --- -- See "Graphics.Vty.Config" module documentation for documentation of the @map@ directive.+ -- See "Graphics.Vty.Config" module documentation for documentation+ -- of the @map@ directive. , inputMap :: InputMap- -- | The input file descriptor to use. The default is 'System.Posix.IO.stdInput'+ -- | The input file descriptor to use. The default is+ -- 'System.Posix.IO.stdInput' , inputFd :: Maybe Fd- -- | The output file descriptor to use. The default is 'System.Posix.IO.stdOutput'+ -- | The output file descriptor to use. The default is+ -- 'System.Posix.IO.stdOutput' , outputFd :: Maybe Fd -- | The terminal name used to look up terminfo capabilities. -- The default is the value of the TERM environment variable. , termName :: Maybe String } deriving (Show, Eq) -instance Default Config where- def = mempty+defaultConfig :: Config+defaultConfig = mempty instance Monoid Config where mempty = Config@@ -173,20 +162,21 @@ , termName = termName c1 <|> termName c0 } --- | Config from @'getAppUserDataDirectory'/config@ and @$VTY_CONFIG_FILE@+-- | Load a configuration from @'getAppUserDataDirectory'/config@ and+-- @$VTY_CONFIG_FILE@. userConfig :: IO Config userConfig = do configFile <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile- overrideConfig <- maybe (return def) parseConfigFile =<< getEnv "VTY_CONFIG_FILE"+ overrideConfig <- maybe (return defaultConfig) parseConfigFile =<< getEnv "VTY_CONFIG_FILE" let base = configFile <> overrideConfig mappend base <$> overrideEnvConfig overrideEnvConfig :: IO Config overrideEnvConfig = do d <- getEnv "VTY_DEBUG_LOG"- return $ def { debugLog = d }+ return $ defaultConfig { debugLog = d } --- | Configures VTY using defaults suitable for terminals. This action+-- | Configures VTY using defaults suitable for terminals. This function -- can raise 'VtyConfigurationError'. standardIOConfig :: IO Config standardIOConfig = do@@ -194,7 +184,7 @@ case mb of Nothing -> throwIO VtyMissingTermEnvVar Just t ->- return def+ return defaultConfig { vmin = Just 1 , mouseMode = Just False , bracketedPasteMode = Just False@@ -207,20 +197,18 @@ parseConfigFile :: FilePath -> IO Config parseConfigFile path = do catch (runParseConfig path <$> BS.readFile path)- (\(_ :: IOException) -> return def)+ (\(_ :: IOException) -> return defaultConfig) runParseConfig :: String -> BS.ByteString -> Config runParseConfig name cfgTxt = case runParser parseConfig () name cfgTxt of Right cfg -> cfg- Left{} -> def+ Left{} -> defaultConfig ------------------------------------------------------------------------ type Parser = Parsec BS.ByteString () --- I tried to use the haskellStyle here but that was specialized (without requirement?) to the--- String stream type. configLanguage :: Monad m => P.GenLanguageDef BS.ByteString () m configLanguage = LanguageDef { commentStart = "{-"@@ -247,13 +235,13 @@ bytes <- P.stringLiteral configLexer key <- parseValue modifiers <- parseValue- return def { inputMap = [(termIdent, bytes, EvKey key modifiers)] }+ return defaultConfig { inputMap = [(termIdent, bytes, EvKey key modifiers)] } debugLogDecl :: Parser Config debugLogDecl = do "debugLog" <- P.identifier configLexer path <- P.stringLiteral configLexer- return def { debugLog = Just path }+ return defaultConfig { debugLog = Just path } ignoreLine :: Parser () ignoreLine = void $ manyTill anyChar newline@@ -262,7 +250,7 @@ parseConfig = liftM mconcat $ many $ do P.whiteSpace configLexer let directives = [try mapDecl, try debugLogDecl]- choice directives <|> (ignoreLine >> return def)+ choice directives <|> (ignoreLine >> return defaultConfig) class Parse a where parseValue :: Parser a instance Parse Char where parseValue = P.charLiteral configLexer
src/Graphics/Vty/Debug.hs view
@@ -1,19 +1,19 @@ -- Copyright 2009-2010 Corey O'Connor-module Graphics.Vty.Debug ( module Graphics.Vty.Debug- , module Graphics.Vty.Debug.Image- )+module Graphics.Vty.Debug+ ( module Graphics.Vty.Debug+ , module Graphics.Vty.Debug.Image+ ) where -import Graphics.Vty.Prelude- import Graphics.Vty.Attributes+import Graphics.Vty.Image (DisplayRegion) import Graphics.Vty.Debug.Image import Graphics.Vty.Span -import qualified Data.Vector as Vector +import qualified Data.Vector as Vector rowOpsEffectedColumns :: DisplayOps -> [Int]-rowOpsEffectedColumns ops +rowOpsEffectedColumns ops = Vector.toList $ Vector.map spanOpsEffectedColumns ops allSpansHaveWidth :: DisplayOps -> Int -> Bool@@ -23,7 +23,7 @@ spanOpsEffectedRows :: DisplayOps -> Int spanOpsEffectedRows ops = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList ops))- + type SpanConstructLog = [SpanConstructEvent] data SpanConstructEvent = SpanSetAttr Attr @@ -37,4 +37,3 @@ regionForWindow :: MockWindow -> DisplayRegion regionForWindow (MockWindow w h) = (w,h)-
src/Graphics/Vty/Debug/Image.hs view
@@ -19,7 +19,7 @@ type ImageEndo = Image -> Image debugImageOps :: [ImageOp]-debugImageOps = +debugImageOps = [ idImageOp -- , renderSingleColumnCharOp -- , renderDoubleColumnCharOp
src/Graphics/Vty/DisplayAttributes.hs view
@@ -1,25 +1,16 @@ -- Copyright 2009-2010 Corey O'Connor-{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} -#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif--module Graphics.Vty.DisplayAttributes- where+module Graphics.Vty.DisplayAttributes where import Graphics.Vty.Attributes import Data.Bits ((.&.)) -#if !(MIN_VERSION_base(4,8,0))-import Data.Monoid (Monoid(..), mconcat)-#endif---- | Given the previously applied display attributes as a FixedAttr and the current display--- attributes as an Attr produces a FixedAttr that represents the current display attributes. This--- is done by using the previously applied display attributes to remove the "KeepCurrent"+-- | Given the previously applied display attributes as a FixedAttr and+-- the current display attributes as an Attr produces a FixedAttr that+-- represents the current display attributes. This is done by using the+-- previously applied display attributes to remove the "KeepCurrent" -- abstraction. fixDisplayAttr :: FixedAttr -> Attr -> FixedAttr fixDisplayAttr fattr attr@@ -34,12 +25,13 @@ fixColor c KeepCurrent = c fixColor _c (SetTo c) = Just c --- | difference between two display attributes. Used in the calculation of the operations required--- to go from one display attribute to the next.+-- | difference between two display attributes. Used in the calculation+-- of the operations required to go from one display attribute to the+-- next. ----- Previously, vty would reset display attributes to default then apply the new display attributes.--- This turned out to be very expensive: A *lot* more data would be sent to the terminal than--- required.+-- Previously, vty would reset display attributes to default then apply+-- the new display attributes. This turned out to be very expensive: A+-- *lot* more data would be sent to the terminal than required. data DisplayAttrDiff = DisplayAttrDiff { styleDiffs :: [StyleStateChange] , foreColorDiff :: DisplayColorDiff@@ -56,15 +48,11 @@ in DisplayAttrDiff ds fcd bcd -- | Used in the computation of a final style attribute change.------ TODO(corey): not really a simplify but a monoid instance. simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange] simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1 --- | Consider two display color attributes diffs. What display color attribute diff are these--- equivalent to?------ TODO(corey): not really a simplify but a monoid instance.+-- | Consider two display color attributes diffs. What display color+-- attribute diff are these equivalent to? simplifyColorDiffs :: DisplayColorDiff -> DisplayColorDiff -> DisplayColorDiff simplifyColorDiffs _cd ColorToDefault = ColorToDefault simplifyColorDiffs cd NoColorChange = cd@@ -77,9 +65,9 @@ | SetColor !Color deriving (Show, Eq) --- | Style attribute changes are transformed into a sequence of apply/removes of the individual--- attributes.-data StyleStateChange +-- | Style attribute changes are transformed into a sequence of+-- apply/removes of the individual attributes.+data StyleStateChange = ApplyStandout | RemoveStandout | ApplyUnderline@@ -94,8 +82,8 @@ | RemoveBold deriving (Show, Eq) --- | Determines the diff between two display&color attributes. This diff determines the operations--- that actually get output to the terminal.+-- | Determines the diff between two display&color attributes. This diff+-- determines the operations that actually get output to the terminal. displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff displayAttrDiffs attr attr' = DisplayAttrDiff { styleDiffs = diffStyles (fixedStyle attr) (fixedStyle attr')
src/Graphics/Vty/Error.hs view
@@ -1,8 +1,8 @@-module Graphics.Vty.Error- where+module Graphics.Vty.Error where -- | The type of exceptions specific to vty. ----- These have fully qualified names by default since, IMO, exception handling requires this.+-- These have fully qualified names by default since, IMO, exception+-- handling requires this. data VtyException = VtyFailure String -- ^ Uncategorized failure specific to vty.
src/Graphics/Vty/Image.hs view
@@ -2,47 +2,59 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DisambiguateRecordFields #-}-module Graphics.Vty.Image ( DisplayText- , Image- , imageWidth- , imageHeight- , horizJoin- , (<|>)- , vertJoin- , (<->)- , horizCat- , vertCat- , backgroundFill- , text- , text'- , char- , string- , iso10646String- , utf8String- , utf8Bytestring- , utf8Bytestring'- , charFill- , emptyImage- , safeWcwidth- , safeWcswidth- , wcwidth- , wcswidth- , crop- , cropRight- , cropLeft- , cropBottom- , cropTop- , pad- , resize- , resizeWidth- , resizeHeight- , translate- , translateX- , translateY- -- | The possible display attributes used in constructing an `Image`.- , module Graphics.Vty.Attributes- )- where+-- | A Vty program makes 'Picture's from 'Image's. This module provides+-- the core constructors for creating, combining, and modifying+-- 'Image's.+module Graphics.Vty.Image+ (+ -- * Images+ Image+ , imageWidth+ , imageHeight+ -- * Image constructors+ , emptyImage+ , char+ , string+ , iso10646String+ , utf8String+ , text+ , text'+ , backgroundFill+ , utf8Bytestring+ , utf8Bytestring'+ , charFill+ -- * Combinators+ , horizJoin+ , (<|>)+ , vertJoin+ , (<->)+ , horizCat+ , vertCat+ -- * Image modifications+ , crop+ , cropRight+ , cropLeft+ , cropBottom+ , cropTop+ , pad+ , resize+ , resizeWidth+ , resizeHeight+ , translate+ , translateX+ , translateY+ -- * Character width functions+ , safeWcwidth+ , safeWcswidth+ , wcwidth+ , wcswidth+ -- * Display Regions+ , DisplayText+ , DisplayRegion+ , regionWidth+ , regionHeight+ )+where import Graphics.Vty.Attributes import Graphics.Vty.Image.Internal@@ -56,115 +68,151 @@ import qualified Data.Text.Lazy.Encoding as TL import Data.Word +-- | A region of the display (first width, then height)+type DisplayRegion = (Int,Int)++regionWidth :: DisplayRegion -> Int+regionWidth = fst++regionHeight :: DisplayRegion -> Int+regionHeight = snd+ infixr 5 <|> infixr 4 <-> --- | An area of the picture's bacground (See Background) of w columns and h rows.-backgroundFill :: Int -> Int -> Image-backgroundFill w h +-- | An area of the picture's background (See 'Background').+backgroundFill :: Int+ -- ^ Fill width in columns+ -> Int+ -- ^ Fill height in rows+ -> Image+backgroundFill w h | w == 0 = EmptyImage | h == 0 = EmptyImage | otherwise = BGFill w h --- | Combines two images horizontally. Alias for horizJoin+-- | Combines two images horizontally. This is an alias for 'horizJoin'. -- -- infixr 5 (<|>) :: Image -> Image -> Image (<|>) = horizJoin --- | Combines two images vertically. Alias for vertJoin+-- | Combines two images vertically. This is an alias for 'vertJoin'. -- -- infixr 4 (<->) :: Image -> Image -> Image (<->) = vertJoin --- | Compose any number of images horizontally.+-- | Compose any number of images together horizontally, with the first+-- in the list being leftmost. horizCat :: [Image] -> Image horizCat = foldr horizJoin EmptyImage --- | Compose any number of images vertically.+-- | Compose any number of images vertically, with the first in the list+-- being topmost. vertCat :: [Image] -> Image vertCat = foldr vertJoin EmptyImage --- | A Data.Text.Lazy value+-- | Make an 'Image' from a lazy text value. text :: Attr -> TL.Text -> Image text a txt = let displayWidth = safeWcswidth (TL.unpack txt) in HorizText a txt displayWidth (fromIntegral $! TL.length txt) --- | A Data.Text value+-- | Make an 'Image' from a text value. text' :: Attr -> T.Text -> Image text' a txt = let displayWidth = safeWcswidth (T.unpack txt) in HorizText a (TL.fromStrict txt) displayWidth (T.length txt) --- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in--- the ISO-10646 encoding.+-- | Make an image from a single character. This is a standard Haskell+-- 31-bit character assumed to be in the ISO-10646 encoding. char :: Attr -> Char -> Image char a c = let displayWidth = safeWcwidth c in HorizText a (TL.singleton c) displayWidth 1 --- | A string of characters layed out on a single row with the same display attribute. The string is--- assumed to be a sequence of ISO-10646 characters. +-- | Make an image from a string of characters layed out on a single+-- row with the same display attribute. The string is assumed to be a+-- sequence of ISO-10646 characters. ----- Note: depending on how the Haskell compiler represents string literals a string literal in a--- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string. --- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry--- about the encoding format when outputting string literals. Just provide the string literal--- directly to iso10646String or string.--- +-- Note: depending on how the Haskell compiler represents string+-- literals, a string literal in a UTF-8 encoded source file, for+-- example, may be represented as a ISO-10646 string. That is, I think,+-- the case with GHC 6.10. This means, for the most part, you don't need+-- to worry about the encoding format when outputting string literals.+-- Just provide the string literal directly to iso10646String or string. iso10646String :: Attr -> String -> Image iso10646String a str = let displayWidth = safeWcswidth str in HorizText a (TL.pack str) displayWidth (length str) --- | Alias for iso10646String. Since the usual case is that a literal string like "foo" is--- represented internally as a list of ISO 10646 31 bit characters. +-- | Make an 'Image' from a 'String'. ----- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while--- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime--- representation.+-- This is an alias for iso10646String since the usual case is that a+-- literal string like "foo" is represented internally as a list of ISO+-- 10646 31 bit characters.+--+-- Note: Keep in mind that GHC will compile source encoded as UTF-8+-- but the literal strings, while UTF-8 encoded in the source, will be+-- transcoded to a ISO 10646 31 bit characters runtime representation. string :: Attr -> String -> Image string = iso10646String --- | A string of characters layed out on a single row. The input is assumed to be the bytes for--- UTF-8 encoded text.+-- | Make an 'Image' from a string of characters layed out on a single+-- row. The input is assumed to be the bytes for UTF-8 encoded text. utf8String :: Attr -> [Word8] -> Image utf8String a bytes = utf8Bytestring a (BL.pack bytes) --- | Renders a UTF-8 encoded lazy bytestring. +-- | Make an 'Image' from a UTF-8 encoded lazy bytestring. utf8Bytestring :: Attr -> BL.ByteString -> Image utf8Bytestring a bs = text a (TL.decodeUtf8 bs) --- | Renders a UTF-8 encoded strict bytestring. +-- | Make an 'Image' from a UTF-8 encoded lazy bytestring. utf8Bytestring' :: Attr -> B.ByteString -> Image utf8Bytestring' a bs = text' a (T.decodeUtf8 bs) --- | creates a fill of the specified character. The dimensions are in number of characters wide and--- number of rows high.-charFill :: Integral d => Attr -> Char -> d -> d -> Image+-- | Make an image filling a region with the specified character.+charFill :: Integral d+ => Attr+ -- ^ The attribute to use.+ -> Char+ -- ^ The character to use in filling the region.+ -> d+ -- ^ The region width.+ -> d+ -- ^ The region height.+ -> Image charFill _a _c 0 _h = EmptyImage charFill _a _c _w 0 = EmptyImage charFill a c w h = vertCat $ replicate (fromIntegral h) $ HorizText a txt displayWidth charWidth- where + where txt = TL.replicate (fromIntegral w) (TL.singleton c) displayWidth = safeWcwidth c * (fromIntegral w) charWidth = fromIntegral w --- | The empty image. Useful for fold combinators. These occupy no space nor define any display--- attributes.-emptyImage :: Image +-- | The empty image. Useful for fold combinators. These occupy no space+-- and do not affect display attributes.+emptyImage :: Image emptyImage = EmptyImage --- | pad the given image. This adds background character fills to the left, top, right, bottom.--- The pad values are how many display columns or rows to add.-pad :: Int -> Int -> Int -> Int -> Image -> Image+-- | Pad the given image. This adds background character fills to the+-- left, top, right, bottom.+pad :: Int+ -- ^ How much padding to add to the left side of the image.+ -> Int+ -- ^ How much padding to add to the top of the image.+ -> Int+ -- ^ How much padding to add to the right side of the image.+ -> Int+ -- ^ How much padding to add to the bottom of the image.+ -> Image+ -- ^ The image to pad.+ -> Image pad 0 0 0 0 i = i pad inL inT inR inB inImage | inL < 0 || inT < 0 || inR < 0 || inB < 0 = error "cannot pad by negative amount" | otherwise = go inL inT inR inB inImage- where - -- TODO: uh.+ where go 0 0 0 0 i = i go 0 0 0 b i = VertJoin i (BGFill w b) w h where w = imageWidth i@@ -179,40 +227,51 @@ where w = imageWidth i + l h = imageHeight i --- | translates an image by padding or cropping the left and top. First param is amount to translate--- left. Second param is amount to translate top.+-- | Translates an image by padding or cropping the left and top. ----- This can have an unexpected effect: Translating an image to less than (0,0) then to greater than--- (0,0) will crop the image.-translate :: Int -> Int -> Image -> Image+-- If translation offsets are negative then the image is cropped.+translate :: Int+ -- ^ The horizontal translation offset (can be negative)+ -> Int+ -- ^ The vertical translation offset (can be negative)+ -> Image+ -- ^ The image to translate.+ -> Image translate x y i = translateX x (translateY y i) --- | translates an image by padding or cropping the left+-- | Translates an image by padding or cropping its left side. translateX :: Int -> Image -> Image translateX x i | x < 0 = let s = abs x in CropLeft i s (imageWidth i - s) (imageHeight i) | x == 0 = i | otherwise = let h = imageHeight i in HorizJoin (BGFill x h) i (imageWidth i + x) h --- | translates an image by padding or cropping the top+-- | Translates an image by padding or cropping its top. translateY :: Int -> Image -> Image translateY y i | y < 0 = let s = abs y in CropTop i s (imageWidth i) (imageHeight i - s) | y == 0 = i | otherwise = let w = imageWidth i in VertJoin (BGFill w y) i w (imageHeight i + y) --- | Ensure an image is no larger than the provided size. If the image is larger then crop the right--- or bottom.+-- | Ensure an image is no larger than the provided size. If the image+-- is larger then crop the right or bottom. ----- This is transformed to a vertical crop from the bottom followed by horizontal crop from the--- right.-crop :: Int -> Int -> Image -> Image+-- This is equivalent to a vertical crop from the bottom followed by+-- horizontal crop from the right.+crop :: Int+ -- ^ Cropping width+ -> Int+ -- ^ Cropping height+ -> Image+ -- ^ The image to crop+ -> Image crop 0 _ _ = EmptyImage crop _ 0 _ = EmptyImage crop w h i = cropBottom h (cropRight w i) --- | crop the display height. If the image is less than or equal in height then this operation has--- no effect. Otherwise the image is cropped from the bottom.+-- | Crop an image's height. If the image's height is less than or equal+-- to the specified height then this operation has no effect. Otherwise+-- the image is cropped from the bottom. cropBottom :: Int -> Image -> Image cropBottom 0 _ = EmptyImage cropBottom h inI@@ -227,8 +286,9 @@ | h >= imageHeight i = i | otherwise = CropBottom i (imageWidth i) h --- | ensure the image is no wider than the given width. If the image is wider then crop the right--- side.+-- | Crop an image's width. If the image's width is less than or equal+-- to the specified width then this operation has no effect. Otherwise+-- the image is cropped from the right. cropRight :: Int -> Image -> Image cropRight 0 _ = EmptyImage cropRight w inI@@ -243,8 +303,9 @@ | w >= imageWidth i = i | otherwise = CropRight i w (imageHeight i) --- | ensure the image is no wider than the given width. If the image is wider then crop the left--- side.+-- | Crop an image's width. If the image's width is less than or equal+-- to the specified width then this operation has no effect. Otherwise+-- the image is cropped from the left. cropLeft :: Int -> Image -> Image cropLeft 0 _ = EmptyImage cropLeft w inI@@ -261,8 +322,9 @@ | imageWidth i <= w = i | otherwise = CropLeft i (imageWidth i - w) w (imageHeight i) --- | crop the display height. If the image is less than or equal in height then this operation has--- no effect. Otherwise the image is cropped from the top.+-- | Crop an image's height. If the image's height is less than or equal+-- to the specified height then this operation has no effect. Otherwise+-- the image is cropped from the top. cropTop :: Int -> Image -> Image cropTop 0 _ = EmptyImage cropTop h inI@@ -279,24 +341,24 @@ | imageHeight i <= h = i | otherwise = CropTop i (imageHeight i - h) (imageWidth i) h --- | Generic resize. Pads and crops as required to assure the given display width and height.--- This is biased to pad/crop the right and bottom.+-- | Generic resize. Pads and crops are added to ensure that the+-- resulting image matches the specified dimensions. This is biased to+-- pad/crop the right and bottom. resize :: Int -> Int -> Image -> Image resize w h i = resizeHeight h (resizeWidth w i) --- | Resize the width. Pads and crops as required to assure the given display width.--- This is biased to pad/crop the right.+-- | Resize the width. Pads and crops as required to assure the given+-- display width. This is biased to pad/crop on the right. resizeWidth :: Int -> Image -> Image resizeWidth w i = case w `compare` imageWidth i of LT -> cropRight w i EQ -> i GT -> i <|> BGFill (w - imageWidth i) (imageHeight i) --- | Resize the height. Pads and crops as required to assure the given display height.--- This is biased to pad/crop the bottom.+-- | Resize the height. Pads and crops as required to assure the given+-- display height. This is biased to pad/crop on the bottom. resizeHeight :: Int -> Image -> Image resizeHeight h i = case h `compare` imageHeight i of LT -> cropBottom h i EQ -> i GT -> i <-> BGFill (imageWidth i) (h - imageHeight i)-
src/Graphics/Vty/Image/Internal.hs view
@@ -1,12 +1,7 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_HADDOCK hide #-} -#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif- module Graphics.Vty.Image.Internal where import Graphics.Vty.Attributes@@ -18,22 +13,9 @@ import qualified Data.Text.Lazy as TL -#if !(MIN_VERSION_base(4,8,0))-import Data.Monoid-#endif- -- | A display text is a Data.Text.Lazy------ TODO(corey): hm. there is an explicit equation for each type which goes to a lazy text. Each--- application probably uses a single type. Perhaps parameterize the entire vty interface by the--- input text type?--- TODO: Try using a builder instead of a TL.Text instance directly. That might improve performance--- for the usual case of appending a bunch of characters with the same attribute together. type DisplayText = TL.Text --- TODO: store a skip list in HorizText(?)--- TODO: represent display strings containing chars that are not 1 column chars as a separate--- display string value? clipText :: DisplayText -> Int -> Int -> DisplayText clipText txt leftSkip rightClip = -- CPS would clarify this I think@@ -42,8 +24,8 @@ (toTake,padSuffix) = clipForCharWidth rightClip txt' 0 txt'' = TL.append (TL.take toTake txt') (if padSuffix then TL.singleton '…' else TL.empty) -- Note: some characters and zero-width and combining characters- -- combine to the left, so keep taking characters even if the width- -- is zero.+ -- combine to the left, so keep taking characters even if the+ -- width is zero. clipForCharWidth w t n | TL.null t = (n, False) | w < cw = (n, w /= 0)@@ -51,8 +33,8 @@ where cw = safeWcwidth (TL.head t) in txt'' --- | This is the internal representation of Images. Use the constructors in "Graphics.Vty.Image" to--- create instances.+-- | This is the internal representation of Images. Use the constructors+-- in "Graphics.Vty.Image" to create instances. -- -- Images are: --@@ -65,49 +47,61 @@ -- * a cropped image -- -- * an empty image of no size or content.-data Image = +data Image = -- | A horizontal text span has a row height of 1. HorizText { attr :: Attr- -- | The text to display. The display width of the text is always outputWidth.+ -- | The text to display. The display width of the text is always+ -- outputWidth. , displayText :: DisplayText -- | The number of display columns for the text. , outputWidth :: Int -- | the number of characters in the text. , charWidth :: Int }- -- | A horizontal join can be constructed between any two images. However a HorizJoin instance is- -- required to be between two images of equal height. The horizJoin constructor adds background- -- fills to the provided images that assure this is true for the HorizJoin value produced.+ -- | A horizontal join can be constructed between any two images.+ -- However a HorizJoin instance is required to be between two images+ -- of equal height. The horizJoin constructor adds background fills+ -- to the provided images that assure this is true for the HorizJoin+ -- value produced. | HorizJoin- { partLeft :: Image + { partLeft :: Image , partRight :: Image- , outputWidth :: Int -- ^ imageWidth partLeft == imageWidth partRight. Always > 0- , outputHeight :: Int -- ^ imageHeight partLeft == imageHeight partRight. Always > 0+ , outputWidth :: Int+ -- ^ imageWidth partLeft == imageWidth partRight. Always > 0+ , outputHeight :: Int+ -- ^ imageHeight partLeft == imageHeight partRight. Always > 0 }- -- | A veritical join can be constructed between any two images. However a VertJoin instance is- -- required to be between two images of equal width. The vertJoin constructor adds background- -- fills to the provides images that assure this is true for the VertJoin value produced.+ -- | A veritical join can be constructed between any two images.+ -- However a VertJoin instance is required to be between two images+ -- of equal width. The vertJoin constructor adds background fills+ -- to the provides images that assure this is true for the VertJoin+ -- value produced. | VertJoin { partTop :: Image , partBottom :: Image- , outputWidth :: Int -- ^ imageWidth partTop == imageWidth partBottom. always > 0- , outputHeight :: Int -- ^ imageHeight partTop == imageHeight partBottom. always > 1+ , outputWidth :: Int+ -- ^ imageWidth partTop == imageWidth partBottom. always > 0+ , outputHeight :: Int+ -- ^ imageHeight partTop == imageHeight partBottom. always > 1 }- -- | A background fill will be filled with the background char. The background char is- -- defined as a property of the Picture this Image is used to form.+ -- | A background fill will be filled with the background char. The+ -- background char is defined as a property of the Picture this+ -- Image is used to form. | BGFill { outputWidth :: Int -- ^ always > 0 , outputHeight :: Int -- ^ always > 0 }- -- | Crop an image horizontally to a size by reducing the size from the right.+ -- | Crop an image horizontally to a size by reducing the size from+ -- the right. | CropRight { croppedImage :: Image -- | Always < imageWidth croppedImage > 0 , outputWidth :: Int , outputHeight :: Int -- ^ imageHeight croppedImage }- -- | Crop an image horizontally to a size by reducing the size from the left.+ -- | Crop an image horizontally to a size by reducing the size from+ -- the left. | CropLeft { croppedImage :: Image -- | Always < imageWidth croppedImage > 0@@ -116,7 +110,8 @@ , outputWidth :: Int , outputHeight :: Int }- -- | Crop an image vertically to a size by reducing the size from the bottom+ -- | Crop an image vertically to a size by reducing the size from+ -- the bottom | CropBottom { croppedImage :: Image -- | imageWidth croppedImage@@ -124,7 +119,8 @@ -- | height image is cropped to. Always < imageHeight croppedImage > 0 , outputHeight :: Int }- -- | Crop an image vertically to a size by reducing the size from the top+ -- | Crop an image vertically to a size by reducing the size from+ -- the top | CropTop { croppedImage :: Image -- | Always < imageHeight croppedImage > 0@@ -136,10 +132,10 @@ } -- | The empty image --- -- The combining operators identity constant. + -- The combining operators identity constant. -- EmptyImage <|> a = a -- EmptyImage <-> a = a- -- + -- -- Any image of zero size equals the empty image. | EmptyImage deriving (Eq, Generic)@@ -198,7 +194,7 @@ = "CropTop("++ show outputWidth ++ "," ++ show topSkip ++ "->" ++ show outputHeight ++ ")\n" ++ go (i+1) croppedImage pp _ EmptyImage = "EmptyImage"- + instance NFData Image where rnf EmptyImage = () rnf (CropRight i w h) = i `deepseq` w `seq` h `seq` ()@@ -210,7 +206,8 @@ rnf (HorizJoin l r w h) = l `deepseq` r `deepseq` w `seq` h `seq` () rnf (HorizText a s w cw) = a `seq` s `deepseq` w `seq` cw `seq` () --- | The width of an Image. This is the number display columns the image will occupy.+-- | The width of an Image. This is the number display columns the image+-- will occupy. imageWidth :: Image -> Int imageWidth HorizText { outputWidth = w } = w imageWidth HorizJoin { outputWidth = w } = w@@ -222,7 +219,8 @@ imageWidth CropTop { outputWidth = w } = w imageWidth EmptyImage = 0 --- | The height of an Image. This is the number of display rows the image will occupy.+-- | The height of an Image. This is the number of display rows the+-- image will occupy. imageHeight :: Image -> Int imageHeight HorizText {} = 1 imageHeight HorizJoin { outputHeight = h } = h@@ -234,27 +232,26 @@ imageHeight CropTop { outputHeight = h } = h imageHeight EmptyImage = 0 --- | Append in the Monoid instance is equivalent to <->. +-- | Append in the Monoid instance is equivalent to <->. instance Monoid Image where mempty = EmptyImage mappend = vertJoin -- | combines two images side by side ----- Combines text chunks where possible. Assures outputWidth and outputHeight properties are not--- violated.------ The result image will have a width equal to the sum of the two images width. And the height will--- equal the largest height of the two images. The area not defined in one image due to a height--- missmatch will be filled with the background pattern.+-- Combines text chunks where possible. Assures outputWidth and+-- outputHeight properties are not violated. ----- TODO: the bg fill is biased towards top to bottom languages(?)+-- The result image will have a width equal to the sum of the two images+-- width. And the height will equal the largest height of the two+-- images. The area not defined in one image due to a height missmatch+-- will be filled with the background pattern. horizJoin :: Image -> Image -> Image horizJoin EmptyImage i = i horizJoin i EmptyImage = i horizJoin i0@(HorizText a0 t0 w0 cw0) i1@(HorizText a1 t1 w1 cw1) | a0 == a1 = HorizText a0 (TL.append t0 t1) (w0 + w1) (cw0 + cw1)- -- TODO: assumes horiz text height is always 1+ -- assumes horiz text height is always 1 | otherwise = HorizJoin i0 i1 (w0 + w1) 1 horizJoin i0 i1 -- If the images are of the same height then no padding is required@@ -276,19 +273,19 @@ -- | combines two images vertically ----- The result image will have a height equal to the sum of the heights of both images.--- The width will equal the largest width of the two images.--- The area not defined in one image due to a width missmatch will be filled with the background--- pattern.------ TODO: the bg fill is biased towards right to left languages(?)+-- The result image will have a height equal to the sum of the heights+-- of both images. The width will equal the largest width of the two+-- images. The area not defined in one image due to a width missmatch+-- will be filled with the background pattern. vertJoin :: Image -> Image -> Image vertJoin EmptyImage i = i vertJoin i EmptyImage = i vertJoin i0 i1- -- If the images are of the same width then no background padding is required+ -- If the images are of the same width then no background padding is+ -- required | w0 == w1 = VertJoin i0 i1 w0 h- -- Otherwise one of the images needs to be padded to the size of the other image.+ -- Otherwise one of the images needs to be padded to the size of the+ -- other image. | w0 < w1 = let padAmount = w1 - w0 in VertJoin (HorizJoin i0 (BGFill padAmount h0) w1 h0) i1 w1 h@@ -302,4 +299,3 @@ h1 = imageHeight i1 h = h0 + h1 vertJoin _ _ = error "vertJoin applied to undefined values."-
src/Graphics/Vty/Inline.hs view
@@ -1,45 +1,43 @@--- | The inline module provides a limited interface to changing the style of terminal output. The--- intention is for this interface to be used inline with other output systems. +{-# LANGUAGE BangPatterns #-}++-- | The inline module provides a limited interface to changing the+-- style of terminal output. The intention is for this interface to be+-- used inline with other output systems. ----- The changes specified by the InlineM monad are applied to the terminals display attributes. These--- display attributes effect the display of all following text output to the terminal file--- descriptor.+-- The changes specified by the InlineM monad are applied to the+-- terminal's display attributes. These display attributes affect the+-- display of all following text output to the terminal file descriptor. ----- For example, in an IO monad the following code with print the text \"Not styled. \" Followed by the--- text \" Styled! \" drawn over a red background and underlined.+-- For example, in an IO monad the following code will print the text+-- \"Not styled. \" Followed by the text \" Styled! \" drawn over a red+-- background and underlined. -- -- @ -- putStr \"Not styled. \" -- putAttrChange_ $ do--- backColor red +-- backColor red -- applyStyle underline -- putStr \" Styled! \" -- putAttrChange_ $ defaultAll -- putStrLn \"Not styled.\" -- @ ----- 'putAttrChange' outputs the control codes to the terminal device 'Handle'. This is a duplicate--- of the 'stdout' handle when the 'terminalHandle' was (first) acquired. If 'stdout' has since been--- changed then 'putStr', 'putStrLn', 'print' etc.. will output to a different 'Handle' than--- 'putAttrChange'+-- 'putAttrChange' emits the control codes to the terminal device+-- attached to 'Handle'. This is a duplicate of the 'stdout' handle when+-- the 'terminalHandle' was (first) acquired. If 'stdout' has since been+-- changed then 'putStr', 'putStrLn', 'print' etc. will output to a+-- different 'Handle' than 'putAttrChange'. -- -- Copyright 2009-2010 Corey O'Connor-{-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}--#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif--module Graphics.Vty.Inline ( module Graphics.Vty.Inline- , withVty- )- where+module Graphics.Vty.Inline+ ( module Graphics.Vty.Inline+ , withVty+ )+where import Graphics.Vty import Graphics.Vty.DisplayAttributes import Graphics.Vty.Inline.Unsafe-import Graphics.Vty.Output.Interface import Blaze.ByteString.Builder (writeToByteString) @@ -50,44 +48,42 @@ import System.IO -#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative-import Data.Monoid ( mappend )-#endif- type InlineM v = State Attr v --- | Set the background color to the provided 'Color'+-- | Set the background color to the provided 'Color'. backColor :: Color -> InlineM () backColor c = modify $ flip mappend ( currentAttr `withBackColor` c ) --- | Set the foreground color to the provided 'Color'+-- | Set the foreground color to the provided 'Color'. foreColor :: Color -> InlineM () foreColor c = modify $ flip mappend ( currentAttr `withForeColor` c ) --- | Attempt to change the 'Style' of the following text.+-- | Attempt to change the 'Style' of the following text.. ----- If the terminal does not support the style change no error is produced. The style can still be--- removed.+-- If the terminal does not support the style change then no error is+-- produced. The style can still be removed. applyStyle :: Style -> InlineM () applyStyle s = modify $ flip mappend ( currentAttr `withStyle` s ) --- | Attempt to remove the specified 'Style' from the display of the following text.+-- | Attempt to remove the specified 'Style' from the display of the+-- following text. ----- This will fail if applyStyle for the given style has not been previously called. +-- This will fail if 'applyStyle' for the given style has not been+-- previously called. removeStyle :: Style -> InlineM ()-removeStyle sMask = modify $ \attr -> +removeStyle sMask = modify $ \attr -> let style' = case attrStyle attr of Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used." KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used." SetTo s -> s .&. complement sMask- in attr { attrStyle = SetTo style' } + in attr { attrStyle = SetTo style' } --- | Reset the display attributes+-- | Reset the display attributes. defaultAll :: InlineM () defaultAll = put defAttr --- | Apply the provided display attribute changes to the given terminal output device.+-- | Apply the provided display attribute changes to the given terminal+-- output device. -- -- This does not flush the terminal. putAttrChange :: ( Applicative m, MonadIO m ) => Output -> InlineM () -> m ()@@ -108,8 +104,8 @@ modifyIORef (assumedStateRef out) $ \s -> s { prevFattr = Just fattr' } inlineHack dc --- | Apply the provided display attributes changes to the terminal output device that was current at--- the time this was first used. Which, for most use cases, is the current terminal.+-- | Apply the provided display attributes changes to the terminal+-- output device. -- -- This will flush the terminal output. putAttrChange_ :: ( Applicative m, MonadIO m ) => InlineM () -> m ()
src/Graphics/Vty/Inline/Unsafe.hs view
@@ -1,16 +1,9 @@-{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} -#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif- module Graphics.Vty.Inline.Unsafe where import Graphics.Vty -import Data.Default-import Data.Monoid import Data.IORef import GHC.IO.Handle (hDuplicate)@@ -21,10 +14,6 @@ import System.Posix.IO (handleToFd) -#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative-#endif- globalVty :: IORef (Maybe Vty) {-# NOINLINE globalVty #-} globalVty = unsafePerformIO $ newIORef Nothing@@ -39,10 +28,11 @@ hSetBuffering stdin NoBuffering stdinDupe <- hDuplicate stdin >>= handleToFd stdoutDupe <- hDuplicate stdout >>= handleToFd- return $ def { inputFd = Just stdinDupe, outputFd = Just stdoutDupe }+ return $ defaultConfig { inputFd = Just stdinDupe, outputFd = Just stdoutDupe } --- | This will create a Vty instance using 'mkVty' and execute an IO action provided that instance.--- The created Vty instance will be stored to the unsafe 'IORef' 'globalVty'.+-- | This will create a Vty instance using 'mkVty' and execute an IO+-- action provided that instance. The created Vty instance will be+-- stored to the unsafe 'IORef' 'globalVty'. -- -- This instance will use duplicates of the stdin and stdout Handles. withVty :: (Vty -> IO b) -> IO b
src/Graphics/Vty/Input.hs view
@@ -1,135 +1,125 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} -#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif---- | The input layer for VTY. This provides methods for initializing an 'Input' structure which can--- then be used to read 'Event's from the terminal.------ The history of terminals has resulted in a broken input process. Some keys and combinations will--- not reliably map to the expected events by any terminal program. Even those not using vty. There--- is no 1:1 mapping from key events to bytes read from the terminal input device. In very limited--- cases the terminal and vty's input process can be customized to resolve these issues.+-- | This module provides the input layer for Vty, including methods+-- for initializing an 'Input' structure and reading 'Event's from the+-- terminal. ----- See "Graphics.Vty.Config" for how to configure vty's input processing. Customizing terminfo and--- the terminal is beyond the scope of this documentation.+-- Note that due to the evolution of terminal emulators, some keys+-- and combinations will not reliably map to the expected events by+-- any terminal program. There is no 1:1 mapping from key events to+-- bytes read from the terminal input device. In very limited cases the+-- terminal and vty's input process can be customized to resolve these+-- issues; see "Graphics.Vty.Config" for how to configure vty's input+-- processing. -- -- = VTY's Implementation ----- One can get the brain rot trying to understand all this. So, as far as I can care...--- -- There are two input modes: ----- 1. 7 bit+-- 1. 7-bit ----- 2. 8 bit+-- 2. 8-bit ----- 7 bit input is the default and the expected in most use cases. This is what vty uses.+-- The 7-bit input mode is the default and the expected mode in most use+-- cases. This is what Vty uses. ----- == 7 bit input encoding+-- == 7-bit input encoding ----- Control key combinations are represented by masking the two high bits of the 7bit input. Back in--- the day the control key actually grounded the two high bit wires: 6 and 7. This is why--- control key combos map to single character events: The input bytes are identical. The input byte--- is the bit encoding of the character with bits 6 and 7 masked. Bit 6 is set by shift. Bit 6 and--- 7 are masked by control. EG:+-- Control key combinations are represented by masking the two high bits+-- of the 7-bit input. Historically the control key actually grounded+-- the two high bit wires: 6 and 7. This is why control key combos+-- map to single character events: the input bytes are identical. The+-- input byte is the bit encoding of the character with bits 6 and 7+-- masked. Bit 6 is set by shift. Bit 6 and 7 are masked by control. For+-- example, ----- * Control-I is 'i', `01101001`, has bit 6 and 7 masked to become `00001001`. Which is the ASCII--- and UTF-8 encoding of the tab key.+-- * Control-I is 'i', `01101001`, and has bit 6 and 7 masked to become+-- `00001001`, which is the ASCII and UTF-8 encoding of the Tab key. ----- * Control+Shift-C is 'C', `01000011`, with bit 6 and 7 set to zero which makes `0000011` and--- is the "End of Text" code.+-- * Control+Shift-C is 'C', `01000011`, with bit 6 and 7 set to zero+-- which is `0000011` and is the "End of Text" code. ----- * Hypothesis: This is why capital-A, 'A', has value 65 in ASCII: This is the value 1 with bit 7--- set and 6 unset.+-- * Hypothesis: This is why capital-A, 'A', has value 65 in ASCII: this+-- is the value 1 with bit 7 set and 6 unset. ----- * Hypothesis: Bit 6 is unset by upper case letters because, initially, there were only upper case--- letters used and a 5 bit encoding.+-- * Hypothesis: Bit 6 is unset by upper case letters because,+-- initially, there were only upper case letters used and a 5 bit+-- encoding. ----- == 8 bit encoding+-- == 8-bit encoding ----- The 8th bit was originally used for parity checking. Useless for emulators. Some terminal--- emulators support a 8 bit input encoding. While this provides some advantages the actual usage is--- low. Most systems use 7bit mode but recognize 8bit control characters when escaped. This is what--- vty does.+-- The 8th bit was originally used for parity checking which is useless+-- for terminal emulators. Some terminal emulators support an 8-bit+-- input encoding. While this provides some advantages, the actual usage+-- is low. Most systems use 7-bit mode but recognize 8-bit control+-- characters when escaped. This is what Vty does. -- -- == Escaped Control Keys ----- Using 7 bit input encoding the @ESC@ byte can signal the start of an encoded control key. To--- differentiate a single @ESC@ eventfrom a control key the timing of the input is used.------ 1. @ESC@ individually: @ESC@ byte; no bytes for 'singleEscPeriod'.+-- Using 7-bit input encoding, the @ESC@ byte can signal the start of+-- an encoded control key. To differentiate a single @ESC@ event from a+-- control key, the timing of the input is used. ----- 2. control keys that contain @ESC@ in their encoding: The @ESC byte; followed by more bytes read--- within 'singleEscPeriod'. All bytes up until the next valid input block are passed to the--- classifier.+-- 1. @ESC@ individually: @ESC@ byte; no bytes following for a period of+-- 'VMIN' milliseconds. ----- If the current runtime is the threaded runtime then the terminal's @VMIN@ and @VTIME@ behavior--- reliably implement the above rules. If the current runtime does not support forkOS then there is--- currently no implementation.+-- 2. Control keys that contain @ESC@ in their encoding: The @ESC byte+-- is followed by more bytes read within 'VMIN' milliseconds. All bytes+-- up until the next valid input block are passed to the classifier. ----- Vty used to emulate @VMIN@ and @VTIME@. This was a input loop which did tricky things with--- non-blocking reads and timers. The implementation was not reliable. A reliable implementation is--- possible, but there are no plans to implement this.+-- If the current runtime is the threaded runtime then the terminal's+-- @VMIN@ and @VTIME@ behavior reliably implement the above rules. If+-- the current runtime does not support 'forkOS' then there is currently+-- no implementation. -- -- == Unicode Input and Escaped Control Key Sequences ----- The input encoding determines how UTF-8 encoded characters are recognize.+-- The input encoding determines how UTF-8 encoded characters are+-- recognized. ----- * 7 bit mode: UTF-8 can be input unambiguiously. UTF-8 input is a superset of ASCII. UTF-8 does--- not overlap escaped control key sequences. However, the escape key must be differentiated from+-- * 7-bit mode: UTF-8 can be input unambiguiously. UTF-8 input is+-- a superset of ASCII. UTF-8 does not overlap escaped control key+-- sequences. However, the escape key must be differentiated from -- escaped control key sequences by the timing of the input bytes. ----- * 8 bit mode: UTF-8 cannot be input unambiguously. This does not require using the timing of--- input bytes to differentiate the escape key. Many terminals do not support 8 bit mode.+-- * 8-bit mode: UTF-8 cannot be input unambiguously. This does not+-- require using the timing of input bytes to differentiate the escape+-- key. Many terminals do not support 8-bit mode. -- -- == Terminfo ----- The terminfo system is used to determine how some keys are encoded. Terminfo is incomplete. In--- some cases terminfo is incorrect. Vty assumes terminfo is correct but provides a mechanism to--- override terminfo. See "Graphics.Vty.Config" specifically 'inputOverrides'.+-- The terminfo system is used to determine how some keys are encoded.+-- Terminfo is incomplete and in some cases terminfo is incorrect. Vty+-- assumes terminfo is correct but provides a mechanism to override+-- terminfo; see "Graphics.Vty.Config", specifically 'inputOverrides'. -- -- == Terminal Input is Broken ----- Clearly terminal input has fundemental issues. There is no easy way to reliably resolve these--- issues.------ One resolution would be to ditch standard terminal interfaces entirely and just go directly to--- scancodes. A reasonable option for vty if everybody used the linux kernel console. I hear GUIs--- are popular these days. Sadly, GUI terminal emulators don't provide access to scancodes AFAIK.------ All is lost? Not really. "Graphics.Vty.Config" supports customizing the input byte to event--- mapping and xterm supports customizing the scancode to input byte mapping. With a lot of work a--- user's system can be set up to encode all the key combos in an almost-sane manner.------ There are other tricky work arounds that can be done. I have no interest in implementing most of--- these. They are not really worth the time.+-- Clearly terminal input has fundemental issues. There is no easy way+-- to reliably resolve these issues. ----- == Terminal Output is Also Broken+-- One resolution would be to ditch standard terminal interfaces+-- entirely and just go directly to scancodes. This would be a+-- reasonable option for Vty if everybody used the linux kernel console+-- but for obvious reasons this is not possible. ----- This isn't the only odd aspect of terminals due to historical aspects that no longer apply. EG:--- Some terminfo capabilities specify millisecond delays. (Capabilities are how terminfo describes--- the control sequence to output red, for instance) This is to account for the slow speed of--- hardcopy teletype interfaces. Cause, uh, we totally still use those.--- --- The output encoding of colors and attributes are also rife with issues.+-- The "Graphics.Vty.Config" module supports customizing the+-- input-byte-to-event mapping and xterm supports customizing the+-- scancode-to-input-byte mapping. With a lot of work a user's system+-- can be set up to encode all the key combos in an almost-sane manner. -- -- == See also -- -- * http://www.leonerd.org.uk/hacks/fixterms/------ In my experience this cannot resolve the issues without changes to the terminal emulator and--- device.-module Graphics.Vty.Input ( Key(..)- , Modifier(..)- , Button(..)- , Event(..)- , Input(..)- , inputForConfig- )- where+module Graphics.Vty.Input+ ( Key(..)+ , Modifier(..)+ , Button(..)+ , Event(..)+ , Input(..)+ , inputForConfig+ )+where import Graphics.Vty.Config import Graphics.Vty.Input.Events@@ -142,42 +132,31 @@ import qualified System.Console.Terminfo as Terminfo import System.Posix.Signals.Exts -#if !(MIN_VERSION_base(4,8,0))-import Data.Functor ((<$>))-import Data.Monoid-#else import Data.Monoid ((<>))-#endif --- | Set up the terminal with file descriptor `inputFd` for input. Returns a 'Input'.+-- | Set up the terminal with file descriptor `inputFd` for input.+-- Returns an 'Input'. ----- The table used to determine the 'Events' to produce for the input bytes comes from--- 'classifyMapForTerm'. Which is then overridden by the the applicable entries from--- 'inputMap'.+-- The table used to determine the 'Events' to produce for the input+-- bytes comes from 'classifyMapForTerm' which is then overridden by+-- the the applicable entries from the configuration's 'inputMap'. -- -- The terminal device is configured with the attributes: ----- * IXON disabled--- - disables software flow control on outgoing data. This stops the process from being--- suspended if the output terminal cannot keep up. I presume this has little effect these--- days. I hope this means that output will be buffered if the terminal cannot keep up. In the--- old days the output might of been dropped?--- --- "raw" mode is used for input.+-- * IXON disabled: disables software flow control on outgoing data.+-- This stops the process from being suspended if the output terminal+-- cannot keep up. ----- * ISIG disabled--- - enables keyboard combinations that result in signals. TODO: should probably be a dynamic--- option.+-- * Raw mode is used for input. ----- * ECHO disabled--- - input is not echod to the output. TODO: should be a dynamic option.+-- * ISIG disabled (enables keyboard combinations that result in+-- signals) ----- * ICANON disabled--- - canonical mode (line mode) input is not used. TODO: should be a dynamic option.+-- * ECHO disabled (input is not echoed to the output) ----- * IEXTEN disabled--- - extended functions are disabled. TODO: I don't know what those are.+-- * ICANON disabled (canonical mode (line mode) input is not used) --+-- * IEXTEN disabled (extended functions are disabled) inputForConfig :: Config -> IO Input inputForConfig config@Config{ termName = Just termName , inputFd = Just termFd
src/Graphics/Vty/Input/Classify.hs view
@@ -1,15 +1,12 @@ {-# OPTIONS_HADDOCK hide #-}--- This makes a kind of tri. Has space efficiency issues with large input blocks.--- Likely building a parser and just applying that would be better.--- I did not write this so I might just rewrite it for better understanding. Which is not the best--- of reasons.--- TODO: measure and rewrite if required.--- TODO: The ClassifyMap interface requires this code to always assure later entries override--- earlier.+-- This makes a kind of tri. Has space efficiency issues with large+-- input blocks. Likely building a parser and just applying that would+-- be better. module Graphics.Vty.Input.Classify- ( classify- , KClass(..)- ) where+ ( classify+ , KClass(..)+ )+where import Graphics.Vty.Input.Events import Graphics.Vty.Input.Mouse@@ -34,23 +31,23 @@ eventForInput = M.fromList table cl' [] = Prefix cl' inputBlock = case M.lookup inputBlock eventForInput of- -- if the inputBlock is exactly what is expected for an event then consume the whole- -- block and return the event+ -- if the inputBlock is exactly what is expected for an+ -- event then consume the whole block and return the event Just e -> Valid e [] Nothing -> case S.member inputBlock prefixSet of True -> Prefix- -- look up progressively smaller tails of the input block until an event is found- -- The assumption is that the event that consumes the most input bytes should be- -- produced.+ -- look up progressively smaller tails of the input+ -- block until an event is found The assumption is that+ -- the event that consumes the most input bytes should+ -- be produced. -- The test verifyFullSynInputToEvent2x verifies this.- -- H: There will always be one match. The prefixSet contains, by definition, all- -- prefixes of an event. + -- H: There will always be one match. The prefixSet+ -- contains, by definition, all prefixes of an event. False -> let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of (s,e) : _ -> Valid e (drop (length s) inputBlock) -- neither a prefix or a full event.- -- TODO: debug log [] -> Invalid classify :: ClassifyMap -> [Char] -> KClass@@ -76,7 +73,8 @@ in case decode codepoint8 of _ | n < length codepoint -> Prefix Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest- Nothing -> Invalid -- something bad happened; just ignore and continue.+ -- something bad happened; just ignore and continue.+ Nothing -> Invalid utf8Length :: (Num t, Ord a, Num a) => a -> t utf8Length c
src/Graphics/Vty/Input/Classify/Parse.hs view
@@ -1,13 +1,14 @@ -- | This module provides a simple parser for parsing input event -- control sequences. module Graphics.Vty.Input.Classify.Parse- ( Parser- , runParser- , failParse- , readInt- , readChar- , expectChar- ) where+ ( Parser+ , runParser+ , failParse+ , readInt+ , readChar+ , expectChar+ )+where import Graphics.Vty.Input.Events import Graphics.Vty.Input.Classify.Types
src/Graphics/Vty/Input/Classify/Types.hs view
@@ -1,8 +1,9 @@ -- | This module exports the input classification type to avoid import -- cycles between other modules that need this. module Graphics.Vty.Input.Classify.Types- ( KClass(..)- ) where+ ( KClass(..)+ )+where import Graphics.Vty.Input.Events
src/Graphics/Vty/Input/Events.hs view
@@ -6,12 +6,14 @@ -- | Representations of non-modifier keys. ----- * KFun is indexed from 0 to 63. Range of supported FKeys varies by terminal and keyboard.+-- * KFun is indexed from 0 to 63. Range of supported FKeys varies by+-- terminal and keyboard. ----- * KUpLeft, KUpRight, KDownLeft, KDownRight, KCenter support varies by terminal and keyboard.+-- * KUpLeft, KUpRight, KDownLeft, KDownRight, KCenter support varies by+-- terminal and keyboard. ----- * Actually, support for most of these but KEsc, KChar, KBS, and KEnter vary by terminal and--- keyboard.+-- * Actually, support for most of these but KEsc, KChar, KBS, and+-- KEnter vary by terminal and keyboard. data Key = KEsc | KChar Char | KBS | KEnter | KLeft | KRight | KUp | KDown | KUpLeft | KUpRight | KDownLeft | KDownRight | KCenter@@ -19,9 +21,9 @@ | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu deriving (Eq,Show,Read,Ord,Generic) --- | Modifier keys. Key codes are interpreted such that users are more likely to--- have Meta than Alt; for instance on the PC Linux console, 'MMeta' will--- generally correspond to the physical Alt key.+-- | Modifier keys. Key codes are interpreted such that users are more+-- likely to have Meta than Alt; for instance on the PC Linux console,+-- 'MMeta' will generally correspond to the physical Alt key. data Modifier = MShift | MCtrl | MMeta | MAlt deriving (Eq,Show,Read,Ord,Generic)
src/Graphics/Vty/Input/Loop.hs view
@@ -3,12 +3,15 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-}--- | The input layer used to be a single function that correctly accounted for the non-threaded--- runtime by emulating the terminal VMIN adn VTIME handling. This has been removed and replace with--- a more straightforward parser. The non-threaded runtime is no longer supported.+-- | The input layer used to be a single function that correctly+-- accounted for the non-threaded runtime by emulating the terminal+-- VMIN adn VTIME handling. This has been removed and replace with a+-- more straightforward parser. The non-threaded runtime is no longer+-- supported. ----- This is an example of an algorithm where code coverage could be high, even 100%, but the--- behavior is still under tested. I should collect more of these examples...+-- This is an example of an algorithm where code coverage could be high,+-- even 100%, but the behavior is still under tested. I should collect+-- more of these examples... -- -- reference: http://www.unixwiz.net/techtips/termios-vmin-vtime.html module Graphics.Vty.Input.Loop where@@ -21,7 +24,6 @@ import Control.Concurrent import Control.Concurrent.STM import Control.Exception (mask, try, SomeException)-import Data.Monoid import Lens.Micro import Lens.Micro.Mtl import Lens.Micro.TH@@ -46,11 +48,12 @@ import Text.Printf (hPrintf) data Input = Input- { -- | Channel of events direct from input processing. Unlike 'nextEvent' this will not refresh- -- the display if the next event is an 'EvResize'.+ { -- | Channel of events direct from input processing. Unlike+ -- 'nextEvent' this will not refresh the display if the next event+ -- is an 'EvResize'. _eventChannel :: TChan Event- -- | Shuts down the input processing. This should return the terminal input state to before- -- the input initialized.+ -- | Shuts down the input processing. This should return the+ -- terminal input state to before he input initialized. , shutdownInput :: IO () -- | Changes to this value are reflected after the next event. , _configRef :: IORef Config@@ -86,7 +89,8 @@ Just h -> liftIO $ hPutStrLn h msg >> hFlush h -- this must be run on an OS thread dedicated to this input handling.--- otherwise the terminal timing read behavior will block the execution of the lightweight threads.+-- otherwise the terminal timing read behavior will block the execution+-- of the lightweight threads. loopInputProcessor :: InputM () loopInputProcessor = do readFromDevice >>= addBytesToProcess@@ -103,11 +107,11 @@ logMsg $ "parsed event: " ++ show event view eventChannel >>= liftIO . atomically . flip writeTChan event --- The timing requirements are assured by the VMIN and VTIME set for the device.+-- The timing requirements are assured by the VMIN and VTIME set for the+-- device. ----- Precondition: Under the threaded runtime. Only current use is from a forkOS thread. That case--- satisfies precondition.--- TODO: When under the non-threaded runtime emulate VMIN and VTIME+-- Precondition: Under the threaded runtime. Only current use is from a+-- forkOS thread. That case satisfies precondition. readFromDevice :: InputM String readFromDevice = do newConfig <- view configRef >>= liftIO . readIORef@@ -120,10 +124,11 @@ bufferPtr <- use $ inputBuffer.ptr maxBytes <- use $ inputBuffer.size stringRep <- liftIO $ do- -- The killThread used in shutdownInput will not interrupt the foreign call fdReadBuf uses- -- this provides a location to be interrupted prior to the foreign call. If there is input- -- on the FD then the fdReadBuf will return in a finite amount of time due to the vtime- -- terminal setting.+ -- The killThread used in shutdownInput will not interrupt the+ -- foreign call fdReadBuf uses this provides a location to be+ -- interrupted prior to the foreign call. If there is input on+ -- the FD then the fdReadBuf will return in a finite amount of+ -- time due to the vtime terminal setting. threadWaitRead fd bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes) if bytesRead > 0@@ -147,7 +152,7 @@ logMsg $ "remaining: " ++ show remaining unprocessedBytes .= remaining return e- _ -> mzero + _ -> mzero dropInvalid :: InputM () dropInvalid = do
src/Graphics/Vty/Input/Mouse.hs view
@@ -3,11 +3,12 @@ -- -- http://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking module Graphics.Vty.Input.Mouse- ( requestMouseEvents- , disableMouseEvents- , isMouseEvent- , classifyMouseEvent- ) where+ ( requestMouseEvents+ , disableMouseEvents+ , isMouseEvent+ , classifyMouseEvent+ )+where import Graphics.Vty.Input.Events import Graphics.Vty.Input.Classify.Types
src/Graphics/Vty/Input/Paste.hs view
@@ -2,10 +2,11 @@ -- -- http://cirw.in/blog/bracketed-paste module Graphics.Vty.Input.Paste- ( parseBracketedPaste- , bracketedPasteStarted- , bracketedPasteFinished- ) where+ ( parseBracketedPaste+ , bracketedPasteStarted+ , bracketedPasteFinished+ )+where import qualified Data.ByteString.Char8 as BS8
src/Graphics/Vty/Input/Terminfo.hs view
@@ -7,8 +7,8 @@ import Control.Arrow import System.Console.Terminfo --- | queries the terminal for all capability based input sequences then adds on a terminal dependent--- input sequence mapping.+-- | Queries the terminal for all capability-based input sequences and+-- then adds on a terminal-dependent input sequence mapping. -- -- For reference see: --@@ -20,29 +20,29 @@ -- -- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html ----- This is painful. Terminfo is incomplete. The vim source implies that terminfo is also incorrect.--- Vty assumes that the an internal terminfo table added to the system provided terminfo table is--- correct.+-- Terminfo is incomplete. The vim source implies that terminfo is also+-- incorrect. Vty assumes that the internal terminfo table added to the+-- system-provided terminfo table is correct. ----- 1. build terminfo table for all caps. Missing caps are not added.+-- The procedure used here is: ----- 2. add tables for visible chars, esc, del plus ctrl and meta+-- 1. Build terminfo table for all caps. Missing caps are not added. ----- 3. add internally defined table for given terminal type.+-- 2. Add tables for visible chars, esc, del, ctrl, and meta. ----- Precedence is currently implicit in the 'compile' algorithm. Which is a bit odd.+-- 3. Add internally-defined table for given terminal type. ----- \todo terminfo meta is not supported.--- \todo no 8bit+-- Precedence is currently implicit in the 'compile' algorithm. classifyMapForTerm :: String -> Terminal -> ClassifyMap classifyMapForTerm termName term = concat $ capsClassifyMap term keysFromCapsTable : universalTable : termSpecificTables termName --- | key table applicable to all terminals.+-- | The key table applicable to all terminals. ----- TODO: some probably only applicable to ANSI/VT100 terminals.+-- Note that some of these entries are probably only applicable to+-- ANSI/VT100 terminals. universalTable :: ClassifyMap universalTable = concat [visibleChars, ctrlChars, ctrlMetaChars, specialSupportKeys] @@ -50,27 +50,27 @@ capsClassifyMap terminal table = [(x,y) | (Just x,y) <- map extractCap table] where extractCap = first (getCapability terminal . tiGetStr) --- | tables specific to a given terminal that are not derivable from terminfo.+-- | Tables specific to a given terminal that are not derivable from+-- terminfo. ----- TODO: Adds the ANSI/VT100/VT50 tables regardless of term identifier.+-- Note that this adds the ANSI/VT100/VT50 tables regardless of term+-- identifier. termSpecificTables :: String -> [ClassifyMap] termSpecificTables _termName = ANSIVT.classifyTable -- | Visible characters in the ISO-8859-1 and UTF-8 common set. ----- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this--- classify table is reached.------ TODO: resolve--- 1. start at ' '. The earlier characters are all 'ctrlChar'+-- We limit to < 0xC1. The UTF8 sequence detector will catch all values+-- 0xC2 and above before this classify table is reached. visibleChars :: ClassifyMap visibleChars = [ ([x], EvKey (KChar x) []) | x <- [' ' .. toEnum 0xC1] ] --- | Non visible characters in the ISO-8859-1 and UTF-8 common set translated to ctrl + char.+-- | Non-printable characters in the ISO-8859-1 and UTF-8 common set+-- translated to ctrl + char. ----- \todo resolve CTRL-i is the same as tab+-- This treats CTRL-i the same as tab. ctrlChars :: ClassifyMap ctrlChars = [ ([toEnum x],EvKey (KChar y) [MCtrl])@@ -83,7 +83,7 @@ ctrlMetaChars :: ClassifyMap ctrlMetaChars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrlChars --- | esc, meta esc, delete, meta delete, enter, meta enter+-- | Esc, meta-esc, delete, meta-delete, enter, meta-enter. specialSupportKeys :: ClassifyMap specialSupportKeys = [ -- special support for ESC@@ -96,9 +96,8 @@ , ("\t", EvKey (KChar '\t') []) ] --- | classify table directly generated from terminfo cap strings------ these are:+-- | A classification table directly generated from terminfo cap+-- strings. These are: -- -- * ka1 - keypad up-left --@@ -113,7 +112,7 @@ -- * kcbt - back tab -- -- * kc1 - keypad left-down--- +-- -- * kc3 - keypad right-down -- -- * kdch1 - delete@@ -121,7 +120,7 @@ -- * kcud1 - down -- -- * kend - end--- +-- -- * kent - enter -- -- * kf0 - kf63 - function keys@@ -180,6 +179,6 @@ , ("kcuu1", EvKey KUp []) ] ++ functionKeyCapsTable --- | cap names for function keys+-- | Cap names for function keys. functionKeyCapsTable :: ClassifyMap functionKeyCapsTable = flip map [0..63] $ \n -> ("kf" ++ show n, EvKey (KFun n) [])
src/Graphics/Vty/Input/Terminfo/ANSIVT.hs view
@@ -1,15 +1,15 @@--- | Input mappings for ANSI/VT100/VT50 terminals that is missing from terminfo.--- --- Or that are sent regardless of terminfo by terminal emulators. EG: Terminal emulators will often--- use VT50 input bytes regardless of declared terminal type. This provides compatibility with--- programs that don't follow terminfo.+-- | Input mappings for ANSI/VT100/VT50 terminals that is missing from+-- terminfo.+--+-- Or that are sent regardless of terminfo by terminal emulators. EG:+-- Terminal emulators will often use VT50 input bytes regardless of+-- declared terminal type. This provides compatibility with programs+-- that don't follow terminfo. module Graphics.Vty.Input.Terminfo.ANSIVT where import Graphics.Vty.Input.Events -- | Encoding for navigation keys.------ TODO: This is not the same as the input bytes pulled from teh caps table. navKeys0 :: ClassifyMap navKeys0 = [ k "G" KCenter@@ -30,8 +30,10 @@ [("\ESC[" ++ charCnt ++ show mc++c,EvKey s m) | charCnt <- ["1;", ""], -- we can have a count or not (m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),- ([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes- (c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft), ("H", KHome), ("F", KEnd)] -- directions and their codes+ -- modifiers and their codes+ ([MShift, MCtrl],6), ([MShift, MMeta],4)],+ -- directions and their codes+ (c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft), ("H", KHome), ("F", KEnd)] ] -- | encoding for ins, del, pageup, pagedown, home, end@@ -49,9 +51,9 @@ [KIns,KDel,KPageUp,KPageDown,KHome,KEnd] -- | encoding for shift plus function keys--- --- According to --+-- According to+-- -- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html -- -- This encoding depends on the terminal.@@ -62,13 +64,13 @@ -- | encoding for meta plus char ----- TODO: resolve ------- 1. removed 'ESC' from second list due to duplication with "special_support_keys".--- 2. removed '[' from second list due to conflict with 7-bit encoding for ESC. Whether meta+[ is--- the same as ESC should examine km and current encoding.--- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped to KBS by--- special_support_keys.+-- 1. removed 'ESC' from second list due to duplication with+-- "special_support_keys".+-- 2. removed '[' from second list due to conflict with 7-bit encoding+-- for ESC. Whether meta+[ is the same as ESC should examine km and+-- current encoding.+-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped+-- to KBS by special_support_keys. functionKeys2 :: ClassifyMap functionKeys2 = [ ('\ESC':[x],EvKey (KChar x) [MMeta]) | x <- '\t':[' ' .. '~']@@ -84,4 +86,3 @@ , functionKeys1 , functionKeys2 ]-
src/Graphics/Vty/Output.hs view
@@ -1,36 +1,37 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-}--- | Output interface.------ Access to the current terminal or a specific terminal device.+-- | This module provides functions for accessing the current terminal+-- or a specific terminal device. ----- See also:+-- See also: ----- 1. "Graphics.Vty.Output": This instantiates an abtract interface to the terminal interface based--- on the TERM and COLORTERM environment variables.+-- 1. "Graphics.Vty.Output": This instantiates an abtract interface+-- to the terminal based on the @TERM@ and @COLORTERM@ environment+-- variables. ----- 2. "Graphics.Vty.Output.Interface": Defines the generic interface all terminals need to implement.+-- 2. "Graphics.Vty.Output.Interface": Defines the generic interface all+-- terminal modules need to implement. ----- 3. "Graphics.Vty.Output.TerminfoBased": Defines a terminal instance that uses terminfo for all--- control strings. No attempt is made to change the character set to UTF-8 for these terminals.--- I don't know a way to reliably determine if that is required or how to do so.+-- 3. "Graphics.Vty.Output.TerminfoBased": Defines a terminal instance+-- that uses terminfo for all control strings. No attempt is made to+-- change the character set to UTF-8 for these terminals. ----- 4. "Graphics.Vty.Output.XTermColor": This module contains an interface suitable for xterm-like--- terminals. These are the terminals where TERM == xterm. This does use terminfo for as many--- control codes as possible.-module Graphics.Vty.Output ( module Graphics.Vty.Output- , Output(..) -- \todo hide constructors- , AssumedState(..)- , DisplayContext(..) -- \todo hide constructors- , outputPicture- , displayContext- )- where+-- 4. "Graphics.Vty.Output.XTermColor": This module contains an+-- interface suitable for xterm-like terminals. These are the terminals+-- where @TERM@ begins with @xterm@. This does use terminfo for as many+-- control codes as possible.+module Graphics.Vty.Output+ ( outputForConfig+ , setCursorPos+ , hideCursor+ , showCursor+ )+where -import Graphics.Vty.Prelude+import Control.Monad (when) import Graphics.Vty.Config-+import Graphics.Vty.Image (regionWidth, regionHeight) import Graphics.Vty.Output.Interface import Graphics.Vty.Output.XTermColor as XTermColor import Graphics.Vty.Output.TerminfoBased as TerminfoBased@@ -42,23 +43,20 @@ import Data.List (isPrefixOf) import Data.Monoid ((<>)) --- | Returns a `Output` for the terminal specified in `Config`+-- | Returns an `Output` for the terminal specified in `Config`. ----- The specific Output implementation used is hidden from the API user. All terminal implementations--- are assumed to perform more, or less, the same. Currently, all implementations use terminfo for at--- least some terminal specific information.+-- The specific Output implementation used is hidden from the API user.+-- All terminal implementations are assumed to perform more, or less,+-- the same. Currently, all implementations use terminfo for at least+-- some terminal specific information. ----- Specifics about it being based on terminfo are hidden from the API user. If a terminal--- implementation is developed for a terminal without terminfo support then Vty should work as--- expected on that terminal.+-- If a terminal implementation is developed for a terminal without+-- terminfo support then Vty should work as expected on that terminal. -- -- Selection of a terminal is done as follows: -- -- * If TERM contains "xterm" or "screen", use XTermColor. -- * otherwise use the TerminfoBased driver.------ \todo add an implementation for windows that does not depend on terminfo. Should be installable--- with only what is provided in the haskell platform. Use ansi-terminal outputForConfig :: Config -> IO Output outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName@@ -79,11 +77,13 @@ -- | Sets the cursor position to the given output column and row. ----- This is not necessarially the same as the character position with the same coordinates.--- Characters can be a variable number of columns in width.+-- This is not necessarially the same as the character position with the+-- same coordinates. Characters can be a variable number of columns in+-- width. ----- Currently, the only way to set the cursor position to a given character coordinate is to specify--- the coordinate in the Picture instance provided to outputPicture or refresh.+-- Currently, the only way to set the cursor position to a given+-- character coordinate is to specify the coordinate in the Picture+-- instance provided to 'outputPicture' or 'refresh'. setCursorPos :: MonadIO m => Output -> Int -> Int -> m () setCursorPos t x y = do bounds <- displayBounds t@@ -91,14 +91,14 @@ dc <- displayContext t bounds liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y --- | Hides the cursor+-- | Hides the cursor. hideCursor :: MonadIO m => Output -> m () hideCursor t = do bounds <- displayBounds t dc <- displayContext t bounds liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc --- | Shows the cursor+-- | Shows the cursor. showCursor :: MonadIO m => Output -> m () showCursor t = do bounds <- displayBounds t
src/Graphics/Vty/Output/Interface.hs view
@@ -1,21 +1,25 @@ -- Copyright Corey O'Connor--- General philosophy is: MonadIO is for equations exposed to clients.-{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleContexts #-}--#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif-+-- | This module provides an abstract interface for performing terminal+-- output. The only user-facing part of this API is 'Output'. module Graphics.Vty.Output.Interface+ ( Output(..)+ , AssumedState(..)+ , DisplayContext(..)+ , Mode(..)+ , displayContext+ , outputPicture+ , initialAssumedState+ , limitAttrForDisplay+ ) where -import Graphics.Vty.Prelude-+import Graphics.Vty.Attributes+import Graphics.Vty.Image (DisplayRegion, regionHeight) import Graphics.Vty.Picture import Graphics.Vty.PictureToSpans import Graphics.Vty.Span@@ -33,59 +37,60 @@ import qualified Data.Text.Lazy as TL import qualified Data.Vector as Vector -#if !(MIN_VERSION_base(4,8,0))-import Data.Monoid (mempty, mappend)-#endif- -- | Modal terminal features that can be enabled and disabled. data Mode = Mouse+ -- ^ Mouse mode (whether the terminal is configured to provide+ -- mouse input events) | BracketedPaste+ -- ^ Paste mode (whether the terminal is configured to provide+ -- events on OS pastes) deriving (Eq, Read, Show) +-- | The Vty terminal output interface. data Output = Output- { -- | Text identifier for the output device. Used for debugging. + { -- | Text identifier for the output device. Used for debugging. terminalID :: String+ -- | Release the terminal just prior to application exit and reset+ -- it to its state prior to application startup. , releaseTerminal :: forall m. MonadIO m => m ()- -- | Clear the display and initialize the terminal to some initial display state. - --- -- The expectation of a program is that the display starts in some initial state. - -- The initial state would consist of fixed values:- --- -- - cursor at top left- -- - UTF-8 character encoding- -- - drawing characteristics are the default- --- -- The abstract operation I think all these behaviors are instances of is reserving exclusive- -- access to a display such that:- --- -- - The previous state cannot be determined- -- - When exclusive access to a display is released the display returns to the previous state.+ -- | Clear the display and initialize the terminal to some initial+ -- display state.+ --+ -- The expectation of a program is that the display starts in some+ -- The initial state. initial state would consist of fixed values:+ --+ -- - cursor at top left+ -- - UTF-8 character encoding+ -- - drawing characteristics are the default , reserveDisplay :: forall m. MonadIO m => m ()- -- | Return the display to the state before `reserveDisplay`- -- If no previous state then set the display state to the initial state.+ -- | Return the display to the state before `reserveDisplay` If no+ -- previous state then set the display state to the initial state. , releaseDisplay :: forall m. MonadIO m => m ()- -- | Returns the current display bounds.+ -- | Returns the current display bounds. , displayBounds :: forall m. MonadIO m => m DisplayRegion- -- | Output the byte string to the terminal device.+ -- | Output the bytestring to the terminal device. , outputByteBuffer :: BS.ByteString -> IO ()- -- | Maximum number of colors supported by the context.+ -- | Specifies the maximum number of colors supported by the+ -- context. , contextColorCount :: Int- -- | if the cursor can be shown / hidden+ -- | Specifies whether the cursor can be shown / hidden. , supportsCursorVisibility :: Bool- -- | Indicates support for terminal modes for this output device+ -- | Indicates support for terminal modes for this output device. , supportsMode :: Mode -> Bool- -- | Enables or disables a mode (does nothing if the mode is unsupported)+ -- | Enables or disables a mode (does nothing if the mode is+ -- unsupported). , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()- -- | Returns whether a mode is enabled+ -- | Returns whether a mode is enabled. , getModeStatus :: forall m. MonadIO m => Mode -> m Bool , assumedStateRef :: IORef AssumedState- -- | Acquire display access to the given region of the display.- -- Currently all regions have the upper left corner of (0,0) and the lower right corner at - -- (max displayWidth providedWidth, max displayHeight providedHeight)+ -- | Acquire display access to the given region of the display.+ -- Currently all regions have the upper left corner of (0,0) and+ -- the lower right corner at (max displayWidth providedWidth, max+ -- displayHeight providedHeight) , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext- -- | Ring the terminal bell if supported.+ -- | Ring the terminal bell if supported. , ringTerminalBell :: forall m. MonadIO m => m ()- -- | Returns whether the terminal has an audio bell feature.+ -- | Returns whether the terminal has an audio bell feature. , supportsBell :: forall m. MonadIO m => m Bool } @@ -102,50 +107,53 @@ data DisplayContext = DisplayContext { contextDevice :: Output- -- | Provide the bounds of the display context. + -- | Provide the bounds of the display context. , contextRegion :: DisplayRegion- -- | sets the output position to the specified row and column. Where the number of bytes- -- required for the control codes can be specified seperate from the actual byte sequence.+ -- | Sets the output position to the specified row and column+ -- where the number of bytes required for the control codes can be+ -- specified seperate from the actual byte sequence. , writeMoveCursor :: Int -> Int -> Write , writeShowCursor :: Write , writeHideCursor :: Write- -- | Assure the specified output attributes will be applied to all the following text until the- -- next output attribute change. Where the number of bytes required for the control codes can- -- be specified seperate from the actual byte sequence. The required number of bytes must be- -- at least the maximum number of bytes required by any attribute changes. The serialization- -- equations must provide the ptr to the next byte to be specified in the output buffer.+ -- Ensure that the specified output attributes will be applied to+ -- all the following text until the next output attribute change+ -- where the number of bytes required for the control codes can be+ -- specified seperately from the actual byte sequence. The required+ -- number of bytes must be at least the maximum number of bytes+ -- required by any attribute changes. The serialization equations+ -- must provide the ptr to the next byte to be specified in the+ -- output buffer. --- -- The currently applied display attributes are provided as well. The Attr data type can- -- specify the style or color should not be changed from the currently applied display- -- attributes. In order to support this the currently applied display attributes are required.- -- In addition it may be possible to optimize the state changes based off the currently applied- -- display attributes.+ -- The currently applied display attributes are provided as well.+ -- The Attr data type can specify the style or color should not be+ -- changed from the currently applied display attributes. In order+ -- to support this the currently applied display attributes are+ -- required. In addition it may be possible to optimize the state+ -- changes based off the currently applied display attributes. , writeSetAttr :: FixedAttr -> Attr -> DisplayAttrDiff -> Write- -- | Reset the display attributes to the default display attributes+ -- | Reset the display attributes to the default display attributes. , writeDefaultAttr :: Write , writeRowEnd :: Write -- | See `Graphics.Vty.Output.XTermColor.inlineHack` , inlineHack :: IO () } --- | All terminals serialize UTF8 text to the terminal device exactly as serialized in memory.+-- | All terminals serialize UTF8 text to the terminal device exactly as+-- serialized in memory. writeUtf8Text :: BS.ByteString -> Write writeUtf8Text = writeByteString -- | Displays the given `Picture`. ----- 0. The image is cropped to the display size. +-- 1. The image is cropped to the display size. ----- 1. Converted into a sequence of attribute changes and text spans.--- --- 2. The cursor is hidden.+-- 2. Converted into a sequence of attribute changes and text spans. ----- 3. Serialized to the display.+-- 3. The cursor is hidden. ----- 4. The cursor is then shown and positioned or kept hidden.--- --- todo: specify possible IO exceptions.--- abstract from IO monad to a MonadIO instance.+-- 4. Serialized to the display.+--+-- 5. The cursor is then shown and positioned or kept hidden. outputPicture :: MonadIO m => DisplayContext -> Picture -> m () outputPicture dc pic = liftIO $ do as <- readIORef (assumedStateRef $ contextDevice dc)@@ -153,12 +161,11 @@ r = contextRegion dc ops = displayOpsForPic pic r initialAttr = FixedAttr defaultStyleMask Nothing Nothing- -- Diff the previous output against the requested output. Differences are currently on a per-row- -- basis.- -- \todo handle resizes that crop the dominate directions better.+ -- Diff the previous output against the requested output.+ -- Differences are currently on a per-row basis. diffs :: [Bool] = case prevOutputOps as of- Nothing -> replicate (fromEnum $ regionHeight $ effectedRegion ops) True- Just previousOps -> if effectedRegion previousOps /= effectedRegion ops+ Nothing -> replicate (fromEnum $ regionHeight $ affectedRegion ops) True+ Just previousOps -> if affectedRegion previousOps /= affectedRegion ops then replicate (displayOpsRows ops) True else zipWith (/=) (Vector.toList previousOps) (Vector.toList ops)@@ -193,7 +200,7 @@ (0, mempty, diffs) ops in out- where + where writeOutputOps' (y, out, True : diffs') spanOps = let spanOut = writeSpanOps dc y initialAttr spanOps out' = out `mappend` spanOut@@ -225,11 +232,12 @@ writeSpanOp _dc (Skip _) _fattr = error "writeSpanOp for Skip" writeSpanOp dc (RowEnd _) fattr = (writeDefaultAttr dc `mappend` writeRowEnd dc, fattr) --- | The cursor position is given in X,Y character offsets. Due to multi-column characters this--- needs to be translated to column, row positions.+-- | The cursor position is given in X,Y character offsets. Due to+-- multi-column characters this needs to be translated to column, row+-- positions. data CursorOutputMap = CursorOutputMap { charToOutputPos :: (Int, Int) -> (Int, Int)- } + } cursorOutputMap :: DisplayOps -> Cursor -> CursorOutputMap cursorOutputMap spanOps _cursor = CursorOutputMap@@ -239,18 +247,18 @@ cursorColumnOffset :: DisplayOps -> Int -> Int -> Int cursorColumnOffset ops cx cy = let cursorRowOps = Vector.unsafeIndex ops (fromEnum cy)- (outOffset, _, _) - = Vector.foldl' ( \(d, currentCx, done) op -> + (outOffset, _, _)+ = Vector.foldl' ( \(d, currentCx, done) op -> if done then (d, currentCx, done) else case spanOpHasWidth op of Nothing -> (d, currentCx, False) Just (cw, ow) -> case compare cx (currentCx + cw) of GT -> ( d + ow , currentCx + cw- , False + , False ) EQ -> ( d + ow , currentCx + cw- , True + , True ) LT -> ( d + columnsToCharOffset (cx - currentCx) op , currentCx + cw@@ -261,10 +269,10 @@ cursorRowOps in outOffset --- | Not all terminals support all display attributes. This filters a display attribute to what the--- given terminal can display.+-- | Not all terminals support all display attributes. This filters a+-- display attribute to what the given terminal can display. limitAttrForDisplay :: Output -> Attr -> Attr-limitAttrForDisplay t attr +limitAttrForDisplay t attr = attr { attrForeColor = clampColor $ attrForeColor attr , attrBackColor = clampColor $ attrBackColor attr }@@ -272,16 +280,16 @@ clampColor Default = Default clampColor KeepCurrent = KeepCurrent clampColor (SetTo c) = clampColor' c- clampColor' (ISOColor v) + clampColor' (ISOColor v) | contextColorCount t < 8 = Default | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8) | otherwise = SetTo $ ISOColor v clampColor' (Color240 v)- -- TODO: Choose closes ISO color?+ -- Should we choose closest ISO color? | contextColorCount t < 8 = Default | contextColorCount t < 16 = Default | contextColorCount t <= 256 = SetTo $ Color240 v- | otherwise - = let p :: Double = fromIntegral v / 240.0 + | otherwise+ = let p :: Double = fromIntegral v / 240.0 v' = floor $ p * (fromIntegral $ contextColorCount t) in SetTo $ Color240 v'
src/Graphics/Vty/Output/Mock.hs view
@@ -1,13 +1,16 @@ -- Copyright Corey O'Connor {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}--- | This provides a mock terminal implementation that is nice for testing. This transforms the--- output operations to visible characters. Which is nice for some tests.-module Graphics.Vty.Output.Mock ( MockData, mockTerminal )- where--import Graphics.Vty.Prelude+-- | This provides a mock terminal implementation that is nice for+-- testing. This transforms the output operations to visible characters+-- which is useful for testing.+module Graphics.Vty.Output.Mock+ ( MockData+ , mockTerminal+ )+where +import Graphics.Vty.Image (DisplayRegion) import Graphics.Vty.Output.Interface import Blaze.ByteString.Builder.Word (writeWord8)@@ -20,18 +23,20 @@ type MockData = IORef (UTF8.UTF8 BS.ByteString) --- | The mock display terminal produces a string representation of the requested picture. There is--- *not* an isomorphism between the string representation and the picture. The string--- representation is a simplification of the picture that is only useful in debugging VTY without--- considering terminal specific issues.+-- | The mock display terminal produces a string representation of+-- the requested picture. There is *not* an isomorphism between the+-- string representation and the picture. The string representation is+-- a simplification of the picture that is only useful in debugging VTY+-- without considering terminal specific issues. ----- The mock implementation is useful in manually determining if the sequence of terminal operations--- matches the expected sequence. So requirement of the produced representation is simplicity in--- parsing the text representation and determining how the picture was mapped to terminal--- operations.+-- The mock implementation is useful in manually determining if the+-- sequence of terminal operations matche the expected sequence. The+-- requirement of the produced representation is simplicity in parsing+-- the text representation and determining how the picture was mapped to+-- terminal operations. ----- The string representation is a sequence of identifiers where each identifier is the name of an--- operation in the algebra.+-- The string representation is a sequence of identifiers where each+-- identifier is the name of an operation in the algebra. mockTerminal :: (Applicative m, MonadIO m) => DisplayRegion -> m (MockData, Output) mockTerminal r = liftIO $ do outRef <- newIORef undefined@@ -56,17 +61,23 @@ , mkDisplayContext = \tActual rActual -> return $ DisplayContext { contextRegion = rActual , contextDevice = tActual- -- A cursor move is always visualized as the single character 'M'+ -- A cursor move is always visualized as the single+ -- character 'M' , writeMoveCursor = \_x _y -> writeWord8 $ toEnum $ fromEnum 'M'- -- Show cursor is always visualized as the single character 'S'+ -- Show cursor is always visualized as the single+ -- character 'S' , writeShowCursor = writeWord8 $ toEnum $ fromEnum 'S'- -- Hide cursor is always visualized as the single character 'H'+ -- Hide cursor is always visualized as the single+ -- character 'H' , writeHideCursor = writeWord8 $ toEnum $ fromEnum 'H'- -- An attr change is always visualized as the single character 'A'+ -- An attr change is always visualized as the single+ -- character 'A' , writeSetAttr = \_fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'- -- default attr is always visualized as the single character 'D'+ -- default attr is always visualized as the single+ -- character 'D' , writeDefaultAttr = writeWord8 $ toEnum $ fromEnum 'D'- -- row end is always visualized as the single character 'E'+ -- row end is always visualized as the single character+ -- 'E' , writeRowEnd = writeWord8 $ toEnum $ fromEnum 'E' , inlineHack = return () }
src/Graphics/Vty/Output/TerminfoBased.hs view
@@ -1,30 +1,23 @@ {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-} {-# CFILES gwinsz.c #-} -#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif---- | Terminfo based terminal handling.------ The color handling assumes tektronix like. No HP support provided. If the terminal is not one I--- have easy access to then color support is entirely based of the docs. Probably with some--- assumptions mixed in.+-- | Terminfo-based terminal output driver. -- -- Copyright Corey O'Connor (coreyoconnor@gmail.com)-module Graphics.Vty.Output.TerminfoBased ( reserveTerminal )- where--import Graphics.Vty.Prelude+module Graphics.Vty.Output.TerminfoBased+ ( reserveTerminal+ )+where +import Control.Monad (when) import Data.ByteString.Internal (toForeignPtr) import Data.Terminfo.Parse import Data.Terminfo.Eval import Graphics.Vty.Attributes+import Graphics.Vty.Image (DisplayRegion) import Graphics.Vty.DisplayAttributes import Graphics.Vty.Output.Interface @@ -45,12 +38,7 @@ import System.Posix.IO (fdWriteBuf) import System.Posix.Types (Fd(..)) -#if !(MIN_VERSION_base(4,8,0))-import Data.Foldable (foldMap)-import Data.Monoid-#endif--data TerminfoCaps = TerminfoCaps +data TerminfoCaps = TerminfoCaps { smcup :: Maybe CapExpression , rmcup :: Maybe CapExpression , cup :: CapExpression@@ -77,9 +65,11 @@ , enterDimMode :: Maybe CapExpression , enterBoldMode :: Maybe CapExpression }- --- kinda like: https://code.google.com/p/vim/source/browse/src/fileio.c#10422--- fdWriteBuf will throw on error. Unless the error is EINTR. On EINTR the write will be retried.++-- kinda like:+-- https://code.google.com/p/vim/source/browse/src/fileio.c#10422+-- fdWriteBuf will throw on error. Unless the error is EINTR. On EINTR+-- the write will be retried. fdWriteAll :: Fd -> Ptr Word8 -> Int -> Int -> IO Int fdWriteAll outFd ptr len count | len < 0 = fail "fdWriteAll: len is less than 0"@@ -95,25 +85,25 @@ sendCapToTerminal t cap capParams = do outputByteBuffer t $ writeToByteString $ writeCapExpr cap capParams -{- | Uses terminfo for all control codes. While this should provide the most compatible terminal- - terminfo does not support some features that would increase efficiency and improve compatibility:- -- - * determine the character encoding supported by the terminal. Should this be taken from the LANG- - environment variable? - -- - * Provide independent string capabilities for all display attributes.- - - - todo: Some display attributes like underline and bold have independent string capabilities that- - should be used instead of the generic "sgr" string capability.- -}+-- | Constructs an output driver that uses terminfo for all control+-- codes. While this should provide the most compatible terminal,+-- terminfo does not support some features that would increase+-- efficiency and improve compatibility:+--+-- * determining the character encoding supported by the terminal.+-- Should this be taken from the LANG environment variable?+--+-- * Providing independent string capabilities for all display+-- attributes. reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output reserveTerminal termName outFd = liftIO $ do ti <- Terminfo.setupTerm termName -- assumes set foreground always implies set background exists.- -- if set foreground is not set then all color changing style attributes are filtered.+ -- if set foreground is not set then all color changing style+ -- attributes are filtered. msetaf <- probeCap ti "setaf" msetf <- probeCap ti "setf"- let (noColors, useAlt, setForeCap) + let (noColors, useAlt, setForeCap) = case msetaf of Just setaf -> (False, False, setaf) Nothing -> case msetf of@@ -121,7 +111,7 @@ Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName) msetab <- probeCap ti "setab" msetb <- probeCap ti "setb"- let set_back_cap + let set_back_cap = case msetab of Nothing -> case msetb of Just setb -> setb@@ -151,8 +141,9 @@ , supportsBell = return $ isJust $ ringBellAudio terminfoCaps , ringTerminalBell = liftIO $ maybeSendCap ringBellAudio [] , reserveDisplay = liftIO $ do- -- If there is no support for smcup: Clear the screen and then move the mouse to the- -- home position to approximate the behavior.+ -- If there is no support for smcup: Clear the screen+ -- and then move the mouse to the home position to+ -- approximate the behavior. maybeSendCap smcup [] sendCap clearScreen [] , releaseDisplay = liftIO $ do@@ -181,8 +172,8 @@ , setMode = const $ const $ return () , getModeStatus = const $ return False , assumedStateRef = newAssumedStateRef- -- I think fix would help assure tActual is the only reference. I was having issues- -- tho.+ -- I think fix would help assure tActual is the only+ -- reference. I was having issues tho. , mkDisplayContext = \tActual -> liftIO . terminfoDisplayContext tActual terminfoCaps } sendCap s = sendCapToTerminal t (s terminfoCaps)@@ -190,13 +181,13 @@ return t requireCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m CapExpression-requireCap ti capName +requireCap ti capName = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\"" Just capStr -> parseCap capStr probeCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m (Maybe CapExpression)-probeCap ti capName +probeCap ti capName = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of Nothing -> return Nothing Just capStr -> Just <$> parseCap capStr@@ -207,11 +198,11 @@ Left e -> fail $ show e Right cap -> return cap -currentDisplayAttrCaps :: ( Applicative m, MonadIO m ) - => Terminfo.Terminal +currentDisplayAttrCaps :: ( Applicative m, MonadIO m )+ => Terminfo.Terminal -> m DisplayAttrCaps-currentDisplayAttrCaps ti - = pure DisplayAttrCaps +currentDisplayAttrCaps ti+ = pure DisplayAttrCaps <*> probeCap ti "sgr" <*> probeCap ti "smso" <*> probeCap ti "rmso"@@ -224,7 +215,7 @@ foreign import ccall "gwinsz.h vty_c_get_window_size" c_getWindowSize :: Fd -> IO CLong getWindowSize :: Fd -> IO (Int,Int)-getWindowSize fd = do +getWindowSize fd = do (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd return (fromIntegral b, fromIntegral a) @@ -248,84 +239,91 @@ -- | Portably setting the display attributes is a giant pain in the ass. ----- If the terminal supports the sgr capability (which sets the on/off state of each style--- directly ; and, for no good reason, resets the colors to the default) this procedure is used: +-- If the terminal supports the sgr capability (which sets the on/off+-- state of each style directly ; and, for no good reason, resets the+-- colors to the default) this procedure is used: -- -- 0. set the style attributes. This resets the fore and back color. -- -- 1, If a foreground color is to be set then set the foreground color -- -- 2. likewise with the background color--- --- If the terminal does not support the sgr cap then:--- if there is a change from an applied color to the default (in either the fore or back color)--- then: ----- 0. reset all display attributes (sgr0)+-- If the terminal does not support the sgr cap then: if there is a+-- change from an applied color to the default (in either the fore or+-- back color) then: ----- 1. enter required style modes+-- 0. reset all display attributes (sgr0) ----- 2. set the fore color if required+-- 1. enter required style modes ----- 3. set the back color if required+-- 2. set the fore color if required ----- Entering the required style modes could require a reset of the display attributes. If this is--- the case then the back and fore colors always need to be set if not default.+-- 3. set the back color if required --+-- Entering the required style modes could require a reset of the+-- display attributes. If this is the case then the back and fore colors+-- always need to be set if not default.+-- -- This equation implements the above logic. ----- \todo This assumes the removal of color changes in the display attributes is done as expected--- with noColors == True. See `limitAttrForDisplay`+-- Note that this assumes the removal of color changes in the+-- display attributes is done as expected with noColors == True. See+-- `limitAttrForDisplay`. ----- \todo This assumes that fewer state changes, followed by fewer bytes, is what to optimize. I--- haven't measured this or even examined terminal implementations. *shrug*+-- Note that this optimizes for fewer state changes followed by fewer+-- bytes. terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> FixedAttr -> Attr -> DisplayAttrDiff -> Write terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of- -- The only way to reset either color, portably, to the default is to use either the set- -- state capability or the set default capability.+ -- The only way to reset either color, portably, to the default+ -- is to use either the set state capability or the set default+ -- capability. True -> do case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps) (fixedStyle attr ) (styleToApplySeq $ fixedStyle attr) of -- only way to reset a color to the defaults EnterExitSeq caps -> writeDefaultAttr dc- `mappend` + `mappend` foldMap (\cap -> writeCapExpr cap []) caps `mappend` setColors -- implicitly resets the colors to the defaults- SetState state -> writeCapExpr (fromJust $ setAttrStates - $ displayAttrCaps + SetState state -> writeCapExpr (fromJust $ setAttrStates+ $ displayAttrCaps $ terminfoCaps ) (sgrArgsForState state) `mappend` setColors- -- Otherwise the display colors are not changing or changing between two non-default- -- points.+ -- Otherwise the display colors are not changing or changing+ -- between two non-default points. False -> do- -- Still, it could be the case that the change in display attributes requires the- -- colors to be reset because the required capability was not available.+ -- Still, it could be the case that the change in display+ -- attributes requires the colors to be reset because the+ -- required capability was not available. case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps) (fixedStyle attr) (styleDiffs diffs) of- -- Really, if terminals were re-implemented with modern concepts instead of bowing- -- down to 40 yr old dumb terminal requirements this would be the only case ever- -- reached! Changes the style and color states according to the differences with- -- the currently applied states.+ -- Really, if terminals were re-implemented with modern+ -- concepts instead of bowing down to 40 yr old dumb+ -- terminal requirements this would be the only case+ -- ever reached! Changes the style and color states+ -- according to the differences with the currently+ -- applied states. EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps `mappend` writeColorDiff setForeColor (foreColorDiff diffs) `mappend` writeColorDiff setBackColor (backColorDiff diffs) -- implicitly resets the colors to the defaults- SetState state -> writeCapExpr (fromJust $ setAttrStates + SetState state -> writeCapExpr (fromJust $ setAttrStates $ displayAttrCaps terminfoCaps ) (sgrArgsForState state) `mappend` setColors- where + where colorMap = case useAltColorMap terminfoCaps of False -> ansiColorIndex True -> altColorIndex@@ -347,17 +345,17 @@ writeColorDiff f (SetColor c) = writeCapExpr (f terminfoCaps) [toEnum $ colorMap c] --- | The color table used by a terminal is a 16 color set followed by a 240 color set that might not--- be supported by the terminal.+-- | The color table used by a terminal is a 16 color set followed by a+-- 240 color set that might not be supported by the terminal. ----- This takes a Color which clearly identifies which pallete to use and computes the index--- into the full 256 color pallete.+-- This takes a Color which clearly identifies which pallete to use and+-- computes the index into the full 256 color pallete. ansiColorIndex :: Color -> Int ansiColorIndex (ISOColor v) = fromEnum v ansiColorIndex (Color240 v) = 16 + fromEnum v -- | For terminals without setaf/setab--- +-- -- See table in `man terminfo` -- Will error if not in table. altColorIndex :: Color -> Int@@ -372,20 +370,23 @@ altColorIndex (ISOColor v) = fromEnum v altColorIndex (Color240 v) = 16 + fromEnum v -{- | The sequence of terminfo caps to apply a given style are determined according to these rules.- -- - 1. The assumption is that it's preferable to use the simpler enter/exit mode capabilities than- - the full set display attribute state capability. +{- | The sequence of terminfo caps to apply a given style are determined+ - according to these rules. -- - 2. If a mode is supposed to be removed but there is not an exit capability defined then the- - display attributes are reset to defaults then the display attribute state is set.+ - 1. The assumption is that it's preferable to use the simpler+ - enter/exit mode capabilities than the full set display attribute+ - state capability. -- - 3. If a mode is supposed to be applied but there is not an enter capability defined then then- - display attribute state is set if possible. Otherwise the mode is not applied.+ - 2. If a mode is supposed to be removed but there is not an exit+ - capability defined then the display attributes are reset to defaults+ - then the display attribute state is set. -- - 4. If the display attribute state is being set then just update the arguments to that for any- - apply/remove.+ - 3. If a mode is supposed to be applied but there is not an enter+ - capability defined then then display attribute state is set if+ - possible. Otherwise the mode is not applied. -+ - 4. If the display attribute state is being set then just update the+ - arguments to that for any apply/remove. -} data DisplayAttrSeq = EnterExitSeq [CapExpression]@@ -415,17 +416,19 @@ reqDisplayCapSeqFor :: DisplayAttrCaps -> Style -> [StyleStateChange] -> DisplayAttrSeq reqDisplayCapSeqFor caps s diffs- -- if the state transition implied by any diff cannot be supported with an enter/exit mode cap- -- then either the state needs to be set or the attribute change ignored.+ -- if the state transition implied by any diff cannot be supported+ -- with an enter/exit mode cap then either the state needs to be set+ -- or the attribute change ignored. = case (any noEnterExitCap diffs, isJust $ setAttrStates caps) of -- If all the diffs have an enter-exit cap then just use those ( False, _ ) -> EnterExitSeq $ map enterExitCap diffs- -- If not all the diffs have an enter-exit cap and there is no set state cap then filter out- -- all unsupported diffs and just apply the rest- ( True, False ) -> EnterExitSeq $ map enterExitCap + -- If not all the diffs have an enter-exit cap and there is no+ -- set state cap then filter out all unsupported diffs and just+ -- apply the rest+ ( True, False ) -> EnterExitSeq $ map enterExitCap $ filter (not . noEnterExitCap) diffs- -- if not all the diffs have an enter-exit can and there is a set state cap then just use- -- the set state cap.+ -- if not all the diffs have an enter-exit can and there is a+ -- set state cap then just use the set state cap. ( True, True ) -> SetState $ stateForStyle s where noEnterExitCap ApplyStandout = isNothing $ enterStandout caps@@ -469,9 +472,8 @@ , applyIfRequired ApplyDim dim , applyIfRequired ApplyBlink bold ]- where - applyIfRequired op flag + where+ applyIfRequired op flag = if 0 == (flag .&. s) then [] else [op]-
src/Graphics/Vty/Output/XTermColor.hs view
@@ -1,12 +1,10 @@-{-# LANGUAGE CPP #-}--#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif- -- Copyright 2009-2010 Corey O'Connor-module Graphics.Vty.Output.XTermColor ( reserveTerminal )- where+-- | Xterm output driver. This uses the Terminfo driver with some+-- extensions for Xterm.+module Graphics.Vty.Output.XTermColor+ ( reserveTerminal+ )+where import Graphics.Vty.Output.Interface import Graphics.Vty.Input.Mouse@@ -23,21 +21,16 @@ import System.Posix.Types (Fd) import System.Posix.Env (getEnv) -#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative-import Data.Foldable (foldMap)-#endif- import Data.List (isInfixOf) import Data.Maybe (catMaybes) import Data.Monoid ((<>)) --- | Initialize the display to UTF-8. +-- | Construct an Xterm output driver. Initialize the display to UTF-8. reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output reserveTerminal variant outFd = liftIO $ do let flushedPut = void . fdWrite outFd- -- If the terminal variant is xterm-color use xterm instead since, more often than not,- -- xterm-color is broken.+ -- If the terminal variant is xterm-color use xterm instead since,+ -- more often than not, xterm-color is broken. let variant' = if variant == "xterm-color" then "xterm" else variant utf8a <- utf8Active@@ -100,16 +93,15 @@ -- | These sequences set xterm based terminals to UTF-8 output. ----- \todo I don't know of a terminfo cap that is equivalent to this.+-- There is no known terminfo capability equivalent to this. setUtf8CharSet, setDefaultCharSet :: String setUtf8CharSet = "\ESC%G" setDefaultCharSet = "\ESC%@" --- | I think xterm is broken: Reseting the background color as the first bytes serialized on a--- new line does not effect the background color xterm uses to clear the line. Which is used--- *after* the next newline.+-- | I think xterm is broken: Reseting the background color as the first+-- bytes serialized on a new line does not effect the background color+-- xterm uses to clear the line. Which is used *after* the next newline. xtermInlineHack :: Output -> IO () xtermInlineHack t = do let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K" outputByteBuffer t $ writeToByteString writeReset-
src/Graphics/Vty/Picture.hs view
@@ -1,24 +1,36 @@ {-# LANGUAGE BangPatterns #-}--- | The 'Picture' data structure is representative of the final terminal view.------ A 'Picture' is a background paired with a layer of 'Image's.-module Graphics.Vty.Picture ( module Graphics.Vty.Picture- , module Graphics.Vty.Image- )- where+-- A 'Picture' is a background paired with a set of 'Image' layers. The+-- 'Picture' data structure is representative of the final terminal+-- view.+module Graphics.Vty.Picture+ ( Picture(..)+ , Cursor(..)+ , Background(..)+ , emptyPicture+ , addToTop+ , addToBottom+ , picForImage+ , picForLayers+ , picImage+ )+where import Graphics.Vty.Image+import Graphics.Vty.Attributes import Control.DeepSeq --- | The type of images to be displayed using 'update'. +-- | A Vty picture. ----- Can be constructed directly or using `picForImage`. Which provides an initial instance with--- reasonable defaults for picCursor and picBackground.+-- These can be constructed directly or using `picForImage`. data Picture = Picture { picCursor :: Cursor+ -- ^ The picture's cursor. , picLayers :: [Image]+ -- ^ The picture's image layers (top-most first). , picBackground :: Background+ -- ^ The picture's background to be displayed in locations with no+ -- Image data. } instance Show Picture where@@ -27,66 +39,64 @@ instance NFData Picture where rnf (Picture c l b) = c `deepseq` l `deepseq` b `deepseq` () --- | a picture with no cursor, background or image layers+-- | A picture with no cursor, background or image layers. emptyPicture :: Picture emptyPicture = Picture NoCursor [] ClearBackground --- | The given 'Image' is added as the top layer of the 'Picture'+-- | Add an 'Image' as the top-most layer of a 'Picture'. addToTop :: Picture -> Image -> Picture addToTop p i = p {picLayers = i : picLayers p} --- | The given 'Image' is added as the bottom layer of the 'Picture'+-- | Add an 'Image' as the bottom-most layer of a 'Picture'. addToBottom :: Picture -> Image -> Picture addToBottom p i = p {picLayers = picLayers p ++ [i]} --- | Create a picture for display for the given image. The picture will not have a displayed cursor--- and no background pattern (ClearBackground) will be used.+-- | Create a picture from the given image. The picture will not have a+-- displayed cursor and no background pattern (ClearBackground) will be+-- used. picForImage :: Image -> Picture-picForImage i = Picture +picForImage i = Picture { picCursor = NoCursor , picLayers = [i] , picBackground = ClearBackground } --- | Create a picture for display with the given layers. Ordered top to bottom.+-- | Create a picture with the given layers, top-most first. ----- The picture will not have a displayed cursor and no background apttern (ClearBackgroun) will be--- used.--- --- The first 'Image' is the top layer.+-- The picture will not have a displayed cursor and no background+-- pattern (ClearBackgroun) will be used. picForLayers :: [Image] -> Picture-picForLayers is = Picture +picForLayers is = Picture { picCursor = NoCursor , picLayers = is , picBackground = ClearBackground } --- | A picture can be configured either to not show the cursor or show the cursor at the specified--- character position. ------ There is not a 1 to 1 map from character positions to a row and column on the screen due to--- characters that take more than 1 column.+-- | A picture can be configured to hide the cursor or to show the+-- cursor at the specified character position. ----- todo: The Cursor can be given a (character,row) offset outside of the visible bounds of the--- output region. In this case the cursor will not be shown.+-- There is not a 1:1 map from character positions to a row and column+-- on the screen due to characters that take more than 1 column. data Cursor =- -- | Hide the cursor- NoCursor- -- | Show the cursor at the given logical column accounting for char width and row+ -- | Hide the cursor+ NoCursor+ -- | Show the cursor at the given logical column accounting for+ -- character width in the presence of multi-column characters. | Cursor !Int !Int- -- | Show the cursor at the given absolute terminal column and row+ -- | Show the cursor at the given absolute terminal column and row | AbsoluteCursor !Int !Int instance NFData Cursor where rnf c = c `seq` () --- | A 'Picture' has a background pattern. The background is either ClearBackground. Which shows the--- layer below or is blank if the bottom layer. Or the background pattern is a character and a--- display attribute. If the display attribute used previously should be used for a background fill--- then use `currentAttr` for the background attribute.+-- | A 'Picture' has a background pattern. The background is either: ----- \todo The current attribute is always set to the default attributes at the start of updating the--- screen to a picture.+-- * ClearBackground, which shows the layer below or is blank if the+-- bottom layer+-- * A character and a display attribute+--+-- If the display attribute used previously should be used for a+-- background fill then use `currentAttr` for the background attribute. data Background = Background { backgroundChar :: Char@@ -103,6 +113,10 @@ rnf (Background c a) = c `seq` a `seq` () rnf ClearBackground = () --- | Compatibility with applications that do not use more than a single layer.+-- | Return the top-most 'Image' layer for a picture. This is unsafe for+-- 'Picture's without at least one layer.+--+-- This is provided for compatibility with applications that do not use+-- more than a single layer. picImage :: Picture -> Image picImage = head . picLayers
src/Graphics/Vty/PictureToSpans.hs view
@@ -1,21 +1,14 @@ -- Copyright Corey O'Connor<coreyoconnor@gmail.com> {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -#ifndef MIN_VERSION_base-#defined MIN_VERSION_base(x,y,z) 1-#endif--{- | Transforms an image into rows of operations.- -}+-- | Transforms an image into rows of operations. module Graphics.Vty.PictureToSpans where -import Graphics.Vty.Prelude-+import Graphics.Vty.Attributes (Attr, currentAttr) import Graphics.Vty.Image import Graphics.Vty.Image.Internal import Graphics.Vty.Picture@@ -26,12 +19,7 @@ import Lens.Micro.TH import Control.Monad.Reader import Control.Monad.State.Strict hiding ( state )--#if __GLASGOW_HASKELL__ < 708-import Control.Monad.ST.Strict hiding ( unsafeIOToST )-#else import Control.Monad.ST.Strict-#endif import qualified Data.Vector as Vector hiding ( take, replicate ) import Data.Vector.Mutable ( MVector(..))@@ -39,29 +27,27 @@ import qualified Data.Text.Lazy as TL -#if !(MIN_VERSION_base(4,8,0))-import Data.Monoid (mappend)-#endif- type MRowOps s = MVector s SpanOps type MSpanOps s = MVector s SpanOp -- transform plus clip. More or less. data BlitState = BlitState- -- we always snoc to the operation vectors. Thus the columnOffset = length of row at rowOffset- -- although, one possibility is to merge layers right in snocOp (naming it something else, of- -- course). In which case columnnOffset would be applicable.- -- Right now we need it to exist.+ -- we always snoc to the operation vectors. Thus the columnOffset =+ -- length of row at rowOffset although, one possibility is to merge+ -- layers right in snocOp (naming it something else, of course). In+ -- which case columnnOffset would be applicable. Right now we need+ -- it to exist. { _columnOffset :: Int , _rowOffset :: Int- -- clip coordinate space is in image space. Which means it's >= 0 and < imageWidth.+ -- clip coordinate space is in image space. Which means it's >= 0+ -- and < imageWidth. , _skipColumns :: Int -- >= 0 and < imageHeight , _skipRows :: Int- -- includes consideration of skipColumns. In display space.- -- The number of columns from the next column to be defined to the end of the display for the- -- row.+ -- includes consideration of skipColumns. In display space. The+ -- number of columns from the next column to be defined to the end+ -- of the display for the row. , _remainingColumns :: Int -- includes consideration of skipRows. In display space. , _remainingRows :: Int@@ -78,21 +64,19 @@ type BlitM s a = ReaderT (BlitEnv s) (StateT BlitState (ST s)) a --- | Produces the span ops that will render the given picture, possibly cropped or padded, into the--- specified region.+-- | Produces the span ops that will render the given picture, possibly+-- cropped or padded, into the specified region. displayOpsForPic :: Picture -> DisplayRegion -> DisplayOps displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r) --- | Returns the DisplayOps for an image rendered to a window the size of the image.+-- | Returns the DisplayOps for an image rendered to a window the size+-- of the image. -- -- largerly used only for debugging. displayOpsForImage :: Image -> DisplayOps displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeight i) -- | Produces the span ops for each layer then combines them.------ TODO: a fold over a builder function. start with span ops that are a bg fill of the entire--- region. combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s) combinedOpsForLayers pic r | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0@@ -101,8 +85,8 @@ case layerOps of [] -> fail "empty picture" [ops] -> substituteSkips (picBackground pic) ops- -- instead of merging ops after generation the merging can be performed as part of- -- snocOp.+ -- instead of merging ops after generation the merging can+ -- be performed as part of snocOp. topOps : lowerOps -> do ops <- foldM mergeUnder topOps lowerOps substituteSkips (picBackground pic) ops@@ -111,21 +95,23 @@ substituteSkips ClearBackground ops = do forM_ [0 .. MVector.length ops - 1] $ \row -> do rowOps <- MVector.read ops row- -- the image operations assure that background fills are combined.- -- clipping a background fill does not split the background fill.- -- merging of image layers can split a skip, but only by the insertion of a non skip.- -- all this combines to mean we can check the last operation and remove it if it's a skip- -- todo: or does it?+ -- the image operations assure that background fills are+ -- combined. clipping a background fill does not split the+ -- background fill. merging of image layers can split a skip,+ -- but only by the insertion of a non skip. all this combines to+ -- mean we can check the last operation and remove it if it's a+ -- skip let rowOps' = case Vector.last rowOps of Skip w -> Vector.init rowOps `Vector.snoc` RowEnd w _ -> rowOps- -- now all the skips can be replaced by replications of ' ' of the required width.+ -- now all the skips can be replaced by replications of ' ' of+ -- the required width. let rowOps'' = swapSkipsForSingleColumnCharSpan ' ' currentAttr rowOps' MVector.write ops row rowOps'' return ops substituteSkips (Background {backgroundChar, backgroundAttr}) ops = do- -- At this point we decide if the background character is single column or not.- -- obviously, single column is easier.+ -- At this point we decide if the background character is single+ -- column or not. obviously, single column is easier. case safeWcwidth backgroundChar of w | w == 0 -> fail $ "invalid background character " ++ show backgroundChar | w == 1 -> do@@ -149,12 +135,12 @@ MVector.write upper row rowOps return upper --- fugly mergeRowUnder :: SpanOps -> SpanOps -> SpanOps mergeRowUnder upperRowOps lowerRowOps = onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) lowerRowOps where- -- H: it will never be the case that we are out of upper ops before lower ops.+ -- H: it will never be the case that we are out of upper ops+ -- before lower ops. onUpperOp :: SpanOps -> SpanOp -> SpanOps -> SpanOps -> SpanOps onUpperOp outOps op@(TextSpan _ w _ _) upperOps lowerOps = let lowerOps' = dropOps w lowerOps@@ -189,30 +175,32 @@ in TextSpan a ow cw txt f v = v --- | Builds a vector of row operations that will output the given picture to the terminal.+-- | Builds a vector of row operations that will output the given+-- picture to the terminal. -- -- Crops to the given display region.------ \todo I'm pretty sure there is an algorithm that does not require a mutable buffer. buildSpans :: Image -> DisplayRegion -> ST s (MRowOps s) buildSpans image outRegion = do -- First we create a mutable vector for each rows output operations. outOps <- MVector.replicate (regionHeight outRegion) Vector.empty- -- \todo I think building the span operations in display order would provide better performance.- -- However, I got stuck trying to implement an algorithm that did this. This will be considered- -- as a possible future optimization. + -- It's possible that building the span operations in display order+ -- would provide better performance. --- -- A depth first traversal of the image is performed. ordered according to the column range- -- defined by the image from least to greatest. The output row ops will at least have the- -- region of the image specified. Iterate over all output rows and output background fills for- -- all unspecified columns.+ -- A depth first traversal of the image is performed. ordered+ -- according to the column range defined by the image from least+ -- to greatest. The output row ops will at least have the region+ -- of the image specified. Iterate over all output rows and output+ -- background fills for all unspecified columns. --- -- The images are made into span operations from left to right. It's possible that this could- -- easily be made to assure top to bottom output as well. + -- The images are made into span operations from left to right. It's+ -- possible that this could easily be made to assure top to bottom+ -- output as well. when (regionHeight outRegion > 0 && regionWidth outRegion > 0) $ do- -- The ops builder recursively descends the image and outputs span ops that would- -- display that image. The number of columns remaining in this row before exceeding the- -- bounds is also provided. This is used to clip the span ops produced to the display.+ -- The ops builder recursively descends the image and outputs+ -- span ops that would display that image. The number of columns+ -- remaining in this row before exceeding the bounds is also+ -- provided. This is used to clip the span ops produced to the+ -- display. let fullBuild = do startImageBuild image -- Fill in any unspecified columns with a skip.@@ -223,7 +211,8 @@ return () return outOps --- | Add the operations required to build a given image to the current set of row operations.+-- | Add the operations required to build a given image to the current+-- set of row operations. startImageBuild :: Image -> BlitM s () startImageBuild image = do outOfBounds <- isOutOfBounds image <$> get@@ -237,17 +226,16 @@ | s ^. skipRows >= imageHeight i = True | otherwise = False --- | This adds an image that might be partially clipped to the output ops.------ This is a very touchy algorithm. Too touchy. For instance, the CropRight and CropBottom--- implementations are odd. They pass the current tests but something seems terribly wrong about all--- this.+-- | This adds an image that might be partially clipped to the output+-- ops. ----- \todo prove this cannot be called in an out of bounds case.+-- This is a very touchy algorithm. Too touchy. For instance, the+-- CropRight and CropBottom implementations are odd. They pass the+-- current tests but something seems terribly wrong about all this. addMaybeClipped :: forall s . Image -> BlitM s () addMaybeClipped EmptyImage = return () addMaybeClipped (HorizText a textStr ow _cw) = do- -- TODO: assumption that text spans are only 1 row high.+ -- This assumes that text spans are only 1 row high. s <- use skipRows when (s < 1) $ do leftClip <- use skipColumns@@ -297,7 +285,7 @@ skipRows += topSkip addMaybeClipped croppedImage -addMaybeClippedJoin :: forall s . String +addMaybeClippedJoin :: forall s . String -> Lens BlitState BlitState Int Int -> Lens BlitState BlitState Int Int -> Lens BlitState BlitState Int Int@@ -310,9 +298,8 @@ state <- get when (state^.remaining <= 0) $ fail $ name ++ " with remaining <= 0" case state^.skip of- s -- TODO: check if clipped in other dim. if not use addUnclipped- | s > size -> put $ state & skip -~ size- | s == 0 -> if state^.remaining > i0Dim + s | s > size -> put $ state & skip -~ size+ | s == 0 -> if state^.remaining > i0Dim then do addMaybeClipped i0 put $ state & offset +~ i0Dim & remaining -~ i0Dim
− src/Graphics/Vty/Prelude.hs
@@ -1,18 +0,0 @@--- | Prelude for Vty modules. Not particularly useful outside of Vty.-module Graphics.Vty.Prelude ( module Graphics.Vty.Prelude- , module Control.Applicative- , module Control.Monad- )-where--import Control.Applicative hiding ((<|>))-import Control.Monad---- | Named alias for a Int pair-type DisplayRegion = (Int,Int)--regionWidth :: DisplayRegion -> Int-regionWidth = fst--regionHeight :: DisplayRegion -> Int-regionHeight = snd
src/Graphics/Vty/Span.hs view
@@ -2,22 +2,16 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE GADTs #-}-{- | A picture is translated into a sequences of state changes and character spans.- - State changes are currently limited to new attribute values. The attribute is applied to all- - following spans. Including spans of the next row. The nth element of the sequence represents the- - nth row (from top to bottom) of the picture to render.- -- - A span op sequence will be defined for all rows and columns (and no more) of the region provided- - with the picture to `spansForPic`.- -- - todo: Partition attribute changes into multiple categories according to the serialized- - representation of the various attributes.- -}-module Graphics.Vty.Span- where--import Graphics.Vty.Prelude+-- | A picture is translated into a sequences of state changes and+-- character spans. The attribute is applied to all following spans,+-- including spans of the next row. The nth element of the sequence+-- represents the nth row (from top to bottom) of the picture to render.+--+-- A span op sequence will be defined for all rows and columns (and no+-- more) of the region provided with the picture to 'spansForPic'.+module Graphics.Vty.Span where +import Graphics.Vty.Attributes (Attr) import Graphics.Vty.Image import Graphics.Vty.Image.Internal ( clipText ) @@ -25,33 +19,33 @@ import Data.Vector (Vector) import qualified Data.Vector as Vector --- | This represents an operation on the terminal. Either an attribute change or the output of a--- text string.+-- | This represents an operation on the terminal: either an attribute+-- change or the output of a text string. data SpanOp =- -- | a span of UTF-8 text occupies a specific number of screen space columns. A single UTF- -- character does not necessarially represent 1 colunm. See Codec.Binary.UTF8.Width- -- TextSpan [Attr] [output width in columns] [number of characters] [data]- TextSpan + -- | A span of UTF-8 text occupies a specific number of screen space+ -- columns. A single UTF character does not necessarily represent 1+ -- colunm. See Codec.Binary.UTF8.Width TextSpan [Attr] [output width+ -- in columns] [number of characters] [data]+ TextSpan { textSpanAttr :: !Attr , textSpanOutputWidth :: !Int , textSpanCharWidth :: !Int , textSpanText :: DisplayText }- -- | Skips the given number of columns- -- A skip is transparent.... maybe? I am not sure how attribute changes interact.- -- todo: separate from this type.+ -- | Skips the given number of columns. | Skip !Int- -- | Marks the end of a row. specifies how many columns are remaining. These columns will not be- -- explicitly overwritten with the span ops. The terminal is require to assure the remaining+ -- | Marks the end of a row. Specifies how many columns are+ -- remaining. These columns will not be explicitly overwritten with+ -- the span ops. The terminal is require to assure the remaining -- columns are clear.- -- todo: separate from this type. | RowEnd !Int deriving Eq --- | vector of span operations. executed in succession. This represents the operations required to--- render a row of the terminal. The operations in one row may effect subsequent rows.--- EG: Setting the foreground color in one row will effect all subsequent rows until the foreground--- color is changed.+-- | A vector of span operations executed in succession. This represents+-- the operations required to render a row of the terminal. The+-- operations in one row may affect subsequent rows. For example,+-- setting the foreground color in one row will affect all subsequent+-- rows until the foreground color is changed. type SpanOps = Vector SpanOp dropOps :: Int -> SpanOps -> SpanOps@@ -89,9 +83,9 @@ , Vector.cons (Skip (w - remainingColumns)) (Vector.tail ops) ) RowEnd _ -> error "cannot split ops containing a row end"- --- | vector of span operation vectors for display. One per row of the output region.+-- | A vector of span operation vectors for display, one per row of the+-- output region. type DisplayOps = Vector SpanOps instance Show SpanOp where@@ -99,40 +93,40 @@ show (Skip ow) = "Skip(" ++ show ow ++ ")" show (RowEnd ow) = "RowEnd(" ++ show ow ++ ")" --- | Number of columns the DisplayOps are defined for+-- | The number of columns the DisplayOps are defined for. ----- All spans are verified to define same number of columns. See: VerifySpanOps+-- All spans are verified to define same number of columns. displayOpsColumns :: DisplayOps -> Int-displayOpsColumns ops +displayOpsColumns ops | Vector.length ops == 0 = 0 | otherwise = Vector.length $ Vector.head ops --- | Number of rows the DisplayOps are defined for+-- | The number of rows the DisplayOps are defined for. displayOpsRows :: DisplayOps -> Int displayOpsRows ops = Vector.length ops -effectedRegion :: DisplayOps -> DisplayRegion-effectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)+affectedRegion :: DisplayOps -> DisplayRegion+affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops) --- | The number of columns a SpanOps effects.+-- | The number of columns a SpanOps affects. spanOpsEffectedColumns :: SpanOps -> Int spanOpsEffectedColumns inOps = Vector.foldl' spanOpsEffectedColumns' 0 inOps- where + where spanOpsEffectedColumns' t (TextSpan _ w _ _ ) = t + w spanOpsEffectedColumns' t (Skip w) = t + w spanOpsEffectedColumns' t (RowEnd w) = t + w --- | The width of a single SpanOp in columns+-- | The width of a single SpanOp in columns. spanOpHasWidth :: SpanOp -> Maybe (Int, Int) spanOpHasWidth (TextSpan _ ow cw _) = Just (cw, ow) spanOpHasWidth (Skip ow) = Just (ow,ow) spanOpHasWidth (RowEnd ow) = Just (ow,ow) --- | returns the number of columns to the character at the given position in the span op+-- | The number of columns to the character at the given position in the+-- span op. columnsToCharOffset :: Int -> SpanOp -> Int columnsToCharOffset cx (TextSpan _ _ _ utf8Str) = let str = TL.unpack utf8Str in wcswidth (take cx str) columnsToCharOffset cx (Skip _) = cx columnsToCharOffset cx (RowEnd _) = cx-
test/Verify.hs view
@@ -1,29 +1,29 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-}-module Verify ( module Verify- , module Control.Applicative- , module Control.DeepSeq- , module Control.Exception- , module Control.Monad- , module Test.QuickCheck- , module Test.QuickCheck.Modifiers- , module Text.Printf- , succeeded- , failed- , monadicIO- , liftIO- , liftBool- , Test(..)- , Prop.Result(..)- )- where+module Verify+ ( module Verify+ , module Control.Applicative+ , module Control.DeepSeq+ , module Control.Exception+ , module Control.Monad+ , module Test.QuickCheck+ , module Test.QuickCheck.Modifiers+ , module Text.Printf+ , succeeded+ , failed+ , monadicIO+ , liftIO+ , liftBool+ , Test(..)+ , Prop.Result(..)+ )+where import Control.Exception ( bracket, try, SomeException(..) ) @@ -35,7 +35,7 @@ import Test.QuickCheck.Modifiers import Test.QuickCheck.Property hiding ( Result(..) ) import qualified Test.QuickCheck.Property as Prop-import Test.QuickCheck.Monadic ( monadicIO ) +import Test.QuickCheck.Monadic ( monadicIO ) import Text.Printf @@ -56,7 +56,7 @@ case qcResult of QC.Success {..} -> return $ Finished TS.Pass QC.Failure {numShrinks,reason} -> return $ Finished- $ TS.Fail $ "After " + $ TS.Fail $ "After " ++ show numShrinks ++ " shrinks determined failure to be: " ++ show reason _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message"@@ -85,16 +85,5 @@ liftIOResult :: Testable prop => IO prop -> Property liftIOResult = ioProperty -#if __GLASGOW_HASKELL__ <= 701-instance Random Word where- random g = - let (i :: Int, g') = random g- in (toEnum i, g')- randomR (l,h) g =- let (i :: Int, g') = randomR (fromEnum l,fromEnum h) g- in (toEnum i, g')-#endif- data Bench where Bench :: forall v . NFData v => IO v -> (v -> IO ()) -> Bench-
test/Verify/Data/Terminfo/Parse.hs view
@@ -1,7 +1,8 @@-module Verify.Data.Terminfo.Parse ( module Verify.Data.Terminfo.Parse- , module Data.Terminfo.Parse- )- where+module Verify.Data.Terminfo.Parse+ ( module Verify.Data.Terminfo.Parse+ , module Data.Terminfo.Parse+ )+where import Data.Terminfo.Parse import Data.Terminfo.Eval@@ -19,22 +20,22 @@ deriving Show instance Arbitrary NonParamCapString where- arbitrary + arbitrary = ( do s <- listOf1 $ (choose (0, 255) >>= return . toEnum) `suchThat` (/= '%') return $ NonParamCapString s- ) `suchThat` ( \(NonParamCapString str) -> length str < 255 ) + ) `suchThat` ( \(NonParamCapString str) -> length str < 255 ) data LiteralPercentCap = LiteralPercentCap String [Word8] deriving ( Show ) instance Arbitrary LiteralPercentCap where- arbitrary + arbitrary = ( do NonParamCapString s <- arbitrary (s', bytes) <- insertEscapeOp "%" [toEnum $ fromEnum '%'] s return $ LiteralPercentCap s' bytes- ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 ) + ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 ) data IncFirstTwoCap = IncFirstTwoCap String [Word8] deriving ( Show )@@ -45,7 +46,7 @@ NonParamCapString s <- arbitrary (s', bytes) <- insertEscapeOp "i" [] s return $ IncFirstTwoCap s' bytes- ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 ) + ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 ) data PushParamCap = PushParamCap String Int [Word8] deriving ( Show )@@ -57,7 +58,7 @@ n <- choose (1,9) (s', bytes) <- insertEscapeOp ("p" ++ show n) [] s return $ PushParamCap s' n bytes- ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 ) + ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 ) data DecPrintCap = DecPrintCap String Int [Word8] deriving ( Show )@@ -69,7 +70,7 @@ n <- choose (1,9) (s', bytes) <- insertEscapeOp ("p" ++ show n ++ "%d") [] s return $ DecPrintCap s' n bytes- ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 ) + ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 ) insertEscapeOp opStr replBytes s = do insertPoints <- listOf1 $ elements [0 .. length s - 1]@@ -92,21 +93,20 @@ = Vector.toList $ Vector.take count $ Vector.drop offset $ capBytes cap collectBytes :: CapExpression -> [Word8]-collectBytes e = concat [ bytes +collectBytes e = concat [ bytes | Bytes offset count <- capOps e , let bytes = bytesForRange e offset count ]- + verifyBytesEqual :: [Word8] -> [Word8] -> Result-verifyBytesEqual outBytes expectedBytes +verifyBytesEqual outBytes expectedBytes = if outBytes == expectedBytes then succeeded- else failed - { reason = "outBytes [" + else failed+ { reason = "outBytes [" ++ hexDump outBytes ++ "] /= expectedBytes [" ++ hexDump expectedBytes ++ "]" }-
test/Verify/Graphics/Vty/Attributes.hs view
@@ -1,7 +1,8 @@-module Verify.Graphics.Vty.Attributes ( module Verify.Graphics.Vty.Attributes- , module Graphics.Vty.Attributes- )- where+module Verify.Graphics.Vty.Attributes+ ( module Verify.Graphics.Vty.Attributes+ , module Graphics.Vty.Attributes+ )+where import Graphics.Vty.Attributes import Verify@@ -40,8 +41,8 @@ -- Limit the possible attributes to just a few for now. possibleAttrMods :: [ AttrOp ]-possibleAttrMods = - [ idOp +possibleAttrMods =+ [ idOp ] ++ map setForeColorOp allColors ++ map setBackColorOp allColors ++ map setStyleOp allStyles@@ -70,4 +71,3 @@ applyOp :: AttrOp -> Attr -> Attr applyOp (AttrOp _ f) a = f a-
test/Verify/Graphics/Vty/DisplayAttributes.hs view
@@ -1,8 +1,8 @@-module Verify.Graphics.Vty.DisplayAttributes ( module Verify.Graphics.Vty.DisplayAttributes- , module Graphics.Vty.DisplayAttributes- )- where+module Verify.Graphics.Vty.DisplayAttributes+ ( module Verify.Graphics.Vty.DisplayAttributes+ , module Graphics.Vty.DisplayAttributes+ )+where import Graphics.Vty.DisplayAttributes import Verify-
test/Verify/Graphics/Vty/Image.hs view
@@ -1,10 +1,11 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DisambiguateRecordFields #-}-module Verify.Graphics.Vty.Image ( module Verify.Graphics.Vty.Image- , module Graphics.Vty.Image- )- where+module Verify.Graphics.Vty.Image+ ( module Verify.Graphics.Vty.Image+ , module Graphics.Vty.Image+ )+where import Verify.Graphics.Vty.Attributes import Graphics.Vty.Image@@ -26,7 +27,7 @@ data DefaultImage = DefaultImage Image instance Show DefaultImage where- show (DefaultImage i) + show (DefaultImage i) = "DefaultImage (" ++ show i ++ ") " ++ show (imageWidth i, imageHeight i) instance Arbitrary DefaultImage where@@ -34,15 +35,15 @@ i <- return $ char defAttr 'X' return $ DefaultImage i -data SingleRowSingleAttrImage - = SingleRowSingleAttrImage +data SingleRowSingleAttrImage+ = SingleRowSingleAttrImage { expectedAttr :: Attr , expectedColumns :: Int , rowImage :: Image } instance Show SingleRowSingleAttrImage where- show (SingleRowSingleAttrImage attr columns image) + show (SingleRowSingleAttrImage attr columns image) = "SingleRowSingleAttrImage (" ++ show attr ++ ") " ++ show columns ++ " ( " ++ show image ++ " )" newtype WidthResize = WidthResize (Image -> (Image, Int))@@ -84,14 +85,14 @@ , do ImageResize f <- arbitrary WidthResize g <- arbitrary- return $! ImageResize $! \i -> + return $! ImageResize $! \i -> let (i0, (_, outHeight)) = f i gI = g i0 in (fst gI, (snd gI, outHeight)) , do ImageResize f <- arbitrary HeightResize g <- arbitrary- return $! ImageResize $! \i -> + return $! ImageResize $! \i -> let (i0, (outWidth, _)) = f i gI = g i0 in (fst gI, (outWidth, snd gI))@@ -100,17 +101,17 @@ instance Arbitrary SingleRowSingleAttrImage where arbitrary = do- -- The text must contain at least one character. Otherwise the image simplifies to the- -- IdImage which has a height of 0. If this is to represent a single row then the height- -- must be 1+ -- The text must contain at least one character. Otherwise the+ -- image simplifies to the IdImage which has a height of 0. If+ -- this is to represent a single row then the height must be 1 singleColumnRowText <- Verify.resize 16 (listOf1 arbitrary) a <- arbitrary let outImage = horizCat $ [char a c | SingleColumnChar c <- singleColumnRowText] outWidth = length singleColumnRowText return $ SingleRowSingleAttrImage a outWidth outImage -data SingleRowTwoAttrImage - = SingleRowTwoAttrImage +data SingleRowTwoAttrImage+ = SingleRowTwoAttrImage { part0 :: SingleRowSingleAttrImage , part1 :: SingleRowSingleAttrImage , joinImage :: Image@@ -122,8 +123,8 @@ p1 <- arbitrary return $ SingleRowTwoAttrImage p0 p1 (rowImage p0 <|> rowImage p1) -data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack - { stackImage :: Image +data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack+ { stackImage :: Image , stackSourceImages :: [SingleRowSingleAttrImage] , stackWidth :: Int , stackHeight :: Int@@ -215,4 +216,3 @@ y <- arbitrary `suchThat` (> 0) let i' = translate x y i return $ Translation i (x,y) i'-
test/Verify/Graphics/Vty/Output.hs view
@@ -4,18 +4,17 @@ import Graphics.Vty.Output.Mock -import qualified Data.ByteString as BS import Data.IORef import qualified Data.String.UTF8 as UTF8 import Test.QuickCheck.Property --- A list of terminals that should be supported.--- This started with a list of terminals ubuntu supported. Then those terminals that really could--- not be supported were removed. Then a few more were pruned until a reasonable looking set was--- made.+-- A list of terminals that should be supported. This started with a+-- list of terminals ubuntu supported. Then those terminals that really+-- could not be supported were removed. Then a few more were pruned+-- until a reasonable looking set was made. terminalsOfInterest :: [String]-terminalsOfInterest = +terminalsOfInterest = [ "vt100" , "vt220" , "vt102"@@ -58,4 +57,3 @@ ++ expectedStr } else return succeeded-
test/Verify/Graphics/Vty/Picture.hs view
@@ -1,8 +1,9 @@ {-# LANGUAGE DisambiguateRecordFields #-}-module Verify.Graphics.Vty.Picture ( module Verify.Graphics.Vty.Picture- , module Graphics.Vty.Picture- )- where+module Verify.Graphics.Vty.Picture+ ( module Verify.Graphics.Vty.Picture+ , module Graphics.Vty.Picture+ )+where import Verify.Graphics.Vty.Prelude @@ -14,9 +15,9 @@ import Verify -data DefaultPic = DefaultPic +data DefaultPic = DefaultPic { defaultPic :: Picture- , defaultWin :: MockWindow + , defaultWin :: MockWindow } instance Show DefaultPic where@@ -27,10 +28,10 @@ arbitrary = do DefaultImage image <- arbitrary let win = MockWindow (imageWidth image) (imageHeight image)- return $ DefaultPic (picForImage image) - win + return $ DefaultPic (picForImage image)+ win -data PicWithBGAttr = PicWithBGAttr +data PicWithBGAttr = PicWithBGAttr { withAttrPic :: Picture , withAttrWin :: MockWindow , withAttrSpecifiedAttr :: Attr@@ -41,12 +42,11 @@ DefaultImage image <- arbitrary let win = MockWindow (imageWidth image) (imageHeight image) attr <- arbitrary- return $ PicWithBGAttr (picForImage image) - win + return $ PicWithBGAttr (picForImage image)+ win attr- + instance Arbitrary Picture where arbitrary = do layers <- Verify.resize 20 (listOf1 arbitrary) return $ picForLayers layers-
test/Verify/Graphics/Vty/Prelude.hs view
@@ -1,10 +1,8 @@-module Verify.Graphics.Vty.Prelude ( module Verify.Graphics.Vty.Prelude- , module Graphics.Vty.Prelude- , MockWindow(..)- )- where--import Graphics.Vty.Prelude+module Verify.Graphics.Vty.Prelude+ ( module Verify.Graphics.Vty.Prelude+ , MockWindow(..)+ )+where import Graphics.Vty.Debug
test/Verify/Graphics/Vty/Span.hs view
@@ -1,8 +1,9 @@ {-# LANGUAGE FlexibleInstances #-}-module Verify.Graphics.Vty.Span ( module Verify.Graphics.Vty.Span- , module Graphics.Vty.Span- )- where+module Verify.Graphics.Vty.Span+ ( module Verify.Graphics.Vty.Span+ , module Graphics.Vty.Span+ )+where import Graphics.Vty.Debug import Graphics.Vty.Span@@ -22,7 +23,7 @@ = let v = map (\s -> (spanOpsEffectedColumns s /= w, s)) (Vector.toList spans) in case any ((== True) . fst) v of False -> succeeded- True -> failed { reason = "Not all spans contained operations defining exactly " + True -> failed { reason = "Not all spans contained operations defining exactly " ++ show w ++ " columns of output - \n" ++ (concatMap ((++ "\n") . show)) v@@ -34,4 +35,3 @@ else failed { reason = "ops for alternate image " ++ show i_alt_ops ++ " are not the same as " ++ show i_ops }-
test/VerifyConfig.hs view
@@ -4,7 +4,6 @@ import Graphics.Vty.Config import Graphics.Vty.Input.Events -import Data.Default import Data.String.QQ import qualified Data.ByteString.Char8 as B @@ -24,7 +23,7 @@ |] exampleConfigConfig :: Config-exampleConfigConfig = def+exampleConfigConfig = defaultConfig { debugLog = Just "/tmp/vty-debug.txt" , inputMap = [ (Nothing, "\ESC[B", EvKey KUp []) , (Nothing, "\ESC[1;3B", EvKey KDown [MAlt])@@ -43,4 +42,3 @@ main = defaultMain [ testCase "example config parses" $ exampleConfigParses ]-
test/VerifyCropSpanGeneration.hs view
@@ -13,7 +13,7 @@ import Verify -import qualified Data.Vector as Vector +import qualified Data.Vector as Vector cropOpDisplayOps :: (Int -> Image -> Image) -> Int -> Image -> (DisplayOps, Image)@@ -75,7 +75,7 @@ in displayOpsForImage i == displayOpsForImage iAlt tests :: IO [Test]-tests = return +tests = return [ verify "cropping from the bottom produces display operations covering the expected rows" cropBottomOutputRows , verify "cropping from the top produces display operations covering the expected rows"@@ -90,4 +90,3 @@ , verify "the output of a stack is the same as that stack cropped top & bottom and joined together" cropTopAndBottomRejoinedEquivalence ]-
test/VerifyEmptyImageProps.hs view
@@ -3,7 +3,7 @@ import Verify -- should be exported by Graphics.Vty.Picture-import Graphics.Vty.Picture ( Image, emptyImage )+import Graphics.Vty.Image ( Image, emptyImage ) tests :: IO [Test] tests = do
test/VerifyEvalTerminfoCaps.hs view
@@ -3,7 +3,7 @@ module VerifyEvalTerminfoCaps where import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)-import Data.Terminfo.Eval +import Data.Terminfo.Eval import Data.Terminfo.Parse import Control.DeepSeq @@ -24,8 +24,9 @@ import Foreign.Ptr (Ptr, minusPtr) import Numeric --- If a terminal defines one of the caps then it's expected to be parsable.-capsOfInterest = +-- If a terminal defines one of the caps then it's expected to be+-- parsable.+capsOfInterest = [ "cup" , "sc" , "rc"@@ -49,12 +50,13 @@ tests :: IO [Test] tests = do- evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024) -- Should be big enough for any termcaps ;-)+ -- 1 MB should be big enough for any termcaps ;-)+ evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024) fmap concat $ forM terminalsOfInterest $ \termName -> do putStrLn $ "adding tests for terminal: " ++ termName mti <- try $ Terminfo.setupTerm termName case mti of- Left (_e :: SomeException) + Left (_e :: SomeException) -> return [] Right ti -> do fmap concat $ forM capsOfInterest $ \capName -> do@@ -71,7 +73,7 @@ {-# NOINLINE verifyEvalCap #-} verifyEvalCap :: Ptr Word8 -> CapExpression -> Int -> Property verifyEvalCap evalBuffer expr !junkInt = do- forAll (vector 9) $ \inputValues -> + forAll (vector 9) $ \inputValues -> let write = writeCapExpr expr inputValues !byteCount = getBound write in liftIOResult $ do@@ -79,12 +81,11 @@ forM_ [0..100] $ \i -> runWrite write startPtr endPtr <- runWrite write startPtr case endPtr `minusPtr` startPtr of- count | count < 0 -> + count | count < 0 -> return $ failed { reason = "End pointer before start pointer." }- | toEnum count > byteCount -> - return $ failed { reason = "End pointer past end of buffer by " - ++ show (toEnum count - byteCount) + | toEnum count > byteCount ->+ return $ failed { reason = "End pointer past end of buffer by "+ ++ show (toEnum count - byteCount) }- | otherwise -> + | otherwise -> return succeeded-
test/VerifyImageOps.hs view
@@ -9,43 +9,43 @@ import Control.DeepSeq twoSwHorizConcat :: SingleColumnChar -> SingleColumnChar -> Bool-twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) = +twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) = imageWidth (char defAttr c1 <|> char defAttr c2) == 2 manySwHorizConcat :: [SingleColumnChar] -> Bool-manySwHorizConcat cs = +manySwHorizConcat cs = let chars = [ char | SingleColumnChar char <- cs ] l = fromIntegral $ length cs in imageWidth ( horizCat $ map (char defAttr) chars ) == l twoSwVertConcat :: SingleColumnChar -> SingleColumnChar -> Bool-twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) = +twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) = imageHeight (char defAttr c1 <-> char defAttr c2) == 2 horizConcatSwAssoc :: SingleColumnChar -> SingleColumnChar -> SingleColumnChar -> Bool-horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) = - (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2 - == +horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =+ (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2+ == char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2) twoDwHorizConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool-twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) = +twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) = imageWidth (char defAttr c1 <|> char defAttr c2) == 4 manyDwHorizConcat :: [DoubleColumnChar] -> Bool-manyDwHorizConcat cs = +manyDwHorizConcat cs = let chars = [ char | DoubleColumnChar char <- cs ] l = fromIntegral $ length cs in imageWidth ( horizCat $ map (char defAttr) chars ) == l * 2 twoDwVertConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool-twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) = +twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) = imageHeight (char defAttr c1 <-> char defAttr c2) == 2 horizConcatDwAssoc :: DoubleColumnChar -> DoubleColumnChar -> DoubleColumnChar -> Bool-horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) = - (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2 - == +horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =+ (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2+ == char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2) vertContatSingleRow :: NonEmptyList SingleRowSingleAttrImage -> Bool@@ -54,9 +54,9 @@ stackImage = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack ] in imageHeight stackImage == expectedHeight -disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage - -> NonEmptyList SingleRowSingleAttrImage- -> Bool+disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage+ -> NonEmptyList SingleRowSingleAttrImage+ -> Bool disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) = let expectedHeight :: Int = max (length stack0) (length stack1) stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]@@ -64,9 +64,9 @@ in imageHeight (stackImage0 <|> stackImage1) == expectedHeight -disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage - -> NonEmptyList SingleRowSingleAttrImage- -> Bool+disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage+ -> NonEmptyList SingleRowSingleAttrImage+ -> Bool disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) = let stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ] stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]@@ -74,31 +74,31 @@ expectedHeight = imageHeight image in case image of HorizJoin {} -> ( expectedHeight == (imageHeight $ partLeft image) )- && + && ( expectedHeight == (imageHeight $ partRight image) ) _ -> True -disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage +disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage -> NonEmptyList SingleRowSingleAttrImage -> Bool disjointWidthVertJoin (NonEmpty stack0) (NonEmpty stack1) = let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images) stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ] stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]- stack0Image = vertCat stack0Images - stack1Image = vertCat stack1Images + stack0Image = vertCat stack0Images+ stack1Image = vertCat stack1Images image = stack0Image <-> stack1Image in imageWidth image == expectedWidth -disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage +disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage -> NonEmptyList SingleRowSingleAttrImage -> Bool disjointWidthVertJoinBgFill (NonEmpty stack0) (NonEmpty stack1) = let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images) stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ] stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]- stack0Image = vertCat stack0Images - stack1Image = vertCat stack1Images + stack0Image = vertCat stack0Images+ stack1Image = vertCat stack1Images image = stack0Image <-> stack1Image in case image of VertJoin {} -> ( expectedWidth == (imageWidth $ partTop image) )@@ -171,4 +171,3 @@ , verify "can rnf image" canRnfImage , verify "can pp image" canPpImage ]-
test/VerifyImageTrans.hs view
@@ -22,7 +22,7 @@ verifyHorizContatWAttrChangeSimplifies ( SingleRowTwoAttrImage (SingleRowSingleAttrImage attr0 charCount0 _image0) (SingleRowSingleAttrImage attr1 charCount1 _image1) i- ) + ) | charCount0 == 0 || charCount1 == 0 || attr0 == attr1 = isHorizTextOfColumns i (charCount0 + charCount1) | otherwise = False == isHorizTextOfColumns i (charCount0 + charCount1)
test/VerifyLayersSpanGeneration.hs view
@@ -4,6 +4,7 @@ import Verify.Graphics.Vty.Prelude +import Verify.Graphics.Vty.Attributes import Verify.Graphics.Vty.Image import Verify.Graphics.Vty.Picture import Verify.Graphics.Vty.Span@@ -13,7 +14,7 @@ import Verify -import qualified Data.Vector as Vector +import qualified Data.Vector as Vector largerHorizSpanOcclusion :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result largerHorizSpanOcclusion row0 row1 =@@ -25,8 +26,9 @@ ops = displayOpsForPic p (imageWidth iLarger,imageHeight iLarger) in verifyOpsEquality expectedOps ops --- | Two rows stacked vertical is equivalent to the first row rendered as the top layer and the--- second row rendered as a bottom layer with a background fill where the first row would be.+-- | Two rows stacked vertical is equivalent to the first row rendered+-- as the top layer and the second row rendered as a bottom layer with a+-- background fill where the first row would be. vertStackLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result vertStackLayerEquivalence0 row0 row1 = let i0 = rowImage row0@@ -52,8 +54,9 @@ opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower) in verifyOpsEquality expectedOps opsLayered --- | Two rows horiz joined is equivalent to the first row rendered as the top layer and the--- second row rendered as a bottom layer with a background fill where the first row would be.+-- | Two rows horiz joined is equivalent to the first row rendered as+-- the top layer and the second row rendered as a bottom layer with a+-- background fill where the first row would be. horizJoinLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result horizJoinLayerEquivalence0 row0 row1 = let i0 = rowImage row0@@ -109,7 +112,7 @@ in verifyOpsEquality expectedOps opsLayered tests :: IO [Test]-tests = return +tests = return [ verify "a larger horiz span occludes a smaller span on a lower layer" largerHorizSpanOcclusion , verify "two rows stack vertical equiv to first image layered on top of second with padding (0)"@@ -125,4 +128,3 @@ -- , verify "alternating images using joins is the same as alternating images using layers (1)" -- horizJoinAlternate1 ]-
test/VerifyOutput.hs view
@@ -1,8 +1,8 @@-{- We setup the environment to envoke certain terminals of interest.- - This assumes appropriate definitions exist in the current environment for the terminals of- - interest.- -}+-- We setup the environment to envoke certain terminals of interest.+-- This assumes appropriate definitions exist in the current environment+-- for the terminals of interest. module VerifyOutput where+ import Verify import Graphics.Vty@@ -12,8 +12,6 @@ import Control.Monad -import Data.Default- import qualified System.Console.Terminfo as Terminfo import System.Posix.Env import System.Posix.IO@@ -37,11 +35,12 @@ smokeTestTerm :: String -> Image -> IO Result smokeTestTerm termName i = do nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags- t <- outputForConfig $ def { outputFd = Just nullOut, termName = Just termName }+ t <- outputForConfig $ defaultConfig { outputFd = Just nullOut, termName = Just termName } -- putStrLn $ "context color count: " ++ show (contextColorCount t) reserveDisplay t dc <- displayContext t (100,100)- -- always show the cursor to produce tests for terminals with no cursor support.+ -- always show the cursor to produce tests for terminals with no+ -- cursor support. let pic = (picForImage i) { picCursor = Cursor 0 0 } outputPicture dc pic setCursorPos t 0 0
test/VerifyParseTerminfoCaps.hs view
@@ -16,7 +16,7 @@ -- If a terminal defines one of the caps then it's expected to be parsable. -- TODO: reduce duplication with terminfo terminal implementation.-capsOfInterest = +capsOfInterest = [ "cup" , "sc" , "rc"@@ -65,7 +65,7 @@ Right e -> onParse e nonParamaterizedCaps (NonParamCapString cap) = do- verifyParseCap cap $ \e -> + verifyParseCap cap $ \e -> let expectedBytes = map (toEnum . fromEnum) cap outBytes = bytesForRange e 0 (length cap) in verifyBytesEqual outBytes expectedBytes@@ -75,7 +75,7 @@ incFirstTwoCaps (IncFirstTwoCap capString expectedBytes) = do verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes- + pushParamCaps (PushParamCap capString expectedParamCount expectedBytes) = do verifyParseCap capString $ \e -> let outBytes = collectBytes e@@ -98,4 +98,3 @@ printExpression ti capName = do let parseResult = parseCapExpression $ fromCapname ti capName putStrLn $ capName ++ ": " ++ show parseResult-
test/VerifySimpleSpanGeneration.hs view
@@ -13,28 +13,28 @@ import Verify -import qualified Data.Vector as Vector +import qualified Data.Vector as Vector unitImageAndZeroWindow0 :: UnitImage -> EmptyWindow -> Bool-unitImageAndZeroWindow0 (UnitImage _ i) (EmptyWindow w) = +unitImageAndZeroWindow0 (UnitImage _ i) (EmptyWindow w) = let p = picForImage i ops = displayOpsForPic p (regionForWindow w) in displayOpsColumns ops == 0 && displayOpsRows ops == 0 unitImageAndZeroWindow1 :: UnitImage -> EmptyWindow -> Bool-unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) = +unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) = let p = picForImage i ops = displayOpsForPic p (regionForWindow w) in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 ) horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool-horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) = +horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) = let p = picForImage i ops = displayOpsForPic p (regionForWindow w) in displayOpsColumns ops == 0 && displayOpsRows ops == 0 horizSpanImageAndZeroWindow1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool-horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) = +horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) = let p = picForImage i ops = displayOpsForPic p (regionForWindow w) in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )@@ -139,7 +139,7 @@ in allSpansHaveWidth ops expectedColumnCount firstSpanOpSetsAttr :: DefaultPic -> Bool-firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } = +firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } = let ops = displayOpsForPic pic (regionForWindow win) in all ( isAttrSpanOp . Vector.head ) ( Vector.toList ops ) @@ -158,7 +158,7 @@ in verifyAllSpansHaveWidth i ops (imageWidth i) tests :: IO [Test]-tests = return +tests = return [ verify "unit image is cropped when window size == (0,0) [0]" unitImageAndZeroWindow0 , verify "unit image is cropped when window size == (0,0) [1]" unitImageAndZeroWindow1 , verify "horiz span image is cropped when window size == (0,0) [0]" horizSpanImageAndZeroWindow0@@ -171,7 +171,7 @@ , verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]" singleAttrSingleSpanStackOpCoverage , verify "a single attr text span is cropped when window size < size of stack image [width]"- singleAttrSingleSpanStackCropped0 + singleAttrSingleSpanStackCropped0 , verify "a single attr text span is cropped when window size < size of stack image [height]" singleAttrSingleSpanStackCropped1 , verify "single attr text span <|> single attr text span display cropped. [width]"
test/VerifyUsingMockInput.hs view
@@ -1,8 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}-{- Generate some input bytes and delays between blocks of input bytes. Verify the events produced- - are as expected.- -}+-- Generate some input bytes and delays between blocks of input bytes.+-- Verify the events produced are as expected. module Main where import Verify.Graphics.Vty.Output@@ -12,14 +11,12 @@ import Graphics.Vty.Input.Loop import Graphics.Vty.Input.Terminfo -import Control.Applicative import Control.Concurrent import Control.Concurrent.STM import Control.Exception import Lens.Micro ((^.)) import Control.Monad -import Data.Default import Data.IORef import Data.List (intersperse, reverse, nubBy) @@ -36,7 +33,8 @@ import Text.Printf --- processing a block of 16 chars is the largest I can do without taking too long to run the test.+-- processing a block of 16 chars is the largest I can do without taking+-- too long to run the test. maxBlockSize :: Int maxBlockSize = 16 @@ -47,8 +45,11 @@ forEachOf l = over (generate (\n -> take n l)) data InputEvent- = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.- | Delay Int -- | microsecond delay+ = Bytes String+ -- ^ Input sequence encoded as a string. Regardless, the input is+ -- read a byte at a time.+ | Delay Int+ -- ^ Microsecond delay deriving Show type InputSpec = [InputEvent]@@ -111,11 +112,11 @@ (writeFd, readFd) <- openPseudoTerminal (setTermAttr,_) <- attributeControl readFd setTermAttr- let testConfig = def { inputFd = Just readFd- , termName = Just "dummy"- , vmin = Just 1- , vtime = Just 100- }+ let testConfig = defaultConfig { inputFd = Just readFd+ , termName = Just "dummy"+ , vmin = Just 1+ , vtime = Just 100+ } input <- initInput testConfig table eventsRef <- newIORef [] let writeWaitClose = do@@ -163,8 +164,8 @@ verifyCapsSynInputToEvent :: Property IO verifyCapsSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->- forEachOf terminalsOfInterest $ \termName -> monadic $ do- term <- setupTerm termName+ forEachOf terminalsOfInterest $ \terminalName -> monadic $ do+ term <- setupTerm terminalName let table = capsClassifyMap term keysFromCapsTable inputSeq = gen table events = map snd inputSeq@@ -183,9 +184,9 @@ verifyFullSynInputToEvent :: Property IO verifyFullSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->- forEachOf terminalsOfInterest $ \termName -> monadic $ do- term <- setupTerm termName- let table = classifyMapForTerm termName term+ forEachOf terminalsOfInterest $ \terminalName -> monadic $ do+ term <- setupTerm terminalName+ let table = classifyMapForTerm terminalName term inputSeq = gen table events = map snd inputSeq keydowns = map (Bytes . fst) inputSeq@@ -194,9 +195,9 @@ verifyFullSynInputToEvent_2x :: Property IO verifyFullSynInputToEvent_2x = forAll $ \(InputBlocksUsingTable gen) ->- forEachOf terminalsOfInterest $ \termName -> monadic $ do- term <- setupTerm termName- let table = classifyMapForTerm termName term+ forEachOf terminalsOfInterest $ \terminalName -> monadic $ do+ term <- setupTerm terminalName+ let table = classifyMapForTerm terminalName term inputSeq = gen table events = concatMap ((\s -> [s,s]) . snd) inputSeq keydowns = map (Bytes . (\s -> s ++ s) . fst) inputSeq
test/VerifyUsingMockTerminal.hs view
@@ -4,9 +4,11 @@ import Verify.Graphics.Vty.Picture import Verify.Graphics.Vty.Image+import Verify.Graphics.Vty.Attributes import Verify.Graphics.Vty.Span import Verify.Graphics.Vty.Output import Graphics.Vty.Output+import Graphics.Vty.Output.Interface import Graphics.Vty.Output.Mock import Graphics.Vty.Debug@@ -39,27 +41,30 @@ singleTRow (MockWindow w h) = liftIOResult $ do (mockData,t) <- mockTerminal (w,h) dc <- displayBounds t >>= displayContext t- -- create an image that contains just the character T repeated for a single row+ -- create an image that contains just the character T repeated for a+ -- single row let i = horizCat $ replicate (fromEnum w) (char defAttr 'T') pic = (picForImage i) { picBackground = Background 'B' defAttr } outputPicture dc pic- -- The mock output string that represents the output bytes a single line containing the T- -- string: Followed by h - 1 lines of a change to the background attribute and then the- -- background character+ -- The mock output string that represents the output bytes a single+ -- line containing the T string: Followed by h - 1 lines of a change+ -- to the background attribute and then the background character let expected = "H" ++ "MDA" ++ replicate (fromEnum w) 'T' ++ concat (replicate (fromEnum h - 1) $ "MDA" ++ replicate (fromEnum w) 'B') compareMockOutput mockData expected- + manyTRows :: MockWindow -> Property manyTRows (MockWindow w h) = liftIOResult $ do (mockData, t) <- mockTerminal (w,h) dc <- displayBounds t >>= displayContext t- -- create an image that contains the character 'T' repeated for all the rows+ -- create an image that contains the character 'T' repeated for all+ -- the rows let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w) (char defAttr 'T') pic = (picForImage i) { picBackground = Background 'B' defAttr } outputPicture dc pic- -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an- -- attribute change. 'A', followed by w 'T's+ -- The UTF8 string that represents the output bytes is h repeats of+ -- a move, 'M', followed by an attribute change. 'A', followed by w+ -- 'T's let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T') compareMockOutput mockData expected @@ -67,12 +72,14 @@ manyTRowsCroppedWidth (MockWindow w h) = liftIOResult $ do (mockData,t) <- mockTerminal (w,h) dc <- displayBounds t >>= displayContext t- -- create an image that contains the character 'T' repeated for all the rows+ -- create an image that contains the character 'T' repeated for all+ -- the rows let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w * 2) (char defAttr 'T') pic = (picForImage i) { picBackground = Background 'B' defAttr } outputPicture dc pic- -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an- -- attribute change. 'A', followed by w 'T's+ -- The UTF8 string that represents the output bytes is h repeats of+ -- a move, 'M', followed by an attribute change. 'A', followed by w+ -- 'T's let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T') compareMockOutput mockData expected @@ -80,12 +87,14 @@ manyTRowsCroppedHeight (MockWindow w h) = liftIOResult $ do (mockData,t) <- mockTerminal (w,h) dc <- displayBounds t >>= displayContext t- -- create an image that contains the character 'T' repeated for all the rows+ -- create an image that contains the character 'T' repeated for all+ -- the rows let i = vertCat $ replicate (fromEnum h * 2) $ horizCat $ replicate (fromEnum w) (char defAttr 'T') pic = (picForImage i) { picBackground = Background 'B' defAttr } outputPicture dc pic- -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an- -- attribute change. 'A', followed by w count 'T's+ -- The UTF8 string that represents the output bytes is h repeats of+ -- a move, 'M', followed by an attribute change. 'A', followed by w+ -- count 'T's let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T') compareMockOutput mockData expected @@ -97,4 +106,3 @@ , verify "manyTRowsCroppedWidth" manyTRowsCroppedWidth , verify "manyTRowsCroppedHeight" manyTRowsCroppedHeight ]-
test/VerifyUtf8Width.hs view
@@ -1,9 +1,11 @@ module VerifyUtf8Width where+ import Verify import Graphics.Text.Width import Graphics.Vty.Attributes import Graphics.Vty.Picture+import Graphics.Vty.Image swIs1Column :: SingleColumnChar -> Bool swIs1Column (SingleColumnChar c) = imageWidth (char defAttr c) == 1
vty.cabal view
@@ -1,10 +1,10 @@ name: vty-version: 5.14+version: 5.15 license: BSD3 license-file: LICENSE author: AUTHORS maintainer: Jonathan Daugherty (cygnus@foobox.com)-homepage: https://github.com/coreyoconnor/vty+homepage: https://github.com/jtdaugherty/vty category: User Interfaces synopsis: A simple terminal UI library description:@@ -12,48 +12,36 @@ be easy to use, have no confusing corner cases, and good support for common terminal types. .- Included in the source distribution is a program- test/interactive_terminal_test.hs that demonstrates the various- features.- .- Developers: See the "Graphics.Vty" module.- .- Users: See the "Graphics.Vty.Config" module.- .- If your terminal is not behaving as expected the results of the- vty-interactive-terminal-test executable should be sent to the Vty- maintainter to aid in debugging the issue.- .- Notable infelicities: Assumes UTF-8 character encoding support by the- terminal; Poor signal handling; Requires terminfo.- .- This project is hosted on github.com: <https://github.com/coreyoconnor/vty>+ See the @vty-examples@ package as well as the program+ @test/interactive_terminal_test.hs@ included in the @vty@ package for+ examples on how to use the library. .- > git clone git://github.com/coreyoconnor/vty.git+ Import the "Graphics.Vty" convenience module to get access to the core+ parts of the library. . © 2006-2007 Stefan O'Rear; BSD3 license. . © Corey O'Connor; BSD3 license.+ .+ © Jonathan Daugherty; BSD3 license. cabal-version: >= 1.18 build-type: Simple data-files: README.md,- TODO, AUTHORS,- CHANGELOG,+ CHANGELOG.md, LICENSE tested-with: GHC >= 7.6.2 source-repository head type: git- location: https://github.com/coreyoconnor/vty.git+ location: https://github.com/jtdaugherty/vty.git library default-language: Haskell2010- build-depends: base >= 4 && < 5,+ build-depends: base >= 4.6 && < 5, blaze-builder >= 0.3.3.2 && < 0.5, bytestring, containers,- data-default >= 0.5.3, deepseq >= 1.1 && < 1.5, directory, filepath >= 1.0 && < 2.0,@@ -83,7 +71,6 @@ Graphics.Vty.Input Graphics.Vty.Input.Events Graphics.Vty.Picture- Graphics.Vty.Prelude Graphics.Vty.Output Graphics.Text.Width -- the modules below are only meant to be used by the tests.@@ -131,30 +118,30 @@ executable vty-mode-demo main-is: ModeDemo.hs+ hs-source-dirs: demos default-language: Haskell2010 default-extensions: ScopedTypeVariables ghc-options: -threaded build-depends: vty,- base >= 4 && < 5,+ base >= 4.6 && < 5, containers,- data-default >= 0.5.3, microlens, microlens-mtl, mtl >= 1.1.1.0 && < 2.3 executable vty-demo main-is: Demo.hs+ hs-source-dirs: demos default-language: Haskell2010 default-extensions: ScopedTypeVariables ghc-options: -threaded build-depends: vty,- base >= 4 && < 5,+ base >= 4.6 && < 5, containers,- data-default >= 0.5.3, microlens, microlens-mtl, mtl >= 1.1.1.0 && < 2.3@@ -169,7 +156,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -201,7 +188,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -234,10 +221,9 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers,- data-default >= 0.5.3, deepseq >= 1.1 && < 1.5, mtl >= 1.1.1.0 && < 2.3, terminfo >= 0.3 && < 0.5,@@ -268,7 +254,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -294,7 +280,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -321,7 +307,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, blaze-builder >= 0.3.3.2 && < 0.5, bytestring, containers,@@ -351,7 +337,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -379,7 +365,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -406,7 +392,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -434,7 +420,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -466,7 +452,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -498,7 +484,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -530,7 +516,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -556,7 +542,7 @@ Cabal >= 1.20, QuickCheck >= 2.7, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -578,14 +564,13 @@ build-depends: vty, Cabal >= 1.20,- data-default >= 0.5.3, QuickCheck >= 2.7, smallcheck == 1.*, quickcheck-assertions >= 0.1.1, test-framework == 0.8.*, test-framework-smallcheck == 0.2.*, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,@@ -613,7 +598,6 @@ build-depends: vty, Cabal >= 1.20,- data-default >= 0.5.3, HUnit, QuickCheck >= 2.7, smallcheck == 1.*,@@ -622,7 +606,7 @@ test-framework-smallcheck == 0.2.*, test-framework-hunit, random >= 1.0 && < 1.2,- base >= 4 && < 5,+ base >= 4.6 && < 5, bytestring, containers, deepseq >= 1.1 && < 1.5,