vty-6.1/0000755000000000000000000000000007346545000010373 5ustar0000000000000000vty-6.1/AUTHORS0000644000000000000000000000075407346545000011451 0ustar0000000000000000The following people should be thanked for contributing to the vty library: * Andrea Vezzosi * Corey O'Connor * Emily Backes * Josef Svenningsson * Nicolas Pouillard * Roman Cheplyaka * Stefan O'Rear * Yusaku Hashimoto * allan.clark * gwern0 * jeanphilippe.bernardy * m.niloc * mikesteele81 * Mikolaj Konarski * Eyal Lotem * Yoshikuni Jujo * Dmitry Ivanov Plus others.. Check the git log and CHANGELOG.md for a full list. vty-6.1/CHANGELOG.md0000644000000000000000000011170407346545000012210 0ustar0000000000000000 6.1 --- API changes: * `ColorMode` got a `Read` instance. * The `Config` type got a new `configPreferredColorMode` field for specifying a preferred `ColorMode`. Backend packages should respect this field, but note that `vty` itself does not (and cannot) enact this preference since it's up to the backend driver to configure the color mode. * The Vty configuration file got a new `colorMode` field whose value is a string literal compatible with the `ColorMode` `Read` instance. 6.0 --- This release marks the beginning of multi-platform support in Vty. Getting to this point involved removing Unix-specific functionality from Vty and moving it to a new package, `vty-unix`. Windows support is now provided via a `vty-windows` package. Another new package, `vty-crossplatform`, is provided as a convenience for applications that want to support both Unix and Windows platforms automatically at build time. See the migration guide below for details on how to upgrade. **Migration guide for 6.0** To upgrade to this version of Vty, most people will only need to take a few steps: 1. Add a package dependency on `vty-unix`, `vty-windows,` or `vty-crossplatform`, depending on the desired level of platform support. For example, if an application only supports Unix systems, it should depend on `vty-unix`. But if an application is intended to work anywhere Vty works, then `vty-crossplatform` is the best choice. 2. Import `mkVty` from the platform package in step (1). (`mkVty` was removed from the `vty` package and is now the responsibility of each platform package.) Imports are as follows: * `vty-unix`: `Graphics.Vty.Platform.Unix` * `vty-windows`: `Graphics.Vty.Platform.Windows` * `vty-crossplatform`: `Graphics.Vty.CrossPlatform` 3. Maintain any existing package dependency on `vty`; the core library abstractions, types, and functions are still obtained from `vty` itself. The platform packages do not re-export the core library's modules. 4. If desired, call `Graphics.Vty.Config.userConfig` to load the Vty user configuration since this step is no longer automatic. For applications using more of Vty's API than just the basic initialization and rendering API, the full change list is provided below. For people who want to write their own Vty platform package like `vty-unix`, see `PLATFORM-HOWTO.md`. **Detailed change list for 6.0** * Package changes: * The following modules got added to the `vty` library: * `Graphics.Vty.UnicodeWidthTable.Main` * The following modules got moved to `vty-unix`: * `Data.Terminfo.Eval` * `Data.Terminfo.Parse` * The following modules got moved to `vty-unix` into the `Graphics.Vty.Platform.Unix` module namespace (previously `Graphics.Vty`): * `Graphics.Vty.Input.Classify` * `Graphics.Vty.Input.Classify.Parse` * `Graphics.Vty.Input.Classify.Types` * `Graphics.Vty.Input.Focus` * `Graphics.Vty.Input.Loop` * `Graphics.Vty.Input.Mouse` * `Graphics.Vty.Input.Paste` * `Graphics.Vty.Input.Terminfo` * `Graphics.Vty.Output.TerminfoBased` * `Graphics.Vty.Output.XTermColor` * The following modules were removed entirely (with contents migrated elsewhere as needed): * `Graphics.Vty.Inline.Unsafe` * `Graphics.Vty.Output.Interface` (migrated to `Graphics.Vty.Output`) * Removed library dependencies on the following packages: * `ansi-terminal` * `containers` * `terminfo` * `transformers` * `unix` * The following executables were moved to other packages: * `vty-build-width-table` (moved to `vty-unix` as `vty-unix-build-width-table`) * `vty-mode-demo` (moved to `vty-crossplatform`) * API changes: * `Graphics.Vty.mkVty` moved to the `vty-unix` package's `Graphics.Vty.Platform.Unix` module. * Added `Graphics.Vty.mkVtyFromPair` for platform packages to construct `Vty` handles. * The contents of the `Graphics.Vty.Output.Interface` module were merged into `Graphics.Vty.Output`. * The `vty-build-width-table` tool was removed from the `vty` package, but its core functionality is now exposed as a library for platform packages to use to provide platform-specific tools using `Graphics.Vty.UnicodeWidthTable.Main` and a new tool by the same name was added to the `vty-unix` package. * `Graphics.Vty.Events`: the `InternalEvent` type's `ResumeAfterSignal` constructor was renamed to `ResumeAfterInterrupt` to be a bit more abstract and platform-agnostic. * Removed the following lenses for fields of the `Input` type: * `eventChannel` (was for `_eventChannel` which was then renamed to `eventChannel`) * `configRef` (was for `_configRef` which was then renamed to `configRef`) * The `Output` record type got a new field, `setOutputWindowTitle`. * The `Input` record type got a new field, `inputLogMsg :: String -> IO ()`, for logging to the Vty log. * `Graphics.Vty.Config` now exposes `VtyUserConfig` instead of `Config`. Many of its fields were Unix-specific and were consequently moved to the `UnixSettings` type in `vty-unix`. * The `VtyUserConfig` type's fields got a `config` field name prefix. * Behavior changes: * Since `vty` no longer implements `mkVty`, the Vty user configuration is no longer implicitly loaded by Vty-based applications. Instead, it is now up to the applications to call `Graphics.Vty.Config.userConfig` to load any user-provided configuration. * Vty no longer implicitly attempts to load configured Unicode width tables. It is now the responsibility of the platform packages (such as `vty-unix`) and/or applications to load tables via `Graphics.Vty.UnicodeWidthTable.IO` and install them via `Graphics.Vty.UnicodeWidthTable.Install`. * Changes to demonstration programs: * `EventEcho`, `ModeDemo`, and `Rogue` demo programs moved to the `vty-crossplatform` package. * Changes to tests: * Where appropriate, some test programs and test cases were moved to `vty-unix` or `vty-crossplatform`. 5.39 ---- Package changes: * Now builds with `mtl-2.3.*`. Bug fixes: * Fixed a long-standing issue where unused input on stdin could cause a memory error and a crash when Vty was being initialized. (#266) 5.38 ---- This release includes numerous API changes, although none of them should break your programs. If so, please open a ticket on the Vty issue tracker. Package changes: * Support mtl 2.3 (thanks Daniel Firth) * The test and example collections got completely overhauled to clean up bit rot. * Moved example programs into examples/ under a new vty-examples package. * Moved test suite programs out of vty.cabal and into tests/ under a new vty-tests package. * Cleaned up all build-depends lists in all three packages to remove unused deps. * Consolidated the test suite library modules into the vty-tests library to avoid redundant compilation. * Added build.sh to build everything in the development process to help ensure that examples and tests don't get forgotten. * Removeed lots of stale/unused modules in old test/ directory. * Got vty-examples building again and resolved various warnings and issues. API changes: * All modules got explicit export lists. Prior to this release, many modules exported everything they contained, making it difficult to know what was really intended to be part of the public API. The new export lists should contain everything that applications need; the risk of breakage exists but should be minor. Please open a ticket if you were using something that is no longer exported. It might be that it was never supposed to be exported to begin with, or it might be just something we need to export once again. * Moved the `attributeControl` function from `Graphics.Vty.Input.Loop` to `Graphics.Vty.Input`. * Removed the `Graphics.Vty.Image.DisplayText` alias for `Text`. * Unified the `Image` cropping constructors (thanks Fraser Tweedale) 5.37 ---- * The Xterm backend is now used when `TERM` matches `rxvt` or `tmux`. * PictureToSpans now uses `error`, not `fail`, to avoid dependence on soon-to-be-removed `MonadFail` instance for `ST` (#248) 5.36 ---- * Raised `microlens` upper bound to allow building with 0.4.13. * Replaced incomplete `Show` output for `Picture` with a derived instance; derived `Show` for `Cursor` and `Background`, too. 5.35.1 ------ Bug fixes: * Fixed a build issue with a test program. 5.35 ---- New features: * Add support for 24-bit color (thanks @u-quark). This change updates Vty to look at the `COLORTERM` environment variable that is conventionally used to advertise support for truecolor escape sequences. The change also updates the Vty demo to demonstrate 24-bit colors. This change also adds a new data type, `ColorMode`, to represent the color mode in use, as well as an `Output` interface field, `outputColorMode`, to track the active color mode and use it to clamp emitted color escape sequences to the active color range. API changes: * All types in `Graphics.Vty.Input.Events` now have strict constructor fields. * Internal events are now wrapped in a new `InternalEvent` type to improve how signal handling is done. This change modifies the `Input` type's event channel API to produce `InternalEvents`, not `Events`. The new `InternalEvent` either wraps `Event` with the `InputEvent` constructor (the previous behavior) or indicates that Vty resumed after handling a signal using the `ResumeAfterSignal` constructor. This change avoids the previous use of `EvResize` with lazy exception arguments as a sentinel value for `ResumeAfterSignal`. Other enhancements: * Bracketed paste parsing performance has been greatly improved thanks to benchmarking and optimization work by @iphydf. As part of that work, Vty now uses bytestrings rather than Strings internally when parsing input to look for events. * The `\b` value is now interpreted as `KBS` (thanks @vglfr) 5.34 ---- API changes: * Added an `NFData` instance for `Event` (thanks Mario Lang) * Removed `Monoid` and `Semigroup` instances for `Attr` and `MaybeDefault`. This change removed the instances because they were misbehaved; merging `Attr` and `MaybeDefault` values with these instances resulted in field value losses. For example, before this change, ``` (defAttr `withForeColor` blue) <> (defAttr `withBackColor` green) ``` would result in just ``` (defAttr `withBackColor` green) ``` because the instances were designed to favor the right-hand arguments' fields even if they had not been explicitly set (a consequence of the `MaybeDefault` `Semigroup` instance). While that behavior was sensible specifically in the context of `Graphics.Vty.Inline`, it wasn't a useful user-facing API and it made for surprising instance behavior. Since there is actually no good way to handle this in a `Semigroup` instance for `Attr` -- some choices have to be made about how to merge two attributes' foreground colors, and that won't be much better than what we had -- the instance was just removed. 5.33 ---- API changes: * The `Cursor` type got a new `PositionOnly` constructor for cursor placement without visibility. Package changes: * Relaxed upper bound for `random` * Updated `microlens` bounds to allow 0.4.12 Other improvements: * Various hlint-driven improvements (thanks Willem Van Onsem) * The implementation of `color240` was improved (thanks (Willem Van Onsem) 5.32 ---- New features: * Meta-PageUp and Meta-PageDown are now supported (#193) * Added `supportsItalics` and `supportsStrikethrough` functions to check for feature support in terminfo Bug fixes: * Detect utf-8 mode in `LANG` regardless of case (thanks Emeka Nkurumeh) 5.31 ---- New features and API changes: * Added support for strikethrough mode. This change adds a new `strikethrough` `Style` value and uses the `smxx` and `rmxx` Terminfo capabilities to activate and deactivate strikethrough mode, respectively. If the terminfo does not report those capabilities, this style is ignored. * `Output`: added the `setDisplayBounds` field to set the output dimensions of the output handle; added an implementation of this for the `TerminfoBased` backend. Other changes: * The C prototype for `vty_c_get_window_size` in `gwinsz.h` was fixed. 5.30 ---- New features: * Added `Graphics.Vty.setWindowTitle` to emit an escape sequence to set the window title, provide the terminal emulator accepts Xterm-style title sequences. For details, see: https://tldp.org/HOWTO/Xterm-Title-3.html 5.29 ---- API changes: * The Input type got a new field, 'restoreInputState'. This field allows the end user to have direct access to the logic needed to restore the terminal's input state flags. Prior to having this field, this state restoration logic could only be invoked as part of calling 'shutdownInput', but since that function does other things (like killing threads) it is not advisable to call it repeatedly (which is necessary in the use case this change is intended to support). This can be called directly to restore the input state flags as needed, although this is not required if 'shutdown' (or 'shutdownInput') is called. Other changes: * attributeControl: explicitly enable the ICRNL terminal mode flag (see #187 and c572ad). 5.28.2 ------ Bug fixes: * Added a package dependency on `semigroups` for the `vty-build-width-table` tool on older GHCs (#185) 5.28.1 ------ Bug fixes: * `installUnicodeWidthTable`: use `throwIO`, not `throw` 5.28 ---- This release improves Vty's support for multi-column Unicode characters and provides greater compatibility with a wider array of terminal emulators. The following sections summarize the relevant changes, but an overview of the new functionality is motivated and detailed in the new "Multi-Column Character Support" README section. For historical context, please also consider reading over [#175](https://github.com/jtdaugherty/vty/issues/175). API changes: * New modules were added: * `Graphics.Vty.UnicodeWidthTable.Types` * `Graphics.Vty.UnicodeWidthTable.IO` * `Graphics.Vty.UnicodeWidthTable.Query` * `Graphics.Vty.UnicodeWidthTable.Install` * The `Config` type got a new field, `allowCustomUnicodeWidthTables`, that controls whether `mkVty` will attempt to load a Unicode width table if specified in the configuration. Configuration file changes: * A new syntax was added to support specifying Unicode width tables on a per-`TERM` basis. The syntax is `widthMap `. See the documentation for `Graphics.Vty.Config` for details. Since prior versions of this library will silently ignore any configuration file lines they cannot parse, this change to user configuration files is at least non-breaking for older versions of Vty. Other changes: * The `mkVty` function now automatically attempts to load a custom Unicode width table if one is specified in the configuration, provided `allowCustomUnicodeWidthTables` is not set to `Just False`. See the documentation for `Graphics.Vty.mkVty` for details. * Vty now includes a command line tool, `vty-build-width-table`, that queries the terminal emulator to construct a custom Unicode width table and optionally update the Vty configuration file to use it. Programs that want to use that tool's functionality may also do so via the API exposed in the various modules listed above. 5.27 ---- * Added `Graphics.Vty.Config.getTtyEraseChar` to support querying the kernel for the current terminal's settings to obtain the character assigned by the `stty erase` command. That can then be added to the Vty configuration's input map to map to `KBS` (backspace) if desired. 5.26 ---- * Resolved various import warnings (thanks @glguy) * Removed the `MonadIO` constraint from the Output type's fields and removed `MonadFail` uses (PR #177, thanks @glguy) * Clarified documentation for ANSI colors (thanks Colby Jenn) * `Graphics.Vty.Attributes` no longer re-exports `Graphics.Vty.Attributes.Color` * The `Graphics.Vty.Attributes.Color` module is now exposed (thanks Colby Jenn) * Raised upper bound for `microlens` to 0.4.12 (thanks Artyom Kazak) * Changed from using `System.Posix.Env.getEnv` to `System.Environment.lookupEnv` (thanks Jonathan Osser) * Added `Graphics.Vty.Image` functions for dealing with character width computations on `Text` values instead of `Strings`: * `safeWctwidth` * `safeWctlwidth` * `wctwidth` * `wctlwidth` 5.25.1 ------ * Avoided a conflict with a Microlens 0.4.10 operator and added an upper bound on Microlens of 0.4.11. 5.25 ---- * The Vty type got a new field, isShutdown, that returns whether the Vty handle has had its 'shutdown' function called (thanks Ian Jeffries) * Vty's shutdown function is now thread-safe. 5.24.1 ------ * The "shutdown" method of Vty handles is now idempotent (#159) 5.24 ---- * Add Generic and NFData instances for some types * Image: remove custom Show instance, add derived Show and Read instances * Updated Travis build settings (thanks Eric Mertens) 5.23.1 ------ * Fixed a bug where italics did not combine properly with other display modes (#155, thanks Eric Mertens) 5.23 ---- * Added support for italicized output when terminfo supports it. This takes the form of a new Style, "italic". Note that most terminfo descriptors do not report capabilities for italics, so support for this will be very spotty. * Updateed text/string function documentation to indicate that escapes are not permitted in their inputs. 5.22 ---- * Added Graphics.Vty.Attributes.Color240.color240CodeToRGB function (thanks Brent Carmer) * Added nextEventNonblocking function (field) to Vty type (#87) 5.21 ---- * Picture and Background now provide Eq instances (thanks Jaro Reinders) * #145: vty builds with microlens 0.4.9 (thanks Daniel Wagner) * #142: note requirement of threaded RTS 5.20 ---- API changes: * Split up Monoid instances into Monoid and Semigroup for newer GHCs (thanks Ryan Scott) 5.19.1 ------ API changes: * Cursor now provides an Eq instance (thanks Jaro Reinders) 5.19 ---- API changes: * URL hyperlinking (via 'withURL') is now optional and disabled by default due to poor support on some common terminals. A new 'Mode' constructor, 'Hyperlink', has been added to enable this feature. To change the hyperlinking mode, use 'setMode' on the 'outputIface' of a Vty handle. 5.18.1 ------ Bug fixes: * Reset the hyperlink state on line endings to avoid run-on hyperlinks 5.18 ---- API changes: * Added support for hyperlinking attributes (thanks Getty Ritter). This change adds a new Attr field for containing the hyperlink to apply, as per https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda 5.17.1 ------ * withStyle now ignores zero arguments, leaving attribute styles untouched if the input style is the null style 5.17 ---- API changes: * Add support for terminal focus events. This change adds a new mode usable with setMode, Focus, that requests that the terminal send events on focus lose/gain. This change also adds two new Event constructors, EvLostFocus and EvGainedFocus. * No longer enable UTF8 mouse event encoding. This encoding was not working properly with Terminal.app, and using the other modes (SGR, etc.) work. * Graphics.Vty.Attributes: escape backticks in Haddock comment (fixes #131) 5.16 ---- API changes: * Added support for mouse wheel events while in mouse mode. The Button type got two new constructors as a result: BScrollUp and BScrollDown. Thanks to doublescale@tutanota.com for this contribution! Bug fixes: * charFill now clamps negative arguments to zero (thanks Eric Mertens!) 5.15.1 ------ Package changes: * Documentation files are now marked accordingly (thanks Michal Suchánek) Bug fixes: * translateX/Y: fix negative translations 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 " 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 for these features. 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 vty-6.1/LICENSE0000644000000000000000000000306007346545000011377 0ustar0000000000000000BSD 3-Clause License Copyright Stefan O'Rear 2006, Corey O'Connor 2008, Corey O'Connor 2009 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Stefan O'Rear nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vty-6.1/README.md0000644000000000000000000001624607346545000011663 0ustar0000000000000000[![Build Status](https://travis-ci.org/jtdaugherty/vty.png)](https://travis-ci.org/jtdaugherty/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. `vty` and its partner packages are published on [Hackage](https://hackage.haskell.org/). The `vty` package works in concert with one or more *platform packages* to do terminal I/O. Each platform package provides support for terminal I/O on a specific platform. Known platform packages are: * [vty-unix](https://github.com/jtdaugherty/vty-unix) - the Unix terminal backend for Vty * [vty-windows](https://github.com/chhackett/vty-windows) - the Windows terminal backend for Vty * [vty-crossplatform](https://github.com/jtdaugherty/vty-crossplatform) - a package that builds `vty-unix` or `vty-windows` based on the build environment # How to use Vty 1. Add a package dependency on `vty-unix`, `vty-windows,` or `vty-crossplatform`, depending on the desired level of platform support. For example, if an application only supports Unix systems, it should depend on `vty-unix`. But if an application is intended to work anywhere Vty works, then `vty-crossplatform` is the best choice. 2. Add a package dependency on `vty`; the core library abstractions, types, and functions are obtained from `vty` itself. The platform packages do not re-export the core library's modules. 3. Import `mkVty` from the platform package in step (1) and use that to construct a `Vty` handle and initialize the terminal. 4. If desired, call `Graphics.Vty.Config.userConfig` to load the Vty user configuration since this step is not automatic. Once you've initialized the terminal and have a `Vty` value, all of the `vty` package's API is now ready to use to do terminal I/O. # Implementing support for a new platform Although this shouldn't be necessary to do very often (if ever!), if you would like to implement support for a new platform for Vty, see `PLATFORM-HOWTO.md`. # Features * Provides an efficient output algorithm. Output buffering and terminal state changes are minimized. * Automatically handles window resizes. * Minimizes repaint area, which virtually eliminates the flicker problems that plague ncurses programs. * Provides a pure, compositional interface for efficiently constructing display images. * Automatically supports refresh on Ctrl-L. * Provides extensible input and output interfaces. * Properly handles cleanup (but not due to signals). * 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 * Supports bracketed paste mode as described at http://cirw.in/blog/bracketed-paste * Supports multi-column Unicode characters such as emoji characters. In cases where Vty and your terminal emulator disagree on character widths, Vty provides a tool `vty-build-width-table` and library functionality to build a width table that will work for your terminal and load it on application startup. # Development Notes Vty uses threads internally, so programs made with Vty need to be compiled with the threaded runtime using the GHC `-threaded` option. # Multi-Column Character Support Vty supports rendering of multi-column characters such as two-column Asian characters and Emoji characters. This section details how to take advantage of this feature, since its behavior will depend on the terminal emulator in use. Terminal emulators support Unicode to varying degrees, and each terminal emulator relies on a table of column widths for each supported Unicode character. Vty also needs to rely on such a table to compute the width of Vty images to do image layout. Since those tables can disagree if Vty and the terminal emulator support different versions of Unicode, and since different terminal emulators will support different versions of Unicode, it's likely that for some wide characters, Vty applications will exhibit rendering problems. Those rendering problems arise from Vty and the terminal emulator coming to different conclusions about how wide some characters are. To address this, Vty supports loading custom character width tables that are based on the terminal's behavior in order to eliminate these disagreements. By default, though, Vty will use its built-in Unicode character width table. Since the built-in table is likely to eventually disagree with your terminal, Vty provides an API and a command-line tool to generate and install custom tables. Custom Unicode width tables based on your terminal emulator can be built by using the API in `Graphics.Vty.UnicodeWidthTable`. The process works by querying the current terminal environment to obtain its width measurements for the entire supported Unicode range. The results are then saved to a disk file. Saved width tables can then be loaded in one of two ways: * Via the library API in `Graphics.Vty.UnicodeWidthTable.IO` * By adding a `widthMap` directive to your Vty configuration file and then invoking `mkVty` to initialize Vty The Vty configuration file supports the `widthMap` directive to allow users to specify which custom width table should be loaded for a given terminal type. This is done by specifying, e.g., ``` widthMap "xterm" "/path/to/map.dat" ``` where the first argument is the value that `TERM` must have in order for the table to be loaded, and the second argument is the path to the table file itself as generated by the two alternatives listed above. If the Vty configuration file contains multiple matching `widthMap` directives for the current value of `TERM`, the last one listed in the file is used. The tables declared in the configuration file are only ever automatically loaded when applications set up Vty by calling `Graphics.Vty.mkVty`. Before a custom table has been loaded, calls to the library's character width functions (e.g. `wcwidth`) will use the default built-in table. Once a custom table has been loaded, the functions will use the new custom table. Only one custom table load can be performed in a Vty program. Once a custom table has been loaded, it cannot be replaced or removed. # Contributing If you decide to contribute, that's great! Here are some guidelines you should consider to make submitting patches easier for all concerned: - Please ensure that the examples and test suites build along with the library by running `build.sh` in the repository. - 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. # Further Reading 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 vty-6.1/Setup.lhs0000644000000000000000000000011307346545000012176 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMainvty-6.1/cbits/0000755000000000000000000000000007346545000011477 5ustar0000000000000000vty-6.1/cbits/mk_wcwidth.c0000644000000000000000000003311407346545000014005 0ustar0000000000000000/* * This is an implementation of wcwidth() and wcswidth() (defined in * IEEE Std 1002.1-2001) for Unicode. * * http://www.opengroup.org/onlinepubs/007904975/functions/wcwidth.html * http://www.opengroup.org/onlinepubs/007904975/functions/wcswidth.html * * In fixed-width output devices, Latin characters all occupy a single * "cell" position of equal width, whereas ideographic CJK characters * occupy two such cells. Interoperability between terminal-line * applications and (teletype-style) character terminals using the * UTF-8 encoding requires agreement on which character should advance * the cursor by how many cell positions. No established formal * standards exist at present on which Unicode character shall occupy * how many cell positions on character terminals. These routines are * a first attempt of defining such behavior based on simple rules * applied to data provided by the Unicode Consortium. * * For some graphical characters, the Unicode standard explicitly * defines a character-cell width via the definition of the East Asian * FullWidth (F), Wide (W), Half-width (H), and Narrow (Na) classes. * In all these cases, there is no ambiguity about which width a * terminal shall use. For characters in the East Asian Ambiguous (A) * class, the width choice depends purely on a preference of backward * compatibility with either historic CJK or Western practice. * Choosing single-width for these characters is easy to justify as * the appropriate long-term solution, as the CJK practice of * displaying these characters as double-width comes from historic * implementation simplicity (8-bit encoded characters were displayed * single-width and 16-bit ones double-width, even for Greek, * Cyrillic, etc.) and not any typographic considerations. * * Much less clear is the choice of width for the Not East Asian * (Neutral) class. Existing practice does not dictate a width for any * of these characters. It would nevertheless make sense * typographically to allocate two character cells to characters such * as for instance EM SPACE or VOLUME INTEGRAL, which cannot be * represented adequately with a single-width glyph. The following * routines at present merely assign a single-cell width to all * neutral characters, in the interest of simplicity. This is not * entirely satisfactory and should be reconsidered before * establishing a formal standard in this area. At the moment, the * decision which Not East Asian (Neutral) characters should be * represented by double-width glyphs cannot yet be answered by * applying a simple rule from the Unicode database content. Setting * up a proper standard for the behavior of UTF-8 character terminals * will require a careful analysis not only of each Unicode character, * but also of each presentation form, something the author of these * routines has avoided to do so far. * * http://www.unicode.org/unicode/reports/tr11/ * * Markus Kuhn -- 2007-05-26 (Unicode 5.0) * * Permission to use, copy, modify, and distribute this software * for any purpose and without fee is hereby granted. The author * disclaims all warranties with regard to this software. * * Latest version: http://www.cl.cam.ac.uk/~mgk25/ucs/wcwidth.c */ #include #include #include // The maximum size for a custom character width table is the total // number of possible characters as dictated by the compiler. #define MAX_CUSTOM_TABLE_SIZE (HS_CHAR_MAX + 1) // The pointer to the start of the custom character width table, if // any. If this is NULL or this is set but the ready flag is false, the // built-in tree search logic is used. static uint8_t* custom_table = NULL; // The size of the custom table, in entries. This should only be set // if custom_table is not NULL. Its value should be the size of the // custom_table array. static uint32_t custom_table_size = 0; // A flag indicating whether the custom table is ready for // use. This should only be set once the table has been // allocated with vty_init_custom_table and initialized with // vty_set_custom_table_range. static uint8_t custom_table_ready = 0; struct interval { int first; int last; }; /* auxiliary function for binary search in interval table */ static int vty_bisearch(HsChar ucs, const struct interval *table, int max) { int min = 0; int mid; if (ucs < table[0].first || ucs > table[max].last) return 0; while (max >= min) { mid = (min + max) / 2; if (ucs > table[mid].last) min = mid + 1; else if (ucs < table[mid].first) max = mid - 1; else return 1; } return 0; } /* The following two functions define the column width of an ISO 10646 * character as follows: * * - The null character (U+0000) has a column width of 0. * * - Other C0/C1 control characters and DEL will lead to a return * value of -1. * * - Non-spacing and enclosing combining characters (general * category code Mn or Me in the Unicode database) have a * column width of 0. * * - SOFT HYPHEN (U+00AD) has a column width of 1. * * - Other format characters (general category code Cf in the Unicode * database) and ZERO WIDTH SPACE (U+200B) have a column width of 0. * * - Hangul Jamo medial vowels and final consonants (U+1160-U+11FF) * have a column width of 0. * * - Spacing characters in the East Asian Wide (W) or East Asian * Full-width (F) category as defined in Unicode Technical * Report #11 have a column width of 2. * * - All remaining characters (including all printable * ISO 8859-1 and WGL4 characters, Unicode control characters, * etc.) have a column width of 1. * * This implementation assumes that wchar_t characters are encoded * in ISO 10646. */ static HsInt builtin_wcwidth(HsChar ucs) { /* sorted list of non-overlapping intervals of non-spacing characters */ /* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c" */ static const struct interval combining[] = { { 0x0300, 0x036F }, { 0x0483, 0x0486 }, { 0x0488, 0x0489 }, { 0x0591, 0x05BD }, { 0x05BF, 0x05BF }, { 0x05C1, 0x05C2 }, { 0x05C4, 0x05C5 }, { 0x05C7, 0x05C7 }, { 0x0600, 0x0603 }, { 0x0610, 0x0615 }, { 0x064B, 0x065E }, { 0x0670, 0x0670 }, { 0x06D6, 0x06E4 }, { 0x06E7, 0x06E8 }, { 0x06EA, 0x06ED }, { 0x070F, 0x070F }, { 0x0711, 0x0711 }, { 0x0730, 0x074A }, { 0x07A6, 0x07B0 }, { 0x07EB, 0x07F3 }, { 0x0901, 0x0902 }, { 0x093C, 0x093C }, { 0x0941, 0x0948 }, { 0x094D, 0x094D }, { 0x0951, 0x0954 }, { 0x0962, 0x0963 }, { 0x0981, 0x0981 }, { 0x09BC, 0x09BC }, { 0x09C1, 0x09C4 }, { 0x09CD, 0x09CD }, { 0x09E2, 0x09E3 }, { 0x0A01, 0x0A02 }, { 0x0A3C, 0x0A3C }, { 0x0A41, 0x0A42 }, { 0x0A47, 0x0A48 }, { 0x0A4B, 0x0A4D }, { 0x0A70, 0x0A71 }, { 0x0A81, 0x0A82 }, { 0x0ABC, 0x0ABC }, { 0x0AC1, 0x0AC5 }, { 0x0AC7, 0x0AC8 }, { 0x0ACD, 0x0ACD }, { 0x0AE2, 0x0AE3 }, { 0x0B01, 0x0B01 }, { 0x0B3C, 0x0B3C }, { 0x0B3F, 0x0B3F }, { 0x0B41, 0x0B43 }, { 0x0B4D, 0x0B4D }, { 0x0B56, 0x0B56 }, { 0x0B82, 0x0B82 }, { 0x0BC0, 0x0BC0 }, { 0x0BCD, 0x0BCD }, { 0x0C3E, 0x0C40 }, { 0x0C46, 0x0C48 }, { 0x0C4A, 0x0C4D }, { 0x0C55, 0x0C56 }, { 0x0CBC, 0x0CBC }, { 0x0CBF, 0x0CBF }, { 0x0CC6, 0x0CC6 }, { 0x0CCC, 0x0CCD }, { 0x0CE2, 0x0CE3 }, { 0x0D41, 0x0D43 }, { 0x0D4D, 0x0D4D }, { 0x0DCA, 0x0DCA }, { 0x0DD2, 0x0DD4 }, { 0x0DD6, 0x0DD6 }, { 0x0E31, 0x0E31 }, { 0x0E34, 0x0E3A }, { 0x0E47, 0x0E4E }, { 0x0EB1, 0x0EB1 }, { 0x0EB4, 0x0EB9 }, { 0x0EBB, 0x0EBC }, { 0x0EC8, 0x0ECD }, { 0x0F18, 0x0F19 }, { 0x0F35, 0x0F35 }, { 0x0F37, 0x0F37 }, { 0x0F39, 0x0F39 }, { 0x0F71, 0x0F7E }, { 0x0F80, 0x0F84 }, { 0x0F86, 0x0F87 }, { 0x0F90, 0x0F97 }, { 0x0F99, 0x0FBC }, { 0x0FC6, 0x0FC6 }, { 0x102D, 0x1030 }, { 0x1032, 0x1032 }, { 0x1036, 0x1037 }, { 0x1039, 0x1039 }, { 0x1058, 0x1059 }, { 0x1160, 0x11FF }, { 0x135F, 0x135F }, { 0x1712, 0x1714 }, { 0x1732, 0x1734 }, { 0x1752, 0x1753 }, { 0x1772, 0x1773 }, { 0x17B4, 0x17B5 }, { 0x17B7, 0x17BD }, { 0x17C6, 0x17C6 }, { 0x17C9, 0x17D3 }, { 0x17DD, 0x17DD }, { 0x180B, 0x180D }, { 0x18A9, 0x18A9 }, { 0x1920, 0x1922 }, { 0x1927, 0x1928 }, { 0x1932, 0x1932 }, { 0x1939, 0x193B }, { 0x1A17, 0x1A18 }, { 0x1B00, 0x1B03 }, { 0x1B34, 0x1B34 }, { 0x1B36, 0x1B3A }, { 0x1B3C, 0x1B3C }, { 0x1B42, 0x1B42 }, { 0x1B6B, 0x1B73 }, { 0x1DC0, 0x1DCA }, { 0x1DFE, 0x1DFF }, { 0x200B, 0x200F }, { 0x202A, 0x202E }, { 0x2060, 0x2063 }, { 0x206A, 0x206F }, { 0x20D0, 0x20EF }, { 0x302A, 0x302F }, { 0x3099, 0x309A }, { 0xA806, 0xA806 }, { 0xA80B, 0xA80B }, { 0xA825, 0xA826 }, { 0xFB1E, 0xFB1E }, { 0xFE00, 0xFE0F }, { 0xFE20, 0xFE23 }, { 0xFEFF, 0xFEFF }, { 0xFFF9, 0xFFFB }, { 0x10A01, 0x10A03 }, { 0x10A05, 0x10A06 }, { 0x10A0C, 0x10A0F }, { 0x10A38, 0x10A3A }, { 0x10A3F, 0x10A3F }, { 0x1D167, 0x1D169 }, { 0x1D173, 0x1D182 }, { 0x1D185, 0x1D18B }, { 0x1D1AA, 0x1D1AD }, { 0x1D242, 0x1D244 }, { 0xE0001, 0xE0001 }, { 0xE0020, 0xE007F }, { 0xE0100, 0xE01EF } }; /* test for 8-bit control characters */ if (ucs == 0) return 0; if (ucs < 32 || (ucs >= 0x7f && ucs < 0xa0)) return -1; /* binary search in table of non-spacing characters */ if (vty_bisearch(ucs, combining, sizeof(combining) / sizeof(struct interval) - 1)) return 0; /* if we arrive here, ucs is not a combining or C0/C1 control character */ return 1 + (ucs >= 0x1100 && (ucs <= 0x115f || /* Hangul Jamo init. consonants */ ucs == 0x2329 || ucs == 0x232a || (ucs >= 0x2e80 && ucs <= 0xa4cf && ucs != 0x303f) || /* CJK ... Yi */ (ucs >= 0xac00 && ucs <= 0xd7a3) || /* Hangul Syllables */ (ucs >= 0xf900 && ucs <= 0xfaff) || /* CJK Compatibility Ideographs */ (ucs >= 0xfe10 && ucs <= 0xfe19) || /* Vertical forms */ (ucs >= 0xfe30 && ucs <= 0xfe6f) || /* CJK Compatibility Forms */ (ucs >= 0xff00 && ucs <= 0xff60) || /* Fullwidth Forms */ (ucs >= 0xffe0 && ucs <= 0xffe6) || (ucs >= 0x20000 && ucs <= 0x2fffd) || (ucs >= 0x30000 && ucs <= 0x3fffd))); } // Return the width, in terminal cells, of the specified character. // // If the global custom width table is present, that table will be // consulted for the character's width. If the character is not in // the table, zero will be returned. If the custom width table is not // present, the built-in width table will be used. HsInt vty_mk_wcwidth(HsChar ch) { if (custom_table_ready) { if ((ch >= 0) && (ch < custom_table_size)) { return custom_table[ch]; } else { return -1; } } else { return builtin_wcwidth(ch); } } // Initialize a custom character width table. // // This allocates a new character width table of the specified size // (in characters). If a custom table has already been allocated, this // returns 1. Otherwise it allocates a new table, initializes all of its // entries to 1, and returns zero. // // Note that this does *not* mark the table as ready for use. Until the // table is marked ready, it will not be used by vty_mk_wcwidth. To mark // the table as ready, call vty_activate_custom_table() after the table // has been set up with calls to vty_set_custom_table_range. int vty_init_custom_table(int size) { if (custom_table == NULL) { if (size > 0 && size <= MAX_CUSTOM_TABLE_SIZE) { custom_table_ready = 0; custom_table = malloc(size); memset(custom_table, 1, size); custom_table_size = size; return 0; } else { return 1; } } else { return 1; } } // Set the specified character range in the custom width table to the // specified width. // // This function sets 'width' as the character width for all entries // in the custom character table starting at the 'start' entry and // including all entries up to and including 'start + size - 1'. // // If this succeeds, it returns zero. If it fails, it returns 1. It // fails if the table is not allocated, marked as ready (i.e. it is in // use and has already been populated), or if the start or size values // are not in bounds for the table. int vty_set_custom_table_range(uint32_t start, uint32_t size, uint8_t width) { if ((custom_table == NULL) || (size >= custom_table_size) || (start >= custom_table_size) || ((start + 1) >= (custom_table_size - size)) || custom_table_ready) { return 1; } else { memset(custom_table + start, width, size); return 0; } } // Mark the allocated custom character width table as ready for use. // // After this call, further calls to vty_set_custom_table_range will // fail. // // This function returns 0 if it succeeds. If it fails, it returns 1. // It fails if the custom table is already ready or if it has not been // allocated. int vty_activate_custom_table() { if (custom_table_ready || (custom_table == NULL)) { return 1; } else { custom_table_ready = 1; return 0; } } // Returns whether a custom character width table has been marked ready. int vty_custom_table_ready() { return custom_table_ready; } // Deallocate the custom width table. // // This does nothing if there is no allocated custom width table, or if // there is one but it is in use (marked ready). This is only useful if // an initial allocation succeeds, but range population fails, after // which point the application may want to deallocate the table to avoid // leaving it in an intermediate state. void vty_deallocate_custom_table() { if ((custom_table != NULL) && (!custom_table_ready)) { free(custom_table); custom_table = NULL; custom_table_size = 0; } } vty-6.1/src/Graphics/Text/0000755000000000000000000000000007346545000013646 5ustar0000000000000000vty-6.1/src/Graphics/Text/Width.hs0000644000000000000000000000376507346545000015274 0ustar0000000000000000-- Copyright 2009 Corey O'Connor {-# OPTIONS_GHC -D_XOPEN_SOURCE #-} {-# LANGUAGE ForeignFunctionInterface #-} -- | This module provides functions to measure the terminal column width -- of characters and strings. -- -- The functions provided in this module all ultimately make calls to -- the C implementation in @cbits/mk_wcwidth.c@. That code manages some -- global state that carries a table of Unicode character widths. For -- more details, see 'Graphics.Vty.UnicodeWidthTable.Install', the C -- code, and the "Multi-Column Character Support" section of the project -- @README@. module Graphics.Text.Width ( wcwidth , wcswidth , wctwidth , wctlwidth , safeWcwidth , safeWcswidth , safeWctwidth , safeWctlwidth ) where import Data.List (foldl') import qualified Data.Text as T import qualified Data.Text.Lazy as TL foreign import ccall unsafe "vty_mk_wcwidth" wcwidth :: Char -> Int wcswidth :: String -> Int wcswidth = foldl' (\l c -> wcwidth c + l) 0 {-# INLINE [1] wcswidth #-} wctwidth :: T.Text -> Int wctwidth = T.foldl' (\l c -> wcwidth c + l) 0 wctlwidth :: TL.Text -> Int wctlwidth = TL.foldl' (\l c -> wcwidth c + l) 0 {-# RULES "wcswidth/unpack" forall x. wcswidth (T.unpack x) = wctwidth x "wcswidth/lazy-unpack" forall x. wcswidth (TL.unpack x) = wctlwidth x #-} -- | 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. safeWcswidth :: String -> Int safeWcswidth = foldl' (\l c -> safeWcwidth c + l) 0 -- | Returns the display width of a text. Assumes all characters with -- unknown widths are 0 width. safeWctwidth :: T.Text -> Int safeWctwidth = T.foldl' (\l c -> safeWcwidth c + l) 0 -- | Returns the display width of a lazy text. Assumes all characters -- with unknown widths are 0 width. safeWctlwidth :: TL.Text -> Int safeWctlwidth = TL.foldl' (\l c -> safeWcwidth c + l) 0 vty-6.1/src/Graphics/0000755000000000000000000000000007346545000012722 5ustar0000000000000000vty-6.1/src/Graphics/Vty.hs0000644000000000000000000002364007346545000014045 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Vty provides interfaces for both terminal input and terminal -- output. -- -- - User input to the terminal is provided to the Vty application as a -- sequence of 'Event's. -- -- - Output is provided to by the application to Vty 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. -- -- - Each platform on which Vty is supported provides a package that -- provides Vty with access to the platform-specific terminal -- interface. For example, on Unix systems, the @vty-unix@ package -- must be used to initialize Vty with access to a Unix terminal. -- -- As a small example, the following program demonstrates the use of Vty -- on a Unix system using the @vty-unix@ package: -- -- > import Graphics.Vty -- > import Graphics.Vty.Platform.Unix (mkVty) -- > -- > main = do -- > vty <- mkVty defaultConfig -- > let line0 = string (defAttr `withForeColor` green) "first line" -- > line1 = string (defAttr `withBackColor` blue) "second line" -- > img = line0 <-> line1 -- > pic = picForImage img -- > update vty pic -- > e <- nextEvent vty -- > shutdown vty -- > print ("Last event was: " ++ show e) -- -- Vty uses threads internally, so programs made with Vty must be -- compiled with the threaded runtime using the GHC @-threaded@ option. module Graphics.Vty ( Vty(..) , setWindowTitle , installCustomWidthTable , mkVtyFromPair , module Graphics.Vty.Config , module Graphics.Vty.Input , module Graphics.Vty.Input.Events , module Graphics.Vty.Output , module Graphics.Vty.Picture , module Graphics.Vty.Image , module Graphics.Vty.Attributes ) where import Graphics.Vty.Config import Graphics.Vty.Input import Graphics.Vty.Input.Events import Graphics.Vty.Output import Graphics.Vty.Picture import Graphics.Vty.Image import Graphics.Vty.Attributes import Graphics.Vty.UnicodeWidthTable.IO import Graphics.Vty.UnicodeWidthTable.Install import qualified Control.Exception as E import Control.Monad (when) import Control.Concurrent.STM import Data.IORef #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif -- | A 'Vty' value represents a handle to the Vty library that the -- application must create in order to use Vty. -- -- The use of this library typically follows this process: -- -- 1. Initialize Vty with the 'mkVty' implementation for your -- platform's Vty package (e.g. @vty-unix@), or, more generically, with -- 'mkVtyFromPair'. This takes control of (and sets up) the terminal. -- -- 2. Use 'update' to display a picture. -- -- 3. Use 'nextEvent' to get the next input event. -- -- 4. Depending on the event, go to 2 or 5. -- -- 5. Shutdown Vty and restore the terminal state with 'shutdown'. At -- this point the 'Vty' handle cannot be used again. -- -- Operations on Vty handles are not thread-safe. data Vty = Vty { update :: Picture -> IO () -- ^ Output the given 'Picture' to the terminal. , nextEvent :: IO Event -- ^ Return the next 'Event' or block until one becomes -- available. , nextEventNonblocking :: IO (Maybe Event) -- ^ Non-blocking version of 'nextEvent'. , inputIface :: Input -- ^ The input interface. See 'Input'. , outputIface :: Output -- ^ The output interface. See 'Output'. , refresh :: IO () -- ^ Refresh the display. If other programs output to the -- terminal and mess up the display then the application might -- want to force a refresh using this function. , 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. Idempotent. , isShutdown :: IO Bool } -- | Attempt to load and install a custom character width table into -- this process. -- -- This looks up the specified terminal name in the specified width -- table map and, if a map file path is found, the map is loaded and -- installed. This is exposed for Vty platform package implementors; -- application developers should never need to call this. installCustomWidthTable :: Maybe FilePath -- ^ Optional path to a log file where log -- messages should be written when attempting to -- load a width table. -> Maybe String -- ^ Optional width table entry name (usually -- the terminal name, e.g. value of @TERM@ on -- Unix systems). If omitted, this function does -- not attempt to load a table. -> [(String, FilePath)] -- ^ Mapping from width table entry names to -- width table file paths. This is usually -- obtained from 'configTermWidthMaps' of -- 'VtyUserConfig'. -> IO () installCustomWidthTable logPath tblName widthMaps = do let doLog s = case logPath of Nothing -> return () Just path -> appendFile path $ "installWidthTable: " <> s <> "\n" customInstalled <- isCustomTableReady when (not customInstalled) $ do case tblName of Nothing -> doLog "No terminal name given in the configuration, skipping load" Just name -> case lookup name widthMaps of Nothing -> doLog $ "Width table " <> show name <> " not found in custom character width mapping list" Just path -> do tableResult <- E.try $ readUnicodeWidthTable path case tableResult of Left (e::E.SomeException) -> doLog $ "Error reading custom character width table " <> "at " <> show path <> ": " <> show e Right (Left msg) -> doLog $ "Error reading custom character width table " <> "at " <> show path <> ": " <> msg Right (Right table) -> do installResult <- E.try $ installUnicodeWidthTable table case installResult of Left (e::E.SomeException) -> doLog $ "Error installing unicode table (" <> show path <> ": " <> show e Right () -> doLog $ "Successfully installed Unicode width table " <> " from " <> show path -- | Build a 'Vty' handle from an input/output pair. -- -- This is exposed for Vty platform package implementors; application -- developers should never need to call this, and should instead call -- @mkVty@ or equivalent from their platform package of choice. mkVtyFromPair :: Input -> Output -> IO Vty mkVtyFromPair input out = do reserveDisplay out shutdownVar <- newTVarIO False let shutdownIo = do alreadyShutdown <- atomically $ swapTVar shutdownVar True when (not alreadyShutdown) $ do shutdownInput input releaseDisplay out releaseTerminal out shutdownStatus = readTVarIO shutdownVar lastPicRef <- newIORef Nothing lastUpdateRef <- newIORef Nothing let innerUpdate inPic = do b <- displayBounds out mlastUpdate <- readIORef lastUpdateRef updateData <- case mlastUpdate of Nothing -> do dc <- displayContext out b outputPicture dc inPic return (b, dc) Just (lastBounds, lastContext) -> do if b /= lastBounds then do dc <- displayContext out b outputPicture dc inPic return (b, dc) else do outputPicture lastContext inPic return (b, lastContext) writeIORef lastUpdateRef $ Just updateData writeIORef lastPicRef $ Just inPic innerRefresh = do writeIORef lastUpdateRef Nothing bounds <- displayBounds out dc <- displayContext out bounds writeIORef (assumedStateRef $ contextDevice dc) initialAssumedState mPic <- readIORef lastPicRef maybe (return ()) innerUpdate mPic mkResize = uncurry EvResize <$> displayBounds out translateInternalEvent ResumeAfterInterrupt = mkResize translateInternalEvent (InputEvent e) = return e gkey = do e <- atomically $ readTChan $ eventChannel input translateInternalEvent e gkey' = do mEv <- atomically $ tryReadTChan $ eventChannel input case mEv of Just e -> Just <$> translateInternalEvent e Nothing -> return Nothing return $ Vty { update = innerUpdate , nextEvent = gkey , nextEventNonblocking = gkey' , inputIface = input , outputIface = out , refresh = innerRefresh , shutdown = shutdownIo , isShutdown = shutdownStatus } -- | Set the terminal window title string. setWindowTitle :: Vty -> String -> IO () setWindowTitle vty title = setOutputWindowTitle (outputIface vty) title vty-6.1/src/Graphics/Vty/0000755000000000000000000000000007346545000013504 5ustar0000000000000000vty-6.1/src/Graphics/Vty/Attributes.hs0000644000000000000000000001531307346545000016171 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} -- | Display 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 -- @ -- -- '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" -- @ -- -- 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. -- -- The value 'currentAttr' will keep the attributes of whatever was -- output previously. module Graphics.Vty.Attributes ( module Graphics.Vty.Attributes.Color , Attr(..) , FixedAttr(..) , MaybeDefault(..) , defAttr , currentAttr -- * Styles , Style , withStyle , standout , italic , strikethrough , underline , reverseVideo , blink , dim , bold , defaultStyleMask , styleMask , hasStyle -- * Setting attribute colors , withForeColor , withBackColor -- * Setting hyperlinks , withURL ) where import Control.DeepSeq import Data.Bits import Data.Text (Text) import Data.Word import GHC.Generics import Graphics.Vty.Attributes.Color -- | 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. data Attr = Attr { attrStyle :: !(MaybeDefault Style) , attrForeColor :: !(MaybeDefault Color) , attrBackColor :: !(MaybeDefault Color) , attrURL :: !(MaybeDefault Text) } deriving ( Eq, Show, Read, Generic, NFData ) -- 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 -- 01 => unchanged -- 10 => set -- YY - foreground color action -- 00 => reset to default -- 01 => unchanged -- 10 => set -- ZZ - background color action -- 00 => reset to default -- 01 => unchanged -- 10 => set -- __ - unused -- -- Next is the style flags -- SURBDOI_ -- S - standout -- U - underline -- R - reverse video -- B - blink -- D - dim -- O - bold -- I - italic -- _ - unused -- -- Then the foreground color encoded into 8 bits. -- Then the background color encoded into 8 bits. -- | 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) , fixedURL :: !(Maybe Text) } 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. data MaybeDefault v = Default | KeepCurrent | SetTo !v deriving (Eq, Read, Show) instance (NFData v) => NFData (MaybeDefault v) where rnf Default = () rnf KeepCurrent = () rnf (SetTo v) = rnf v -- | 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 -- | Valid style attributes include: -- -- * standout -- -- * underline -- -- * reverseVideo -- -- * blink -- -- * dim -- -- * bold/bright -- -- * italic -- -- * strikethrough (via the smxx/rmxx terminfo capabilities) -- -- (The invisible, protect, and altcharset display attributes some -- terminals support are not supported via VTY.) standout, underline, reverseVideo, blink, dim, bold, italic, strikethrough :: Style standout = 0x01 underline = 0x02 reverseVideo = 0x04 blink = 0x08 dim = 0x10 bold = 0x20 italic = 0x40 strikethrough = 0x80 defaultStyleMask :: Style defaultStyleMask = 0x00 styleMask :: Attr -> Word8 styleMask attr = case attrStyle attr of Default -> 0 KeepCurrent -> 0 SetTo v -> v -- | true if the given Style value has the specified Style set. hasStyle :: Style -> Style -> Bool hasStyle s bitMask = ( s .&. bitMask ) /= 0 -- | Set the foreground color of an `Attr'. withForeColor :: Attr -> Color -> Attr withForeColor attr c = attr { attrForeColor = SetTo c } -- | Set the background color of an `Attr'. withBackColor :: Attr -> Color -> Attr withBackColor attr c = attr { attrBackColor = SetTo c } -- | Add the given style attribute withStyle :: Attr -> Style -> Attr withStyle attr 0 = attr withStyle attr styleFlag = attr { attrStyle = SetTo $ styleMask attr .|. styleFlag } -- | Add a hyperlinked URL using the proposed [escape sequences for -- hyperlinked -- URLs](https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda). -- These escape sequences are comparatively new and aren't widely -- supported in terminal emulators yet, but most terminal emulators -- that don't know about these sequences will ignore these sequences, -- and therefore this should fall back sensibly. In some cases they -- won't and this will result in garbage, so this is why hyperlinking is -- disabled by default, in which case this combinator has no observable -- effect. To enable it, enable 'Hyperlink' mode on your Vty output -- interface. withURL :: Attr -> Text -> Attr withURL attr url = attr { attrURL = SetTo url } -- | 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 Default -- | 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. currentAttr :: Attr currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent KeepCurrent vty-6.1/src/Graphics/Vty/Attributes/0000755000000000000000000000000007346545000015632 5ustar0000000000000000vty-6.1/src/Graphics/Vty/Attributes/Color.hs0000644000000000000000000001240207346545000017243 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} module Graphics.Vty.Attributes.Color ( Color(..) , ColorMode(..) -- ** Fixed Colors -- | Standard 8-color ANSI terminal color codes. -- -- Note that these map to colors in the terminal's custom palette. For -- instance, `white` maps to whatever the terminal color theme uses for -- white. -- -- Use these functions if you want to make apps that fit the terminal theme. -- If you want access to more/stronger colors use `rgbColor` , black , red , green , yellow , blue , magenta , cyan , white -- | Bright/Vivid variants of the standard 8-color ANSI , brightBlack , brightRed , brightGreen , brightYellow , brightBlue , brightMagenta , brightCyan , brightWhite -- ** Creating Colors From RGB , linearColor , srgbColor , rgbColor , color240 , module Graphics.Vty.Attributes.Color240 ) where import Data.Word import GHC.Generics import Control.DeepSeq import Graphics.Vty.Attributes.Color240 -- | 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. -- -- * 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: -- -- * black (0) -- -- * red (1) -- -- * green (2) -- -- * yellow (3) -- -- * blue (4) -- -- * magenta (5) -- -- * cyan (6) -- -- * white (7) -- -- 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 palette. 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. -- -- 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 | RGBColor !Word8 !Word8 !Word8 deriving ( Eq, Show, Read, Generic, NFData ) data ColorMode = NoColor | ColorMode8 | ColorMode16 | ColorMode240 !Word8 | FullColor deriving ( Eq, Show, Read ) 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 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 -- | Create a color value from RGB values in the 0..255 range inclusive. -- No transformation of the input values is done; a color is created -- directly from the RGB values specified, unlike the 'srgbColor' and -- 'color240' functions. linearColor :: Integral i => i -> i -> i -> Color linearColor r g b = RGBColor r' g' b' where r' = fromIntegral (clamp r) :: Word8 g' = fromIntegral (clamp g) :: Word8 b' = fromIntegral (clamp b) :: Word8 clamp = min 255 . max 0 -- | Given RGB values in the range 0..255 inclusive, create a color -- using the sRGB transformation described at -- -- https://en.wikipedia.org/wiki/SRGB#The_reverse_transformation srgbColor :: Integral i => i -> i -> i -> Color srgbColor r g b = -- TODO: it may be worth translating this to a lookup table, as with color240 let shrink n = fromIntegral n / 255 :: Double -- called gamma^-1 in wiki gamma u | u <= 0.04045 = u/12.92 | otherwise = ((u + 0.055) / 1.055) ** 2.4 -- TODO: this is a slightly inaccurate conversion. is it worth doing proterly? expand n = round (255 * n) convert = expand . gamma . shrink in RGBColor (convert r) (convert g) (convert b) color240 :: Integral i => i -> i -> i -> Color color240 r g b = Color240 (rgbColorToColor240 r g b) -- | Create a Vty 'Color' (in the 240 color set) from an RGB triple. -- This is a synonym for 'color240'. This function is lossy in the sense -- that we only internally support 240 colors but the #RRGGBB format -- supports 256^3 colors. rgbColor :: Integral i => i -> i -> i -> Color rgbColor = color240 vty-6.1/src/Graphics/Vty/Attributes/Color240.hs0000644000000000000000000002260307346545000017475 0ustar0000000000000000-- This header file was generated by ./256colres.pl module Graphics.Vty.Attributes.Color240 ( rgbColorToColor240 , color240CodeToRGB ) where import Data.Word (Word8) import Text.Printf -- Note: rgbColor's mapping from RGB to 240 colors was generated from -- 256colres.pl which is forked from xterm 256colres.pl. -- | Create a value in the Color240 set from an RGB triple. This maps -- the input arguments to an entry in the 240-color palette depicted at: -- -- https://rich.readthedocs.io/en/stable/appendix/colors.html rgbColorToColor240 :: Integral i => i -> i -> i -> Word8 rgbColorToColor240 r g b | r < 0 && g < 0 && b < 0 = error "rgbColor with negative color component intensity" | r == 8 && g == 8 && b == 8 = 216 | r == 18 && g == 18 && b == 18 = 217 | r == 28 && g == 28 && b == 28 = 218 | r == 38 && g == 38 && b == 38 = 219 | r == 48 && g == 48 && b == 48 = 220 | r == 58 && g == 58 && b == 58 = 221 | r == 68 && g == 68 && b == 68 = 222 | r == 78 && g == 78 && b == 78 = 223 | r == 88 && g == 88 && b == 88 = 224 | r == 98 && g == 98 && b == 98 = 225 | r == 108 && g == 108 && b == 108 = 226 | r == 118 && g == 118 && b == 118 = 227 | r == 128 && g == 128 && b == 128 = 228 | r == 138 && g == 138 && b == 138 = 229 | r == 148 && g == 148 && b == 148 = 230 | r == 158 && g == 158 && b == 158 = 231 | r == 168 && g == 168 && b == 168 = 232 | r == 178 && g == 178 && b == 178 = 233 | r == 188 && g == 188 && b == 188 = 234 | r == 198 && g == 198 && b == 198 = 235 | r == 208 && g == 208 && b == 208 = 236 | r == 218 && g == 218 && b == 218 = 237 | r == 228 && g == 228 && b == 228 = 238 | r == 238 && g == 238 && b == 238 = 239 | otherwise = 36 * go r + 6 * go g + go b where go = simpleColor_ (error (printf "RGB color %d %d %d does not map to 240 palette." (fromIntegral r :: Int) (fromIntegral g :: Int) (fromIntegral b :: Int))) simpleColor_ :: Integral i => Word8 -> i -> Word8 simpleColor_ e c | c <= 0 = 0 | c <= 95 = 1 | c <= 255 = fromIntegral ((c-16) `div` 40) | otherwise = e -- | Create a RGB triple from a value in the Color240 set. color240CodeToRGB :: Word8 -> Maybe (Int, Int, Int) color240CodeToRGB n = case n of 0 -> Just (0, 0, 0) 1 -> Just (0, 0, 95) 2 -> Just (0, 0, 135) 3 -> Just (0, 0, 175) 4 -> Just (0, 0, 215) 5 -> Just (0, 0, 255) 6 -> Just (0, 95, 0) 7 -> Just (0, 95, 95) 8 -> Just (0, 95, 135) 9 -> Just (0, 95, 175) 10 -> Just (0, 95, 215) 11 -> Just (0, 95, 255) 12 -> Just (0, 135, 0) 13 -> Just (0, 135, 95) 14 -> Just (0, 135, 135) 15 -> Just (0, 135, 175) 16 -> Just (0, 135, 215) 17 -> Just (0, 135, 255) 18 -> Just (0, 175, 0) 19 -> Just (0, 175, 95) 20 -> Just (0, 175, 135) 21 -> Just (0, 175, 175) 22 -> Just (0, 175, 215) 23 -> Just (0, 175, 255) 24 -> Just (0, 215, 0) 25 -> Just (0, 215, 95) 26 -> Just (0, 215, 135) 27 -> Just (0, 215, 175) 28 -> Just (0, 215, 215) 29 -> Just (0, 215, 255) 30 -> Just (0, 255, 0) 31 -> Just (0, 255, 95) 32 -> Just (0, 255, 135) 33 -> Just (0, 255, 175) 34 -> Just (0, 255, 215) 35 -> Just (0, 255, 255) 36 -> Just (95, 0, 0) 37 -> Just (95, 0, 95) 38 -> Just (95, 0, 135) 39 -> Just (95, 0, 175) 40 -> Just (95, 0, 215) 41 -> Just (95, 0, 255) 42 -> Just (95, 95, 0) 43 -> Just (95, 95, 95) 44 -> Just (95, 95, 135) 45 -> Just (95, 95, 175) 46 -> Just (95, 95, 215) 47 -> Just (95, 95, 255) 48 -> Just (95, 135, 0) 49 -> Just (95, 135, 95) 50 -> Just (95, 135, 135) 51 -> Just (95, 135, 175) 52 -> Just (95, 135, 215) 53 -> Just (95, 135, 255) 54 -> Just (95, 175, 0) 55 -> Just (95, 175, 95) 56 -> Just (95, 175, 135) 57 -> Just (95, 175, 175) 58 -> Just (95, 175, 215) 59 -> Just (95, 175, 255) 60 -> Just (95, 215, 0) 61 -> Just (95, 215, 95) 62 -> Just (95, 215, 135) 63 -> Just (95, 215, 175) 64 -> Just (95, 215, 215) 65 -> Just (95, 215, 255) 66 -> Just (95, 255, 0) 67 -> Just (95, 255, 95) 68 -> Just (95, 255, 135) 69 -> Just (95, 255, 175) 70 -> Just (95, 255, 215) 71 -> Just (95, 255, 255) 72 -> Just (135, 0, 0) 73 -> Just (135, 0, 95) 74 -> Just (135, 0, 135) 75 -> Just (135, 0, 175) 76 -> Just (135, 0, 215) 77 -> Just (135, 0, 255) 78 -> Just (135, 95, 0) 79 -> Just (135, 95, 95) 80 -> Just (135, 95, 135) 81 -> Just (135, 95, 175) 82 -> Just (135, 95, 215) 83 -> Just (135, 95, 255) 84 -> Just (135, 135, 0) 85 -> Just (135, 135, 95) 86 -> Just (135, 135, 135) 87 -> Just (135, 135, 175) 88 -> Just (135, 135, 215) 89 -> Just (135, 135, 255) 90 -> Just (135, 175, 0) 91 -> Just (135, 175, 95) 92 -> Just (135, 175, 135) 93 -> Just (135, 175, 175) 94 -> Just (135, 175, 215) 95 -> Just (135, 175, 255) 96 -> Just (135, 215, 0) 97 -> Just (135, 215, 95) 98 -> Just (135, 215, 135) 99 -> Just (135, 215, 175) 100 -> Just (135, 215, 215) 101 -> Just (135, 215, 255) 102 -> Just (135, 255, 0) 103 -> Just (135, 255, 95) 104 -> Just (135, 255, 135) 105 -> Just (135, 255, 175) 106 -> Just (135, 255, 215) 107 -> Just (135, 255, 255) 108 -> Just (175, 0, 0) 109 -> Just (175, 0, 95) 110 -> Just (175, 0, 135) 111 -> Just (175, 0, 175) 112 -> Just (175, 0, 215) 113 -> Just (175, 0, 255) 114 -> Just (175, 95, 0) 115 -> Just (175, 95, 95) 116 -> Just (175, 95, 135) 117 -> Just (175, 95, 175) 118 -> Just (175, 95, 215) 119 -> Just (175, 95, 255) 120 -> Just (175, 135, 0) 121 -> Just (175, 135, 95) 122 -> Just (175, 135, 135) 123 -> Just (175, 135, 175) 124 -> Just (175, 135, 215) 125 -> Just (175, 135, 255) 126 -> Just (175, 175, 0) 127 -> Just (175, 175, 95) 128 -> Just (175, 175, 135) 129 -> Just (175, 175, 175) 130 -> Just (175, 175, 215) 131 -> Just (175, 175, 255) 132 -> Just (175, 215, 0) 133 -> Just (175, 215, 95) 134 -> Just (175, 215, 135) 135 -> Just (175, 215, 175) 136 -> Just (175, 215, 215) 137 -> Just (175, 215, 255) 138 -> Just (175, 255, 0) 139 -> Just (175, 255, 95) 140 -> Just (175, 255, 135) 141 -> Just (175, 255, 175) 142 -> Just (175, 255, 215) 143 -> Just (175, 255, 255) 144 -> Just (215, 0, 0) 145 -> Just (215, 0, 95) 146 -> Just (215, 0, 135) 147 -> Just (215, 0, 175) 148 -> Just (215, 0, 215) 149 -> Just (215, 0, 255) 150 -> Just (215, 95, 0) 151 -> Just (215, 95, 95) 152 -> Just (215, 95, 135) 153 -> Just (215, 95, 175) 154 -> Just (215, 95, 215) 155 -> Just (215, 95, 255) 156 -> Just (215, 135, 0) 157 -> Just (215, 135, 95) 158 -> Just (215, 135, 135) 159 -> Just (215, 135, 175) 160 -> Just (215, 135, 215) 161 -> Just (215, 135, 255) 162 -> Just (215, 175, 0) 163 -> Just (215, 175, 95) 164 -> Just (215, 175, 135) 165 -> Just (215, 175, 175) 166 -> Just (215, 175, 215) 167 -> Just (215, 175, 255) 168 -> Just (215, 215, 0) 169 -> Just (215, 215, 95) 170 -> Just (215, 215, 135) 171 -> Just (215, 215, 175) 172 -> Just (215, 215, 215) 173 -> Just (215, 215, 255) 174 -> Just (215, 255, 0) 175 -> Just (215, 255, 95) 176 -> Just (215, 255, 135) 177 -> Just (215, 255, 175) 178 -> Just (215, 255, 215) 179 -> Just (215, 255, 255) 180 -> Just (255, 0, 0) 181 -> Just (255, 0, 95) 182 -> Just (255, 0, 135) 183 -> Just (255, 0, 175) 184 -> Just (255, 0, 215) 185 -> Just (255, 0, 255) 186 -> Just (255, 95, 0) 187 -> Just (255, 95, 95) 188 -> Just (255, 95, 135) 189 -> Just (255, 95, 175) 190 -> Just (255, 95, 215) 191 -> Just (255, 95, 255) 192 -> Just (255, 135, 0) 193 -> Just (255, 135, 95) 194 -> Just (255, 135, 135) 195 -> Just (255, 135, 175) 196 -> Just (255, 135, 215) 197 -> Just (255, 135, 255) 198 -> Just (255, 175, 0) 199 -> Just (255, 175, 95) 200 -> Just (255, 175, 135) 201 -> Just (255, 175, 175) 202 -> Just (255, 175, 215) 203 -> Just (255, 175, 255) 204 -> Just (255, 215, 0) 205 -> Just (255, 215, 95) 206 -> Just (255, 215, 135) 207 -> Just (255, 215, 175) 208 -> Just (255, 215, 215) 209 -> Just (255, 215, 255) 210 -> Just (255, 255, 0) 211 -> Just (255, 255, 95) 212 -> Just (255, 255, 135) 213 -> Just (255, 255, 175) 214 -> Just (255, 255, 215) 215 -> Just (255, 255, 255) 216 -> Just (8, 8, 8) 217 -> Just (18, 18, 18) 218 -> Just (28, 28, 28) 219 -> Just (38, 38, 38) 220 -> Just (48, 48, 48) 221 -> Just (58, 58, 58) 222 -> Just (68, 68, 68) 223 -> Just (78, 78, 78) 224 -> Just (88, 88, 88) 225 -> Just (98, 98, 98) 226 -> Just (108, 108, 108) 227 -> Just (118, 118, 118) 228 -> Just (128, 128, 128) 229 -> Just (138, 138, 138) 230 -> Just (148, 148, 148) 231 -> Just (158, 158, 158) 232 -> Just (168, 168, 168) 233 -> Just (178, 178, 178) 234 -> Just (188, 188, 188) 235 -> Just (198, 198, 198) 236 -> Just (208, 208, 208) 237 -> Just (218, 218, 218) 238 -> Just (228, 228, 228) 239 -> Just (238, 238, 238) _ -> Nothing vty-6.1/src/Graphics/Vty/Config.hs0000644000000000000000000003627107346545000015256 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} -- | Vty supports a configuration file format and provides a -- corresponding 'VtyUserConfig' data type. The 'VtyUserConfig' can be -- provided to platform packages' @mkVty@ functions to customize the -- application's use of Vty. -- -- = Debug -- -- == @colorMode@ -- -- Format: -- -- @ -- colorMode \"|FullColor>\" -- @ -- -- The preferred color mode to use, chosen from the constructors of the -- 'ColorMode' type. If absent, the backend driver may detect and choose -- an appropriate color mode. Implementor's note: backend packages -- should respect this setting when it is present even when their -- detection indicates that a different color mode should be used. -- -- == @debugLog@ -- -- Format: -- -- @ -- \"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. -- -- = Input Processing -- -- == @map@ -- -- Format: -- -- @ -- \"map\" term string key modifier_list -- where -- key := KEsc | KChar Char | KBS ... (same as 'Key') -- modifier_list := \"[\" modifier+ \"]\" -- modifier := MShift | MCtrl | MMeta | MAlt -- term := "_" | string -- @ -- -- E.g., if the contents are -- -- @ -- map _ \"\\ESC[B\" KUp [] -- map _ \"\\ESC[1;3B\" KDown [MAlt] -- 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. 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@. -- -- = Unicode Character Width Maps -- -- == @widthMap@ -- -- Format: -- -- @ -- \"widthMap\" string string -- @ -- -- E.g., -- -- @ -- widthMap \"xterm\" \"\/home\/user\/.vty\/xterm\_map.dat\" -- @ -- -- This directive specifies the path to a Unicode character -- width map (the second argument) that should correspond to -- the terminal named by first argument. Unicode character -- width maps can be produced either by running platform -- packages' width table tools or by calling the library routine -- 'Graphics.Vty.UnicodeWidthTable.Query.buildUnicodeWidthTable'. Vty -- platform packages should use these configuration settings to attempt -- to load and install the specified width map. module Graphics.Vty.Config ( InputMap , VtyUserConfig(..) , userConfig , overrideEnvConfig , currentTerminalName , runParseConfig , parseConfigFile , defaultConfig , vtyConfigPath , widthTableFilename , vtyDataDirectory , terminalWidthTablePath , vtyConfigFileEnvName , ConfigUpdateResult(..) , addConfigWidthMap ) where import Prelude import Control.Applicative hiding (many) import Control.Exception (catch, IOException) import Control.Monad (liftM, guard, void) import qualified Data.ByteString as BS #if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (Monoid(..)) #endif #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup(..)) #endif import Text.Read (readMaybe) import Graphics.Vty.Attributes.Color (ColorMode(..)) import Graphics.Vty.Input.Events import GHC.Generics import System.Directory ( getAppUserDataDirectory, doesFileExist , createDirectoryIfMissing ) import System.Environment (lookupEnv) import System.FilePath ((), takeDirectory) import Text.Parsec hiding ((<|>)) import Text.Parsec.Token ( GenLanguageDef(..) ) import qualified Text.Parsec.Token as P -- | 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 core library configuration. Platform-specific details are not -- included in the VtyUserConfig. data VtyUserConfig = VtyUserConfig { configDebugLog :: Maybe FilePath -- ^ Debug information is appended to this file if not -- Nothing. , configInputMap :: InputMap -- ^ 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. , configTermWidthMaps :: [(String, FilePath)] -- ^ Terminal width map files. , configAllowCustomUnicodeWidthTables :: Maybe Bool -- ^ Whether to permit custom Unicode width table loading by -- 'Graphics.Vty.mkVty'. @'Just' 'False'@ indicates that -- table loading should not be performed. Other values permit -- table loading. -- -- If a table load is attempted and fails, information -- about the failure will be logged to the debug log if the -- configuration specifies one. If no custom table is loaded -- (or if a load fails), the built-in character width table -- will be used. , configPreferredColorMode :: Maybe ColorMode -- ^ Preferred color mode. If set, this should -- override platform color mode detection. } deriving (Show, Eq) defaultConfig :: VtyUserConfig defaultConfig = mempty instance Semigroup VtyUserConfig where c0 <> c1 = -- latter config takes priority for everything but inputMap VtyUserConfig { configDebugLog = configDebugLog c1 <|> configDebugLog c0 , configInputMap = configInputMap c0 <> configInputMap c1 , configTermWidthMaps = configTermWidthMaps c1 <|> configTermWidthMaps c0 , configAllowCustomUnicodeWidthTables = configAllowCustomUnicodeWidthTables c1 <|> configAllowCustomUnicodeWidthTables c0 , configPreferredColorMode = configPreferredColorMode c1 <|> configPreferredColorMode c0 } instance Monoid VtyUserConfig where mempty = VtyUserConfig { configDebugLog = mempty , configInputMap = mempty , configTermWidthMaps = [] , configAllowCustomUnicodeWidthTables = Nothing , configPreferredColorMode = Nothing } #if !(MIN_VERSION_base(4,11,0)) mappend = (<>) #endif vtyDataDirectory :: IO FilePath vtyDataDirectory = getAppUserDataDirectory "vty" vtyConfigPath :: IO FilePath vtyConfigPath = do dir <- vtyDataDirectory return $ dir "config" vtyConfigFileEnvName :: String vtyConfigFileEnvName = "VTY_CONFIG_FILE" -- | Load a configuration from 'vtyConfigPath' and @$VTY_CONFIG_FILE@. -- If none is found, build a default configuration. userConfig :: IO VtyUserConfig userConfig = do configFile <- vtyConfigPath >>= parseConfigFile overrideConfig <- maybe (return defaultConfig) parseConfigFile =<< lookupEnv vtyConfigFileEnvName let base = configFile <> overrideConfig mappend base <$> overrideEnvConfig widthTableFilename :: String -> String widthTableFilename term = "width_table_" <> term <> ".dat" termVariable :: String termVariable = "TERM" currentTerminalName :: IO (Maybe String) currentTerminalName = lookupEnv termVariable terminalWidthTablePath :: IO (Maybe FilePath) terminalWidthTablePath = do dataDir <- vtyDataDirectory result <- lookupEnv termVariable case result of Nothing -> return Nothing Just term -> do return $ Just $ dataDir widthTableFilename term overrideEnvConfig :: IO VtyUserConfig overrideEnvConfig = do d <- lookupEnv "VTY_DEBUG_LOG" return $ defaultConfig { configDebugLog = d } -- | Parse a Vty configuration file. -- -- Lines in config files that fail to parse are ignored. Later entries -- take precedence over earlier ones. parseConfigFile :: FilePath -> IO VtyUserConfig parseConfigFile path = do catch (runParseConfig path <$> BS.readFile path) (\(_ :: IOException) -> return defaultConfig) runParseConfig :: String -> BS.ByteString -> VtyUserConfig runParseConfig name cfgTxt = case runParser parseConfig () name cfgTxt of Right cfg -> cfg Left{} -> defaultConfig ------------------------------------------------------------------------ type Parser = Parsec BS.ByteString () configLanguage :: Monad m => P.GenLanguageDef BS.ByteString () m configLanguage = LanguageDef { commentStart = "{-" , commentEnd = "-}" , commentLine = "--" , nestedComments = True , identStart = letter <|> char '_' , identLetter = alphaNum <|> oneOf "_'" , opStart = opLetter configLanguage , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~" , reservedOpNames = [] , reservedNames = [] , caseSensitive = True } configLexer :: Monad m => P.GenTokenParser BS.ByteString () m configLexer = P.makeTokenParser configLanguage mapDecl :: Parser VtyUserConfig mapDecl = do "map" <- P.identifier configLexer termIdent <- (char '_' >> P.whiteSpace configLexer >> return Nothing) <|> (Just <$> P.stringLiteral configLexer) bytes <- P.stringLiteral configLexer key <- parseValue modifiers <- parseValue return defaultConfig { configInputMap = [(termIdent, bytes, EvKey key modifiers)] } debugLogDecl :: Parser VtyUserConfig debugLogDecl = do "debugLog" <- P.identifier configLexer path <- P.stringLiteral configLexer return defaultConfig { configDebugLog = Just path } colorModeDecl :: Parser VtyUserConfig colorModeDecl = do "colorMode" <- P.identifier configLexer mode <- P.stringLiteral configLexer return defaultConfig { configPreferredColorMode = readMaybe mode } widthMapDecl :: Parser VtyUserConfig widthMapDecl = do "widthMap" <- P.identifier configLexer tName <- P.stringLiteral configLexer path <- P.stringLiteral configLexer return defaultConfig { configTermWidthMaps = [(tName, path)] } ignoreLine :: Parser () ignoreLine = void $ manyTill anyChar newline parseConfig :: Parser VtyUserConfig parseConfig = liftM mconcat $ many $ do P.whiteSpace configLexer let directives = [try mapDecl, try debugLogDecl, try widthMapDecl, try colorModeDecl] choice directives <|> (ignoreLine >> return defaultConfig) class Parse a where parseValue :: Parser a instance Parse Char where parseValue = P.charLiteral configLexer instance Parse Int where parseValue = fromInteger <$> P.natural configLexer instance Parse Key where parseValue = genericParse instance Parse Modifier where parseValue = genericParse instance Parse a => Parse [a] where parseValue = P.brackets configLexer (parseValue `sepBy` P.symbol configLexer ",") ------------------------------------------------------------------------ -- Derived parser for ADTs via generics ------------------------------------------------------------------------ genericParse :: (Generic a, GParse (Rep a)) => Parser a genericParse = to <$> gparse class GParse f where gparse :: Parser (f a) instance GParse f => GParse (M1 S i f) where gparse = M1 <$> gparse instance GParse U1 where gparse = return U1 instance Parse a => GParse (K1 i a) where gparse = K1 <$> parseValue instance (GParse f, GParse g) => GParse (f :*: g) where gparse = (:*:) <$> gparse <*> gparse instance GParseAlts f => GParse (M1 D i f) where gparse = do con <- P.identifier configLexer M1 <$> gparseAlts con ------------------------------------------------------------------------ class GParseAlts f where gparseAlts :: String -> Parser (f a) instance (Constructor i, GParse f) => GParseAlts (M1 C i f) where gparseAlts con = do guard (con == conName (M1 Nothing :: C1 i Maybe a)) M1 <$> gparse instance (GParseAlts f, GParseAlts g) => GParseAlts (f :+: g) where gparseAlts con = L1 <$> gparseAlts con <|> R1 <$> gparseAlts con instance GParseAlts V1 where gparseAlts _ = fail "GParse: V1" -- | The result of a configuration change attempt made by -- 'addConfigWidthMap'. data ConfigUpdateResult = ConfigurationCreated -- ^ A new configuration file file was written with the new width -- table entry. | ConfigurationModified -- ^ An existing configuration file was modified with the new width -- table entry. | ConfigurationConflict String -- ^ The attempted width table entry could not be written to the -- configuration due to a conflict; the argument here is the width -- table file path for the conflicting entry. | ConfigurationRedundant -- ^ No change was made because the existing configuration already -- contains the specified mapping. deriving (Eq, Show) -- | Add a @widthMap@ directive to the Vty configuration file at the -- specified path. -- -- If the configuration path refers to a configuration that already -- contains the directive for the specified map and terminal type, the -- configuration file will not be modified. If the file does not contain -- the directive, it will be appended to the file. -- -- If the configuration path does not exist, a new configuration file -- will be created and any directories in the path will also be created. -- -- This returns a 'ConfigUpdateResult' indicating the change to the -- configuration. This does not handle exceptions raised by file or -- directory permissions issues. addConfigWidthMap :: FilePath -- ^ The configuration file path of the configuration -- to modify or create. -> String -- ^ The @TERM@ value for the @widthMap@ directive. -> FilePath -- ^ The width table file path for the directive. -> IO ConfigUpdateResult addConfigWidthMap configPath term tablePath = do configEx <- doesFileExist configPath if configEx then updateConfig else createConfig >> return ConfigurationCreated where directive = "widthMap " <> show term <> " " <> show tablePath <> "\n" createConfig = do let dir = takeDirectory configPath createDirectoryIfMissing True dir writeFile configPath directive updateConfig = do config <- parseConfigFile configPath if (term, tablePath) `elem` configTermWidthMaps config then return ConfigurationRedundant else case lookup term (configTermWidthMaps config) of Just other -> return $ ConfigurationConflict other Nothing -> do appendFile configPath directive return ConfigurationModified vty-6.1/src/Graphics/Vty/Debug.hs0000644000000000000000000000230707346545000015070 0ustar0000000000000000-- Copyright 2009-2010 Corey O'Connor module Graphics.Vty.Debug ( MockWindow(..) , SpanConstructLog , regionForWindow , allSpansHaveWidth , spanOpsAffectedColumns , spanOpsAffectedRows , rowOpsAffectedColumns , isSetAttr ) where import Graphics.Vty.Attributes import Graphics.Vty.Image (DisplayRegion) import Graphics.Vty.Span import qualified Data.Vector as Vector rowOpsAffectedColumns :: DisplayOps -> [Int] rowOpsAffectedColumns ops = Vector.toList $ Vector.map spanOpsAffectedColumns ops allSpansHaveWidth :: DisplayOps -> Int -> Bool allSpansHaveWidth ops expected = all (== expected) $ Vector.toList $ Vector.map spanOpsAffectedColumns ops spanOpsAffectedRows :: DisplayOps -> Int spanOpsAffectedRows ops = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList ops)) type SpanConstructLog = [SpanConstructEvent] data SpanConstructEvent = SpanSetAttr Attr isSetAttr :: Attr -> SpanConstructEvent -> Bool isSetAttr expectedAttr (SpanSetAttr inAttr) | inAttr == expectedAttr = True isSetAttr _attr _event = False data MockWindow = MockWindow Int Int deriving (Show, Eq) regionForWindow :: MockWindow -> DisplayRegion regionForWindow (MockWindow w h) = (w,h) vty-6.1/src/Graphics/Vty/DisplayAttributes.hs0000644000000000000000000001420107346545000017512 0ustar0000000000000000-- Copyright 2009-2010 Corey O'Connor {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} module Graphics.Vty.DisplayAttributes ( DisplayAttrDiff(..) , StyleStateChange(..) , DisplayColorDiff(..) , URLDiff(..) , fixDisplayAttr , displayAttrDiffs ) where import Graphics.Vty.Attributes import Data.Bits ((.&.)) import Data.ByteString (ByteString) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup(..)) #endif import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) -- | 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 = FixedAttr (fixStyle (fixedStyle fattr) (attrStyle attr)) (fixColor (fixedForeColor fattr) (attrForeColor attr)) (fixColor (fixedBackColor fattr) (attrBackColor attr)) (fixURL (fixedURL fattr) (attrURL attr)) where fixStyle _s Default = defaultStyleMask fixStyle s KeepCurrent = s fixStyle _s (SetTo newStyle) = newStyle fixColor _c Default = Nothing fixColor c KeepCurrent = c fixColor _c (SetTo c) = Just c fixURL c KeepCurrent = c fixURL _c (SetTo n) = Just n fixURL _c Default = Nothing -- | 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. data DisplayAttrDiff = DisplayAttrDiff { styleDiffs :: [StyleStateChange] , foreColorDiff :: DisplayColorDiff , backColorDiff :: DisplayColorDiff , urlDiff :: URLDiff } deriving (Show) instance Semigroup DisplayAttrDiff where d0 <> d1 = let ds = simplifyStyleDiffs (styleDiffs d0) (styleDiffs d1) fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1) bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1) ud = simplifyUrlDiffs (urlDiff d0) (urlDiff d1) in DisplayAttrDiff ds fcd bcd ud instance Monoid DisplayAttrDiff where mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange #if !(MIN_VERSION_base(4,11,0)) mappend = (<>) #endif -- | Used in the computation of a final style attribute change. 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? simplifyColorDiffs :: DisplayColorDiff -> DisplayColorDiff -> DisplayColorDiff simplifyColorDiffs _cd ColorToDefault = ColorToDefault simplifyColorDiffs cd NoColorChange = cd simplifyColorDiffs _cd (SetColor !c) = SetColor c -- | Consider two URL changes, which are mostly going to be the latter -- unless the latter specifies no change. simplifyUrlDiffs :: URLDiff -> URLDiff -> URLDiff simplifyUrlDiffs ud NoLinkChange = ud simplifyUrlDiffs _ ud = ud -- | Difference between two display color attribute changes. data DisplayColorDiff = ColorToDefault | NoColorChange | SetColor !Color deriving (Show, Eq) -- | Style attribute changes are transformed into a sequence of -- apply/removes of the individual attributes. data StyleStateChange = ApplyStandout | RemoveStandout | ApplyItalic | RemoveItalic | ApplyStrikethrough | RemoveStrikethrough | ApplyUnderline | RemoveUnderline | ApplyReverseVideo | RemoveReverseVideo | ApplyBlink | RemoveBlink | ApplyDim | RemoveDim | ApplyBold | RemoveBold deriving (Show, Eq) -- Setting and unsetting hyperlinks data URLDiff = LinkTo !ByteString | NoLinkChange | EndLink deriving (Show, Eq) -- | 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') , foreColorDiff = diffColor (fixedForeColor attr) (fixedForeColor attr') , backColorDiff = diffColor (fixedBackColor attr) (fixedBackColor attr') , urlDiff = diffURL (fixedURL attr) (fixedURL attr') } diffURL :: Maybe Text -> Maybe Text -> URLDiff diffURL Nothing Nothing = NoLinkChange diffURL (Just _) Nothing = EndLink diffURL _ (Just url) = LinkTo (encodeUtf8 url) diffColor :: Maybe Color -> Maybe Color -> DisplayColorDiff diffColor Nothing (Just c') = SetColor c' diffColor (Just c) (Just c') | c == c' = NoColorChange | otherwise = SetColor c' diffColor Nothing Nothing = NoColorChange diffColor (Just _) Nothing = ColorToDefault diffStyles :: Style -> Style -> [StyleStateChange] diffStyles prev cur = mconcat [ styleDiff standout ApplyStandout RemoveStandout , styleDiff underline ApplyUnderline RemoveUnderline , styleDiff italic ApplyItalic RemoveItalic , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo , styleDiff blink ApplyBlink RemoveBlink , styleDiff dim ApplyDim RemoveDim , styleDiff bold ApplyBold RemoveBold ] where styleDiff s sm rm = case (0 == prev .&. s, 0 == cur .&. s) of -- not set in either (True, True) -> [] -- set in both (False, False) -> [] -- now set (True, False) -> [sm] -- now unset (False, True) -> [rm] vty-6.1/src/Graphics/Vty/Error.hs0000644000000000000000000000044107346545000015130 0ustar0000000000000000module Graphics.Vty.Error ( VtyException(..) ) where -- | The type of exceptions specific to vty. -- -- These have fully qualified names by default since, IMO, exception -- handling requires this. data VtyException = VtyFailure String -- ^ Uncategorized failure specific to vty. vty-6.1/src/Graphics/Vty/Image.hs0000644000000000000000000003077507346545000015076 0ustar0000000000000000-- Copyright 2009-2010 Corey O'Connor {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DisambiguateRecordFields #-} -- | 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 , safeWctwidth , safeWctlwidth , wcwidth , wcswidth , wctwidth , wctlwidth -- * Display Regions , DisplayRegion , regionWidth , regionHeight ) where import Graphics.Vty.Attributes import Graphics.Vty.Image.Internal import Graphics.Text.Width import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL 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 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. This is an alias for 'horizJoin'. -- -- infixr 5 (<|>) :: Image -> Image -> Image (<|>) = horizJoin -- | Combines two images vertically. This is an alias for 'vertJoin'. -- -- infixr 4 (<->) :: Image -> Image -> Image (<->) = vertJoin -- | 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, with the first in the list -- being topmost. vertCat :: [Image] -> Image vertCat = foldr vertJoin EmptyImage -- | Make an 'Image' from a lazy text value. The text value should be -- sanitized of escape sequences (ASCII 27) and carriage returns; -- otherwise layout and attribute problems may result. text :: Attr -> TL.Text -> Image text a txt = let displayWidth = safeWctlwidth txt in HorizText a txt displayWidth (fromIntegral $! TL.length txt) -- | Make an 'Image' from a text value. The text value should be -- sanitized of escape sequences (ASCII 27) and carriage returns; -- otherwise layout and attribute problems may result. text' :: Attr -> T.Text -> Image text' a txt = let displayWidth = safeWctwidth txt in HorizText a (TL.fromStrict txt) displayWidth (T.length txt) -- | 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 -- | Make an image from a string of characters laid out on a single -- row with the same display attribute. The string is assumed to be a -- sequence of ISO-10646 characters. The input string should be -- sanitized of escape sequences (ASCII 27) and carriage returns; -- otherwise layout and attribute problems may result. -- -- 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) -- | Make an 'Image' from a 'String'. -- -- 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 -- | 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) -- | Make an 'Image' from a UTF-8 encoded lazy bytestring. utf8Bytestring :: Attr -> BL.ByteString -> Image utf8Bytestring a bs = text a (TL.decodeUtf8 bs) -- | Make an 'Image' from a UTF-8 encoded strict bytestring. utf8Bytestring' :: Attr -> B.ByteString -> Image utf8Bytestring' a bs = text' a (T.decodeUtf8 bs) -- | Make an image filling a region with the specified character. -- -- If either the width or height are less than or equal to 0, then -- the result is the empty image. 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 w h | w <= 0 || h <= 0 = EmptyImage | otherwise = vertCat $ replicate (fromIntegral h) $ HorizText a txt displayWidth charWidth where txt = TL.replicate charWidth (TL.singleton c) displayWidth = safeWcwidth c * charWidth charWidth :: Num a => a charWidth = fromIntegral w -- | 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. 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 go 0 0 0 0 i = i go 0 0 0 b i = VertJoin i (BGFill w b) w h where w = imageWidth i h = imageHeight i + b go 0 0 r b i = go 0 0 0 b $ HorizJoin i (BGFill r h) w h where w = imageWidth i + r h = imageHeight i go 0 t r b i = go 0 0 r b $ VertJoin (BGFill w t) i w h where w = imageWidth i h = imageHeight i + t go l t r b i = go 0 t r b $ HorizJoin (BGFill l h) i w h where w = imageWidth i + l h = imageHeight i -- | Translates an image by padding or cropping the left and top. -- -- 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 its left side. translateX :: Int -> Image -> Image translateX x i | x < 0 && (abs x > imageWidth i) = emptyImage | x < 0 = cropLeft (imageWidth i + x) 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 its top. translateY :: Int -> Image -> Image translateY y i | y < 0 && (abs y > imageHeight i) = emptyImage | y < 0 = cropTop (imageHeight i + y) i | 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. -- -- 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 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 | h < 0 = error "cannot crop height to less than zero" | otherwise = go inI where go EmptyImage = EmptyImage go i@(Crop {outputHeight}) = i {outputHeight = min h outputHeight} go i | h >= imageHeight i = i | otherwise = Crop i 0 0 (imageWidth i) h -- | 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 | w < 0 = error "cannot crop width to less than zero" | otherwise = go inI where go EmptyImage = EmptyImage go i@(Crop {outputWidth}) = i {outputWidth = min w outputWidth} go i | w >= imageWidth i = i | otherwise = Crop i 0 0 w (imageHeight i) -- | 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 | w < 0 = error "cannot crop the width to less than zero" | otherwise = go inI where go EmptyImage = EmptyImage go i@(Crop {leftSkip, outputWidth}) = let delta = max 0 (outputWidth - w) in i { leftSkip = leftSkip + delta , outputWidth = outputWidth - delta } go i | imageWidth i <= w = i | otherwise = Crop i (imageWidth i - w) 0 w (imageHeight i) -- | 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 | h < 0 = error "cannot crop the height to less than zero" | otherwise = go inI where go EmptyImage = EmptyImage go i@(Crop {topSkip, outputHeight}) = let delta = max 0 (outputHeight - h) in i { topSkip = topSkip + delta , outputHeight = outputHeight - delta } go i | imageHeight i <= h = i | otherwise = Crop i 0 (imageHeight i - h) (imageWidth i) h -- | 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 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 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) vty-6.1/src/Graphics/Vty/Image/0000755000000000000000000000000007346545000014526 5ustar0000000000000000vty-6.1/src/Graphics/Vty/Image/Internal.hs0000644000000000000000000002133307346545000016640 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_HADDOCK hide #-} module Graphics.Vty.Image.Internal ( Image(..) , imageHeight , imageWidth , horizJoin , vertJoin , ppImageStructure , clipText ) where import Graphics.Vty.Attributes import Graphics.Text.Width import GHC.Generics import Control.DeepSeq #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup(..)) #endif import qualified Data.Text.Lazy as TL clipText :: TL.Text -> Int -> Int -> TL.Text clipText txt leftSkip rightClip = -- CPS would clarify this I think let (toDrop,padPrefix) = clipForCharWidth leftSkip txt 0 txt' = if padPrefix then TL.cons '…' (TL.drop (toDrop+1) txt) else TL.drop toDrop txt (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. clipForCharWidth w t n | TL.null t = (n, False) | w < cw = (n, w /= 0) | otherwise = clipForCharWidth (w - cw) (TL.tail t) (n + 1) 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. -- -- Images are: -- -- * a horizontal span of text -- -- * a horizontal or vertical join of two images -- -- * a two dimensional fill of the 'Picture's background character -- -- * a cropped image -- -- * an empty image of no size or content. 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. , displayText :: TL.Text -- | 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. | HorizJoin { partLeft :: Image , partRight :: Image , 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. | VertJoin { partTop :: Image , partBottom :: Image , 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. | BGFill { outputWidth :: Int -- ^ always > 0 , outputHeight :: Int -- ^ always > 0 } -- | Crop an image | Crop { croppedImage :: Image , leftSkip :: Int , topSkip :: Int , outputWidth :: Int , outputHeight :: Int } -- | The empty image -- -- The combining operators identity constant. -- EmptyImage <|> a = a -- EmptyImage <-> a = a -- -- Any image of zero size equals the empty image. | EmptyImage deriving (Eq, Generic, Show, Read) -- | pretty print just the structure of an image. ppImageStructure :: Image -> String ppImageStructure = go 0 where go indent img = tab indent ++ pp indent img tab indent = concat $ replicate indent " " pp _ (HorizText {outputWidth}) = "HorizText(" ++ show outputWidth ++ ")" pp _ (BGFill {outputWidth, outputHeight}) = "BGFill(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")" pp i (HorizJoin {partLeft = l, partRight = r, outputWidth = c}) = "HorizJoin(" ++ show c ++ ")\n" ++ go (i+1) l ++ "\n" ++ go (i+1) r pp i (VertJoin {partTop = t, partBottom = b, outputWidth = c, outputHeight = r}) = "VertJoin(" ++ show c ++ ", " ++ show r ++ ")\n" ++ go (i+1) t ++ "\n" ++ go (i+1) b pp i (Crop {croppedImage, leftSkip, topSkip, outputWidth, outputHeight}) = "Crop(" ++ show leftSkip ++ "," ++ show topSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n" ++ go (i+1) croppedImage pp _ EmptyImage = "EmptyImage" instance NFData Image where rnf EmptyImage = () rnf (Crop i x y w h) = i `deepseq` x `seq` y `seq` w `seq` h `seq` () rnf (BGFill w h) = w `seq` h `seq` () rnf (VertJoin t b w h) = t `deepseq` b `deepseq` w `seq` h `seq` () 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. imageWidth :: Image -> Int imageWidth HorizText { outputWidth = w } = w imageWidth HorizJoin { outputWidth = w } = w imageWidth VertJoin { outputWidth = w } = w imageWidth BGFill { outputWidth = w } = w imageWidth Crop { outputWidth = w } = w imageWidth EmptyImage = 0 -- | 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 imageHeight VertJoin { outputHeight = h } = h imageHeight BGFill { outputHeight = h } = h imageHeight Crop { outputHeight = h } = h imageHeight EmptyImage = 0 -- | Append in the 'Semigroup' instance is equivalent to '<->'. instance Semigroup Image where (<>) = vertJoin -- | Append in the 'Monoid' instance is equivalent to '<->'. instance Monoid Image where mempty = EmptyImage #if !(MIN_VERSION_base(4,11,0)) mappend = (<>) #endif -- | 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 mismatch -- 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) -- 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 | h0 == h1 = HorizJoin i0 i1 w h0 -- otherwise one of the images needs to be padded to the right size. | h0 < h1 -- Pad i0 = let padAmount = h1 - h0 in HorizJoin (VertJoin i0 (BGFill w0 padAmount) w0 h1) i1 w h1 | h0 > h1 -- Pad i1 = let padAmount = h0 - h1 in HorizJoin i0 (VertJoin i1 (BGFill w1 padAmount) w1 h0) w h0 where w0 = imageWidth i0 w1 = imageWidth i1 w = w0 + w1 h0 = imageHeight i0 h1 = imageHeight i1 horizJoin _ _ = error "horizJoin applied to undefined values." -- | 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 mismatch -- 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 | w0 == w1 = VertJoin i0 i1 w0 h -- 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 | w0 > w1 = let padAmount = w0 - w1 in VertJoin i0 (HorizJoin i1 (BGFill padAmount h1) w0 h1) w0 h where w0 = imageWidth i0 w1 = imageWidth i1 h0 = imageHeight i0 h1 = imageHeight i1 h = h0 + h1 vertJoin _ _ = error "vertJoin applied to undefined values." vty-6.1/src/Graphics/Vty/Inline.hs0000644000000000000000000001044207346545000015257 0ustar0000000000000000-- | 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 -- 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 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 -- applyStyle underline -- putStr \" Styled! \" -- putAttrChange_ $ defaultAll -- putStrLn \"Not styled.\" -- @ -- -- '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 module Graphics.Vty.Inline ( module Graphics.Vty.Inline ) where import Graphics.Vty import Graphics.Vty.DisplayAttributes import Blaze.ByteString.Builder (writeToByteString) import Control.Monad.State.Strict import Data.Bits ( (.&.), complement ) import Data.IORef import System.IO type InlineM v = State InlineState v data InlineState = InlineState { inlineAttr :: Attr , inlineUrlsEnabled :: Bool } -- | Set the background color to the provided 'Color'. backColor :: Color -> InlineM () backColor c = modify $ \s -> s { inlineAttr = inlineAttr s `withBackColor` c } -- | Set the foreground color to the provided 'Color'. foreColor :: Color -> InlineM () foreColor c = modify $ \s -> s { inlineAttr = inlineAttr s `withForeColor` c } -- | Attempt to change the 'Style' of the following text.. -- -- If the terminal does not support the style change then no error is -- produced. The style can still be removed. applyStyle :: Style -> InlineM () applyStyle st = modify $ \s -> s { inlineAttr = inlineAttr s `withStyle` st } -- | 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. removeStyle :: Style -> InlineM () removeStyle sMask = modify $ \s -> s { inlineAttr = let style' = case attrStyle (inlineAttr s) of Default -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used." KeepCurrent -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used." SetTo st -> st .&. complement sMask in (inlineAttr s) { attrStyle = SetTo style' } } -- | Reset the display attributes. defaultAll :: InlineM () defaultAll = modify $ \s -> s { inlineAttr = defAttr } -- | 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 () putAttrChange out c = liftIO $ do bounds <- displayBounds out dc <- displayContext out bounds mfattr <- prevFattr <$> readIORef (assumedStateRef out) fattr <- case mfattr of Nothing -> do liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc False return $ FixedAttr defaultStyleMask Nothing Nothing Nothing Just v -> return v let InlineState attr urlsEnabled = execState c (InlineState currentAttr False) attr' = limitAttrForDisplay out attr fattr' = fixDisplayAttr fattr attr' diffs = displayAttrDiffs fattr fattr' outputByteBuffer out $ writeToByteString $ writeSetAttr dc urlsEnabled fattr attr' diffs modifyIORef (assumedStateRef out) $ \s -> s { prevFattr = Just fattr' } inlineHack dc -- | Apply the provided display attributes changes to the terminal -- output device. -- -- This will flush the terminal output. putAttrChange_ :: ( Applicative m, MonadIO m ) => Output -> InlineM () -> m () putAttrChange_ out c = liftIO $ do hFlush stdout putAttrChange out c hFlush stdout vty-6.1/src/Graphics/Vty/Input.hs0000644000000000000000000000245307346545000015143 0ustar0000000000000000-- | This module provides the input abstraction for Vty. module Graphics.Vty.Input ( Input(..) , module Graphics.Vty.Input.Events ) where import Graphics.Vty.Input.Events import Control.Concurrent.STM (TChan) -- | The library's input-processing abstraction. Platform-specific -- implementations must implement an 'Input' and provide it to -- 'Graphics.Vty.mkVtyFromPair'. data Input = Input { eventChannel :: TChan InternalEvent -- ^ A channel of events generated by input processing. The -- input implementation must write its input events to this -- channel; the Vty event loop will read from this channel -- and provide the events to the user's application via -- 'nextEvent'. , shutdownInput :: IO () -- ^ Shut down the input processing. As part of shutting down -- the input, this should also restore the input state if -- appropriate. , restoreInputState :: IO () -- ^ Restore the terminal's input state to what it was prior -- to configuring the input for Vty. This should be done as -- part of 'shutdownInput' but is exposed in case it needs to -- be used directly. , inputLogMsg :: String -> IO () -- ^ Log the specified message. } vty-6.1/src/Graphics/Vty/Input/0000755000000000000000000000000007346545000014603 5ustar0000000000000000vty-6.1/src/Graphics/Vty/Input/Events.hs0000644000000000000000000000644407346545000016413 0ustar0000000000000000{-# Language DeriveGeneric #-} {-# Language StrictData #-} module Graphics.Vty.Input.Events ( Key(..) , Modifier(..) , Event(..) , Button(..) , ClassifyMap , InternalEvent(..) ) where import Control.DeepSeq import Data.ByteString import GHC.Generics -- | Representations of non-modifier keys. -- -- * 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. -- -- * Actually, support for most of these but KEsc, KChar, KBS, and -- KEnter vary by terminal and keyboard. data Key = KEsc | KChar {-# UNPACK #-} Char | KBS | KEnter | KLeft | KRight | KUp | KDown | KUpLeft | KUpRight | KDownLeft | KDownRight | KCenter | KFun {-# UNPACK #-} Int | KBackTab | KPrtScr | KPause | KIns | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu deriving (Eq, Show, Read, Ord, Generic) instance NFData 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) instance NFData Modifier -- | Mouse buttons. data Button = BLeft | BMiddle | BRight | BScrollUp | BScrollDown deriving (Eq, Show, Read, Ord, Generic) instance NFData Button -- | Events. data Event = EvKey Key [Modifier] -- ^ A keyboard key was pressed with the specified modifiers. | EvMouseDown Int Int Button [Modifier] -- ^ A mouse button was pressed at the specified column and row. Any -- modifiers available in the event are also provided. | EvMouseUp Int Int (Maybe Button) -- ^ A mouse button was released at the specified column and -- row. Some terminals report only that a button was released -- without specifying which one; in that case, Nothing is provided. -- Otherwise Just the button released is included in the event. | EvResize Int Int -- The terminal window was resized and the size is provided in the -- integer fields (width, height). | EvPaste ByteString -- ^ A paste event occurs when a bracketed paste input sequence is -- received. For terminals that support bracketed paste mode, these -- events will be triggered on a paste event. Terminals that do not -- support bracketed pastes will send the paste contents as ordinary -- input (which is probably bad, so beware!) Note that the data is -- provided in raw form and you'll have to decode (e.g. as UTF-8) if -- that's what your application expects. | EvLostFocus -- ^ The terminal running the application lost input focus. | EvGainedFocus -- ^ The terminal running the application gained input focus. deriving (Eq, Show, Read, Ord, Generic) instance NFData Event type ClassifyMap = [(String,Event)] -- | The type of internal events that drive the internal Vty event -- dispatching to the application. data InternalEvent = ResumeAfterInterrupt -- ^ Vty resumed operation after the process was interrupted (e.g. -- with a signal). In practice this translates into a screen redraw -- in the input event loop. | InputEvent Event -- ^ An input event was received. vty-6.1/src/Graphics/Vty/Output.hs0000644000000000000000000003755607346545000015360 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RecordWildCards, CPP #-} -- | This module provides an abstract interface for performing terminal -- output and functions for accessing the current terminal or a specific -- terminal device. module Graphics.Vty.Output ( Output(..) , AssumedState(..) , DisplayContext(..) , Mode(..) , displayContext , outputPicture , initialAssumedState , limitAttrForDisplay , setCursorPos , hideCursor , showCursor ) where import Blaze.ByteString.Builder (Write, writeToByteString) import Blaze.ByteString.Builder.ByteString (writeByteString) import Control.Monad (when) import qualified Data.ByteString as BS import Data.IORef import qualified Data.Vector as Vector #if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>)) #endif import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL import Graphics.Vty.Attributes import Graphics.Vty.DisplayAttributes import Graphics.Vty.Image (DisplayRegion, regionWidth, regionHeight) import Graphics.Vty.Picture import Graphics.Vty.PictureToSpans import Graphics.Vty.Span -- | 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) | Focus -- ^ Focus-in/focus-out events (whether the terminal is -- configured to provide events on focus change) | Hyperlink -- ^ Hyperlink mode via the 'withURL' attribute modifier (see -- https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda). -- Note that this may not work gracefully in all terminal -- emulators so be sure to test this mode with the terminals -- you intend to support. It is off by default. deriving (Eq, Read, Show) -- | The library's device output abstraction. Platform-specific -- implementations must implement an 'Output' and provide it to -- 'Graphics.Vty.mkVtyFromPair'. data Output = Output { -- | 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 :: IO () -- | 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 :: IO () -- | Return the display to the state before `reserveDisplay` If no -- previous state then set the display state to the initial state. , releaseDisplay :: IO () -- | Sets the current display bounds (width, height). , setDisplayBounds :: (Int, Int) -> IO () -- | Returns the current display bounds. , displayBounds :: IO DisplayRegion -- | Output the bytestring to the terminal device. , outputByteBuffer :: BS.ByteString -> IO () -- | Specifies whether the cursor can be shown / hidden. , supportsCursorVisibility :: Bool -- | Indicates support for terminal modes for this output device. , supportsMode :: Mode -> Bool -- | Enables or disables a mode (does nothing if the mode is -- unsupported). , setMode :: Mode -> Bool -> IO () -- | Returns whether a mode is enabled. , getModeStatus :: Mode -> IO 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) , mkDisplayContext :: Output -> DisplayRegion -> IO DisplayContext -- | Ring the terminal bell if supported. , ringTerminalBell :: IO () -- | Returns whether the terminal has an audio bell feature. , supportsBell :: IO Bool -- | Returns whether the terminal supports italicized text. -- -- This is terminal-dependent and should make a best effort to -- determine whether this feature is supported, but even if the -- terminal advertises support (e.g. via terminfo) that might not -- be a reliable indicator of whether the feature will work as -- desired. , supportsItalics :: IO Bool -- | Returns whether the terminal supports strikethrough text. -- -- This is terminal-dependent and should make a best effort to -- determine whether this feature is supported, but even if the -- terminal advertises support (e.g. via terminfo) that might not -- be a reliable indicator of whether the feature will work as -- desired. , supportsStrikethrough :: IO Bool -- | Returns how many colors the terminal supports. , outputColorMode :: ColorMode -- | Set the output's window title, if any. , setOutputWindowTitle :: String -> IO () } -- | Sets the cursor position to the given output column and row. -- -- This is not necessarily 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'. setCursorPos :: Output -> Int -> Int -> IO () setCursorPos t x y = do bounds <- displayBounds t when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do dc <- displayContext t bounds outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y -- | Hides the cursor. hideCursor :: Output -> IO () hideCursor t = do bounds <- displayBounds t dc <- displayContext t bounds outputByteBuffer t $ writeToByteString $ writeHideCursor dc -- | Shows the cursor. showCursor :: Output -> IO () showCursor t = do bounds <- displayBounds t dc <- displayContext t bounds outputByteBuffer t $ writeToByteString $ writeShowCursor dc displayContext :: Output -> DisplayRegion -> IO DisplayContext displayContext t = mkDisplayContext t t data AssumedState = AssumedState { prevFattr :: Maybe FixedAttr , prevOutputOps :: Maybe DisplayOps } initialAssumedState :: AssumedState initialAssumedState = AssumedState Nothing Nothing data DisplayContext = DisplayContext { contextDevice :: Output -- | 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. , writeMoveCursor :: Int -> Int -> Write , writeShowCursor :: Write , writeHideCursor :: Write -- 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. , writeSetAttr :: Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write -- | Reset the display attributes to the default display attributes. , writeDefaultAttr :: Bool -> 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. writeUtf8Text :: BS.ByteString -> Write writeUtf8Text = writeByteString -- | Displays the given `Picture`. -- -- 1. The image is cropped to the display size. -- -- 2. Converted into a sequence of attribute changes and text spans. -- -- 3. The cursor is hidden. -- -- 4. Serialized to the display. -- -- 5. The cursor is then shown and positioned or kept hidden. outputPicture :: DisplayContext -> Picture -> IO () outputPicture dc pic = do urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink as <- readIORef (assumedStateRef $ contextDevice dc) let manipCursor = supportsCursorVisibility (contextDevice dc) r = contextRegion dc ops = displayOpsForPic pic r initialAttr = FixedAttr defaultStyleMask Nothing Nothing Nothing -- 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 $ affectedRegion ops) True Just previousOps -> if affectedRegion previousOps /= affectedRegion ops then replicate (displayOpsRows ops) True else Vector.toList $ Vector.zipWith (/=) previousOps ops -- build the Write corresponding to the output image out = (if manipCursor then writeHideCursor dc else mempty) `mappend` writeOutputOps urlsEnabled dc initialAttr diffs ops `mappend` (let (w,h) = contextRegion dc clampX = max 0 . min (w-1) clampY = max 0 . min (h-1) in case picCursor pic of _ | not manipCursor -> mempty NoCursor -> mempty AbsoluteCursor x y -> writeShowCursor dc `mappend` writeMoveCursor dc (clampX x) (clampY y) PositionOnly isAbs x y -> if isAbs then writeMoveCursor dc (clampX x) (clampY y) else let (ox, oy) = charToOutputPos m (clampX x, clampY y) m = cursorOutputMap ops $ picCursor pic in writeMoveCursor dc (clampX ox) (clampY oy) Cursor x y -> let m = cursorOutputMap ops $ picCursor pic (ox, oy) = charToOutputPos m (clampX x, clampY y) in writeShowCursor dc `mappend` writeMoveCursor dc (clampX ox) (clampY oy) ) -- ... then serialize outputByteBuffer (contextDevice dc) (writeToByteString out) -- Cache the output spans. let as' = as { prevOutputOps = Just ops } writeIORef (assumedStateRef $ contextDevice dc) as' writeOutputOps :: Bool -> DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write writeOutputOps urlsEnabled dc initialAttr diffs ops = let (_, out, _) = Vector.foldl' writeOutputOps' (0, mempty, diffs) ops in out where writeOutputOps' (y, out, True : diffs') spanOps = let spanOut = writeSpanOps urlsEnabled dc y initialAttr spanOps out' = out `mappend` spanOut in (y+1, out', diffs') writeOutputOps' (y, out, False : diffs') _spanOps = (y + 1, out, diffs') writeOutputOps' (_y, _out, []) _spanOps = error "vty - output spans without a corresponding diff." writeSpanOps :: Bool -> DisplayContext -> Int -> FixedAttr -> SpanOps -> Write writeSpanOps urlsEnabled dc y initialAttr spanOps = -- The first operation is to set the cursor to the start of the row let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc urlsEnabled -- then the span ops are serialized in the order specified in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp urlsEnabled dc op fattr of (opOut, fattr') -> (out `mappend` opOut, fattr') ) (start, initialAttr) spanOps writeSpanOp :: Bool -> DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr) writeSpanOp urlsEnabled dc (TextSpan attr _ _ str) fattr = let attr' = limitAttrForDisplay (contextDevice dc) attr fattr' = fixDisplayAttr fattr attr' diffs = displayAttrDiffs fattr fattr' out = writeSetAttr dc urlsEnabled fattr attr' diffs `mappend` writeUtf8Text (T.encodeUtf8 $ TL.toStrict str) in (out, fattr') writeSpanOp _ _ (Skip _) _fattr = error "writeSpanOp for Skip" writeSpanOp urlsEnabled dc (RowEnd _) fattr = (writeDefaultAttr dc urlsEnabled `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. data CursorOutputMap = CursorOutputMap { charToOutputPos :: (Int, Int) -> (Int, Int) } cursorOutputMap :: DisplayOps -> Cursor -> CursorOutputMap cursorOutputMap spanOps _cursor = CursorOutputMap { charToOutputPos = \(cx, cy) -> (cursorColumnOffset spanOps cx cy, cy) } cursorColumnOffset :: DisplayOps -> Int -> Int -> Int cursorColumnOffset ops cx cy = let cursorRowOps = Vector.unsafeIndex ops (fromEnum cy) (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 ) EQ -> ( d + ow , currentCx + cw , True ) LT -> ( d + columnsToCharOffset (cx - currentCx) op , currentCx + cw , True ) ) (0, 0, False) cursorRowOps in outOffset -- | 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 = attr { attrForeColor = clampColor $ attrForeColor attr , attrBackColor = clampColor $ attrBackColor attr } where clampColor Default = Default clampColor KeepCurrent = KeepCurrent clampColor (SetTo c) = clampColor' (outputColorMode t) c clampColor' NoColor _ = Default clampColor' ColorMode8 (ISOColor v) | v >= 8 = SetTo $ ISOColor (v - 8) | otherwise = SetTo $ ISOColor v clampColor' ColorMode8 _ = Default clampColor' ColorMode16 c@(ISOColor _) = SetTo c clampColor' ColorMode16 _ = Default clampColor' (ColorMode240 _) c@(ISOColor _) = SetTo c clampColor' (ColorMode240 colorCount) c@(Color240 n) | n <= colorCount = SetTo c | otherwise = Default clampColor' colorMode@(ColorMode240 _) (RGBColor r g b) = clampColor' colorMode (color240 r g b) clampColor' FullColor c = SetTo c vty-6.1/src/Graphics/Vty/Output/0000755000000000000000000000000007346545000015004 5ustar0000000000000000vty-6.1/src/Graphics/Vty/Output/Mock.hs0000644000000000000000000000760307346545000016237 0ustar0000000000000000-- 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 useful for testing. module Graphics.Vty.Output.Mock ( MockData , mockTerminal ) where import Graphics.Vty.Image (DisplayRegion) import Graphics.Vty.Attributes.Color (ColorMode(ColorMode16)) import Graphics.Vty.Output import Blaze.ByteString.Builder.Word (writeWord8) import Control.Monad.Trans import qualified Data.ByteString as BS import Data.IORef import qualified Data.String.UTF8 as UTF8 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 implementation is useful in manually determining if the -- sequence of terminal operations matches 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. mockTerminal :: (Applicative m, MonadIO m) => DisplayRegion -> m (MockData, Output) mockTerminal r = liftIO $ do outRef <- newIORef undefined newAssumedStateRef <- newIORef initialAssumedState let t = Output { terminalID = "mock terminal" , releaseTerminal = return () , reserveDisplay = return () , releaseDisplay = return () , ringTerminalBell = return () , supportsBell = return False , supportsItalics = return False , supportsStrikethrough = return False , setDisplayBounds = const $ return () , displayBounds = return r , outputByteBuffer = \bytes -> do putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes" writeIORef outRef $ UTF8.fromRep bytes , supportsCursorVisibility = True , supportsMode = const False , setMode = const $ const $ return () , getModeStatus = const $ return False , assumedStateRef = newAssumedStateRef , outputColorMode = ColorMode16 , setOutputWindowTitle = const $ return () , mkDisplayContext = \tActual rActual -> return $ DisplayContext { contextRegion = rActual , contextDevice = tActual -- 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' , writeShowCursor = writeWord8 $ toEnum $ fromEnum 'S' -- 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' , writeSetAttr = \_ _fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A' -- default attr is always visualized as the single -- character 'D' , writeDefaultAttr = const $ writeWord8 $ toEnum $ fromEnum 'D' -- row end is always visualized as the single character -- 'E' , writeRowEnd = writeWord8 $ toEnum $ fromEnum 'E' , inlineHack = return () } } return (outRef, t) vty-6.1/src/Graphics/Vty/Picture.hs0000644000000000000000000001006607346545000015456 0ustar0000000000000000-- 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 -- | A Vty picture. -- -- 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. } deriving (Eq, Show) instance NFData Picture where rnf (Picture c l b) = c `deepseq` l `deepseq` b `deepseq` () -- | A picture with no cursor, background or image layers. emptyPicture :: Picture emptyPicture = Picture NoCursor [] ClearBackground -- | Add an 'Image' as the top-most layer of a 'Picture'. addToTop :: Picture -> Image -> Picture addToTop p i = p {picLayers = i : picLayers p} -- | 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 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 { picCursor = NoCursor , picLayers = [i] , picBackground = ClearBackground } -- | Create a picture with the given layers, top-most first. -- -- The picture will not have a displayed cursor and no background -- pattern (ClearBackgroun) will be used. picForLayers :: [Image] -> Picture picForLayers is = Picture { picCursor = NoCursor , picLayers = is , picBackground = ClearBackground } -- | A picture can be configured to hide the cursor or to show the -- cursor at the specified character position. -- -- 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 -- | Set the terminal's cursor position without displaying a cursor -- character. This is important for accessibility with screen -- readers where a cursor position needs to be reported but we may -- not want to show a block cursor in that location for cosmetic -- reasons. The boolean argument indicates whether the positioning -- should be absolute as with 'AbsoluteCursor' ('True') or logical -- as with 'Cursor' ('False'). | PositionOnly !Bool !Int !Int -- | 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 | AbsoluteCursor !Int !Int deriving (Eq, Show) 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 -- * 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 , backgroundAttr :: Attr } -- | A ClearBackground is: -- -- * the space character if there are remaining non-skip ops -- -- * End of line if there are no remaining non-skip ops. | ClearBackground deriving (Eq, Show) instance NFData Background where rnf (Background c a) = c `seq` a `seq` () rnf ClearBackground = () -- | 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 vty-6.1/src/Graphics/Vty/PictureToSpans.hs0000644000000000000000000003365207346545000016774 0ustar0000000000000000-- Copyright Corey O'Connor {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -- | Transforms an image into rows of operations. module Graphics.Vty.PictureToSpans ( displayOpsForPic ) where import Graphics.Vty.Attributes (Attr, currentAttr) import Graphics.Vty.Image import Graphics.Vty.Image.Internal import Graphics.Vty.Picture import Graphics.Vty.Span import Lens.Micro import Lens.Micro.Mtl import Lens.Micro.TH import Control.Monad import Control.Monad.Reader import Control.Monad.State.Strict hiding ( state ) import Control.Monad.ST.Strict import qualified Data.Vector as Vector hiding ( take, replicate ) import Data.Vector.Mutable ( MVector(..)) import qualified Data.Vector.Mutable as MVector import qualified Data.Text.Lazy as TL type MRowOps s = MVector s SpanOps -- 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. { _columnOffset :: Int , _rowOffset :: Int -- 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. , _remainingColumns :: Int -- includes consideration of skipRows. In display space. , _remainingRows :: Int } makeLenses ''BlitState data BlitEnv s = BlitEnv { _region :: DisplayRegion , _mrowOps :: MRowOps s } makeLenses ''BlitEnv 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. displayOpsForPic :: Picture -> DisplayRegion -> DisplayOps displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r) -- | Produces the span ops for each layer then combines them. combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s) combinedOpsForLayers pic r | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0 | otherwise = do layerOps <- mapM (`buildSpans` r) (picLayers pic) case layerOps of [] -> error "empty picture" [ops] -> substituteSkips (picBackground pic) ops -- 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 substituteSkips :: Background -> MRowOps s -> ST s (MRowOps s) 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 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. 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. case safeWcwidth backgroundChar of w | w == 0 -> error $ "invalid background character " ++ show backgroundChar | w == 1 -> do forM_ [0 .. MVector.length ops - 1] $ \row -> do rowOps <- MVector.read ops row let rowOps' = swapSkipsForSingleColumnCharSpan backgroundChar backgroundAttr rowOps MVector.write ops row rowOps' | otherwise -> do forM_ [0 .. MVector.length ops - 1] $ \row -> do rowOps <- MVector.read ops row let rowOps' = swapSkipsForCharSpan w backgroundChar backgroundAttr rowOps MVector.write ops row rowOps' return ops mergeUnder :: MRowOps s -> MRowOps s -> ST s (MRowOps s) mergeUnder upper lower = do forM_ [0 .. MVector.length upper - 1] $ \row -> do upperRowOps <- MVector.read upper row lowerRowOps <- MVector.read lower row let rowOps = mergeRowUnder upperRowOps lowerRowOps MVector.write upper row rowOps return upper mergeRowUnder :: SpanOps -> SpanOps -> SpanOps mergeRowUnder upperRowOps = onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) where -- 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 outOps' = Vector.snoc outOps op in if Vector.null lowerOps' then outOps' else onUpperOp outOps' (Vector.head upperOps) (Vector.tail upperOps) lowerOps' onUpperOp outOps (Skip w) upperOps lowerOps = let (ops', lowerOps') = splitOpsAt w lowerOps outOps' = outOps `mappend` ops' in if Vector.null lowerOps' then outOps' else onUpperOp outOps' (Vector.head upperOps) (Vector.tail upperOps) lowerOps' onUpperOp _ (RowEnd _) _ _ = error "cannot merge rows containing RowEnd ops" swapSkipsForSingleColumnCharSpan :: Char -> Attr -> SpanOps -> SpanOps swapSkipsForSingleColumnCharSpan c a = Vector.map f where f (Skip ow) = let txt = TL.pack $ replicate ow c in TextSpan a ow ow txt f v = v swapSkipsForCharSpan :: Int -> Char -> Attr -> SpanOps -> SpanOps swapSkipsForCharSpan w c a = Vector.map f where f (Skip ow) = let txt0Cw = ow `div` w txt0 = TL.pack $ replicate txt0Cw c txt1Cw = ow `mod` w txt1 = TL.pack $ replicate txt1Cw '…' cw = txt0Cw + txt1Cw txt = txt0 `TL.append` txt1 in TextSpan a ow cw txt f v = v -- | Builds a vector of row operations that will output the given -- picture to the terminal. -- -- Crops to the given display region. 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 -- 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. -- -- 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. let fullBuild = do startImageBuild image -- Fill in any unspecified columns with a skip. forM_ [0 .. (regionHeight outRegion - 1)] (addRowCompletion outRegion) initEnv = BlitEnv outRegion outOps initState = BlitState 0 0 0 0 (regionWidth outRegion) (regionHeight outRegion) _ <- runStateT (runReaderT fullBuild initEnv) initState return () return outOps -- | 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 when (not outOfBounds) $ addMaybeClipped image isOutOfBounds :: Image -> BlitState -> Bool isOutOfBounds i s | s ^. remainingColumns <= 0 = True | s ^. remainingRows <= 0 = True | s ^. skipColumns >= imageWidth i = True | 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 -- Crop implementations is 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 -- This assumes that text spans are only 1 row high. s <- use skipRows when (s < 1) $ do leftClip <- use skipColumns rightClip <- use remainingColumns let leftClipped = leftClip > 0 rightClipped = (ow - leftClip) > rightClip if leftClipped || rightClipped then let textStr' = clipText textStr leftClip rightClip in addUnclippedText a textStr' else addUnclippedText a textStr addMaybeClipped (VertJoin topImage bottomImage _ow oh) = do when (imageHeight topImage + imageHeight bottomImage > 0) $ addMaybeClippedJoin "vert_join" skipRows remainingRows rowOffset (imageHeight topImage) topImage bottomImage oh addMaybeClipped (HorizJoin leftImage rightImage ow _oh) = do when (imageWidth leftImage + imageWidth rightImage > 0) $ addMaybeClippedJoin "horiz_join" skipColumns remainingColumns columnOffset (imageWidth leftImage) leftImage rightImage ow addMaybeClipped BGFill {outputWidth, outputHeight} = do s <- get let outputWidth' = min (outputWidth - s^.skipColumns) (s^.remainingColumns) outputHeight' = min (outputHeight - s^.skipRows ) (s^.remainingRows) y <- use rowOffset forM_ [y..y+outputHeight'-1] $ snocOp (Skip outputWidth') addMaybeClipped Crop {croppedImage, leftSkip, topSkip, outputWidth, outputHeight} = do sx <- use skipColumns skipColumns += leftSkip modifying remainingColumns (min (outputWidth - sx)) sy <- use skipRows skipRows += topSkip modifying remainingRows (min (outputHeight - sy)) addMaybeClipped croppedImage addMaybeClippedJoin :: forall s . String -> Lens BlitState BlitState Int Int -> Lens BlitState BlitState Int Int -> Lens BlitState BlitState Int Int -> Int -> Image -> Image -> Int -> BlitM s () addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do state <- get when (state^.remaining <= 0) $ error $ name ++ " with remaining <= 0" case state^.skip of s | s > size -> put $ state & skip %~ subtract size | s == 0 -> if state^.remaining > i0Dim then do addMaybeClipped i0 put $ state & offset %~ (+ i0Dim) & remaining %~ subtract i0Dim addMaybeClipped i1 else addMaybeClipped i0 | s < i0Dim -> let i0Dim' = i0Dim - s in if state^.remaining <= i0Dim' then addMaybeClipped i0 else do addMaybeClipped i0 put $ state & offset %~ (+ i0Dim') & remaining %~ subtract i0Dim' & skip .~ 0 addMaybeClipped i1 | s >= i0Dim -> do put $ state & skip %~ subtract i0Dim addMaybeClipped i1 _ -> error $ name ++ " has unhandled skip class" addUnclippedText :: Attr -> TL.Text -> BlitM s () addUnclippedText a txt = do let op = TextSpan a usedDisplayColumns (fromIntegral $ TL.length txt) txt usedDisplayColumns = wctlwidth txt use rowOffset >>= snocOp op addRowCompletion :: DisplayRegion -> Int -> BlitM s () addRowCompletion displayRegion row = do allRowOps <- view mrowOps rowOps <- lift $ lift $ MVector.read allRowOps row let endX = spanOpsAffectedColumns rowOps when (endX < regionWidth displayRegion) $ do let ow = regionWidth displayRegion - endX snocOp (Skip ow) row -- | snocs the operation to the operations for the given row. snocOp :: SpanOp -> Int -> BlitM s () snocOp !op !row = do theMrowOps <- view mrowOps theRegion <- view region lift $ lift $ do ops <- MVector.read theMrowOps row let ops' = Vector.snoc ops op when (spanOpsAffectedColumns ops' > regionWidth theRegion) $ error $ "row " ++ show row ++ " now exceeds region width" MVector.write theMrowOps row ops' vty-6.1/src/Graphics/Vty/Span.hs0000644000000000000000000001356507346545000014753 0ustar0000000000000000-- Copyright Corey O'Connor {-# LANGUAGE GADTs #-} -- | 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 ( SpanOp(..) , columnsToCharOffset , spanOpHasWidth , SpanOps , spanOpsAffectedColumns , splitOpsAt , dropOps , DisplayOps , displayOpsRows , displayOpsColumns , affectedRegion ) where import Graphics.Vty.Attributes (Attr) import Graphics.Vty.Image import Graphics.Vty.Image.Internal ( clipText ) import qualified Data.Text.Lazy as TL 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. data SpanOp = -- | 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 :: TL.Text } -- | 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 -- columns are clear. | RowEnd !Int deriving Eq -- | 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 dropOps w = snd . splitOpsAt w splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps) splitOpsAt = splitOpsAt' where splitOpsAt' 0 ops = (Vector.empty, ops) splitOpsAt' remainingColumns ops = case Vector.head ops of t@(TextSpan {}) -> if remainingColumns >= textSpanOutputWidth t then let (pre,post) = splitOpsAt' (remainingColumns - textSpanOutputWidth t) (Vector.tail ops) in (Vector.cons t pre, post) else let preTxt = clipText (textSpanText t) 0 remainingColumns preOp = TextSpan { textSpanAttr = textSpanAttr t , textSpanOutputWidth = remainingColumns , textSpanCharWidth = fromIntegral $! TL.length preTxt , textSpanText = preTxt } postWidth = textSpanOutputWidth t - remainingColumns postTxt = clipText (textSpanText t) remainingColumns postWidth postOp = TextSpan { textSpanAttr = textSpanAttr t , textSpanOutputWidth = postWidth , textSpanCharWidth = fromIntegral $! TL.length postTxt , textSpanText = postTxt } in ( Vector.singleton preOp , Vector.cons postOp (Vector.tail ops) ) Skip w -> if remainingColumns >= w then let (pre,post) = splitOpsAt' (remainingColumns - w) (Vector.tail ops) in (Vector.cons (Skip w) pre, post) else ( Vector.singleton $ Skip remainingColumns , Vector.cons (Skip (w - remainingColumns)) (Vector.tail ops) ) RowEnd _ -> error "cannot split ops containing a row end" -- | A vector of span operation vectors for display, one per row of the -- output region. type DisplayOps = Vector SpanOps instance Show SpanOp where show (TextSpan attr ow cw _) = "TextSpan(" ++ show attr ++ ")(" ++ show ow ++ ", " ++ show cw ++ ")" show (Skip ow) = "Skip(" ++ show ow ++ ")" show (RowEnd ow) = "RowEnd(" ++ show ow ++ ")" -- | The number of columns the DisplayOps are defined for. -- -- All spans are verified to define same number of columns. displayOpsColumns :: DisplayOps -> Int displayOpsColumns ops | Vector.length ops == 0 = 0 | otherwise = Vector.length $ Vector.head ops -- | The number of rows the DisplayOps are defined for. displayOpsRows :: DisplayOps -> Int displayOpsRows = Vector.length affectedRegion :: DisplayOps -> DisplayRegion affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops) -- | The number of columns a SpanOps affects. spanOpsAffectedColumns :: SpanOps -> Int spanOpsAffectedColumns inOps = Vector.foldl' spanOpsAffectedColumns' 0 inOps where spanOpsAffectedColumns' t (TextSpan _ w _ _ ) = t + w spanOpsAffectedColumns' t (Skip w) = t + w spanOpsAffectedColumns' t (RowEnd w) = t + w -- | 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) -- | The number of columns to the character at the given position in the -- span op. columnsToCharOffset :: Int -> SpanOp -> Int columnsToCharOffset cx (TextSpan _ _ _ utf8Str) = wctlwidth (TL.take (fromIntegral cx) utf8Str) columnsToCharOffset cx (Skip _) = cx columnsToCharOffset cx (RowEnd _) = cx vty-6.1/src/Graphics/Vty/UnicodeWidthTable/0000755000000000000000000000000007346545000017042 5ustar0000000000000000vty-6.1/src/Graphics/Vty/UnicodeWidthTable/IO.hs0000644000000000000000000000573407346545000017716 0ustar0000000000000000{-# LANGUAGE CPP #-} module Graphics.Vty.UnicodeWidthTable.IO ( readUnicodeWidthTable , parseUnicodeWidthTable , writeUnicodeWidthTable ) where import Control.Monad (when, forM) import Data.Binary import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString.Lazy as BSL #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif import Graphics.Vty.UnicodeWidthTable.Types -- | Load a binary unicode width table from the specified file. -- -- This either returns a successfully parsed table or a table parsing -- error message. This does not handle I/O exceptions. readUnicodeWidthTable :: FilePath -> IO (Either String UnicodeWidthTable) readUnicodeWidthTable path = parseUnicodeWidthTable <$> BSL.readFile path -- | Parse a binary unicode width table. parseUnicodeWidthTable :: BSL.ByteString -> Either String UnicodeWidthTable parseUnicodeWidthTable bs = case runGetOrFail tableParser bs of Left (_, _, msg) -> Left msg -- Even if we parsed a table, leftover bytes indicate something -- could be wrong. Right (remainingBytes, _, _) | not (BSL.null remainingBytes) -> Left $ "Error: " <> show (BSL.length remainingBytes) <> " byte(s) left unconsumed" Right (_, _, table) -> Right table -- | Write the unicode width table to the specified path. -- -- This does not handle I/O exceptions. writeUnicodeWidthTable :: FilePath -> UnicodeWidthTable -> IO () writeUnicodeWidthTable path table = do let body = runPut (tableV1Writer table) BSL.writeFile path body -- | Width table magic bytes for use in the binary format. widthTableMagic :: Word32 widthTableMagic = 0xc1a9f7e0 tableParser :: Get UnicodeWidthTable tableParser = do magic <- getWord32le when (magic /= widthTableMagic) $ fail "Table magic number invalid" version <- getWord8 case version of 1 -> tableV1Parser _ -> fail "Table version invalid" tableV1Parser :: Get UnicodeWidthTable tableV1Parser = do numRanges <- getWord32le let parseRange = do start <- getWord32le size <- getWord32le cols <- getWord8 return WidthTableRange { rangeStart = start , rangeSize = size , rangeColumns = cols } ranges <- forM [1..numRanges] $ const parseRange return UnicodeWidthTable { unicodeWidthTableRanges = ranges } tableV1Writer :: UnicodeWidthTable -> Put tableV1Writer table = do -- Magic bytes putWord32le widthTableMagic -- Version putWord8 1 -- Number of ranges let ranges = unicodeWidthTableRanges table let numRanges = length ranges putWord32le (fromIntegral numRanges) -- Ranges let putRange r = do putWord32le $ rangeStart r putWord32le $ rangeSize r putWord8 $ rangeColumns r mapM_ putRange ranges vty-6.1/src/Graphics/Vty/UnicodeWidthTable/Install.hs0000644000000000000000000001147007346545000021007 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} module Graphics.Vty.UnicodeWidthTable.Install ( TableInstallException(..) , installUnicodeWidthTable , isCustomTableReady ) where import Control.Monad (when, forM_) import qualified Control.Exception as E import GHC.Conc.Sync (withMVar) import Control.Concurrent.MVar (MVar, newMVar) import Data.Word (Word8, Word32) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif import System.IO.Unsafe (unsafePerformIO) import Graphics.Vty.UnicodeWidthTable.Types -- | The lock used to make functions in this module thread-safe. installLock :: MVar () {-# NOINLINE installLock #-} installLock = unsafePerformIO $ newMVar () -- | Returns True if and only if a custom table has been allocated and -- marked as ready for use. -- -- This function is thread-safe. isCustomTableReady :: IO Bool isCustomTableReady = withInstallLock $ (== 1) <$> c_isCustomTableReady withInstallLock :: IO a -> IO a withInstallLock act = withMVar installLock $ const act -- This is the size of the allocated custom character width table, in -- character slots. It's important that this be large enough to hold all -- possible Unicode character values. At the time of this writing, the -- valid Unicode range is 0 - 0x10ffff, hence this value. tableSize :: Int tableSize = 0x110000 -- | Exception type raised by 'installUnicodeWidthTable'. data TableInstallException = TableInitFailure Int Int -- ^ The width table could not be initialized. Args: failure status, -- requested table size. | TableRangeFailure Int WidthTableRange -- ^ A code point range could not be configured. Args: failure -- status, offending range. | TableActivationFailure Int -- ^ The table could not be activated. Args: failure status. deriving (Eq, Show) instance E.Exception TableInstallException -- | Install a custom unicode character width -- table. Such tables are obtained with -- 'Graphics.Vty.UnicodeWidthTable.Query.buildUnicodeWidthTable' and -- 'Graphics.Vty.UnicodeWidthTable.IO.readUnicodeWidthTable'. -- -- ALERT! This function is probably not what you want to use because -- it is automatically called by 'Graphics.Vty.mkVty'. You will only -- ever need to call this function if you want to use functions -- in 'Graphics.Text.Width' without controlling the terminal with -- 'Graphics.Vty.mkVty'. -- -- This affects the behavior of the 'Graphics.Vty.Image.wcwidth' -- function and functions that call it. It does so by -- changing global state available to the C implementation -- of 'Graphics.Vty.Image.wcwidth'. To ensure that your -- program gets consistent results from evaluating calls to -- 'Graphics.Vty.Image.wcwidth', the installation of a custom table -- should be performed before you call 'Graphics.Vty.Image.wcwidth' in -- your program. -- -- This is best done at Vty startup, and if you use -- 'Graphics.Vty.mkVty', that function calls this automatically based on -- the Vty configuration's declared width tables. It is exposed as part -- of the public API so that applications can call this as needed if -- they don't want to control the terminal with 'mkVty' but do want to -- make calls to 'Graphics.Vty.Image.wcwidth'. -- -- It's also important to note that once a custom table has been -- installed, it is permanent for the life of the process. No new table -- can be installed, and the new custom table cannot be removed. -- -- If this function fails for any reason -- if the table cannot be -- installed or is invalid, or if a custom table already exists -- this -- will raise a 'TableInstallException' exception. -- -- This function is thread-safe. installUnicodeWidthTable :: UnicodeWidthTable -> IO () installUnicodeWidthTable table = withInstallLock $ do initResult <- initCustomTable tableSize when (initResult /= 0) $ E.throwIO $ TableInitFailure initResult tableSize forM_ (unicodeWidthTableRanges table) $ \r -> do result <- setCustomTableRange (rangeStart r) (rangeSize r) (rangeColumns r) when (result /= 0) $ do deallocateCustomTable E.throwIO $ TableRangeFailure result r actResult <- activateCustomTable when (actResult /= 0) $ E.throwIO $ TableActivationFailure actResult ------------------------------------------------------------------------ -- C imports foreign import ccall unsafe "vty_init_custom_table" initCustomTable :: Int -> IO Int foreign import ccall unsafe "vty_set_custom_table_range" setCustomTableRange :: Word32 -> Word32 -> Word8 -> IO Int foreign import ccall unsafe "vty_activate_custom_table" activateCustomTable :: IO Int foreign import ccall unsafe "vty_custom_table_ready" c_isCustomTableReady :: IO Int foreign import ccall unsafe "vty_deallocate_custom_table" deallocateCustomTable :: IO () vty-6.1/src/Graphics/Vty/UnicodeWidthTable/Main.hs0000644000000000000000000001526707346545000020275 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} -- | This module provides a command-line tool implementation for -- building Vty character width tables and updating the user's local Vty -- configuration to load them. -- -- The API is parameterized on a platform-specific function to obtain -- character widths. For example, on Unix platforms, this could be done -- with a routine that communicates with the terminal to query it for -- character widths. On other platforms, such a routine might interact -- with a system library. -- -- This tool is provided as a library implementation so that the tool -- has a consistent interface across platforms and so that it implements -- the Vty configuration update the same way everywhere. module Graphics.Vty.UnicodeWidthTable.Main ( defaultMain ) where import qualified Control.Exception as E import Control.Monad (when) import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif import System.Directory (createDirectoryIfMissing) import System.Environment (getArgs, getProgName) import System.FilePath (takeDirectory) import System.Exit (exitFailure) import System.Console.GetOpt import Text.Read (readMaybe) import Graphics.Vty.Config ( terminalWidthTablePath, currentTerminalName , vtyConfigPath, addConfigWidthMap , ConfigUpdateResult(..) ) import Graphics.Vty.UnicodeWidthTable.IO import Graphics.Vty.UnicodeWidthTable.Query data Arg = Help | OutputPath String | TableUpperBound String | UpdateConfig | VtyConfigPath String deriving (Eq, Show) options :: Config -> [OptDescr Arg] options config = [ Option "h" ["help"] (NoArg Help) "This help output" , Option "b" ["bound"] (ReqArg TableUpperBound "MAX_CHAR") ("The maximum Unicode code point to test when building the table " <> "(default: " <> (show $ fromEnum $ configBound config) <> ")") , Option "p" ["path"] (ReqArg OutputPath "PATH") ("The output path to write to (default: " <> fromMaybe "" (configOutputPath config) <> ")") , Option "u" ["update-config"] (NoArg UpdateConfig) "Create or update the Vty configuration file to use the new table (default: no)" , Option "c" ["config-path"] (ReqArg VtyConfigPath "PATH") ("Update the specified Vty configuration file path when -u is set (default: " <> configPath config <> ")") ] data Config = Config { configOutputPath :: Maybe FilePath , configBound :: Char , configUpdate :: Bool , configPath :: FilePath } deriving (Show) mkDefaultConfig :: IO Config mkDefaultConfig = do Config <$> terminalWidthTablePath <*> pure defaultUnicodeTableUpperBound <*> pure False <*> vtyConfigPath usage :: IO () usage = do config <- mkDefaultConfig pn <- getProgName putStrLn $ "Usage: " <> pn <> " [options]" putStrLn "" putStrLn "This tool queries the terminal on stdout to determine the widths" putStrLn "of Unicode characters rendered to the terminal. The resulting data" putStrLn "is written to a table at the specified output path for later" putStrLn "loading by Vty-based applications." putStrLn "" putStrLn $ usageInfo pn (options config) updateConfigFromArg :: Arg -> Config -> Config updateConfigFromArg Help c = c updateConfigFromArg UpdateConfig c = c { configUpdate = True } updateConfigFromArg (VtyConfigPath p) c = c { configPath = p } updateConfigFromArg (TableUpperBound s) c = case readMaybe s of Nothing -> error $ "Invalid table upper bound: " <> show s Just v -> c { configBound = toEnum v } updateConfigFromArg (OutputPath p) c = c { configOutputPath = Just p } -- | Run the character width table builder tool using the specified -- function to obtain character widths. This is intended to be a 'main' -- implementation, e.g. @main = defaultMain getCharWidth@. -- -- The tool queries the local terminal in some way (as determined by -- the provided function) over a wide range of Unicode code points and -- generates a table of character widths that can subsequently be loaded -- by Vty-based applications. -- -- The tool respects the following command-line flags, all of which are -- optional and have sensible defaults: -- -- * @-h@/@--help@: help output -- * @-b@/@--bound@: Unicode code point upper bound to use when building -- the table. -- * @-p@/@--path@: the output path where the generated table should be -- written. -- * @-u@/@--update-config@: If given, create or update the user's Vty -- configuration file to use the new table. -- * @-c@/@--config-path@: the path to the user's Vty configuration. defaultMain :: (Char -> IO Int) -> IO () defaultMain charWidth = do defConfig <- mkDefaultConfig strArgs <- getArgs let (args, unused, errors) = getOpt Permute (options defConfig) strArgs when (not $ null errors) $ do mapM_ putStrLn errors exitFailure when ((not $ null unused) || (Help `elem` args)) $ do usage exitFailure let config = foldr updateConfigFromArg defConfig args outputPath <- case configOutputPath config of Nothing -> do putStrLn "Error: could not obtain terminal width table path" exitFailure Just path -> return path putStrLn "Querying terminal:" builtTable <- buildUnicodeWidthTable charWidth $ configBound config let dir = takeDirectory outputPath createDirectoryIfMissing True dir writeUnicodeWidthTable outputPath builtTable putStrLn $ "\nOutput table written to " <> outputPath when (configUpdate config) $ do let cPath = configPath config Just tName <- currentTerminalName result <- E.try $ addConfigWidthMap cPath tName outputPath case result of Left (e::E.SomeException) -> do putStrLn $ "Error updating Vty configuration at " <> cPath <> ": " <> show e exitFailure Right ConfigurationCreated -> do putStrLn $ "Configuration file created: " <> cPath Right ConfigurationModified -> do putStrLn $ "Configuration file updated: " <> cPath Right (ConfigurationConflict other) -> do putStrLn $ "Configuration file not updated: uses a different table " <> "for TERM=" <> tName <> ": " <> other Right ConfigurationRedundant -> do putStrLn $ "Configuration file not updated: configuration " <> cPath <> " already uses table " <> outputPath <> " for TERM=" <> tName vty-6.1/src/Graphics/Vty/UnicodeWidthTable/Query.hs0000644000000000000000000000535507346545000020513 0ustar0000000000000000{-# LANGUAGE TupleSections #-} module Graphics.Vty.UnicodeWidthTable.Query ( buildUnicodeWidthTable , defaultUnicodeTableUpperBound ) where import Control.Monad (forM) import Data.Char (generalCategory, GeneralCategory(..)) import Graphics.Vty.UnicodeWidthTable.Types shouldConsider :: Char -> Bool shouldConsider c = case generalCategory c of Control -> False NotAssigned -> False Surrogate -> False _ -> True -- | Convert a sequence of character/width pairs into a list of -- run-length encoded ranges. This function assumes the pairs come -- sorted by character ordinal value. It does not require that the -- character range is fully covered by the sequence. -- -- The result of this function is a list of ranges in reverse order -- relative to the input sequence. mkRanges :: [(Char, Int)] -> [WidthTableRange] mkRanges pairs = let convertedPairs = convert <$> pairs convert (c, i) = (fromIntegral $ fromEnum c, fromIntegral i) go Nothing finishedRanges [] = finishedRanges go (Just r) finishedRanges [] = r:finishedRanges go Nothing finishedRanges ((c, width):rest) = go (Just $ WidthTableRange c 1 width) finishedRanges rest go (Just r@(WidthTableRange prevCh sz prevWidth)) finishedRanges ((c, width):rest) = if c == prevCh + sz && prevWidth == width then go (Just (WidthTableRange prevCh (sz + 1) prevWidth)) finishedRanges rest else go (Just (WidthTableRange c 1 width)) (r:finishedRanges) rest in go Nothing [] convertedPairs -- The uppermost code point to consider when building Unicode width -- tables. defaultUnicodeTableUpperBound :: Char defaultUnicodeTableUpperBound = '\xe0000' -- | Construct a unicode character width table. This works by using the -- provided function to obtain the appropriate width for each character -- in a wide range of Unicode code points, which on some platforms -- may perform local terminal operations or may interact with system -- libraries. Depending on how the provided width function works, this -- may need to be run only in a terminal that is not actively controlled -- by a Vty handle. -- -- The character argument specifies the upper bound code point to test -- when building the table. This allows callers to decide how much of -- the Unicode code point space to scan when building the table. -- -- This does not handle exceptions. buildUnicodeWidthTable :: (Char -> IO Int) -> Char -> IO UnicodeWidthTable buildUnicodeWidthTable charWidth tableUpperBound = do pairs <- forM (filter shouldConsider ['\0'..tableUpperBound]) $ \i -> (i,) <$> charWidth i return UnicodeWidthTable { unicodeWidthTableRanges = reverse $ mkRanges pairs } vty-6.1/src/Graphics/Vty/UnicodeWidthTable/Types.hs0000644000000000000000000000202607346545000020502 0ustar0000000000000000module Graphics.Vty.UnicodeWidthTable.Types ( UnicodeWidthTable(..) , WidthTableRange(..) ) where import Data.Word (Word8, Word32) -- | A range of code points in a width table. data WidthTableRange = WidthTableRange { rangeStart :: Word32 -- ^ The range's starting code point. , rangeSize :: Word32 -- ^ The number of code points in the contiguous -- range, beginning with the starting code point -- ('rangeStart'). , rangeColumns :: Word8 -- ^ The terminal width, in columns, of all of the -- characters corresponding to the code points in -- this range. } deriving (Eq, Show) -- | A run-length-encoded table of Unicode character widths. data UnicodeWidthTable = UnicodeWidthTable { unicodeWidthTableRanges :: [WidthTableRange] -- ^ The ranges in the table. } deriving (Show) vty-6.1/vty.cabal0000644000000000000000000000674507346545000012215 0ustar0000000000000000name: vty version: 6.1 license: BSD3 license-file: LICENSE author: AUTHORS maintainer: Jonathan Daugherty (cygnus@foobox.com) homepage: https://github.com/jtdaugherty/vty category: User Interfaces synopsis: A simple terminal UI library description: vty is terminal GUI library in the niche of ncurses. It is intended to be easy to use and to provide good support for common terminal types. . See the @vty-examples@ package as well as the program @examples/interactive_terminal_test.hs@ included in the @vty@ repository for examples on how to use the library. . 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 extra-doc-files: README.md, AUTHORS, CHANGELOG.md, LICENSE tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7, GHC==9.0.2, GHC==9.2.8, GHC==9.4.5, GHC==9.6.2 source-repository head type: git location: https://github.com/jtdaugherty/vty.git library default-language: Haskell2010 include-dirs: cbits hs-source-dirs: src ghc-options: -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10 build-depends: base >= 4.8 && < 5, blaze-builder >= 0.3.3.2 && < 0.5, bytestring, deepseq >= 1.1 && < 1.5, microlens < 0.4.14, microlens-mtl, microlens-th, mtl >= 1.1.1.0 && < 2.4, stm, text >= 0.11.3, utf8-string >= 0.3 && < 1.1, vector >= 0.7, binary, parsec, filepath, directory if !impl(ghc >= 8.0) build-depends: semigroups >= 0.16, fail exposed-modules: Graphics.Text.Width Graphics.Vty Graphics.Vty.Attributes Graphics.Vty.Attributes.Color Graphics.Vty.Attributes.Color240 Graphics.Vty.Config Graphics.Vty.Debug Graphics.Vty.DisplayAttributes Graphics.Vty.Error Graphics.Vty.Image Graphics.Vty.Image.Internal Graphics.Vty.Inline Graphics.Vty.Input Graphics.Vty.Input.Events Graphics.Vty.Output Graphics.Vty.Output.Mock Graphics.Vty.Picture Graphics.Vty.PictureToSpans Graphics.Vty.Span Graphics.Vty.UnicodeWidthTable.IO Graphics.Vty.UnicodeWidthTable.Install Graphics.Vty.UnicodeWidthTable.Main Graphics.Vty.UnicodeWidthTable.Query Graphics.Vty.UnicodeWidthTable.Types c-sources: cbits/mk_wcwidth.c