git.iko.soy/vty
on 97f48dc help sign in
4a29aec
swap
0 ahead, 277 behind
.travis.yml+17−100
since splitsnapshots
unifiedsplit
@@ -1,109 +1,26 @@
1−# This Travis job script has been generated by a script via
2−#
3−# runghc make_travis_yml_2.hs 'vty.cabal'
4−#
5−# For more information, see https://github.com/haskell-CI/haskell-ci
6−#
7−language: c
1+language: haskell
8−sudo: false
9
2
10−git:
3+notifications:
11− submodules: false # whether to recursively clone submodules
4+ email: false
12−
13−cache:
14− directories:
15− - $HOME/.cabal/packages
16− - $HOME/.cabal/store
17−
18−before_cache:
19− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
20− # remove files that are regenerated by 'cabal update'
21− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
22− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
23− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
24− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
25− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
26−
27− - rm -rfv $HOME/.cabal/packages/head.hackage
28
5
29matrix:
6matrix:
30− include:
7+ allow_failures:
31− - compiler: "ghc-8.4.3"
8+ - env: CABALVER=head GHCVER=head
32− # env: TEST=--disable-tests BENCH=--disable-benchmarks
33− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}
34− - compiler: "ghc-8.2.2"
35− # env: TEST=--disable-tests BENCH=--disable-benchmarks
36− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}}
37− - compiler: "ghc-8.0.2"
38− # env: TEST=--disable-tests BENCH=--disable-benchmarks
39− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}}
40− - compiler: "ghc-7.10.3"
41− # env: TEST=--disable-tests BENCH=--disable-benchmarks
42− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}}
43
9
44−before_install:
10+env:
45− - HC=${CC}
11+ - CABALVER=1.22 GHCVER=7.10.1
46− - HCPKG=${HC/ghc/ghc-pkg}
12+ - CABALVER=1.24 GHCVER=8.0.1
47− - unset CC
13+ - CABALVER=1.24 GHCVER=8.0.2
48− - ROOTDIR=$(pwd)
14+ - CABALVER=head GHCVER=head
49− - mkdir -p $HOME/.local/bin
50− - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"
51− - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))
52− - echo $HCNUMVER
53
15
54install:
16install:
55− - cabal --version
17+ - ./ci/travis_ci_install
56− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
57− - BENCH=${BENCH---enable-benchmarks}
58− - TEST=${TEST---enable-tests}
59− - HADDOCK=${HADDOCK-true}
60− - UNCONSTRAINED=${UNCONSTRAINED-true}
61− - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}
62− - GHCHEAD=${GHCHEAD-false}
63− - travis_retry cabal update -v
64− - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"
65− - rm -fv cabal.project cabal.project.local
66− - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
67− - "printf 'packages: \".\"\\n' > cabal.project"
68− - touch cabal.project.local
69− - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- vty | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
70− - cat cabal.project || true
71− - cat cabal.project.local || true
72− - if [ -f "./configure.ac" ]; then
73− (cd "." && autoreconf -i);
74− fi
75− - rm -f cabal.project.freeze
76− - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
77− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
78− - rm -rf .ghc.environment.* "."/dist
79− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
80
18
81−# Here starts the actual work to be performed for the package under test;
82−# any command which exits with a non-zero exit code causes the build to fail.
83script:
19script:
84− # test that source-distributions can be generated
20+ - ./ci/travis_ci_script
85− - (cd "." && cabal sdist)
86− - mv "."/dist/vty-*.tar.gz ${DISTDIR}/
87− - cd ${DISTDIR} || false
88− - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
89− - "printf 'packages: vty-*/*.cabal\\n' > cabal.project"
90− - touch cabal.project.local
91− - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- vty | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
92− - cat cabal.project || true
93− - cat cabal.project.local || true
94− # this builds all libraries and executables (without tests/benchmarks)
95− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
96
21
97− # build & run tests, build benchmarks
22+before_install:
98− - cabal new-build -w ${HC} ${TEST} ${BENCH} all
23+ - sudo add-apt-repository -y ppa:hvr/ghc
99− - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi
24+ - sudo apt-get update
100−
25+ - sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER
101− # haddock
26+ - export PATH=/opt/ghc/$GHCVER/bin:$PATH
102− - rm -rf ./dist-newstyle
103− - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi
104−
105− # Build without installed constraints for packages in global-db
106− - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi
107−
108−# REGENDATA ["vty.cabal"]
109−# EOF
CHANGELOG.md+375−747
@@ -1,861 +1,489 @@
1−
2−5.35.1
3−------
4−
5−Bug fixes:
6− * Fixed a build issue with a test program.
7−
8−5.35
9−----
10−
11−New features:
12− * Add support for 24-bit color (thanks @u-quark). This change
13− updates Vty to look at the `COLORTERM` environment variable that is
14− conventionally used to advertise support for truecolor escape
15− sequences. The change also updates the Vty demo to demonstrate
16− 24-bit colors. This change also adds a new data type, `ColorMode`,
17− to represent the color mode in use, as well as an `Output` interface
18− field, `outputColorMode`, to track the active color mode and use it
19− to clamp emitted color escape sequences to the active color range.
20−
21−API changes:
22− * All types in `Graphics.Vty.Input.Events` now have strict constructor
23− fields.
24− * Internal events are now wrapped in a new `InternalEvent` type to
25− improve how signal handling is done. This change modifies the `Input`
26− type's event channel API to produce `InternalEvents`, not `Events`.
27− The new `InternalEvent` either wraps `Event` with the `InputEvent`
28− constructor (the previous behavior) or indicates that Vty resumed
29− after handling a signal using the `ResumeAfterSignal` constructor.
30− This change avoids the previous use of `EvResize` with lazy exception
31− arguments as a sentinel value for `ResumeAfterSignal`.
32−
33−Other enhancements:
34− * Bracketed paste parsing performance has been greatly improved thanks
35− to benchmarking and optimization work by @iphydf. As part of that
36− work, Vty now uses bytestrings rather than Strings internally when
37− parsing input to look for events.
38− * The `\b` value is now interpreted as `KBS` (thanks @vglfr)
39−
40−5.34
41−----
42−
43−API changes:
44− * Added an `NFData` instance for `Event` (thanks Mario Lang)
45− * Removed `Monoid` and `Semigroup` instances for `Attr` and
46− `MaybeDefault`. This change removed the instances because they were
47− misbehaved; merging `Attr` and `MaybeDefault` values with these
48− instances resulted in field value losses. For example, before this
49− change,
50−```
51−(defAttr `withForeColor` blue) <> (defAttr `withBackColor` green)
52−```
53− would result in just
54−```
55− (defAttr `withBackColor` green)
56−```
57− because the instances were designed to favor the right-hand
58− arguments' fields even if they had not been explicitly set
59− (a consequence of the `MaybeDefault` `Semigroup` instance).
60− While that behavior was sensible specifically in the context of
61− `Graphics.Vty.Inline`, it wasn't a useful user-facing API and it made
62− for surprising instance behavior. Since there is actually no good way
63− to handle this in a `Semigroup` instance for `Attr` -- some choices
64− have to be made about how to merge two attributes' foreground colors,
65− and that won't be much better than what we had -- the instance was
66− just removed.
67−
68−
69−5.33
70−----
71−
72−API changes:
73−* The `Cursor` type got a new `PositionOnly` constructor for cursor
74− placement without visibility.
75−
76−Package changes:
77−* Relaxed upper bound for `random`
78−* Updated `microlens` bounds to allow 0.4.12
79−
80−Other improvements:
81−* Various hlint-driven improvements (thanks Willem Van Onsem)
82−* The implementation of `color240` was improved (thanks (Willem Van
83− Onsem)
84−
85−5.32
86−----
87−
88−New features:
89− * Meta-PageUp and Meta-PageDown are now supported (#193)
90− * Added `supportsItalics` and `supportsStrikethrough` functions to
91− check for feature support in terminfo
92−
93−Bug fixes:
94− * Detect utf-8 mode in `LANG` regardless of case (thanks Emeka
95− Nkurumeh)
96−
97−5.31
98−----
99−
100−New features and API changes:
101− * Added support for strikethrough mode. This change adds a new
102− `strikethrough` `Style` value and uses the `smxx` and `rmxx`
103− Terminfo capabilities to activate and deactivate strikethrough mode,
104− respectively. If the terminfo does not report those capabilities,
105− this style is ignored.
106− * `Output`: added the `setDisplayBounds` field to set the output
107− dimensions of the output handle; added an implementation of this for
108− the `TerminfoBased` backend.
109−
110−Other changes:
111− * The C prototype for `vty_c_get_window_size` in `gwinsz.h` was fixed.
112−
113−5.30
114−----
115−
116−New features:
117− * Added `Graphics.Vty.setWindowTitle` to emit an escape
118− sequence to set the window title, provide the terminal emulator
119− accepts Xterm-style title sequences. For details, see:
120− https://tldp.org/HOWTO/Xterm-Title-3.html
121−
122−5.29
123−----
124−
125−API changes:
126− * The Input type got a new field, 'restoreInputState'. This field
127− allows the end user to have direct access to the logic needed to
128− restore the terminal's input state flags. Prior to having this field,
129− this state restoration logic could only be invoked as part of calling
130− 'shutdownInput', but since that function does other things (like
131− killing threads) it is not advisable to call it repeatedly (which is
132− necessary in the use case this change is intended to support). This
133− can be called directly to restore the input state flags as needed,
134− although this is not required if 'shutdown' (or 'shutdownInput') is
135− called.
136−
137−Other changes:
138− * attributeControl: explicitly enable the ICRNL terminal mode flag (see
139− #187 and c572ad).
140−
141−5.28.2
142−------
143−
144−Bug fixes:
145− * Added a package dependency on `semigroups` for the
146− `vty-build-width-table` tool on older GHCs (#185)
147−
148−5.28.1
149−------
150−
151−Bug fixes:
152− * `installUnicodeWidthTable`: use `throwIO`, not `throw`
153−
154−5.28
155−----
156−
157−This release improves Vty's support for multi-column Unicode characters
158−and provides greater compatibility with a wider array of terminal
159−emulators. The following sections summarize the relevant changes, but an
160−overview of the new functionality is motivated and detailed in the new
161−"Multi-Column Character Support" README section. For
162−historical context, please also consider reading over
163−[#175](https://github.com/jtdaugherty/vty/issues/175).
164−
165−API changes:
166− * New modules were added:
167− * `Graphics.Vty.UnicodeWidthTable.Types`
168− * `Graphics.Vty.UnicodeWidthTable.IO`
169− * `Graphics.Vty.UnicodeWidthTable.Query`
170− * `Graphics.Vty.UnicodeWidthTable.Install`
171− * The `Config` type got a new field, `allowCustomUnicodeWidthTables`,
172− that controls whether `mkVty` will attempt to load a Unicode width
173− table if specified in the configuration.
174−
175−Configuration file changes:
176− * A new syntax was added to support specifying Unicode width tables on
177− a per-`TERM` basis. The syntax is `widthMap <TERM> <PATH>`. See the
178− documentation for `Graphics.Vty.Config` for details. Since prior
179− versions of this library will silently ignore any configuration file
180− lines they cannot parse, this change to user configuration files is
181− at least non-breaking for older versions of Vty.
182−
183−Other changes:
184− * The `mkVty` function now automatically attempts to load a custom
185− Unicode width table if one is specified in the configuration,
186− provided `allowCustomUnicodeWidthTables` is not set to `Just False`.
187− See the documentation for `Graphics.Vty.mkVty` for details.
188− * Vty now includes a command line tool, `vty-build-width-table`, that
189− queries the terminal emulator to construct a custom Unicode width
190− table and optionally update the Vty configuration file to use it.
191− Programs that want to use that tool's functionality may also do so
192− via the API exposed in the various modules listed above.
193−
194−5.27
195−----
196−
197−* Added `Graphics.Vty.Config.getTtyEraseChar` to support querying the
198− kernel for the current terminal's settings to obtain the character
199− assigned by the `stty erase` command. That can then be added to the
200− Vty configuration's input map to map to `KBS` (backspace) if desired.
201−
202−5.26
203−----
204−
205−* Resolved various import warnings (thanks @glguy)
206−* Removed the `MonadIO` constraint from the Output type's fields and
207− removed `MonadFail` uses (PR #177, thanks @glguy)
208−* Clarified documentation for ANSI colors (thanks Colby Jenn)
209−* `Graphics.Vty.Attributes` no longer re-exports
210− `Graphics.Vty.Attributes.Color`
211−* The `Graphics.Vty.Attributes.Color` module is now exposed (thanks
212− Colby Jenn)
213−* Raised upper bound for `microlens` to 0.4.12 (thanks Artyom Kazak)
214−* Changed from using `System.Posix.Env.getEnv` to
215− `System.Environment.lookupEnv` (thanks Jonathan Osser)
216−* Added `Graphics.Vty.Image` functions for dealing with character width
217− computations on `Text` values instead of `Strings`:
218− * `safeWctwidth`
219− * `safeWctlwidth`
220− * `wctwidth`
221− * `wctlwidth`
222−
223−5.25.1
224−------
225−
226−* Avoided a conflict with a Microlens 0.4.10 operator and added an
227− upper bound on Microlens of 0.4.11.
228−
229−5.25
230−----
231−
232−* The Vty type got a new field, isShutdown, that returns whether the
233− Vty handle has had its 'shutdown' function called (thanks Ian
234− Jeffries)
235−* Vty's shutdown function is now thread-safe.
236−
237−5.24.1
238−------
239−
240−* The "shutdown" method of Vty handles is now idempotent (#159)
241−
242−5.24
243−----
244−
245−* Add Generic and NFData instances for some types
246−* Image: remove custom Show instance, add derived Show and Read
247− instances
248−* Updated Travis build settings (thanks Eric Mertens)
249−
250−5.23.1
251−------
252−
253−* Fixed a bug where italics did not combine properly with other display
254− modes (#155, thanks Eric Mertens)
255−
256−5.23
257−----
258−
259−* Added support for italicized output when terminfo supports it. This
260− takes the form of a new Style, "italic". Note that most terminfo
261− descriptors do not report capabilities for italics, so support for
262− this will be very spotty.
263−* Updateed text/string function documentation to indicate that escapes
264− are not permitted in their inputs.
265−
266−5.22
267−----
268−
269−* Added Graphics.Vty.Attributes.Color240.color240CodeToRGB function
270− (thanks Brent Carmer)
271−* Added nextEventNonblocking function (field) to Vty type (#87)
272−
273−5.21
274−----
275−
276−* Picture and Background now provide Eq instances (thanks Jaro Reinders)
277−* #145: vty builds with microlens 0.4.9 (thanks Daniel Wagner)
278−* #142: note requirement of threaded RTS
279−
2805.20
15.20
281−----
282−
283API changes:
2API changes:
284−* Split up Monoid instances into Monoid and Semigroup for newer GHCs
3+ - Split up Monoid instances into Monoid and Semigroup for newer GHCs
285− (thanks Ryan Scott)
4+ (thanks Ryan Scott)
286
5
2875.19.1
65.19.1
288−------
289−
290API changes:
7API changes:
291−* Cursor now provides an Eq instance (thanks Jaro Reinders)
8+ * Cursor now provides an Eq instance (thanks Jaro Reinders)
292
9
2935.19
105.19
294−----
295−
296API changes:
11API changes:
297−* URL hyperlinking (via 'withURL') is now optional and disabled by
12+ - URL hyperlinking (via 'withURL') is now optional and disabled by
298− default due to poor support on some common terminals. A new 'Mode'
13+ default due to poor support on some common terminals. A new 'Mode'
299− constructor, 'Hyperlink', has been added to enable this feature. To
14+ constructor, 'Hyperlink', has been added to enable this feature. To
300− change the hyperlinking mode, use 'setMode' on the 'outputIface' of a
15+ change the hyperlinking mode, use 'setMode' on the 'outputIface' of a
301− Vty handle.
16+ Vty handle.
302
17
3035.18.1
185.18.1
304−------
305−
306Bug fixes:
19Bug fixes:
307−* Reset the hyperlink state on line endings to avoid run-on hyperlinks
20+ - Reset the hyperlink state on line endings to avoid run-on hyperlinks
308
21
3095.18
225.18
310−----
311−
312API changes:
23API changes:
313−* Added support for hyperlinking attributes (thanks Getty Ritter). This
24+ - Added support for hyperlinking attributes (thanks Getty Ritter). This
314− change adds a new Attr field for containing the hyperlink to apply,
25+ change adds a new Attr field for containing the hyperlink to apply,
315− as per https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda
26+ as per https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda
316
27
3175.17.1
285.17.1
318−------
319−
320−* withStyle now ignores zero arguments, leaving attribute styles
29+ - withStyle now ignores zero arguments, leaving attribute styles
321− untouched if the input style is the null style
30+ untouched if the input style is the null style
322
31
3235.17
325.17
324−----
325−
326API changes:
33API changes:
327−* Add support for terminal focus events. This change adds a new mode
34+ - Add support for terminal focus events. This change adds a new mode
328− usable with setMode, Focus, that requests that the terminal send
35+ usable with setMode, Focus, that requests that the terminal send
329− events on focus lose/gain. This change also adds two new Event
36+ events on focus lose/gain. This change also adds two new Event
330− constructors, EvLostFocus and EvGainedFocus.
37+ constructors, EvLostFocus and EvGainedFocus.
331−* No longer enable UTF8 mouse event encoding. This encoding was not
38+ - No longer enable UTF8 mouse event encoding. This encoding was not
332− working properly with Terminal.app, and using the other modes (SGR,
39+ working properly with Terminal.app, and using the other modes (SGR,
333− etc.) work.
40+ etc.) work.
334−* Graphics.Vty.Attributes: escape backticks in Haddock comment (fixes
41+ - Graphics.Vty.Attributes: escape backticks in Haddock comment (fixes
335− #131)
42+ #131)
336
43
3375.16
445.16
338−----
339−
340API changes:
45API changes:
341−* Added support for mouse wheel events while in mouse mode. The Button
46+ - Added support for mouse wheel events while in mouse mode. The Button
342− type got two new constructors as a result: BScrollUp and BScrollDown.
47+ type got two new constructors as a result: BScrollUp and BScrollDown.
343− Thanks to doublescale@tutanota.com for this contribution!
48+ Thanks to doublescale@tutanota.com for this contribution!
344
49
345Bug fixes:
50Bug fixes:
346−* charFill now clamps negative arguments to zero (thanks Eric Mertens!)
51+ - charFill now clamps negative arguments to zero (thanks Eric
52+ Mertens!)
347
53
3485.15.1
545.15.1
349−------
350−
351Package changes:
55Package changes:
352−* Documentation files are now marked accordingly (thanks Michal
56+ - Documentation files are now marked accordingly (thanks Michal
353− Suchánek)
57+ Suchánek)
354
58
355Bug fixes:
59Bug fixes:
356−* translateX/Y: fix negative translations
60+ - translateX/Y: fix negative translations
357
61
3585.15
625.15
359−----
360−
361Package changes:
63Package changes:
362−* Discontinued support for GHC versions prior to 7.10.1.
64+ - Discontinued support for GHC versions prior to 7.10.1.
363−* Removed instructions and configuration for Stack builds since they
65+ - Removed instructions and configuration for Stack builds since they
364− are no longer supported.
66+ are no longer supported.
365−* Clarified README mention of (lack of) Windows support (contributors
67+ - Clarified README mention of (lack of) Windows support (contributors
366− wanted, though!)
68+ wanted, though!)
367−* Removed dependency on data-default (see below).
69+ - Removed dependency on data-default (see below).
368
70
369API changes:
71API changes:
370−* Moved color definitions from Attributes to Color module.
72+ - Moved color definitions from Attributes to Color module.
371−* In lieu of data-default (Default) instances for Attr and Config, use
73+ - In lieu of data-default (Default) instances for Attr and Config, use
372− 'defAttr' and the new 'defaultConfig' (or 'mempty') instead of 'def'.
74+ 'defAttr' and the new 'defaultConfig' (or 'mempty') instead of 'def'.
373−* Graphics.Vty.Output no longer re-exports
75+ - Graphics.Vty.Output no longer re-exports
374− Graphics.Vty.Output.Interface.
76+ Graphics.Vty.Output.Interface.
375−* Removed Graphics.Vty.Prelude module and moved DisplayRegion and its
77+ - Removed Graphics.Vty.Prelude module and moved DisplayRegion and its
376− accessors to Graphics.Vty.Image.
78+ accessors to Graphics.Vty.Image.
377−* Graphics.Vty.Image no longer re-exports Graphics.Vty.Attributes.
79+ - Graphics.Vty.Image no longer re-exports Graphics.Vty.Attributes.
378−* Graphics.Vty.Picture no longer re-exports Graphics.Vty.Image.
80+ - Graphics.Vty.Picture no longer re-exports Graphics.Vty.Image.
379
81
3805.14
825.14
381−----
382−
383−* addMaybeClippedJoin: instead of raising an exception when the join
83+ - addMaybeClippedJoin: instead of raising an exception when the join
384− is totally clipped, just reduce the clip amount and continue
84+ is totally clipped, just reduce the clip amount and continue
385−* addMaybeClipped: skip blit of joins when their primary dimension is
85+ - addMaybeClipped: skip blit of joins when their primary dimension is
386− zero
86+ zero
387−* 'string' and related text functions no longer treat an empty string
87+ - 'string' and related text functions no longer treat an empty string
388− as an empty image (thanks Chris Penner). This means that now it is
88+ as an empty image (thanks Chris Penner). This means that now it is
389− possible to use 'str ""' as a non-empty image with height 1.
89+ possible to use 'str ""' as a non-empty image with height 1.
390
90
3915.13
915.13
392−----
393−
394−* Reverted changes in 5.12 due to disagreements between terminal
92+ - Reverted changes in 5.12 due to disagreements between terminal
395− emulators and utf8proc; for more details, please see the ticket
93+ emulators and utf8proc; for more details, please see the ticket
396− discussion at
94+ discussion at
397− https://github.com/coreyoconnor/vty/issues/115
95+ https://github.com/coreyoconnor/vty/issues/115
398
96
3995.12
975.12
400−----
401−
402−* Replaced 'wcwidth' with a call to the utf8proc library's character
98+ - Replaced 'wcwidth' with a call to the utf8proc library's character
403− width function, which is much more up to date (by several Unicode
99+ width function, which is much more up to date (by several Unicode
404− versions) and returns the right width for a much larger set of
100+ versions) and returns the right width for a much larger set of
405− characters.
101+ characters.
406−* Added a bundled version of the utf8proc C library.
102+ - Added a bundled version of the utf8proc C library.
407
103
4085.11.3
1045.11.3
409−------
410−
411−* Fix mouse event offsets in mouse-up events
105+ - Fix mouse event offsets in mouse-up events
412
106
4135.11.2
1075.11.2
414−------
415−
416−* Mouse events were modified so that the upper-left corner of the window
108+ - Mouse events were modified so that the upper-left corner of the
417− is (0,0) rather than (1,1).
109+ window is (0,0) rather than (1,1).
418
110
4195.11.1
1115.11.1
420−------
421−
422−* Add Generic instance for Image
112+ - Add Generic instance for Image
423−* nextEvent: stop trying to refresh on a resize event (fixes segfault
113+ - nextEvent: stop trying to refresh on a resize event (fixes segfault
424− on refresh with normal cursor positioning mode)
114+ on refresh with normal cursor positioning mode)
425−* Remove redundant clause from clipForCharWidth (thanks Eric Mertens)
115+ - Remove redundant clause from clipForCharWidth (thanks Eric Mertens)
426−* Update maintainer
116+ - Update maintainer
427
117
4285.11
1185.11
429−----
430−
431−* Vty now raises a VtyConfigurationError exception when the TERM
119+ - Vty now raises a VtyConfigurationError exception when the TERM
432− evironment variable is missing (thanks Eric Mertens)
120+ evironment variable is missing (thanks Eric Mertens)
433−* Graphics.Vty.Config got an explicit export list to avoid accidentally
121+ - Graphics.Vty.Config got an explicit export list to avoid accidentally
434− exporting internal types (thanks Eric Mertens)
122+ exporting internal types (thanks Eric Mertens)
435
123
4365.10
1245.10
437−----
438−
439−* Add absolute cursor positioning mode AbsoluteCursor to Cursor. This
125+ - Add absolute cursor positioning mode AbsoluteCursor to Cursor. This
440− mode provides greater control over cursor positioning by bypassing
126+ mode provides greater control over cursor positioning by bypassing
441− the logical positioning provided by default. Rather than positioning
127+ the logical positioning provided by default. Rather than positioning
442− the cursor by looking at the widths of characters involved, this
128+ the cursor by looking at the widths of characters involved, this
443− constructor lets you provide a physical row and column instead. This
129+ constructor lets you provide a physical row and column instead. This
444− is useful in more sophisticated programs. (thanks Eric Mertens)
130+ is useful in more sophisticated programs. (thanks Eric Mertens)
445−* Added a new Generic-derived config parser (thanks Eric Mertens)
131+ - Added a new Generic-derived config parser (thanks Eric Mertens)
446−* Fixed the MShift case in the configuration file parser (thanks Eric
132+ - Fixed the MShift case in the configuration file parser (thanks Eric
447− Mertens)
133+ Mertens)
448−* Fixed wcwidth import and matched safeWcswidth to its documented
134+ - Fixed wcwidth import and matched safeWcswidth to its documented
449− behavior. Previously vty_mk_wcwidth was being imported with the
135+ behavior. Previously vty_mk_wcwidth was being imported with
450− wrong type causing the -1 return value to be mapped to the wrong Int
136+ the wrong type causing the -1 return value to be mapped to the
451− value. Additionally safeWcswidth was using the unsafe character width
137+ wrong Int value. Additionally safeWcswidth was using the unsafe
452− function and only ensuring that the final result was non-negative.
138+ character width function and only ensuring that the final result was
453− (thanks Eric Mertens)
139+ non-negative. (thanks Eric Mertens)
454
140
4555.9.1
1415.9.1
456−-----
457−
458−* Vty now only emits UTF8 charset sequences in terminals without a
142+ - Vty now only emits UTF8 charset sequences in terminals without a
459− preexisting UTF8 declaration to avoid emitting garbage sequences
143+ preexisting UTF8 declaration to avoid emitting garbage sequences
460− (fixes #89)
144+ (fixes #89)
461
145
4625.9
1465.9
463−---
464−
465−* Added new Output methods supportsBell and ringTerminalBell to find out
147+ - Added new Output methods supportsBell and ringTerminalBell to find
466− whether the output device has an audio bell and to ring it (see #102)
148+ out whether the output device has an audio bell and to ring it (see
149+ #102)
467
150
4685.8.1
1515.8.1
469−-----
470−
471−* Fixed "refresh" to work as advertised (see #104)
152+ - Fixed "refresh" to work as advertised (see #104)
472
153
4735.8
1545.8
474−---
475−
476−* API change: EvPaste input event now provides paste data as a raw
155+ - API change: EvPaste input event now provides paste data as a raw
477− ByteString rather than a String to allow the application to decode how
156+ ByteString rather than a String to allow the application to decode
478− best to decode it
157+ how best to decode it
479
158
4805.7.1
1595.7.1
481−-----
482−
483−* ModeDemo: added an explicit Control.Applicative import for older GHCs
160+ - ModeDemo: added an explicit Control.Applicative import for older
161+ GHCs
484
162
4855.7
1635.7
486−---
487−
488−* Mouse and paste modes are now off by default.
164+ - Mouse and paste modes are now off by default.
489−* The Config type got new fields: mouseMode and bracketedPasteMode.
165+ - The Config type got new fields: mouseMode and bracketedPasteMode.
490− These determine whether these modes are enabled initially (for
166+ These determine whether these modes are enabled initially (for
491− terminals that support them).
167+ terminals that support them).
492−* Added a Mode type for modal terminal features (mouse events,
168+ - Added a Mode type for modal terminal features (mouse events,
493− bracketed paste mode) that is used with new Output interface
169+ bracketed paste mode) that is used with new Output interface
494− functions:
170+ functions:
495− * supportsMode :: Mode -> Bool tells whether the device supports a
171+ * supportsMode :: Mode -> Bool tells whether the device supports a
496− mode
172+ mode
497− * setMode :: Mode -> Bool -> IO () turns a mode on or off
173+ * setMode :: Mode -> Bool -> IO () turns a mode on or off
498− * getModeStatus :: Mode -> IO Bool tells you whether a mode is on or
174+ * getModeStatus :: Mode -> IO Bool tells you whether a mode is on or
499− off
175+ off
500−* Added a new demo program, ModeDemo.hs, to demonstrate usage of modes
176+ - Added a new demo program, ModeDemo.hs, to demonstrate usage of modes
501
177
5025.6
1785.6
503−---
504−
505−* Added support for normal and extended mouse modes in Xterm-like
179+ - Added support for normal and extended mouse modes in Xterm-like
506− terminals via the MouseDown and MouseUp Event constructors
180+ terminals via the MouseDown and MouseUp Event constructors
507−* Added support for bracketed paste mode in Xterm-like terminals via
181+ - Added support for bracketed paste mode in Xterm-like terminals via
508− the EvPaste event constructor
182+ the EvPaste event constructor
509−* Added derived Show instances for Event and Button (thanks Felix
183+ - Added derived Show instances for Event and Button (thanks Felix
510− Hirn)
184+ Hirn)
511−* Now TERM values containing "screen" will automatically use the
185+ - Now TERM values containing "screen" will automatically use the
512− XtermColor driver rather than just TerminfoBased
186+ XtermColor driver rather than just TerminfoBased
513
187
5145.5.0
1885.5.0
515−-----
516−
517−* Replaced lens dependency with microlens, microlens-mtl, microlens-th
189+ - Replaced lens dependency with microlens, microlens-mtl, microlens-th
518− dependencies. Issue #90
190+ dependencies. Issue #90
519− * Thanks Jonathan Daugherty
191+ - Thanks Jonathan Daugherty
520−* Cabal corrections.
192+ - Cabal corrections.
521− * Thanks Lennart Spitzner
193+ - Thanks Lennart Spitzner
522
194
5235.4.0
1955.4.0
524−-----
525−
526−* Changed eventChannel of Graphics.Vty.Input from Chan to
196+ - Changed eventChannel of Graphics.Vty.Input from Chan to TChan.
527− TChan. This enables clients to query if there are no pending
197+ This enables clients to query if there are no pending events. The
528− events. The Graphics.Vty interface nextEvent is unchanged.
198+ Graphics.Vty interface nextEvent is unchanged. Clients that use
529− Clients that use eventChannel directly will require updating.
199+ eventChannel directly will require updating.
530− https://github.com/coreyoconnor/vty/issues/60
200+ https://github.com/coreyoconnor/vty/issues/60
531−
5325.3.1
2015.3.1
533−-----
534−
535−* Reverted cabal file to depend on Cabal >= 1.18 instead of 1.20 due to
202+ - Reverted cabal file to depend on Cabal >= 1.18 instead of 1.20 due
536− possibly breaking this on reasonable GHC versions
203+ to possibly breaking this on reasonable GHC versions
537
204
5385.3
2055.3
539−---
540−
541−* Upgraded QuickCheck dependency to 2.7
206+ - Upgraded QuickCheck dependency to 2.7
542−* The standard IO Config (standardIOConfig) was overriding any provided
207+ - The standard IO Config (standardIOConfig) was overriding any
543− application config. In addition, the inputFd and outputFd could not be
208+ provided application config. In addition, the inputFd and outputFd
544− changed if mkVty was used. Fixed.
209+ could not be changed if mkVty was used. Fixed.
545−* Correct handling of display attributes at end of line. The output
210+ - Correct handling of display attributes at end of line. The output
546− attributes are set to default at the end of content for the line and
211+ attributes are set to default at the end of content for the line and
547− at the start of a new line. Previously the current attribute would
212+ at the start of a new line. Previously the current attribute would
548− extend to the next start of content. This was odd to reason about and
213+ extend to the next start of content. This was odd to reason about
549− was the cause of https://github.com/coreyoconnor/vty/issues/76 IIRC Yi
214+ and was the cause of https://github.com/coreyoconnor/vty/issues/76
550− requires the old behavior to display the selection region correctly.
215+ IIRC Yi requires the old behavior to display the selection region
216+ correctly.
551−* shutdown of the input thread is now performed using killThread and
217+ - shutdown of the input thread is now performed using killThread and
552− synchronization on an MVar. For correct handling of the terminal read
218+ synchronization on an MVar. For correct handling of the terminal
553− vmin and vtime the read must be a blocking read on an OS thread.
219+ read vmin and vtime the read must be a blocking read on an OS
554− This places a threadWaitRead, which will be interrupted by the
220+ thread. This places a threadWaitRead, which will be interrupted by
555− killThread, prior to the uninterruptable read. An alternative would be
221+ the killThread, prior to the uninterruptable read. An alternative
556− to re-import the read foreign call as interruptable.
222+ would be to re-import the read foreign call as interruptable.
557
223
5585.2.11
2245.2.11
559−------
560−
561−* deepseq bounds increased for tests.
225+ - deepseq bounds increased for tests.
562−* Clean up warnings when compiling on 7.10
226+ - Clean up warnings when compiling on 7.10
563− * Thanks Eric Mertens
227+ - Thanks Eric Mertens
564−* Avoid discarding input bytes after multi-byte encoded codepoint
228+ - Avoid discarding input bytes after multi-byte encoded codepoint
565− * Thanks Eric Mertens
229+ - Thanks Eric Mertens
566
230
5675.2.10
2315.2.10
568−------
569−
570−* "str" now returns EmptyImage for empty strings to match behavior of
232+ - "str" now returns EmptyImage for empty strings to match behavior of
571− other string-like Image constructors (fixes #74)
233+ other string-like Image constructors (fixes #74)
572− * Thanks Jonathan Daugherty
234+ - Thanks Jonathan Daugherty
573
235
5745.2.9
2365.2.9
575−-----
576−
577−* dependency version bumps
237+ - dependency version bumps
578− * https://github.com/coreyoconnor/vty/pull/71
238+ - https://github.com/coreyoconnor/vty/pull/71
579− * https://github.com/coreyoconnor/vty/pull/70
239+ - https://github.com/coreyoconnor/vty/pull/70
580−* Correct/Simplify the example code
240+ - Correct/Simplify the example code
581− * Thanks glguy
241+ - Thanks glguy
582− * https://github.com/coreyoconnor/vty/pull/69
242+ - https://github.com/coreyoconnor/vty/pull/69
583
243
5845.2.8
2445.2.8
585−-----
586−
587−* blaze-builder, lens, utf8-string version constraint bump
245+ - blaze-builder, lens, utf8-string version constraint bump
588− * Thanks glguy
246+ - Thanks glguy
589− * https://github.com/coreyoconnor/vty/pull/67
247+ - https://github.com/coreyoconnor/vty/pull/67
590−* Do not differentiate based on TERM_PROGRAM
248+ - Do not differentiate based on TERM_PROGRAM
591− * https://github.com/coreyoconnor/vty/issues/68
249+ - https://github.com/coreyoconnor/vty/issues/68
592
250
5935.2.7
2515.2.7
594−-----
595−
596−* lens and deepseq constraint bump + misc
252+ - lens and deepseq constraint bump + misc
597− * Thanks ethercrow
253+ - Thanks ethercrow
598− * https://github.com/coreyoconnor/vty/pull/66
254+ - https://github.com/coreyoconnor/vty/pull/66
599
255
6005.2.6
2565.2.6
601−-----
602−
603−* lens constraint bump
257+ - lens constraint bump
604− * Thanks alexander-b!
258+ - Thanks alexander-b!
605− * https://github.com/coreyoconnor/vty/pull/64
259+ - https://github.com/coreyoconnor/vty/pull/64
606
260
6075.2.5
2615.2.5
608−-----
609−
610−* lens and random version constraint bump.
262+ - lens and random version constraint bump.
611− * Thanks RyanGlScott!
263+ - Thanks RyanGlScott!
612− * https://github.com/coreyoconnor/vty/pull/62
264+ - https://github.com/coreyoconnor/vty/pull/62
613
265
6145.2.4
2665.2.4
615−-----
616−
617−* removed -fpic from cc-options. No longer required.
267+ - removed -fpic from cc-options. No longer required.
618− * https://github.com/coreyoconnor/vty/issues/61
268+ - https://github.com/coreyoconnor/vty/issues/61
619− * https://ghc.haskell.org/trac/ghc/ticket/9657
269+ - https://ghc.haskell.org/trac/ghc/ticket/9657
620− * Thanks Fuuzetsu!
270+ - Thanks Fuuzetsu!
621
271
6225.2.3
2725.2.3
623−-----
624−
625−* evaluate/compile the input parsing table once instead of each
273+ - evaluate/compile the input parsing table once instead of each
626− keystroke.
274+ keystroke.
627− * https://github.com/coreyoconnor/vty/pull/59
275+ - https://github.com/coreyoconnor/vty/pull/59
628− * Thanks ethercrow!
276+ - Thanks ethercrow!
629
277
6305.2.2
2785.2.2
631−-----
632−
633−* When looking at input for an event, don't look too deep.
279+ - When looking at input for an event, don't look too deep.
634− * https://github.com/coreyoconnor/vty/pull/57
280+ - https://github.com/coreyoconnor/vty/pull/57
635− * Thanks ethercrow!
281+ - Thanks ethercrow!
636
282
6375.2.1
2835.2.1
638−-----
639−
640−* Bump upper version bound for lens to 4.5. Thanks markus1189!
284+ - Bump upper version bound for lens to 4.5. Thanks markus1189!
641
285
6425.2.0
2865.2.0
643−-----
644−
645−* Config structure now specifies file descriptor to use. The default
287+ - Config structure now specifies file descriptor to use. The default
646− is stdInput and stdOutput file descriptors. Previously Vty used
288+ is stdInput and stdOutput file descriptors. Previously Vty used
647− stdInput for input and the follow code for output:
289+ stdInput for input and the follow code for output:
648− * hDuplicate stdout >>= handleToFd >>= (`hSetBuffering`
290+ - hDuplicate stdout >>= handleToFd >>= (`hSetBuffering`
649− NoBuffering)
291+ NoBuffering)
650− * the difference was required by Vty.Inline. Now, Vty.Inline uses
292+ - the difference was required by Vty.Inline. Now, Vty.Inline uses
651− the Config structure options to acheive the same effect.
293+ the Config structure options to acheive the same effect.
652−* removed: derivedVtime, derivedVmin, inputForCurrentTerminal,
294+ - removed: derivedVtime, derivedVmin, inputForCurrentTerminal,
653− inputForNameAndIO, outputForCurrentTerminal, outputForNameAndIO
295+ inputForNameAndIO, outputForCurrentTerminal, outputForNameAndIO
654−* added: inputForConfig, outputForConfig
296+ - added: inputForConfig, outputForConfig
655−* updates to vty-rogue from jtdaugherty. Thanks!
297+ - updates to vty-rogue from jtdaugherty. Thanks!
656−* the oldest version of GHC tested to support vty is 7.6.2.
298+ - the oldest version of GHC tested to support vty is 7.6.2.
657−* the oldest version of GHC that vty compiles under is 7.4.2
299+ - the oldest version of GHC that vty compiles under is 7.4.2
658
300
6595.1.4
3015.1.4
660−-----
661−
662−* merged https://github.com/coreyoconnor/vty/pull/51 thanks trofi!
302+ - merged https://github.com/coreyoconnor/vty/pull/51 thanks trofi!
663
303
6645.1.1
3045.1.1
665−-----
666−
667−* merged https://github.com/coreyoconnor/vty/pull/48 thanks sjmielke!
305+ - merged https://github.com/coreyoconnor/vty/pull/48 thanks sjmielke!
668−* jtdaugherty resolved a number of compiler warnings. Thanks!
306+ - jtdaugherty resolved a number of compiler warnings. Thanks!
669
307
6705.1.0
3085.1.0
671−-----
672−
673−* vmin and vtime can be specified however the application requires.
309+ - vmin and vtime can be specified however the application requires.
674− See Graphics.Vty.Config.
310+ See Graphics.Vty.Config.
675−* fixed the processing of input when vmin is set > 1.
311+ - fixed the processing of input when vmin is set > 1.
676
312
6775.0.0
3135.0.0
678−-----
679−
680−* The naming convention now matches:
314+ - The naming convention now matches:
681− * http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions
315+ - http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions
682−* all projects using vty for input must be compiled with -threaded.
316+ - all projects using vty for input must be compiled with -threaded.
683− Please notify vty author if this is not acceptable.
317+ Please notify vty author if this is not acceptable.
684−* mkVtyEscDelay has been removed. Use "mkVty def". Which initialized
318+ - mkVtyEscDelay has been removed. Use "mkVty def". Which initialized
685− vty with the default configuration.
319+ vty with the default configuration.
686−* input handling changes
320+ - input handling changes
687− * KASCII is now KChar
321+ - KASCII is now KChar
688− * KPN5 is now KCenter
322+ - KPN5 is now KCenter
689− * tests exist.
323+ - tests exist.
690− * Applications can add to the input tables by setting inputMap of
324+ - Applications can add to the input tables by setting inputMap of
691− the Config. See Graphics.Vty.Config
325+ the Config. See Graphics.Vty.Config
692− * Users can define input table extensions that will apply to all vty
326+ - Users can define input table extensions that will apply to all vty
693− applications. See Graphics.Vty.Config
327+ applications. See Graphics.Vty.Config
694− * terminal timing is now handled by selecting an appropriate VTIME.
328+ - terminal timing is now handled by selecting an appropriate VTIME.
695− Previously this was implemented within Vty itself. This reduced
329+ Previously this was implemented within Vty itself. This reduced
696− complexity in vty but provides a different meta key behavior and
330+ complexity in vty but provides a different meta key behavior and
697− implies a requirement on -threaded.
331+ implies a requirement on -threaded.
698− * The time vty will wait to verify an ESC byte means a single ESC
332+ - The time vty will wait to verify an ESC byte means a single ESC
699− key is the singleEscPeriod of the Input Config structure.
333+ key is the singleEscPeriod of the Input Config structure.
700−* removed the typeclass based terminal and display context interface
334+ - removed the typeclass based terminal and display context interface
701− in favor of a data structure of properties interface.
335+ in favor of a data structure of properties interface.
702−* renamed the Terminal interface to Output
336+ - renamed the Terminal interface to Output
703−* The default picture for an image now uses the "clear" background.
337+ - The default picture for an image now uses the "clear" background.
704− This background fills background spans with spaces or just ends the
338+ This background fills background spans with spaces or just ends the
705− line.
339+ line.
706− * Previously the background defaulted to the space character. This
340+ - Previously the background defaulted to the space character. This
707− causes issues copying text from a text editor. The text would end
341+ causes issues copying text from a text editor. The text would end
708− up with extra spaces at the end of the line.
342+ up with extra spaces at the end of the line.
709−* Layer support
343+ - Layer support
710− * Each layer is an image.
344+ - Each layer is an image.
711− * The layers for a picture are a list of images.
345+ - The layers for a picture are a list of images.
712− * The first image is the top-most layer. The images are ordered from
346+ - The first image is the top-most layer. The images are ordered from
713− top to bottom.
347+ top to bottom.
714− * The transparent areas for a layer are the backgroundFill areas.
348+ - The transparent areas for a layer are the backgroundFill areas.
715− backgroundFill is added to pad images when images of different
349+ backgroundFill is added to pad images when images of different
716− sizes are joined.
350+ sizes are joined.
717− * If the background is clear there is no background layer.
351+ - If the background is clear there is no background layer.
718− * If there is a background character then the bottom layer is the
352+ - If there is a background character then the bottom layer is the
719− background layer.
353+ background layer.
720− * emptyPicture is a Picture with no layers and no cursor
354+ - emptyPicture is a Picture with no layers and no cursor
721− * addToTop and addToBottom add a layer to the top and bottom of the
355+ - addToTop and addToBottom add a layer to the top and bottom of the
722− given Picture.
356+ given Picture.
723−* compatibility improvements:
357+ - compatibility improvements:
724− * terminfo based terminals with no cursor support are silently
358+ - terminfo based terminals with no cursor support are silently
725− accepted. The cursor visibility changes in the Picture will have
359+ accepted. The cursor visibility changes in the Picture will have
726− no effect.
360+ no effect.
727− * alternate (setf/setb) color maps supported. Though colors beyond
361+ - alternate (setf/setb) color maps supported. Though colors beyond
728− the first 8 are just a guess.
362+ the first 8 are just a guess.
729− * added "rgbColor" for easy support of RGB specified colors.
363+ - added "rgbColor" for easy support of RGB specified colors.
730− * Both applications and users can add to the mapping used to
364+ - Both applications and users can add to the mapping used to
731− translate from input bytes to events.
365+ translate from input bytes to events.
732−* Additional information about input and output process can be
366+ - Additional information about input and output process can be
733− appended to a debug log
367+ appended to a debug log
734− * Set environment variable VTY_DEBUG_LOG to path of debug log
368+ - Set environment variable VTY_DEBUG_LOG to path of debug log
735− * Or use "debugLog <path>" config directive
369+ - Or use "debugLog <path>" config directive
736− * Or set 'debugLog' property of the Config provided to mkVty.
370+ - Or set 'debugLog' property of the Config provided to mkVty.
737−* examples moved to vty-examples package. See test directory for cabal
371+ - examples moved to vty-examples package. See test directory for cabal
738− file.
372+ file.
739− * vty-interactive-terminal-test
373+ - vty-interactive-terminal-test
740− * interactive test. Useful for building a bug report for vty's
374+ - interactive test. Useful for building a bug report for vty's
741− author.
375+ author.
742− * test/interactive_terminal_test.hs
376+ - test/interactive_terminal_test.hs
743− * vty-event-echo
377+ - vty-event-echo
744− * view a input event log for vty. Example of interacting with
378+ - view a input event log for vty. Example of interacting with
745− user.
379+ user.
746− * test/EventEcho.hs
380+ - test/EventEcho.hs
747− * vty-rogue
381+ - vty-rogue
748− * The start of a rogue-like game. Example of layers and image
382+ - The start of a rogue-like game. Example of layers and image
749− build operations.
383+ build operations.
750− * test/Rogue.hs
384+ - test/Rogue.hs
751− * vty-benchmark
385+ - vty-benchmark
752− * benchmarks vty. A series of tests that push random pictures to
386+ - benchmarks vty. A series of tests that push random pictures to
753− the terminal. The random pictures are generated using
387+ the terminal. The random pictures are generated using
754− QuickCheck. The same generators used in the automated tests.
388+ QuickCheck. The same generators used in the automated tests.
755− * test/benchmark.hs
389+ - test/benchmark.hs
756
390
7574.7.0.0
3914.7.0.0
758−-------
392+ - API changes:
393+ - Added Graphics.Vty.Image.crop: Ensure an image is no larger
394+ than the specified size.
395+ - Added Graphics.Vty.Image.pad: Ensure an image is no smaller
396+ than the specified size.
397+ - Added Graphics.Vty.Image.translate: Offset an image.
398+ - Thanks Ben Boeckel <MathStuf@gmail.com> for these features.
759
399
760−API changes:
400+4.3.0.0
761−* Added Graphics.Vty.Image.crop: Ensure an image is no larger
762− than the specified size.
763−* Added Graphics.Vty.Image.pad: Ensure an image is no smaller
764− than the specified size.
765−* Added Graphics.Vty.Image.translate: Offset an image.
766−* Thanks Ben Boeckel <MathStuf@gmail.com> for these features.
767
401
7684.2.1.0
4024.2.1.0
769−-------
770−
771−API changes:
403+ - API changes:
772−* Attr record accessor fore_color changed to attr_fore_color
404+ - Attr record accessor fore_color changed to attr_fore_color
773−* Attr record accessor back_color changed to attr_back_color
405+ - Attr record accessor back_color changed to attr_back_color
774−* Attr record accessor style changed to attr_style
406+ - Attr record accessor style changed to attr_style
775−* Added an "inline" display attribute changing DSL:
407+ - Added an "inline" display attribute changing DSL:
776− * put_attr_change applies a display attribute change
408+ - put_attr_change applies a display attribute change
777− immediately to a terminal
409+ immediately to a terminal
778− * For instance, can be used to change the display attrbiutes
410+ - For instance, can be used to change the display attrbiutes
779− of text output via putStrLn and putStr. EX:
411+ of text output via putStrLn and putStr. EX:
780− "put_attr_change $ back_color red" will set the background
412+ "put_attr_change $ back_color red" will set the background
781− color to red.
413+ color to red.
782− * Changes do not apply to a Picture output via output_picture.
414+ - Changes do not apply to a Picture output via output_picture.
783− * See Graphics.Vty.Inline
415+ - See Graphics.Vty.Inline
784−* Moved all IO actions into any monad an instance of MonadIO
416+ - Moved all IO actions into any monad an instance of MonadIO
785
417
7864.0.0.1
4184.0.0.1
787−-------
788−
789−* binding for mk_wcswidth was incorrect. Most platforms just
419+ - binding for mk_wcswidth was incorrect. Most platforms just
790− magically worked due to coincidence.
420+ magically worked due to coincidence.
791
421
7924.0.0
4224.0.0
793−-----
794−
795−API changes:
423+ - API changes:
796−* "getSize" has been removed. Use "terminal vty >>= display_bounds"
424+ - "getSize" has been removed. Use "terminal vty >>= display_bounds"
797− where "vty" is an instance of the Vty data structure.
425+ where "vty" is an instance of the Vty data structure.
798−* added a "terminal" field to the Vty data structure. Accesses the
426+ - added a "terminal" field to the Vty data structure. Accesses the
799− TerminalHandle associated with the Vty instance.
427+ TerminalHandle associated with the Vty instance.
800−* Graphics.Vty.Types has undergone a number of changes. Summary:
428+ - Graphics.Vty.Types has undergone a number of changes. Summary:
801− * Partitioned into Graphics.Vty.Attributes for display attributes.
429+ - Partitioned into Graphics.Vty.Attributes for display attributes.
802− Graphics.Vty.Image for image combinators. Graphics.Vty.Picture
430+ Graphics.Vty.Image for image combinators. Graphics.Vty.Picture
803− for final picture construction.
431+ for final picture construction.
804−* Graphics.Vty.Attributes:
432+ - Graphics.Vty.Attributes:
805− * "setFG" and "setBG" are now "with_fore_color" and
433+ - "setFG" and "setBG" are now "with_fore_color" and
806− "with_back_color"
434+ "with_back_color"
807− * All other "set.." equations similarly replaced.
435+ - All other "set.." equations similarly replaced.
808− * "attr" is now "def_attr", short for "default display attributes"
436+ - "attr" is now "def_attr", short for "default display attributes"
809− Also added a "current_attr" for "currently applied display
437+ Also added a "current_attr" for "currently applied display
810− attributes"
438+ attributes"
811−* Graphics.Vty.Image:
439+ - Graphics.Vty.Image:
812− * "horzcat" is now "horiz_cat"
440+ - "horzcat" is now "horiz_cat"
813− * "vertcat" is now "vert_cat"
441+ - "vertcat" is now "vert_cat"
814− * "renderBS" is now "utf8_bytestring"
442+ - "renderBS" is now "utf8_bytestring"
815− * "renderChar" is now "char"
443+ - "renderChar" is now "char"
816− * "renderFill" is now "char_fill"
444+ - "renderFill" is now "char_fill"
817− * added a "utf8_string" and "string" (AKA "iso_10464_string") for
445+ - added a "utf8_string" and "string" (AKA "iso_10464_string") for
818− UTF-8 encoded Strings and ISO-10464 encoded Strings. String
446+ UTF-8 encoded Strings and ISO-10464 encoded Strings. String
819− literals in GHC have an ISO-10464 runtime representation.
447+ literals in GHC have an ISO-10464 runtime representation.
820−* Graphics.Vty.Picture:
448+ - Graphics.Vty.Picture:
821− * exports Graphics.Vty.Image
449+ - exports Graphics.Vty.Image
822− * "pic" is now "pic_for_image"
450+ - "pic" is now "pic_for_image"
823− * added API for setting background fill pattern.
451+ - added API for setting background fill pattern.
824−* Completely rewritten output backend.
452+ - Completely rewritten output backend.
825− * Efficient, scanline style output span generator. Has not been
453+ - Efficient, scanline style output span generator. Has not been
826− fully optimized, but good enough.
454+ fully optimized, but good enough.
827− * The details required to display the desired picture on a
455+ - The details required to display the desired picture on a
828− terminal are well encapsulated.
456+ terminal are well encapsulated.
829− * Terminfo based display terminal implementation. With specialized
457+ - Terminfo based display terminal implementation. With specialized
830− derivitives for xterm, Terminal.app, and iTerm.app.
458+ derivitives for xterm, Terminal.app, and iTerm.app.
831− * Attempts to robustly handle even terminals that don't
459+ - Attempts to robustly handle even terminals that don't
832− support all display attributes.
460+ support all display attributes.
833− * I've tested the following terminals with success: iTerm.app,
461+ - I've tested the following terminals with success: iTerm.app,
834− Terminal.app, xterm, rxvt, mlterm, Eterm, gnome-terminal,
462+ Terminal.app, xterm, rxvt, mlterm, Eterm, gnome-terminal,
835− konsole, screen, linux vty. Hopefully you will be as
463+ konsole, screen, linux vty. Hopefully you will be as
836− successfull.
464+ successfull.
837− * Improved unicode support. Double wide characters will display as
465+ - Improved unicode support. Double wide characters will display as
838− expected.
466+ expected.
839−* 256 color support. See Graphics.Vty.Attributes.Color240. The actual
467+ - 256 color support. See Graphics.Vty.Attributes.Color240. The actual
840− output color is adjusted according to the number of colors the
468+ output color is adjusted according to the number of colors the
841− terminal supports.
469+ terminal supports.
842−* The Graphics.Vty.Image combinators no longer require matching
470+ - The Graphics.Vty.Image combinators no longer require matching
843− dimensions to arguments. Unspecified areas are filled in with a
471+ dimensions to arguments. Unspecified areas are filled in with a
844− user-customizable background pattern. See Graphics.Vty.Picture.
472+ user-customizable background pattern. See Graphics.Vty.Picture.
845−* output images are always cropped to display size.
473+ - output images are always cropped to display size.
846−* Significant code coverage by QuickCheck tests. An interactive test
474+ - Significant code coverage by QuickCheck tests. An interactive test
847− for those final properties that couldn't be automatically verified.
475+ for those final properties that couldn't be automatically verified.
848
476
849Issues resolved:
477Issues resolved:
850−* "gnome terminal displays non-basic attributes as strikethrough"
478+ - "gnome terminal displays non-basic attributes as strikethrough"
851− * http://trac.haskell.org/vty/ticket/14
479+ - http://trac.haskell.org/vty/ticket/14
852−* "Multi-byte characters are not displayed correctly on update"
480+ - "Multi-byte characters are not displayed correctly on update"
853− * http://trac.haskell.org/vty/ticket/10
481+ - http://trac.haskell.org/vty/ticket/10
854−* "Redraw does not handle rendering a line that extends beyond screen
482+ - "Redraw does not handle rendering a line that extends beyond screen
855− width characters"
483+ width characters"
856− * http://trac.haskell.org/vty/ticket/13
484+ - http://trac.haskell.org/vty/ticket/13
857−* "The <|> and <-> combinators should be more forgiving of mismatched
485+ - "The <|> and <-> combinators should be more forgiving of mismatched
858− dimensions"
486+ dimensions"
859− * http://trac.haskell.org/vty/ticket/9
487+ - http://trac.haskell.org/vty/ticket/9
860−* "256-color support"
488+ - "256-color support"
861− * http://trac.haskell.org/vty/ticket/19
489+ - http://trac.haskell.org/vty/ticket/19
LICENSE−2
@@ -1,5 +1,3 @@
1−BSD 3-Clause License
2−
3Copyright Stefan O'Rear 2006, Corey O'Connor 2008, Corey O'Connor 2009
1Copyright Stefan O'Rear 2006, Corey O'Connor 2008, Corey O'Connor 2009
4
2
5All rights reserved.
3All rights reserved.
README.md+53−103
@@ -18,21 +18,24 @@ cabal install vty
18
18
19# Features
19# Features
20
20
21−* Supports a large number of terminals, i.e., vt100, ansi, hurd, linux,
21+* Supports a large number of terminals. vt100, ansi, hurd, linux,
22− `screen`, etc., or anything with a sufficient terminfo entry.
22+ screen, etc., or anything with a sufficient terminfo entry.
23
23
24−* Automatically handles window resizes.
24+* Automatic handling of window resizes.
25
25
26−* Supports Unicode output on terminals with UTF-8 support.
26+* Unicode output on terminals with UTF-8 support.
27
27
28+* Handles multi-column glyphs. (Requires user to properly configure
29+ terminal.)
30+
28−* Provides an efficient output algorithm. Output buffering and terminal
31+* Efficient output. Output buffering and terminal state changes are
29− state changes are minimized.
32+ minimized.
30
33
31* Minimizes repaint area, which virtually eliminates the flicker
34* Minimizes repaint area, which virtually eliminates the flicker
32 problems that plague ncurses programs.
35 problems that plague ncurses programs.
33
36
34−* Provides a pure, compositional interface for efficiently constructing
37+* A pure, compositional interface for efficiently constructing display
35− display images.
38+ images.
36
39
37* Automatically decodes keyboard keys into (key,[modifier]) tuples.
40* Automatically decodes keyboard keys into (key,[modifier]) tuples.
38
41
@@ -41,7 +44,7 @@ cabal install vty
41* Supports a keypress timeout after for lone ESC. The timeout is
44* Supports a keypress timeout after for lone ESC. The timeout is
42 customizable.
45 customizable.
43
46
44−* Provides extensible input and output interfaces.
47+* The interface is designed for easy extension.
45
48
46* Supports ANSI graphics modes (SGR as defined in `console_codes(4)`)
49* Supports ANSI graphics modes (SGR as defined in `console_codes(4)`)
47 with a type-safe interface and graceful fallback for terminals
50 with a type-safe interface and graceful fallback for terminals
@@ -57,12 +60,6 @@ cabal install vty
57* Supports bracketed paste mode as described at
60* Supports bracketed paste mode as described at
58 http://cirw.in/blog/bracketed-paste
61 http://cirw.in/blog/bracketed-paste
59
62
60−* Supports multi-column Unicode characters such as emoji characters. In
61− cases where Vty and your terminal emulator disagree on character
62− widths, Vty provides a tool `vty-build-width-table` and library
63− functionality to build a width table that will work for your terminal
64− and load it on application startup.
65−
66# Development Notes
63# Development Notes
67
64
68Vty uses threads internally, so programs made with Vty need to be
65Vty uses threads internally, so programs made with Vty need to be
@@ -72,91 +69,12 @@ compiled with the threaded runtime using the GHC `-threaded` option.
72
69
73## Posix Terminals
70## Posix Terminals
74
71
75−For the most part, Vty uses `terminfo` to determine terminal protocol
72+Uses terminfo to determine terminal protocol. With some special rules to
76−with some special rules to handle some omissions from `terminfo`.
73+handle some omissions from terminfo.
77
74
78## Windows
75## Windows
79
76
80−Windows is not supported.
77+Unsupported (but contributions and testing here are very welcome!)
81−
82−# Multi-Column Character Support
83−
84−Vty supports rendering of multi-column characters such as two-column
85−Asian characters and Emoji characters. This section details how to
86−take advantage of this feature, since its behavior will depend on the
87−terminal emulator in use.
88−
89−Terminal emulators support Unicode to varying degrees, and each terminal
90−emulator relies on a table of column widths for each supported Unicode
91−character. Vty also needs to rely on such a table to compute the width
92−of Vty images to do image layout. Since those tables can disagree if
93−Vty and the terminal emulator support different versions of Unicode,
94−and since different terminal emulators will support different versions
95−of Unicode, it's likely that for some wide characters, Vty applications
96−will exhibit rendering problems. Those rendering problems arise from Vty
97−and the terminal emulator coming to different conclusions about how wide
98−some characters are.
99−
100−To address this, Vty supports loading custom character width tables
101−that are based on the terminal's behavior in order to eliminate these
102−disagreements. By default, though, Vty will use its built-in Unicode
103−character width table. Since the built-in table is likely to eventually
104−disagree with your terminal, Vty provides an API and a command-line tool
105−to generate and install custom tables.
106−
107−Custom Unicode width tables based on your terminal emulator can be
108−built by running Vty's built-in tool, `vty-build-width-table`. The tool
109−works by querying the current terminal emulator to obtain its width
110−measurements for the entire supported Unicode range. The
111−results are then saved to a disk file. These custom tables
112−can also be generated programmatically by using the API in
113−`Graphics.Vty.UnicodeWidthTable.Query`.
114−
115−Saved width tables can then be loaded in one of two ways:
116−
117−* Via the library API in `Graphics.Vty.UnicodeWidthTable.IO`
118−* By adding a `widthMap` directive to your Vty configuration file and
119− then invoking `mkVty` to initialize Vty
120−
121−The Vty configuration file supports the `widthMap` directive to allow
122−users to specify which custom width table should be loaded for a given
123−terminal type. This is done by specifying, e.g.,
124−
125−```
126−widthMap "xterm" "/path/to/map.dat"
127−```
128−
129−where the first argument is the value that `TERM` must have in order for
130−the table to be loaded, and the second argument is the path to the table
131−file itself as generated by the two alternatives listed above. If the
132−Vty configuration file contains multiple matching `widthMap` directives
133−for the current value of `TERM`, the last one listed in the file is
134−used.
135−
136−The tables declared in the configuration file are only ever
137−automatically loaded when applications set up Vty by calling
138−`Graphics.Vty.mkVty`.
139−
140−Before a custom table has been loaded, calls to the library's character
141−width functions (e.g. `wcwidth`) will use the default built-in table.
142−Once a custom table has been loaded, the functions will use the new
143−custom table. Only one custom table load can be performed in a Vty
144−program. Once a custom table has been loaded, it cannot be replaced or
145−removed.
146−
147−Without using a custom width table, users of Vty-based applications
148−are likely to eventually experience rendering problems with with wide
149−characters. We recommend that developers of Vty-based applications either:
150−
151−* Provide the `vty-build-width-table` tool and documentation for running
152− it and updating the Vty configuration, or
153−* Have the application invoke the Vty library's table-building
154− functionality and load the table at startup without using the Vty
155− configuration.
156−
157−The best option will depend on a number of factors: the user audience,
158−the amount of risk posed by wide character rendering, the terminal
159−emulators in use, etc.
160
78
161# Contributing
79# Contributing
162
80
@@ -170,13 +88,45 @@ should consider to make submitting patches easier for all concerned:
170 conventions already used in the codebase.
88 conventions already used in the codebase.
171 - Please provide Haddock documentation for any changes you make.
89 - Please provide Haddock documentation for any changes you make.
172
90
91+# Development Notes
92+
93+## Under NixOS
94+
95+### Using cabal
96+
97+After installing `ncurses` to the user environment:
98+
99+~~~
100+LIBRARY_PATH=$HOME/.nix-profile/lib/ cabal configure --enable-tests --extra-lib-dirs=$HOME/.nix-profile/lib
101+LIBRARY_PATH=$HOME/.nix-profile/lib/ cabal build
102+LIBRARY_PATH=$HOME/.nix-profile/lib/ cabal test
103+~~~
104+
105+## Code Coverage
106+
107+As of last testing, profiling causes issues with coverage when enabled.
108+To evaluate coverage, configure as follows:
109+
110+~~~
111+rm -rf dist ; cabal configure --enable-tests --enable-library-coverage \
112+ --disable-library-profiling \
113+ --disable-executable-profiling
114+~~~
115+
116+## Profiling
117+
118+~~~
119+rm -rf dist ; cabal configure --enable-tests --disable-library-coverage \
120+ --enable-library-profiling \
121+ --enable-executable-profiling
122+~~~
123+
173# Known Issues
124# Known Issues
174
125
175−* Terminals have numerous quirks and bugs, so mileage may vary. Please
126+* Terminals have numerous quirks and bugs. Vty picks what works best for
176− report issues as you encounter them and provide details on your
127+ the author in ambiguous or buggy situations.
177− terminal emulator, operating system, etc.
178
128
179−* STOP, TERM and INT signals are not handled.
129+* Signal handling of STOP, TERM and INT are nonexistent.
180
130
181* The character encoding of the terminal is assumed to be UTF-8 if
131* The character encoding of the terminal is assumed to be UTF-8 if
182 unicode is used.
132 unicode is used.
@@ -186,10 +136,10 @@ should consider to make submitting patches easier for all concerned:
186 (shifted F10 etc). See `Config` for customizing vty's behavior for a
136 (shifted F10 etc). See `Config` for customizing vty's behavior for a
187 particular terminal.
137 particular terminal.
188
138
189−* Vty uses the `TIOCGWINSZ` ioctl to find the current window size, which
139+* Uses the `TIOCGWINSZ` ioctl to find the current window size, which
190 appears to be limited to Linux and BSD.
140 appears to be limited to Linux and BSD.
191
141
192−# Further Reading
142+# Sources
193
143
194Good sources of documentation for terminal programming are:
144Good sources of documentation for terminal programming are:
195
145
cbits/get_tty_erase.cdeleted−18
@@ -1,18 +0,0 @@
1−#include <termios.h>
2−#include <stdio.h>
3−#include <unistd.h>
4−#include <stdlib.h>
5−
6−// Given a file descriptor for a terminal, get the ERASE character for
7−// the terminal. If the terminal info cannot be obtained, this returns
8−// zero.
9−char vty_get_tty_erase(int fd)
10−{
11− struct termios trm;
12−
13− if (0 == tcgetattr(fd, &trm)) {
14− return (char) trm.c_cc[VERASE];
15− } else {
16− return (char) 0;
17− }
18−}
cbits/gwinsz.c+5−14
@@ -1,18 +1,9 @@
1#include <sys/ioctl.h>
1#include <sys/ioctl.h>
2
2
3unsigned long vty_c_get_window_size(int fd) {
3unsigned long vty_c_get_window_size(int fd) {
4− struct winsize w;
4+ struct winsize w;
5− if (ioctl (fd, TIOCGWINSZ, &w) >= 0)
5+ if (ioctl (fd, TIOCGWINSZ, &w) >= 0)
6− return (w.ws_row << 16) + w.ws_col;
6+ return (w.ws_row << 16) + w.ws_col;
7− else
7+ else
8− return 0x190050;
8+ return 0x190050;
9−}
10−
11−void vty_c_set_window_size(int fd, unsigned long val) {
12− struct winsize w;
13− if (ioctl(fd, TIOCGWINSZ, &w) >= 0) {
14− w.ws_row = val >> 16;
15− w.ws_col = val & 0xFFFF;
16− ioctl(fd, TIOCSWINSZ, &w);
17− }
18}
9}
cbits/gwinsz.h+1−2
@@ -1,2 +1 @@
1−unsigned long vty_c_get_window_size(int fd);
1+unsigned long vty_c_get_window_size(void);
2−unsigned long vty_c_set_window_size(int fd, unsigned long val);
cbits/mk_wcwidth.c+2−136
@@ -60,28 +60,6 @@
60 */
60 */
61
61
62#include <HsFFI.h>
62#include <HsFFI.h>
63−#include <stdlib.h>
64−#include <string.h>
65−
66−// The maximum size for a custom character width table is the total
67−// number of possible characters as dictated by the compiler.
68−#define MAX_CUSTOM_TABLE_SIZE (HS_CHAR_MAX + 1)
69−
70−// The pointer to the start of the custom character width table, if
71−// any. If this is NULL or this is set but the ready flag is false, the
72−// built-in tree search logic is used.
73−static uint8_t* custom_table = NULL;
74−
75−// The size of the custom table, in entries. This should only be set
76−// if custom_table is not NULL. Its value should be the size of the
77−// custom_table array.
78−static uint32_t custom_table_size = 0;
79−
80−// A flag indicating whether the custom table is ready for
81−// use. This should only be set once the table has been
82−// allocated with vty_init_custom_table and initialized with
83−// vty_set_custom_table_range.
84−static uint8_t custom_table_ready = 0;
85
63
86struct interval {
64struct interval {
87 int first;
65 int first;
@@ -141,7 +119,7 @@ static int vty_bisearch(HsChar ucs, const struct interval *table, int max) {
141 * in ISO 10646.
119 * in ISO 10646.
142 */
120 */
143
121
144−static HsInt builtin_wcwidth(HsChar ucs)
122+HsInt vty_mk_wcwidth(HsChar ucs)
145{
123{
146 /* sorted list of non-overlapping intervals of non-spacing characters */
124 /* sorted list of non-overlapping intervals of non-spacing characters */
147 /* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c" */
125 /* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c" */
@@ -204,7 +182,7 @@ static HsInt builtin_wcwidth(HsChar ucs)
204
182
205 /* binary search in table of non-spacing characters */
183 /* binary search in table of non-spacing characters */
206 if (vty_bisearch(ucs, combining,
184 if (vty_bisearch(ucs, combining,
207− sizeof(combining) / sizeof(struct interval) - 1))
185+ sizeof(combining) / sizeof(struct interval) - 1))
208 return 0;
186 return 0;
209
187
210 /* if we arrive here, ucs is not a combining or C0/C1 control character */
188 /* if we arrive here, ucs is not a combining or C0/C1 control character */
@@ -224,115 +202,3 @@ static HsInt builtin_wcwidth(HsChar ucs)
224 (ucs >= 0x20000 && ucs <= 0x2fffd) ||
202 (ucs >= 0x20000 && ucs <= 0x2fffd) ||
225 (ucs >= 0x30000 && ucs <= 0x3fffd)));
203 (ucs >= 0x30000 && ucs <= 0x3fffd)));
226}
204}
227−
228−// Return the width, in terminal cells, of the specified character.
229−//
230−// If the global custom width table is present, that table will be
231−// consulted for the character's width. If the character is not in
232−// the table, zero will be returned. If the custom width table is not
233−// present, the built-in width table will be used.
234−HsInt vty_mk_wcwidth(HsChar ch)
235−{
236− if (custom_table_ready) {
237− if ((ch >= 0) && (ch < custom_table_size)) {
238− return custom_table[ch];
239− } else {
240− return -1;
241− }
242− } else {
243− return builtin_wcwidth(ch);
244− }
245−}
246−
247−// Initialize a custom character width table.
248−//
249−// This allocates a new character width table of the specified size
250−// (in characters). If a custom table has already been allocated, this
251−// returns 1. Otherwise it allocates a new table, initializes all of its
252−// entries to 1, and returns zero.
253−//
254−// Note that this does *not* mark the table as ready for use. Until the
255−// table is marked ready, it will not be used by vty_mk_wcwidth. To mark
256−// the table as ready, call vty_activate_custom_table() after the table
257−// has been set up with calls to vty_set_custom_table_range.
258−int vty_init_custom_table(int size)
259−{
260− if (custom_table == NULL) {
261− if (size > 0 && size <= MAX_CUSTOM_TABLE_SIZE) {
262− custom_table_ready = 0;
263− custom_table = malloc(size);
264− memset(custom_table, 1, size);
265− custom_table_size = size;
266− return 0;
267− } else {
268− return 1;
269− }
270− } else {
271− return 1;
272− }
273−}
274−
275−// Set the specified character range in the custom width table to the
276−// specified width.
277−//
278−// This function sets 'width' as the character width for all entries
279−// in the custom character table starting at the 'start' entry and
280−// including all entries up to and including 'start + size - 1'.
281−//
282−// If this succeeds, it returns zero. If it fails, it returns 1. It
283−// fails if the table is not allocated, marked as ready (i.e. it is in
284−// use and has already been populated), or if the start or size values
285−// are not in bounds for the table.
286−int vty_set_custom_table_range(uint32_t start, uint32_t size, uint8_t width)
287−{
288− if ((custom_table == NULL) ||
289− (size >= custom_table_size) ||
290− (start >= custom_table_size) ||
291− ((start + 1) >= (custom_table_size - size)) ||
292− custom_table_ready) {
293− return 1;
294− } else {
295− memset(custom_table + start, width, size);
296− return 0;
297− }
298−}
299−
300−// Mark the allocated custom character width table as ready for use.
301−//
302−// After this call, further calls to vty_set_custom_table_range will
303−// fail.
304−//
305−// This function returns 0 if it succeeds. If it fails, it returns 1.
306−// It fails if the custom table is already ready or if it has not been
307−// allocated.
308−int vty_activate_custom_table()
309−{
310− if (custom_table_ready || (custom_table == NULL)) {
311− return 1;
312− } else {
313− custom_table_ready = 1;
314− return 0;
315− }
316−}
317−
318−// Returns whether a custom character width table has been marked ready.
319−int vty_custom_table_ready()
320−{
321− return custom_table_ready;
322−}
323−
324−// Deallocate the custom width table.
325−//
326−// This does nothing if there is no allocated custom width table, or if
327−// there is one but it is in use (marked ready). This is only useful if
328−// an initial allocation succeeds, but range population fails, after
329−// which point the application may want to deallocate the table to avoid
330−// leaving it in an intermediate state.
331−void vty_deallocate_custom_table()
332−{
333− if ((custom_table != NULL) && (!custom_table_ready)) {
334− free(custom_table);
335− custom_table = NULL;
336− custom_table_size = 0;
337− }
338−}
demos/Demo.hs+4−12
@@ -31,8 +31,7 @@ introText = vertCat $ map (string defAttr)
31 [ "this line is hidden by the top layer"
31 [ "this line is hidden by the top layer"
32 , "The vty demo program will echo the events generated by the pressed keys."
32 , "The vty demo program will echo the events generated by the pressed keys."
33 , "Below there is a 240 color box."
33 , "Below there is a 240 color box."
34− , "Followed by a description of the 16 color palette."
34+ , "Followed by a description of the 16 color pallete."
35− , "Followed by tones of red using a 24-bit palette."
36 , "If the 240 color box is not visible then the terminal"
35 , "If the 240 color box is not visible then the terminal"
37 , "claims 240 colors are not supported."
36 , "claims 240 colors are not supported."
38 , "Try setting TERM to xterm-256color"
37 , "Try setting TERM to xterm-256color"
@@ -43,19 +42,12 @@ introText = vertCat $ map (string defAttr)
43 , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯"
42 , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯"
44 ]
43 ]
45
44
46−splitColorImages :: [Image] -> [[Image]]
47−splitColorImages [] = []
48−splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))
49−
50−fullcolorbox :: Image
51−fullcolorbox = vertCat $ map horizCat $ splitColorImages colorImages
52− where
53− colorImages = map (\i -> string (currentAttr `withBackColor` linearColor i 0 0) " ") [0..255]
54−
55colorbox_240 :: Image
45colorbox_240 :: Image
56colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages
46colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages
57 where
47 where
58 colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]
48 colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]
49+ splitColorImages [] = []
50+ splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))
59
51
60colorbox_16 :: Image
52colorbox_16 :: Image
61colorbox_16 = border <|> column0 <|> border <|> column1 <|> border <|> column2 <|> border
53colorbox_16 = border <|> column0 <|> border <|> column1 <|> border <|> column2 <|> border
@@ -78,7 +70,7 @@ updateDisplay = do
78 "Press ESC to exit. Events for keys below."
70 "Press ESC to exit. Events for keys below."
79 eventLog <- foldMap (string defAttr) <$> get
71 eventLog <- foldMap (string defAttr) <$> get
80 let pic = picForImage (info <-> eventLog)
72 let pic = picForImage (info <-> eventLog)
81− `addToBottom` (introText <-> colorbox_240 <|> colorbox_16 <|> fullcolorbox)
73+ `addToBottom` (introText <-> colorbox_240 <|> colorbox_16)
82 vty <- ask
74 vty <- ask
83 liftIO $ update vty pic
75 liftIO $ update vty pic
84
76
demos/ModeDemo.hs−2
@@ -2,8 +2,6 @@ module Main where
2
2
3import Control.Applicative
3import Control.Applicative
4import Data.Monoid
4import Data.Monoid
5−import Foreign.C.Types (CInt(..), CChar(..))
6−import System.Posix.Types (Fd(..))
7
5
8import Graphics.Vty
6import Graphics.Vty
9
7
src/Codec/Binary/UTF8/Debug.hs+2−1
@@ -14,4 +14,5 @@ utf8FromIso :: [Int] -> [Word8]
14utf8FromIso = encode . map toEnum
14utf8FromIso = encode . map toEnum
15
15
16ppUtf8 :: [Int] -> IO ()
16ppUtf8 :: [Int] -> IO ()
17−ppUtf8 = print . map (`showHex` "") . utf8FromIso
17+ppUtf8 = print . map (\f -> f "") . map showHex . utf8FromIso
18+
src/Data/Sequence/Extra.hs+1−1
@@ -7,7 +7,7 @@ import Data.Sequence
7import Control.Parallel.Strategies
7import Control.Parallel.Strategies
8
8
9instance NFData a => NFData (Seq a) where
9instance NFData a => NFData (Seq a) where
10− rnf = rnf' . viewl
10+ rnf = \v -> rnf' (viewl v)
11 where
11 where
12 rnf' EmptyL = ()
12 rnf' EmptyL = ()
13 rnf' (a :< r) = rnf a >| rnf' (viewl r)
13 rnf' (a :< r) = rnf a >| rnf' (viewl r)
src/Data/Terminfo/Eval.hs+3−3
@@ -42,7 +42,7 @@ pop = do
42
42
43readParam :: Word -> Eval CapParam
43readParam :: Word -> Eval CapParam
44readParam pn = do
44readParam pn = do
45− !params <- evalParams <$> get
45+ !params <- get >>= return . evalParams
46 return $! genericIndex params pn
46 return $! genericIndex params pn
47
47
48push :: CapParam -> Eval ()
48push :: CapParam -> Eval ()
@@ -64,11 +64,11 @@ writeCapExpr cap params =
64 in snd $ runWriter (runStateT (writeCapOps (capOps cap)) s0)
64 in snd $ runWriter (runStateT (writeCapOps (capOps cap)) s0)
65
65
66writeCapOps :: CapOps -> Eval ()
66writeCapOps :: CapOps -> Eval ()
67−writeCapOps = mapM_ writeCapOp
67+writeCapOps ops = mapM_ writeCapOp ops
68
68
69writeCapOp :: CapOp -> Eval ()
69writeCapOp :: CapOp -> Eval ()
70writeCapOp (Bytes !offset !count) = do
70writeCapOp (Bytes !offset !count) = do
71− !cap <- evalExpression <$> get
71+ !cap <- get >>= return . evalExpression
72 let bytes = Vector.take count $ Vector.drop offset (capBytes cap)
72 let bytes = Vector.take count $ Vector.drop offset (capBytes cap)
73 Vector.forM_ bytes $ tell.writeWord8
73 Vector.forM_ bytes $ tell.writeWord8
74writeCapOp DecOut = do
74writeCapOp DecOut = do
src/Data/Terminfo/Parse.hs+10−10
@@ -1,9 +1,9 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CPP #-}
2{-# LANGUAGE CPP #-}
3+{-# OPTIONS_HADDOCK hide #-}
3{-# LANGUAGE NoMonomorphismRestriction #-}
4{-# LANGUAGE NoMonomorphismRestriction #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE NamedFieldPuns #-}
5{-# OPTIONS_GHC -funbox-strict-fields -O #-}
6{-# OPTIONS_GHC -funbox-strict-fields -O #-}
6−{-# OPTIONS_HADDOCK hide #-}
7
7
8module Data.Terminfo.Parse
8module Data.Terminfo.Parse
9 ( module Data.Terminfo.Parse
9 ( module Data.Terminfo.Parse
@@ -39,7 +39,7 @@ instance Show CapExpression where
39 ++ " <= " ++ show (sourceString c)
39 ++ " <= " ++ show (sourceString c)
40 where
40 where
41 hexDump :: [Word8] -> String
41 hexDump :: [Word8] -> String
42− hexDump = foldr showHex ""
42+ hexDump = foldr (\b s -> showHex b s) ""
43
43
44instance NFData CapExpression where
44instance NFData CapExpression where
45 rnf (CapExpression ops !_bytes !str !c !pOps)
45 rnf (CapExpression ops !_bytes !str !c !pOps)
@@ -99,7 +99,7 @@ parseCapExpression capString =
99 Left e -> Left e
99 Left e -> Left e
100 Right buildResults -> Right $ constructCapExpression capString buildResults
100 Right buildResults -> Right $ constructCapExpression capString buildResults
101
101
102−constructCapExpression :: String -> BuildResults -> CapExpression
102+constructCapExpression :: [Char] -> BuildResults -> CapExpression
103constructCapExpression capString buildResults =
103constructCapExpression capString buildResults =
104 let expr = CapExpression
104 let expr = CapExpression
105 { capOps = outCapOps buildResults
105 { capOps = outCapOps buildResults
@@ -128,7 +128,7 @@ paramEscapeParser = do
128literalPercentParser :: CapParser BuildResults
128literalPercentParser :: CapParser BuildResults
129literalPercentParser = do
129literalPercentParser = do
130 _ <- char '%'
130 _ <- char '%'
131− startOffset <- nextOffset <$> getState
131+ startOffset <- getState >>= return . nextOffset
132 incOffset 1
132 incOffset 1
133 return $ BuildResults 0 [Bytes startOffset 1] []
133 return $ BuildResults 0 [Bytes startOffset 1] []
134
134
@@ -154,7 +154,7 @@ incrementOpParser = do
154pushOpParser :: CapParser BuildResults
154pushOpParser :: CapParser BuildResults
155pushOpParser = do
155pushOpParser = do
156 _ <- char 'p'
156 _ <- char 'p'
157− paramN <- read . pure <$> digit
157+ paramN <- digit >>= return . (\d -> read [d])
158 incOffset 2
158 incOffset 2
159 return $ BuildResults (fromEnum paramN) [PushParam $ paramN - 1] []
159 return $ BuildResults (fromEnum paramN) [PushParam $ paramN - 1] []
160
160
@@ -299,7 +299,7 @@ compareOpParser
299bytesOpParser :: CapParser BuildResults
299bytesOpParser :: CapParser BuildResults
300bytesOpParser = do
300bytesOpParser = do
301 bytes <- many1 $ satisfy (/= '%')
301 bytes <- many1 $ satisfy (/= '%')
302− startOffset <- nextOffset <$> getState
302+ startOffset <- getState >>= return . nextOffset
303 let !c = length bytes
303 let !c = length bytes
304 !s <- getState
304 !s <- getState
305 let s' = s { nextOffset = startOffset + c }
305 let s' = s { nextOffset = startOffset + c }
@@ -336,9 +336,9 @@ data BuildResults = BuildResults
336instance Semigroup BuildResults where
336instance Semigroup BuildResults where
337 v0 <> v1
337 v0 <> v1
338 = BuildResults
338 = BuildResults
339− { outParamCount = outParamCount v0 `max` outParamCount v1
339+ { outParamCount = (outParamCount v0) `max` (outParamCount v1)
340− , outCapOps = outCapOps v0 <> outCapOps v1
340+ , outCapOps = (outCapOps v0) <> (outCapOps v1)
341− , outParamOps = outParamOps v0 <> outParamOps v1
341+ , outParamOps = (outParamOps v0) <> (outParamOps v1)
342 }
342 }
343
343
344instance Monoid BuildResults where
344instance Monoid BuildResults where
src/Graphics/Text/Width.hs+9−40
@@ -1,47 +1,26 @@
1-- Copyright 2009 Corey O'Connor
1-- Copyright 2009 Corey O'Connor
2{-# OPTIONS_GHC -D_XOPEN_SOURCE #-}
2{-# OPTIONS_GHC -D_XOPEN_SOURCE #-}
3{-# LANGUAGE ForeignFunctionInterface #-}
3{-# LANGUAGE ForeignFunctionInterface #-}
4−-- | This module provides functions to measure the terminal column width
5−-- of characters and strings.
6−--
7−-- The functions provided in this module all ultimately make calls to
8−-- the C implementation in @cbits/mk_wcwidth.c@. That code manages some
9−-- global state that carries a table of Unicode character widths. For
10−-- more details, see 'Graphics.Vty.UnicodeWidthTable.Install', the C
11−-- code, and the "Multi-Column Character Support" section of the project
12−-- @README@.
13module Graphics.Text.Width
4module Graphics.Text.Width
14 ( wcwidth
5 ( wcwidth
15 , wcswidth
6 , wcswidth
16− , wctwidth
17− , wctlwidth
18 , safeWcwidth
7 , safeWcwidth
19 , safeWcswidth
8 , safeWcswidth
20− , safeWctwidth
21− , safeWctlwidth
22 )
9 )
23where
10where
24
11
25−import Data.List (foldl')
26−import qualified Data.Text as T
27−import qualified Data.Text.Lazy as TL
28−
29foreign import ccall unsafe "vty_mk_wcwidth" wcwidth :: Char -> Int
12foreign import ccall unsafe "vty_mk_wcwidth" wcwidth :: Char -> Int
30
13
31wcswidth :: String -> Int
14wcswidth :: String -> Int
32−wcswidth = foldl' (\l c -> wcwidth c + l) 0
15+wcswidth = sum . map wcwidth
33−{-# INLINE [1] wcswidth #-}
34−
35−wctwidth :: T.Text -> Int
36−wctwidth = T.foldl' (\l c -> wcwidth c + l) 0
37
16
38−wctlwidth :: TL.Text -> Int
17+-- XXX: Characters with unknown widths occupy 1 column?
39−wctlwidth = TL.foldl' (\l c -> wcwidth c + l) 0
18+--
40−
19+-- Not sure if this is actually correct. I presume there is a
41−{-# RULES
20+-- replacement character that is output by the terminal instead of the
42−"wcswidth/unpack" forall x. wcswidth (T.unpack x) = wctwidth x
21+-- character and this replacement character is 1 column wide. If this is
43−"wcswidth/lazy-unpack" forall x. wcswidth (TL.unpack x) = wctlwidth x
22+-- not true for all terminals then a per-terminal replacement character
44− #-}
23+-- width needs to be implemented.
45
24
46-- | Returns the display width of a character. Assumes all characters
25-- | Returns the display width of a character. Assumes all characters
47-- with unknown widths are 0 width.
26-- with unknown widths are 0 width.
@@ -51,14 +30,4 @@ safeWcwidth = max 0 . wcwidth
51-- | Returns the display width of a string. Assumes all characters with
30-- | Returns the display width of a string. Assumes all characters with
52-- unknown widths are 0 width.
31-- unknown widths are 0 width.
53safeWcswidth :: String -> Int
32safeWcswidth :: String -> Int
54−safeWcswidth = foldl' (\l c -> safeWcwidth c + l) 0
33+safeWcswidth = sum . map safeWcwidth
55−
56−-- | Returns the display width of a text. Assumes all characters with
57−-- unknown widths are 0 width.
58−safeWctwidth :: T.Text -> Int
59−safeWctwidth = T.foldl' (\l c -> safeWcwidth c + l) 0
60−
61−-- | Returns the display width of a lazy text. Assumes all characters
62−-- with unknown widths are 0 width.
63−safeWctlwidth :: TL.Text -> Int
64−safeWctlwidth = TL.foldl' (\l c -> safeWcwidth c + l) 0
src/Graphics/Vty.hs+38−127
@@ -1,5 +1,4 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
3
2
4-- | Vty provides interfaces for both terminal input and terminal
3-- | Vty provides interfaces for both terminal input and terminal
5-- output.
4-- output.
@@ -14,7 +13,7 @@
14-- values in the "Graphics.Vty.Attributes" module.
13-- values in the "Graphics.Vty.Attributes" module.
15--
14--
16-- Vty uses threads internally, so programs made with Vty need to be
15-- Vty uses threads internally, so programs made with Vty need to be
17−-- compiled with the threaded runtime using the GHC @-threaded@ option.
16+-- compiled with the threaded runtime using the GHC `-threaded` option.
18--
17--
19-- @
18-- @
20-- import "Graphics.Vty"
19-- import "Graphics.Vty"
@@ -34,7 +33,6 @@
34module Graphics.Vty
33module Graphics.Vty
35 ( Vty(..)
34 ( Vty(..)
36 , mkVty
35 , mkVty
37− , setWindowTitle
38 , Mode(..)
36 , Mode(..)
39 , module Graphics.Vty.Config
37 , module Graphics.Vty.Config
40 , module Graphics.Vty.Input
38 , module Graphics.Vty.Input
@@ -48,20 +46,12 @@ where
48
46
49import Graphics.Vty.Config
47import Graphics.Vty.Config
50import Graphics.Vty.Input
48import Graphics.Vty.Input
51−import Graphics.Vty.Input.Events
52import Graphics.Vty.Output
49import Graphics.Vty.Output
53import Graphics.Vty.Output.Interface
50import Graphics.Vty.Output.Interface
54import Graphics.Vty.Picture
51import Graphics.Vty.Picture
55import Graphics.Vty.Image
52import Graphics.Vty.Image
56import Graphics.Vty.Attributes
53import Graphics.Vty.Attributes
57−import Graphics.Vty.UnicodeWidthTable.IO
58−import Graphics.Vty.UnicodeWidthTable.Install
59
54
60−import Data.Char (isPrint, showLitChar)
61−import qualified Data.ByteString.Char8 as BS8
62−
63−import qualified Control.Exception as E
64−import Control.Monad (when)
65import Control.Concurrent.STM
55import Control.Concurrent.STM
66
56
67import Data.IORef
57import Data.IORef
@@ -74,7 +64,7 @@ import Data.Semigroup ((<>))
74--
64--
75-- The use of Vty typically follows this process:
65-- The use of Vty typically follows this process:
76--
66--
77−-- 1. Initialize vty with 'mkVty' (this takes control of the terminal).
67+-- 1. Initialize vty
78--
68--
79-- 2. Use 'update' to display a picture.
69-- 2. Use 'update' to display a picture.
80--
70--
@@ -82,33 +72,31 @@ import Data.Semigroup ((<>))
82--
72--
83-- 4. Depending on the event, go to 2 or 5.
73-- 4. Depending on the event, go to 2 or 5.
84--
74--
85−-- 5. Shutdown vty and restore the terminal state with 'shutdown'. At
75+-- 5. Shutdown vty.
86−-- this point the 'Vty' handle cannot be used again.
87--
76--
88-- Operations on Vty handles are not thread-safe.
77-- Operations on Vty handles are not thread-safe.
89−data Vty =
78+data Vty = Vty
90− Vty { update :: Picture -> IO ()
91− -- ^ Outputs the given 'Picture'.
79+ { -- | Outputs the given 'Picture'.
92− , nextEvent :: IO Event
80+ update :: Picture -> IO ()
93− -- ^ Return the next 'Event' or block until one becomes
81+ -- | Get one 'Event' object, blocking if none are available. This
94− -- available.
82+ -- will refresh the terminal if the event is a 'EvResize'.
95− , nextEventNonblocking :: IO (Maybe Event)
83+ , nextEvent :: IO Event
96− -- ^ Non-blocking version of 'nextEvent'.
97− , inputIface :: Input
98− -- ^ The input interface. See 'Input'.
84+ -- | The input interface. See 'Input'.
85+ , inputIface :: Input
86+ -- | The output interface. See 'Output'.
99− , outputIface :: Output
87+ , outputIface :: Output
100− -- ^ The output interface. See 'Output'.
88+ -- | Refresh the display. 'nextEvent' will refresh the display if
101− , refresh :: IO ()
89+ -- a resize occurs, but this can be used to refresh the display
102− -- ^ Refresh the display. If other programs output to the
90+ -- explicitly. If other programs output to the terminal and mess
103− -- terminal and mess up the display then the application might
91+ -- up the display then the application might want to force a
104− -- want to force a refresh using this function.
92+ -- refresh using this function.
105− , shutdown :: IO ()
93+ , refresh :: IO ()
106− -- ^ Clean up after vty. A call to this function is necessary to
94+ -- | Clean up after vty. A call to this function is necessary to
107− -- cleanly restore the terminal state before application exit.
95+ -- cleanly restore the terminal state before application exit. The
108− -- The above methods will throw an exception if executed after
96+ -- above methods will throw an exception if executed after this is
109− -- this is executed. Idempotent.
97+ -- executed.
110− , isShutdown :: IO Bool
98+ , shutdown :: IO ()
111− }
99+ }
112
100
113-- | Create a Vty handle. At most one handle should be created at a time
101-- | Create a Vty handle. At most one handle should be created at a time
114-- for a given terminal device.
102-- for a given terminal device.
@@ -121,63 +109,17 @@ data Vty =
121mkVty :: Config -> IO Vty
109mkVty :: Config -> IO Vty
122mkVty appConfig = do
110mkVty appConfig = do
123 config <- (<> appConfig) <$> userConfig
111 config <- (<> appConfig) <$> userConfig
112+ input <- inputForConfig config
113+ out <- outputForConfig config
114+ intMkVty input out
124
115
125− when (allowCustomUnicodeWidthTables config /= Just False) $
126− installCustomWidthTable config
127−
128− input <- inputForConfig config
129− out <- outputForConfig config
130− internalMkVty input out
131−
132−installCustomWidthTable :: Config -> IO ()
133−installCustomWidthTable c = do
134− let doLog s = case debugLog c of
135− Nothing -> return ()
136− Just path -> appendFile path $ "installWidthTable: " <> s <> "\n"
137−
138− customInstalled <- isCustomTableReady
139− when (not customInstalled) $ do
140− mTerm <- currentTerminalName
141− case mTerm of
142− Nothing ->
143− doLog "No current terminal name available"
144− Just currentTerm ->
145− case lookup currentTerm (termWidthMaps c) of
146− Nothing ->
147− doLog "Current terminal not found in custom character width mapping list"
148− Just path -> do
149− tableResult <- E.try $ readUnicodeWidthTable path
150− case tableResult of
151− Left (e::E.SomeException) ->
152− doLog $ "Error reading custom character width table " <>
153− "at " <> show path <> ": " <> show e
154− Right (Left msg) ->
155− doLog $ "Error reading custom character width table " <>
156− "at " <> show path <> ": " <> msg
157− Right (Right table) -> do
158− installResult <- E.try $ installUnicodeWidthTable table
159− case installResult of
160− Left (e::E.SomeException) ->
161− doLog $ "Error installing unicode table (" <>
162− show path <> ": " <> show e
163− Right () ->
164− doLog $ "Successfully installed Unicode width table " <>
165− " from " <> show path
166−
167−internalMkVty :: Input -> Output -> IO Vty
116+intMkVty :: Input -> Output -> IO Vty
168−internalMkVty input out = do
117+intMkVty input out = do
169 reserveDisplay out
118 reserveDisplay out
170−
171− shutdownVar <- newTVarIO False
172 let shutdownIo = do
119 let shutdownIo = do
173− alreadyShutdown <- atomically $ swapTVar shutdownVar True
174− when (not alreadyShutdown) $ do
175− shutdownInput input
120+ shutdownInput input
176− releaseDisplay out
121+ releaseDisplay out
177− releaseTerminal out
122+ releaseTerminal out
178−
179− let shutdownStatus = readTVarIO shutdownVar
180−
181 lastPicRef <- newIORef Nothing
123 lastPicRef <- newIORef Nothing
182 lastUpdateRef <- newIORef Nothing
124 lastUpdateRef <- newIORef Nothing
183
125
@@ -209,47 +151,16 @@ internalMkVty input out = do
209 mPic <- readIORef lastPicRef
151 mPic <- readIORef lastPicRef
210 maybe (return ()) innerUpdate mPic
152 maybe (return ()) innerUpdate mPic
211
153
212− let mkResize = uncurry EvResize <$> displayBounds out
213−
214− translateInternalEvent ResumeAfterSignal = mkResize
215− translateInternalEvent (InputEvent e) = return e
216−
217− gkey = do
218− e <- atomically $ readTChan $ _eventChannel input
154+ let gkey = do k <- atomically $ readTChan $ _eventChannel input
219− translateInternalEvent e
220− gkey' = do
221− mEv <- atomically $ tryReadTChan $ _eventChannel input
222− case mEv of
155+ case k of
223− Just e -> Just <$> translateInternalEvent e
156+ (EvResize _ _) -> displayBounds out
157+ >>= return . (\(w,h)-> EvResize w h)
224− Nothing -> return Nothing
158+ _ -> return k
225
159
226 return $ Vty { update = innerUpdate
160 return $ Vty { update = innerUpdate
227 , nextEvent = gkey
161 , nextEvent = gkey
228− , nextEventNonblocking = gkey'
229 , inputIface = input
162 , inputIface = input
230 , outputIface = out
163 , outputIface = out
231 , refresh = innerRefresh
164 , refresh = innerRefresh
232 , shutdown = shutdownIo
165 , shutdown = shutdownIo
233− , isShutdown = shutdownStatus
234 }
166 }
235−
236−-- | Set the terminal window title string.
237−--
238−-- This function emits an Xterm-compatible escape sequence that we
239−-- anticipate will work for essentially all modern terminal emulators.
240−-- Ideally we'd use a terminal capability for this, but there does not
241−-- seem to exist a termcap for setting window titles. If you find that
242−-- this function does not work for a given terminal emulator, please
243−-- report the issue.
244−--
245−-- For details, see:
246−--
247−-- https://tldp.org/HOWTO/Xterm-Title-3.html
248−setWindowTitle :: Vty -> String -> IO ()
249−setWindowTitle vty title = do
250− let sanitize :: String -> String
251− sanitize = concatMap sanitizeChar
252− sanitizeChar c | not (isPrint c) = showLitChar c ""
253− | otherwise = [c]
254− let buf = BS8.pack $ "\ESC]2;" <> sanitize title <> "\007"
255− outputByteBuffer (outputIface vty) buf
src/Graphics/Vty/Attributes.hs+56−29
@@ -1,6 +1,7 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE StandaloneDeriving #-}
3+{-# LANGUAGE GADTs #-}
3−{-# LANGUAGE DeriveAnyClass #-}
4+{-# LANGUAGE RankNTypes #-}
4
5
5-- | Display attributes
6-- | Display attributes
6--
7--
@@ -27,9 +28,7 @@
27-- The value 'currentAttr' will keep the attributes of whatever was
28-- The value 'currentAttr' will keep the attributes of whatever was
28-- output previously.
29-- output previously.
29module Graphics.Vty.Attributes
30module Graphics.Vty.Attributes
30− ( module Graphics.Vty.Attributes.Color
31−
32− , Attr(..)
31+ ( Attr(..)
33 , FixedAttr(..)
32 , FixedAttr(..)
34 , MaybeDefault(..)
33 , MaybeDefault(..)
35 , defAttr
34 , defAttr
@@ -39,8 +38,6 @@ module Graphics.Vty.Attributes
39 , Style
38 , Style
40 , withStyle
39 , withStyle
41 , standout
40 , standout
42− , italic
43− , strikethrough
44 , underline
41 , underline
45 , reverseVideo
42 , reverseVideo
46 , blink
43 , blink
@@ -56,16 +53,22 @@ module Graphics.Vty.Attributes
56
53
57 -- * Setting hyperlinks
54 -- * Setting hyperlinks
58 , withURL
55 , withURL
56+
57+ -- * Colors
58+ , module Graphics.Vty.Attributes.Color
59+ , module Graphics.Vty.Attributes.Color240
59 )
60 )
60where
61where
61
62
62−import Control.DeepSeq
63import Data.Bits
63import Data.Bits
64+#if !(MIN_VERSION_base(4,11,0))
65+import Data.Semigroup
66+#endif
64import Data.Text (Text)
67import Data.Text (Text)
65import Data.Word
68import Data.Word
66−import GHC.Generics
67
69
68import Graphics.Vty.Attributes.Color
70import Graphics.Vty.Attributes.Color
71+import Graphics.Vty.Attributes.Color240
69
72
70-- | A display attribute defines the Color and Style of all the
73-- | A display attribute defines the Color and Style of all the
71-- characters rendered after the attribute is applied.
74-- characters rendered after the attribute is applied.
@@ -79,7 +82,7 @@ data Attr = Attr
79 , attrForeColor :: !(MaybeDefault Color)
82 , attrForeColor :: !(MaybeDefault Color)
80 , attrBackColor :: !(MaybeDefault Color)
83 , attrBackColor :: !(MaybeDefault Color)
81 , attrURL :: !(MaybeDefault Text)
84 , attrURL :: !(MaybeDefault Text)
82− } deriving ( Eq, Show, Read, Generic, NFData )
85+ } deriving ( Eq, Show, Read )
83
86
84-- This could be encoded into a single 32 bit word. The 32 bit word is
87-- This could be encoded into a single 32 bit word. The 32 bit word is
85-- first divided into 4 groups of 8 bits where: The first group codes
88-- first divided into 4 groups of 8 bits where: The first group codes
@@ -100,19 +103,31 @@ data Attr = Attr
100-- __ - unused
103-- __ - unused
101--
104--
102-- Next is the style flags
105-- Next is the style flags
103−-- SURBDOI_
106+-- SURBDO__
104-- S - standout
107-- S - standout
105-- U - underline
108-- U - underline
106-- R - reverse video
109-- R - reverse video
107-- B - blink
110-- B - blink
108-- D - dim
111-- D - dim
109-- O - bold
112-- O - bold
110−-- I - italic
111−-- _ - unused
113+-- __ - unused
112--
114--
113-- Then the foreground color encoded into 8 bits.
115-- Then the foreground color encoded into 8 bits.
114-- Then the background color encoded into 8 bits.
116-- Then the background color encoded into 8 bits.
115
117
118+instance Semigroup Attr where
119+ attr0 <> attr1 =
120+ Attr ( attrStyle attr0 <> attrStyle attr1 )
121+ ( attrForeColor attr0 <> attrForeColor attr1 )
122+ ( attrBackColor attr0 <> attrBackColor attr1 )
123+ ( attrURL attr0 <> attrURL attr1 )
124+
125+instance Monoid Attr where
126+ mempty = Attr mempty mempty mempty mempty
127+#if !(MIN_VERSION_base(4,11,0))
128+ mappend = (<>)
129+#endif
130+
116-- | Specifies the display attributes such that the final style and
131-- | Specifies the display attributes such that the final style and
117-- color values do not depend on the previously applied display
132-- color values do not depend on the previously applied display
118-- attribute. The display attributes can still depend on the terminal's
133-- attribute. The display attributes can still depend on the terminal's
@@ -127,20 +142,38 @@ data FixedAttr = FixedAttr
127-- | The style and color attributes can either be the terminal defaults.
142-- | The style and color attributes can either be the terminal defaults.
128-- Or be equivalent to the previously applied style. Or be a specific
143-- Or be equivalent to the previously applied style. Or be a specific
129-- value.
144-- value.
130−data MaybeDefault v = Default | KeepCurrent | SetTo !v
145+data MaybeDefault v where
131− deriving (Eq, Read, Show)
146+ Default :: MaybeDefault v
132−
147+ KeepCurrent :: MaybeDefault v
148+ SetTo :: forall v . ( Eq v, Show v, Read v ) => !v -> MaybeDefault v
149+
150+deriving instance Eq v => Eq (MaybeDefault v)
151+deriving instance Eq v => Show (MaybeDefault v)
133−instance (NFData v) => NFData (MaybeDefault v) where
152+deriving instance (Eq v, Show v, Read v) => Read (MaybeDefault v)
153+
154+instance Eq v => Semigroup (MaybeDefault v) where
155+ Default <> Default = Default
156+ Default <> KeepCurrent = Default
157+ Default <> SetTo v = SetTo v
134− rnf Default = ()
158+ KeepCurrent <> Default = Default
159+ KeepCurrent <> KeepCurrent = KeepCurrent
160+ KeepCurrent <> SetTo v = SetTo v
161+ SetTo _v <> Default = Default
135− rnf KeepCurrent = ()
162+ SetTo v <> KeepCurrent = SetTo v
136− rnf (SetTo v) = rnf v
163+ SetTo _ <> SetTo v = SetTo v
164+
165+instance Eq v => Monoid ( MaybeDefault v ) where
166+ mempty = KeepCurrent
167+#if !(MIN_VERSION_base(4,11,0))
168+ mappend = (<>)
169+#endif
137
170
138-- | Styles are represented as an 8 bit word. Each bit in the word is 1
171-- | Styles are represented as an 8 bit word. Each bit in the word is 1
139-- if the style attribute assigned to that bit should be applied and 0
172-- if the style attribute assigned to that bit should be applied and 0
140-- if the style attribute should not be applied.
173-- if the style attribute should not be applied.
141type Style = Word8
174type Style = Word8
142
175
143−-- | Valid style attributes include:
176+-- | The 6 possible style attributes:
144--
177--
145-- * standout
178-- * standout
146--
179--
@@ -154,21 +187,15 @@ type Style = Word8
154--
187--
155-- * bold/bright
188-- * bold/bright
156--
189--
157−-- * italic
158−--
159−-- * strikethrough (via the smxx/rmxx terminfo capabilities)
160−--
161-- (The invisible, protect, and altcharset display attributes some
190-- (The invisible, protect, and altcharset display attributes some
162-- terminals support are not supported via VTY.)
191-- terminals support are not supported via VTY.)
163−standout, underline, reverseVideo, blink, dim, bold, italic, strikethrough :: Style
192+standout, underline, reverseVideo, blink, dim, bold :: Style
164standout = 0x01
193standout = 0x01
165underline = 0x02
194underline = 0x02
166−reverseVideo = 0x04
195+reverseVideo = 0x04
167blink = 0x08
196blink = 0x08
168dim = 0x10
197dim = 0x10
169bold = 0x20
198bold = 0x20
170−italic = 0x40
171−strikethrough = 0x80
172
199
173defaultStyleMask :: Style
200defaultStyleMask :: Style
174defaultStyleMask = 0x00
201defaultStyleMask = 0x00
src/Graphics/Vty/Attributes/Color.hs+5−96
@@ -1,24 +1,5 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE DeriveAnyClass #-}
3−{-# LANGUAGE MultiWayIf #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5−
6module Graphics.Vty.Attributes.Color
1module Graphics.Vty.Attributes.Color
7 ( Color(..)
2 ( Color(..)
8− , ColorMode(..)
9−
10− -- * Detecting Terminal Color Support
11− , detectColorMode
12−
13− -- ** Fixed Colors
14− -- | Standard 8-color ANSI terminal color codes.
15− --
16− -- Note that these map to colors in the terminal's custom palette. For
17− -- instance, `white` maps to whatever the terminal color theme uses for
18− -- white.
19− --
20− -- Use these functions if you want to make apps that fit the terminal theme.
21− -- If you want access to more/stronger colors use `rgbColor`
22 , black
3 , black
23 , red
4 , red
24 , green
5 , green
@@ -27,8 +8,6 @@ module Graphics.Vty.Attributes.Color
27 , magenta
8 , magenta
28 , cyan
9 , cyan
29 , white
10 , white
30−
31− -- | Bright/Vivid variants of the standard 8-color ANSI
32 , brightBlack
11 , brightBlack
33 , brightRed
12 , brightRed
34 , brightGreen
13 , brightGreen
@@ -37,25 +16,10 @@ module Graphics.Vty.Attributes.Color
37 , brightMagenta
16 , brightMagenta
38 , brightCyan
17 , brightCyan
39 , brightWhite
18 , brightWhite
40− -- ** Creating Colors From RGB
41− , linearColor
42− , srgbColor
43− , rgbColor
44− , color240
45− , module Graphics.Vty.Attributes.Color240
46 )
19 )
47where
20where
48
21
49import Data.Word
22import Data.Word
50−import GHC.Generics
51−import Control.DeepSeq
52−import System.Environment (lookupEnv)
53−
54−import qualified System.Console.Terminfo as Terminfo
55−import Control.Exception (catch)
56−import Data.Maybe
57−
58−import Graphics.Vty.Attributes.Color240
59
23
60-- | Abstract data type representing a color.
24-- | Abstract data type representing a color.
61--
25--
@@ -95,7 +59,7 @@ import Graphics.Vty.Attributes.Color240
95-- reported then the color reproduction will be incorrect.
59-- reported then the color reproduction will be incorrect.
96--
60--
97-- If the terminal reports <= 16 colors then the 240 color palette
61-- If the terminal reports <= 16 colors then the 240 color palette
98−-- points are only mapped to the 8 color palette. I'm not sure of
62+-- points are only mapped to the 8 color pallete. I'm not sure of
99-- the RGB points for the "bright" colors which is why they are not
63-- the RGB points for the "bright" colors which is why they are not
100-- addressable via the 240 color palette.
64-- addressable via the 240 color palette.
101--
65--
@@ -109,33 +73,10 @@ import Graphics.Vty.Attributes.Color240
109-- terminfo but I don't know it.
73-- terminfo but I don't know it.
110--
74--
111-- Seriously, terminal color support is INSANE.
75-- Seriously, terminal color support is INSANE.
112−data Color = ISOColor !Word8 | Color240 !Word8 | RGBColor !Word8 !Word8 !Word8
76+data Color = ISOColor !Word8 | Color240 !Word8
113− deriving ( Eq, Show, Read, Generic, NFData )
77+ deriving ( Eq, Show, Read )
114−
115−data ColorMode
116− = NoColor
117− | ColorMode8
118− | ColorMode16
119− | ColorMode240 !Word8
120− | FullColor
121− deriving ( Eq, Show )
122−
123−detectColorMode :: String -> IO ColorMode
124−detectColorMode termName' = do
125− term <- catch (Just <$> Terminfo.setupTerm termName')
126− (\(_ :: Terminfo.SetupTermError) -> return Nothing)
127− let getCap cap = term >>= \t -> Terminfo.getCapability t cap
128− termColors = fromMaybe 0 $ getCap (Terminfo.tiGetNum "colors")
129− colorterm <- lookupEnv "COLORTERM"
130− return $ if
131− | termColors < 8 -> NoColor
132− | termColors < 16 -> ColorMode8
133− | termColors == 16 -> ColorMode16
134− | termColors < 256 -> ColorMode240 (fromIntegral termColors - 16)
135− | colorterm == Just "truecolor" -> FullColor
136− | colorterm == Just "24bit" -> FullColor
137− | otherwise -> ColorMode240 240
138
78
79+-- | Standard 8-color ANSI terminal color codes.
139black, red, green, yellow, blue, magenta, cyan, white :: Color
80black, red, green, yellow, blue, magenta, cyan, white :: Color
140black = ISOColor 0
81black = ISOColor 0
141red = ISOColor 1
82red = ISOColor 1
@@ -146,6 +87,7 @@ magenta= ISOColor 5
146cyan = ISOColor 6
87cyan = ISOColor 6
147white = ISOColor 7
88white = ISOColor 7
148
89
90+-- | Bright/Vivid variants of the standard 8-color ANSI
149brightBlack, brightRed, brightGreen, brightYellow :: Color
91brightBlack, brightRed, brightGreen, brightYellow :: Color
150brightBlue, brightMagenta, brightCyan, brightWhite :: Color
92brightBlue, brightMagenta, brightCyan, brightWhite :: Color
151brightBlack = ISOColor 8
93brightBlack = ISOColor 8
@@ -156,36 +98,3 @@ brightBlue = ISOColor 12
156brightMagenta= ISOColor 13
98brightMagenta= ISOColor 13
157brightCyan = ISOColor 14
99brightCyan = ISOColor 14
158brightWhite = ISOColor 15
100brightWhite = ISOColor 15
159−
160−linearColor :: Integral i => i -> i -> i -> Color
161−linearColor r g b = RGBColor r' g' b'
162− where
163− r' = fromIntegral (clamp r) :: Word8
164− g' = fromIntegral (clamp g) :: Word8
165− b' = fromIntegral (clamp b) :: Word8
166− clamp = min 255 . max 0
167−
168−srgbColor :: Integral i => i -> i -> i -> Color
169−srgbColor r g b =
170− -- srgb to rgb transformation as described at
171− -- https://en.wikipedia.org/wiki/SRGB#The_reverse_transformation
172− --
173− -- TODO: it may be worth translating this to a lookup table, as with color240
174− let shrink n = fromIntegral n / 255 :: Double
175− -- called gamma^-1 in wiki
176− gamma u
177− | u <= 0.04045 = u/12.92
178− | otherwise = ((u + 0.055) / 1.055) ** 2.4
179− -- TODO: this is a slightly inaccurate conversion. is it worth doing proterly?
180− expand n = round (255 * n)
181− convert = expand . gamma . shrink
182− in RGBColor (convert r) (convert g) (convert b)
183−
184−color240 :: Integral i => i -> i -> i -> Color
185−color240 r g b = Color240 (rgbColorToColor240 r g b)
186−
187−-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.
188−-- This function is lossy in the sense that we only internally support 240 colors but the
189−-- #RRGGBB format supports 16^3 colors.
190−rgbColor :: Integral i => i -> i -> i -> Color
191−rgbColor = color240
src/Graphics/Vty/Attributes/Color240.hs+248−285
@@ -1,298 +1,261 @@
1-- This header file was generated by ./256colres.pl
1-- This header file was generated by ./256colres.pl
2module Graphics.Vty.Attributes.Color240
2module Graphics.Vty.Attributes.Color240
3− ( rgbColorToColor240
3+ ( rgbColor
4− , color240CodeToRGB
5 )
4 )
6where
5where
7
6
8−import Data.Word (Word8)
7+import Graphics.Vty.Attributes.Color
8+
9import Text.Printf
9import Text.Printf
10
10
11-- Note: rgbColor's mapping from RGB to 240 colors was generated from
11-- Note: rgbColor's mapping from RGB to 240 colors was generated from
12-- 256colres.pl which is forked from xterm 256colres.pl.
12-- 256colres.pl which is forked from xterm 256colres.pl.
13
13
14−-- | Create a value in the Color240 set from an RGB triple
14+-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.
15−rgbColorToColor240 :: Integral i => i -> i -> i -> Word8
15+rgbColor :: Integral i => i -> i -> i -> Color
16−rgbColorToColor240 r g b
16+rgbColor r g b
17 | r < 0 && g < 0 && b < 0 = error "rgbColor with negative color component intensity"
17 | r < 0 && g < 0 && b < 0 = error "rgbColor with negative color component intensity"
18− | r == 8 && g == 8 && b == 8 = 216
18+ | r == 8 && g == 8 && b == 8 = Color240 216
19− | r == 18 && g == 18 && b == 18 = 217
19+ | r == 18 && g == 18 && b == 18 = Color240 217
20− | r == 28 && g == 28 && b == 28 = 218
20+ | r == 28 && g == 28 && b == 28 = Color240 218
21− | r == 38 && g == 38 && b == 38 = 219
21+ | r == 38 && g == 38 && b == 38 = Color240 219
22− | r == 48 && g == 48 && b == 48 = 220
22+ | r == 48 && g == 48 && b == 48 = Color240 220
23− | r == 58 && g == 58 && b == 58 = 221
23+ | r == 58 && g == 58 && b == 58 = Color240 221
24− | r == 68 && g == 68 && b == 68 = 222
24+ | r == 68 && g == 68 && b == 68 = Color240 222
25− | r == 78 && g == 78 && b == 78 = 223
25+ | r == 78 && g == 78 && b == 78 = Color240 223
26− | r == 88 && g == 88 && b == 88 = 224
26+ | r == 88 && g == 88 && b == 88 = Color240 224
27− | r == 98 && g == 98 && b == 98 = 225
27+ | r == 98 && g == 98 && b == 98 = Color240 225
28− | r == 108 && g == 108 && b == 108 = 226
28+ | r == 108 && g == 108 && b == 108 = Color240 226
29− | r == 118 && g == 118 && b == 118 = 227
29+ | r == 118 && g == 118 && b == 118 = Color240 227
30− | r == 128 && g == 128 && b == 128 = 228
30+ | r == 128 && g == 128 && b == 128 = Color240 228
31− | r == 138 && g == 138 && b == 138 = 229
31+ | r == 138 && g == 138 && b == 138 = Color240 229
32− | r == 148 && g == 148 && b == 148 = 230
32+ | r == 148 && g == 148 && b == 148 = Color240 230
33− | r == 158 && g == 158 && b == 158 = 231
33+ | r == 158 && g == 158 && b == 158 = Color240 231
34− | r == 168 && g == 168 && b == 168 = 232
34+ | r == 168 && g == 168 && b == 168 = Color240 232
35− | r == 178 && g == 178 && b == 178 = 233
35+ | r == 178 && g == 178 && b == 178 = Color240 233
36− | r == 188 && g == 188 && b == 188 = 234
36+ | r == 188 && g == 188 && b == 188 = Color240 234
37− | r == 198 && g == 198 && b == 198 = 235
37+ | r == 198 && g == 198 && b == 198 = Color240 235
38− | r == 208 && g == 208 && b == 208 = 236
38+ | r == 208 && g == 208 && b == 208 = Color240 236
39− | r == 218 && g == 218 && b == 218 = 237
39+ | r == 218 && g == 218 && b == 218 = Color240 237
40− | r == 228 && g == 228 && b == 228 = 238
40+ | r == 228 && g == 228 && b == 228 = Color240 238
41− | r == 238 && g == 238 && b == 238 = 239
41+ | r == 238 && g == 238 && b == 238 = Color240 239
42− | otherwise = 36 * go r + 6 * go g + go b
42+ | r <= 0 && g <= 0 && b <= 0 = Color240 0
43− where go = simpleColor_ (error (printf "RGB color %d %d %d does not map to 240 palette."
43+ | r <= 0 && g <= 0 && b <= 95 = Color240 1
44+ | r <= 0 && g <= 0 && b <= 135 = Color240 2
45+ | r <= 0 && g <= 0 && b <= 175 = Color240 3
46+ | r <= 0 && g <= 0 && b <= 215 = Color240 4
47+ | r <= 0 && g <= 0 && b <= 255 = Color240 5
48+ | r <= 0 && g <= 95 && b <= 0 = Color240 6
49+ | r <= 0 && g <= 95 && b <= 95 = Color240 7
50+ | r <= 0 && g <= 95 && b <= 135 = Color240 8
51+ | r <= 0 && g <= 95 && b <= 175 = Color240 9
52+ | r <= 0 && g <= 95 && b <= 215 = Color240 10
53+ | r <= 0 && g <= 95 && b <= 255 = Color240 11
54+ | r <= 0 && g <= 135 && b <= 0 = Color240 12
55+ | r <= 0 && g <= 135 && b <= 95 = Color240 13
56+ | r <= 0 && g <= 135 && b <= 135 = Color240 14
57+ | r <= 0 && g <= 135 && b <= 175 = Color240 15
58+ | r <= 0 && g <= 135 && b <= 215 = Color240 16
59+ | r <= 0 && g <= 135 && b <= 255 = Color240 17
60+ | r <= 0 && g <= 175 && b <= 0 = Color240 18
61+ | r <= 0 && g <= 175 && b <= 95 = Color240 19
62+ | r <= 0 && g <= 175 && b <= 135 = Color240 20
63+ | r <= 0 && g <= 175 && b <= 175 = Color240 21
64+ | r <= 0 && g <= 175 && b <= 215 = Color240 22
65+ | r <= 0 && g <= 175 && b <= 255 = Color240 23
66+ | r <= 0 && g <= 215 && b <= 0 = Color240 24
67+ | r <= 0 && g <= 215 && b <= 95 = Color240 25
68+ | r <= 0 && g <= 215 && b <= 135 = Color240 26
69+ | r <= 0 && g <= 215 && b <= 175 = Color240 27
70+ | r <= 0 && g <= 215 && b <= 215 = Color240 28
71+ | r <= 0 && g <= 215 && b <= 255 = Color240 29
72+ | r <= 0 && g <= 255 && b <= 0 = Color240 30
73+ | r <= 0 && g <= 255 && b <= 95 = Color240 31
74+ | r <= 0 && g <= 255 && b <= 135 = Color240 32
75+ | r <= 0 && g <= 255 && b <= 175 = Color240 33
76+ | r <= 0 && g <= 255 && b <= 215 = Color240 34
77+ | r <= 0 && g <= 255 && b <= 255 = Color240 35
78+ | r <= 95 && g <= 0 && b <= 0 = Color240 36
79+ | r <= 95 && g <= 0 && b <= 95 = Color240 37
80+ | r <= 95 && g <= 0 && b <= 135 = Color240 38
81+ | r <= 95 && g <= 0 && b <= 175 = Color240 39
82+ | r <= 95 && g <= 0 && b <= 215 = Color240 40
83+ | r <= 95 && g <= 0 && b <= 255 = Color240 41
84+ | r <= 95 && g <= 95 && b <= 0 = Color240 42
85+ | r <= 95 && g <= 95 && b <= 95 = Color240 43
86+ | r <= 95 && g <= 95 && b <= 135 = Color240 44
87+ | r <= 95 && g <= 95 && b <= 175 = Color240 45
88+ | r <= 95 && g <= 95 && b <= 215 = Color240 46
89+ | r <= 95 && g <= 95 && b <= 255 = Color240 47
90+ | r <= 95 && g <= 135 && b <= 0 = Color240 48
91+ | r <= 95 && g <= 135 && b <= 95 = Color240 49
92+ | r <= 95 && g <= 135 && b <= 135 = Color240 50
93+ | r <= 95 && g <= 135 && b <= 175 = Color240 51
94+ | r <= 95 && g <= 135 && b <= 215 = Color240 52
95+ | r <= 95 && g <= 135 && b <= 255 = Color240 53
96+ | r <= 95 && g <= 175 && b <= 0 = Color240 54
97+ | r <= 95 && g <= 175 && b <= 95 = Color240 55
98+ | r <= 95 && g <= 175 && b <= 135 = Color240 56
99+ | r <= 95 && g <= 175 && b <= 175 = Color240 57
100+ | r <= 95 && g <= 175 && b <= 215 = Color240 58
101+ | r <= 95 && g <= 175 && b <= 255 = Color240 59
102+ | r <= 95 && g <= 215 && b <= 0 = Color240 60
103+ | r <= 95 && g <= 215 && b <= 95 = Color240 61
104+ | r <= 95 && g <= 215 && b <= 135 = Color240 62
105+ | r <= 95 && g <= 215 && b <= 175 = Color240 63
106+ | r <= 95 && g <= 215 && b <= 215 = Color240 64
107+ | r <= 95 && g <= 215 && b <= 255 = Color240 65
108+ | r <= 95 && g <= 255 && b <= 0 = Color240 66
109+ | r <= 95 && g <= 255 && b <= 95 = Color240 67
110+ | r <= 95 && g <= 255 && b <= 135 = Color240 68
111+ | r <= 95 && g <= 255 && b <= 175 = Color240 69
112+ | r <= 95 && g <= 255 && b <= 215 = Color240 70
113+ | r <= 95 && g <= 255 && b <= 255 = Color240 71
114+ | r <= 135 && g <= 0 && b <= 0 = Color240 72
115+ | r <= 135 && g <= 0 && b <= 95 = Color240 73
116+ | r <= 135 && g <= 0 && b <= 135 = Color240 74
117+ | r <= 135 && g <= 0 && b <= 175 = Color240 75
118+ | r <= 135 && g <= 0 && b <= 215 = Color240 76
119+ | r <= 135 && g <= 0 && b <= 255 = Color240 77
120+ | r <= 135 && g <= 95 && b <= 0 = Color240 78
121+ | r <= 135 && g <= 95 && b <= 95 = Color240 79
122+ | r <= 135 && g <= 95 && b <= 135 = Color240 80
123+ | r <= 135 && g <= 95 && b <= 175 = Color240 81
124+ | r <= 135 && g <= 95 && b <= 215 = Color240 82
125+ | r <= 135 && g <= 95 && b <= 255 = Color240 83
126+ | r <= 135 && g <= 135 && b <= 0 = Color240 84
127+ | r <= 135 && g <= 135 && b <= 95 = Color240 85
128+ | r <= 135 && g <= 135 && b <= 135 = Color240 86
129+ | r <= 135 && g <= 135 && b <= 175 = Color240 87
130+ | r <= 135 && g <= 135 && b <= 215 = Color240 88
131+ | r <= 135 && g <= 135 && b <= 255 = Color240 89
132+ | r <= 135 && g <= 175 && b <= 0 = Color240 90
133+ | r <= 135 && g <= 175 && b <= 95 = Color240 91
134+ | r <= 135 && g <= 175 && b <= 135 = Color240 92
135+ | r <= 135 && g <= 175 && b <= 175 = Color240 93
136+ | r <= 135 && g <= 175 && b <= 215 = Color240 94
137+ | r <= 135 && g <= 175 && b <= 255 = Color240 95
138+ | r <= 135 && g <= 215 && b <= 0 = Color240 96
139+ | r <= 135 && g <= 215 && b <= 95 = Color240 97
140+ | r <= 135 && g <= 215 && b <= 135 = Color240 98
141+ | r <= 135 && g <= 215 && b <= 175 = Color240 99
142+ | r <= 135 && g <= 215 && b <= 215 = Color240 100
143+ | r <= 135 && g <= 215 && b <= 255 = Color240 101
144+ | r <= 135 && g <= 255 && b <= 0 = Color240 102
145+ | r <= 135 && g <= 255 && b <= 95 = Color240 103
146+ | r <= 135 && g <= 255 && b <= 135 = Color240 104
147+ | r <= 135 && g <= 255 && b <= 175 = Color240 105
148+ | r <= 135 && g <= 255 && b <= 215 = Color240 106
149+ | r <= 135 && g <= 255 && b <= 255 = Color240 107
150+ | r <= 175 && g <= 0 && b <= 0 = Color240 108
151+ | r <= 175 && g <= 0 && b <= 95 = Color240 109
152+ | r <= 175 && g <= 0 && b <= 135 = Color240 110
153+ | r <= 175 && g <= 0 && b <= 175 = Color240 111
154+ | r <= 175 && g <= 0 && b <= 215 = Color240 112
155+ | r <= 175 && g <= 0 && b <= 255 = Color240 113
156+ | r <= 175 && g <= 95 && b <= 0 = Color240 114
157+ | r <= 175 && g <= 95 && b <= 95 = Color240 115
158+ | r <= 175 && g <= 95 && b <= 135 = Color240 116
159+ | r <= 175 && g <= 95 && b <= 175 = Color240 117
160+ | r <= 175 && g <= 95 && b <= 215 = Color240 118
161+ | r <= 175 && g <= 95 && b <= 255 = Color240 119
162+ | r <= 175 && g <= 135 && b <= 0 = Color240 120
163+ | r <= 175 && g <= 135 && b <= 95 = Color240 121
164+ | r <= 175 && g <= 135 && b <= 135 = Color240 122
165+ | r <= 175 && g <= 135 && b <= 175 = Color240 123
166+ | r <= 175 && g <= 135 && b <= 215 = Color240 124
167+ | r <= 175 && g <= 135 && b <= 255 = Color240 125
168+ | r <= 175 && g <= 175 && b <= 0 = Color240 126
169+ | r <= 175 && g <= 175 && b <= 95 = Color240 127
170+ | r <= 175 && g <= 175 && b <= 135 = Color240 128
171+ | r <= 175 && g <= 175 && b <= 175 = Color240 129
172+ | r <= 175 && g <= 175 && b <= 215 = Color240 130
173+ | r <= 175 && g <= 175 && b <= 255 = Color240 131
174+ | r <= 175 && g <= 215 && b <= 0 = Color240 132
175+ | r <= 175 && g <= 215 && b <= 95 = Color240 133
176+ | r <= 175 && g <= 215 && b <= 135 = Color240 134
177+ | r <= 175 && g <= 215 && b <= 175 = Color240 135
178+ | r <= 175 && g <= 215 && b <= 215 = Color240 136
179+ | r <= 175 && g <= 215 && b <= 255 = Color240 137
180+ | r <= 175 && g <= 255 && b <= 0 = Color240 138
181+ | r <= 175 && g <= 255 && b <= 95 = Color240 139
182+ | r <= 175 && g <= 255 && b <= 135 = Color240 140
183+ | r <= 175 && g <= 255 && b <= 175 = Color240 141
184+ | r <= 175 && g <= 255 && b <= 215 = Color240 142
185+ | r <= 175 && g <= 255 && b <= 255 = Color240 143
186+ | r <= 215 && g <= 0 && b <= 0 = Color240 144
187+ | r <= 215 && g <= 0 && b <= 95 = Color240 145
188+ | r <= 215 && g <= 0 && b <= 135 = Color240 146
189+ | r <= 215 && g <= 0 && b <= 175 = Color240 147
190+ | r <= 215 && g <= 0 && b <= 215 = Color240 148
191+ | r <= 215 && g <= 0 && b <= 255 = Color240 149
192+ | r <= 215 && g <= 95 && b <= 0 = Color240 150
193+ | r <= 215 && g <= 95 && b <= 95 = Color240 151
194+ | r <= 215 && g <= 95 && b <= 135 = Color240 152
195+ | r <= 215 && g <= 95 && b <= 175 = Color240 153
196+ | r <= 215 && g <= 95 && b <= 215 = Color240 154
197+ | r <= 215 && g <= 95 && b <= 255 = Color240 155
198+ | r <= 215 && g <= 135 && b <= 0 = Color240 156
199+ | r <= 215 && g <= 135 && b <= 95 = Color240 157
200+ | r <= 215 && g <= 135 && b <= 135 = Color240 158
201+ | r <= 215 && g <= 135 && b <= 175 = Color240 159
202+ | r <= 215 && g <= 135 && b <= 215 = Color240 160
203+ | r <= 215 && g <= 135 && b <= 255 = Color240 161
204+ | r <= 215 && g <= 175 && b <= 0 = Color240 162
205+ | r <= 215 && g <= 175 && b <= 95 = Color240 163
206+ | r <= 215 && g <= 175 && b <= 135 = Color240 164
207+ | r <= 215 && g <= 175 && b <= 175 = Color240 165
208+ | r <= 215 && g <= 175 && b <= 215 = Color240 166
209+ | r <= 215 && g <= 175 && b <= 255 = Color240 167
210+ | r <= 215 && g <= 215 && b <= 0 = Color240 168
211+ | r <= 215 && g <= 215 && b <= 95 = Color240 169
212+ | r <= 215 && g <= 215 && b <= 135 = Color240 170
213+ | r <= 215 && g <= 215 && b <= 175 = Color240 171
214+ | r <= 215 && g <= 215 && b <= 215 = Color240 172
215+ | r <= 215 && g <= 215 && b <= 255 = Color240 173
216+ | r <= 215 && g <= 255 && b <= 0 = Color240 174
217+ | r <= 215 && g <= 255 && b <= 95 = Color240 175
218+ | r <= 215 && g <= 255 && b <= 135 = Color240 176
219+ | r <= 215 && g <= 255 && b <= 175 = Color240 177
220+ | r <= 215 && g <= 255 && b <= 215 = Color240 178
221+ | r <= 215 && g <= 255 && b <= 255 = Color240 179
222+ | r <= 255 && g <= 0 && b <= 0 = Color240 180
223+ | r <= 255 && g <= 0 && b <= 95 = Color240 181
224+ | r <= 255 && g <= 0 && b <= 135 = Color240 182
225+ | r <= 255 && g <= 0 && b <= 175 = Color240 183
226+ | r <= 255 && g <= 0 && b <= 215 = Color240 184
227+ | r <= 255 && g <= 0 && b <= 255 = Color240 185
228+ | r <= 255 && g <= 95 && b <= 0 = Color240 186
229+ | r <= 255 && g <= 95 && b <= 95 = Color240 187
230+ | r <= 255 && g <= 95 && b <= 135 = Color240 188
231+ | r <= 255 && g <= 95 && b <= 175 = Color240 189
232+ | r <= 255 && g <= 95 && b <= 215 = Color240 190
233+ | r <= 255 && g <= 95 && b <= 255 = Color240 191
234+ | r <= 255 && g <= 135 && b <= 0 = Color240 192
235+ | r <= 255 && g <= 135 && b <= 95 = Color240 193
236+ | r <= 255 && g <= 135 && b <= 135 = Color240 194
237+ | r <= 255 && g <= 135 && b <= 175 = Color240 195
238+ | r <= 255 && g <= 135 && b <= 215 = Color240 196
239+ | r <= 255 && g <= 135 && b <= 255 = Color240 197
240+ | r <= 255 && g <= 175 && b <= 0 = Color240 198
241+ | r <= 255 && g <= 175 && b <= 95 = Color240 199
242+ | r <= 255 && g <= 175 && b <= 135 = Color240 200
243+ | r <= 255 && g <= 175 && b <= 175 = Color240 201
244+ | r <= 255 && g <= 175 && b <= 215 = Color240 202
245+ | r <= 255 && g <= 175 && b <= 255 = Color240 203
246+ | r <= 255 && g <= 215 && b <= 0 = Color240 204
247+ | r <= 255 && g <= 215 && b <= 95 = Color240 205
248+ | r <= 255 && g <= 215 && b <= 135 = Color240 206
249+ | r <= 255 && g <= 215 && b <= 175 = Color240 207
250+ | r <= 255 && g <= 215 && b <= 215 = Color240 208
251+ | r <= 255 && g <= 215 && b <= 255 = Color240 209
252+ | r <= 255 && g <= 255 && b <= 0 = Color240 210
253+ | r <= 255 && g <= 255 && b <= 95 = Color240 211
254+ | r <= 255 && g <= 255 && b <= 135 = Color240 212
255+ | r <= 255 && g <= 255 && b <= 175 = Color240 213
256+ | r <= 255 && g <= 255 && b <= 215 = Color240 214
257+ | r <= 255 && g <= 255 && b <= 255 = Color240 215
258+ | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."
44 (fromIntegral r :: Int)
259 (fromIntegral r :: Int)
45 (fromIntegral g :: Int)
260 (fromIntegral g :: Int)
46− (fromIntegral b :: Int)))
261+ (fromIntegral b :: Int))
47−
48−simpleColor_ :: Integral i => Word8 -> i -> Word8
49−simpleColor_ e c
50− | c <= 0 = 0
51− | c <= 95 = 1
52− | c <= 255 = fromIntegral ((c-16) `div` 40)
53− | otherwise = e
54−
55−-- | Create a RGB triple from a value in the Color240 set.
56−color240CodeToRGB :: Word8 -> Maybe (Int, Int, Int)
57−color240CodeToRGB n = case n of
58− 0 -> Just (0, 0, 0)
59− 1 -> Just (0, 0, 95)
60− 2 -> Just (0, 0, 135)
61− 3 -> Just (0, 0, 175)
62− 4 -> Just (0, 0, 215)
63− 5 -> Just (0, 0, 255)
64− 6 -> Just (0, 95, 0)
65− 7 -> Just (0, 95, 95)
66− 8 -> Just (0, 95, 135)
67− 9 -> Just (0, 95, 175)
68− 10 -> Just (0, 95, 215)
69− 11 -> Just (0, 95, 255)
70− 12 -> Just (0, 135, 0)
71− 13 -> Just (0, 135, 95)
72− 14 -> Just (0, 135, 135)
73− 15 -> Just (0, 135, 175)
74− 16 -> Just (0, 135, 215)
75− 17 -> Just (0, 135, 255)
76− 18 -> Just (0, 175, 0)
77− 19 -> Just (0, 175, 95)
78− 20 -> Just (0, 175, 135)
79− 21 -> Just (0, 175, 175)
80− 22 -> Just (0, 175, 215)
81− 23 -> Just (0, 175, 255)
82− 24 -> Just (0, 215, 0)
83− 25 -> Just (0, 215, 95)
84− 26 -> Just (0, 215, 135)
85− 27 -> Just (0, 215, 175)
86− 28 -> Just (0, 215, 215)
87− 29 -> Just (0, 215, 255)
88− 30 -> Just (0, 255, 0)
89− 31 -> Just (0, 255, 95)
90− 32 -> Just (0, 255, 135)
91− 33 -> Just (0, 255, 175)
92− 34 -> Just (0, 255, 215)
93− 35 -> Just (0, 255, 255)
94− 36 -> Just (95, 0, 0)
95− 37 -> Just (95, 0, 95)
96− 38 -> Just (95, 0, 135)
97− 39 -> Just (95, 0, 175)
98− 40 -> Just (95, 0, 215)
99− 41 -> Just (95, 0, 255)
100− 42 -> Just (95, 95, 0)
101− 43 -> Just (95, 95, 95)
102− 44 -> Just (95, 95, 135)
103− 45 -> Just (95, 95, 175)
104− 46 -> Just (95, 95, 215)
105− 47 -> Just (95, 95, 255)
106− 48 -> Just (95, 135, 0)
107− 49 -> Just (95, 135, 95)
108− 50 -> Just (95, 135, 135)
109− 51 -> Just (95, 135, 175)
110− 52 -> Just (95, 135, 215)
111− 53 -> Just (95, 135, 255)
112− 54 -> Just (95, 175, 0)
113− 55 -> Just (95, 175, 95)
114− 56 -> Just (95, 175, 135)
115− 57 -> Just (95, 175, 175)
116− 58 -> Just (95, 175, 215)
117− 59 -> Just (95, 175, 255)
118− 60 -> Just (95, 215, 0)
119− 61 -> Just (95, 215, 95)
120− 62 -> Just (95, 215, 135)
121− 63 -> Just (95, 215, 175)
122− 64 -> Just (95, 215, 215)
123− 65 -> Just (95, 215, 255)
124− 66 -> Just (95, 255, 0)
125− 67 -> Just (95, 255, 95)
126− 68 -> Just (95, 255, 135)
127− 69 -> Just (95, 255, 175)
128− 70 -> Just (95, 255, 215)
129− 71 -> Just (95, 255, 255)
130− 72 -> Just (135, 0, 0)
131− 73 -> Just (135, 0, 95)
132− 74 -> Just (135, 0, 135)
133− 75 -> Just (135, 0, 175)
134− 76 -> Just (135, 0, 215)
135− 77 -> Just (135, 0, 255)
136− 78 -> Just (135, 95, 0)
137− 79 -> Just (135, 95, 95)
138− 80 -> Just (135, 95, 135)
139− 81 -> Just (135, 95, 175)
140− 82 -> Just (135, 95, 215)
141− 83 -> Just (135, 95, 255)
142− 84 -> Just (135, 135, 0)
143− 85 -> Just (135, 135, 95)
144− 86 -> Just (135, 135, 135)
145− 87 -> Just (135, 135, 175)
146− 88 -> Just (135, 135, 215)
147− 89 -> Just (135, 135, 255)
148− 90 -> Just (135, 175, 0)
149− 91 -> Just (135, 175, 95)
150− 92 -> Just (135, 175, 135)
151− 93 -> Just (135, 175, 175)
152− 94 -> Just (135, 175, 215)
153− 95 -> Just (135, 175, 255)
154− 96 -> Just (135, 215, 0)
155− 97 -> Just (135, 215, 95)
156− 98 -> Just (135, 215, 135)
157− 99 -> Just (135, 215, 175)
158− 100 -> Just (135, 215, 215)
159− 101 -> Just (135, 215, 255)
160− 102 -> Just (135, 255, 0)
161− 103 -> Just (135, 255, 95)
162− 104 -> Just (135, 255, 135)
163− 105 -> Just (135, 255, 175)
164− 106 -> Just (135, 255, 215)
165− 107 -> Just (135, 255, 255)
166− 108 -> Just (175, 0, 0)
167− 109 -> Just (175, 0, 95)
168− 110 -> Just (175, 0, 135)
169− 111 -> Just (175, 0, 175)
170− 112 -> Just (175, 0, 215)
171− 113 -> Just (175, 0, 255)
172− 114 -> Just (175, 95, 0)
173− 115 -> Just (175, 95, 95)
174− 116 -> Just (175, 95, 135)
175− 117 -> Just (175, 95, 175)
176− 118 -> Just (175, 95, 215)
177− 119 -> Just (175, 95, 255)
178− 120 -> Just (175, 135, 0)
179− 121 -> Just (175, 135, 95)
180− 122 -> Just (175, 135, 135)
181− 123 -> Just (175, 135, 175)
182− 124 -> Just (175, 135, 215)
183− 125 -> Just (175, 135, 255)
184− 126 -> Just (175, 175, 0)
185− 127 -> Just (175, 175, 95)
186− 128 -> Just (175, 175, 135)
187− 129 -> Just (175, 175, 175)
188− 130 -> Just (175, 175, 215)
189− 131 -> Just (175, 175, 255)
190− 132 -> Just (175, 215, 0)
191− 133 -> Just (175, 215, 95)
192− 134 -> Just (175, 215, 135)
193− 135 -> Just (175, 215, 175)
194− 136 -> Just (175, 215, 215)
195− 137 -> Just (175, 215, 255)
196− 138 -> Just (175, 255, 0)
197− 139 -> Just (175, 255, 95)
198− 140 -> Just (175, 255, 135)
199− 141 -> Just (175, 255, 175)
200− 142 -> Just (175, 255, 215)
201− 143 -> Just (175, 255, 255)
202− 144 -> Just (215, 0, 0)
203− 145 -> Just (215, 0, 95)
204− 146 -> Just (215, 0, 135)
205− 147 -> Just (215, 0, 175)
206− 148 -> Just (215, 0, 215)
207− 149 -> Just (215, 0, 255)
208− 150 -> Just (215, 95, 0)
209− 151 -> Just (215, 95, 95)
210− 152 -> Just (215, 95, 135)
211− 153 -> Just (215, 95, 175)
212− 154 -> Just (215, 95, 215)
213− 155 -> Just (215, 95, 255)
214− 156 -> Just (215, 135, 0)
215− 157 -> Just (215, 135, 95)
216− 158 -> Just (215, 135, 135)
217− 159 -> Just (215, 135, 175)
218− 160 -> Just (215, 135, 215)
219− 161 -> Just (215, 135, 255)
220− 162 -> Just (215, 175, 0)
221− 163 -> Just (215, 175, 95)
222− 164 -> Just (215, 175, 135)
223− 165 -> Just (215, 175, 175)
224− 166 -> Just (215, 175, 215)
225− 167 -> Just (215, 175, 255)
226− 168 -> Just (215, 215, 0)
227− 169 -> Just (215, 215, 95)
228− 170 -> Just (215, 215, 135)
229− 171 -> Just (215, 215, 175)
230− 172 -> Just (215, 215, 215)
231− 173 -> Just (215, 215, 255)
232− 174 -> Just (215, 255, 0)
233− 175 -> Just (215, 255, 95)
234− 176 -> Just (215, 255, 135)
235− 177 -> Just (215, 255, 175)
236− 178 -> Just (215, 255, 215)
237− 179 -> Just (215, 255, 255)
238− 180 -> Just (255, 0, 0)
239− 181 -> Just (255, 0, 95)
240− 182 -> Just (255, 0, 135)
241− 183 -> Just (255, 0, 175)
242− 184 -> Just (255, 0, 215)
243− 185 -> Just (255, 0, 255)
244− 186 -> Just (255, 95, 0)
245− 187 -> Just (255, 95, 95)
246− 188 -> Just (255, 95, 135)
247− 189 -> Just (255, 95, 175)
248− 190 -> Just (255, 95, 215)
249− 191 -> Just (255, 95, 255)
250− 192 -> Just (255, 135, 0)
251− 193 -> Just (255, 135, 95)
252− 194 -> Just (255, 135, 135)
253− 195 -> Just (255, 135, 175)
254− 196 -> Just (255, 135, 215)
255− 197 -> Just (255, 135, 255)
256− 198 -> Just (255, 175, 0)
257− 199 -> Just (255, 175, 95)
258− 200 -> Just (255, 175, 135)
259− 201 -> Just (255, 175, 175)
260− 202 -> Just (255, 175, 215)
261− 203 -> Just (255, 175, 255)
262− 204 -> Just (255, 215, 0)
263− 205 -> Just (255, 215, 95)
264− 206 -> Just (255, 215, 135)
265− 207 -> Just (255, 215, 175)
266− 208 -> Just (255, 215, 215)
267− 209 -> Just (255, 215, 255)
268− 210 -> Just (255, 255, 0)
269− 211 -> Just (255, 255, 95)
270− 212 -> Just (255, 255, 135)
271− 213 -> Just (255, 255, 175)
272− 214 -> Just (255, 255, 215)
273− 215 -> Just (255, 255, 255)
274− 216 -> Just (8, 8, 8)
275− 217 -> Just (18, 18, 18)
276− 218 -> Just (28, 28, 28)
277− 219 -> Just (38, 38, 38)
278− 220 -> Just (48, 48, 48)
279− 221 -> Just (58, 58, 58)
280− 222 -> Just (68, 68, 68)
281− 223 -> Just (78, 78, 78)
282− 224 -> Just (88, 88, 88)
283− 225 -> Just (98, 98, 98)
284− 226 -> Just (108, 108, 108)
285− 227 -> Just (118, 118, 118)
286− 228 -> Just (128, 128, 128)
287− 229 -> Just (138, 138, 138)
288− 230 -> Just (148, 148, 148)
289− 231 -> Just (158, 158, 158)
290− 232 -> Just (168, 168, 168)
291− 233 -> Just (178, 178, 178)
292− 234 -> Just (188, 188, 188)
293− 235 -> Just (198, 198, 198)
294− 236 -> Just (208, 208, 208)
295− 237 -> Just (218, 218, 218)
296− 238 -> Just (228, 228, 228)
297− 239 -> Just (238, 238, 238)
298− _ -> Nothing
src/Graphics/Vty/Config.hs+65−247
@@ -3,7 +3,6 @@
3{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
3{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
4{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6−{-# LANGUAGE LambdaCase, MultiWayIf #-}
7-- | Vty supports a configuration file format and associated 'Config'
6-- | Vty supports a configuration file format and associated 'Config'
8-- data type. The 'Config' can be provided to 'mkVty' to customize the
7-- data type. The 'Config' can be provided to 'mkVty' to customize the
9-- application's use of Vty.
8-- application's use of Vty.
@@ -55,33 +54,7 @@
55-- If a debug log is requested then vty will output the current input
54-- If a debug log is requested then vty will output the current input
56-- table to the log in the above format. A workflow for using this is
55-- table to the log in the above format. A workflow for using this is
57-- to set @VTY_DEBUG_LOG@. Run the application. Check the debug log for
56-- to set @VTY_DEBUG_LOG@. Run the application. Check the debug log for
58−-- incorrect mappings. Add corrected mappings to @$HOME\/.vty\/config@.
57+-- incorrect mappings. Add corrected mappings to @$HOME/.vty/config@.
59−--
60−-- = Unicode Character Width Maps
61−--
62−-- == @widthMap@
63−--
64−-- Format:
65−--
66−-- @
67−-- \"widthMap\" string string
68−-- @
69−--
70−-- E.g.,
71−--
72−-- @
73−-- widthMap \"xterm\" \"\/home\/user\/.vty\/xterm\_map.dat\"
74−-- @
75−--
76−-- This directive specifies the path to a Unicode character width
77−-- map (the second argument) that should be loaded and used when
78−-- the value of TERM matches the first argument. Unicode character
79−-- width maps can be produced either by running the provided binary
80−-- @vty-build-width-table@ or by calling the library routine
81−-- 'Graphics.Vty.UnicodeWidthTable.Query.buildUnicodeWidthTable'. The
82−-- 'Graphics.Vty.mkVty' function will use these configuration settings
83−-- to attempt to load and install the specified width map. See the
84−-- documentation for 'Graphics.Vty.mkVty' for details.
85module Graphics.Vty.Config
58module Graphics.Vty.Config
86 ( InputMap
59 ( InputMap
87 , Config(..)
60 , Config(..)
@@ -92,17 +65,6 @@ module Graphics.Vty.Config
92 , runParseConfig
65 , runParseConfig
93 , parseConfigFile
66 , parseConfigFile
94 , defaultConfig
67 , defaultConfig
95− , getTtyEraseChar
96− , currentTerminalName
97−
98− , vtyConfigPath
99− , widthTableFilename
100− , vtyDataDirectory
101− , terminalWidthTablePath
102− , vtyConfigFileEnvName
103−
104− , ConfigUpdateResult(..)
105− , addConfigWidthMap
106 )
68 )
107where
69where
108
70
@@ -114,40 +76,32 @@ import Control.Exception (catch, IOException, Exception(..), throwIO)
114import Control.Monad (liftM, guard, void)
76import Control.Monad (liftM, guard, void)
115
77
116import qualified Data.ByteString as BS
78import qualified Data.ByteString as BS
117−#if !(MIN_VERSION_base(4,8,0))
118import Data.Monoid (Monoid(..))
79import Data.Monoid (Monoid(..))
119−#endif
120#if !(MIN_VERSION_base(4,11,0))
80#if !(MIN_VERSION_base(4,11,0))
121import Data.Semigroup (Semigroup(..))
81import Data.Semigroup (Semigroup(..))
122#endif
82#endif
123import Data.Typeable (Typeable)
83import Data.Typeable (Typeable)
124
84
125import Graphics.Vty.Input.Events
85import Graphics.Vty.Input.Events
126−import Graphics.Vty.Attributes.Color (ColorMode(..), detectColorMode)
127
86
128import GHC.Generics
87import GHC.Generics
129
88
130−import System.Directory ( getAppUserDataDirectory, doesFileExist
89+import System.Directory (getAppUserDataDirectory)
131− , createDirectoryIfMissing
132− )
133−import System.Environment (lookupEnv)
90+import System.Posix.Env (getEnv)
134−import System.FilePath ((</>), takeDirectory)
135import System.Posix.IO (stdInput, stdOutput)
91import System.Posix.IO (stdInput, stdOutput)
136import System.Posix.Types (Fd(..))
92import System.Posix.Types (Fd(..))
137−import Foreign.C.Types (CInt(..), CChar(..))
138
93
139import Text.Parsec hiding ((<|>))
94import Text.Parsec hiding ((<|>))
140import Text.Parsec.Token ( GenLanguageDef(..) )
95import Text.Parsec.Token ( GenLanguageDef(..) )
141import qualified Text.Parsec.Token as P
96import qualified Text.Parsec.Token as P
142
97
143-- | Type of errors that can be thrown when configuring VTY
98-- | Type of errors that can be thrown when configuring VTY
144−data VtyConfigurationError =
99+data VtyConfigurationError
145− VtyMissingTermEnvVar
146− -- ^ TERM environment variable not set
100+ = VtyMissingTermEnvVar -- ^ TERM environment variable not set
147− deriving (Show, Eq, Typeable)
101+ deriving (Show, Eq, Typeable)
148
102
149instance Exception VtyConfigurationError where
103instance Exception VtyConfigurationError where
150− displayException VtyMissingTermEnvVar = "TERM environment variable not set"
104+ displayException VtyMissingTermEnvVar = "TERM environment variable not set"
151
105
152-- | Mappings from input bytes to event in the order specified. Later
106-- | Mappings from input bytes to event in the order specified. Later
153-- entries take precedence over earlier in the case multiple entries
107-- entries take precedence over earlier in the case multiple entries
@@ -155,144 +109,90 @@ instance Exception VtyConfigurationError where
155type InputMap = [(Maybe String, String, Event)]
109type InputMap = [(Maybe String, String, Event)]
156
110
157-- | A Vty configuration.
111-- | A Vty configuration.
158−data Config =
112+data Config = Config
113+ {
114+ -- | The default is 1 character.
159− Config { vmin :: Maybe Int
115+ vmin :: Maybe Int
160− -- ^ The default is 1 character.
161− , vtime :: Maybe Int
162− -- ^ The default is 100 milliseconds, 0.1 seconds.
116+ -- | The default is 100 milliseconds, 0.1 seconds.
117+ , vtime :: Maybe Int
118+ -- | The default is False.
163− , mouseMode :: Maybe Bool
119+ , mouseMode :: Maybe Bool
164− -- ^ The default is False.
120+ -- | The default is False.
165− , bracketedPasteMode :: Maybe Bool
121+ , bracketedPasteMode :: Maybe Bool
166− -- ^ The default is False.
167− , debugLog :: Maybe FilePath
168− -- ^ Debug information is appended to this file if not
122+ -- | Debug information is appended to this file if not Nothing.
169− -- Nothing.
123+ , debugLog :: Maybe FilePath
170− , inputMap :: InputMap
171− -- ^ The (input byte, output event) pairs extend the internal
124+ -- | The (input byte, output event) pairs extend the internal input
172− -- input table of VTY and the table from terminfo.
125+ -- table of VTY and the table from terminfo.
173− --
126+ --
174− -- See "Graphics.Vty.Config" module documentation for
127+ -- See "Graphics.Vty.Config" module documentation for documentation
175− -- documentation of the @map@ directive.
128+ -- of the @map@ directive.
176− , inputFd :: Maybe Fd
129+ , inputMap :: InputMap
177− -- ^ The input file descriptor to use. The default is
130+ -- | The input file descriptor to use. The default is
178− -- 'System.Posix.IO.stdInput'
131+ -- 'System.Posix.IO.stdInput'
179− , outputFd :: Maybe Fd
132+ , inputFd :: Maybe Fd
180− -- ^ The output file descriptor to use. The default is
133+ -- | The output file descriptor to use. The default is
181− -- 'System.Posix.IO.stdOutput'
134+ -- 'System.Posix.IO.stdOutput'
182− , termName :: Maybe String
135+ , outputFd :: Maybe Fd
183− -- ^ The terminal name used to look up terminfo capabilities.
136+ -- | The terminal name used to look up terminfo capabilities.
184− -- The default is the value of the TERM environment variable.
137+ -- The default is the value of the TERM environment variable.
185− , termWidthMaps :: [(String, FilePath)]
138+ , termName :: Maybe String
186− -- ^ Terminal width map files.
187− , allowCustomUnicodeWidthTables :: Maybe Bool
188− -- ^ Whether to permit custom Unicode width table loading by
189− -- 'Graphics.Vty.mkVty'. @'Just' 'False'@ indicates that
190− -- table loading should not be performed. Other values permit
191− -- table loading.
192− --
193− -- If a table load is attempted and fails, information
194− -- about the failure will be logged to the debug log if the
195− -- configuration specifies one. If no custom table is loaded
196− -- (or if a load fails), the built-in character width table
197− -- will be used.
198− , colorMode :: Maybe ColorMode
199− -- ^ The color mode used to know how many colors the terminal
200− -- supports.
201− }
202− deriving (Show, Eq)
139+ } deriving (Show, Eq)
203
140
204defaultConfig :: Config
141defaultConfig :: Config
205defaultConfig = mempty
142defaultConfig = mempty
206
143
207instance Semigroup Config where
144instance Semigroup Config where
208− c0 <> c1 =
145+ c0 <> c1 = Config
209 -- latter config takes priority for everything but inputMap
146 -- latter config takes priority for everything but inputMap
210− Config { vmin = vmin c1 <|> vmin c0
147+ { vmin = vmin c1 <|> vmin c0
211− , vtime = vtime c1 <|> vtime c0
148+ , vtime = vtime c1 <|> vtime c0
212− , mouseMode = mouseMode c1
149+ , mouseMode = mouseMode c1
213− , bracketedPasteMode = bracketedPasteMode c1
150+ , bracketedPasteMode = bracketedPasteMode c1
214− , debugLog = debugLog c1 <|> debugLog c0
151+ , debugLog = debugLog c1 <|> debugLog c0
215− , inputMap = inputMap c0 <> inputMap c1
152+ , inputMap = inputMap c0 <> inputMap c1
216− , inputFd = inputFd c1 <|> inputFd c0
153+ , inputFd = inputFd c1 <|> inputFd c0
217− , outputFd = outputFd c1 <|> outputFd c0
154+ , outputFd = outputFd c1 <|> outputFd c0
218− , termName = termName c1 <|> termName c0
155+ , termName = termName c1 <|> termName c0
219− , termWidthMaps = termWidthMaps c1 <|> termWidthMaps c0
220− , allowCustomUnicodeWidthTables =
221− allowCustomUnicodeWidthTables c1 <|> allowCustomUnicodeWidthTables c0
222− , colorMode = colorMode c1 <|> colorMode c0
223− }
156+ }
224
157
225instance Monoid Config where
158instance Monoid Config where
226− mempty =
159+ mempty = Config
227− Config { vmin = Nothing
160+ { vmin = Nothing
228− , vtime = Nothing
161+ , vtime = Nothing
229− , mouseMode = Nothing
162+ , mouseMode = Nothing
230− , bracketedPasteMode = Nothing
163+ , bracketedPasteMode = Nothing
231− , debugLog = mempty
164+ , debugLog = mempty
232− , inputMap = mempty
165+ , inputMap = mempty
233− , inputFd = Nothing
166+ , inputFd = Nothing
234− , outputFd = Nothing
167+ , outputFd = Nothing
235− , termName = Nothing
168+ , termName = Nothing
236− , termWidthMaps = []
237− , allowCustomUnicodeWidthTables = Nothing
238− , colorMode = Nothing
239− }
169+ }
240#if !(MIN_VERSION_base(4,11,0))
170#if !(MIN_VERSION_base(4,11,0))
241 mappend = (<>)
171 mappend = (<>)
242#endif
172#endif
243
173
244−vtyDataDirectory :: IO FilePath
245−vtyDataDirectory = getAppUserDataDirectory "vty"
246−
247−vtyConfigPath :: IO FilePath
248−vtyConfigPath = do
249− dir <- vtyDataDirectory
250− return $ dir </> "config"
251−
252−vtyConfigFileEnvName :: String
253−vtyConfigFileEnvName = "VTY_CONFIG_FILE"
254−
255−-- | Load a configuration from 'vtyConfigPath' and @$VTY_CONFIG_FILE@.
174+-- | Load a configuration from @'getAppUserDataDirectory'/config@ and
175+-- @$VTY_CONFIG_FILE@.
256userConfig :: IO Config
176userConfig :: IO Config
257userConfig = do
177userConfig = do
258− configFile <- vtyConfigPath >>= parseConfigFile
178+ configFile <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile
259− overrideConfig <- maybe (return defaultConfig) parseConfigFile =<<
179+ overrideConfig <- maybe (return defaultConfig) parseConfigFile =<< getEnv "VTY_CONFIG_FILE"
260− lookupEnv vtyConfigFileEnvName
261 let base = configFile <> overrideConfig
180 let base = configFile <> overrideConfig
262 mappend base <$> overrideEnvConfig
181 mappend base <$> overrideEnvConfig
263
182
264−widthTableFilename :: String -> String
265−widthTableFilename term = "width_table_" <> term <> ".dat"
266−
267−termVariable :: String
268−termVariable = "TERM"
269−
270−currentTerminalName :: IO (Maybe String)
271−currentTerminalName = lookupEnv termVariable
272−
273−terminalWidthTablePath :: IO (Maybe FilePath)
274−terminalWidthTablePath = do
275− dataDir <- vtyDataDirectory
276− result <- lookupEnv termVariable
277− case result of
278− Nothing -> return Nothing
279− Just term -> do
280− return $ Just $ dataDir </> widthTableFilename term
281−
282overrideEnvConfig :: IO Config
183overrideEnvConfig :: IO Config
283overrideEnvConfig = do
184overrideEnvConfig = do
284− d <- lookupEnv "VTY_DEBUG_LOG"
185+ d <- getEnv "VTY_DEBUG_LOG"
285 return $ defaultConfig { debugLog = d }
186 return $ defaultConfig { debugLog = d }
286
187
287-- | Configures VTY using defaults suitable for terminals. This function
188-- | Configures VTY using defaults suitable for terminals. This function
288-- can raise 'VtyConfigurationError'.
189-- can raise 'VtyConfigurationError'.
289standardIOConfig :: IO Config
190standardIOConfig :: IO Config
290standardIOConfig = do
191standardIOConfig = do
291− mb <- lookupEnv termVariable
192+ mb <- getEnv "TERM"
292 case mb of
193 case mb of
293 Nothing -> throwIO VtyMissingTermEnvVar
194 Nothing -> throwIO VtyMissingTermEnvVar
294− Just t -> do
195+ Just t ->
295− mcolorMode <- detectColorMode t
296 return defaultConfig
196 return defaultConfig
297 { vmin = Just 1
197 { vmin = Just 1
298 , mouseMode = Just False
198 , mouseMode = Just False
@@ -301,7 +201,6 @@ standardIOConfig = do
301 , inputFd = Just stdInput
201 , inputFd = Just stdInput
302 , outputFd = Just stdOutput
202 , outputFd = Just stdOutput
303 , termName = Just t
203 , termName = Just t
304− , colorMode = Just mcolorMode
305 }
204 }
306
205
307parseConfigFile :: FilePath -> IO Config
206parseConfigFile :: FilePath -> IO Config
@@ -353,20 +252,13 @@ debugLogDecl = do
353 path <- P.stringLiteral configLexer
252 path <- P.stringLiteral configLexer
354 return defaultConfig { debugLog = Just path }
253 return defaultConfig { debugLog = Just path }
355
254
356−widthMapDecl :: Parser Config
357−widthMapDecl = do
358− "widthMap" <- P.identifier configLexer
359− tName <- P.stringLiteral configLexer
360− path <- P.stringLiteral configLexer
361− return defaultConfig { termWidthMaps = [(tName, path)] }
362−
363ignoreLine :: Parser ()
255ignoreLine :: Parser ()
364ignoreLine = void $ manyTill anyChar newline
256ignoreLine = void $ manyTill anyChar newline
365
257
366parseConfig :: Parser Config
258parseConfig :: Parser Config
367parseConfig = liftM mconcat $ many $ do
259parseConfig = liftM mconcat $ many $ do
368 P.whiteSpace configLexer
260 P.whiteSpace configLexer
369− let directives = [try mapDecl, try debugLogDecl, try widthMapDecl]
261+ let directives = [try mapDecl, try debugLogDecl]
370 choice directives <|> (ignoreLine >> return defaultConfig)
262 choice directives <|> (ignoreLine >> return defaultConfig)
371
263
372class Parse a where parseValue :: Parser a
264class Parse a where parseValue :: Parser a
@@ -412,77 +304,3 @@ instance (GParseAlts f, GParseAlts g) => GParseAlts (f :+: g) where
412 gparseAlts con = L1 <$> gparseAlts con <|> R1 <$> gparseAlts con
304 gparseAlts con = L1 <$> gparseAlts con <|> R1 <$> gparseAlts con
413
305
414instance GParseAlts V1 where gparseAlts _ = fail "GParse: V1"
306instance GParseAlts V1 where gparseAlts _ = fail "GParse: V1"
415−
416−foreign import ccall "vty_get_tty_erase" cGetTtyErase :: Fd -> IO CChar
417−
418−-- | Get the "erase" character for the terminal attached to the
419−-- specified file descriptor. This is the character configured by 'stty
420−-- erase'. If the call to 'tcgetattr' fails, this will return 'Nothing'.
421−-- Otherwise it will return the character that has been configured to
422−-- indicate the canonical mode ERASE behavior. That character can then
423−-- be added to the table of strings that we interpret to mean Backspace.
424−--
425−-- For more details, see:
426−--
427−-- * https://www.gnu.org/software/libc/manual/html_node/Canonical-or-Not.html
428−-- * https://www.gsp.com/cgi-bin/man.cgi?section=1&topic=stty
429−-- * https://github.com/matterhorn-chat/matterhorn/issues/565
430−getTtyEraseChar :: Fd -> IO (Maybe Char)
431−getTtyEraseChar fd = do
432− c <- cGetTtyErase fd
433− if c /= 0
434− then return $ Just $ toEnum $ fromEnum c
435− else return Nothing
436−
437−data ConfigUpdateResult =
438− ConfigurationCreated
439− | ConfigurationModified
440− | ConfigurationConflict String
441− | ConfigurationRedundant
442− deriving (Eq, Show)
443−
444−-- | Add a @widthMap@ directive to the Vty configuration file at the
445−-- specified path.
446−--
447−-- If the configuration path refers to a configuration that already
448−-- contains the directive for the specified map and terminal type, the
449−-- configuration file will not be modified. If the file does not contain
450−-- the directive, it will be appended to the file.
451−--
452−-- If the configuration path does not exist, a new configuration file
453−-- will be created and any directories in the path will also be created.
454−--
455−-- This returns @True@ if the configuration was created or modified and
456−-- @False@ otherwise. This does not handle exceptions raised by file or
457−-- directory permissions issues.
458−addConfigWidthMap :: FilePath
459− -- ^ The configuration file path of the configuration
460− -- to modify or create.
461− -> String
462− -- ^ The @TERM@ value for the @widthMap@ directive.
463− -> FilePath
464− -- ^ The width table file path for the directive.
465− -> IO ConfigUpdateResult
466−addConfigWidthMap configPath term tablePath = do
467− configEx <- doesFileExist configPath
468− if configEx
469− then updateConfig
470− else createConfig >> return ConfigurationCreated
471−
472− where
473− directive = "widthMap " <> show term <> " " <> show tablePath <> "\n"
474−
475− createConfig = do
476− let dir = takeDirectory configPath
477− createDirectoryIfMissing True dir
478− writeFile configPath directive
479−
480− updateConfig = do
481− config <- parseConfigFile configPath
482− if (term, tablePath) `elem` termWidthMaps config
483− then return ConfigurationRedundant
484− else case lookup term (termWidthMaps config) of
485− Just other -> return $ ConfigurationConflict other
486− Nothing -> do
487− appendFile configPath directive
488− return ConfigurationModified
src/Graphics/Vty/Debug.hs+6−6
@@ -12,16 +12,16 @@ import Graphics.Vty.Span
12
12
13import qualified Data.Vector as Vector
13import qualified Data.Vector as Vector
14
14
15−rowOpsAffectedColumns :: DisplayOps -> [Int]
15+rowOpsEffectedColumns :: DisplayOps -> [Int]
16−rowOpsAffectedColumns ops
16+rowOpsEffectedColumns ops
17− = Vector.toList $ Vector.map spanOpsAffectedColumns ops
17+ = Vector.toList $ Vector.map spanOpsEffectedColumns ops
18
18
19allSpansHaveWidth :: DisplayOps -> Int -> Bool
19allSpansHaveWidth :: DisplayOps -> Int -> Bool
20allSpansHaveWidth ops expected
20allSpansHaveWidth ops expected
21− = all (== expected) $ Vector.toList $ Vector.map spanOpsAffectedColumns ops
21+ = all (== expected) $ Vector.toList $ Vector.map spanOpsEffectedColumns ops
22
22
23−spanOpsAffectedRows :: DisplayOps -> Int
23+spanOpsEffectedRows :: DisplayOps -> Int
24−spanOpsAffectedRows ops
24+spanOpsEffectedRows ops
25 = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList ops))
25 = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList ops))
26
26
27type SpanConstructLog = [SpanConstructEvent]
27type SpanConstructLog = [SpanConstructEvent]
src/Graphics/Vty/DisplayAttributes.hs−6
@@ -94,10 +94,6 @@ data DisplayColorDiff
94data StyleStateChange
94data StyleStateChange
95 = ApplyStandout
95 = ApplyStandout
96 | RemoveStandout
96 | RemoveStandout
97− | ApplyItalic
98− | RemoveItalic
99− | ApplyStrikethrough
100− | RemoveStrikethrough
101 | ApplyUnderline
97 | ApplyUnderline
102 | RemoveUnderline
98 | RemoveUnderline
103 | ApplyReverseVideo
99 | ApplyReverseVideo
@@ -145,8 +141,6 @@ diffStyles prev cur
145 = mconcat
141 = mconcat
146 [ styleDiff standout ApplyStandout RemoveStandout
142 [ styleDiff standout ApplyStandout RemoveStandout
147 , styleDiff underline ApplyUnderline RemoveUnderline
143 , styleDiff underline ApplyUnderline RemoveUnderline
148− , styleDiff italic ApplyItalic RemoveItalic
149− , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough
150 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo
144 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo
151 , styleDiff blink ApplyBlink RemoveBlink
145 , styleDiff blink ApplyBlink RemoveBlink
152 , styleDiff dim ApplyDim RemoveDim
146 , styleDiff dim ApplyDim RemoveDim
src/Graphics/Vty/Image.hs+8−17
@@ -1,4 +1,5 @@
1-- Copyright 2009-2010 Corey O'Connor
1-- Copyright 2009-2010 Corey O'Connor
2+{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE NamedFieldPuns #-}
3{-# LANGUAGE NamedFieldPuns #-}
3{-# LANGUAGE DisambiguateRecordFields #-}
4{-# LANGUAGE DisambiguateRecordFields #-}
4-- | A Vty program makes 'Picture's from 'Image's. This module provides
5-- | A Vty program makes 'Picture's from 'Image's. This module provides
@@ -45,12 +46,8 @@ module Graphics.Vty.Image
45 -- * Character width functions
46 -- * Character width functions
46 , safeWcwidth
47 , safeWcwidth
47 , safeWcswidth
48 , safeWcswidth
48− , safeWctwidth
49− , safeWctlwidth
50 , wcwidth
49 , wcwidth
51 , wcswidth
50 , wcswidth
52− , wctwidth
53− , wctlwidth
54 -- * Display Regions
51 -- * Display Regions
55 , DisplayText
52 , DisplayText
56 , DisplayRegion
53 , DisplayRegion
@@ -116,18 +113,14 @@ horizCat = foldr horizJoin EmptyImage
116vertCat :: [Image] -> Image
113vertCat :: [Image] -> Image
117vertCat = foldr vertJoin EmptyImage
114vertCat = foldr vertJoin EmptyImage
118
115
119−-- | Make an 'Image' from a lazy text value. The text value should be
116+-- | Make an 'Image' from a lazy text value.
120−-- sanitized of escape sequences (ASCII 27) and carriage returns;
121−-- otherwise layout and attribute problems may result.
122text :: Attr -> TL.Text -> Image
117text :: Attr -> TL.Text -> Image
123−text a txt = let displayWidth = safeWctlwidth txt
118+text a txt = let displayWidth = safeWcswidth (TL.unpack txt)
124 in HorizText a txt displayWidth (fromIntegral $! TL.length txt)
119 in HorizText a txt displayWidth (fromIntegral $! TL.length txt)
125
120
126−-- | Make an 'Image' from a text value. The text value should be
121+-- | Make an 'Image' from a text value.
127−-- sanitized of escape sequences (ASCII 27) and carriage returns;
128−-- otherwise layout and attribute problems may result.
129text' :: Attr -> T.Text -> Image
122text' :: Attr -> T.Text -> Image
130−text' a txt = let displayWidth = safeWctwidth txt
123+text' a txt = let displayWidth = safeWcswidth (T.unpack txt)
131 in HorizText a (TL.fromStrict txt) displayWidth (T.length txt)
124 in HorizText a (TL.fromStrict txt) displayWidth (T.length txt)
132
125
133-- | Make an image from a single character. This is a standard Haskell
126-- | Make an image from a single character. This is a standard Haskell
@@ -137,11 +130,9 @@ char a c =
137 let displayWidth = safeWcwidth c
130 let displayWidth = safeWcwidth c
138 in HorizText a (TL.singleton c) displayWidth 1
131 in HorizText a (TL.singleton c) displayWidth 1
139
132
140−-- | Make an image from a string of characters laid out on a single
133+-- | Make an image from a string of characters layed out on a single
141-- row with the same display attribute. The string is assumed to be a
134-- row with the same display attribute. The string is assumed to be a
142−-- sequence of ISO-10646 characters. The input string should be
135+-- sequence of ISO-10646 characters.
143−-- sanitized of escape sequences (ASCII 27) and carriage returns;
144−-- otherwise layout and attribute problems may result.
145--
136--
146-- Note: depending on how the Haskell compiler represents string
137-- Note: depending on how the Haskell compiler represents string
147-- literals, a string literal in a UTF-8 encoded source file, for
138-- literals, a string literal in a UTF-8 encoded source file, for
@@ -175,7 +166,7 @@ utf8String a bytes = utf8Bytestring a (BL.pack bytes)
175utf8Bytestring :: Attr -> BL.ByteString -> Image
166utf8Bytestring :: Attr -> BL.ByteString -> Image
176utf8Bytestring a bs = text a (TL.decodeUtf8 bs)
167utf8Bytestring a bs = text a (TL.decodeUtf8 bs)
177
168
178−-- | Make an 'Image' from a UTF-8 encoded strict bytestring.
169+-- | Make an 'Image' from a UTF-8 encoded lazy bytestring.
179utf8Bytestring' :: Attr -> B.ByteString -> Image
170utf8Bytestring' :: Attr -> B.ByteString -> Image
180utf8Bytestring' a bs = text' a (T.decodeUtf8 bs)
171utf8Bytestring' a bs = text' a (T.decodeUtf8 bs)
181
172
src/Graphics/Vty/Image/Internal.hs+30−4
@@ -142,11 +142,37 @@ data Image =
142 --
142 --
143 -- Any image of zero size equals the empty image.
143 -- Any image of zero size equals the empty image.
144 | EmptyImage
144 | EmptyImage
145− deriving (Eq, Generic, Show, Read)
145+ deriving (Eq, Generic)
146+
147+instance Show Image where
148+ show ( HorizText { attr, displayText, outputWidth, charWidth } )
149+ = "HorizText " ++ show displayText
150+ ++ "@(" ++ show attr ++ ","
151+ ++ show outputWidth ++ ","
152+ ++ show charWidth ++ ")"
153+ show ( BGFill { outputWidth, outputHeight } )
154+ = "BGFill (" ++ show outputWidth ++ "," ++ show outputHeight ++ ")"
155+ show ( HorizJoin { partLeft = l, partRight = r, outputWidth = c } )
156+ = "HorizJoin " ++ show c ++ " (" ++ show l ++ " <|> " ++ show r ++ ")"
157+ show ( VertJoin { partTop = t, partBottom = b, outputWidth = c, outputHeight = r } )
158+ = "VertJoin [" ++ show c ++ ", " ++ show r ++ "] (" ++ show t ++ ") <-> (" ++ show b ++ ")"
159+ show ( CropRight { croppedImage, outputWidth, outputHeight } )
160+ = "CropRight [" ++ show outputWidth ++ "," ++ show outputHeight ++ "]"
161+ ++ " (" ++ show croppedImage ++ ")"
162+ show ( CropLeft { croppedImage, leftSkip, outputWidth, outputHeight } )
163+ = "CropLeft [" ++ show leftSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ "]"
164+ ++ " (" ++ show croppedImage ++ ")"
165+ show ( CropBottom { croppedImage, outputWidth, outputHeight } )
166+ = "CropBottom [" ++ show outputWidth ++ "," ++ show outputHeight ++ "]"
167+ ++ " (" ++ show croppedImage ++ ")"
168+ show ( CropTop { croppedImage, topSkip, outputWidth, outputHeight } )
169+ = "CropTop [" ++ show topSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ "]"
170+ ++ " (" ++ show croppedImage ++ ")"
171+ show ( EmptyImage ) = "EmptyImage"
146
172
147-- | pretty print just the structure of an image.
173-- | pretty print just the structure of an image.
148ppImageStructure :: Image -> String
174ppImageStructure :: Image -> String
149−ppImageStructure = go 0
175+ppImageStructure inImg = go 0 inImg
150 where
176 where
151 go indent img = tab indent ++ pp indent img
177 go indent img = tab indent ++ pp indent img
152 tab indent = concat $ replicate indent " "
178 tab indent = concat $ replicate indent " "
@@ -228,7 +254,7 @@ instance Monoid Image where
228--
254--
229-- The result image will have a width equal to the sum of the two images
255-- The result image will have a width equal to the sum of the two images
230-- width. And the height will equal the largest height of the two
256-- width. And the height will equal the largest height of the two
231−-- images. The area not defined in one image due to a height mismatch
257+-- images. The area not defined in one image due to a height missmatch
232-- will be filled with the background pattern.
258-- will be filled with the background pattern.
233horizJoin :: Image -> Image -> Image
259horizJoin :: Image -> Image -> Image
234horizJoin EmptyImage i = i
260horizJoin EmptyImage i = i
@@ -259,7 +285,7 @@ horizJoin _ _ = error "horizJoin applied to undefined values."
259--
285--
260-- The result image will have a height equal to the sum of the heights
286-- The result image will have a height equal to the sum of the heights
261-- of both images. The width will equal the largest width of the two
287-- of both images. The width will equal the largest width of the two
262−-- images. The area not defined in one image due to a width mismatch
288+-- images. The area not defined in one image due to a width missmatch
263-- will be filled with the background pattern.
289-- will be filled with the background pattern.
264vertJoin :: Image -> Image -> Image
290vertJoin :: Image -> Image -> Image
265vertJoin EmptyImage i = i
291vertJoin EmptyImage i = i
src/Graphics/Vty/Inline.hs+7−5
@@ -1,3 +1,5 @@
1+{-# LANGUAGE BangPatterns #-}
2+
1-- | The inline module provides a limited interface to changing the
3-- | The inline module provides a limited interface to changing the
2-- style of terminal output. The intention is for this interface to be
4-- style of terminal output. The intention is for this interface to be
3-- used inline with other output systems.
5-- used inline with other output systems.
@@ -56,13 +58,13 @@ data InlineState =
56-- | Set the background color to the provided 'Color'.
58-- | Set the background color to the provided 'Color'.
57backColor :: Color -> InlineM ()
59backColor :: Color -> InlineM ()
58backColor c = modify $ \s ->
60backColor c = modify $ \s ->
59− s { inlineAttr = inlineAttr s `withBackColor` c
61+ s { inlineAttr = inlineAttr s `mappend` (currentAttr `withBackColor` c)
60 }
62 }
61
63
62-- | Set the foreground color to the provided 'Color'.
64-- | Set the foreground color to the provided 'Color'.
63foreColor :: Color -> InlineM ()
65foreColor :: Color -> InlineM ()
64foreColor c = modify $ \s ->
66foreColor c = modify $ \s ->
65− s { inlineAttr = inlineAttr s `withForeColor` c
67+ s { inlineAttr = inlineAttr s `mappend` (currentAttr `withForeColor` c)
66 }
68 }
67
69
68-- | Attempt to change the 'Style' of the following text..
70-- | Attempt to change the 'Style' of the following text..
@@ -71,7 +73,7 @@ foreColor c = modify $ \s ->
71-- produced. The style can still be removed.
73-- produced. The style can still be removed.
72applyStyle :: Style -> InlineM ()
74applyStyle :: Style -> InlineM ()
73applyStyle st = modify $ \s ->
75applyStyle st = modify $ \s ->
74− s { inlineAttr = inlineAttr s `withStyle` st
76+ s { inlineAttr = inlineAttr s `mappend` (currentAttr `withStyle` st)
75 }
77 }
76
78
77-- | Attempt to remove the specified 'Style' from the display of the
79-- | Attempt to remove the specified 'Style' from the display of the
@@ -83,8 +85,8 @@ removeStyle :: Style -> InlineM ()
83removeStyle sMask = modify $ \s ->
85removeStyle sMask = modify $ \s ->
84 s { inlineAttr =
86 s { inlineAttr =
85 let style' = case attrStyle (inlineAttr s) of
87 let style' = case attrStyle (inlineAttr s) of
86− Default -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
88+ Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
87− KeepCurrent -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
89+ KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
88 SetTo st -> st .&. complement sMask
90 SetTo st -> st .&. complement sMask
89 in (inlineAttr s) { attrStyle = SetTo style' }
91 in (inlineAttr s) { attrStyle = SetTo style' }
90 }
92 }
src/Graphics/Vty/Input.hs+23−14
@@ -1,4 +1,4 @@
1−{-# LANGUAGE RecordWildCards, CPP #-}
1+{-# LANGUAGE RecordWildCards #-}
2
2
3-- | This module provides the input layer for Vty, including methods
3-- | This module provides the input layer for Vty, including methods
4-- for initializing an 'Input' structure and reading 'Event's from the
4-- for initializing an 'Input' structure and reading 'Event's from the
@@ -77,7 +77,7 @@
77-- The input encoding determines how UTF-8 encoded characters are
77-- The input encoding determines how UTF-8 encoded characters are
78-- recognized.
78-- recognized.
79--
79--
80−-- * 7-bit mode: UTF-8 can be input unambiguously. UTF-8 input is
80+-- * 7-bit mode: UTF-8 can be input unambiguiously. UTF-8 input is
81-- a superset of ASCII. UTF-8 does not overlap escaped control key
81-- a superset of ASCII. UTF-8 does not overlap escaped control key
82-- sequences. However, the escape key must be differentiated from
82-- sequences. However, the escape key must be differentiated from
83-- escaped control key sequences by the timing of the input bytes.
83-- escaped control key sequences by the timing of the input bytes.
@@ -95,7 +95,7 @@
95--
95--
96-- == Terminal Input is Broken
96-- == Terminal Input is Broken
97--
97--
98−-- Clearly terminal input has fundamental issues. There is no easy way
98+-- Clearly terminal input has fundemental issues. There is no easy way
99-- to reliably resolve these issues.
99-- to reliably resolve these issues.
100--
100--
101-- One resolution would be to ditch standard terminal interfaces
101-- One resolution would be to ditch standard terminal interfaces
@@ -132,9 +132,7 @@ import Lens.Micro
132import qualified System.Console.Terminfo as Terminfo
132import qualified System.Console.Terminfo as Terminfo
133import System.Posix.Signals.Exts
133import System.Posix.Signals.Exts
134
134
135−#if !MIN_VERSION_base(4,11,0)
136import Data.Monoid ((<>))
135import Data.Monoid ((<>))
137−#endif
138
136
139-- | Set up the terminal with file descriptor `inputFd` for input.
137-- | Set up the terminal with file descriptor `inputFd` for input.
140-- Returns an 'Input'.
138-- Returns an 'Input'.
@@ -143,8 +141,22 @@ import Data.Monoid ((<>))
143-- bytes comes from 'classifyMapForTerm' which is then overridden by
141-- bytes comes from 'classifyMapForTerm' which is then overridden by
144-- the the applicable entries from the configuration's 'inputMap'.
142-- the the applicable entries from the configuration's 'inputMap'.
145--
143--
146−-- The terminal device's mode flags are configured by the
144+-- The terminal device is configured with the attributes:
147−-- 'attributeControl' function.
145+--
146+-- * IXON disabled: disables software flow control on outgoing data.
147+-- This stops the process from being suspended if the output terminal
148+-- cannot keep up.
149+--
150+-- * Raw mode is used for input.
151+--
152+-- * ISIG disabled (enables keyboard combinations that result in
153+-- signals)
154+--
155+-- * ECHO disabled (input is not echoed to the output)
156+--
157+-- * ICANON disabled (canonical mode (line mode) input is not used)
158+--
159+-- * IEXTEN disabled (extended functions are disabled)
148inputForConfig :: Config -> IO Input
160inputForConfig :: Config -> IO Input
149inputForConfig config@Config{ termName = Just termName
161inputForConfig config@Config{ termName = Just termName
150 , inputFd = Just termFd
162 , inputFd = Just termFd
@@ -154,23 +166,20 @@ inputForConfig config@Config{ termName = Just termName
154 terminal <- Terminfo.setupTerm termName
166 terminal <- Terminfo.setupTerm termName
155 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]
167 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]
156 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides
168 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides
157− (setAttrs, unsetAttrs) <- attributeControl termFd
169+ (setAttrs,unsetAttrs) <- attributeControl termFd
158 setAttrs
170 setAttrs
159 input <- initInput config activeInputMap
171 input <- initInput config activeInputMap
160 let pokeIO = Catch $ do
172 let pokeIO = Catch $ do
173+ let e = error "vty internal failure: this value should not propagate to users"
161 setAttrs
174 setAttrs
162− atomically $ writeTChan (input^.eventChannel) ResumeAfterSignal
175+ atomically $ writeTChan (input^.eventChannel) (EvResize e e)
163 _ <- installHandler windowChange pokeIO Nothing
176 _ <- installHandler windowChange pokeIO Nothing
164 _ <- installHandler continueProcess pokeIO Nothing
177 _ <- installHandler continueProcess pokeIO Nothing
165−
166− let restore = unsetAttrs
167−
168 return $ input
178 return $ input
169 { shutdownInput = do
179 { shutdownInput = do
170 shutdownInput input
180 shutdownInput input
171 _ <- installHandler windowChange Ignore Nothing
181 _ <- installHandler windowChange Ignore Nothing
172 _ <- installHandler continueProcess Ignore Nothing
182 _ <- installHandler continueProcess Ignore Nothing
173− restore
183+ unsetAttrs
174− , restoreInputState = restoreInputState input >> restore
175 }
184 }
176inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig
185inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig
src/Graphics/Vty/Input/Classify.hs+29−53
@@ -1,11 +1,10 @@
1{-# OPTIONS_HADDOCK hide #-}
1{-# OPTIONS_HADDOCK hide #-}
2−-- This makes a kind of trie. Has space efficiency issues with large
2+-- This makes a kind of tri. Has space efficiency issues with large
3-- input blocks. Likely building a parser and just applying that would
3-- input blocks. Likely building a parser and just applying that would
4-- be better.
4-- be better.
5module Graphics.Vty.Input.Classify
5module Graphics.Vty.Input.Classify
6 ( classify
6 ( classify
7 , KClass(..)
7 , KClass(..)
8− , ClassifierState(..)
9 )
8 )
10where
9where
11
10
@@ -17,39 +16,25 @@ import Graphics.Vty.Input.Classify.Types
17
16
18import Codec.Binary.UTF8.Generic (decode)
17import Codec.Binary.UTF8.Generic (decode)
19
18
20−import Control.Arrow (first)
19+import Data.List (inits)
21import qualified Data.Map as M( fromList, lookup )
20import qualified Data.Map as M( fromList, lookup )
22import Data.Maybe ( mapMaybe )
21import Data.Maybe ( mapMaybe )
23import qualified Data.Set as S( fromList, member )
22import qualified Data.Set as S( fromList, member )
24
23
24+import Data.Char
25import Data.Word
25import Data.Word
26
26
27−import qualified Data.ByteString as BS
28−import qualified Data.ByteString.Char8 as BS8
29−import Data.ByteString.Char8 (ByteString)
30−
31−-- | Whether the classifier is currently processing a chunked format.
32−-- Currently, only bracketed pastes use this.
33−data ClassifierState
34− = ClassifierStart
35− -- ^ Not processing a chunked format.
36− | ClassifierInChunk ByteString [ByteString]
37− -- ^ Currently processing a chunked format. The initial chunk is in the
38− -- first argument and a reversed remainder of the chunks is collected in
39− -- the second argument. At the end of the processing, the chunks are
40− -- reversed and concatenated with the final chunk.
41−
42−compile :: ClassifyMap -> ByteString -> KClass
27+compile :: ClassifyMap -> [Char] -> KClass
43compile table = cl' where
28compile table = cl' where
44 -- take all prefixes and create a set of these
29 -- take all prefixes and create a set of these
45− prefixSet = S.fromList $ concatMap (init . BS.inits . BS8.pack . fst) table
30+ prefixSet = S.fromList $ concatMap (init . inits . fst) $ table
46 maxValidInputLength = maximum (map (length . fst) table)
31 maxValidInputLength = maximum (map (length . fst) table)
47− eventForInput = M.fromList $ map (first BS8.pack) table
32+ eventForInput = M.fromList table
48− cl' inputBlock | BS8.null inputBlock = Prefix
33+ cl' [] = Prefix
49 cl' inputBlock = case M.lookup inputBlock eventForInput of
34 cl' inputBlock = case M.lookup inputBlock eventForInput of
50 -- if the inputBlock is exactly what is expected for an
35 -- if the inputBlock is exactly what is expected for an
51 -- event then consume the whole block and return the event
36 -- event then consume the whole block and return the event
52− Just e -> Valid e BS8.empty
37+ Just e -> Valid e []
53 Nothing -> case S.member inputBlock prefixSet of
38 Nothing -> case S.member inputBlock prefixSet of
54 True -> Prefix
39 True -> Prefix
55 -- look up progressively smaller tails of the input
40 -- look up progressively smaller tails of the input
@@ -60,49 +45,40 @@ compile table = cl' where
60 -- H: There will always be one match. The prefixSet
45 -- H: There will always be one match. The prefixSet
61 -- contains, by definition, all prefixes of an event.
46 -- contains, by definition, all prefixes of an event.
62 False ->
47 False ->
63− let inputPrefixes = reverse . take maxValidInputLength . tail . BS8.inits $ inputBlock
48+ let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock
64 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of
49 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of
65− (s,e) : _ -> Valid e (BS8.drop (BS8.length s) inputBlock)
50+ (s,e) : _ -> Valid e (drop (length s) inputBlock)
66 -- neither a prefix or a full event.
51 -- neither a prefix or a full event.
67 [] -> Invalid
52 [] -> Invalid
68
53
69−classify :: ClassifyMap -> ClassifierState -> ByteString -> KClass
54+classify :: ClassifyMap -> [Char] -> KClass
70−classify table = process
55+classify table =
71− where
72− standardClassifier = compile table
56+ let standardClassifier = compile table
73−
74− process ClassifierStart s =
75− case BS.uncons s of
57+ in \s -> case s of
76− _ | bracketedPasteStarted s ->
58+ _ | bracketedPasteStarted s ->
77− if bracketedPasteFinished s
78− then parseBracketedPaste s
79− else Chunk
80− _ | isMouseEvent s -> classifyMouseEvent s
81− _ | isFocusEvent s -> classifyFocusEvent s
82− Just (c,cs) | c >= 0xC2 -> classifyUtf8 c cs
83− _ -> standardClassifier s
84−
85− process (ClassifierInChunk p ps) s | bracketedPasteStarted p =
86 if bracketedPasteFinished s
59 if bracketedPasteFinished s
87− then parseBracketedPaste $ BS.concat $ p:reverse (s:ps)
60+ then parseBracketedPaste s
88− else Chunk
61+ else Prefix
89− process ClassifierInChunk{} _ = Invalid
62+ _ | isMouseEvent s -> classifyMouseEvent s
63+ _ | isFocusEvent s -> classifyFocusEvent s
64+ c:cs | ord c >= 0xC2 -> classifyUtf8 c cs
65+ _ -> standardClassifier s
90
66
91−classifyUtf8 :: Word8 -> ByteString -> KClass
67+classifyUtf8 :: Char -> [Char] -> KClass
92classifyUtf8 c cs =
68classifyUtf8 c cs =
93− let n = utf8Length c
69+ let n = utf8Length (ord c)
94− (codepoint,rest) = BS8.splitAt (n - 1) cs
70+ (codepoint,rest) = splitAt n (c:cs)
95
71
96 codepoint8 :: [Word8]
72 codepoint8 :: [Word8]
97− codepoint8 = c:BS.unpack codepoint
73+ codepoint8 = map (fromIntegral . ord) codepoint
98
74
99 in case decode codepoint8 of
75 in case decode codepoint8 of
100− _ | n < BS.length codepoint + 1 -> Prefix
76+ _ | n < length codepoint -> Prefix
101− Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest
77+ Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest
102 -- something bad happened; just ignore and continue.
78 -- something bad happened; just ignore and continue.
103− Nothing -> Invalid
79+ Nothing -> Invalid
104
80
105−utf8Length :: Word8 -> Int
81+utf8Length :: (Num t, Ord a, Num a) => a -> t
106utf8Length c
82utf8Length c
107 | c < 0x80 = 1
83 | c < 0x80 = 1
108 | c < 0xE0 = 2
84 | c < 0xE0 = 2
src/Graphics/Vty/Input/Classify/Parse.hs+7−10
@@ -16,15 +16,12 @@ import Graphics.Vty.Input.Classify.Types
16import Control.Monad.Trans.Maybe
16import Control.Monad.Trans.Maybe
17import Control.Monad.State
17import Control.Monad.State
18
18
19−import qualified Data.ByteString.Char8 as BS8
20−import Data.ByteString.Char8 (ByteString)
21−
22−type Parser a = MaybeT (State ByteString) a
19+type Parser a = MaybeT (State String) a
23
20
24-- | Run a parser on a given input string. If the parser fails, return
21-- | Run a parser on a given input string. If the parser fails, return
25-- 'Invalid'. Otherwise return the valid event ('Valid') and the
22-- 'Invalid'. Otherwise return the valid event ('Valid') and the
26-- remaining unparsed characters.
23-- remaining unparsed characters.
27−runParser :: ByteString -> Parser Event -> KClass
24+runParser :: String -> Parser Event -> KClass
28runParser s parser =
25runParser s parser =
29 case runState (runMaybeT parser) s of
26 case runState (runMaybeT parser) s of
30 (Nothing, _) -> Invalid
27 (Nothing, _) -> Invalid
@@ -39,9 +36,9 @@ failParse = fail "invalid parse"
39-- return '123' and consume those characters.
36-- return '123' and consume those characters.
40readInt :: Parser Int
37readInt :: Parser Int
41readInt = do
38readInt = do
42− s <- BS8.unpack <$> get
39+ s <- get
43 case (reads :: ReadS Int) s of
40 case (reads :: ReadS Int) s of
44− [(i, rest)] -> put (BS8.pack rest) >> return i
41+ [(i, rest)] -> put rest >> return i
45 _ -> failParse
42 _ -> failParse
46
43
47-- | Read a character from the input stream. If one cannot be read (e.g.
44-- | Read a character from the input stream. If one cannot be read (e.g.
@@ -49,9 +46,9 @@ readInt = do
49readChar :: Parser Char
46readChar :: Parser Char
50readChar = do
47readChar = do
51 s <- get
48 s <- get
52− case BS8.uncons s of
49+ case s of
53− Just (c,rest) -> put rest >> return c
50+ c:rest -> put rest >> return c
54− Nothing -> failParse
51+ _ -> failParse
55
52
56-- | Read a character from the input stream and fail parsing if it is
53-- | Read a character from the input stream and fail parsing if it is
57-- not the specified character.
54-- not the specified character.
src/Graphics/Vty/Input/Classify/Types.hs+1−7
@@ -1,6 +1,5 @@
1-- | This module exports the input classification type to avoid import
1-- | This module exports the input classification type to avoid import
2-- cycles between other modules that need this.
2-- cycles between other modules that need this.
3−{-# LANGUAGE StrictData #-}
4module Graphics.Vty.Input.Classify.Types
3module Graphics.Vty.Input.Classify.Types
5 ( KClass(..)
4 ( KClass(..)
6 )
5 )
@@ -8,10 +7,8 @@ where
8
7
9import Graphics.Vty.Input.Events
8import Graphics.Vty.Input.Events
10
9
11−import Data.ByteString.Char8 (ByteString)
12−
13data KClass
10data KClass
14− = Valid Event ByteString
11+ = Valid Event [Char]
15 -- ^ A valid event was parsed. Any unused characters from the input
12 -- ^ A valid event was parsed. Any unused characters from the input
16 -- stream are also provided.
13 -- stream are also provided.
17 | Invalid
14 | Invalid
@@ -19,7 +16,4 @@ data KClass
19 | Prefix
16 | Prefix
20 -- ^ The input characters form the prefix of a valid event character
17 -- ^ The input characters form the prefix of a valid event character
21 -- sequence.
18 -- sequence.
22− | Chunk
23− -- ^ The input characters are either start of a bracketed paste chunk
24− -- or in the middle of a bracketed paste chunk.
25 deriving(Show, Eq)
19 deriving(Show, Eq)
src/Graphics/Vty/Input/Events.hs+6−24
@@ -1,8 +1,6 @@
1{-# Language DeriveGeneric #-}
1{-# Language DeriveGeneric #-}
2−{-# Language StrictData #-}
3module Graphics.Vty.Input.Events where
2module Graphics.Vty.Input.Events where
4
3
5−import Control.DeepSeq
6import Data.ByteString
4import Data.ByteString
7import GHC.Generics
5import GHC.Generics
8
6
@@ -16,29 +14,23 @@ import GHC.Generics
16--
14--
17-- * Actually, support for most of these but KEsc, KChar, KBS, and
15-- * Actually, support for most of these but KEsc, KChar, KBS, and
18-- KEnter vary by terminal and keyboard.
16-- KEnter vary by terminal and keyboard.
19−data Key = KEsc | KChar {-# UNPACK #-} Char | KBS | KEnter
17+data Key = KEsc | KChar Char | KBS | KEnter
20 | KLeft | KRight | KUp | KDown
18 | KLeft | KRight | KUp | KDown
21 | KUpLeft | KUpRight | KDownLeft | KDownRight | KCenter
19 | KUpLeft | KUpRight | KDownLeft | KDownRight | KCenter
22− | KFun {-# UNPACK #-} Int | KBackTab | KPrtScr | KPause | KIns
20+ | KFun Int | KBackTab | KPrtScr | KPause | KIns
23 | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
21 | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
24 deriving (Eq,Show,Read,Ord,Generic)
22 deriving (Eq,Show,Read,Ord,Generic)
25
23
26−instance NFData Key
27−
28-- | Modifier keys. Key codes are interpreted such that users are more
24-- | Modifier keys. Key codes are interpreted such that users are more
29-- likely to have Meta than Alt; for instance on the PC Linux console,
25-- likely to have Meta than Alt; for instance on the PC Linux console,
30-- 'MMeta' will generally correspond to the physical Alt key.
26-- 'MMeta' will generally correspond to the physical Alt key.
31data Modifier = MShift | MCtrl | MMeta | MAlt
27data Modifier = MShift | MCtrl | MMeta | MAlt
32 deriving (Eq,Show,Read,Ord,Generic)
28 deriving (Eq,Show,Read,Ord,Generic)
33
29
34−instance NFData Modifier
35−
36-- | Mouse buttons.
30-- | Mouse buttons.
37data Button = BLeft | BMiddle | BRight | BScrollUp | BScrollDown
31data Button = BLeft | BMiddle | BRight | BScrollUp | BScrollDown
38 deriving (Eq,Show,Read,Ord,Generic)
32 deriving (Eq,Show,Read,Ord,Generic)
39
33
40−instance NFData Button
41−
42-- | Events.
34-- | Events.
43data Event
35data Event
44 = EvKey Key [Modifier]
36 = EvKey Key [Modifier]
@@ -52,8 +44,10 @@ data Event
52 -- without specifying which one; in that case, Nothing is provided.
44 -- without specifying which one; in that case, Nothing is provided.
53 -- Otherwise Just the button released is included in the event.
45 -- Otherwise Just the button released is included in the event.
54 | EvResize Int Int
46 | EvResize Int Int
55− -- The terminal window was resized and the size is provided in the
47+ -- ^ If read from 'eventChannel' this is the size at the time of the
56− -- integer fields (width, height).
48+ -- signal. If read from 'nextEvent' this is the size at the time the
49+ -- event was processed by Vty. Typically these are the same, but if
50+ -- somebody is resizing the terminal quickly they can be different.
57 | EvPaste ByteString
51 | EvPaste ByteString
58 -- ^ A paste event occurs when a bracketed paste input sequence is
52 -- ^ A paste event occurs when a bracketed paste input sequence is
59 -- received. For terminals that support bracketed paste mode, these
53 -- received. For terminals that support bracketed paste mode, these
@@ -68,16 +62,4 @@ data Event
68 -- ^ The terminal running the application gained input focus.
62 -- ^ The terminal running the application gained input focus.
69 deriving (Eq,Show,Read,Ord,Generic)
63 deriving (Eq,Show,Read,Ord,Generic)
70
64
71−instance NFData Event
72−
73type ClassifyMap = [(String,Event)]
65type ClassifyMap = [(String,Event)]
74−
75−-- | The type of internal events that drive the internal Vty event
76−-- dispatching to the application.
77−data InternalEvent =
78− ResumeAfterSignal
79− -- ^ Vty resumed operation after the process was interrupted with a
80− -- signal. In practice this translates into a screen redraw in the
81− -- input event loop.
82− | InputEvent Event
83− -- ^ An input event was received.
src/Graphics/Vty/Input/Focus.hs+13−15
@@ -11,32 +11,30 @@ import Graphics.Vty.Input.Classify.Types
11import Graphics.Vty.Input.Classify.Parse
11import Graphics.Vty.Input.Classify.Parse
12
12
13import Control.Monad.State
13import Control.Monad.State
14−
14+import Data.List (isPrefixOf)
15−import qualified Data.ByteString.Char8 as BS8
16−import Data.ByteString.Char8 (ByteString)
17
15
18-- | These sequences set xterm-based terminals to send focus event
16-- | These sequences set xterm-based terminals to send focus event
19-- sequences.
17-- sequences.
20−requestFocusEvents :: ByteString
18+requestFocusEvents :: String
21−requestFocusEvents = BS8.pack "\ESC[?1004h"
19+requestFocusEvents = "\ESC[?1004h"
22
20
23-- | These sequences disable focus events.
21-- | These sequences disable focus events.
24−disableFocusEvents :: ByteString
22+disableFocusEvents :: String
25−disableFocusEvents = BS8.pack "\ESC[?1004l"
23+disableFocusEvents = "\ESC[?1004l"
26
24
27-- | Does the specified string begin with a focus event?
25-- | Does the specified string begin with a focus event?
28−isFocusEvent :: ByteString -> Bool
26+isFocusEvent :: String -> Bool
29−isFocusEvent s = BS8.isPrefixOf focusIn s ||
27+isFocusEvent s = isPrefixOf focusIn s ||
30− BS8.isPrefixOf focusOut s
28+ isPrefixOf focusOut s
31
29
32−focusIn :: ByteString
30+focusIn :: String
33−focusIn = BS8.pack "\ESC[I"
31+focusIn = "\ESC[I"
34
32
35−focusOut :: ByteString
33+focusOut :: String
36−focusOut = BS8.pack "\ESC[O"
34+focusOut = "\ESC[O"
37
35
38-- | Attempt to classify an input string as a focus event.
36-- | Attempt to classify an input string as a focus event.
39−classifyFocusEvent :: ByteString -> KClass
37+classifyFocusEvent :: String -> KClass
40classifyFocusEvent s = runParser s $ do
38classifyFocusEvent s = runParser s $ do
41 when (not $ isFocusEvent s) failParse
39 when (not $ isFocusEvent s) failParse
42
40
src/Graphics/Vty/Input/Loop.hs+29−86
@@ -1,9 +1,8 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE NoMonomorphismRestriction #-}
3{-# LANGUAGE RecordWildCards #-}
1{-# LANGUAGE RecordWildCards #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5−{-# LANGUAGE TemplateHaskell #-}
6{-# OPTIONS_HADDOCK hide #-}
2{-# OPTIONS_HADDOCK hide #-}
3+{-# LANGUAGE NoMonomorphismRestriction #-}
4+{-# LANGUAGE TemplateHaskell #-}
5+{-# LANGUAGE CPP #-}
7-- | The input layer used to be a single function that correctly
6-- | The input layer used to be a single function that correctly
8-- accounted for the non-threaded runtime by emulating the terminal
7-- accounted for the non-threaded runtime by emulating the terminal
9-- VMIN adn VTIME handling. This has been removed and replace with a
8-- VMIN adn VTIME handling. This has been removed and replace with a
@@ -34,15 +33,12 @@ import Control.Monad.Trans.State (StateT(..), evalStateT)
34import Control.Monad.State.Class (MonadState, modify)
33import Control.Monad.State.Class (MonadState, modify)
35import Control.Monad.Trans.Reader (ReaderT(..))
34import Control.Monad.Trans.Reader (ReaderT(..))
36
35
37−import qualified Data.ByteString.Char8 as BS8
36+import Data.Char
38−import qualified Data.ByteString as BS
39−import Data.ByteString.Char8 (ByteString)
40import Data.IORef
37import Data.IORef
41import Data.Word (Word8)
38import Data.Word (Word8)
42
39
43−import Foreign (allocaArray)
40+import Foreign ( allocaArray, peekArray, Ptr )
44import Foreign.C.Types (CInt(..))
41import Foreign.C.Types (CInt(..))
45−import Foreign.Ptr (Ptr, castPtr)
46
42
47import System.IO
43import System.IO
48import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))
44import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))
@@ -55,15 +51,10 @@ data Input = Input
55 { -- | Channel of events direct from input processing. Unlike
51 { -- | Channel of events direct from input processing. Unlike
56 -- 'nextEvent' this will not refresh the display if the next event
52 -- 'nextEvent' this will not refresh the display if the next event
57 -- is an 'EvResize'.
53 -- is an 'EvResize'.
58− _eventChannel :: TChan InternalEvent
54+ _eventChannel :: TChan Event
59− -- | Shuts down the input processing. As part of shutting down the
55+ -- | Shuts down the input processing. This should return the
60− -- input, this should also restore the input state.
56+ -- terminal input state to before he input initialized.
61 , shutdownInput :: IO ()
57 , shutdownInput :: IO ()
62− -- | Restore the terminal's input state to what it was prior
63− -- to configuring input for Vty. This should be done as part of
64− -- 'shutdownInput' but is exposed in case you need to access it
65− -- directly.
66− , restoreInputState :: IO ()
67 -- | Changes to this value are reflected after the next event.
58 -- | Changes to this value are reflected after the next event.
68 , _configRef :: IORef Config
59 , _configRef :: IORef Config
69 -- | input debug log
60 -- | input debug log
@@ -80,11 +71,10 @@ data InputBuffer = InputBuffer
80makeLenses ''InputBuffer
71makeLenses ''InputBuffer
81
72
82data InputState = InputState
73data InputState = InputState
83− { _unprocessedBytes :: ByteString
74+ { _unprocessedBytes :: String
84− , _classifierState :: ClassifierState
85 , _appliedConfig :: Config
75 , _appliedConfig :: Config
86 , _inputBuffer :: InputBuffer
76 , _inputBuffer :: InputBuffer
87− , _classifier :: ClassifierState -> ByteString -> KClass
77+ , _classifier :: String -> KClass
88 }
78 }
89
79
90makeLenses ''InputState
80makeLenses ''InputState
@@ -109,20 +99,20 @@ loopInputProcessor = do
109 dropInvalid
99 dropInvalid
110 loopInputProcessor
100 loopInputProcessor
111
101
112−addBytesToProcess :: ByteString -> InputM ()
102+addBytesToProcess :: String -> InputM ()
113addBytesToProcess block = unprocessedBytes <>= block
103addBytesToProcess block = unprocessedBytes <>= block
114
104
115emit :: Event -> InputM ()
105emit :: Event -> InputM ()
116emit event = do
106emit event = do
117 logMsg $ "parsed event: " ++ show event
107 logMsg $ "parsed event: " ++ show event
118− view eventChannel >>= liftIO . atomically . flip writeTChan (InputEvent event)
108+ view eventChannel >>= liftIO . atomically . flip writeTChan event
119
109
120-- The timing requirements are assured by the VMIN and VTIME set for the
110-- The timing requirements are assured by the VMIN and VTIME set for the
121-- device.
111-- device.
122--
112--
123-- Precondition: Under the threaded runtime. Only current use is from a
113-- Precondition: Under the threaded runtime. Only current use is from a
124-- forkOS thread. That case satisfies precondition.
114-- forkOS thread. That case satisfies precondition.
125−readFromDevice :: InputM ByteString
115+readFromDevice :: InputM String
126readFromDevice = do
116readFromDevice = do
127 newConfig <- view configRef >>= liftIO . readIORef
117 newConfig <- view configRef >>= liftIO . readIORef
128 oldConfig <- use appliedConfig
118 oldConfig <- use appliedConfig
@@ -142,10 +132,9 @@ readFromDevice = do
142 threadWaitRead fd
132 threadWaitRead fd
143 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)
133 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)
144 if bytesRead > 0
134 if bytesRead > 0
145− then BS.packCStringLen (castPtr bufferPtr, fromIntegral bytesRead)
135+ then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr
146− else return BS.empty
136+ else return []
147− when (not $ BS.null stringRep) $
148− logMsg $ "input bytes: " ++ show (BS8.unpack stringRep)
137+ when (not $ null stringRep) $ logMsg $ "input bytes: " ++ show stringRep
149 return stringRep
138 return stringRep
150
139
151applyConfig :: Fd -> Config -> IO ()
140applyConfig :: Fd -> Config -> IO ()
@@ -156,86 +145,41 @@ applyConfig _ _ = fail "(vty) applyConfig was not provided a complete configurat
156parseEvent :: InputM Event
145parseEvent :: InputM Event
157parseEvent = do
146parseEvent = do
158 c <- use classifier
147 c <- use classifier
159− s <- use classifierState
160 b <- use unprocessedBytes
148 b <- use unprocessedBytes
161− case c s b of
149+ case c b of
162 Valid e remaining -> do
150 Valid e remaining -> do
163 logMsg $ "valid parse: " ++ show e
151 logMsg $ "valid parse: " ++ show e
164 logMsg $ "remaining: " ++ show remaining
152 logMsg $ "remaining: " ++ show remaining
165− classifierState .= ClassifierStart
166 unprocessedBytes .= remaining
153 unprocessedBytes .= remaining
167 return e
154 return e
168− _ -> mzero
155+ _ -> mzero
169
156
170dropInvalid :: InputM ()
157dropInvalid :: InputM ()
171dropInvalid = do
158dropInvalid = do
172 c <- use classifier
159 c <- use classifier
173− s <- use classifierState
174 b <- use unprocessedBytes
160 b <- use unprocessedBytes
175− case c s b of
176− Chunk -> do
177− classifierState .=
178− case s of
179− ClassifierStart -> ClassifierInChunk b []
180− ClassifierInChunk p bs -> ClassifierInChunk p (b:bs)
181− unprocessedBytes .= BS8.empty
182− Invalid -> do
161+ when (c b == Invalid) $ do
183− logMsg "dropping input bytes"
162+ logMsg "dropping input bytes"
184− classifierState .= ClassifierStart
185− unprocessedBytes .= BS8.empty
163+ unprocessedBytes .= []
186− _ -> return ()
187
164
188runInputProcessorLoop :: ClassifyMap -> Input -> IO ()
165runInputProcessorLoop :: ClassifyMap -> Input -> IO ()
189runInputProcessorLoop classifyTable input = do
166runInputProcessorLoop classifyTable input = do
190 let bufferSize = 1024
167 let bufferSize = 1024
191 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do
168 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do
192− s0 <- InputState BS8.empty ClassifierStart
193− <$> readIORef (_configRef input)
169+ s0 <- InputState [] <$> readIORef (_configRef input)
194− <*> pure (InputBuffer bufferPtr bufferSize)
170+ <*> pure (InputBuffer bufferPtr bufferSize)
195− <*> pure (classify classifyTable)
171+ <*> pure (classify classifyTable)
196 runReaderT (evalStateT loopInputProcessor s0) input
172 runReaderT (evalStateT loopInputProcessor s0) input
197
173
198−-- | Construct two IO actions: one to configure the terminal for Vty and
199−-- one to restore the terminal mode flags to the values they had at the
200−-- time this function was called.
201−--
202−-- This function constructs a configuration action to clear the
203−-- following terminal mode flags:
204−--
205−-- * IXON disabled: disables software flow control on outgoing data.
206−-- This stops the process from being suspended if the output terminal
207−-- cannot keep up.
208−--
209−-- * Raw mode is used for input.
210−--
211−-- * ISIG (enables keyboard combinations that result in
212−-- signals)
213−--
214−-- * ECHO (input is not echoed to the output)
215−--
216−-- * ICANON (canonical mode (line mode) input is not used)
217−--
218−-- * IEXTEN (extended functions are disabled)
219−--
220−-- The configuration action also explicitly sets these flags:
221−--
222−-- * ICRNL (input carriage returns are mapped to newlines)
223attributeControl :: Fd -> IO (IO (), IO ())
174attributeControl :: Fd -> IO (IO (), IO ())
224attributeControl fd = do
175attributeControl fd = do
225 original <- getTerminalAttributes fd
176 original <- getTerminalAttributes fd
226− let vtyMode = foldl withMode clearedFlags flagsToSet
227− clearedFlags = foldl withoutMode original flagsToUnset
228− flagsToSet = [ MapCRtoLF -- ICRNL
229− ]
230− flagsToUnset = [ StartStopOutput -- IXON
231− , KeyboardInterrupts -- ISIG
177+ let vtyMode = foldl withoutMode original [ StartStopOutput, KeyboardInterrupts
232− , EnableEcho -- ECHO
233− , ProcessInput -- ICANON
234− , ExtendedFunctions -- IEXTEN
178+ , EnableEcho, ProcessInput, ExtendedFunctions
235− ]
179+ ]
236 let setAttrs = setTerminalAttributes fd vtyMode Immediately
180 let setAttrs = setTerminalAttributes fd vtyMode Immediately
237 unsetAttrs = setTerminalAttributes fd original Immediately
181 unsetAttrs = setTerminalAttributes fd original Immediately
238− return (setAttrs, unsetAttrs)
182+ return (setAttrs,unsetAttrs)
239
183
240logInitialInputState :: Input -> ClassifyMap -> IO()
184logInitialInputState :: Input -> ClassifyMap -> IO()
241logInitialInputState input classifyTable = case _inputDebug input of
185logInitialInputState input classifyTable = case _inputDebug input of
@@ -243,7 +187,7 @@ logInitialInputState input classifyTable = case _inputDebug input of
243 Just h -> do
187 Just h -> do
244 Config{ vmin = Just theVmin
188 Config{ vmin = Just theVmin
245 , vtime = Just theVtime
189 , vtime = Just theVtime
246− , termName = Just theTerm } <- readIORef $ _configRef input
190+ , termName = Just theTerm, .. } <- readIORef $ _configRef input
247 _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))
191 _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))
248 forM_ classifyTable $ \i -> case i of
192 forM_ classifyTable $ \i -> case i of
249 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)
193 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)
@@ -259,7 +203,6 @@ initInput config classifyTable = do
259 applyConfig fd config
203 applyConfig fd config
260 stopSync <- newEmptyMVar
204 stopSync <- newEmptyMVar
261 input <- Input <$> atomically newTChan
205 input <- Input <$> atomically newTChan
262− <*> pure (return ())
263 <*> pure (return ())
206 <*> pure (return ())
264 <*> newIORef config
207 <*> newIORef config
265 <*> maybe (return Nothing)
208 <*> maybe (return Nothing)
src/Graphics/Vty/Input/Mouse.hs+17−19
@@ -15,12 +15,10 @@ import Graphics.Vty.Input.Classify.Types
15import Graphics.Vty.Input.Classify.Parse
15import Graphics.Vty.Input.Classify.Parse
16
16
17import Control.Monad.State
17import Control.Monad.State
18+import Data.List (isPrefixOf)
18import Data.Maybe (catMaybes)
19import Data.Maybe (catMaybes)
19import Data.Bits ((.&.))
20import Data.Bits ((.&.))
20
21
21−import qualified Data.ByteString.Char8 as BS8
22−import Data.ByteString.Char8 (ByteString)
23−
24-- A mouse event in SGR extended mode is
22-- A mouse event in SGR extended mode is
25--
23--
26-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')
24-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')
@@ -34,28 +32,28 @@ import Data.ByteString.Char8 (ByteString)
34
32
35-- | These sequences set xterm-based terminals to send mouse event
33-- | These sequences set xterm-based terminals to send mouse event
36-- sequences.
34-- sequences.
37−requestMouseEvents :: ByteString
35+requestMouseEvents :: String
38−requestMouseEvents = BS8.pack "\ESC[?1000h\ESC[?1002h\ESC[?1006h"
36+requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h"
39
37
40-- | These sequences disable mouse events.
38-- | These sequences disable mouse events.
41−disableMouseEvents :: ByteString
39+disableMouseEvents :: String
42−disableMouseEvents = BS8.pack "\ESC[?1000l\ESC[?1002l\ESC[?1006l"
40+disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l"
43
41
44-- | Does the specified string begin with a mouse event?
42-- | Does the specified string begin with a mouse event?
45−isMouseEvent :: ByteString -> Bool
43+isMouseEvent :: String -> Bool
46isMouseEvent s = isSGREvent s || isNormalEvent s
44isMouseEvent s = isSGREvent s || isNormalEvent s
47
45
48−isSGREvent :: ByteString -> Bool
46+isSGREvent :: String -> Bool
49−isSGREvent = BS8.isPrefixOf sgrPrefix
47+isSGREvent = isPrefixOf sgrPrefix
50
48
51−sgrPrefix :: ByteString
49+sgrPrefix :: String
52−sgrPrefix = BS8.pack "\ESC[M"
50+sgrPrefix = "\ESC[M"
53
51
54−isNormalEvent :: ByteString -> Bool
52+isNormalEvent :: String -> Bool
55−isNormalEvent = BS8.isPrefixOf normalPrefix
53+isNormalEvent = isPrefixOf normalPrefix
56
54
57−normalPrefix :: ByteString
55+normalPrefix :: String
58−normalPrefix = BS8.pack "\ESC[<"
56+normalPrefix = "\ESC[<"
59
57
60-- Modifier bits:
58-- Modifier bits:
61shiftBit :: Int
59shiftBit :: Int
@@ -89,8 +87,8 @@ scrollDown = 65
89hasBitSet :: Int -> Int -> Bool
87hasBitSet :: Int -> Int -> Bool
90hasBitSet val bit = val .&. bit > 0
88hasBitSet val bit = val .&. bit > 0
91
89
92−-- | Attempt to classify an input string as a mouse event.
90+-- | Attempt to lassify an input string as a mouse event.
93−classifyMouseEvent :: ByteString -> KClass
91+classifyMouseEvent :: String -> KClass
94classifyMouseEvent s = runParser s $ do
92classifyMouseEvent s = runParser s $ do
95 when (not $ isMouseEvent s) failParse
93 when (not $ isMouseEvent s) failParse
96
94
@@ -102,7 +100,7 @@ classifyMouseEvent s = runParser s $ do
102 'M' -> classifyNormalMouseEvent
100 'M' -> classifyNormalMouseEvent
103 _ -> failParse
101 _ -> failParse
104
102
105−-- Given a modifier/button value, determine which button was indicated
103+-- Given a modifer/button value, determine which button was indicated
106getSGRButton :: Int -> Parser Button
104getSGRButton :: Int -> Parser Button
107getSGRButton mods =
105getSGRButton mods =
108 let buttonMap = [ (leftButton, BLeft)
106 let buttonMap = [ (leftButton, BLeft)
src/Graphics/Vty/Input/Paste.hs+24−16
@@ -9,33 +9,41 @@ module Graphics.Vty.Input.Paste
9where
9where
10
10
11import qualified Data.ByteString.Char8 as BS8
11import qualified Data.ByteString.Char8 as BS8
12−import Data.ByteString.Char8 (ByteString)
13
12
14import Graphics.Vty.Input.Events
13import Graphics.Vty.Input.Events
15import Graphics.Vty.Input.Classify.Types
14import Graphics.Vty.Input.Classify.Types
16
15
17−bracketedPasteStart :: ByteString
16+import Data.List (isPrefixOf, isInfixOf)
18−bracketedPasteStart = BS8.pack "\ESC[200~"
19
17
18+bracketedPasteStart :: String
19+bracketedPasteStart = "\ESC[200~"
20+
20−bracketedPasteEnd :: ByteString
21+bracketedPasteEnd :: String
21−bracketedPasteEnd = BS8.pack "\ESC[201~"
22+bracketedPasteEnd = "\ESC[201~"
22
23
23-- | Does the input start a bracketed paste?
24-- | Does the input start a bracketed paste?
24−bracketedPasteStarted :: ByteString -> Bool
25+bracketedPasteStarted :: String -> Bool
25−bracketedPasteStarted = BS8.isPrefixOf bracketedPasteStart
26+bracketedPasteStarted = isPrefixOf bracketedPasteStart
26
27
27-- | Does the input contain a complete bracketed paste?
28-- | Does the input contain a complete bracketed paste?
28−bracketedPasteFinished :: ByteString -> Bool
29+bracketedPasteFinished :: String -> Bool
29−bracketedPasteFinished = BS8.isInfixOf bracketedPasteEnd
30+bracketedPasteFinished = isInfixOf bracketedPasteEnd
30
31
31-- | Parse a bracketed paste. This should only be called on a string if
32-- | Parse a bracketed paste. This should only be called on a string if
32-- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return
33-- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return
33-- 'True'.
34-- 'True'.
34−parseBracketedPaste :: ByteString -> KClass
35+parseBracketedPaste :: String -> KClass
35parseBracketedPaste s =
36parseBracketedPaste s =
37+ let (p, rest) = takeUntil (drop (length bracketedPasteStart) s) bracketedPasteEnd
38+ rest' = if bracketedPasteEnd `isPrefixOf` rest
39+ then drop (length bracketedPasteEnd) rest
40+ else rest
36− Valid (EvPaste p) (BS8.drop endLen rest')
41+ in Valid (EvPaste $ BS8.pack p) rest'
37− where
42+
38− startLen = BS8.length bracketedPasteStart
43+takeUntil :: (Eq a) => [a] -> [a] -> ([a],[a])
39− endLen = BS8.length bracketedPasteEnd
44+takeUntil [] _ = ([], [])
40− (_, rest ) = BS8.breakSubstring bracketedPasteStart s
45+takeUntil cs sub
41− (p, rest') = BS8.breakSubstring bracketedPasteEnd . BS8.drop startLen $ rest
46+ | length cs < length sub = (cs, [])
47+ | take (length sub) cs == sub = ([], drop (length sub) cs)
48+ | otherwise = let (pre, suf) = takeUntil (tail cs) sub
49+ in (head cs:pre, suf)
src/Graphics/Vty/Input/Terminfo.hs+4−6
@@ -74,7 +74,7 @@ visibleChars = [ ([x], EvKey (KChar x) [])
74ctrlChars :: ClassifyMap
74ctrlChars :: ClassifyMap
75ctrlChars =
75ctrlChars =
76 [ ([toEnum x],EvKey (KChar y) [MCtrl])
76 [ ([toEnum x],EvKey (KChar y) [MCtrl])
77− | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_'])
77+ | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_'])
78 , y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.
78 , y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.
79 , y /= 'h' -- CTRL-h should not hide BS
79 , y /= 'h' -- CTRL-h should not hide BS
80 ]
80 ]
@@ -86,12 +86,10 @@ ctrlMetaChars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrlChars
86-- | Esc, meta-esc, delete, meta-delete, enter, meta-enter.
86-- | Esc, meta-esc, delete, meta-delete, enter, meta-enter.
87specialSupportKeys :: ClassifyMap
87specialSupportKeys :: ClassifyMap
88specialSupportKeys =
88specialSupportKeys =
89− [ ("\ESC\ESC[5~",EvKey KPageUp [MMeta])
90− , ("\ESC\ESC[6~",EvKey KPageDown [MMeta])
91− -- special support for ESC
89+ [ -- special support for ESC
92− , ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])
90+ ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])
93 -- Special support for backspace
91 -- Special support for backspace
94− , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta]), ("\b",EvKey KBS [])
92+ , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])
95 -- Special support for Enter
93 -- Special support for Enter
96 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])
94 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])
97 -- explicit support for tab
95 -- explicit support for tab
src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+1−1
@@ -59,7 +59,7 @@ navKeys3 =
59-- This encoding depends on the terminal.
59-- This encoding depends on the terminal.
60functionKeys1 :: ClassifyMap
60functionKeys1 :: ClassifyMap
61functionKeys1 =
61functionKeys1 =
62− let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-head nrs+ff) m) | n <- nrs ] in
62+ let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in
63 concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]
63 concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]
64
64
65-- | encoding for meta plus char
65-- | encoding for meta plus char
src/Graphics/Vty/Output.hs+14−15
@@ -1,4 +1,5 @@
1−{-# LANGUAGE RecordWildCards, CPP #-}
1+{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE NamedFieldPuns #-}
2-- | This module provides functions for accessing the current terminal
3-- | This module provides functions for accessing the current terminal
3-- or a specific terminal device.
4-- or a specific terminal device.
4--
5--
@@ -37,11 +38,10 @@ import Graphics.Vty.Output.TerminfoBased as TerminfoBased
37
38
38import Blaze.ByteString.Builder (writeToByteString)
39import Blaze.ByteString.Builder (writeToByteString)
39
40
40−import Data.List (isPrefixOf)
41+import Control.Monad.Trans
41
42
42−#if !MIN_VERSION_base(4,11,0)
43+import Data.List (isPrefixOf)
43import Data.Monoid ((<>))
44import Data.Monoid ((<>))
44−#endif
45
45
46-- | Returns an `Output` for the terminal specified in `Config`.
46-- | Returns an `Output` for the terminal specified in `Config`.
47--
47--
@@ -58,12 +58,11 @@ import Data.Monoid ((<>))
58-- * If TERM contains "xterm" or "screen", use XTermColor.
58-- * If TERM contains "xterm" or "screen", use XTermColor.
59-- * otherwise use the TerminfoBased driver.
59-- * otherwise use the TerminfoBased driver.
60outputForConfig :: Config -> IO Output
60outputForConfig :: Config -> IO Output
61−outputForConfig Config{ outputFd = Just fd, termName = Just termName
61+outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do
62− , colorMode = Just colorMode, .. } = do
63 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName
62 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName
64− then XTermColor.reserveTerminal termName fd colorMode
63+ then XTermColor.reserveTerminal termName fd
65 -- Not an xterm-like terminal. try for generic terminfo.
64 -- Not an xterm-like terminal. try for generic terminfo.
66− else TerminfoBased.reserveTerminal termName fd colorMode
65+ else TerminfoBased.reserveTerminal termName fd
67
66
68 case mouseMode of
67 case mouseMode of
69 Just s -> setMode t Mouse s
68 Just s -> setMode t Mouse s
@@ -78,30 +77,30 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig
78
77
79-- | Sets the cursor position to the given output column and row.
78-- | Sets the cursor position to the given output column and row.
80--
79--
81−-- This is not necessarily the same as the character position with the
80+-- This is not necessarially the same as the character position with the
82-- same coordinates. Characters can be a variable number of columns in
81-- same coordinates. Characters can be a variable number of columns in
83-- width.
82-- width.
84--
83--
85-- Currently, the only way to set the cursor position to a given
84-- Currently, the only way to set the cursor position to a given
86-- character coordinate is to specify the coordinate in the Picture
85-- character coordinate is to specify the coordinate in the Picture
87-- instance provided to 'outputPicture' or 'refresh'.
86-- instance provided to 'outputPicture' or 'refresh'.
88−setCursorPos :: Output -> Int -> Int -> IO ()
87+setCursorPos :: MonadIO m => Output -> Int -> Int -> m ()
89setCursorPos t x y = do
88setCursorPos t x y = do
90 bounds <- displayBounds t
89 bounds <- displayBounds t
91 when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do
90 when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do
92 dc <- displayContext t bounds
91 dc <- displayContext t bounds
93− outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y
92+ liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y
94
93
95-- | Hides the cursor.
94-- | Hides the cursor.
96−hideCursor :: Output -> IO ()
95+hideCursor :: MonadIO m => Output -> m ()
97hideCursor t = do
96hideCursor t = do
98 bounds <- displayBounds t
97 bounds <- displayBounds t
99 dc <- displayContext t bounds
98 dc <- displayContext t bounds
100− outputByteBuffer t $ writeToByteString $ writeHideCursor dc
99+ liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc
101
100
102-- | Shows the cursor.
101-- | Shows the cursor.
103−showCursor :: Output -> IO ()
102+showCursor :: MonadIO m => Output -> m ()
104showCursor t = do
103showCursor t = do
105 bounds <- displayBounds t
104 bounds <- displayBounds t
106 dc <- displayContext t bounds
105 dc <- displayContext t bounds
107− outputByteBuffer t $ writeToByteString $ writeShowCursor dc
106+ liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc
src/Graphics/Vty/Output/Interface.hs+35−61
@@ -1,9 +1,9 @@
1-- Copyright Corey O'Connor
1-- Copyright Corey O'Connor
2+{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE RankNTypes #-}
3{-# LANGUAGE RankNTypes #-}
3{-# LANGUAGE ExistentialQuantification #-}
4{-# LANGUAGE ExistentialQuantification #-}
4{-# LANGUAGE GADTs #-}
5{-# LANGUAGE GADTs #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleContexts #-}
6−{-# LANGUAGE ScopedTypeVariables #-}
7-- | This module provides an abstract interface for performing terminal
7-- | This module provides an abstract interface for performing terminal
8-- output. The only user-facing part of this API is 'Output'.
8-- output. The only user-facing part of this API is 'Output'.
9module Graphics.Vty.Output.Interface
9module Graphics.Vty.Output.Interface
@@ -29,6 +29,8 @@ import Graphics.Vty.DisplayAttributes
29import Blaze.ByteString.Builder (Write, writeToByteString)
29import Blaze.ByteString.Builder (Write, writeToByteString)
30import Blaze.ByteString.Builder.ByteString (writeByteString)
30import Blaze.ByteString.Builder.ByteString (writeByteString)
31
31
32+import Control.Monad.Trans
33+
32import qualified Data.ByteString as BS
34import qualified Data.ByteString as BS
33import Data.IORef
35import Data.IORef
34import qualified Data.Text.Encoding as T
36import qualified Data.Text.Encoding as T
@@ -59,7 +61,7 @@ data Output = Output
59 terminalID :: String
61 terminalID :: String
60 -- | Release the terminal just prior to application exit and reset
62 -- | Release the terminal just prior to application exit and reset
61 -- it to its state prior to application startup.
63 -- it to its state prior to application startup.
62− , releaseTerminal :: IO ()
64+ , releaseTerminal :: forall m. MonadIO m => m ()
63 -- | Clear the display and initialize the terminal to some initial
65 -- | Clear the display and initialize the terminal to some initial
64 -- display state.
66 -- display state.
65 --
67 --
@@ -69,57 +71,40 @@ data Output = Output
69 -- - cursor at top left
71 -- - cursor at top left
70 -- - UTF-8 character encoding
72 -- - UTF-8 character encoding
71 -- - drawing characteristics are the default
73 -- - drawing characteristics are the default
72− , reserveDisplay :: IO ()
74+ , reserveDisplay :: forall m. MonadIO m => m ()
73 -- | Return the display to the state before `reserveDisplay` If no
75 -- | Return the display to the state before `reserveDisplay` If no
74 -- previous state then set the display state to the initial state.
76 -- previous state then set the display state to the initial state.
75− , releaseDisplay :: IO ()
77+ , releaseDisplay :: forall m. MonadIO m => m ()
76− -- | Sets the current display bounds (width, height).
77− , setDisplayBounds :: (Int, Int) -> IO ()
78 -- | Returns the current display bounds.
78 -- | Returns the current display bounds.
79− , displayBounds :: IO DisplayRegion
79+ , displayBounds :: forall m. MonadIO m => m DisplayRegion
80 -- | Output the bytestring to the terminal device.
80 -- | Output the bytestring to the terminal device.
81 , outputByteBuffer :: BS.ByteString -> IO ()
81 , outputByteBuffer :: BS.ByteString -> IO ()
82+ -- | Specifies the maximum number of colors supported by the
83+ -- context.
84+ , contextColorCount :: Int
82 -- | Specifies whether the cursor can be shown / hidden.
85 -- | Specifies whether the cursor can be shown / hidden.
83 , supportsCursorVisibility :: Bool
86 , supportsCursorVisibility :: Bool
84 -- | Indicates support for terminal modes for this output device.
87 -- | Indicates support for terminal modes for this output device.
85 , supportsMode :: Mode -> Bool
88 , supportsMode :: Mode -> Bool
86 -- | Enables or disables a mode (does nothing if the mode is
89 -- | Enables or disables a mode (does nothing if the mode is
87 -- unsupported).
90 -- unsupported).
88− , setMode :: Mode -> Bool -> IO ()
91+ , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()
89 -- | Returns whether a mode is enabled.
92 -- | Returns whether a mode is enabled.
90− , getModeStatus :: Mode -> IO Bool
93+ , getModeStatus :: forall m. MonadIO m => Mode -> m Bool
91 , assumedStateRef :: IORef AssumedState
94 , assumedStateRef :: IORef AssumedState
92 -- | Acquire display access to the given region of the display.
95 -- | Acquire display access to the given region of the display.
93 -- Currently all regions have the upper left corner of (0,0) and
96 -- Currently all regions have the upper left corner of (0,0) and
94 -- the lower right corner at (max displayWidth providedWidth, max
97 -- the lower right corner at (max displayWidth providedWidth, max
95 -- displayHeight providedHeight)
98 -- displayHeight providedHeight)
96− , mkDisplayContext :: Output -> DisplayRegion -> IO DisplayContext
99+ , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext
97 -- | Ring the terminal bell if supported.
100 -- | Ring the terminal bell if supported.
98− , ringTerminalBell :: IO ()
101+ , ringTerminalBell :: forall m. MonadIO m => m ()
99 -- | Returns whether the terminal has an audio bell feature.
102 -- | Returns whether the terminal has an audio bell feature.
100− , supportsBell :: IO Bool
103+ , supportsBell :: forall m. MonadIO m => m Bool
101− -- | Returns whether the terminal supports italicized text.
102− --
103− -- This is terminal-dependent and should make a best effort to
104− -- determine whether this feature is supported, but even if the
105− -- terminal advertises support (e.g. via terminfo) that might not
106− -- be a reliable indicator of whether the feature will work as
107− -- desired.
108− , supportsItalics :: IO Bool
109− -- | Returns whether the terminal supports strikethrough text.
110− --
111− -- This is terminal-dependent and should make a best effort to
112− -- determine whether this feature is supported, but even if the
113− -- terminal advertises support (e.g. via terminfo) that might not
114− -- be a reliable indicator of whether the feature will work as
115− -- desired.
116− , supportsStrikethrough :: IO Bool
117− -- | Returns how many colors the terminal supports.
118− , outputColorMode :: ColorMode
119 }
104 }
120
105
121−displayContext :: Output -> DisplayRegion -> IO DisplayContext
106+displayContext :: MonadIO m => Output -> DisplayRegion -> m DisplayContext
122−displayContext t = mkDisplayContext t t
107+displayContext t = liftIO . mkDisplayContext t t
123
108
124data AssumedState = AssumedState
109data AssumedState = AssumedState
125 { prevFattr :: Maybe FixedAttr
110 { prevFattr :: Maybe FixedAttr
@@ -178,8 +163,8 @@ writeUtf8Text = writeByteString
178-- 4. Serialized to the display.
163-- 4. Serialized to the display.
179--
164--
180-- 5. The cursor is then shown and positioned or kept hidden.
165-- 5. The cursor is then shown and positioned or kept hidden.
181−outputPicture :: DisplayContext -> Picture -> IO ()
166+outputPicture :: MonadIO m => DisplayContext -> Picture -> m ()
182−outputPicture dc pic = do
167+outputPicture dc pic = liftIO $ do
183 urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink
168 urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink
184 as <- readIORef (assumedStateRef $ contextDevice dc)
169 as <- readIORef (assumedStateRef $ contextDevice dc)
185 let manipCursor = supportsCursorVisibility (contextDevice dc)
170 let manipCursor = supportsCursorVisibility (contextDevice dc)
@@ -192,7 +177,8 @@ outputPicture dc pic = do
192 Nothing -> replicate (fromEnum $ regionHeight $ affectedRegion ops) True
177 Nothing -> replicate (fromEnum $ regionHeight $ affectedRegion ops) True
193 Just previousOps -> if affectedRegion previousOps /= affectedRegion ops
178 Just previousOps -> if affectedRegion previousOps /= affectedRegion ops
194 then replicate (displayOpsRows ops) True
179 then replicate (displayOpsRows ops) True
195− else Vector.toList $ Vector.zipWith (/=) previousOps ops
180+ else zipWith (/=) (Vector.toList previousOps)
181+ (Vector.toList ops)
196 -- build the Write corresponding to the output image
182 -- build the Write corresponding to the output image
197 out = (if manipCursor then writeHideCursor dc else mempty)
183 out = (if manipCursor then writeHideCursor dc else mempty)
198 `mappend` writeOutputOps urlsEnabled dc initialAttr diffs ops
184 `mappend` writeOutputOps urlsEnabled dc initialAttr diffs ops
@@ -206,12 +192,6 @@ outputPicture dc pic = do
206 AbsoluteCursor x y ->
192 AbsoluteCursor x y ->
207 writeShowCursor dc `mappend`
193 writeShowCursor dc `mappend`
208 writeMoveCursor dc (clampX x) (clampY y)
194 writeMoveCursor dc (clampX x) (clampY y)
209− PositionOnly isAbs x y ->
210− if isAbs
211− then writeMoveCursor dc (clampX x) (clampY y)
212− else let (ox, oy) = charToOutputPos m (clampX x, clampY y)
213− m = cursorOutputMap ops $ picCursor pic
214− in writeMoveCursor dc (clampX ox) (clampY oy)
215 Cursor x y ->
195 Cursor x y ->
216 let m = cursorOutputMap ops $ picCursor pic
196 let m = cursorOutputMap ops $ picCursor pic
217 (ox, oy) = charToOutputPos m (clampX x, clampY y)
197 (ox, oy) = charToOutputPos m (clampX x, clampY y)
@@ -309,23 +289,17 @@ limitAttrForDisplay t attr
309 where
289 where
310 clampColor Default = Default
290 clampColor Default = Default
311 clampColor KeepCurrent = KeepCurrent
291 clampColor KeepCurrent = KeepCurrent
312− clampColor (SetTo c) = clampColor' (outputColorMode t) c
292+ clampColor (SetTo c) = clampColor' c
313−
314− clampColor' NoColor _ = Default
293+ clampColor' (ISOColor v)
315−
294+ | contextColorCount t < 8 = Default
316− clampColor' ColorMode8 (ISOColor v)
317− | v >= 8 = SetTo $ ISOColor (v - 8)
295+ | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8)
318− | otherwise = SetTo $ ISOColor v
296+ | otherwise = SetTo $ ISOColor v
319− clampColor' ColorMode8 _ = Default
297+ clampColor' (Color240 v)
320−
298+ -- Should we choose closest ISO color?
321− clampColor' ColorMode16 c@(ISOColor _) = SetTo c
299+ | contextColorCount t < 8 = Default
322− clampColor' ColorMode16 _ = Default
300+ | contextColorCount t < 16 = Default
323−
301+ | contextColorCount t <= 256 = SetTo $ Color240 v
324− clampColor' (ColorMode240 _) c@(ISOColor _) = SetTo c
325− clampColor' (ColorMode240 colorCount) c@(Color240 n)
326− | n <= colorCount = SetTo c
327− | otherwise = Default
302+ | otherwise
328− clampColor' colorMode@(ColorMode240 _) (RGBColor r g b) =
303+ = let p :: Double = fromIntegral v / 240.0
329− clampColor' colorMode (color240 r g b)
304+ v' = floor $ p * (fromIntegral $ contextColorCount t)
330−
305+ in SetTo $ Color240 v'
331− clampColor' FullColor c = SetTo c
src/Graphics/Vty/Output/Mock.hs+2−6
@@ -11,7 +11,6 @@ module Graphics.Vty.Output.Mock
11where
11where
12
12
13import Graphics.Vty.Image (DisplayRegion)
13import Graphics.Vty.Image (DisplayRegion)
14−import Graphics.Vty.Attributes.Color (ColorMode(ColorMode16))
15import Graphics.Vty.Output.Interface
14import Graphics.Vty.Output.Interface
16
15
17import Blaze.ByteString.Builder.Word (writeWord8)
16import Blaze.ByteString.Builder.Word (writeWord8)
@@ -31,7 +30,7 @@ type MockData = IORef (UTF8.UTF8 BS.ByteString)
31-- without considering terminal specific issues.
30-- without considering terminal specific issues.
32--
31--
33-- The mock implementation is useful in manually determining if the
32-- The mock implementation is useful in manually determining if the
34−-- sequence of terminal operations matches the expected sequence. The
33+-- sequence of terminal operations matche the expected sequence. The
35-- requirement of the produced representation is simplicity in parsing
34-- requirement of the produced representation is simplicity in parsing
36-- the text representation and determining how the picture was mapped to
35-- the text representation and determining how the picture was mapped to
37-- terminal operations.
36-- terminal operations.
@@ -49,19 +48,16 @@ mockTerminal r = liftIO $ do
49 , releaseDisplay = return ()
48 , releaseDisplay = return ()
50 , ringTerminalBell = return ()
49 , ringTerminalBell = return ()
51 , supportsBell = return False
50 , supportsBell = return False
52− , supportsItalics = return False
53− , supportsStrikethrough = return False
54− , setDisplayBounds = const $ return ()
55 , displayBounds = return r
51 , displayBounds = return r
56 , outputByteBuffer = \bytes -> do
52 , outputByteBuffer = \bytes -> do
57 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"
53 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"
58 writeIORef outRef $ UTF8.fromRep bytes
54 writeIORef outRef $ UTF8.fromRep bytes
55+ , contextColorCount = 16
59 , supportsCursorVisibility = True
56 , supportsCursorVisibility = True
60 , supportsMode = const False
57 , supportsMode = const False
61 , setMode = const $ const $ return ()
58 , setMode = const $ const $ return ()
62 , getModeStatus = const $ return False
59 , getModeStatus = const $ return False
63 , assumedStateRef = newAssumedStateRef
60 , assumedStateRef = newAssumedStateRef
64− , outputColorMode = ColorMode16
65 , mkDisplayContext = \tActual rActual -> return $ DisplayContext
61 , mkDisplayContext = \tActual rActual -> return $ DisplayContext
66 { contextRegion = rActual
62 { contextRegion = rActual
67 , contextDevice = tActual
63 , contextDevice = tActual
src/Graphics/Vty/Output/TerminfoBased.hs+59−147
@@ -1,6 +1,6 @@
1+{-# LANGUAGE RecordWildCards #-}
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE CPP #-}
4{-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-}
4{-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-}
5{-# CFILES gwinsz.c #-}
5{-# CFILES gwinsz.c #-}
6
6
@@ -9,12 +9,10 @@
9-- Copyright Corey O'Connor (coreyoconnor@gmail.com)
9-- Copyright Corey O'Connor (coreyoconnor@gmail.com)
10module Graphics.Vty.Output.TerminfoBased
10module Graphics.Vty.Output.TerminfoBased
11 ( reserveTerminal
11 ( reserveTerminal
12− , setWindowSize
13 )
12 )
14where
13where
15
14
16import Control.Monad (when)
15import Control.Monad (when)
17−import Data.Bits (shiftL, (.&.))
18import qualified Data.ByteString as BS
16import qualified Data.ByteString as BS
19import Data.ByteString.Internal (toForeignPtr)
17import Data.ByteString.Internal (toForeignPtr)
20import Data.Terminfo.Parse
18import Data.Terminfo.Parse
@@ -25,16 +23,16 @@ import Graphics.Vty.Image (DisplayRegion)
25import Graphics.Vty.DisplayAttributes
23import Graphics.Vty.DisplayAttributes
26import Graphics.Vty.Output.Interface
24import Graphics.Vty.Output.Interface
27
25
28−import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable, writeWord8)
26+import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable)
29
27
28+import Control.Monad.Trans
29+
30+import Data.Bits ((.&.))
31+import Data.Foldable (foldMap)
30import Data.IORef
32import Data.IORef
31import Data.Maybe (isJust, isNothing, fromJust)
33import Data.Maybe (isJust, isNothing, fromJust)
32import Data.Word
34import Data.Word
33
35
34−#if !MIN_VERSION_base(4,8,0)
35−import Data.Foldable (foldMap)
36−#endif
37−
38import Foreign.C.Types ( CInt(..), CLong(..) )
36import Foreign.C.Types ( CInt(..), CLong(..) )
39import Foreign.ForeignPtr (withForeignPtr)
37import Foreign.ForeignPtr (withForeignPtr)
40import Foreign.Ptr (Ptr, plusPtr)
38import Foreign.Ptr (Ptr, plusPtr)
@@ -49,6 +47,7 @@ data TerminfoCaps = TerminfoCaps
49 , cup :: CapExpression
47 , cup :: CapExpression
50 , cnorm :: Maybe CapExpression
48 , cnorm :: Maybe CapExpression
51 , civis :: Maybe CapExpression
49 , civis :: Maybe CapExpression
50+ , supportsNoColors :: Bool
52 , useAltColorMap :: Bool
51 , useAltColorMap :: Bool
53 , setForeColor :: CapExpression
52 , setForeColor :: CapExpression
54 , setBackColor :: CapExpression
53 , setBackColor :: CapExpression
@@ -63,10 +62,6 @@ data DisplayAttrCaps = DisplayAttrCaps
63 { setAttrStates :: Maybe CapExpression
62 { setAttrStates :: Maybe CapExpression
64 , enterStandout :: Maybe CapExpression
63 , enterStandout :: Maybe CapExpression
65 , exitStandout :: Maybe CapExpression
64 , exitStandout :: Maybe CapExpression
66− , enterItalic :: Maybe CapExpression
67− , exitItalic :: Maybe CapExpression
68− , enterStrikethrough :: Maybe CapExpression
69− , exitStrikethrough :: Maybe CapExpression
70 , enterUnderline :: Maybe CapExpression
65 , enterUnderline :: Maybe CapExpression
71 , exitUnderline :: Maybe CapExpression
66 , exitUnderline :: Maybe CapExpression
72 , enterReverseVideo :: Maybe CapExpression
67 , enterReverseVideo :: Maybe CapExpression
@@ -103,28 +98,28 @@ sendCapToTerminal t cap capParams = do
103--
98--
104-- * Providing independent string capabilities for all display
99-- * Providing independent string capabilities for all display
105-- attributes.
100-- attributes.
106−reserveTerminal :: String -> Fd -> ColorMode -> IO Output
101+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output
107−reserveTerminal termName outFd colorMode = do
102+reserveTerminal termName outFd = liftIO $ do
108 ti <- Terminfo.setupTerm termName
103 ti <- Terminfo.setupTerm termName
109 -- assumes set foreground always implies set background exists.
104 -- assumes set foreground always implies set background exists.
110 -- if set foreground is not set then all color changing style
105 -- if set foreground is not set then all color changing style
111 -- attributes are filtered.
106 -- attributes are filtered.
112 msetaf <- probeCap ti "setaf"
107 msetaf <- probeCap ti "setaf"
113 msetf <- probeCap ti "setf"
108 msetf <- probeCap ti "setf"
114− let (useAlt, setForeCap)
109+ let (noColors, useAlt, setForeCap)
115 = case msetaf of
110 = case msetaf of
116− Just setaf -> (False, setaf)
111+ Just setaf -> (False, False, setaf)
117 Nothing -> case msetf of
112 Nothing -> case msetf of
118− Just setf -> (True, setf)
113+ Just setf -> (False, True, setf)
119− Nothing -> (True, error $ "no fore color support for terminal " ++ termName)
114+ Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName)
120 msetab <- probeCap ti "setab"
115 msetab <- probeCap ti "setab"
121 msetb <- probeCap ti "setb"
116 msetb <- probeCap ti "setb"
122− let setBackCap
117+ let set_back_cap
123 = case msetab of
118 = case msetab of
124− Just setab -> setab
125 Nothing -> case msetb of
119 Nothing -> case msetb of
126 Just setb -> setb
120 Just setb -> setb
127 Nothing -> error $ "no back color support for terminal " ++ termName
121 Nothing -> error $ "no back color support for terminal " ++ termName
122+ Just setab -> setab
128
123
129 hyperlinkModeStatus <- newIORef False
124 hyperlinkModeStatus <- newIORef False
130 newAssumedStateRef <- newIORef initialAssumedState
125 newAssumedStateRef <- newIORef initialAssumedState
@@ -133,13 +128,13 @@ reserveTerminal termName outFd colorMode = do
133 curStatus <- terminfoModeStatus m
128 curStatus <- terminfoModeStatus m
134 when (newStatus /= curStatus) $
129 when (newStatus /= curStatus) $
135 case m of
130 case m of
136− Hyperlink -> do
131+ Hyperlink -> liftIO $ do
137 writeIORef hyperlinkModeStatus newStatus
132 writeIORef hyperlinkModeStatus newStatus
138 writeIORef newAssumedStateRef initialAssumedState
133 writeIORef newAssumedStateRef initialAssumedState
139 _ -> return ()
134 _ -> return ()
140 terminfoModeStatus m =
135 terminfoModeStatus m =
141 case m of
136 case m of
142− Hyperlink -> readIORef hyperlinkModeStatus
137+ Hyperlink -> liftIO $ readIORef hyperlinkModeStatus
143 _ -> return False
138 _ -> return False
144 terminfoModeSupported Hyperlink = True
139 terminfoModeSupported Hyperlink = True
145 terminfoModeSupported _ = False
140 terminfoModeSupported _ = False
@@ -150,9 +145,10 @@ reserveTerminal termName outFd colorMode = do
150 <*> requireCap ti "cup"
145 <*> requireCap ti "cup"
151 <*> probeCap ti "cnorm"
146 <*> probeCap ti "cnorm"
152 <*> probeCap ti "civis"
147 <*> probeCap ti "civis"
148+ <*> pure noColors
153 <*> pure useAlt
149 <*> pure useAlt
154 <*> pure setForeCap
150 <*> pure setForeCap
155− <*> pure setBackCap
151+ <*> pure set_back_cap
156 <*> requireCap ti "sgr0"
152 <*> requireCap ti "sgr0"
157 <*> requireCap ti "clear"
153 <*> requireCap ti "clear"
158 <*> requireCap ti "el"
154 <*> requireCap ti "el"
@@ -160,28 +156,22 @@ reserveTerminal termName outFd colorMode = do
160 <*> probeCap ti "bel"
156 <*> probeCap ti "bel"
161 let t = Output
157 let t = Output
162 { terminalID = termName
158 { terminalID = termName
163− , releaseTerminal = do
159+ , releaseTerminal = liftIO $ do
164 sendCap setDefaultAttr []
160 sendCap setDefaultAttr []
165 maybeSendCap cnorm []
161 maybeSendCap cnorm []
166 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps
162 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps
167− , supportsItalics = return $ (isJust $ enterItalic (displayAttrCaps terminfoCaps)) &&
168− (isJust $ exitItalic (displayAttrCaps terminfoCaps))
169− , supportsStrikethrough = return $ (isJust $ enterStrikethrough (displayAttrCaps terminfoCaps)) &&
170− (isJust $ exitStrikethrough (displayAttrCaps terminfoCaps))
171− , ringTerminalBell = maybeSendCap ringBellAudio []
163+ , ringTerminalBell = liftIO $ maybeSendCap ringBellAudio []
172− , reserveDisplay = do
164+ , reserveDisplay = liftIO $ do
173 -- If there is no support for smcup: Clear the screen
165 -- If there is no support for smcup: Clear the screen
174 -- and then move the mouse to the home position to
166 -- and then move the mouse to the home position to
175 -- approximate the behavior.
167 -- approximate the behavior.
176 maybeSendCap smcup []
168 maybeSendCap smcup []
177 sendCap clearScreen []
169 sendCap clearScreen []
178− , releaseDisplay = do
170+ , releaseDisplay = liftIO $ do
179 maybeSendCap rmcup []
171 maybeSendCap rmcup []
180 maybeSendCap cnorm []
172 maybeSendCap cnorm []
181− , setDisplayBounds = \(w, h) ->
182− setWindowSize outFd (w, h)
183 , displayBounds = do
173 , displayBounds = do
184− rawSize <- getWindowSize outFd
174+ rawSize <- liftIO $ getWindowSize outFd
185 case rawSize of
175 case rawSize of
186 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize
176 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize
187 | otherwise -> return (w,h)
177 | otherwise -> return (w,h)
@@ -192,48 +182,51 @@ reserveTerminal termName outFd colorMode = do
192 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "
182 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "
193 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen
183 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen
194 ++ " Please report this bug to vty project."
184 ++ " Please report this bug to vty project."
185+ , contextColorCount
186+ = case supportsNoColors terminfoCaps of
187+ False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of
188+ Nothing -> 8
189+ Just v -> toEnum v
190+ True -> 1
195 , supportsCursorVisibility = isJust $ civis terminfoCaps
191 , supportsCursorVisibility = isJust $ civis terminfoCaps
196 , supportsMode = terminfoModeSupported
192 , supportsMode = terminfoModeSupported
197 , setMode = terminfoSetMode
193 , setMode = terminfoSetMode
198 , getModeStatus = terminfoModeStatus
194 , getModeStatus = terminfoModeStatus
199 , assumedStateRef = newAssumedStateRef
195 , assumedStateRef = newAssumedStateRef
200− , outputColorMode = colorMode
201 -- I think fix would help assure tActual is the only
196 -- I think fix would help assure tActual is the only
202 -- reference. I was having issues tho.
197 -- reference. I was having issues tho.
203− , mkDisplayContext = (`terminfoDisplayContext` terminfoCaps)
198+ , mkDisplayContext = \tActual -> liftIO . terminfoDisplayContext tActual terminfoCaps
204 }
199 }
205 sendCap s = sendCapToTerminal t (s terminfoCaps)
200 sendCap s = sendCapToTerminal t (s terminfoCaps)
206 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)
201 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)
207 return t
202 return t
208
203
209−requireCap :: Terminfo.Terminal -> String -> IO CapExpression
204+requireCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m CapExpression
210requireCap ti capName
205requireCap ti capName
211 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of
206 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of
212 Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""
207 Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""
213 Just capStr -> parseCap capStr
208 Just capStr -> parseCap capStr
214
209
215−probeCap :: Terminfo.Terminal -> String -> IO (Maybe CapExpression)
210+probeCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m (Maybe CapExpression)
216probeCap ti capName
211probeCap ti capName
217 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of
212 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of
218 Nothing -> return Nothing
213 Nothing -> return Nothing
219 Just capStr -> Just <$> parseCap capStr
214 Just capStr -> Just <$> parseCap capStr
220
215
221−parseCap :: String -> IO CapExpression
216+parseCap :: (Applicative m, MonadIO m) => String -> m CapExpression
222parseCap capStr = do
217parseCap capStr = do
223 case parseCapExpression capStr of
218 case parseCapExpression capStr of
224 Left e -> fail $ show e
219 Left e -> fail $ show e
225 Right cap -> return cap
220 Right cap -> return cap
226
221
227−currentDisplayAttrCaps :: Terminfo.Terminal -> IO DisplayAttrCaps
222+currentDisplayAttrCaps :: ( Applicative m, MonadIO m )
223+ => Terminfo.Terminal
224+ -> m DisplayAttrCaps
228currentDisplayAttrCaps ti
225currentDisplayAttrCaps ti
229 = pure DisplayAttrCaps
226 = pure DisplayAttrCaps
230 <*> probeCap ti "sgr"
227 <*> probeCap ti "sgr"
231 <*> probeCap ti "smso"
228 <*> probeCap ti "smso"
232 <*> probeCap ti "rmso"
229 <*> probeCap ti "rmso"
233− <*> probeCap ti "sitm"
234− <*> probeCap ti "ritm"
235− <*> probeCap ti "smxx"
236− <*> probeCap ti "rmxx"
237 <*> probeCap ti "smul"
230 <*> probeCap ti "smul"
238 <*> probeCap ti "rmul"
231 <*> probeCap ti "rmul"
239 <*> probeCap ti "rev"
232 <*> probeCap ti "rev"
@@ -247,13 +240,6 @@ getWindowSize fd = do
247 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd
240 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd
248 return (fromIntegral b, fromIntegral a)
241 return (fromIntegral b, fromIntegral a)
249
242
250−foreign import ccall "gwinsz.h vty_c_set_window_size" c_setWindowSize :: Fd -> CLong -> IO ()
251−
252−setWindowSize :: Fd -> (Int, Int) -> IO ()
253−setWindowSize fd (w, h) = do
254− let val = (h `shiftL` 16) + w
255− c_setWindowSize fd $ fromIntegral val
256−
257terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext
243terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext
258terminfoDisplayContext tActual terminfoCaps r = return dc
244terminfoDisplayContext tActual terminfoCaps r = return dc
259 where dc = DisplayContext
245 where dc = DisplayContext
@@ -269,11 +255,7 @@ terminfoDisplayContext tActual terminfoCaps r = return dc
269 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps
255 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps
270 , writeDefaultAttr = \urlsEnabled ->
256 , writeDefaultAttr = \urlsEnabled ->
271 writeCapExpr (setDefaultAttr terminfoCaps) [] `mappend`
257 writeCapExpr (setDefaultAttr terminfoCaps) [] `mappend`
272− (if urlsEnabled then writeURLEscapes EndLink else mempty) `mappend`
258+ (if urlsEnabled then writeURLEscapes EndLink else mempty)
273− (case exitStrikethrough $ displayAttrCaps terminfoCaps of
274− Just cap -> writeCapExpr cap []
275− Nothing -> mempty
276− )
277 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []
259 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []
278 , inlineHack = return ()
260 , inlineHack = return ()
279 }
261 }
@@ -295,7 +277,7 @@ writeURLEscapes NoLinkChange =
295-- | Portably setting the display attributes is a giant pain in the ass.
277-- | Portably setting the display attributes is a giant pain in the ass.
296--
278--
297-- If the terminal supports the sgr capability (which sets the on/off
279-- If the terminal supports the sgr capability (which sets the on/off
298−-- state of each style directly; and, for no good reason, resets the
280+-- state of each style directly ; and, for no good reason, resets the
299-- colors to the default) this procedure is used:
281-- colors to the default) this procedure is used:
300--
282--
301-- 0. set the style attributes. This resets the fore and back color.
283-- 0. set the style attributes. This resets the fore and back color.
@@ -329,14 +311,14 @@ writeURLEscapes NoLinkChange =
329-- Note that this optimizes for fewer state changes followed by fewer
311-- Note that this optimizes for fewer state changes followed by fewer
330-- bytes.
312-- bytes.
331terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write
313terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write
332−terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
314+terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs = do
333 urlAttrs urlsEnabled `mappend` case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of
315 urlAttrs urlsEnabled `mappend` case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of
334 -- The only way to reset either color, portably, to the default
316 -- The only way to reset either color, portably, to the default
335 -- is to use either the set state capability or the set default
317 -- is to use either the set state capability or the set default
336 -- capability.
318 -- capability.
337− True -> do
319+ True -> do
338 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)
320 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)
339− (fixedStyle attr)
321+ (fixedStyle attr )
340 (styleToApplySeq $ fixedStyle attr) of
322 (styleToApplySeq $ fixedStyle attr) of
341 -- only way to reset a color to the defaults
323 -- only way to reset a color to the defaults
342 EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled
324 EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled
@@ -346,12 +328,12 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
346 setColors
328 setColors
347 -- implicitly resets the colors to the defaults
329 -- implicitly resets the colors to the defaults
348 SetState state -> writeCapExpr (fromJust $ setAttrStates
330 SetState state -> writeCapExpr (fromJust $ setAttrStates
349− $ displayAttrCaps terminfoCaps
331+ $ displayAttrCaps
332+ $ terminfoCaps
350 )
333 )
351 (sgrArgsForState state)
334 (sgrArgsForState state)
352− `mappend` setItalics
335+ `mappend`
353− `mappend` setStrikethrough
354− `mappend` setColors
336+ setColors
355 -- Otherwise the display colors are not changing or changing
337 -- Otherwise the display colors are not changing or changing
356 -- between two non-default points.
338 -- between two non-default points.
357 False -> do
339 False -> do
@@ -369,16 +351,14 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
369 -- applied states.
351 -- applied states.
370 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps
352 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps
371 `mappend`
353 `mappend`
372− writeColorDiff Foreground (foreColorDiff diffs)
354+ writeColorDiff setForeColor (foreColorDiff diffs)
373 `mappend`
355 `mappend`
374− writeColorDiff Background (backColorDiff diffs)
356+ writeColorDiff setBackColor (backColorDiff diffs)
375 -- implicitly resets the colors to the defaults
357 -- implicitly resets the colors to the defaults
376 SetState state -> writeCapExpr (fromJust $ setAttrStates
358 SetState state -> writeCapExpr (fromJust $ setAttrStates
377 $ displayAttrCaps terminfoCaps
359 $ displayAttrCaps terminfoCaps
378 )
360 )
379 (sgrArgsForState state)
361 (sgrArgsForState state)
380− `mappend` setItalics
381− `mappend` setStrikethrough
382 `mappend` setColors
362 `mappend` setColors
383 where
363 where
384 urlAttrs True = writeURLEscapes (urlDiff diffs)
364 urlAttrs True = writeURLEscapes (urlDiff diffs)
@@ -387,81 +367,31 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
387 False -> ansiColorIndex
367 False -> ansiColorIndex
388 True -> altColorIndex
368 True -> altColorIndex
389 attr = fixDisplayAttr prevAttr reqAttr
369 attr = fixDisplayAttr prevAttr reqAttr
390−
391− -- italics can't be set via SGR, so here we manually
392− -- apply the enter and exit sequences as needed after
393− -- changing the SGR
394− setItalics
395− | hasStyle (fixedStyle attr) italic
396− , Just sitm <- enterItalic (displayAttrCaps terminfoCaps)
397− = writeCapExpr sitm []
398− | otherwise = mempty
399− setStrikethrough
400− | hasStyle (fixedStyle attr) strikethrough
401− , Just smxx <- enterStrikethrough (displayAttrCaps terminfoCaps)
402− = writeCapExpr smxx []
403− | otherwise = mempty
404 setColors =
370 setColors =
405 (case fixedForeColor attr of
371 (case fixedForeColor attr of
406− Just c -> writeColor Foreground c
372+ Just c -> writeCapExpr (setForeColor terminfoCaps)
373+ [toEnum $ colorMap c]
407 Nothing -> mempty)
374 Nothing -> mempty)
408 `mappend`
375 `mappend`
409 (case fixedBackColor attr of
376 (case fixedBackColor attr of
410− Just c -> writeColor Background c
377+ Just c -> writeCapExpr (setBackColor terminfoCaps)
378+ [toEnum $ colorMap c]
411 Nothing -> mempty)
379 Nothing -> mempty)
412− writeColorDiff _side NoColorChange
380+ writeColorDiff _f NoColorChange
413 = mempty
381 = mempty
414− writeColorDiff _side ColorToDefault
382+ writeColorDiff _f ColorToDefault
415 = error "ColorToDefault is not a possible case for applyColorDiffs"
383 = error "ColorToDefault is not a possible case for applyColorDiffs"
416− writeColorDiff side (SetColor c)
384+ writeColorDiff f (SetColor c)
417− = writeColor side c
418−
419− writeColor side (RGBColor r g b) =
420− case outputColorMode (contextDevice dc) of
421− FullColor ->
422− hardcodeColor side (r, g, b)
423− _ ->
424− error "clampColor should remove rgb colors in standard mode"
425− writeColor side c =
426− writeCapExpr (setSideColor side terminfoCaps) [toEnum $ colorMap c]
385+ = writeCapExpr (f terminfoCaps) [toEnum $ colorMap c]
427−
428−-- a color can either be in the foreground or the background
429−data ColorSide = Foreground | Background
430−
431−-- get the capability for drawing a color on a specific side
432−setSideColor :: ColorSide -> TerminfoCaps -> CapExpression
433−setSideColor Foreground = setForeColor
434−setSideColor Background = setBackColor
435−
436−hardcodeColor :: ColorSide -> (Word8, Word8, Word8) -> Write
437−hardcodeColor side (r, g, b) =
438− -- hardcoded color codes are formatted as "\x1b[{side};2;{r};{g};{b}m"
439− mconcat [ writeStr "\x1b[", sideCode, delimiter, writeChar '2', delimiter
440− , writeColor r, delimiter, writeColor g, delimiter, writeColor b
441− , writeChar 'm']
442− where
443− writeChar = writeWord8 . fromIntegral . fromEnum
444− writeStr = mconcat . map writeChar
445− writeColor = writeStr . show
446− delimiter = writeChar ';'
447− -- 38/48 are used to set whether we should write to the
448− -- foreground/background. I really don't want to know why.
449− sideCode = case side of
450− Foreground -> writeStr "38"
451− Background -> writeStr "48"
452
386
453-- | The color table used by a terminal is a 16 color set followed by a
387-- | The color table used by a terminal is a 16 color set followed by a
454-- 240 color set that might not be supported by the terminal.
388-- 240 color set that might not be supported by the terminal.
455--
389--
456−-- This takes a Color which clearly identifies which palette to use and
390+-- This takes a Color which clearly identifies which pallete to use and
457−-- computes the index into the full 256 color palette.
391+-- computes the index into the full 256 color pallete.
458ansiColorIndex :: Color -> Int
392ansiColorIndex :: Color -> Int
459ansiColorIndex (ISOColor v) = fromEnum v
393ansiColorIndex (ISOColor v) = fromEnum v
460ansiColorIndex (Color240 v) = 16 + fromEnum v
394ansiColorIndex (Color240 v) = 16 + fromEnum v
461−ansiColorIndex (RGBColor _ _ _) =
462− error $ unlines [ "Attempted to create color index from rgb color."
463− , "This is currently unsupported, and shouldn't ever happen"
464− ]
465
395
466-- | For terminals without setaf/setab
396-- | For terminals without setaf/setab
467--
397--
@@ -478,10 +408,6 @@ altColorIndex (ISOColor 6) = 3
478altColorIndex (ISOColor 7) = 7
408altColorIndex (ISOColor 7) = 7
479altColorIndex (ISOColor v) = fromEnum v
409altColorIndex (ISOColor v) = fromEnum v
480altColorIndex (Color240 v) = 16 + fromEnum v
410altColorIndex (Color240 v) = 16 + fromEnum v
481−altColorIndex (RGBColor _ _ _) =
482− error $ unlines [ "Attempted to create color index from rgb color."
483− , "This is currently unsupported, and shouldn't ever happen"
484− ]
485
411
486{- | The sequence of terminfo caps to apply a given style are determined
412{- | The sequence of terminfo caps to apply a given style are determined
487 - according to these rules.
413 - according to these rules.
@@ -508,8 +434,6 @@ data DisplayAttrSeq
508data DisplayAttrState = DisplayAttrState
434data DisplayAttrState = DisplayAttrState
509 { applyStandout :: Bool
435 { applyStandout :: Bool
510 , applyUnderline :: Bool
436 , applyUnderline :: Bool
511− , applyItalic :: Bool
512− , applyStrikethrough :: Bool
513 , applyReverseVideo :: Bool
437 , applyReverseVideo :: Bool
514 , applyBlink :: Bool
438 , applyBlink :: Bool
515 , applyDim :: Bool
439 , applyDim :: Bool
@@ -546,10 +470,6 @@ reqDisplayCapSeqFor caps s diffs
546 -- set state cap then just use the set state cap.
470 -- set state cap then just use the set state cap.
547 ( True, True ) -> SetState $ stateForStyle s
471 ( True, True ) -> SetState $ stateForStyle s
548 where
472 where
549− noEnterExitCap ApplyStrikethrough = isNothing $ enterStrikethrough caps
550− noEnterExitCap RemoveStrikethrough = isNothing $ exitStrikethrough caps
551− noEnterExitCap ApplyItalic = isNothing $ enterItalic caps
552− noEnterExitCap RemoveItalic = isNothing $ exitItalic caps
553 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps
473 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps
554 noEnterExitCap RemoveStandout = isNothing $ exitStandout caps
474 noEnterExitCap RemoveStandout = isNothing $ exitStandout caps
555 noEnterExitCap ApplyUnderline = isNothing $ enterUnderline caps
475 noEnterExitCap ApplyUnderline = isNothing $ enterUnderline caps
@@ -562,10 +482,6 @@ reqDisplayCapSeqFor caps s diffs
562 noEnterExitCap RemoveDim = True
482 noEnterExitCap RemoveDim = True
563 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps
483 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps
564 noEnterExitCap RemoveBold = True
484 noEnterExitCap RemoveBold = True
565− enterExitCap ApplyStrikethrough = fromJust $ enterStrikethrough caps
566− enterExitCap RemoveStrikethrough = fromJust $ exitStrikethrough caps
567− enterExitCap ApplyItalic = fromJust $ enterItalic caps
568− enterExitCap RemoveItalic = fromJust $ exitItalic caps
569 enterExitCap ApplyStandout = fromJust $ enterStandout caps
485 enterExitCap ApplyStandout = fromJust $ enterStandout caps
570 enterExitCap RemoveStandout = fromJust $ exitStandout caps
486 enterExitCap RemoveStandout = fromJust $ exitStandout caps
571 enterExitCap ApplyUnderline = fromJust $ enterUnderline caps
487 enterExitCap ApplyUnderline = fromJust $ enterUnderline caps
@@ -579,8 +495,6 @@ stateForStyle :: Style -> DisplayAttrState
579stateForStyle s = DisplayAttrState
495stateForStyle s = DisplayAttrState
580 { applyStandout = isStyleSet standout
496 { applyStandout = isStyleSet standout
581 , applyUnderline = isStyleSet underline
497 , applyUnderline = isStyleSet underline
582− , applyItalic = isStyleSet italic
583− , applyStrikethrough = isStyleSet strikethrough
584 , applyReverseVideo = isStyleSet reverseVideo
498 , applyReverseVideo = isStyleSet reverseVideo
585 , applyBlink = isStyleSet blink
499 , applyBlink = isStyleSet blink
586 , applyDim = isStyleSet dim
500 , applyDim = isStyleSet dim
@@ -592,12 +506,10 @@ styleToApplySeq :: Style -> [StyleStateChange]
592styleToApplySeq s = concat
506styleToApplySeq s = concat
593 [ applyIfRequired ApplyStandout standout
507 [ applyIfRequired ApplyStandout standout
594 , applyIfRequired ApplyUnderline underline
508 , applyIfRequired ApplyUnderline underline
595− , applyIfRequired ApplyItalic italic
596− , applyIfRequired ApplyStrikethrough strikethrough
597 , applyIfRequired ApplyReverseVideo reverseVideo
509 , applyIfRequired ApplyReverseVideo reverseVideo
598 , applyIfRequired ApplyBlink blink
510 , applyIfRequired ApplyBlink blink
599 , applyIfRequired ApplyDim dim
511 , applyIfRequired ApplyDim dim
600− , applyIfRequired ApplyBold bold
512+ , applyIfRequired ApplyBlink bold
601 ]
513 ]
602 where
514 where
603 applyIfRequired op flag
515 applyIfRequired op flag
src/Graphics/Vty/Output/XTermColor.hs+18−31
@@ -1,4 +1,3 @@
1−{-# Language CPP #-}
2-- Copyright 2009-2010 Corey O'Connor
1-- Copyright 2009-2010 Corey O'Connor
3-- | Xterm output driver. This uses the Terminfo driver with some
2-- | Xterm output driver. This uses the Terminfo driver with some
4-- extensions for Xterm.
3-- extensions for Xterm.
@@ -10,41 +9,26 @@ where
10import Graphics.Vty.Output.Interface
9import Graphics.Vty.Output.Interface
11import Graphics.Vty.Input.Mouse
10import Graphics.Vty.Input.Mouse
12import Graphics.Vty.Input.Focus
11import Graphics.Vty.Input.Focus
13−import Graphics.Vty.Attributes.Color (ColorMode)
14import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased
12import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased
15
13
16import Blaze.ByteString.Builder (writeToByteString)
14import Blaze.ByteString.Builder (writeToByteString)
17import Blaze.ByteString.Builder.Word (writeWord8)
15import Blaze.ByteString.Builder.Word (writeWord8)
18
16
19−import qualified Data.ByteString.Char8 as BS8
20−import Data.ByteString.Char8 (ByteString)
21−import Foreign.Ptr (castPtr)
22−
23import Control.Monad (void, when)
17import Control.Monad (void, when)
24import Control.Monad.Trans
18import Control.Monad.Trans
25−import Data.Char (toLower)
26import Data.IORef
19import Data.IORef
27
20
28−import System.Posix.IO (fdWriteBuf)
21+import System.Posix.IO (fdWrite)
29−import System.Posix.Types (ByteCount, Fd)
22+import System.Posix.Types (Fd)
30import System.Posix.Env (getEnv)
23import System.Posix.Env (getEnv)
31
24
32import Data.List (isInfixOf)
25import Data.List (isInfixOf)
33import Data.Maybe (catMaybes)
26import Data.Maybe (catMaybes)
34−
35−#if !MIN_VERSION_base(4,11,0)
36import Data.Monoid ((<>))
27import Data.Monoid ((<>))
37−#endif
38−
39−-- | Write a 'ByteString' to an 'Fd'.
40−fdWrite :: Fd -> ByteString -> IO ByteCount
41−fdWrite fd s =
42− BS8.useAsCStringLen s $ \(buf,len) -> do
43− fdWriteBuf fd (castPtr buf) (fromIntegral len)
44
28
45-- | Construct an Xterm output driver. Initialize the display to UTF-8.
29-- | Construct an Xterm output driver. Initialize the display to UTF-8.
46−reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> ColorMode -> m Output
30+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output
47−reserveTerminal variant outFd colorMode = liftIO $ do
31+reserveTerminal variant outFd = liftIO $ do
48 let flushedPut = void . fdWrite outFd
32 let flushedPut = void . fdWrite outFd
49 -- If the terminal variant is xterm-color use xterm instead since,
33 -- If the terminal variant is xterm-color use xterm instead since,
50 -- more often than not, xterm-color is broken.
34 -- more often than not, xterm-color is broken.
@@ -52,7 +36,7 @@ reserveTerminal variant outFd colorMode = liftIO $ do
52
36
53 utf8a <- utf8Active
37 utf8a <- utf8Active
54 when (not utf8a) $ flushedPut setUtf8CharSet
38 when (not utf8a) $ flushedPut setUtf8CharSet
55− t <- TerminfoBased.reserveTerminal variant' outFd colorMode
39+ t <- TerminfoBased.reserveTerminal variant' outFd
56
40
57 mouseModeStatus <- newIORef False
41 mouseModeStatus <- newIORef False
58 focusModeStatus <- newIORef False
42 focusModeStatus <- newIORef False
@@ -104,27 +88,30 @@ reserveTerminal variant outFd colorMode = liftIO $ do
104utf8Active :: IO Bool
88utf8Active :: IO Bool
105utf8Active = do
89utf8Active = do
106 let vars = ["LC_ALL", "LANG", "LC_CTYPE"]
90 let vars = ["LC_ALL", "LANG", "LC_CTYPE"]
107− results <- map (toLower <$>) . catMaybes <$> mapM getEnv vars
91+ results <- catMaybes <$> mapM getEnv vars
108− let matches = filter ("utf8" `isInfixOf`) results <>
92+ let matches = filter ("UTF8" `isInfixOf`) results <>
109− filter ("utf-8" `isInfixOf`) results
93+ filter ("UTF-8" `isInfixOf`) results
110 return $ not $ null matches
94 return $ not $ null matches
111
95
112-- | Enable bracketed paste mode:
96-- | Enable bracketed paste mode:
113-- http://cirw.in/blog/bracketed-paste
97-- http://cirw.in/blog/bracketed-paste
114−enableBracketedPastes :: ByteString
98+enableBracketedPastes :: String
115−enableBracketedPastes = BS8.pack "\ESC[?2004h"
99+enableBracketedPastes = "\ESC[?2004h"
116
100
117-- | Disable bracketed paste mode:
101-- | Disable bracketed paste mode:
118−disableBracketedPastes :: ByteString
102+disableBracketedPastes :: String
119−disableBracketedPastes = BS8.pack "\ESC[?2004l"
103+disableBracketedPastes = "\ESC[?2004l"
120
104
121-- | These sequences set xterm based terminals to UTF-8 output.
105-- | These sequences set xterm based terminals to UTF-8 output.
122--
106--
123-- There is no known terminfo capability equivalent to this.
107-- There is no known terminfo capability equivalent to this.
124−setUtf8CharSet, setDefaultCharSet :: ByteString
108+setUtf8CharSet, setDefaultCharSet :: String
125−setUtf8CharSet = BS8.pack "\ESC%G"
109+setUtf8CharSet = "\ESC%G"
126−setDefaultCharSet = BS8.pack "\ESC%@"
110+setDefaultCharSet = "\ESC%@"
127
111
112+-- | I think xterm is broken: Reseting the background color as the first
113+-- bytes serialized on a new line does not effect the background color
114+-- xterm uses to clear the line. Which is used *after* the next newline.
128xtermInlineHack :: Output -> IO ()
115xtermInlineHack :: Output -> IO ()
129xtermInlineHack t = do
116xtermInlineHack t = do
130 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"
117 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"
src/Graphics/Vty/Picture.hs+2−10
@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
1-- A 'Picture' is a background paired with a set of 'Image' layers. The
2-- A 'Picture' is a background paired with a set of 'Image' layers. The
2-- 'Picture' data structure is representative of the final terminal
3-- 'Picture' data structure is representative of the final terminal
3-- view.
4-- view.
@@ -30,7 +31,7 @@ data Picture = Picture
30 , picBackground :: Background
31 , picBackground :: Background
31 -- ^ The picture's background to be displayed in locations with no
32 -- ^ The picture's background to be displayed in locations with no
32 -- Image data.
33 -- Image data.
33− } deriving Eq
34+ }
34
35
35instance Show Picture where
36instance Show Picture where
36 show (Picture _ layers _ ) = "Picture ?? " ++ show layers ++ " ??"
37 show (Picture _ layers _ ) = "Picture ?? " ++ show layers ++ " ??"
@@ -79,14 +80,6 @@ picForLayers is = Picture
79data Cursor =
80data Cursor =
80 -- | Hide the cursor
81 -- | Hide the cursor
81 NoCursor
82 NoCursor
82− -- | Set the terminal's cursor position without displaying a cursor
83− -- character. This is important for accessibility with screen
84− -- readers where a cursor position needs to be reported but we may
85− -- not want to show a block cursor in that location for cosmetic
86− -- reasons. The boolean argument indicates whether the positioning
87− -- should be absolute as with 'AbsoluteCursor' ('True') or logical
88− -- as with 'Cursor' ('False').
89− | PositionOnly !Bool !Int !Int
90 -- | Show the cursor at the given logical column accounting for
83 -- | Show the cursor at the given logical column accounting for
91 -- character width in the presence of multi-column characters.
84 -- character width in the presence of multi-column characters.
92 | Cursor !Int !Int
85 | Cursor !Int !Int
@@ -116,7 +109,6 @@ data Background
116 --
109 --
117 -- * End of line if there are no remaining non-skip ops.
110 -- * End of line if there are no remaining non-skip ops.
118 | ClearBackground
111 | ClearBackground
119− deriving Eq
120
112
121instance NFData Background where
113instance NFData Background where
122 rnf (Background c a) = c `seq` a `seq` ()
114 rnf (Background c a) = c `seq` a `seq` ()
src/Graphics/Vty/PictureToSpans.hs+17−11
@@ -72,7 +72,7 @@ displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r)
72-- | Returns the DisplayOps for an image rendered to a window the size
72-- | Returns the DisplayOps for an image rendered to a window the size
73-- of the image.
73-- of the image.
74--
74--
75−-- largely used only for debugging.
75+-- largerly used only for debugging.
76displayOpsForImage :: Image -> DisplayOps
76displayOpsForImage :: Image -> DisplayOps
77displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeight i)
77displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeight i)
78
78
@@ -81,7 +81,7 @@ combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s)
81combinedOpsForLayers pic r
81combinedOpsForLayers pic r
82 | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0
82 | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0
83 | otherwise = do
83 | otherwise = do
84− layerOps <- mapM (`buildSpans` r) (picLayers pic)
84+ layerOps <- mapM (\layer -> buildSpans layer r) (picLayers pic)
85 case layerOps of
85 case layerOps of
86 [] -> fail "empty picture"
86 [] -> fail "empty picture"
87 [ops] -> substituteSkips (picBackground pic) ops
87 [ops] -> substituteSkips (picBackground pic) ops
@@ -136,8 +136,8 @@ mergeUnder upper lower = do
136 return upper
136 return upper
137
137
138mergeRowUnder :: SpanOps -> SpanOps -> SpanOps
138mergeRowUnder :: SpanOps -> SpanOps -> SpanOps
139−mergeRowUnder upperRowOps =
139+mergeRowUnder upperRowOps lowerRowOps =
140− onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps)
140+ onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) lowerRowOps
141 where
141 where
142 -- H: it will never be the case that we are out of upper ops
142 -- H: it will never be the case that we are out of upper ops
143 -- before lower ops.
143 -- before lower ops.
@@ -298,11 +298,11 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do
298 state <- get
298 state <- get
299 when (state^.remaining <= 0) $ fail $ name ++ " with remaining <= 0"
299 when (state^.remaining <= 0) $ fail $ name ++ " with remaining <= 0"
300 case state^.skip of
300 case state^.skip of
301− s | s > size -> put $ state & skip %~ subtract size
301+ s | s > size -> put $ state & skip -~ size
302 | s == 0 -> if state^.remaining > i0Dim
302 | s == 0 -> if state^.remaining > i0Dim
303 then do
303 then do
304 addMaybeClipped i0
304 addMaybeClipped i0
305− put $ state & offset %~ (+ i0Dim) & remaining %~ subtract i0Dim
305+ put $ state & offset +~ i0Dim & remaining -~ i0Dim
306 addMaybeClipped i1
306 addMaybeClipped i1
307 else addMaybeClipped i0
307 else addMaybeClipped i0
308 | s < i0Dim ->
308 | s < i0Dim ->
@@ -311,10 +311,10 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do
311 then addMaybeClipped i0
311 then addMaybeClipped i0
312 else do
312 else do
313 addMaybeClipped i0
313 addMaybeClipped i0
314− put $ state & offset %~ (+ i0Dim') & remaining %~ subtract i0Dim' & skip .~ 0
314+ put $ state & offset +~ i0Dim' & remaining -~ i0Dim' & skip .~ 0
315 addMaybeClipped i1
315 addMaybeClipped i1
316 | s >= i0Dim -> do
316 | s >= i0Dim -> do
317− put $ state & skip %~ subtract i0Dim
317+ put $ state & skip -~ i0Dim
318 addMaybeClipped i1
318 addMaybeClipped i1
319 _ -> fail $ name ++ " has unhandled skip class"
319 _ -> fail $ name ++ " has unhandled skip class"
320
320
@@ -323,14 +323,14 @@ addUnclippedText a txt = do
323 let op = TextSpan a usedDisplayColumns
323 let op = TextSpan a usedDisplayColumns
324 (fromIntegral $ TL.length txt)
324 (fromIntegral $ TL.length txt)
325 txt
325 txt
326− usedDisplayColumns = wctlwidth txt
326+ usedDisplayColumns = wcswidth $ TL.unpack txt
327 use rowOffset >>= snocOp op
327 use rowOffset >>= snocOp op
328
328
329addRowCompletion :: DisplayRegion -> Int -> BlitM s ()
329addRowCompletion :: DisplayRegion -> Int -> BlitM s ()
330addRowCompletion displayRegion row = do
330addRowCompletion displayRegion row = do
331 allRowOps <- view mrowOps
331 allRowOps <- view mrowOps
332 rowOps <- lift $ lift $ MVector.read allRowOps row
332 rowOps <- lift $ lift $ MVector.read allRowOps row
333− let endX = spanOpsAffectedColumns rowOps
333+ let endX = spanOpsEffectedColumns rowOps
334 when (endX < regionWidth displayRegion) $ do
334 when (endX < regionWidth displayRegion) $ do
335 let ow = regionWidth displayRegion - endX
335 let ow = regionWidth displayRegion - endX
336 snocOp (Skip ow) row
336 snocOp (Skip ow) row
@@ -343,6 +343,12 @@ snocOp !op !row = do
343 lift $ lift $ do
343 lift $ lift $ do
344 ops <- MVector.read theMrowOps row
344 ops <- MVector.read theMrowOps row
345 let ops' = Vector.snoc ops op
345 let ops' = Vector.snoc ops op
346− when (spanOpsAffectedColumns ops' > regionWidth theRegion)
346+ when (spanOpsEffectedColumns ops' > regionWidth theRegion)
347 $ fail $ "row " ++ show row ++ " now exceeds region width"
347 $ fail $ "row " ++ show row ++ " now exceeds region width"
348 MVector.write theMrowOps row ops'
348 MVector.write theMrowOps row ops'
349+
350+(-~) :: Num a => ASetter s t a a -> a -> s -> t
351+l -~ n = over l (subtract n)
352+
353+(+~) :: Num a => ASetter s t a a -> a -> s -> t
354+l +~ n = over l (n +)
src/Graphics/Vty/Span.hs+11−8
@@ -1,4 +1,6 @@
1-- Copyright Corey O'Connor
1-- Copyright Corey O'Connor
2+{-# LANGUAGE BangPatterns #-}
3+{-# LANGUAGE NamedFieldPuns #-}
2{-# LANGUAGE GADTs #-}
4{-# LANGUAGE GADTs #-}
3-- | A picture is translated into a sequences of state changes and
5-- | A picture is translated into a sequences of state changes and
4-- character spans. The attribute is applied to all following spans,
6-- character spans. The attribute is applied to all following spans,
@@ -50,7 +52,7 @@ dropOps :: Int -> SpanOps -> SpanOps
50dropOps w = snd . splitOpsAt w
52dropOps w = snd . splitOpsAt w
51
53
52splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)
54splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)
53−splitOpsAt = splitOpsAt'
55+splitOpsAt inW inOps = splitOpsAt' inW inOps
54 where
56 where
55 splitOpsAt' 0 ops = (Vector.empty, ops)
57 splitOpsAt' 0 ops = (Vector.empty, ops)
56 splitOpsAt' remainingColumns ops = case Vector.head ops of
58 splitOpsAt' remainingColumns ops = case Vector.head ops of
@@ -101,18 +103,18 @@ displayOpsColumns ops
101
103
102-- | The number of rows the DisplayOps are defined for.
104-- | The number of rows the DisplayOps are defined for.
103displayOpsRows :: DisplayOps -> Int
105displayOpsRows :: DisplayOps -> Int
104−displayOpsRows = Vector.length
106+displayOpsRows ops = Vector.length ops
105
107
106affectedRegion :: DisplayOps -> DisplayRegion
108affectedRegion :: DisplayOps -> DisplayRegion
107affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)
109affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)
108
110
109-- | The number of columns a SpanOps affects.
111-- | The number of columns a SpanOps affects.
110−spanOpsAffectedColumns :: SpanOps -> Int
112+spanOpsEffectedColumns :: SpanOps -> Int
111−spanOpsAffectedColumns inOps = Vector.foldl' spanOpsAffectedColumns' 0 inOps
113+spanOpsEffectedColumns inOps = Vector.foldl' spanOpsEffectedColumns' 0 inOps
112 where
114 where
113− spanOpsAffectedColumns' t (TextSpan _ w _ _ ) = t + w
115+ spanOpsEffectedColumns' t (TextSpan _ w _ _ ) = t + w
114− spanOpsAffectedColumns' t (Skip w) = t + w
116+ spanOpsEffectedColumns' t (Skip w) = t + w
115− spanOpsAffectedColumns' t (RowEnd w) = t + w
117+ spanOpsEffectedColumns' t (RowEnd w) = t + w
116
118
117-- | The width of a single SpanOp in columns.
119-- | The width of a single SpanOp in columns.
118spanOpHasWidth :: SpanOp -> Maybe (Int, Int)
120spanOpHasWidth :: SpanOp -> Maybe (Int, Int)
@@ -124,6 +126,7 @@ spanOpHasWidth (RowEnd ow) = Just (ow,ow)
124-- span op.
126-- span op.
125columnsToCharOffset :: Int -> SpanOp -> Int
127columnsToCharOffset :: Int -> SpanOp -> Int
126columnsToCharOffset cx (TextSpan _ _ _ utf8Str) =
128columnsToCharOffset cx (TextSpan _ _ _ utf8Str) =
127− wctlwidth (TL.take (fromIntegral cx) utf8Str)
129+ let str = TL.unpack utf8Str
130+ in wcswidth (take cx str)
128columnsToCharOffset cx (Skip _) = cx
131columnsToCharOffset cx (Skip _) = cx
129columnsToCharOffset cx (RowEnd _) = cx
132columnsToCharOffset cx (RowEnd _) = cx
src/Graphics/Vty/UnicodeWidthTable/IO.hsdeleted−105
@@ -1,105 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−module Graphics.Vty.UnicodeWidthTable.IO
3− ( readUnicodeWidthTable
4− , parseUnicodeWidthTable
5− , writeUnicodeWidthTable
6− )
7−where
8−
9−import Control.Monad (when, forM)
10−import Data.Binary
11−import Data.Binary.Get
12−import Data.Binary.Put
13−import qualified Data.ByteString.Lazy as BSL
14−#if !(MIN_VERSION_base(4,11,0))
15−import Data.Semigroup ((<>))
16−#endif
17−
18−import Graphics.Vty.UnicodeWidthTable.Types
19−
20−-- | Load a binary unicode width table from the specified file.
21−--
22−-- This either returns a successfully parsed table or a table parsing
23−-- error message. This does not handle I/O exceptions.
24−readUnicodeWidthTable :: FilePath -> IO (Either String UnicodeWidthTable)
25−readUnicodeWidthTable path = parseUnicodeWidthTable <$> BSL.readFile path
26−
27−-- | Parse a binary unicode width table.
28−parseUnicodeWidthTable :: BSL.ByteString -> Either String UnicodeWidthTable
29−parseUnicodeWidthTable bs =
30− case runGetOrFail tableParser bs of
31− Left (_, _, msg) ->
32− Left msg
33−
34− -- Even if we parsed a table, leftover bytes indicate something
35− -- could be wrong.
36− Right (remainingBytes, _, _) | not (BSL.null remainingBytes) ->
37− Left $ "Error: " <> show (BSL.length remainingBytes) <>
38− " byte(s) left unconsumed"
39−
40− Right (_, _, table) ->
41− Right table
42−
43−-- | Write the unicode width table to the specified path.
44−--
45−-- This does not handle I/O exceptions.
46−writeUnicodeWidthTable :: FilePath -> UnicodeWidthTable -> IO ()
47−writeUnicodeWidthTable path table = do
48− let body = runPut (tableV1Writer table)
49− BSL.writeFile path body
50−
51−-- | Width table magic bytes for use in the binary format.
52−widthTableMagic :: Word32
53−widthTableMagic = 0xc1a9f7e0
54−
55−tableParser :: Get UnicodeWidthTable
56−tableParser = do
57− magic <- getWord32le
58−
59− when (magic /= widthTableMagic) $
60− fail "Table magic number invalid"
61−
62− version <- getWord8
63−
64− case version of
65− 1 -> tableV1Parser
66− _ -> fail "Table version invalid"
67−
68−tableV1Parser :: Get UnicodeWidthTable
69−tableV1Parser = do
70− numRanges <- getWord32le
71−
72− let parseRange = do
73− start <- getWord32le
74− size <- getWord32le
75− cols <- getWord8
76− return WidthTableRange { rangeStart = start
77− , rangeSize = size
78− , rangeColumns = cols
79− }
80−
81− ranges <- forM [1..numRanges] $ const parseRange
82−
83− return UnicodeWidthTable { unicodeWidthTableRanges = ranges
84− }
85−
86−tableV1Writer :: UnicodeWidthTable -> Put
87−tableV1Writer table = do
88− -- Magic bytes
89− putWord32le widthTableMagic
90−
91− -- Version
92− putWord8 1
93−
94− -- Number of ranges
95− let ranges = unicodeWidthTableRanges table
96− let numRanges = length ranges
97− putWord32le (fromIntegral numRanges)
98−
99− -- Ranges
100− let putRange r = do
101− putWord32le $ rangeStart r
102− putWord32le $ rangeSize r
103− putWord8 $ rangeColumns r
104−
105− mapM_ putRange ranges
src/Graphics/Vty/UnicodeWidthTable/Install.hsdeleted−129
@@ -1,129 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE ForeignFunctionInterface #-}
3−module Graphics.Vty.UnicodeWidthTable.Install
4− ( TableInstallException(..)
5− , installUnicodeWidthTable
6− , isCustomTableReady
7− )
8−where
9−
10−import Control.Monad (when, forM_)
11−import qualified Control.Exception as E
12−import GHC.Conc.Sync (withMVar)
13−import Control.Concurrent.MVar (MVar, newMVar)
14−import Data.Word (Word8, Word32)
15−#if !(MIN_VERSION_base(4,11,0))
16−import Data.Semigroup ((<>))
17−#endif
18−import System.IO.Unsafe (unsafePerformIO)
19−
20−import Graphics.Vty.UnicodeWidthTable.Types
21−
22−-- | The lock used to make functions in this module thread-safe.
23−installLock :: MVar ()
24−{-# NOINLINE installLock #-}
25−installLock = unsafePerformIO $ newMVar ()
26−
27−-- | Returns True if and only if a custom table has been allocated and
28−-- marked as ready for use.
29−--
30−-- This function is thread-safe.
31−isCustomTableReady :: IO Bool
32−isCustomTableReady = withInstallLock $ (== 1) <$> c_isCustomTableReady
33−
34−withInstallLock :: IO a -> IO a
35−withInstallLock act = withMVar installLock $ const act
36−
37−-- This is the size of the allocated custom character width table, in
38−-- character slots. It's important that this be large enough to hold all
39−-- possible Unicode character values. At the time of this writing, the
40−-- valid Unicode range is 0 - 0x10ffff, hence this value.
41−tableSize :: Int
42−tableSize = 0x110000
43−
44−-- | Exception type raised by 'installUnicodeWidthTable'.
45−data TableInstallException =
46− TableInitFailure Int Int
47− -- ^ The width table could not be initialized. Args: failure status,
48− -- requested table size.
49− | TableRangeFailure Int WidthTableRange
50− -- ^ A code point range could not be configured. Args: failure
51− -- status, offending range.
52− | TableActivationFailure Int
53− -- ^ The table could not be activated. Args: failure status.
54− deriving (Eq, Show)
55−
56−instance E.Exception TableInstallException
57−
58−-- | Install a custom unicode character width
59−-- table. Such tables are obtained with
60−-- 'Graphics.Vty.UnicodeWidthTable.Query.buildUnicodeWidthTable' and
61−-- 'Graphics.Vty.UnicodeWidthTable.IO.readUnicodeWidthTable'.
62−--
63−-- ALERT! This function is probably not what you want to use because
64−-- it is automatically called by 'Graphics.Vty.mkVty'. You will only
65−-- ever need to call this function if you want to use functions
66−-- in 'Graphics.Text.Width' without controlling the terminal with
67−-- 'Graphics.Vty.mkVty'.
68−--
69−-- This affects the behavior of the 'Graphics.Vty.Image.wcwidth'
70−-- function and functions that call it. It does so by
71−-- changing global state available to the C implementation
72−-- of 'Graphics.Vty.Image.wcwidth'. To ensure that your
73−-- program gets consistent results from evaluating calls to
74−-- 'Graphics.Vty.Image.wcwidth', the installation of a custom table
75−-- should be performed before you call 'Graphics.Vty.Image.wcwidth' in
76−-- your program.
77−--
78−-- This is best done at Vty startup, and if you use
79−-- 'Graphics.Vty.mkVty', that function calls this automatically based on
80−-- the Vty configuration's declared width tables. It is exposed as part
81−-- of the public API so that applications can call this as needed if
82−-- they don't want to control the terminal with 'mkVty' but do want to
83−-- make calls to 'Graphics.Vty.Image.wcwidth'.
84−--
85−-- It's also important to note that once a custom table has been
86−-- installed, it is permanent for the life of the process. No new table
87−-- can be installed, and the new custom table cannot be removed.
88−--
89−-- If this function fails for any reason -- if the table cannot be
90−-- installed or is invalid, or if a custom table already exists -- this
91−-- will raise a 'TableInstallException' exception.
92−--
93−-- This function is thread-safe.
94−installUnicodeWidthTable :: UnicodeWidthTable -> IO ()
95−installUnicodeWidthTable table = withInstallLock $ do
96− initResult <- initCustomTable tableSize
97− when (initResult /= 0) $
98− E.throwIO $ TableInitFailure initResult tableSize
99−
100− forM_ (unicodeWidthTableRanges table) $ \r -> do
101− result <- setCustomTableRange (rangeStart r)
102− (rangeSize r)
103− (rangeColumns r)
104−
105− when (result /= 0) $ do
106− deallocateCustomTable
107− E.throwIO $ TableRangeFailure result r
108−
109− actResult <- activateCustomTable
110− when (actResult /= 0) $
111− E.throwIO $ TableActivationFailure actResult
112−
113−------------------------------------------------------------------------
114−-- C imports
115−
116−foreign import ccall unsafe "vty_init_custom_table"
117− initCustomTable :: Int -> IO Int
118−
119−foreign import ccall unsafe "vty_set_custom_table_range"
120− setCustomTableRange :: Word32 -> Word32 -> Word8 -> IO Int
121−
122−foreign import ccall unsafe "vty_activate_custom_table"
123− activateCustomTable :: IO Int
124−
125−foreign import ccall unsafe "vty_custom_table_ready"
126− c_isCustomTableReady :: IO Int
127−
128−foreign import ccall unsafe "vty_deallocate_custom_table"
129− deallocateCustomTable :: IO ()
src/Graphics/Vty/UnicodeWidthTable/Query.hsdeleted−79
@@ -1,79 +0,0 @@
1−{-# LANGUAGE TupleSections #-}
2−module Graphics.Vty.UnicodeWidthTable.Query
3− ( buildUnicodeWidthTable
4− , defaultUnicodeTableUpperBound
5− )
6−where
7−
8−import Control.Monad (forM)
9−import Data.Char (generalCategory, GeneralCategory(..))
10−import System.Console.ANSI (getCursorPosition)
11−import Text.Printf (printf)
12−
13−import Graphics.Vty.UnicodeWidthTable.Types
14−
15−shouldConsider :: Char -> Bool
16−shouldConsider c =
17− case generalCategory c of
18− Control -> False
19− NotAssigned -> False
20− Surrogate -> False
21− _ -> True
22−
23−charWidth :: Char -> IO Int
24−charWidth c = do
25− printf "\r"
26− putChar c
27− Just (_, col) <- getCursorPosition
28− return col
29−
30−-- | Convert a sequence of character/width pairs into a list of
31−-- run-length encoded ranges. This function assumes the pairs come
32−-- sorted by character ordinal value. It does not require that the
33−-- character range is fully covered by the sequence.
34−--
35−-- The result of this function is a list of ranges in reverse order
36−-- relative to the input sequence.
37−mkRanges :: [(Char, Int)] -> [WidthTableRange]
38−mkRanges pairs =
39− let convertedPairs = convert <$> pairs
40− convert (c, i) = (fromIntegral $ fromEnum c, fromIntegral i)
41−
42− go Nothing finishedRanges [] = finishedRanges
43− go (Just r) finishedRanges [] = r:finishedRanges
44−
45− go Nothing finishedRanges ((c, width):rest) =
46− go (Just $ WidthTableRange c 1 width) finishedRanges rest
47−
48− go (Just r@(WidthTableRange prevCh sz prevWidth)) finishedRanges ((c, width):rest) =
49− if c == prevCh + sz && prevWidth == width
50− then go (Just (WidthTableRange prevCh (sz + 1) prevWidth)) finishedRanges rest
51− else go (Just (WidthTableRange c 1 width)) (r:finishedRanges) rest
52−
53− in go Nothing [] convertedPairs
54−
55−-- The uppermost code point to consider when building Unicode width
56−-- tables.
57−defaultUnicodeTableUpperBound :: Char
58−defaultUnicodeTableUpperBound = '\xe0000'
59−
60−-- | Construct a unicode character width table by querying the terminal
61−-- connected to stdout. This works by emitting characters to stdout
62−-- and then querying the terminal to determine the resulting cursor
63−-- position in order to measure character widths. Consequently this will
64−-- generate a lot of output and may take a while, depending on your
65−-- system performance. This should not be run in a terminal while it is
66−-- controlled by Vty.
67−--
68−-- The argument specifies the upper bound code point to test when
69−-- building the table. This allows callers to decide how much of the
70−-- Unicode code point space to scan when building the table.
71−--
72−-- This does not handle exceptions.
73−buildUnicodeWidthTable :: Char -> IO UnicodeWidthTable
74−buildUnicodeWidthTable tableUpperBound = do
75− pairs <- forM (filter shouldConsider ['\0'..tableUpperBound]) $ \i ->
76− (i,) <$> charWidth i
77−
78− return UnicodeWidthTable { unicodeWidthTableRanges = reverse $ mkRanges pairs
79− }
src/Graphics/Vty/UnicodeWidthTable/Types.hsdeleted−29
@@ -1,29 +0,0 @@
1−module Graphics.Vty.UnicodeWidthTable.Types
2− ( UnicodeWidthTable(..)
3− , WidthTableRange(..)
4− )
5−where
6−
7−import Data.Word (Word8, Word32)
8−
9−-- | A range of code points in a width table.
10−data WidthTableRange =
11− WidthTableRange { rangeStart :: Word32
12− -- ^ The range's starting code point.
13− , rangeSize :: Word32
14− -- ^ The number of code points in the contiguous
15− -- range, beginning with the starting code point
16− -- ('rangeStart').
17− , rangeColumns :: Word8
18− -- ^ The terminal width, in columns, of all of the
19− -- characters corresponding to the code points in
20− -- this range.
21− }
22− deriving (Eq, Show)
23−
24−-- | A run-length-encoded table of Unicode character widths.
25−data UnicodeWidthTable =
26− UnicodeWidthTable { unicodeWidthTableRanges :: [WidthTableRange]
27− -- ^ The ranges in the table.
28− }
29− deriving (Show)
test/Verify/Graphics/Vty/Span.hs+1−1
@@ -20,7 +20,7 @@ isAttrSpanOp TextSpan {} = True
20isAttrSpanOp _ = False
20isAttrSpanOp _ = False
21
21
22verifyAllSpansHaveWidth i spans w
22verifyAllSpansHaveWidth i spans w
23− = let v = map (\s -> (spanOpsAffectedColumns s /= w, s)) (Vector.toList spans)
23+ = let v = map (\s -> (spanOpsEffectedColumns s /= w, s)) (Vector.toList spans)
24 in case any ((== True) . fst) v of
24 in case any ((== True) . fst) v of
25 False -> succeeded
25 False -> succeeded
26 True -> failed { reason = "Not all spans contained operations defining exactly "
26 True -> failed { reason = "Not all spans contained operations defining exactly "
test/VerifyAttributeOps.hsnew file+9
@@ -0,0 +1,9 @@
1+module VerifyAttributeOps where
2+
3+import Verify.Graphics.Vty.Attributes
4+
5+import Verify
6+
7+tests :: IO [Test]
8+tests = return []
9+
test/VerifyColor240.hsdeleted−269
@@ -1,269 +0,0 @@
1−module VerifyColor240 where
2−
3−import Data.Word(Word8)
4−import Verify
5−
6−import Graphics.Vty.Attributes.Color240(rgbColorToColor240)
7−
8−oldRgbColorToColor240 :: Integral i => i -> i -> i -> Word8
9−oldRgbColorToColor240 r g b
10− | r < 0 && g < 0 && b < 0 = error "rgbColor with negative color component intensity"
11− | r == 8 && g == 8 && b == 8 = 216
12− | r == 18 && g == 18 && b == 18 = 217
13− | r == 28 && g == 28 && b == 28 = 218
14− | r == 38 && g == 38 && b == 38 = 219
15− | r == 48 && g == 48 && b == 48 = 220
16− | r == 58 && g == 58 && b == 58 = 221
17− | r == 68 && g == 68 && b == 68 = 222
18− | r == 78 && g == 78 && b == 78 = 223
19− | r == 88 && g == 88 && b == 88 = 224
20− | r == 98 && g == 98 && b == 98 = 225
21− | r == 108 && g == 108 && b == 108 = 226
22− | r == 118 && g == 118 && b == 118 = 227
23− | r == 128 && g == 128 && b == 128 = 228
24− | r == 138 && g == 138 && b == 138 = 229
25− | r == 148 && g == 148 && b == 148 = 230
26− | r == 158 && g == 158 && b == 158 = 231
27− | r == 168 && g == 168 && b == 168 = 232
28− | r == 178 && g == 178 && b == 178 = 233
29− | r == 188 && g == 188 && b == 188 = 234
30− | r == 198 && g == 198 && b == 198 = 235
31− | r == 208 && g == 208 && b == 208 = 236
32− | r == 218 && g == 218 && b == 218 = 237
33− | r == 228 && g == 228 && b == 228 = 238
34− | r == 238 && g == 238 && b == 238 = 239
35− | r <= 0 && g <= 0 && b <= 0 = 0
36− | r <= 0 && g <= 0 && b <= 95 = 1
37− | r <= 0 && g <= 0 && b <= 135 = 2
38− | r <= 0 && g <= 0 && b <= 175 = 3
39− | r <= 0 && g <= 0 && b <= 215 = 4
40− | r <= 0 && g <= 0 && b <= 255 = 5
41− | r <= 0 && g <= 95 && b <= 0 = 6
42− | r <= 0 && g <= 95 && b <= 95 = 7
43− | r <= 0 && g <= 95 && b <= 135 = 8
44− | r <= 0 && g <= 95 && b <= 175 = 9
45− | r <= 0 && g <= 95 && b <= 215 = 10
46− | r <= 0 && g <= 95 && b <= 255 = 11
47− | r <= 0 && g <= 135 && b <= 0 = 12
48− | r <= 0 && g <= 135 && b <= 95 = 13
49− | r <= 0 && g <= 135 && b <= 135 = 14
50− | r <= 0 && g <= 135 && b <= 175 = 15
51− | r <= 0 && g <= 135 && b <= 215 = 16
52− | r <= 0 && g <= 135 && b <= 255 = 17
53− | r <= 0 && g <= 175 && b <= 0 = 18
54− | r <= 0 && g <= 175 && b <= 95 = 19
55− | r <= 0 && g <= 175 && b <= 135 = 20
56− | r <= 0 && g <= 175 && b <= 175 = 21
57− | r <= 0 && g <= 175 && b <= 215 = 22
58− | r <= 0 && g <= 175 && b <= 255 = 23
59− | r <= 0 && g <= 215 && b <= 0 = 24
60− | r <= 0 && g <= 215 && b <= 95 = 25
61− | r <= 0 && g <= 215 && b <= 135 = 26
62− | r <= 0 && g <= 215 && b <= 175 = 27
63− | r <= 0 && g <= 215 && b <= 215 = 28
64− | r <= 0 && g <= 215 && b <= 255 = 29
65− | r <= 0 && g <= 255 && b <= 0 = 30
66− | r <= 0 && g <= 255 && b <= 95 = 31
67− | r <= 0 && g <= 255 && b <= 135 = 32
68− | r <= 0 && g <= 255 && b <= 175 = 33
69− | r <= 0 && g <= 255 && b <= 215 = 34
70− | r <= 0 && g <= 255 && b <= 255 = 35
71− | r <= 95 && g <= 0 && b <= 0 = 36
72− | r <= 95 && g <= 0 && b <= 95 = 37
73− | r <= 95 && g <= 0 && b <= 135 = 38
74− | r <= 95 && g <= 0 && b <= 175 = 39
75− | r <= 95 && g <= 0 && b <= 215 = 40
76− | r <= 95 && g <= 0 && b <= 255 = 41
77− | r <= 95 && g <= 95 && b <= 0 = 42
78− | r <= 95 && g <= 95 && b <= 95 = 43
79− | r <= 95 && g <= 95 && b <= 135 = 44
80− | r <= 95 && g <= 95 && b <= 175 = 45
81− | r <= 95 && g <= 95 && b <= 215 = 46
82− | r <= 95 && g <= 95 && b <= 255 = 47
83− | r <= 95 && g <= 135 && b <= 0 = 48
84− | r <= 95 && g <= 135 && b <= 95 = 49
85− | r <= 95 && g <= 135 && b <= 135 = 50
86− | r <= 95 && g <= 135 && b <= 175 = 51
87− | r <= 95 && g <= 135 && b <= 215 = 52
88− | r <= 95 && g <= 135 && b <= 255 = 53
89− | r <= 95 && g <= 175 && b <= 0 = 54
90− | r <= 95 && g <= 175 && b <= 95 = 55
91− | r <= 95 && g <= 175 && b <= 135 = 56
92− | r <= 95 && g <= 175 && b <= 175 = 57
93− | r <= 95 && g <= 175 && b <= 215 = 58
94− | r <= 95 && g <= 175 && b <= 255 = 59
95− | r <= 95 && g <= 215 && b <= 0 = 60
96− | r <= 95 && g <= 215 && b <= 95 = 61
97− | r <= 95 && g <= 215 && b <= 135 = 62
98− | r <= 95 && g <= 215 && b <= 175 = 63
99− | r <= 95 && g <= 215 && b <= 215 = 64
100− | r <= 95 && g <= 215 && b <= 255 = 65
101− | r <= 95 && g <= 255 && b <= 0 = 66
102− | r <= 95 && g <= 255 && b <= 95 = 67
103− | r <= 95 && g <= 255 && b <= 135 = 68
104− | r <= 95 && g <= 255 && b <= 175 = 69
105− | r <= 95 && g <= 255 && b <= 215 = 70
106− | r <= 95 && g <= 255 && b <= 255 = 71
107− | r <= 135 && g <= 0 && b <= 0 = 72
108− | r <= 135 && g <= 0 && b <= 95 = 73
109− | r <= 135 && g <= 0 && b <= 135 = 74
110− | r <= 135 && g <= 0 && b <= 175 = 75
111− | r <= 135 && g <= 0 && b <= 215 = 76
112− | r <= 135 && g <= 0 && b <= 255 = 77
113− | r <= 135 && g <= 95 && b <= 0 = 78
114− | r <= 135 && g <= 95 && b <= 95 = 79
115− | r <= 135 && g <= 95 && b <= 135 = 80
116− | r <= 135 && g <= 95 && b <= 175 = 81
117− | r <= 135 && g <= 95 && b <= 215 = 82
118− | r <= 135 && g <= 95 && b <= 255 = 83
119− | r <= 135 && g <= 135 && b <= 0 = 84
120− | r <= 135 && g <= 135 && b <= 95 = 85
121− | r <= 135 && g <= 135 && b <= 135 = 86
122− | r <= 135 && g <= 135 && b <= 175 = 87
123− | r <= 135 && g <= 135 && b <= 215 = 88
124− | r <= 135 && g <= 135 && b <= 255 = 89
125− | r <= 135 && g <= 175 && b <= 0 = 90
126− | r <= 135 && g <= 175 && b <= 95 = 91
127− | r <= 135 && g <= 175 && b <= 135 = 92
128− | r <= 135 && g <= 175 && b <= 175 = 93
129− | r <= 135 && g <= 175 && b <= 215 = 94
130− | r <= 135 && g <= 175 && b <= 255 = 95
131− | r <= 135 && g <= 215 && b <= 0 = 96
132− | r <= 135 && g <= 215 && b <= 95 = 97
133− | r <= 135 && g <= 215 && b <= 135 = 98
134− | r <= 135 && g <= 215 && b <= 175 = 99
135− | r <= 135 && g <= 215 && b <= 215 = 100
136− | r <= 135 && g <= 215 && b <= 255 = 101
137− | r <= 135 && g <= 255 && b <= 0 = 102
138− | r <= 135 && g <= 255 && b <= 95 = 103
139− | r <= 135 && g <= 255 && b <= 135 = 104
140− | r <= 135 && g <= 255 && b <= 175 = 105
141− | r <= 135 && g <= 255 && b <= 215 = 106
142− | r <= 135 && g <= 255 && b <= 255 = 107
143− | r <= 175 && g <= 0 && b <= 0 = 108
144− | r <= 175 && g <= 0 && b <= 95 = 109
145− | r <= 175 && g <= 0 && b <= 135 = 110
146− | r <= 175 && g <= 0 && b <= 175 = 111
147− | r <= 175 && g <= 0 && b <= 215 = 112
148− | r <= 175 && g <= 0 && b <= 255 = 113
149− | r <= 175 && g <= 95 && b <= 0 = 114
150− | r <= 175 && g <= 95 && b <= 95 = 115
151− | r <= 175 && g <= 95 && b <= 135 = 116
152− | r <= 175 && g <= 95 && b <= 175 = 117
153− | r <= 175 && g <= 95 && b <= 215 = 118
154− | r <= 175 && g <= 95 && b <= 255 = 119
155− | r <= 175 && g <= 135 && b <= 0 = 120
156− | r <= 175 && g <= 135 && b <= 95 = 121
157− | r <= 175 && g <= 135 && b <= 135 = 122
158− | r <= 175 && g <= 135 && b <= 175 = 123
159− | r <= 175 && g <= 135 && b <= 215 = 124
160− | r <= 175 && g <= 135 && b <= 255 = 125
161− | r <= 175 && g <= 175 && b <= 0 = 126
162− | r <= 175 && g <= 175 && b <= 95 = 127
163− | r <= 175 && g <= 175 && b <= 135 = 128
164− | r <= 175 && g <= 175 && b <= 175 = 129
165− | r <= 175 && g <= 175 && b <= 215 = 130
166− | r <= 175 && g <= 175 && b <= 255 = 131
167− | r <= 175 && g <= 215 && b <= 0 = 132
168− | r <= 175 && g <= 215 && b <= 95 = 133
169− | r <= 175 && g <= 215 && b <= 135 = 134
170− | r <= 175 && g <= 215 && b <= 175 = 135
171− | r <= 175 && g <= 215 && b <= 215 = 136
172− | r <= 175 && g <= 215 && b <= 255 = 137
173− | r <= 175 && g <= 255 && b <= 0 = 138
174− | r <= 175 && g <= 255 && b <= 95 = 139
175− | r <= 175 && g <= 255 && b <= 135 = 140
176− | r <= 175 && g <= 255 && b <= 175 = 141
177− | r <= 175 && g <= 255 && b <= 215 = 142
178− | r <= 175 && g <= 255 && b <= 255 = 143
179− | r <= 215 && g <= 0 && b <= 0 = 144
180− | r <= 215 && g <= 0 && b <= 95 = 145
181− | r <= 215 && g <= 0 && b <= 135 = 146
182− | r <= 215 && g <= 0 && b <= 175 = 147
183− | r <= 215 && g <= 0 && b <= 215 = 148
184− | r <= 215 && g <= 0 && b <= 255 = 149
185− | r <= 215 && g <= 95 && b <= 0 = 150
186− | r <= 215 && g <= 95 && b <= 95 = 151
187− | r <= 215 && g <= 95 && b <= 135 = 152
188− | r <= 215 && g <= 95 && b <= 175 = 153
189− | r <= 215 && g <= 95 && b <= 215 = 154
190− | r <= 215 && g <= 95 && b <= 255 = 155
191− | r <= 215 && g <= 135 && b <= 0 = 156
192− | r <= 215 && g <= 135 && b <= 95 = 157
193− | r <= 215 && g <= 135 && b <= 135 = 158
194− | r <= 215 && g <= 135 && b <= 175 = 159
195− | r <= 215 && g <= 135 && b <= 215 = 160
196− | r <= 215 && g <= 135 && b <= 255 = 161
197− | r <= 215 && g <= 175 && b <= 0 = 162
198− | r <= 215 && g <= 175 && b <= 95 = 163
199− | r <= 215 && g <= 175 && b <= 135 = 164
200− | r <= 215 && g <= 175 && b <= 175 = 165
201− | r <= 215 && g <= 175 && b <= 215 = 166
202− | r <= 215 && g <= 175 && b <= 255 = 167
203− | r <= 215 && g <= 215 && b <= 0 = 168
204− | r <= 215 && g <= 215 && b <= 95 = 169
205− | r <= 215 && g <= 215 && b <= 135 = 170
206− | r <= 215 && g <= 215 && b <= 175 = 171
207− | r <= 215 && g <= 215 && b <= 215 = 172
208− | r <= 215 && g <= 215 && b <= 255 = 173
209− | r <= 215 && g <= 255 && b <= 0 = 174
210− | r <= 215 && g <= 255 && b <= 95 = 175
211− | r <= 215 && g <= 255 && b <= 135 = 176
212− | r <= 215 && g <= 255 && b <= 175 = 177
213− | r <= 215 && g <= 255 && b <= 215 = 178
214− | r <= 215 && g <= 255 && b <= 255 = 179
215− | r <= 255 && g <= 0 && b <= 0 = 180
216− | r <= 255 && g <= 0 && b <= 95 = 181
217− | r <= 255 && g <= 0 && b <= 135 = 182
218− | r <= 255 && g <= 0 && b <= 175 = 183
219− | r <= 255 && g <= 0 && b <= 215 = 184
220− | r <= 255 && g <= 0 && b <= 255 = 185
221− | r <= 255 && g <= 95 && b <= 0 = 186
222− | r <= 255 && g <= 95 && b <= 95 = 187
223− | r <= 255 && g <= 95 && b <= 135 = 188
224− | r <= 255 && g <= 95 && b <= 175 = 189
225− | r <= 255 && g <= 95 && b <= 215 = 190
226− | r <= 255 && g <= 95 && b <= 255 = 191
227− | r <= 255 && g <= 135 && b <= 0 = 192
228− | r <= 255 && g <= 135 && b <= 95 = 193
229− | r <= 255 && g <= 135 && b <= 135 = 194
230− | r <= 255 && g <= 135 && b <= 175 = 195
231− | r <= 255 && g <= 135 && b <= 215 = 196
232− | r <= 255 && g <= 135 && b <= 255 = 197
233− | r <= 255 && g <= 175 && b <= 0 = 198
234− | r <= 255 && g <= 175 && b <= 95 = 199
235− | r <= 255 && g <= 175 && b <= 135 = 200
236− | r <= 255 && g <= 175 && b <= 175 = 201
237− | r <= 255 && g <= 175 && b <= 215 = 202
238− | r <= 255 && g <= 175 && b <= 255 = 203
239− | r <= 255 && g <= 215 && b <= 0 = 204
240− | r <= 255 && g <= 215 && b <= 95 = 205
241− | r <= 255 && g <= 215 && b <= 135 = 206
242− | r <= 255 && g <= 215 && b <= 175 = 207
243− | r <= 255 && g <= 215 && b <= 215 = 208
244− | r <= 255 && g <= 215 && b <= 255 = 209
245− | r <= 255 && g <= 255 && b <= 0 = 210
246− | r <= 255 && g <= 255 && b <= 95 = 211
247− | r <= 255 && g <= 255 && b <= 135 = 212
248− | r <= 255 && g <= 255 && b <= 175 = 213
249− | r <= 255 && g <= 255 && b <= 215 = 214
250− | r <= 255 && g <= 255 && b <= 255 = 215
251− | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."
252− (fromIntegral r :: Int)
253− (fromIntegral g :: Int)
254− (fromIntegral b :: Int))
255−
256−sameColor :: Int -> Int -> Int -> Bool
257−sameColor r g b = oldRgbColorToColor240 r g b == rgbColorToColor240 r g b
258−
259−genVal :: Gen Int
260−genVal = chooseInt (0, 255)
261−
262−sameColorCheck :: Property
263−sameColorCheck = forAll genVal (\r -> forAll genVal (\g -> forAll genVal (sameColor r g)))
264−
265−tests :: IO [Test]
266−tests = return
267− [ verify "check rgbColorToColor240 optimization is correct" sameColorCheck
268− ]
269−
test/VerifyEmptyImageProps.hs−1
@@ -1,4 +1,3 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
2module VerifyEmptyImageProps where
1module VerifyEmptyImageProps where
3
2
4import Verify
3import Verify
test/VerifyEvalTerminfoCaps.hs−1
@@ -1,6 +1,5 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE NamedFieldPuns #-}
2{-# LANGUAGE NamedFieldPuns #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4module VerifyEvalTerminfoCaps where
3module VerifyEvalTerminfoCaps where
5
4
6import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)
5import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)
test/VerifyImageOps.hs+1−2
@@ -1,4 +1,3 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
2module VerifyImageOps where
1module VerifyImageOps where
3
2
4import Graphics.Vty.Attributes
3import Graphics.Vty.Attributes
@@ -137,7 +136,7 @@ cropBottomLimitsHeight :: Image -> Int -> Property
137cropBottomLimitsHeight i v = v >= 0 ==>
136cropBottomLimitsHeight i v = v >= 0 ==>
138 v >= imageHeight (cropBottom v i)
137 v >= imageHeight (cropBottom v i)
139
138
140−-- ridiculous tests just to satisfy my desire for nice code coverage :-P
139+-- rediculous tests just to satisfy my desire for nice code coverage :-P
141canShowImage :: Image -> Bool
140canShowImage :: Image -> Bool
142canShowImage i = length (show i) > 0
141canShowImage i = length (show i) > 0
143
142
test/VerifyOutput.hs+3−7
@@ -1,7 +1,6 @@
1−-- We setup the environment to invoke certain terminals of interest.
1+-- We setup the environment to envoke certain terminals of interest.
2-- This assumes appropriate definitions exist in the current environment
2-- This assumes appropriate definitions exist in the current environment
3-- for the terminals of interest.
3-- for the terminals of interest.
4−{-# LANGUAGE ScopedTypeVariables #-}
5module VerifyOutput where
4module VerifyOutput where
6
5
7import Verify
6import Verify
@@ -14,6 +13,7 @@ import Verify.Graphics.Vty.Output
14import Control.Monad
13import Control.Monad
15
14
16import qualified System.Console.Terminfo as Terminfo
15import qualified System.Console.Terminfo as Terminfo
16+import System.Posix.Env
17import System.Posix.IO
17import System.Posix.IO
18
18
19tests :: IO [Test]
19tests :: IO [Test]
@@ -35,11 +35,7 @@ smokeTestTermNonMac termName i = liftIOResult $ do
35smokeTestTerm :: String -> Image -> IO Result
35smokeTestTerm :: String -> Image -> IO Result
36smokeTestTerm termName i = do
36smokeTestTerm termName i = do
37 nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags
37 nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags
38− t <- outputForConfig $ defaultConfig
38+ t <- outputForConfig $ defaultConfig { outputFd = Just nullOut, termName = Just termName }
39− { outputFd = Just nullOut
40− , termName = Just termName
41− , colorMode = Just NoColor
42− }
43 -- putStrLn $ "context color count: " ++ show (contextColorCount t)
39 -- putStrLn $ "context color count: " ++ show (contextColorCount t)
44 reserveDisplay t
40 reserveDisplay t
45 dc <- displayContext t (100,100)
41 dc <- displayContext t (100,100)
test/VerifyParseTerminfoCaps.hs−1
@@ -1,5 +1,4 @@
1{-# LANGUAGE NamedFieldPuns #-}
1{-# LANGUAGE NamedFieldPuns #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
3module VerifyParseTerminfoCaps where
2module VerifyParseTerminfoCaps where
4
3
5import Prelude hiding ( catch )
4import Prelude hiding ( catch )
test/VerifySimpleSpanGeneration.hs+8−8
@@ -25,7 +25,7 @@ unitImageAndZeroWindow1 :: UnitImage -> EmptyWindow -> Bool
25unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =
25unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =
26 let p = picForImage i
26 let p = picForImage i
27 ops = displayOpsForPic p (regionForWindow w)
27 ops = displayOpsForPic p (regionForWindow w)
28− in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )
28+ in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )
29
29
30horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool
30horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool
31horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =
31horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =
@@ -37,7 +37,7 @@ horizSpanImageAndZeroWindow1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool
37horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =
37horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =
38 let p = picForImage i
38 let p = picForImage i
39 ops = displayOpsForPic p (regionForWindow w)
39 ops = displayOpsForPic p (regionForWindow w)
40− in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )
40+ in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )
41
41
42horizSpanImageAndEqualWindow0 :: SingleRowSingleAttrImage -> Result
42horizSpanImageAndEqualWindow0 :: SingleRowSingleAttrImage -> Result
43horizSpanImageAndEqualWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
43horizSpanImageAndEqualWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
@@ -51,7 +51,7 @@ horizSpanImageAndEqualWindow1 (SingleRowSingleAttrImage { rowImage = i, expected
51 let p = picForImage i
51 let p = picForImage i
52 w = MockWindow c 1
52 w = MockWindow c 1
53 ops = displayOpsForPic p (regionForWindow w)
53 ops = displayOpsForPic p (regionForWindow w)
54− in spanOpsAffectedRows ops == 1
54+ in spanOpsEffectedRows ops == 1
55
55
56horizSpanImageAndLesserWindow0 :: SingleRowSingleAttrImage -> Result
56horizSpanImageAndLesserWindow0 :: SingleRowSingleAttrImage -> Result
57horizSpanImageAndLesserWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
57horizSpanImageAndLesserWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =
@@ -74,7 +74,7 @@ singleAttrSingleSpanStackCropped1 stack =
74 expectedRowCount = stackHeight stack `div` 2
74 expectedRowCount = stackHeight stack `div` 2
75 w = MockWindow (stackWidth stack) expectedRowCount
75 w = MockWindow (stackWidth stack) expectedRowCount
76 ops = displayOpsForPic p (regionForWindow w)
76 ops = displayOpsForPic p (regionForWindow w)
77− actualRowCount = spanOpsAffectedRows ops
77+ actualRowCount = spanOpsEffectedRows ops
78 in expectedRowCount == actualRowCount
78 in expectedRowCount == actualRowCount
79
79
80singleAttrSingleSpanStackCropped2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
80singleAttrSingleSpanStackCropped2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
@@ -90,7 +90,7 @@ singleAttrSingleSpanStackCropped3 stack0 stack1 =
90 w = MockWindow (imageWidth (picImage p)) expectedRowCount
90 w = MockWindow (imageWidth (picImage p)) expectedRowCount
91 ops = displayOpsForPic p (regionForWindow w)
91 ops = displayOpsForPic p (regionForWindow w)
92 expectedRowCount = imageHeight (picImage p) `div` 2
92 expectedRowCount = imageHeight (picImage p) `div` 2
93− actualRowCount = spanOpsAffectedRows ops
93+ actualRowCount = spanOpsEffectedRows ops
94 in expectedRowCount == actualRowCount
94 in expectedRowCount == actualRowCount
95
95
96singleAttrSingleSpanStackCropped4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
96singleAttrSingleSpanStackCropped4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result
@@ -107,7 +107,7 @@ singleAttrSingleSpanStackCropped5 stack0 stack1 =
107 w = MockWindow (imageWidth (picImage p)) (stackHeight stack0)
107 w = MockWindow (imageWidth (picImage p)) (stackHeight stack0)
108 ops = displayOpsForPic p (regionForWindow w)
108 ops = displayOpsForPic p (regionForWindow w)
109 expectedRowCount = stackHeight stack0
109 expectedRowCount = stackHeight stack0
110− actualRowCount = spanOpsAffectedRows ops
110+ actualRowCount = spanOpsEffectedRows ops
111 in expectedRowCount == actualRowCount
111 in expectedRowCount == actualRowCount
112
112
113horizSpanImageAndGreaterWindow0 :: SingleRowSingleAttrImage -> Result
113horizSpanImageAndGreaterWindow0 :: SingleRowSingleAttrImage -> Result
@@ -123,13 +123,13 @@ arbImageIsCropped :: DefaultImage -> MockWindow -> Bool
123arbImageIsCropped (DefaultImage image) win@(MockWindow w h) =
123arbImageIsCropped (DefaultImage image) win@(MockWindow w h) =
124 let pic = picForImage image
124 let pic = picForImage image
125 ops = displayOpsForPic pic (regionForWindow win)
125 ops = displayOpsForPic pic (regionForWindow win)
126− in ( spanOpsAffectedRows ops == h ) && ( allSpansHaveWidth ops w )
126+ in ( spanOpsEffectedRows ops == h ) && ( allSpansHaveWidth ops w )
127
127
128spanOpsActuallyFillRows :: DefaultPic -> Bool
128spanOpsActuallyFillRows :: DefaultPic -> Bool
129spanOpsActuallyFillRows (DefaultPic pic win) =
129spanOpsActuallyFillRows (DefaultPic pic win) =
130 let ops = displayOpsForPic pic (regionForWindow win)
130 let ops = displayOpsForPic pic (regionForWindow win)
131 expectedRowCount = regionHeight (regionForWindow win)
131 expectedRowCount = regionHeight (regionForWindow win)
132− actualRowCount = spanOpsAffectedRows ops
132+ actualRowCount = spanOpsEffectedRows ops
133 in expectedRowCount == actualRowCount
133 in expectedRowCount == actualRowCount
134
134
135spanOpsActuallyFillColumns :: DefaultPic -> Bool
135spanOpsActuallyFillColumns :: DefaultPic -> Bool
test/VerifyUsingMockInput.hs+1−4
@@ -1,6 +1,5 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4-- Generate some input bytes and delays between blocks of input bytes.
3-- Generate some input bytes and delays between blocks of input bytes.
5-- Verify the events produced are as expected.
4-- Verify the events produced are as expected.
6module Main where
5module Main where
@@ -132,9 +131,7 @@ assertEventsFromSynInput table inputSpec expectedEvents = do
132 readLoop 0 = return ()
131 readLoop 0 = return ()
133 readLoop n = do
132 readLoop n = do
134 e <- atomically $ readTChan $ input^.eventChannel
133 e <- atomically $ readTChan $ input^.eventChannel
135− case e of
136− InputEvent ev -> modifyIORef eventsRef ((:) ev)
134+ modifyIORef eventsRef ((:) e)
137− ResumeAfterSignal -> return ()
138 readLoop (n - 1)
135 readLoop (n - 1)
139 genEventsUsingIoActions maxDuration writeWaitClose readEvents
136 genEventsUsingIoActions maxDuration writeWaitClose readEvents
140 outEvents <- reverse <$> readIORef eventsRef
137 outEvents <- reverse <$> readIORef eventsRef
test/interactive_terminal_test.hs+1−1
@@ -364,7 +364,7 @@ Did the test output match the description?
364|]
364|]
365 defaultSuccessConfirmResults
365 defaultSuccessConfirmResults
366
366
367−-- Explicitly define the bytes that encode each example text.
367+-- Explicitely definethe bytes that encode each example text.
368-- This avoids any issues with how the compiler represents string literals.
368-- This avoids any issues with how the compiler represents string literals.
369--
369--
370-- This document is UTF-8 encoded so the UTF-8 string is still included for
370-- This document is UTF-8 encoded so the UTF-8 string is still included for
tools/BuildWidthTable.hsdeleted−144
@@ -1,144 +0,0 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
2−{-# LANGUAGE CPP #-}
3−module Main where
4−
5−import qualified Control.Exception as E
6−import Control.Monad (when)
7−import Data.Maybe (fromMaybe)
8−#if !(MIN_VERSION_base(4,11,0))
9−import Data.Semigroup ((<>))
10−#endif
11−import System.Directory (createDirectoryIfMissing)
12−import System.Environment (getArgs, getProgName)
13−import System.FilePath (takeDirectory)
14−import System.Exit (exitFailure)
15−import System.Console.GetOpt
16−import Text.Read (readMaybe)
17−
18−import Graphics.Vty.Config ( terminalWidthTablePath, currentTerminalName
19− , vtyConfigPath, addConfigWidthMap
20− , ConfigUpdateResult(..)
21− )
22−import Graphics.Vty.UnicodeWidthTable.IO
23−import Graphics.Vty.UnicodeWidthTable.Query
24−
25−data Arg = Help
26− | OutputPath String
27− | TableUpperBound String
28− | UpdateConfig
29− | VtyConfigPath String
30− deriving (Eq, Show)
31−
32−options :: Config -> [OptDescr Arg]
33−options config =
34− [ Option "h" ["help"] (NoArg Help)
35− "This help output"
36− , Option "b" ["bound"] (ReqArg TableUpperBound "MAX_CHAR")
37− ("The maximum Unicode code point to test when building the table " <>
38− "(default: " <> (show $ fromEnum $ configBound config) <> ")")
39− , Option "p" ["path"] (ReqArg OutputPath "PATH")
40− ("The output path to write to (default: " <>
41− fromMaybe "<none>" (configOutputPath config) <> ")")
42− , Option "u" ["update-config"] (NoArg UpdateConfig)
43− "Create or update the Vty configuration file to use the new table (default: no)"
44− , Option "c" ["config-path"] (ReqArg VtyConfigPath "PATH")
45− ("Update the specified Vty configuration file path when -u is set (default: " <>
46− configPath config <> ")")
47− ]
48−
49−data Config =
50− Config { configOutputPath :: Maybe FilePath
51− , configBound :: Char
52− , configUpdate :: Bool
53− , configPath :: FilePath
54− }
55− deriving (Show)
56−
57−mkDefaultConfig :: IO Config
58−mkDefaultConfig = do
59− Config <$> terminalWidthTablePath
60− <*> pure defaultUnicodeTableUpperBound
61− <*> pure False
62− <*> vtyConfigPath
63−
64−usage :: IO ()
65−usage = do
66− config <- mkDefaultConfig
67− pn <- getProgName
68− putStrLn $ "Usage: " <> pn <> " [options]"
69− putStrLn ""
70− putStrLn "This tool queries the terminal on stdout to determine the widths"
71− putStrLn "of Unicode characters rendered to the terminal. The resulting data"
72− putStrLn "is written to a table at the specified output path for later"
73− putStrLn "loading by Vty-based applications."
74− putStrLn ""
75−
76− putStrLn $ usageInfo pn (options config)
77−
78−updateConfigFromArg :: Arg -> Config -> Config
79−updateConfigFromArg Help c =
80− c
81−updateConfigFromArg UpdateConfig c =
82− c { configUpdate = True }
83−updateConfigFromArg (VtyConfigPath p) c =
84− c { configPath = p }
85−updateConfigFromArg (TableUpperBound s) c =
86− case readMaybe s of
87− Nothing -> error $ "Invalid table upper bound: " <> show s
88− Just v -> c { configBound = toEnum v }
89−updateConfigFromArg (OutputPath p) c =
90− c { configOutputPath = Just p }
91−
92−main :: IO ()
93−main = do
94− defConfig <- mkDefaultConfig
95− strArgs <- getArgs
96− let (args, unused, errors) = getOpt Permute (options defConfig) strArgs
97−
98− when (not $ null errors) $ do
99− mapM_ putStrLn errors
100− exitFailure
101−
102− when ((not $ null unused) || (Help `elem` args)) $ do
103− usage
104− exitFailure
105−
106− let config = foldr updateConfigFromArg defConfig args
107−
108− outputPath <- case configOutputPath config of
109− Nothing -> do
110− putStrLn "Error: could not obtain terminal width table path"
111− exitFailure
112− Just path -> return path
113−
114− putStrLn "Querying terminal:"
115− builtTable <- buildUnicodeWidthTable $ configBound config
116−
117− let dir = takeDirectory outputPath
118− createDirectoryIfMissing True dir
119− writeUnicodeWidthTable outputPath builtTable
120−
121− putStrLn $ "\nOutput table written to " <> outputPath
122−
123− when (configUpdate config) $ do
124− let cPath = configPath config
125− Just tName <- currentTerminalName
126−
127− result <- E.try $ addConfigWidthMap cPath tName outputPath
128−
129− case result of
130− Left (e::E.SomeException) -> do
131− putStrLn $ "Error updating Vty configuration at " <> cPath <> ": " <>
132− show e
133− exitFailure
134− Right ConfigurationCreated -> do
135− putStrLn $ "Configuration file created: " <> cPath
136− Right ConfigurationModified -> do
137− putStrLn $ "Configuration file updated: " <> cPath
138− Right (ConfigurationConflict other) -> do
139− putStrLn $ "Configuration file not updated: uses a different table " <>
140− "for TERM=" <> tName <> ": " <> other
141− Right ConfigurationRedundant -> do
142− putStrLn $ "Configuration file not updated: configuration " <>
143− cPath <> " already uses table " <> outputPath <>
144− " for TERM=" <> tName
vty.cabal+67−73
@@ -1,5 +1,5 @@
1name: vty
1name: vty
2−version: 5.35.1
2+version: 5.20
3license: BSD3
3license: BSD3
4license-file: LICENSE
4license-file: LICENSE
5author: AUTHORS
5author: AUTHORS
@@ -24,13 +24,13 @@ description:
24 &#169; Corey O'Connor; BSD3 license.
24 &#169; Corey O'Connor; BSD3 license.
25 .
25 .
26 &#169; Jonathan Daugherty; BSD3 license.
26 &#169; Jonathan Daugherty; BSD3 license.
27−cabal-version: 1.18
27+cabal-version: >= 1.18
28build-type: Simple
28build-type: Simple
29extra-doc-files: README.md,
29extra-doc-files: README.md,
30 AUTHORS,
30 AUTHORS,
31 CHANGELOG.md,
31 CHANGELOG.md,
32 LICENSE
32 LICENSE
33−tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.5
33+tested-with: GHC >= 7.6.2
34
34
35source-repository head
35source-repository head
36 type: git
36 type: git
@@ -45,9 +45,10 @@ library
45 deepseq >= 1.1 && < 1.5,
45 deepseq >= 1.1 && < 1.5,
46 directory,
46 directory,
47 filepath >= 1.0 && < 2.0,
47 filepath >= 1.0 && < 2.0,
48− microlens < 0.4.13,
48+ microlens,
49 microlens-mtl,
49 microlens-mtl,
50 microlens-th,
50 microlens-th,
51+ -- required for nice installation with yi
51 hashable >= 1.2,
52 hashable >= 1.2,
52 mtl >= 1.1.1.0 && < 2.3,
53 mtl >= 1.1.1.0 && < 2.3,
53 parallel >= 2.2 && < 3.3,
54 parallel >= 2.2 && < 3.3,
@@ -58,18 +59,13 @@ library
58 text >= 0.11.3,
59 text >= 0.11.3,
59 unix,
60 unix,
60 utf8-string >= 0.3 && < 1.1,
61 utf8-string >= 0.3 && < 1.1,
61− vector >= 0.7,
62+ vector >= 0.7
62− binary,
63− ansi-terminal >= 0.10.3
64
63
65 if !impl(ghc >= 8.0)
64 if !impl(ghc >= 8.0)
66− build-depends: semigroups >= 0.16,
65+ build-depends: semigroups >= 0.16
67− fail
68
66
69 exposed-modules: Graphics.Vty
67 exposed-modules: Graphics.Vty
70 Graphics.Vty.Attributes
68 Graphics.Vty.Attributes
71− Graphics.Vty.Attributes.Color
72− Graphics.Vty.Attributes.Color240
73 Graphics.Vty.Config
69 Graphics.Vty.Config
74 Graphics.Vty.Error
70 Graphics.Vty.Error
75 Graphics.Vty.Image
71 Graphics.Vty.Image
@@ -80,6 +76,7 @@ library
80 Graphics.Vty.Picture
76 Graphics.Vty.Picture
81 Graphics.Vty.Output
77 Graphics.Vty.Output
82 Graphics.Text.Width
78 Graphics.Text.Width
79+ -- the modules below are only meant to be used by the tests.
83 Codec.Binary.UTF8.Debug
80 Codec.Binary.UTF8.Debug
84 Data.Terminfo.Parse
81 Data.Terminfo.Parse
85 Data.Terminfo.Eval
82 Data.Terminfo.Eval
@@ -100,47 +97,35 @@ library
100 Graphics.Vty.Output.Interface
97 Graphics.Vty.Output.Interface
101 Graphics.Vty.Output.XTermColor
98 Graphics.Vty.Output.XTermColor
102 Graphics.Vty.Output.TerminfoBased
99 Graphics.Vty.Output.TerminfoBased
103− Graphics.Vty.UnicodeWidthTable.Types
104− Graphics.Vty.UnicodeWidthTable.IO
105− Graphics.Vty.UnicodeWidthTable.Query
106− Graphics.Vty.UnicodeWidthTable.Install
107
100
108− other-modules: Graphics.Vty.Debug.Image
101+ other-modules: Graphics.Vty.Attributes.Color
102+ Graphics.Vty.Attributes.Color240
103+ Graphics.Vty.Debug.Image
109 Graphics.Vty.Input.Terminfo.ANSIVT
104 Graphics.Vty.Input.Terminfo.ANSIVT
110
105
111 c-sources: cbits/gwinsz.c
106 c-sources: cbits/gwinsz.c
112 cbits/set_term_timing.c
107 cbits/set_term_timing.c
113− cbits/get_tty_erase.c
114 cbits/mk_wcwidth.c
108 cbits/mk_wcwidth.c
115
109
116 include-dirs: cbits
110 include-dirs: cbits
117
111
118 hs-source-dirs: src
112 hs-source-dirs: src
119
113
114+ default-extensions: ScopedTypeVariables
115+ ForeignFunctionInterface
116+
120 ghc-options: -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10
117 ghc-options: -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10
121
118
122 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10
119 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10
123
120
124−executable vty-build-width-table
125− main-is: BuildWidthTable.hs
126− hs-source-dirs: tools
127−
128− default-language: Haskell2010
129− ghc-options: -threaded -Wall
121+ cc-options: -O2
130−
131− if !impl(ghc >= 8.0)
132− build-depends: semigroups >= 0.16
133−
134− build-depends: vty,
135− directory,
136− filepath,
137− base >= 4.8 && < 5
138
122
139executable vty-mode-demo
123executable vty-mode-demo
140 main-is: ModeDemo.hs
124 main-is: ModeDemo.hs
141 hs-source-dirs: demos
125 hs-source-dirs: demos
142
126
143 default-language: Haskell2010
127 default-language: Haskell2010
128+ default-extensions: ScopedTypeVariables
144 ghc-options: -threaded
129 ghc-options: -threaded
145
130
146 build-depends: vty,
131 build-depends: vty,
@@ -155,6 +140,7 @@ executable vty-demo
155 hs-source-dirs: demos
140 hs-source-dirs: demos
156
141
157 default-language: Haskell2010
142 default-language: Haskell2010
143+ default-extensions: ScopedTypeVariables
158 ghc-options: -threaded
144 ghc-options: -threaded
159
145
160 build-depends: vty,
146 build-depends: vty,
@@ -164,8 +150,29 @@ executable vty-demo
164 microlens-mtl,
150 microlens-mtl,
165 mtl >= 1.1.1.0 && < 2.3
151 mtl >= 1.1.1.0 && < 2.3
166
152
153+test-suite verify-attribute-ops
154+ default-language: Haskell2010
155+ default-extensions: ScopedTypeVariables
156+ type: detailed-0.9
157+ hs-source-dirs: test
158+ test-module: VerifyAttributeOps
159+ build-depends: vty,
160+ Cabal >= 1.20,
161+ QuickCheck >= 2.7,
162+ random >= 1.0 && < 1.2,
163+ base >= 4.8 && < 5,
164+ bytestring,
165+ containers,
166+ deepseq >= 1.1 && < 1.5,
167+ mtl >= 1.1.1.0 && < 2.3,
168+ text >= 0.11.3,
169+ unix,
170+ utf8-string >= 0.3 && < 1.1,
171+ vector >= 0.7
172+
167test-suite verify-using-mock-terminal
173test-suite verify-using-mock-terminal
168 default-language: Haskell2010
174 default-language: Haskell2010
175+ default-extensions: ScopedTypeVariables
169
176
170 type: detailed-0.9
177 type: detailed-0.9
171
178
@@ -184,7 +191,7 @@ test-suite verify-using-mock-terminal
184 build-depends: vty,
191 build-depends: vty,
185 Cabal >= 1.20,
192 Cabal >= 1.20,
186 QuickCheck >= 2.7,
193 QuickCheck >= 2.7,
187− random >= 1.0 && < 1.3,
194+ random >= 1.0 && < 1.2,
188 base >= 4.8 && < 5,
195 base >= 4.8 && < 5,
189 bytestring,
196 bytestring,
190 containers,
197 containers,
@@ -198,6 +205,7 @@ test-suite verify-using-mock-terminal
198
205
199test-suite verify-terminal
206test-suite verify-terminal
200 default-language: Haskell2010
207 default-language: Haskell2010
208+ default-extensions: ScopedTypeVariables
201
209
202 type: detailed-0.9
210 type: detailed-0.9
203
211
@@ -216,7 +224,7 @@ test-suite verify-terminal
216 build-depends: vty,
224 build-depends: vty,
217 Cabal >= 1.20,
225 Cabal >= 1.20,
218 QuickCheck >= 2.7,
226 QuickCheck >= 2.7,
219− random >= 1.0 && < 1.3,
227+ random >= 1.0 && < 1.2,
220 base >= 4.8 && < 5,
228 base >= 4.8 && < 5,
221 bytestring,
229 bytestring,
222 containers,
230 containers,
@@ -230,6 +238,7 @@ test-suite verify-terminal
230
238
231test-suite verify-display-attributes
239test-suite verify-display-attributes
232 default-language: Haskell2010
240 default-language: Haskell2010
241+ default-extensions: ScopedTypeVariables
233
242
234 type: detailed-0.9
243 type: detailed-0.9
235
244
@@ -248,7 +257,7 @@ test-suite verify-display-attributes
248 build-depends: vty,
257 build-depends: vty,
249 Cabal >= 1.20,
258 Cabal >= 1.20,
250 QuickCheck >= 2.7,
259 QuickCheck >= 2.7,
251− random >= 1.0 && < 1.3,
260+ random >= 1.0 && < 1.2,
252 base >= 4.8 && < 5,
261 base >= 4.8 && < 5,
253 bytestring,
262 bytestring,
254 containers,
263 containers,
@@ -261,6 +270,7 @@ test-suite verify-display-attributes
261
270
262test-suite verify-empty-image-props
271test-suite verify-empty-image-props
263 default-language: Haskell2010
272 default-language: Haskell2010
273+ default-extensions: ScopedTypeVariables
264
274
265 type: detailed-0.9
275 type: detailed-0.9
266
276
@@ -273,7 +283,7 @@ test-suite verify-empty-image-props
273 build-depends: vty,
283 build-depends: vty,
274 Cabal >= 1.20,
284 Cabal >= 1.20,
275 QuickCheck >= 2.7,
285 QuickCheck >= 2.7,
276− random >= 1.0 && < 1.3,
286+ random >= 1.0 && < 1.2,
277 base >= 4.8 && < 5,
287 base >= 4.8 && < 5,
278 bytestring,
288 bytestring,
279 containers,
289 containers,
@@ -286,6 +296,7 @@ test-suite verify-empty-image-props
286
296
287test-suite verify-eval-terminfo-caps
297test-suite verify-eval-terminfo-caps
288 default-language: Haskell2010
298 default-language: Haskell2010
299+ default-extensions: ScopedTypeVariables
289
300
290 type: detailed-0.9
301 type: detailed-0.9
291
302
@@ -299,7 +310,7 @@ test-suite verify-eval-terminfo-caps
299 build-depends: vty,
310 build-depends: vty,
300 Cabal >= 1.20,
311 Cabal >= 1.20,
301 QuickCheck >= 2.7,
312 QuickCheck >= 2.7,
302− random >= 1.0 && < 1.3,
313+ random >= 1.0 && < 1.2,
303 base >= 4.8 && < 5,
314 base >= 4.8 && < 5,
304 blaze-builder >= 0.3.3.2 && < 0.5,
315 blaze-builder >= 0.3.3.2 && < 0.5,
305 bytestring,
316 bytestring,
@@ -314,6 +325,7 @@ test-suite verify-eval-terminfo-caps
314
325
315test-suite verify-image-ops
326test-suite verify-image-ops
316 default-language: Haskell2010
327 default-language: Haskell2010
328+ default-extensions: ScopedTypeVariables
317
329
318 type: detailed-0.9
330 type: detailed-0.9
319
331
@@ -328,7 +340,7 @@ test-suite verify-image-ops
328 build-depends: vty,
340 build-depends: vty,
329 Cabal >= 1.20,
341 Cabal >= 1.20,
330 QuickCheck >= 2.7,
342 QuickCheck >= 2.7,
331− random >= 1.0 && < 1.3,
343+ random >= 1.0 && < 1.2,
332 base >= 4.8 && < 5,
344 base >= 4.8 && < 5,
333 bytestring,
345 bytestring,
334 containers,
346 containers,
@@ -341,6 +353,7 @@ test-suite verify-image-ops
341
353
342test-suite verify-image-trans
354test-suite verify-image-trans
343 default-language: Haskell2010
355 default-language: Haskell2010
356+ default-extensions: ScopedTypeVariables
344
357
345 type: detailed-0.9
358 type: detailed-0.9
346
359
@@ -355,7 +368,7 @@ test-suite verify-image-trans
355 build-depends: vty,
368 build-depends: vty,
356 Cabal >= 1.20,
369 Cabal >= 1.20,
357 QuickCheck >= 2.7,
370 QuickCheck >= 2.7,
358− random >= 1.0 && < 1.3,
371+ random >= 1.0 && < 1.2,
359 base >= 4.8 && < 5,
372 base >= 4.8 && < 5,
360 bytestring,
373 bytestring,
361 containers,
374 containers,
@@ -368,6 +381,7 @@ test-suite verify-image-trans
368
381
369test-suite verify-inline
382test-suite verify-inline
370 default-language: Haskell2010
383 default-language: Haskell2010
384+ default-extensions: ScopedTypeVariables
371
385
372 type: detailed-0.9
386 type: detailed-0.9
373
387
@@ -381,7 +395,7 @@ test-suite verify-inline
381 build-depends: vty,
395 build-depends: vty,
382 Cabal >= 1.20,
396 Cabal >= 1.20,
383 QuickCheck >= 2.7,
397 QuickCheck >= 2.7,
384− random >= 1.0 && < 1.3,
398+ random >= 1.0 && < 1.2,
385 base >= 4.8 && < 5,
399 base >= 4.8 && < 5,
386 bytestring,
400 bytestring,
387 containers,
401 containers,
@@ -394,6 +408,7 @@ test-suite verify-inline
394
408
395test-suite verify-parse-terminfo-caps
409test-suite verify-parse-terminfo-caps
396 default-language: Haskell2010
410 default-language: Haskell2010
411+ default-extensions: ScopedTypeVariables
397
412
398 type: detailed-0.9
413 type: detailed-0.9
399
414
@@ -408,7 +423,7 @@ test-suite verify-parse-terminfo-caps
408 build-depends: vty,
423 build-depends: vty,
409 Cabal >= 1.20,
424 Cabal >= 1.20,
410 QuickCheck >= 2.7,
425 QuickCheck >= 2.7,
411− random >= 1.0 && < 1.3,
426+ random >= 1.0 && < 1.2,
412 base >= 4.8 && < 5,
427 base >= 4.8 && < 5,
413 bytestring,
428 bytestring,
414 containers,
429 containers,
@@ -422,6 +437,7 @@ test-suite verify-parse-terminfo-caps
422
437
423test-suite verify-simple-span-generation
438test-suite verify-simple-span-generation
424 default-language: Haskell2010
439 default-language: Haskell2010
440+ default-extensions: ScopedTypeVariables
425
441
426 type: detailed-0.9
442 type: detailed-0.9
427
443
@@ -439,7 +455,7 @@ test-suite verify-simple-span-generation
439 build-depends: vty,
455 build-depends: vty,
440 Cabal >= 1.20,
456 Cabal >= 1.20,
441 QuickCheck >= 2.7,
457 QuickCheck >= 2.7,
442− random >= 1.0 && < 1.3,
458+ random >= 1.0 && < 1.2,
443 base >= 4.8 && < 5,
459 base >= 4.8 && < 5,
444 bytestring,
460 bytestring,
445 containers,
461 containers,
@@ -453,6 +469,7 @@ test-suite verify-simple-span-generation
453
469
454test-suite verify-crop-span-generation
470test-suite verify-crop-span-generation
455 default-language: Haskell2010
471 default-language: Haskell2010
472+ default-extensions: ScopedTypeVariables
456
473
457 type: detailed-0.9
474 type: detailed-0.9
458
475
@@ -470,7 +487,7 @@ test-suite verify-crop-span-generation
470 build-depends: vty,
487 build-depends: vty,
471 Cabal >= 1.20,
488 Cabal >= 1.20,
472 QuickCheck >= 2.7,
489 QuickCheck >= 2.7,
473− random >= 1.0 && < 1.3,
490+ random >= 1.0 && < 1.2,
474 base >= 4.8 && < 5,
491 base >= 4.8 && < 5,
475 bytestring,
492 bytestring,
476 containers,
493 containers,
@@ -484,6 +501,7 @@ test-suite verify-crop-span-generation
484
501
485test-suite verify-layers-span-generation
502test-suite verify-layers-span-generation
486 default-language: Haskell2010
503 default-language: Haskell2010
504+ default-extensions: ScopedTypeVariables
487
505
488 type: detailed-0.9
506 type: detailed-0.9
489
507
@@ -501,32 +519,7 @@ test-suite verify-layers-span-generation
501 build-depends: vty,
519 build-depends: vty,
502 Cabal >= 1.20,
520 Cabal >= 1.20,
503 QuickCheck >= 2.7,
521 QuickCheck >= 2.7,
504− random >= 1.0 && < 1.3,
522+ random >= 1.0 && < 1.2,
505− base >= 4.8 && < 5,
506− bytestring,
507− containers,
508− deepseq >= 1.1 && < 1.5,
509− mtl >= 1.1.1.0 && < 2.3,
510− text >= 0.11.3,
511− unix,
512− utf8-string >= 0.3 && < 1.1,
513− vector >= 0.7
514−
515−test-suite verify-color-mapping
516− default-language: Haskell2010
517−
518− type: detailed-0.9
519−
520− hs-source-dirs: test
521−
522− test-module: VerifyColor240
523−
524− other-modules: Verify
525−
526− build-depends: vty,
527− Cabal >= 1.20,
528− QuickCheck >= 2.7,
529− random >= 1.0 && < 1.3,
530 base >= 4.8 && < 5,
523 base >= 4.8 && < 5,
531 bytestring,
524 bytestring,
532 containers,
525 containers,
@@ -539,6 +532,7 @@ test-suite verify-color-mapping
539
532
540test-suite verify-utf8-width
533test-suite verify-utf8-width
541 default-language: Haskell2010
534 default-language: Haskell2010
535+ default-extensions: ScopedTypeVariables
542
536
543 type: detailed-0.9
537 type: detailed-0.9
544
538
@@ -551,7 +545,7 @@ test-suite verify-utf8-width
551 build-depends: vty,
545 build-depends: vty,
552 Cabal >= 1.20,
546 Cabal >= 1.20,
553 QuickCheck >= 2.7,
547 QuickCheck >= 2.7,
554− random >= 1.0 && < 1.3,
548+ random >= 1.0 && < 1.2,
555 base >= 4.8 && < 5,
549 base >= 4.8 && < 5,
556 bytestring,
550 bytestring,
557 containers,
551 containers,
@@ -564,6 +558,7 @@ test-suite verify-utf8-width
564
558
565test-suite verify-using-mock-input
559test-suite verify-using-mock-input
566 default-language: Haskell2010
560 default-language: Haskell2010
561+ default-extensions: ScopedTypeVariables
567
562
568 type: exitcode-stdio-1.0
563 type: exitcode-stdio-1.0
569
564
@@ -571,8 +566,6 @@ test-suite verify-using-mock-input
571
566
572 main-is: VerifyUsingMockInput.hs
567 main-is: VerifyUsingMockInput.hs
573
568
574− other-modules: Verify.Graphics.Vty.Output
575−
576 build-depends: vty,
569 build-depends: vty,
577 Cabal >= 1.20,
570 Cabal >= 1.20,
578 QuickCheck >= 2.7,
571 QuickCheck >= 2.7,
@@ -580,7 +573,7 @@ test-suite verify-using-mock-input
580 quickcheck-assertions >= 0.1.1,
573 quickcheck-assertions >= 0.1.1,
581 test-framework == 0.8.*,
574 test-framework == 0.8.*,
582 test-framework-smallcheck == 0.2.*,
575 test-framework-smallcheck == 0.2.*,
583− random >= 1.0 && < 1.3,
576+ random >= 1.0 && < 1.2,
584 base >= 4.8 && < 5,
577 base >= 4.8 && < 5,
585 bytestring,
578 bytestring,
586 containers,
579 containers,
@@ -599,6 +592,7 @@ test-suite verify-using-mock-input
599
592
600test-suite verify-config
593test-suite verify-config
601 default-language: Haskell2010
594 default-language: Haskell2010
595+ default-extensions: ScopedTypeVariables
602
596
603 type: exitcode-stdio-1.0
597 type: exitcode-stdio-1.0
604
598
@@ -615,7 +609,7 @@ test-suite verify-config
615 test-framework == 0.8.*,
609 test-framework == 0.8.*,
616 test-framework-smallcheck == 0.2.*,
610 test-framework-smallcheck == 0.2.*,
617 test-framework-hunit,
611 test-framework-hunit,
618− random >= 1.0 && < 1.3,
612+ random >= 1.0 && < 1.2,
619 base >= 4.8 && < 5,
613 base >= 4.8 && < 5,
620 bytestring,
614 bytestring,
621 containers,
615 containers,