2438c54...master · vty

git.iko.soy/vty

63 files changed+3747−1367

since splitsnapshots

unifiedsplit

.gitignore+1

@@ -6,6 +6,7 @@ Setup

66dist

77dist-newstyle

88cabal.project.local

9+.ghc.environment.*

910test/benchmark

1011.hpc

1112.cabal-sandbox

.travis.yml+100−17

@@ -1,26 +1,109 @@

1−language: haskell

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

8+sudo: false

3−notifications:

4− email: false

10+git:

11+ submodules: false # whether to recursively clone submodules

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

528

629matrix:

7− allow_failures:

8− - env: CABALVER=head GHCVER=head

30+ include:

31+ - compiler: "ghc-8.4.3"

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]}}

943

10−env:

11− - CABALVER=1.22 GHCVER=7.10.1

12− - CABALVER=1.24 GHCVER=8.0.1

13− - CABALVER=1.24 GHCVER=8.0.2

14− - CABALVER=head GHCVER=head

44+before_install:

45+ - HC=${CC}

46+ - HCPKG=${HC/ghc/ghc-pkg}

47+ - unset CC

48+ - ROOTDIR=$(pwd)

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

1553

1654install:

17− - ./ci/travis_ci_install

55+ - cabal --version

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)

1880

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.

1983script:

20− - ./ci/travis_ci_script

84+ # test that source-distributions can be generated

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

2196

22−before_install:

23− - sudo add-apt-repository -y ppa:hvr/ghc

24− - sudo apt-get update

25− - sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER

26− - export PATH=/opt/ghc/$GHCVER/bin:$PATH

97+ # build & run tests, build benchmarks

98+ - cabal new-build -w ${HC} ${TEST} ${BENCH} all

99+ - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi

100+

101+ # haddock

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+777−344

@@ -1,428 +1,861 @@

2+5.35.1

3+------

5+Bug fixes:

6+ * Fixed a build issue with a test program.

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+

280+5.20

281+----

282+

283+API changes:

284+* Split up Monoid instances into Monoid and Semigroup for newer GHCs

285+ (thanks Ryan Scott)

286+

287+5.19.1

288+------

289+

290+API changes:

291+* Cursor now provides an Eq instance (thanks Jaro Reinders)

292+

293+5.19

294+----

295+

296+API changes:

297+* URL hyperlinking (via 'withURL') is now optional and disabled by

298+ default due to poor support on some common terminals. A new 'Mode'

299+ constructor, 'Hyperlink', has been added to enable this feature. To

300+ change the hyperlinking mode, use 'setMode' on the 'outputIface' of a

301+ Vty handle.

302+

303+5.18.1

304+------

305+

306+Bug fixes:

307+* Reset the hyperlink state on line endings to avoid run-on hyperlinks

308+

309+5.18

310+----

311+

312+API changes:

313+* Added support for hyperlinking attributes (thanks Getty Ritter). This

314+ change adds a new Attr field for containing the hyperlink to apply,

315+ as per https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda

316+

317+5.17.1

318+------

319+

320+* withStyle now ignores zero arguments, leaving attribute styles

321+ untouched if the input style is the null style

322+

323+5.17

324+----

325+

326+API changes:

327+* Add support for terminal focus events. This change adds a new mode

328+ usable with setMode, Focus, that requests that the terminal send

329+ events on focus lose/gain. This change also adds two new Event

330+ constructors, EvLostFocus and EvGainedFocus.

331+* No longer enable UTF8 mouse event encoding. This encoding was not

332+ working properly with Terminal.app, and using the other modes (SGR,

333+ etc.) work.

334+* Graphics.Vty.Attributes: escape backticks in Haddock comment (fixes

335+ #131)

336+

337+5.16

338+----

339+

340+API changes:

341+* Added support for mouse wheel events while in mouse mode. The Button

342+ type got two new constructors as a result: BScrollUp and BScrollDown.

343+ Thanks to doublescale@tutanota.com for this contribution!

344+

345+Bug fixes:

346+* charFill now clamps negative arguments to zero (thanks Eric Mertens!)

347+

348+5.15.1

349+------

350+

351+Package changes:

352+* Documentation files are now marked accordingly (thanks Michal

353+ Suchánek)

354+

355+Bug fixes:

356+* translateX/Y: fix negative translations

357+

13585.15

359+----

360+

2361Package changes:

3− - Discontinued support for GHC versions prior to 7.10.1.

4− - Removed instructions and configuration for Stack builds since they

5− are no longer supported.

6− - Clarified README mention of (lack of) Windows support (contributors

7− wanted, though!)

8− - Removed dependency on data-default (see below).

362+* Discontinued support for GHC versions prior to 7.10.1.

363+* Removed instructions and configuration for Stack builds since they

364+ are no longer supported.

365+* Clarified README mention of (lack of) Windows support (contributors

366+ wanted, though!)

367+* Removed dependency on data-default (see below).

9368

10369API changes:

11− - Moved color definitions from Attributes to Color module.

12− - In lieu of data-default (Default) instances for Attr and Config, use

13− 'defAttr' and the new 'defaultConfig' (or 'mempty') instead of 'def'.

14− - Graphics.Vty.Output no longer re-exports

15− Graphics.Vty.Output.Interface.

16− - Removed Graphics.Vty.Prelude module and moved DisplayRegion and its

17− accessors to Graphics.Vty.Image.

18− - Graphics.Vty.Image no longer re-exports Graphics.Vty.Attributes.

19− - Graphics.Vty.Picture no longer re-exports Graphics.Vty.Image.

370+* Moved color definitions from Attributes to Color module.

371+* In lieu of data-default (Default) instances for Attr and Config, use

372+ 'defAttr' and the new 'defaultConfig' (or 'mempty') instead of 'def'.

373+* Graphics.Vty.Output no longer re-exports

374+ Graphics.Vty.Output.Interface.

375+* Removed Graphics.Vty.Prelude module and moved DisplayRegion and its

376+ accessors to Graphics.Vty.Image.

377+* Graphics.Vty.Image no longer re-exports Graphics.Vty.Attributes.

378+* Graphics.Vty.Picture no longer re-exports Graphics.Vty.Image.

20379

213805.14

22− - addMaybeClippedJoin: instead of raising an exception when the join

23− is totally clipped, just reduce the clip amount and continue

24− - addMaybeClipped: skip blit of joins when their primary dimension is

25− zero

26− - 'string' and related text functions no longer treat an empty string

27− as an empty image (thanks Chris Penner). This means that now it is

28− possible to use 'str ""' as a non-empty image with height 1.

381+----

382+

383+* addMaybeClippedJoin: instead of raising an exception when the join

384+ is totally clipped, just reduce the clip amount and continue

385+* addMaybeClipped: skip blit of joins when their primary dimension is

386+ zero

387+* '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

389+ possible to use 'str ""' as a non-empty image with height 1.

29390

303915.13

31− - Reverted changes in 5.12 due to disagreements between terminal

32− emulators and utf8proc; for more details, please see the ticket

33− discussion at

34− https://github.com/coreyoconnor/vty/issues/115

392+----

393+

394+* Reverted changes in 5.12 due to disagreements between terminal

395+ emulators and utf8proc; for more details, please see the ticket

396+ discussion at

397+ https://github.com/coreyoconnor/vty/issues/115

35398

363995.12

37− - Replaced 'wcwidth' with a call to the utf8proc library's character

38− width function, which is much more up to date (by several Unicode

39− versions) and returns the right width for a much larger set of

40− characters.

41− - Added a bundled version of the utf8proc C library.

400+----

401+

402+* Replaced 'wcwidth' with a call to the utf8proc library's character

403+ 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

405+ characters.

406+* Added a bundled version of the utf8proc C library.

42407

434085.11.3

44− - Fix mouse event offsets in mouse-up events

409+------

410+

411+* Fix mouse event offsets in mouse-up events

45412

464135.11.2

47− - Mouse events were modified so that the upper-left corner of the

48− window is (0,0) rather than (1,1).

414+------

415+

416+* Mouse events were modified so that the upper-left corner of the window

417+ is (0,0) rather than (1,1).

49418

504195.11.1

51− - Add Generic instance for Image

52− - nextEvent: stop trying to refresh on a resize event (fixes segfault

53− on refresh with normal cursor positioning mode)

54− - Remove redundant clause from clipForCharWidth (thanks Eric Mertens)

55− - Update maintainer

420+------

421+

422+* Add Generic instance for Image

423+* nextEvent: stop trying to refresh on a resize event (fixes segfault

424+ on refresh with normal cursor positioning mode)

425+* Remove redundant clause from clipForCharWidth (thanks Eric Mertens)

426+* Update maintainer

56427

574285.11

58− - Vty now raises a VtyConfigurationError exception when the TERM

59− evironment variable is missing (thanks Eric Mertens)

60− - Graphics.Vty.Config got an explicit export list to avoid accidentally

61− exporting internal types (thanks Eric Mertens)

429+----

430+

431+* Vty now raises a VtyConfigurationError exception when the TERM

432+ evironment variable is missing (thanks Eric Mertens)

433+* Graphics.Vty.Config got an explicit export list to avoid accidentally

434+ exporting internal types (thanks Eric Mertens)

62435

634365.10

64− - Add absolute cursor positioning mode AbsoluteCursor to Cursor. This

65− mode provides greater control over cursor positioning by bypassing

66− the logical positioning provided by default. Rather than positioning

67− the cursor by looking at the widths of characters involved, this

68− constructor lets you provide a physical row and column instead. This

69− is useful in more sophisticated programs. (thanks Eric Mertens)

70− - Added a new Generic-derived config parser (thanks Eric Mertens)

71− - Fixed the MShift case in the configuration file parser (thanks Eric

72− Mertens)

73− - Fixed wcwidth import and matched safeWcswidth to its documented

74− behavior. Previously vty_mk_wcwidth was being imported with

75− the wrong type causing the -1 return value to be mapped to the

76− wrong Int value. Additionally safeWcswidth was using the unsafe

77− character width function and only ensuring that the final result was

78− non-negative. (thanks Eric Mertens)

437+----

438+

439+* Add absolute cursor positioning mode AbsoluteCursor to Cursor. This

440+ mode provides greater control over cursor positioning by bypassing

441+ the logical positioning provided by default. Rather than positioning

442+ the cursor by looking at the widths of characters involved, this

443+ constructor lets you provide a physical row and column instead. This

444+ is useful in more sophisticated programs. (thanks Eric Mertens)

445+* Added a new Generic-derived config parser (thanks Eric Mertens)

446+* Fixed the MShift case in the configuration file parser (thanks Eric

447+ Mertens)

448+* Fixed wcwidth import and matched safeWcswidth to its documented

449+ behavior. Previously vty_mk_wcwidth was being imported with the

450+ wrong type causing the -1 return value to be mapped to the wrong Int

451+ value. Additionally safeWcswidth was using the unsafe character width

452+ function and only ensuring that the final result was non-negative.

453+ (thanks Eric Mertens)

79454

804555.9.1

81− - Vty now only emits UTF8 charset sequences in terminals without a

82− preexisting UTF8 declaration to avoid emitting garbage sequences

83− (fixes #89)

456+-----

457+

458+* Vty now only emits UTF8 charset sequences in terminals without a

459+ preexisting UTF8 declaration to avoid emitting garbage sequences

460+ (fixes #89)

84461

854625.9

86− - Added new Output methods supportsBell and ringTerminalBell to find

87− out whether the output device has an audio bell and to ring it (see

88− #102)

463+---

464+

465+* Added new Output methods supportsBell and ringTerminalBell to find out

466+ whether the output device has an audio bell and to ring it (see #102)

89467

904685.8.1

91− - Fixed "refresh" to work as advertised (see #104)

469+-----

470+

471+* Fixed "refresh" to work as advertised (see #104)

92472

934735.8

94− - API change: EvPaste input event now provides paste data as a raw

95− ByteString rather than a String to allow the application to decode

96− how best to decode it

474+---

475+

476+* 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

478+ best to decode it

97479

984805.7.1

99− - ModeDemo: added an explicit Control.Applicative import for older

100− GHCs

481+-----

482+

483+* ModeDemo: added an explicit Control.Applicative import for older GHCs

101484

1024855.7

103− - Mouse and paste modes are now off by default.

104− - The Config type got new fields: mouseMode and bracketedPasteMode.

105− These determine whether these modes are enabled initially (for

106− terminals that support them).

107− - Added a Mode type for modal terminal features (mouse events,

108− bracketed paste mode) that is used with new Output interface

109− functions:

110− * supportsMode :: Mode -> Bool tells whether the device supports a

111− mode

112− * setMode :: Mode -> Bool -> IO () turns a mode on or off

113− * getModeStatus :: Mode -> IO Bool tells you whether a mode is on or

114− off

115− - Added a new demo program, ModeDemo.hs, to demonstrate usage of modes

486+---

487+

488+* Mouse and paste modes are now off by default.

489+* The Config type got new fields: mouseMode and bracketedPasteMode.

490+ These determine whether these modes are enabled initially (for

491+ terminals that support them).

492+* Added a Mode type for modal terminal features (mouse events,

493+ bracketed paste mode) that is used with new Output interface

494+ functions:

495+ * supportsMode :: Mode -> Bool tells whether the device supports a

496+ mode

497+ * setMode :: Mode -> Bool -> IO () turns a mode on or off

498+ * getModeStatus :: Mode -> IO Bool tells you whether a mode is on or

499+ off

500+* Added a new demo program, ModeDemo.hs, to demonstrate usage of modes

116501

1175025.6

118− - Added support for normal and extended mouse modes in Xterm-like

119− terminals via the MouseDown and MouseUp Event constructors

120− - Added support for bracketed paste mode in Xterm-like terminals via

121− the EvPaste event constructor

122− - Added derived Show instances for Event and Button (thanks Felix

123− Hirn)

124− - Now TERM values containing "screen" will automatically use the

125− XtermColor driver rather than just TerminfoBased

503+---

504+

505+* Added support for normal and extended mouse modes in Xterm-like

506+ terminals via the MouseDown and MouseUp Event constructors

507+* Added support for bracketed paste mode in Xterm-like terminals via

508+ the EvPaste event constructor

509+* Added derived Show instances for Event and Button (thanks Felix

510+ Hirn)

511+* Now TERM values containing "screen" will automatically use the

512+ XtermColor driver rather than just TerminfoBased

126513

1275145.5.0

128− - Replaced lens dependency with microlens, microlens-mtl, microlens-th

129− dependencies. Issue #90

130− - Thanks Jonathan Daugherty

131− - Cabal corrections.

132− - Thanks Lennart Spitzner

515+-----

516+

517+* Replaced lens dependency with microlens, microlens-mtl, microlens-th

518+ dependencies. Issue #90

519+ * Thanks Jonathan Daugherty

520+* Cabal corrections.

521+ * Thanks Lennart Spitzner

133522

1345235.4.0

135− - Changed eventChannel of Graphics.Vty.Input from Chan to TChan.

136− This enables clients to query if there are no pending events. The

137− Graphics.Vty interface nextEvent is unchanged. Clients that use

138− eventChannel directly will require updating.

139− https://github.com/coreyoconnor/vty/issues/60

524+-----

525+

526+* Changed eventChannel of Graphics.Vty.Input from Chan to

527+ TChan. This enables clients to query if there are no pending

528+ events. The Graphics.Vty interface nextEvent is unchanged.

529+ Clients that use eventChannel directly will require updating.

530+ https://github.com/coreyoconnor/vty/issues/60

531+

1405325.3.1

141− - Reverted cabal file to depend on Cabal >= 1.18 instead of 1.20 due

142− to possibly breaking this on reasonable GHC versions

533+-----

534+

535+* Reverted cabal file to depend on Cabal >= 1.18 instead of 1.20 due to

536+ possibly breaking this on reasonable GHC versions

143537

1445385.3

145− - Upgraded QuickCheck dependency to 2.7

146− - The standard IO Config (standardIOConfig) was overriding any

147− provided application config. In addition, the inputFd and outputFd

148− could not be changed if mkVty was used. Fixed.

149− - Correct handling of display attributes at end of line. The output

150− attributes are set to default at the end of content for the line and

151− at the start of a new line. Previously the current attribute would

152− extend to the next start of content. This was odd to reason about

153− and was the cause of https://github.com/coreyoconnor/vty/issues/76

154− IIRC Yi requires the old behavior to display the selection region

155− correctly.

156− - shutdown of the input thread is now performed using killThread and

157− synchronization on an MVar. For correct handling of the terminal

158− read vmin and vtime the read must be a blocking read on an OS

159− thread. This places a threadWaitRead, which will be interrupted by

160− the killThread, prior to the uninterruptable read. An alternative

161− would be to re-import the read foreign call as interruptable.

539+---

540+

541+* Upgraded QuickCheck dependency to 2.7

542+* The standard IO Config (standardIOConfig) was overriding any provided

543+ application config. In addition, the inputFd and outputFd could not be

544+ changed if mkVty was used. Fixed.

545+* 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

547+ 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

549+ was the cause of https://github.com/coreyoconnor/vty/issues/76 IIRC Yi

550+ requires the old behavior to display the selection region correctly.

551+* shutdown of the input thread is now performed using killThread and

552+ synchronization on an MVar. For correct handling of the terminal read

553+ vmin and vtime the read must be a blocking read on an OS thread.

554+ This places a threadWaitRead, which will be interrupted by the

555+ killThread, prior to the uninterruptable read. An alternative would be

556+ to re-import the read foreign call as interruptable.

162557

1635585.2.11

164− - deepseq bounds increased for tests.

165− - Clean up warnings when compiling on 7.10

166− - Thanks Eric Mertens

167− - Avoid discarding input bytes after multi-byte encoded codepoint

168− - Thanks Eric Mertens

559+------

560+

561+* deepseq bounds increased for tests.

562+* Clean up warnings when compiling on 7.10

563+ * Thanks Eric Mertens

564+* Avoid discarding input bytes after multi-byte encoded codepoint

565+ * Thanks Eric Mertens

169566

1705675.2.10

171− - "str" now returns EmptyImage for empty strings to match behavior of

172− other string-like Image constructors (fixes #74)

173− - Thanks Jonathan Daugherty

568+------

569+

570+* "str" now returns EmptyImage for empty strings to match behavior of

571+ other string-like Image constructors (fixes #74)

572+ * Thanks Jonathan Daugherty

174573

1755745.2.9

176− - dependency version bumps

177− - https://github.com/coreyoconnor/vty/pull/71

178− - https://github.com/coreyoconnor/vty/pull/70

179− - Correct/Simplify the example code

180− - Thanks glguy

181− - https://github.com/coreyoconnor/vty/pull/69

575+-----

576+

577+* dependency version bumps

578+ * https://github.com/coreyoconnor/vty/pull/71

579+ * https://github.com/coreyoconnor/vty/pull/70

580+* Correct/Simplify the example code

581+ * Thanks glguy

582+ * https://github.com/coreyoconnor/vty/pull/69

182583

1835845.2.8

184− - blaze-builder, lens, utf8-string version constraint bump

185− - Thanks glguy

186− - https://github.com/coreyoconnor/vty/pull/67

187− - Do not differentiate based on TERM_PROGRAM

188− - https://github.com/coreyoconnor/vty/issues/68

585+-----

586+

587+* blaze-builder, lens, utf8-string version constraint bump

588+ * Thanks glguy

589+ * https://github.com/coreyoconnor/vty/pull/67

590+* Do not differentiate based on TERM_PROGRAM

591+ * https://github.com/coreyoconnor/vty/issues/68

189592

1905935.2.7

191− - lens and deepseq constraint bump + misc

192− - Thanks ethercrow

193− - https://github.com/coreyoconnor/vty/pull/66

594+-----

595+

596+* lens and deepseq constraint bump + misc

597+ * Thanks ethercrow

598+ * https://github.com/coreyoconnor/vty/pull/66

194599

1956005.2.6

196− - lens constraint bump

197− - Thanks alexander-b!

198− - https://github.com/coreyoconnor/vty/pull/64

601+-----

602+

603+* lens constraint bump

604+ * Thanks alexander-b!

605+ * https://github.com/coreyoconnor/vty/pull/64

199606

2006075.2.5

201− - lens and random version constraint bump.

202− - Thanks RyanGlScott!

203− - https://github.com/coreyoconnor/vty/pull/62

608+-----

609+

610+* lens and random version constraint bump.

611+ * Thanks RyanGlScott!

612+ * https://github.com/coreyoconnor/vty/pull/62

204613

2056145.2.4

206− - removed -fpic from cc-options. No longer required.

207− - https://github.com/coreyoconnor/vty/issues/61

208− - https://ghc.haskell.org/trac/ghc/ticket/9657

209− - Thanks Fuuzetsu!

615+-----

616+

617+* removed -fpic from cc-options. No longer required.

618+ * https://github.com/coreyoconnor/vty/issues/61

619+ * https://ghc.haskell.org/trac/ghc/ticket/9657

620+ * Thanks Fuuzetsu!

210621

2116225.2.3

212− - evaluate/compile the input parsing table once instead of each

213− keystroke.

214− - https://github.com/coreyoconnor/vty/pull/59

215− - Thanks ethercrow!

623+-----

624+

625+* evaluate/compile the input parsing table once instead of each

626+ keystroke.

627+ * https://github.com/coreyoconnor/vty/pull/59

628+ * Thanks ethercrow!

216629

2176305.2.2

218− - When looking at input for an event, don't look too deep.

219− - https://github.com/coreyoconnor/vty/pull/57

220− - Thanks ethercrow!

631+-----

632+

633+* When looking at input for an event, don't look too deep.

634+ * https://github.com/coreyoconnor/vty/pull/57

635+ * Thanks ethercrow!

221636

2226375.2.1

223− - Bump upper version bound for lens to 4.5. Thanks markus1189!

638+-----

639+

640+* Bump upper version bound for lens to 4.5. Thanks markus1189!

224641

2256425.2.0

226− - Config structure now specifies file descriptor to use. The default

227− is stdInput and stdOutput file descriptors. Previously Vty used

228− stdInput for input and the follow code for output:

229− - hDuplicate stdout >>= handleToFd >>= (`hSetBuffering`

230− NoBuffering)

231− - the difference was required by Vty.Inline. Now, Vty.Inline uses

232− the Config structure options to acheive the same effect.

233− - removed: derivedVtime, derivedVmin, inputForCurrentTerminal,

234− inputForNameAndIO, outputForCurrentTerminal, outputForNameAndIO

235− - added: inputForConfig, outputForConfig

236− - updates to vty-rogue from jtdaugherty. Thanks!

237− - the oldest version of GHC tested to support vty is 7.6.2.

238− - the oldest version of GHC that vty compiles under is 7.4.2

643+-----

644+

645+* Config structure now specifies file descriptor to use. The default

646+ is stdInput and stdOutput file descriptors. Previously Vty used

647+ stdInput for input and the follow code for output:

648+ * hDuplicate stdout >>= handleToFd >>= (`hSetBuffering`

649+ NoBuffering)

650+ * the difference was required by Vty.Inline. Now, Vty.Inline uses

651+ the Config structure options to acheive the same effect.

652+* removed: derivedVtime, derivedVmin, inputForCurrentTerminal,

653+ inputForNameAndIO, outputForCurrentTerminal, outputForNameAndIO

654+* added: inputForConfig, outputForConfig

655+* updates to vty-rogue from jtdaugherty. Thanks!

656+* 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

239658

2406595.1.4

241− - merged https://github.com/coreyoconnor/vty/pull/51 thanks trofi!

660+-----

661+

662+* merged https://github.com/coreyoconnor/vty/pull/51 thanks trofi!

242663

2436645.1.1

244− - merged https://github.com/coreyoconnor/vty/pull/48 thanks sjmielke!

245− - jtdaugherty resolved a number of compiler warnings. Thanks!

665+-----

666+

667+* merged https://github.com/coreyoconnor/vty/pull/48 thanks sjmielke!

668+* jtdaugherty resolved a number of compiler warnings. Thanks!

246669

2476705.1.0

248− - vmin and vtime can be specified however the application requires.

249− See Graphics.Vty.Config.

250− - fixed the processing of input when vmin is set > 1.

671+-----

672+

673+* vmin and vtime can be specified however the application requires.

674+ See Graphics.Vty.Config.

675+* fixed the processing of input when vmin is set > 1.

251676

2526775.0.0

253− - The naming convention now matches:

254− - http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions

255− - all projects using vty for input must be compiled with -threaded.

256− Please notify vty author if this is not acceptable.

257− - mkVtyEscDelay has been removed. Use "mkVty def". Which initialized

258− vty with the default configuration.

259− - input handling changes

260− - KASCII is now KChar

261− - KPN5 is now KCenter

262− - tests exist.

263− - Applications can add to the input tables by setting inputMap of

264− the Config. See Graphics.Vty.Config

265− - Users can define input table extensions that will apply to all vty

266− applications. See Graphics.Vty.Config

267− - terminal timing is now handled by selecting an appropriate VTIME.

268− Previously this was implemented within Vty itself. This reduced

269− complexity in vty but provides a different meta key behavior and

270− implies a requirement on -threaded.

271− - The time vty will wait to verify an ESC byte means a single ESC

272− key is the singleEscPeriod of the Input Config structure.

273− - removed the typeclass based terminal and display context interface

274− in favor of a data structure of properties interface.

275− - renamed the Terminal interface to Output

276− - The default picture for an image now uses the "clear" background.

277− This background fills background spans with spaces or just ends the

278− line.

279− - Previously the background defaulted to the space character. This

280− causes issues copying text from a text editor. The text would end

281− up with extra spaces at the end of the line.

282− - Layer support

283− - Each layer is an image.

284− - The layers for a picture are a list of images.

285− - The first image is the top-most layer. The images are ordered from

286− top to bottom.

287− - The transparent areas for a layer are the backgroundFill areas.

288− backgroundFill is added to pad images when images of different

289− sizes are joined.

290− - If the background is clear there is no background layer.

291− - If there is a background character then the bottom layer is the

292− background layer.

293− - emptyPicture is a Picture with no layers and no cursor

294− - addToTop and addToBottom add a layer to the top and bottom of the

295− given Picture.

296− - compatibility improvements:

297− - terminfo based terminals with no cursor support are silently

298− accepted. The cursor visibility changes in the Picture will have

299− no effect.

300− - alternate (setf/setb) color maps supported. Though colors beyond

301− the first 8 are just a guess.

302− - added "rgbColor" for easy support of RGB specified colors.

303− - Both applications and users can add to the mapping used to

304− translate from input bytes to events.

305− - Additional information about input and output process can be

306− appended to a debug log

307− - Set environment variable VTY_DEBUG_LOG to path of debug log

308− - Or use "debugLog <path>" config directive

309− - Or set 'debugLog' property of the Config provided to mkVty.

310− - examples moved to vty-examples package. See test directory for cabal

311− file.

312− - vty-interactive-terminal-test

313− - interactive test. Useful for building a bug report for vty's

314− author.

315− - test/interactive_terminal_test.hs

316− - vty-event-echo

317− - view a input event log for vty. Example of interacting with

318− user.

319− - test/EventEcho.hs

320− - vty-rogue

321− - The start of a rogue-like game. Example of layers and image

322− build operations.

323− - test/Rogue.hs

324− - vty-benchmark

325− - benchmarks vty. A series of tests that push random pictures to

326− the terminal. The random pictures are generated using

327− QuickCheck. The same generators used in the automated tests.

328− - test/benchmark.hs

678+-----

679+

680+* The naming convention now matches:

681+ * http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions

682+* all projects using vty for input must be compiled with -threaded.

683+ Please notify vty author if this is not acceptable.

684+* mkVtyEscDelay has been removed. Use "mkVty def". Which initialized

685+ vty with the default configuration.

686+* input handling changes

687+ * KASCII is now KChar

688+ * KPN5 is now KCenter

689+ * tests exist.

690+ * Applications can add to the input tables by setting inputMap of

691+ the Config. See Graphics.Vty.Config

692+ * Users can define input table extensions that will apply to all vty

693+ applications. See Graphics.Vty.Config

694+ * terminal timing is now handled by selecting an appropriate VTIME.

695+ Previously this was implemented within Vty itself. This reduced

696+ complexity in vty but provides a different meta key behavior and

697+ implies a requirement on -threaded.

698+ * The time vty will wait to verify an ESC byte means a single ESC

699+ key is the singleEscPeriod of the Input Config structure.

700+* removed the typeclass based terminal and display context interface

701+ in favor of a data structure of properties interface.

702+* renamed the Terminal interface to Output

703+* The default picture for an image now uses the "clear" background.

704+ This background fills background spans with spaces or just ends the

705+ line.

706+ * Previously the background defaulted to the space character. This

707+ causes issues copying text from a text editor. The text would end

708+ up with extra spaces at the end of the line.

709+* Layer support

710+ * Each layer is an image.

711+ * The layers for a picture are a list of images.

712+ * The first image is the top-most layer. The images are ordered from

713+ top to bottom.

714+ * The transparent areas for a layer are the backgroundFill areas.

715+ backgroundFill is added to pad images when images of different

716+ sizes are joined.

717+ * If the background is clear there is no background layer.

718+ * If there is a background character then the bottom layer is the

719+ background layer.

720+ * emptyPicture is a Picture with no layers and no cursor

721+ * addToTop and addToBottom add a layer to the top and bottom of the

722+ given Picture.

723+* compatibility improvements:

724+ * terminfo based terminals with no cursor support are silently

725+ accepted. The cursor visibility changes in the Picture will have

726+ no effect.

727+ * alternate (setf/setb) color maps supported. Though colors beyond

728+ the first 8 are just a guess.

729+ * added "rgbColor" for easy support of RGB specified colors.

730+ * Both applications and users can add to the mapping used to

731+ translate from input bytes to events.

732+* Additional information about input and output process can be

733+ appended to a debug log

734+ * Set environment variable VTY_DEBUG_LOG to path of debug log

735+ * Or use "debugLog <path>" config directive

736+ * Or set 'debugLog' property of the Config provided to mkVty.

737+* examples moved to vty-examples package. See test directory for cabal

738+ file.

739+ * vty-interactive-terminal-test

740+ * interactive test. Useful for building a bug report for vty's

741+ author.

742+ * test/interactive_terminal_test.hs

743+ * vty-event-echo

744+ * view a input event log for vty. Example of interacting with

745+ user.

746+ * test/EventEcho.hs

747+ * vty-rogue

748+ * The start of a rogue-like game. Example of layers and image

749+ build operations.

750+ * test/Rogue.hs

751+ * vty-benchmark

752+ * benchmarks vty. A series of tests that push random pictures to

753+ the terminal. The random pictures are generated using

754+ QuickCheck. The same generators used in the automated tests.

755+ * test/benchmark.hs

329756

3307574.7.0.0

331− - API changes:

332− - Added Graphics.Vty.Image.crop: Ensure an image is no larger

333− than the specified size.

334− - Added Graphics.Vty.Image.pad: Ensure an image is no smaller

335− than the specified size.

336− - Added Graphics.Vty.Image.translate: Offset an image.

337− - Thanks Ben Boeckel <MathStuf@gmail.com> for these features.

758+-------

338759

339−4.3.0.0

760+API changes:

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.

340767

3417684.2.1.0

342− - API changes:

343− - Attr record accessor fore_color changed to attr_fore_color

344− - Attr record accessor back_color changed to attr_back_color

345− - Attr record accessor style changed to attr_style

346− - Added an "inline" display attribute changing DSL:

347− - put_attr_change applies a display attribute change

348− immediately to a terminal

349− - For instance, can be used to change the display attrbiutes

350− of text output via putStrLn and putStr. EX:

351− "put_attr_change $ back_color red" will set the background

352− color to red.

353− - Changes do not apply to a Picture output via output_picture.

354− - See Graphics.Vty.Inline

355− - Moved all IO actions into any monad an instance of MonadIO

769+-------

770+

771+API changes:

772+* Attr record accessor fore_color changed to attr_fore_color

773+* Attr record accessor back_color changed to attr_back_color

774+* Attr record accessor style changed to attr_style

775+* Added an "inline" display attribute changing DSL:

776+ * put_attr_change applies a display attribute change

777+ immediately to a terminal

778+ * For instance, can be used to change the display attrbiutes

779+ of text output via putStrLn and putStr. EX:

780+ "put_attr_change $ back_color red" will set the background

781+ color to red.

782+ * Changes do not apply to a Picture output via output_picture.

783+ * See Graphics.Vty.Inline

784+* Moved all IO actions into any monad an instance of MonadIO

356785

3577864.0.0.1

358− - binding for mk_wcswidth was incorrect. Most platforms just

359− magically worked due to coincidence.

787+-------

788+

789+* binding for mk_wcswidth was incorrect. Most platforms just

790+ magically worked due to coincidence.

360791

3617924.0.0

362− - API changes:

363− - "getSize" has been removed. Use "terminal vty >>= display_bounds"

364− where "vty" is an instance of the Vty data structure.

365− - added a "terminal" field to the Vty data structure. Accesses the

366− TerminalHandle associated with the Vty instance.

367− - Graphics.Vty.Types has undergone a number of changes. Summary:

368− - Partitioned into Graphics.Vty.Attributes for display attributes.

369− Graphics.Vty.Image for image combinators. Graphics.Vty.Picture

370− for final picture construction.

371− - Graphics.Vty.Attributes:

372− - "setFG" and "setBG" are now "with_fore_color" and

373− "with_back_color"

374− - All other "set.." equations similarly replaced.

375− - "attr" is now "def_attr", short for "default display attributes"

376− Also added a "current_attr" for "currently applied display

377− attributes"

378− - Graphics.Vty.Image:

379− - "horzcat" is now "horiz_cat"

380− - "vertcat" is now "vert_cat"

381− - "renderBS" is now "utf8_bytestring"

382− - "renderChar" is now "char"

383− - "renderFill" is now "char_fill"

384− - added a "utf8_string" and "string" (AKA "iso_10464_string") for

385− UTF-8 encoded Strings and ISO-10464 encoded Strings. String

386− literals in GHC have an ISO-10464 runtime representation.

387− - Graphics.Vty.Picture:

388− - exports Graphics.Vty.Image

389− - "pic" is now "pic_for_image"

390− - added API for setting background fill pattern.

391− - Completely rewritten output backend.

392− - Efficient, scanline style output span generator. Has not been

393− fully optimized, but good enough.

394− - The details required to display the desired picture on a

395− terminal are well encapsulated.

396− - Terminfo based display terminal implementation. With specialized

397− derivitives for xterm, Terminal.app, and iTerm.app.

398− - Attempts to robustly handle even terminals that don't

399− support all display attributes.

400− - I've tested the following terminals with success: iTerm.app,

401− Terminal.app, xterm, rxvt, mlterm, Eterm, gnome-terminal,

402− konsole, screen, linux vty. Hopefully you will be as

403− successfull.

404− - Improved unicode support. Double wide characters will display as

405− expected.

406− - 256 color support. See Graphics.Vty.Attributes.Color240. The actual

407− output color is adjusted according to the number of colors the

408− terminal supports.

409− - The Graphics.Vty.Image combinators no longer require matching

410− dimensions to arguments. Unspecified areas are filled in with a

411− user-customizable background pattern. See Graphics.Vty.Picture.

412− - output images are always cropped to display size.

413− - Significant code coverage by QuickCheck tests. An interactive test

414− for those final properties that couldn't be automatically verified.

793+-----

794+

795+API changes:

796+* "getSize" has been removed. Use "terminal vty >>= display_bounds"

797+ where "vty" is an instance of the Vty data structure.

798+* added a "terminal" field to the Vty data structure. Accesses the

799+ TerminalHandle associated with the Vty instance.

800+* Graphics.Vty.Types has undergone a number of changes. Summary:

801+ * Partitioned into Graphics.Vty.Attributes for display attributes.

802+ Graphics.Vty.Image for image combinators. Graphics.Vty.Picture

803+ for final picture construction.

804+* Graphics.Vty.Attributes:

805+ * "setFG" and "setBG" are now "with_fore_color" and

806+ "with_back_color"

807+ * All other "set.." equations similarly replaced.

808+ * "attr" is now "def_attr", short for "default display attributes"

809+ Also added a "current_attr" for "currently applied display

810+ attributes"

811+* Graphics.Vty.Image:

812+ * "horzcat" is now "horiz_cat"

813+ * "vertcat" is now "vert_cat"

814+ * "renderBS" is now "utf8_bytestring"

815+ * "renderChar" is now "char"

816+ * "renderFill" is now "char_fill"

817+ * added a "utf8_string" and "string" (AKA "iso_10464_string") for

818+ UTF-8 encoded Strings and ISO-10464 encoded Strings. String

819+ literals in GHC have an ISO-10464 runtime representation.

820+* Graphics.Vty.Picture:

821+ * exports Graphics.Vty.Image

822+ * "pic" is now "pic_for_image"

823+ * added API for setting background fill pattern.

824+* Completely rewritten output backend.

825+ * Efficient, scanline style output span generator. Has not been

826+ fully optimized, but good enough.

827+ * The details required to display the desired picture on a

828+ terminal are well encapsulated.

829+ * Terminfo based display terminal implementation. With specialized

830+ derivitives for xterm, Terminal.app, and iTerm.app.

831+ * Attempts to robustly handle even terminals that don't

832+ support all display attributes.

833+ * I've tested the following terminals with success: iTerm.app,

834+ Terminal.app, xterm, rxvt, mlterm, Eterm, gnome-terminal,

835+ konsole, screen, linux vty. Hopefully you will be as

836+ successfull.

837+ * Improved unicode support. Double wide characters will display as

838+ expected.

839+* 256 color support. See Graphics.Vty.Attributes.Color240. The actual

840+ output color is adjusted according to the number of colors the

841+ terminal supports.

842+* The Graphics.Vty.Image combinators no longer require matching

843+ dimensions to arguments. Unspecified areas are filled in with a

844+ user-customizable background pattern. See Graphics.Vty.Picture.

845+* output images are always cropped to display size.

846+* Significant code coverage by QuickCheck tests. An interactive test

847+ for those final properties that couldn't be automatically verified.

415848

416849Issues resolved:

417− - "gnome terminal displays non-basic attributes as strikethrough"

418− - http://trac.haskell.org/vty/ticket/14

419− - "Multi-byte characters are not displayed correctly on update"

420− - http://trac.haskell.org/vty/ticket/10

421− - "Redraw does not handle rendering a line that extends beyond screen

422− width characters"

423− - http://trac.haskell.org/vty/ticket/13

424− - "The <|> and <-> combinators should be more forgiving of mismatched

425− dimensions"

426− - http://trac.haskell.org/vty/ticket/9

427− - "256-color support"

428− - http://trac.haskell.org/vty/ticket/19

850+* "gnome terminal displays non-basic attributes as strikethrough"

851+ * http://trac.haskell.org/vty/ticket/14

852+* "Multi-byte characters are not displayed correctly on update"

853+ * http://trac.haskell.org/vty/ticket/10

854+* "Redraw does not handle rendering a line that extends beyond screen

855+ width characters"

856+ * http://trac.haskell.org/vty/ticket/13

857+* "The <|> and <-> combinators should be more forgiving of mismatched

858+ dimensions"

859+ * http://trac.haskell.org/vty/ticket/9

860+* "256-color support"

861+ * http://trac.haskell.org/vty/ticket/19

LICENSE+2

@@ -1,3 +1,5 @@

1+BSD 3-Clause License

13Copyright Stefan O'Rear 2006, Corey O'Connor 2008, Corey O'Connor 2009

35All rights reserved.

README.md+109−54

@@ -7,7 +7,7 @@ interface for doing terminal I/O. Vty is supported on GHC versions

77Install via `git` with:

99```

10−git clone git://github.com/coreyoconnor/vty.git

10+git clone git://github.com/jtdaugherty/vty.git

1111```

1212

1313Install via `cabal` with:

@@ -18,24 +18,21 @@ cabal install vty

1818

1919# Features

2020

21−* Supports a large number of terminals. vt100, ansi, hurd, linux,

22− screen, etc., or anything with a sufficient terminfo entry.

21+* Supports a large number of terminals, i.e., vt100, ansi, hurd, linux,

22+ `screen`, etc., or anything with a sufficient terminfo entry.

2323

24−* Automatic handling of window resizes.

24+* Automatically handles window resizes.

2525

26−* Unicode output on terminals with UTF-8 support.

26+* Supports Unicode output on terminals with UTF-8 support.

2727

28−* Handles multi-column glyphs. (Requires user to properly configure

29− terminal.)

30−

31−* Efficient output. Output buffering and terminal state changes are

32− minimized.

28+* Provides an efficient output algorithm. Output buffering and terminal

29+ state changes are minimized.

3330

3431* Minimizes repaint area, which virtually eliminates the flicker

3532 problems that plague ncurses programs.

3633

37−* A pure, compositional interface for efficiently constructing display

38− images.

34+* Provides a pure, compositional interface for efficiently constructing

35+ display images.

3936

4037* Automatically decodes keyboard keys into (key,[modifier]) tuples.

4138

@@ -44,7 +41,7 @@ cabal install vty

4441* Supports a keypress timeout after for lone ESC. The timeout is

4542 customizable.

4643

47−* The interface is designed for easy extension.

44+* Provides extensible input and output interfaces.

4845

4946* Supports ANSI graphics modes (SGR as defined in `console_codes(4)`)

5047 with a type-safe interface and graceful fallback for terminals

@@ -60,16 +57,106 @@ cabal install vty

6057* Supports bracketed paste mode as described at

6158 http://cirw.in/blog/bracketed-paste

6259

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

67+

68+Vty uses threads internally, so programs made with Vty need to be

69+compiled with the threaded runtime using the GHC `-threaded` option.

70+

6371# Platform Support

6472

6573## Posix Terminals

6674

67−Uses terminfo to determine terminal protocol. With some special rules to

68−handle some omissions from terminfo.

75+For the most part, Vty uses `terminfo` to determine terminal protocol

76+with some special rules to handle some omissions from `terminfo`.

6977

7078## Windows

7179

72−Unsupported (but contributions and testing here are very welcome!)

80+Windows is not supported.

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.

73160

74161# Contributing

75162

@@ -83,45 +170,13 @@ should consider to make submitting patches easier for all concerned:

83170 conventions already used in the codebase.

84171 - Please provide Haddock documentation for any changes you make.

85172

86−# Development Notes

87−

88−## Under NixOS

89−

90−### Using cabal

91−

92−After installing `ncurses` to the user environment:

93−

94−~~~

95−LIBRARY_PATH=$HOME/.nix-profile/lib/ cabal configure --enable-tests --extra-lib-dirs=$HOME/.nix-profile/lib

96−LIBRARY_PATH=$HOME/.nix-profile/lib/ cabal build

97−LIBRARY_PATH=$HOME/.nix-profile/lib/ cabal test

98−~~~

99−

100−## Code Coverage

101−

102−As of last testing, profiling causes issues with coverage when enabled.

103−To evaluate coverage, configure as follows:

104−

105−~~~

106−rm -rf dist ; cabal configure --enable-tests --enable-library-coverage \

107− --disable-library-profiling \

108− --disable-executable-profiling

109−~~~

110−

111−## Profiling

112−

113−~~~

114−rm -rf dist ; cabal configure --enable-tests --disable-library-coverage \

115− --enable-library-profiling \

116− --enable-executable-profiling

117−~~~

118−

119173# Known Issues

120174

121−* Terminals have numerous quirks and bugs. Vty picks what works best for

122− the author in ambiguous or buggy situations.

175+* Terminals have numerous quirks and bugs, so mileage may vary. Please

176+ report issues as you encounter them and provide details on your

177+ terminal emulator, operating system, etc.

123178

124−* Signal handling of STOP, TERM and INT are nonexistent.

179+* STOP, TERM and INT signals are not handled.

125180

126181* The character encoding of the terminal is assumed to be UTF-8 if

127182 unicode is used.

@@ -131,10 +186,10 @@ rm -rf dist ; cabal configure --enable-tests --disable-library-coverage \

131186 (shifted F10 etc). See `Config` for customizing vty's behavior for a

132187 particular terminal.

133188

134−* Uses the `TIOCGWINSZ` ioctl to find the current window size, which

189+* Vty uses the `TIOCGWINSZ` ioctl to find the current window size, which

135190 appears to be limited to Linux and BSD.

136191

137−# Sources

192+# Further Reading

138193

139194Good sources of documentation for terminal programming are:

140195

cbits/get_tty_erase.cnew file+18

@@ -0,0 +1,18 @@

1+#include <termios.h>

2+#include <stdio.h>

3+#include <unistd.h>

4+#include <stdlib.h>

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+14−5

@@ -1,9 +1,18 @@

11#include <sys/ioctl.h>

33unsigned long vty_c_get_window_size(int fd) {

4− struct winsize w;

5− if (ioctl (fd, TIOCGWINSZ, &w) >= 0)

6− return (w.ws_row << 16) + w.ws_col;

7− else

8− return 0x190050;

4+ struct winsize w;

5+ if (ioctl (fd, TIOCGWINSZ, &w) >= 0)

6+ return (w.ws_row << 16) + w.ws_col;

7+ else

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+ }

918}

cbits/gwinsz.h+2−1

@@ -1 +1,2 @@

1−unsigned long vty_c_get_window_size(void);

1+unsigned long vty_c_get_window_size(int fd);

2+unsigned long vty_c_set_window_size(int fd, unsigned long val);

cbits/mk_wcwidth.c+136−2

@@ -60,6 +60,28 @@

6060 */

6161

6262#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;

6385

6486struct interval {

6587 int first;

@@ -119,7 +141,7 @@ static int vty_bisearch(HsChar ucs, const struct interval *table, int max) {

119141 * in ISO 10646.

120142 */

121143

122−HsInt vty_mk_wcwidth(HsChar ucs)

144+static HsInt builtin_wcwidth(HsChar ucs)

123145{

124146 /* sorted list of non-overlapping intervals of non-spacing characters */

125147 /* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c" */

@@ -182,7 +204,7 @@ HsInt vty_mk_wcwidth(HsChar ucs)

182204

183205 /* binary search in table of non-spacing characters */

184206 if (vty_bisearch(ucs, combining,

185− sizeof(combining) / sizeof(struct interval) - 1))

207+ sizeof(combining) / sizeof(struct interval) - 1))

186208 return 0;

187209

188210 /* if we arrive here, ucs is not a combining or C0/C1 control character */

@@ -202,3 +224,115 @@ HsInt vty_mk_wcwidth(HsChar ucs)

202224 (ucs >= 0x20000 && ucs <= 0x2fffd) ||

203225 (ucs >= 0x30000 && ucs <= 0x3fffd)));

204226}

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+12−4

@@ -31,7 +31,8 @@ introText = vertCat $ map (string defAttr)

3131 [ "this line is hidden by the top layer"

3232 , "The vty demo program will echo the events generated by the pressed keys."

3333 , "Below there is a 240 color box."

34− , "Followed by a description of the 16 color pallete."

34+ , "Followed by a description of the 16 color palette."

35+ , "Followed by tones of red using a 24-bit palette."

3536 , "If the 240 color box is not visible then the terminal"

3637 , "claims 240 colors are not supported."

3738 , "Try setting TERM to xterm-256color"

@@ -42,12 +43,19 @@ introText = vertCat $ map (string defAttr)

4243 , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯"

4344 ]

4445

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+

4555colorbox_240 :: Image

4656colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages

4757 where

4858 colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]

49− splitColorImages [] = []

50− splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))

5159

5260colorbox_16 :: Image

@@ -70,7 +78,7 @@ updateDisplay = do

7078 "Press ESC to exit. Events for keys below."

7179 eventLog <- foldMap (string defAttr) <$> get

7280 let pic = picForImage (info <-> eventLog)

73− `addToBottom` (introText <-> colorbox_240 <|> colorbox_16)

81+ `addToBottom` (introText <-> colorbox_240 <|> colorbox_16 <|> fullcolorbox)

7482 vty <- ask

7583 liftIO $ update vty pic

7684

demos/ModeDemo.hs+2

@@ -2,6 +2,8 @@ module Main where

33import Control.Applicative

44import Data.Monoid

5+import Foreign.C.Types (CInt(..), CChar(..))

6+import System.Posix.Types (Fd(..))

68import Graphics.Vty

src/Codec/Binary/UTF8/Debug.hs+1−2

@@ -14,5 +14,4 @@ utf8FromIso :: [Int] -> [Word8]

1414utf8FromIso = encode . map toEnum

1515

1616ppUtf8 :: [Int] -> IO ()

17−ppUtf8 = print . map (\f -> f "") . map showHex . utf8FromIso

18−

17+ppUtf8 = print . map (`showHex` "") . utf8FromIso

src/Data/Sequence/Extra.hs+1−1

@@ -7,7 +7,7 @@ import Data.Sequence

77import Control.Parallel.Strategies

99instance NFData a => NFData (Seq a) where

10− rnf = \v -> rnf' (viewl v)

10+ rnf = rnf' . viewl

1111 where

1212 rnf' EmptyL = ()

1313 rnf' (a :< r) = rnf a >| rnf' (viewl r)

src/Data/Terminfo/Eval.hs+3−3

@@ -42,7 +42,7 @@ pop = do

4242

4343readParam :: Word -> Eval CapParam

4444readParam pn = do

45− !params <- get >>= return . evalParams

45+ !params <- evalParams <$> get

4646 return $! genericIndex params pn

4747

4848push :: CapParam -> Eval ()

@@ -64,11 +64,11 @@ writeCapExpr cap params =

6464 in snd $ runWriter (runStateT (writeCapOps (capOps cap)) s0)

6565

6666writeCapOps :: CapOps -> Eval ()

67−writeCapOps ops = mapM_ writeCapOp ops

67+writeCapOps = mapM_ writeCapOp

6868

6969writeCapOp :: CapOp -> Eval ()

7070writeCapOp (Bytes !offset !count) = do

71− !cap <- get >>= return . evalExpression

71+ !cap <- evalExpression <$> get

7272 let bytes = Vector.take count $ Vector.drop offset (capBytes cap)

7373 Vector.forM_ bytes $ tell.writeWord8

7474writeCapOp DecOut = do

src/Data/Terminfo/Parse.hs+22−13

@@ -1,8 +1,9 @@

11{-# LANGUAGE BangPatterns #-}

2−{-# OPTIONS_HADDOCK hide #-}

2+{-# LANGUAGE CPP #-}

33{-# LANGUAGE NoMonomorphismRestriction #-}

4−{-# LANGUAGE NamedFieldPuns #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

55{-# OPTIONS_GHC -funbox-strict-fields -O #-}

6+{-# OPTIONS_HADDOCK hide #-}

78module Data.Terminfo.Parse

89 ( module Data.Terminfo.Parse

@@ -13,6 +14,9 @@ where

1314import Control.Monad ( liftM )

1415import Control.DeepSeq

1516

17+#if !(MIN_VERSION_base(4,11,0))

18+import Data.Semigroup (Semigroup(..))

19+#endif

1620import Data.Word

1721import qualified Data.Vector.Unboxed as Vector

1822

@@ -35,7 +39,7 @@ instance Show CapExpression where

3539 ++ " <= " ++ show (sourceString c)

3640 where

3741 hexDump :: [Word8] -> String

38− hexDump = foldr (\b s -> showHex b s) ""

42+ hexDump = foldr showHex ""

3943

4044instance NFData CapExpression where

4145 rnf (CapExpression ops !_bytes !str !c !pOps)

@@ -95,7 +99,7 @@ parseCapExpression capString =

9599 Left e -> Left e

96100 Right buildResults -> Right $ constructCapExpression capString buildResults

97101

98−constructCapExpression :: [Char] -> BuildResults -> CapExpression

102+constructCapExpression :: String -> BuildResults -> CapExpression

99103constructCapExpression capString buildResults =

100104 let expr = CapExpression

101105 { capOps = outCapOps buildResults

@@ -124,7 +128,7 @@ paramEscapeParser = do

124128literalPercentParser :: CapParser BuildResults

125129literalPercentParser = do

126130 _ <- char '%'

127− startOffset <- getState >>= return . nextOffset

131+ startOffset <- nextOffset <$> getState

128132 incOffset 1

129133 return $ BuildResults 0 [Bytes startOffset 1] []

130134

@@ -150,7 +154,7 @@ incrementOpParser = do

150154pushOpParser :: CapParser BuildResults

151155pushOpParser = do

152156 _ <- char 'p'

153− paramN <- digit >>= return . (\d -> read [d])

157+ paramN <- read . pure <$> digit

154158 incOffset 2

155159 return $ BuildResults (fromEnum paramN) [PushParam $ paramN - 1] []

156160

@@ -295,7 +299,7 @@ compareOpParser

295299bytesOpParser :: CapParser BuildResults

296300bytesOpParser = do

297301 bytes <- many1 $ satisfy (/= '%')

298− startOffset <- getState >>= return . nextOffset

302+ startOffset <- nextOffset <$> getState

299303 let !c = length bytes

300304 !s <- getState

301305 let s' = s { nextOffset = startOffset + c }

@@ -329,11 +333,16 @@ data BuildResults = BuildResults

329333 , outParamOps :: !ParamOps

330334 }

331335

332−instance Monoid BuildResults where

333− mempty = BuildResults 0 [] []

334− v0 `mappend` v1

336+instance Semigroup BuildResults where

337+ v0 <> v1

335338 = BuildResults

336− { outParamCount = (outParamCount v0) `max` (outParamCount v1)

337− , outCapOps = (outCapOps v0) `mappend` (outCapOps v1)

338− , outParamOps = (outParamOps v0) `mappend` (outParamOps v1)

339+ { outParamCount = outParamCount v0 `max` outParamCount v1

340+ , outCapOps = outCapOps v0 <> outCapOps v1

341+ , outParamOps = outParamOps v0 <> outParamOps v1

339342 }

343+

344+instance Monoid BuildResults where

345+ mempty = BuildResults 0 [] []

346+#if !(MIN_VERSION_base(4,11,0))

347+ mappend = (<>)

348+#endif

src/Graphics/Text/Width.hs+40−9

@@ -1,26 +1,47 @@

22{-# OPTIONS_GHC -D_XOPEN_SOURCE #-}

33{-# 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@.

413module Graphics.Text.Width

514 ( wcwidth

615 , wcswidth

16+ , wctwidth

17+ , wctlwidth

718 , safeWcwidth

819 , safeWcswidth

20+ , safeWctwidth

21+ , safeWctlwidth

922 )

1023where

1124

25+import Data.List (foldl')

26+import qualified Data.Text as T

27+import qualified Data.Text.Lazy as TL

28+

1229foreign import ccall unsafe "vty_mk_wcwidth" wcwidth :: Char -> Int

1330

1431wcswidth :: String -> Int

15−wcswidth = sum . map wcwidth

32+wcswidth = foldl' (\l c -> wcwidth c + l) 0

33+{-# INLINE [1] wcswidth #-}

1634

17−-- XXX: Characters with unknown widths occupy 1 column?

18−--

19−-- Not sure if this is actually correct. I presume there is a

20−-- replacement character that is output by the terminal instead of the

21−-- character and this replacement character is 1 column wide. If this is

22−-- not true for all terminals then a per-terminal replacement character

23−-- width needs to be implemented.

35+wctwidth :: T.Text -> Int

36+wctwidth = T.foldl' (\l c -> wcwidth c + l) 0

37+

38+wctlwidth :: TL.Text -> Int

39+wctlwidth = TL.foldl' (\l c -> wcwidth c + l) 0

40+

41+{-# RULES

42+"wcswidth/unpack" forall x. wcswidth (T.unpack x) = wctwidth x

43+"wcswidth/lazy-unpack" forall x. wcswidth (TL.unpack x) = wctlwidth x

44+ #-}

2445

2546-- | Returns the display width of a character. Assumes all characters

2647-- with unknown widths are 0 width.

@@ -30,4 +51,14 @@ safeWcwidth = max 0 . wcwidth

3051-- | Returns the display width of a string. Assumes all characters with

3152-- unknown widths are 0 width.

3253safeWcswidth :: String -> Int

33−safeWcswidth = sum . map safeWcwidth

54+safeWcswidth = foldl' (\l c -> safeWcwidth c + l) 0

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+134−38

@@ -1,3 +1,6 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE ScopedTypeVariables #-}

14-- | Vty provides interfaces for both terminal input and terminal

25-- output.

36--

@@ -10,6 +13,9 @@

1013-- "Graphics.Vty.Image". Output can be syled using 'Attr' (attribute)

1114-- values in the "Graphics.Vty.Attributes" module.

1215--

16+-- Vty uses threads internally, so programs made with Vty need to be

17+-- compiled with the threaded runtime using the GHC @-threaded@ option.

18+--

1319-- @

1420-- import "Graphics.Vty"

1521--

@@ -28,6 +34,7 @@

2834module Graphics.Vty

2935 ( Vty(..)

3036 , mkVty

37+ , setWindowTitle

3138 , Mode(..)

3239 , module Graphics.Vty.Config

3340 , module Graphics.Vty.Input

@@ -41,23 +48,33 @@ where

4148

4249import Graphics.Vty.Config

4350import Graphics.Vty.Input

51+import Graphics.Vty.Input.Events

4452import Graphics.Vty.Output

4553import Graphics.Vty.Output.Interface

4654import Graphics.Vty.Picture

4755import Graphics.Vty.Image

4856import Graphics.Vty.Attributes

57+import Graphics.Vty.UnicodeWidthTable.IO

58+import Graphics.Vty.UnicodeWidthTable.Install

4959

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)

5065import Control.Concurrent.STM

5166

5267import Data.IORef

53−import Data.Monoid

68+#if !(MIN_VERSION_base(4,11,0))

69+import Data.Semigroup ((<>))

70+#endif

5471

5572-- | A Vty value represents a handle to the Vty library that the

5673-- application must create in order to use Vty.

5774--

5875-- The use of Vty typically follows this process:

5976--

60−-- 1. Initialize vty

77+-- 1. Initialize vty with 'mkVty' (this takes control of the terminal).

6178--

6279-- 2. Use 'update' to display a picture.

6380--

@@ -65,31 +82,33 @@ import Data.Monoid

6582--

6683-- 4. Depending on the event, go to 2 or 5.

6784--

68−-- 5. Shutdown vty.

85+-- 5. Shutdown vty and restore the terminal state with 'shutdown'. At

86+-- this point the 'Vty' handle cannot be used again.

6987--

7088-- Operations on Vty handles are not thread-safe.

71−data Vty = Vty

72− { -- | Outputs the given 'Picture'.

73− update :: Picture -> IO ()

74− -- | Get one 'Event' object, blocking if none are available. This

75− -- will refresh the terminal if the event is a 'EvResize'.

76− , nextEvent :: IO Event

77− -- | The input interface. See 'Input'.

78− , inputIface :: Input

79− -- | The output interface. See 'Output'.

80− , outputIface :: Output

81− -- | Refresh the display. 'nextEvent' will refresh the display if

82− -- a resize occurs, but this can be used to refresh the display

83− -- explicitly. If other programs output to the terminal and mess

84− -- up the display then the application might want to force a

85− -- refresh using this function.

86− , refresh :: IO ()

87− -- | Clean up after vty. A call to this function is necessary to

88− -- cleanly restore the terminal state before application exit. The

89− -- above methods will throw an exception if executed after this is

90− -- executed.

91− , shutdown :: IO ()

92− }

89+data Vty =

90+ Vty { update :: Picture -> IO ()

91+ -- ^ Outputs the given 'Picture'.

92+ , nextEvent :: IO Event

93+ -- ^ Return the next 'Event' or block until one becomes

94+ -- available.

95+ , nextEventNonblocking :: IO (Maybe Event)

96+ -- ^ Non-blocking version of 'nextEvent'.

97+ , inputIface :: Input

98+ -- ^ The input interface. See 'Input'.

99+ , outputIface :: Output

100+ -- ^ The output interface. See 'Output'.

101+ , refresh :: IO ()

102+ -- ^ Refresh the display. If other programs output to the

103+ -- terminal and mess up the display then the application might

104+ -- want to force a refresh using this function.

105+ , shutdown :: IO ()

106+ -- ^ Clean up after vty. A call to this function is necessary to

107+ -- cleanly restore the terminal state before application exit.

108+ -- The above methods will throw an exception if executed after

109+ -- this is executed. Idempotent.

110+ , isShutdown :: IO Bool

111+ }

93112

94113-- | Create a Vty handle. At most one handle should be created at a time

95114-- for a given terminal device.

@@ -102,17 +121,63 @@ data Vty = Vty

102121mkVty :: Config -> IO Vty

103122mkVty appConfig = do

104123 config <- (<> appConfig) <$> userConfig

105− input <- inputForConfig config

106− out <- outputForConfig config

107− intMkVty input out

108124

109−intMkVty :: Input -> Output -> IO Vty

110−intMkVty input out = do

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

168+internalMkVty input out = do

111169 reserveDisplay out

170+

171+ shutdownVar <- newTVarIO False

112172 let shutdownIo = do

113− shutdownInput input

114− releaseDisplay out

115− releaseTerminal out

173+ alreadyShutdown <- atomically $ swapTVar shutdownVar True

174+ when (not alreadyShutdown) $ do

175+ shutdownInput input

176+ releaseDisplay out

177+ releaseTerminal out

178+

179+ let shutdownStatus = readTVarIO shutdownVar

180+

116181 lastPicRef <- newIORef Nothing

117182 lastUpdateRef <- newIORef Nothing

118183

@@ -144,16 +209,47 @@ intMkVty input out = do

144209 mPic <- readIORef lastPicRef

145210 maybe (return ()) innerUpdate mPic

146211

147− let gkey = do k <- atomically $ readTChan $ _eventChannel input

148− case k of

149− (EvResize _ _) -> displayBounds out

150− >>= return . (\(w,h)-> EvResize w h)

151− _ -> return k

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

219+ translateInternalEvent e

220+ gkey' = do

221+ mEv <- atomically $ tryReadTChan $ _eventChannel input

222+ case mEv of

223+ Just e -> Just <$> translateInternalEvent e

224+ Nothing -> return Nothing

152225

153226 return $ Vty { update = innerUpdate

154227 , nextEvent = gkey

228+ , nextEventNonblocking = gkey'

155229 , inputIface = input

156230 , outputIface = out

157231 , refresh = innerRefresh

158232 , shutdown = shutdownIo

233+ , isShutdown = shutdownStatus

159234 }

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+54−45

@@ -1,6 +1,6 @@

1−{-# LANGUAGE StandaloneDeriving #-}

2−{-# LANGUAGE GADTs #-}

3−{-# LANGUAGE RankNTypes #-}

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE DeriveAnyClass #-}

55-- | Display attributes

66--

@@ -10,14 +10,14 @@

1010-- 'withForeColor', 'withBackColor', and 'withStyle', e.g.,

1111--

1212-- @

13−-- defAttr `withForeColor` red

13+-- defAttr \`withForeColor\` red

1414-- @

1515--

1616-- 'Image' constructors often require an 'Attr' to indicate the

1717-- attributes used in the image, e.g.,

1818--

1919-- @

20−-- string (defAttr `withForeColor` red) "this text will be red"

20+-- string (defAttr \`withForeColor\` red) "this text will be red"

2121-- @

2222--

2323-- The appearance of 'Image's using 'defAttr' is determined by the The

@@ -27,7 +27,9 @@

2727-- The value 'currentAttr' will keep the attributes of whatever was

2828-- output previously.

2929module Graphics.Vty.Attributes

30− ( Attr(..)

30+ ( module Graphics.Vty.Attributes.Color

31+

32+ , Attr(..)

3133 , FixedAttr(..)

3234 , MaybeDefault(..)

3335 , defAttr

@@ -37,6 +39,8 @@ module Graphics.Vty.Attributes

3739 , Style

3840 , withStyle

3941 , standout

42+ , italic

43+ , strikethrough

4044 , underline

4145 , reverseVideo

4246 , blink

@@ -50,17 +54,18 @@ module Graphics.Vty.Attributes

5054 , withForeColor

5155 , withBackColor

5256

53− -- * Colors

54− , module Graphics.Vty.Attributes.Color

55− , module Graphics.Vty.Attributes.Color240

57+ -- * Setting hyperlinks

58+ , withURL

5659 )

5760where

5861

62+import Control.DeepSeq

5963import Data.Bits

64+import Data.Text (Text)

6065import Data.Word

66+import GHC.Generics

6167

6268import Graphics.Vty.Attributes.Color

63−import Graphics.Vty.Attributes.Color240

6469

6570-- | A display attribute defines the Color and Style of all the

6671-- characters rendered after the attribute is applied.

@@ -73,7 +78,8 @@ data Attr = Attr

7378 { attrStyle :: !(MaybeDefault Style)

7479 , attrForeColor :: !(MaybeDefault Color)

7580 , attrBackColor :: !(MaybeDefault Color)

76− } deriving ( Eq, Show, Read )

81+ , attrURL :: !(MaybeDefault Text)

82+ } deriving ( Eq, Show, Read, Generic, NFData )

7783

7884-- This could be encoded into a single 32 bit word. The 32 bit word is

7985-- first divided into 4 groups of 8 bits where: The first group codes

@@ -94,25 +100,19 @@ data Attr = Attr

94100-- __ - unused

95101--

96102-- Next is the style flags

97−-- SURBDO__

103+-- SURBDOI_

98104-- S - standout

99105-- U - underline

100106-- R - reverse video

101107-- B - blink

102108-- D - dim

103109-- O - bold

104−-- __ - unused

110+-- I - italic

111+-- _ - unused

105112--

106113-- Then the foreground color encoded into 8 bits.

107114-- Then the background color encoded into 8 bits.

108115

109−instance Monoid Attr where

110− mempty = Attr mempty mempty mempty

111− mappend attr0 attr1 =

112− Attr ( attrStyle attr0 `mappend` attrStyle attr1 )

113− ( attrForeColor attr0 `mappend` attrForeColor attr1 )

114− ( attrBackColor attr0 `mappend` attrBackColor attr1 )

115−

116116-- | Specifies the display attributes such that the final style and

117117-- color values do not depend on the previously applied display

118118-- attribute. The display attributes can still depend on the terminal's

@@ -121,38 +121,26 @@ data FixedAttr = FixedAttr

121121 { fixedStyle :: !Style

122122 , fixedForeColor :: !(Maybe Color)

123123 , fixedBackColor :: !(Maybe Color)

124+ , fixedURL :: !(Maybe Text)

124125 } deriving ( Eq, Show )

125126

126127-- | The style and color attributes can either be the terminal defaults.

127128-- Or be equivalent to the previously applied style. Or be a specific

128129-- value.

129−data MaybeDefault v where

130− Default :: MaybeDefault v

131− KeepCurrent :: MaybeDefault v

132− SetTo :: forall v . ( Eq v, Show v, Read v ) => !v -> MaybeDefault v

133−

134−deriving instance Eq v => Eq (MaybeDefault v)

135−deriving instance Eq v => Show (MaybeDefault v)

136−deriving instance (Eq v, Show v, Read v) => Read (MaybeDefault v)

137−

138−instance Eq v => Monoid ( MaybeDefault v ) where

139− mempty = KeepCurrent

140− mappend Default Default = Default

141− mappend Default KeepCurrent = Default

142− mappend Default ( SetTo v ) = SetTo v

143− mappend KeepCurrent Default = Default

144− mappend KeepCurrent KeepCurrent = KeepCurrent

145− mappend KeepCurrent ( SetTo v ) = SetTo v

146− mappend ( SetTo _v ) Default = Default

147− mappend ( SetTo v ) KeepCurrent = SetTo v

148− mappend ( SetTo _ ) ( SetTo v ) = SetTo v

130+data MaybeDefault v = Default | KeepCurrent | SetTo !v

131+ deriving (Eq, Read, Show)

132+

133+instance (NFData v) => NFData (MaybeDefault v) where

134+ rnf Default = ()

135+ rnf KeepCurrent = ()

136+ rnf (SetTo v) = rnf v

149137

150138-- | Styles are represented as an 8 bit word. Each bit in the word is 1

151139-- if the style attribute assigned to that bit should be applied and 0

152140-- if the style attribute should not be applied.

153141type Style = Word8

154142

155−-- | The 6 possible style attributes:

143+-- | Valid style attributes include:

156144--

157145-- * standout

158146--

@@ -166,15 +154,21 @@ type Style = Word8

166154--

167155-- * bold/bright

168156--

157+-- * italic

158+--

159+-- * strikethrough (via the smxx/rmxx terminfo capabilities)

160+--

169161-- (The invisible, protect, and altcharset display attributes some

170162-- terminals support are not supported via VTY.)

171−standout, underline, reverseVideo, blink, dim, bold :: Style

163+standout, underline, reverseVideo, blink, dim, bold, italic, strikethrough :: Style

172164standout = 0x01

173165underline = 0x02

174−reverseVideo = 0x04

166+reverseVideo = 0x04

175167blink = 0x08

176168dim = 0x10

177169bold = 0x20

170+italic = 0x40

171+strikethrough = 0x80

178172

179173defaultStyleMask :: Style

180174defaultStyleMask = 0x00

@@ -200,13 +194,28 @@ withBackColor attr c = attr { attrBackColor = SetTo c }

200194

201195-- | Add the given style attribute

202196withStyle :: Attr -> Style -> Attr

197+withStyle attr 0 = attr

203198withStyle attr styleFlag = attr { attrStyle = SetTo $ styleMask attr .|. styleFlag }

204199

200+-- | Add a hyperlinked URL using the proposed [escape sequences for

201+-- hyperlinked

202+-- URLs](https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda).

203+-- These escape sequences are comparatively new and aren't widely

204+-- supported in terminal emulators yet, but most terminal emulators

205+-- that don't know about these sequences will ignore these sequences,

206+-- and therefore this should fall back sensibly. In some cases they

207+-- won't and this will result in garbage, so this is why hyperlinking is

208+-- disabled by default, in which case this combinator has no observable

209+-- effect. To enable it, enable 'Hyperlink' mode on your Vty output

210+-- interface.

211+withURL :: Attr -> Text -> Attr

212+withURL attr url = attr { attrURL = SetTo url }

213+

205214-- | Sets the style, background color and foreground color to the

206215-- default values for the terminal. There is no easy way to determine

207216-- what the default background and foreground colors are.

208217defAttr :: Attr

209−defAttr = Attr Default Default Default

218+defAttr = Attr Default Default Default Default

210219

211220-- | Keeps the style, background color and foreground color that was

212221-- previously set. Used to override some part of the previous style.

@@ -216,4 +225,4 @@ defAttr = Attr Default Default Default

216225-- Would be the currently applied style (be it underline, bold, etc) but

217226-- with the foreground color set to brightMagenta.

218227currentAttr :: Attr

219−currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent

228+currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent KeepCurrent

src/Graphics/Vty/Attributes/Color.hs+96−5

@@ -1,5 +1,24 @@

1+{-# LANGUAGE DeriveGeneric #-}

2+{-# LANGUAGE DeriveAnyClass #-}

3+{-# LANGUAGE MultiWayIf #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

16module Graphics.Vty.Attributes.Color

27 ( Color(..)

8+ , ColorMode(..)

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`

322 , black

423 , red

524 , green

@@ -8,6 +27,8 @@ module Graphics.Vty.Attributes.Color

827 , magenta

928 , cyan

1029 , white

30+

31+ -- | Bright/Vivid variants of the standard 8-color ANSI

1132 , brightBlack

1233 , brightRed

1334 , brightGreen

@@ -16,10 +37,25 @@ module Graphics.Vty.Attributes.Color

1637 , brightMagenta

1738 , brightCyan

1839 , brightWhite

40+ -- ** Creating Colors From RGB

41+ , linearColor

42+ , srgbColor

43+ , rgbColor

44+ , color240

45+ , module Graphics.Vty.Attributes.Color240

1946 )

2047where

2148

2249import 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

2359

2460-- | Abstract data type representing a color.

2561--

@@ -59,7 +95,7 @@ import Data.Word

5995-- reported then the color reproduction will be incorrect.

6096--

6197-- If the terminal reports <= 16 colors then the 240 color palette

62−-- points are only mapped to the 8 color pallete. I'm not sure of

98+-- points are only mapped to the 8 color palette. I'm not sure of

6399-- the RGB points for the "bright" colors which is why they are not

64100-- addressable via the 240 color palette.

65101--

@@ -73,10 +109,33 @@ import Data.Word

73109-- terminfo but I don't know it.

74110--

75111-- Seriously, terminal color support is INSANE.

76−data Color = ISOColor !Word8 | Color240 !Word8

77− deriving ( Eq, Show, Read )

112+data Color = ISOColor !Word8 | Color240 !Word8 | RGBColor !Word8 !Word8 !Word8

113+ deriving ( Eq, Show, Read, Generic, NFData )

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

78138

79−-- | Standard 8-color ANSI terminal color codes.

80139black, red, green, yellow, blue, magenta, cyan, white :: Color

81140black = ISOColor 0

82141red = ISOColor 1

@@ -87,7 +146,6 @@ magenta= ISOColor 5

87146cyan = ISOColor 6

88147white = ISOColor 7

89148

90−-- | Bright/Vivid variants of the standard 8-color ANSI

91149brightBlack, brightRed, brightGreen, brightYellow :: Color

92150brightBlue, brightMagenta, brightCyan, brightWhite :: Color

93151brightBlack = ISOColor 8

@@ -98,3 +156,36 @@ brightBlue = ISOColor 12

98156brightMagenta= ISOColor 13

99157brightCyan = ISOColor 14

100158brightWhite = 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+285−248

@@ -1,261 +1,298 @@

11-- This header file was generated by ./256colres.pl

22module Graphics.Vty.Attributes.Color240

3− ( rgbColor

3+ ( rgbColorToColor240

4+ , color240CodeToRGB

45 )

56where

7−import Graphics.Vty.Attributes.Color

8−

8+import Data.Word (Word8)

99import Text.Printf

1010

1111-- Note: rgbColor's mapping from RGB to 240 colors was generated from

1212-- 256colres.pl which is forked from xterm 256colres.pl.

1313

14−-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.

15−rgbColor :: Integral i => i -> i -> i -> Color

16−rgbColor r g b

14+-- | Create a value in the Color240 set from an RGB triple

15+rgbColorToColor240 :: Integral i => i -> i -> i -> Word8

16+rgbColorToColor240 r g b

1717 | r < 0 && g < 0 && b < 0 = error "rgbColor with negative color component intensity"

18− | r == 8 && g == 8 && b == 8 = Color240 216

19− | r == 18 && g == 18 && b == 18 = Color240 217

20− | r == 28 && g == 28 && b == 28 = Color240 218

21− | r == 38 && g == 38 && b == 38 = Color240 219

22− | r == 48 && g == 48 && b == 48 = Color240 220

23− | r == 58 && g == 58 && b == 58 = Color240 221

24− | r == 68 && g == 68 && b == 68 = Color240 222

25− | r == 78 && g == 78 && b == 78 = Color240 223

26− | r == 88 && g == 88 && b == 88 = Color240 224

27− | r == 98 && g == 98 && b == 98 = Color240 225

28− | r == 108 && g == 108 && b == 108 = Color240 226

29− | r == 118 && g == 118 && b == 118 = Color240 227

30− | r == 128 && g == 128 && b == 128 = Color240 228

31− | r == 138 && g == 138 && b == 138 = Color240 229

32− | r == 148 && g == 148 && b == 148 = Color240 230

33− | r == 158 && g == 158 && b == 158 = Color240 231

34− | r == 168 && g == 168 && b == 168 = Color240 232

35− | r == 178 && g == 178 && b == 178 = Color240 233

36− | r == 188 && g == 188 && b == 188 = Color240 234

37− | r == 198 && g == 198 && b == 198 = Color240 235

38− | r == 208 && g == 208 && b == 208 = Color240 236

39− | r == 218 && g == 218 && b == 218 = Color240 237

40− | r == 228 && g == 228 && b == 228 = Color240 238

41− | r == 238 && g == 238 && b == 238 = Color240 239

42− | r <= 0 && g <= 0 && b <= 0 = Color240 0

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."

18+ | r == 8 && g == 8 && b == 8 = 216

19+ | r == 18 && g == 18 && b == 18 = 217

20+ | r == 28 && g == 28 && b == 28 = 218

21+ | r == 38 && g == 38 && b == 38 = 219

22+ | r == 48 && g == 48 && b == 48 = 220

23+ | r == 58 && g == 58 && b == 58 = 221

24+ | r == 68 && g == 68 && b == 68 = 222

25+ | r == 78 && g == 78 && b == 78 = 223

26+ | r == 88 && g == 88 && b == 88 = 224

27+ | r == 98 && g == 98 && b == 98 = 225

28+ | r == 108 && g == 108 && b == 108 = 226

29+ | r == 118 && g == 118 && b == 118 = 227

30+ | r == 128 && g == 128 && b == 128 = 228

31+ | r == 138 && g == 138 && b == 138 = 229

32+ | r == 148 && g == 148 && b == 148 = 230

33+ | r == 158 && g == 158 && b == 158 = 231

34+ | r == 168 && g == 168 && b == 168 = 232

35+ | r == 178 && g == 178 && b == 178 = 233

36+ | r == 188 && g == 188 && b == 188 = 234

37+ | r == 198 && g == 198 && b == 198 = 235

38+ | r == 208 && g == 208 && b == 208 = 236

39+ | r == 218 && g == 218 && b == 218 = 237

40+ | r == 228 && g == 228 && b == 228 = 238

41+ | r == 238 && g == 238 && b == 238 = 239

42+ | otherwise = 36 * go r + 6 * go g + go b

43+ where go = simpleColor_ (error (printf "RGB color %d %d %d does not map to 240 palette."

25944 (fromIntegral r :: Int)

26045 (fromIntegral g :: Int)

261− (fromIntegral b :: Int))

46+ (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+259−68

@@ -1,7 +1,9 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DeriveDataTypeable #-}

23{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

34{-# LANGUAGE TypeOperators #-}

45{-# LANGUAGE ScopedTypeVariables #-}

6+{-# LANGUAGE LambdaCase, MultiWayIf #-}

57-- | Vty supports a configuration file format and associated 'Config'

68-- data type. The 'Config' can be provided to 'mkVty' to customize the

79-- application's use of Vty.

@@ -53,7 +55,33 @@

5355-- If a debug log is requested then vty will output the current input

5456-- table to the log in the above format. A workflow for using this is

5557-- to set @VTY_DEBUG_LOG@. Run the application. Check the debug log for

56−-- incorrect mappings. Add corrected mappings to @$HOME/.vty/config@.

58+-- 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.

5785module Graphics.Vty.Config

5886 ( InputMap

5987 , Config(..)

@@ -64,6 +92,17 @@ module Graphics.Vty.Config

6492 , runParseConfig

6593 , parseConfigFile

6694 , defaultConfig

95+ , getTtyEraseChar

96+ , currentTerminalName

97+

98+ , vtyConfigPath

99+ , widthTableFilename

100+ , vtyDataDirectory

101+ , terminalWidthTablePath

102+ , vtyConfigFileEnvName

103+

104+ , ConfigUpdateResult(..)

105+ , addConfigWidthMap

67106 )

68107where

69108

@@ -75,29 +114,40 @@ import Control.Exception (catch, IOException, Exception(..), throwIO)

75114import Control.Monad (liftM, guard, void)

76115

77116import qualified Data.ByteString as BS

78−import Data.Monoid

117+#if !(MIN_VERSION_base(4,8,0))

118+import Data.Monoid (Monoid(..))

119+#endif

120+#if !(MIN_VERSION_base(4,11,0))

121+import Data.Semigroup (Semigroup(..))

122+#endif

79123import Data.Typeable (Typeable)

80124

81125import Graphics.Vty.Input.Events

126+import Graphics.Vty.Attributes.Color (ColorMode(..), detectColorMode)

82127

83128import GHC.Generics

84129

85−import System.Directory (getAppUserDataDirectory)

86−import System.Posix.Env (getEnv)

130+import System.Directory ( getAppUserDataDirectory, doesFileExist

131+ , createDirectoryIfMissing

132+ )

133+import System.Environment (lookupEnv)

134+import System.FilePath ((</>), takeDirectory)

87135import System.Posix.IO (stdInput, stdOutput)

88136import System.Posix.Types (Fd(..))

137+import Foreign.C.Types (CInt(..), CChar(..))

89138

90139import Text.Parsec hiding ((<|>))

91140import Text.Parsec.Token ( GenLanguageDef(..) )

92141import qualified Text.Parsec.Token as P

93142

94143-- | Type of errors that can be thrown when configuring VTY

95−data VtyConfigurationError

96− = VtyMissingTermEnvVar -- ^ TERM environment variable not set

97− deriving (Show, Eq, Typeable)

144+data VtyConfigurationError =

145+ VtyMissingTermEnvVar

146+ -- ^ TERM environment variable not set

147+ deriving (Show, Eq, Typeable)

98148

99149instance Exception VtyConfigurationError where

100− displayException VtyMissingTermEnvVar = "TERM environment variable not set"

150+ displayException VtyMissingTermEnvVar = "TERM environment variable not set"

101151

102152-- | Mappings from input bytes to event in the order specified. Later

103153-- entries take precedence over earlier in the case multiple entries

@@ -105,85 +155,144 @@ instance Exception VtyConfigurationError where

105155type InputMap = [(Maybe String, String, Event)]

106156

107157-- | A Vty configuration.

108−data Config = Config

109− {

110− -- | The default is 1 character.

111− vmin :: Maybe Int

112− -- | The default is 100 milliseconds, 0.1 seconds.

113− , vtime :: Maybe Int

114− -- | The default is False.

115− , mouseMode :: Maybe Bool

116− -- | The default is False.

117− , bracketedPasteMode :: Maybe Bool

118− -- | Debug information is appended to this file if not Nothing.

119− , debugLog :: Maybe FilePath

120− -- | The (input byte, output event) pairs extend the internal input

121− -- table of VTY and the table from terminfo.

122− --

123− -- See "Graphics.Vty.Config" module documentation for documentation

124− -- of the @map@ directive.

125− , inputMap :: InputMap

126− -- | The input file descriptor to use. The default is

127− -- 'System.Posix.IO.stdInput'

128− , inputFd :: Maybe Fd

129− -- | The output file descriptor to use. The default is

130− -- 'System.Posix.IO.stdOutput'

131− , outputFd :: Maybe Fd

132− -- | The terminal name used to look up terminfo capabilities.

133− -- The default is the value of the TERM environment variable.

134− , termName :: Maybe String

135− } deriving (Show, Eq)

158+data Config =

159+ Config { vmin :: Maybe Int

160+ -- ^ The default is 1 character.

161+ , vtime :: Maybe Int

162+ -- ^ The default is 100 milliseconds, 0.1 seconds.

163+ , mouseMode :: Maybe Bool

164+ -- ^ The default is False.

165+ , bracketedPasteMode :: Maybe Bool

166+ -- ^ The default is False.

167+ , debugLog :: Maybe FilePath

168+ -- ^ Debug information is appended to this file if not

169+ -- Nothing.

170+ , inputMap :: InputMap

171+ -- ^ The (input byte, output event) pairs extend the internal

172+ -- input table of VTY and the table from terminfo.

173+ --

174+ -- See "Graphics.Vty.Config" module documentation for

175+ -- documentation of the @map@ directive.

176+ , inputFd :: Maybe Fd

177+ -- ^ The input file descriptor to use. The default is

178+ -- 'System.Posix.IO.stdInput'

179+ , outputFd :: Maybe Fd

180+ -- ^ The output file descriptor to use. The default is

181+ -- 'System.Posix.IO.stdOutput'

182+ , termName :: Maybe String

183+ -- ^ The terminal name used to look up terminfo capabilities.

184+ -- The default is the value of the TERM environment variable.

185+ , termWidthMaps :: [(String, FilePath)]

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)

136203

137204defaultConfig :: Config

138205defaultConfig = mempty

139206

140−instance Monoid Config where

141− mempty = Config

142− { vmin = Nothing

143− , vtime = Nothing

144− , mouseMode = Nothing

145− , bracketedPasteMode = Nothing

146− , debugLog = mempty

147− , inputMap = mempty

148− , inputFd = Nothing

149− , outputFd = Nothing

150− , termName = Nothing

151− }

152− mappend c0 c1 = Config

207+instance Semigroup Config where

208+ c0 <> c1 =

153209 -- latter config takes priority for everything but inputMap

154− { vmin = vmin c1 <|> vmin c0

155− , vtime = vtime c1 <|> vtime c0

156− , mouseMode = mouseMode c1

157− , bracketedPasteMode = bracketedPasteMode c1

158− , debugLog = debugLog c1 <|> debugLog c0

159− , inputMap = inputMap c0 <> inputMap c1

160− , inputFd = inputFd c1 <|> inputFd c0

161− , outputFd = outputFd c1 <|> outputFd c0

162− , termName = termName c1 <|> termName c0

163− }

164−

165−-- | Load a configuration from @'getAppUserDataDirectory'/config@ and

166−-- @$VTY_CONFIG_FILE@.

210+ Config { vmin = vmin c1 <|> vmin c0

211+ , vtime = vtime c1 <|> vtime c0

212+ , mouseMode = mouseMode c1

213+ , bracketedPasteMode = bracketedPasteMode c1

214+ , debugLog = debugLog c1 <|> debugLog c0

215+ , inputMap = inputMap c0 <> inputMap c1

216+ , inputFd = inputFd c1 <|> inputFd c0

217+ , outputFd = outputFd c1 <|> outputFd c0

218+ , 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+ }

224+

225+instance Monoid Config where

226+ mempty =

227+ Config { vmin = Nothing

228+ , vtime = Nothing

229+ , mouseMode = Nothing

230+ , bracketedPasteMode = Nothing

231+ , debugLog = mempty

232+ , inputMap = mempty

233+ , inputFd = Nothing

234+ , outputFd = Nothing

235+ , termName = Nothing

236+ , termWidthMaps = []

237+ , allowCustomUnicodeWidthTables = Nothing

238+ , colorMode = Nothing

239+ }

240+#if !(MIN_VERSION_base(4,11,0))

241+ mappend = (<>)

242+#endif

243+

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@.

167256userConfig :: IO Config

168257userConfig = do

169− configFile <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile

170− overrideConfig <- maybe (return defaultConfig) parseConfigFile =<< getEnv "VTY_CONFIG_FILE"

258+ configFile <- vtyConfigPath >>= parseConfigFile

259+ overrideConfig <- maybe (return defaultConfig) parseConfigFile =<<

260+ lookupEnv vtyConfigFileEnvName

171261 let base = configFile <> overrideConfig

172262 mappend base <$> overrideEnvConfig

173263

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+

174282overrideEnvConfig :: IO Config

175283overrideEnvConfig = do

176− d <- getEnv "VTY_DEBUG_LOG"

284+ d <- lookupEnv "VTY_DEBUG_LOG"

177285 return $ defaultConfig { debugLog = d }

178286

179287-- | Configures VTY using defaults suitable for terminals. This function

180288-- can raise 'VtyConfigurationError'.

181289standardIOConfig :: IO Config

182290standardIOConfig = do

183− mb <- getEnv "TERM"

291+ mb <- lookupEnv termVariable

184292 case mb of

185293 Nothing -> throwIO VtyMissingTermEnvVar

186− Just t ->

294+ Just t -> do

295+ mcolorMode <- detectColorMode t

187296 return defaultConfig

188297 { vmin = Just 1

189298 , mouseMode = Just False

@@ -192,6 +301,7 @@ standardIOConfig = do

192301 , inputFd = Just stdInput

193302 , outputFd = Just stdOutput

194303 , termName = Just t

304+ , colorMode = Just mcolorMode

195305 }

196306

197307parseConfigFile :: FilePath -> IO Config

@@ -243,13 +353,20 @@ debugLogDecl = do

243353 path <- P.stringLiteral configLexer

244354 return defaultConfig { debugLog = Just path }

245355

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+

246363ignoreLine :: Parser ()

247364ignoreLine = void $ manyTill anyChar newline

248365

249366parseConfig :: Parser Config

250367parseConfig = liftM mconcat $ many $ do

251368 P.whiteSpace configLexer

252− let directives = [try mapDecl, try debugLogDecl]

369+ let directives = [try mapDecl, try debugLogDecl, try widthMapDecl]

253370 choice directives <|> (ignoreLine >> return defaultConfig)

254371

255372class Parse a where parseValue :: Parser a

@@ -295,3 +412,77 @@ instance (GParseAlts f, GParseAlts g) => GParseAlts (f :+: g) where

295412 gparseAlts con = L1 <$> gparseAlts con <|> R1 <$> gparseAlts con

296413

297414instance 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

1212

1313import qualified Data.Vector as Vector

1414

15−rowOpsEffectedColumns :: DisplayOps -> [Int]

16−rowOpsEffectedColumns ops

17− = Vector.toList $ Vector.map spanOpsEffectedColumns ops

15+rowOpsAffectedColumns :: DisplayOps -> [Int]

16+rowOpsAffectedColumns ops

17+ = Vector.toList $ Vector.map spanOpsAffectedColumns ops

1818

1919allSpansHaveWidth :: DisplayOps -> Int -> Bool

2020allSpansHaveWidth ops expected

21− = all (== expected) $ Vector.toList $ Vector.map spanOpsEffectedColumns ops

21+ = all (== expected) $ Vector.toList $ Vector.map spanOpsAffectedColumns ops

2222

23−spanOpsEffectedRows :: DisplayOps -> Int

24−spanOpsEffectedRows ops

23+spanOpsAffectedRows :: DisplayOps -> Int

24+spanOpsAffectedRows ops

2525 = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList ops))

2626

2727type SpanConstructLog = [SpanConstructEvent]

src/Graphics/Vty/DisplayAttributes.hs+47−4

@@ -1,11 +1,18 @@

22{-# LANGUAGE BangPatterns #-}

3+{-# LANGUAGE CPP #-}

45module Graphics.Vty.DisplayAttributes where

67import Graphics.Vty.Attributes

89import Data.Bits ((.&.))

10+import Data.ByteString (ByteString)

11+#if !(MIN_VERSION_base(4,11,0))

12+import Data.Semigroup (Semigroup(..))

13+#endif

14+import Data.Text (Text)

15+import Data.Text.Encoding (encodeUtf8)

916

1017-- | Given the previously applied display attributes as a FixedAttr and

1118-- the current display attributes as an Attr produces a FixedAttr that

@@ -17,6 +24,7 @@ fixDisplayAttr fattr attr

1724 = FixedAttr (fixStyle (fixedStyle fattr) (attrStyle attr))

1825 (fixColor (fixedForeColor fattr) (attrForeColor attr))

1926 (fixColor (fixedBackColor fattr) (attrBackColor attr))

27+ (fixURL (fixedURL fattr) (attrURL attr))

2028 where

2129 fixStyle _s Default = defaultStyleMask

2230 fixStyle s KeepCurrent = s

@@ -24,6 +32,9 @@ fixDisplayAttr fattr attr

2432 fixColor _c Default = Nothing

2533 fixColor c KeepCurrent = c

2634 fixColor _c (SetTo c) = Just c

35+ fixURL c KeepCurrent = c

36+ fixURL _c (SetTo n) = Just n

37+ fixURL _c Default = Nothing

2738

2839-- | difference between two display attributes. Used in the calculation

2940-- of the operations required to go from one display attribute to the

@@ -36,16 +47,23 @@ data DisplayAttrDiff = DisplayAttrDiff

3647 { styleDiffs :: [StyleStateChange]

3748 , foreColorDiff :: DisplayColorDiff

3849 , backColorDiff :: DisplayColorDiff

50+ , urlDiff :: URLDiff

3951 }

4052 deriving (Show)

4153

42−instance Monoid DisplayAttrDiff where

43− mempty = DisplayAttrDiff [] NoColorChange NoColorChange

44− mappend d0 d1 =

54+instance Semigroup DisplayAttrDiff where

55+ d0 <> d1 =

4556 let ds = simplifyStyleDiffs (styleDiffs d0) (styleDiffs d1)

4657 fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1)

4758 bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1)

48− in DisplayAttrDiff ds fcd bcd

59+ ud = simplifyUrlDiffs (urlDiff d0) (urlDiff d1)

60+ in DisplayAttrDiff ds fcd bcd ud

61+

62+instance Monoid DisplayAttrDiff where

63+ mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange

64+#if !(MIN_VERSION_base(4,11,0))

65+ mappend = (<>)

66+#endif

4967

5068-- | Used in the computation of a final style attribute change.

5169simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]

@@ -58,6 +76,12 @@ simplifyColorDiffs _cd ColorToDefault = ColorToDefault

5876simplifyColorDiffs cd NoColorChange = cd

5977simplifyColorDiffs _cd (SetColor !c) = SetColor c

6078

79+-- | Consider two URL changes, which are mostly going to be the latter

80+-- unless the latter specifies no change.

81+simplifyUrlDiffs :: URLDiff -> URLDiff -> URLDiff

82+simplifyUrlDiffs ud NoLinkChange = ud

83+simplifyUrlDiffs _ ud = ud

84+

6185-- | Difference between two display color attribute changes.

6286data DisplayColorDiff

6387 = ColorToDefault

@@ -70,6 +94,10 @@ data DisplayColorDiff

7094data StyleStateChange

7195 = ApplyStandout

7296 | RemoveStandout

97+ | ApplyItalic

98+ | RemoveItalic

99+ | ApplyStrikethrough

100+ | RemoveStrikethrough

73101 | ApplyUnderline

74102 | RemoveUnderline

75103 | ApplyReverseVideo

@@ -82,6 +110,13 @@ data StyleStateChange

82110 | RemoveBold

83111 deriving (Show, Eq)

84112

113+-- Setting and unsetting hyperlinks

114+data URLDiff

115+ = LinkTo !ByteString

116+ | NoLinkChange

117+ | EndLink

118+ deriving (Show, Eq)

119+

85120-- | Determines the diff between two display&color attributes. This diff

86121-- determines the operations that actually get output to the terminal.

87122displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff

@@ -89,8 +124,14 @@ displayAttrDiffs attr attr' = DisplayAttrDiff

89124 { styleDiffs = diffStyles (fixedStyle attr) (fixedStyle attr')

90125 , foreColorDiff = diffColor (fixedForeColor attr) (fixedForeColor attr')

91126 , backColorDiff = diffColor (fixedBackColor attr) (fixedBackColor attr')

127+ , urlDiff = diffURL (fixedURL attr) (fixedURL attr')

92128 }

93129

130+diffURL :: Maybe Text -> Maybe Text -> URLDiff

131+diffURL Nothing Nothing = NoLinkChange

132+diffURL (Just _) Nothing = EndLink

133+diffURL _ (Just url) = LinkTo (encodeUtf8 url)

134+

94135diffColor :: Maybe Color -> Maybe Color -> DisplayColorDiff

95136diffColor Nothing (Just c') = SetColor c'

96137diffColor (Just c) (Just c')

@@ -104,6 +145,8 @@ diffStyles prev cur

104145 = mconcat

105146 [ styleDiff standout ApplyStandout RemoveStandout

106147 , styleDiff underline ApplyUnderline RemoveUnderline

148+ , styleDiff italic ApplyItalic RemoveItalic

149+ , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough

107150 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo

108151 , styleDiff blink ApplyBlink RemoveBlink

109152 , styleDiff dim ApplyDim RemoveDim

src/Graphics/Vty/Image.hs+33−16

@@ -1,5 +1,4 @@

2−{-# LANGUAGE BangPatterns #-}

32{-# LANGUAGE NamedFieldPuns #-}

43{-# LANGUAGE DisambiguateRecordFields #-}

54-- | A Vty program makes 'Picture's from 'Image's. This module provides

@@ -46,8 +45,12 @@ module Graphics.Vty.Image

4645 -- * Character width functions

4746 , safeWcwidth

4847 , safeWcswidth

48+ , safeWctwidth

49+ , safeWctlwidth

4950 , wcwidth

5051 , wcswidth

52+ , wctwidth

53+ , wctlwidth

5154 -- * Display Regions

5255 , DisplayText

5356 , DisplayRegion

@@ -113,14 +116,18 @@ horizCat = foldr horizJoin EmptyImage

113116vertCat :: [Image] -> Image

114117vertCat = foldr vertJoin EmptyImage

115118

116−-- | Make an 'Image' from a lazy text value.

119+-- | Make an 'Image' from a lazy text value. The text value should be

120+-- sanitized of escape sequences (ASCII 27) and carriage returns;

121+-- otherwise layout and attribute problems may result.

117122text :: Attr -> TL.Text -> Image

118−text a txt = let displayWidth = safeWcswidth (TL.unpack txt)

123+text a txt = let displayWidth = safeWctlwidth txt

119124 in HorizText a txt displayWidth (fromIntegral $! TL.length txt)

120125

121−-- | Make an 'Image' from a text value.

126+-- | Make an 'Image' from a text value. The text value should be

127+-- sanitized of escape sequences (ASCII 27) and carriage returns;

128+-- otherwise layout and attribute problems may result.

122129text' :: Attr -> T.Text -> Image

123−text' a txt = let displayWidth = safeWcswidth (T.unpack txt)

130+text' a txt = let displayWidth = safeWctwidth txt

124131 in HorizText a (TL.fromStrict txt) displayWidth (T.length txt)

125132

126133-- | Make an image from a single character. This is a standard Haskell

@@ -130,9 +137,11 @@ char a c =

130137 let displayWidth = safeWcwidth c

131138 in HorizText a (TL.singleton c) displayWidth 1

132139

133−-- | Make an image from a string of characters layed out on a single

140+-- | Make an image from a string of characters laid out on a single

134141-- row with the same display attribute. The string is assumed to be a

135−-- sequence of ISO-10646 characters.

142+-- sequence of ISO-10646 characters. The input string should be

143+-- sanitized of escape sequences (ASCII 27) and carriage returns;

144+-- otherwise layout and attribute problems may result.

136145--

137146-- Note: depending on how the Haskell compiler represents string

138147-- literals, a string literal in a UTF-8 encoded source file, for

@@ -166,11 +175,14 @@ utf8String a bytes = utf8Bytestring a (BL.pack bytes)

166175utf8Bytestring :: Attr -> BL.ByteString -> Image

167176utf8Bytestring a bs = text a (TL.decodeUtf8 bs)

168177

169−-- | Make an 'Image' from a UTF-8 encoded lazy bytestring.

178+-- | Make an 'Image' from a UTF-8 encoded strict bytestring.

170179utf8Bytestring' :: Attr -> B.ByteString -> Image

171180utf8Bytestring' a bs = text' a (T.decodeUtf8 bs)

172181

173182-- | Make an image filling a region with the specified character.

183+--

184+-- If either the width or height are less than or equal to 0, then

185+-- the result is the empty image.

174186charFill :: Integral d

175187 => Attr

176188 -- ^ The attribute to use.

@@ -181,14 +193,17 @@ charFill :: Integral d

181193 -> d

182194 -- ^ The region height.

183195 -> Image

184−charFill _a _c 0 _h = EmptyImage

185−charFill _a _c _w 0 = EmptyImage

186−charFill a c w h =

187− vertCat $ replicate (fromIntegral h) $ HorizText a txt displayWidth charWidth

188− where

189− txt = TL.replicate (fromIntegral w) (TL.singleton c)

190− displayWidth = safeWcwidth c * (fromIntegral w)

191− charWidth = fromIntegral w

196+charFill a c w h

197+ | w <= 0 || h <= 0 = EmptyImage

198+ | otherwise = vertCat

199+ $ replicate (fromIntegral h)

200+ $ HorizText a txt displayWidth charWidth

201+ where

202+ txt = TL.replicate charWidth (TL.singleton c)

203+ displayWidth = safeWcwidth c * charWidth

204+

205+ charWidth :: Num a => a

206+ charWidth = fromIntegral w

192207

193208-- | The empty image. Useful for fold combinators. These occupy no space

194209-- and do not affect display attributes.

@@ -242,6 +257,7 @@ translate x y i = translateX x (translateY y i)

242257-- | Translates an image by padding or cropping its left side.

243258translateX :: Int -> Image -> Image

244259translateX x i

260+ | x < 0 && (abs x > imageWidth i) = emptyImage

245261 | x < 0 = let s = abs x in CropLeft i s (imageWidth i - s) (imageHeight i)

246262 | x == 0 = i

247263 | otherwise = let h = imageHeight i in HorizJoin (BGFill x h) i (imageWidth i + x) h

@@ -249,6 +265,7 @@ translateX x i

249265-- | Translates an image by padding or cropping its top.

250266translateY :: Int -> Image -> Image

251267translateY y i

268+ | y < 0 && (abs y > imageHeight i) = emptyImage

252269 | y < 0 = let s = abs y in CropTop i s (imageWidth i) (imageHeight i - s)

253270 | y == 0 = i

254271 | otherwise = let w = imageWidth i in VertJoin (BGFill w y) i w (imageHeight i + y)

src/Graphics/Vty/Image/Internal.hs+16−32

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE NamedFieldPuns #-}

23{-# LANGUAGE DeriveGeneric #-}

34{-# OPTIONS_HADDOCK hide #-}

@@ -11,6 +12,9 @@ import GHC.Generics

1112

1213import Control.DeepSeq

1314

15+#if !(MIN_VERSION_base(4,11,0))

16+import Data.Semigroup (Semigroup(..))

17+#endif

1418import qualified Data.Text.Lazy as TL

1519

1620-- | A display text is a Data.Text.Lazy

@@ -138,37 +142,11 @@ data Image =

138142 --

139143 -- Any image of zero size equals the empty image.

140144 | EmptyImage

141− deriving (Eq, Generic)

142−

143−instance Show Image where

144− show ( HorizText { attr, displayText, outputWidth, charWidth } )

145− = "HorizText " ++ show displayText

146− ++ "@(" ++ show attr ++ ","

147− ++ show outputWidth ++ ","

148− ++ show charWidth ++ ")"

149− show ( BGFill { outputWidth, outputHeight } )

150− = "BGFill (" ++ show outputWidth ++ "," ++ show outputHeight ++ ")"

151− show ( HorizJoin { partLeft = l, partRight = r, outputWidth = c } )

152− = "HorizJoin " ++ show c ++ " (" ++ show l ++ " <|> " ++ show r ++ ")"

153− show ( VertJoin { partTop = t, partBottom = b, outputWidth = c, outputHeight = r } )

154− = "VertJoin [" ++ show c ++ ", " ++ show r ++ "] (" ++ show t ++ ") <-> (" ++ show b ++ ")"

155− show ( CropRight { croppedImage, outputWidth, outputHeight } )

156− = "CropRight [" ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

157− ++ " (" ++ show croppedImage ++ ")"

158− show ( CropLeft { croppedImage, leftSkip, outputWidth, outputHeight } )

159− = "CropLeft [" ++ show leftSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

160− ++ " (" ++ show croppedImage ++ ")"

161− show ( CropBottom { croppedImage, outputWidth, outputHeight } )

162− = "CropBottom [" ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

163− ++ " (" ++ show croppedImage ++ ")"

164− show ( CropTop { croppedImage, topSkip, outputWidth, outputHeight } )

165− = "CropTop [" ++ show topSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

166− ++ " (" ++ show croppedImage ++ ")"

167− show ( EmptyImage ) = "EmptyImage"

145+ deriving (Eq, Generic, Show, Read)

168146

169147-- | pretty print just the structure of an image.

170148ppImageStructure :: Image -> String

171−ppImageStructure inImg = go 0 inImg

149+ppImageStructure = go 0

172150 where

173151 go indent img = tab indent ++ pp indent img

174152 tab indent = concat $ replicate indent " "

@@ -232,10 +210,16 @@ imageHeight CropBottom { outputHeight = h } = h

232210imageHeight CropTop { outputHeight = h } = h

233211imageHeight EmptyImage = 0

234212

235−-- | Append in the Monoid instance is equivalent to <->.

213+-- | Append in the 'Semigroup' instance is equivalent to '<->'.

214+instance Semigroup Image where

215+ (<>) = vertJoin

216+

217+-- | Append in the 'Monoid' instance is equivalent to '<->'.

236218instance Monoid Image where

237219 mempty = EmptyImage

238− mappend = vertJoin

220+#if !(MIN_VERSION_base(4,11,0))

221+ mappend = (<>)

222+#endif

239223

240224-- | combines two images side by side

241225--

@@ -244,7 +228,7 @@ instance Monoid Image where

244228--

245229-- The result image will have a width equal to the sum of the two images

246230-- width. And the height will equal the largest height of the two

247−-- images. The area not defined in one image due to a height missmatch

231+-- images. The area not defined in one image due to a height mismatch

248232-- will be filled with the background pattern.

249233horizJoin :: Image -> Image -> Image

250234horizJoin EmptyImage i = i

@@ -275,7 +259,7 @@ horizJoin _ _ = error "horizJoin applied to undefined values."

275259--

276260-- The result image will have a height equal to the sum of the heights

277261-- of both images. The width will equal the largest width of the two

278−-- images. The area not defined in one image due to a width missmatch

262+-- images. The area not defined in one image due to a width mismatch

279263-- will be filled with the background pattern.

280264vertJoin :: Image -> Image -> Image

281265vertJoin EmptyImage i = i

src/Graphics/Vty/Inline.hs+28−17

@@ -1,5 +1,3 @@

1−{-# LANGUAGE BangPatterns #-}

2−

31-- | The inline module provides a limited interface to changing the

42-- style of terminal output. The intention is for this interface to be

53-- used inline with other output systems.

@@ -48,22 +46,33 @@ import Data.IORef

4846

4947import System.IO

5048

51−type InlineM v = State Attr v

49+type InlineM v = State InlineState v

50+

51+data InlineState =

52+ InlineState { inlineAttr :: Attr

53+ , inlineUrlsEnabled :: Bool

54+ }

5255

5356-- | Set the background color to the provided 'Color'.

5457backColor :: Color -> InlineM ()

55−backColor c = modify $ flip mappend ( currentAttr `withBackColor` c )

58+backColor c = modify $ \s ->

59+ s { inlineAttr = inlineAttr s `withBackColor` c

60+ }

5661

5762-- | Set the foreground color to the provided 'Color'.

5863foreColor :: Color -> InlineM ()

59−foreColor c = modify $ flip mappend ( currentAttr `withForeColor` c )

64+foreColor c = modify $ \s ->

65+ s { inlineAttr = inlineAttr s `withForeColor` c

66+ }

6067

6168-- | Attempt to change the 'Style' of the following text..

6269--

6370-- If the terminal does not support the style change then no error is

6471-- produced. The style can still be removed.

6572applyStyle :: Style -> InlineM ()

66−applyStyle s = modify $ flip mappend ( currentAttr `withStyle` s )

73+applyStyle st = modify $ \s ->

74+ s { inlineAttr = inlineAttr s `withStyle` st

75+ }

6776

6877-- | Attempt to remove the specified 'Style' from the display of the

6978-- following text.

@@ -71,16 +80,18 @@ applyStyle s = modify $ flip mappend ( currentAttr `withStyle` s )

7180-- This will fail if 'applyStyle' for the given style has not been

7281-- previously called.

7382removeStyle :: Style -> InlineM ()

74−removeStyle sMask = modify $ \attr ->

75− let style' = case attrStyle attr of

76− Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

77− KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

78− SetTo s -> s .&. complement sMask

79− in attr { attrStyle = SetTo style' }

83+removeStyle sMask = modify $ \s ->

84+ s { inlineAttr =

85+ let style' = case attrStyle (inlineAttr s) of

86+ Default -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

87+ KeepCurrent -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

88+ SetTo st -> st .&. complement sMask

89+ in (inlineAttr s) { attrStyle = SetTo style' }

90+ }

8091

8192-- | Reset the display attributes.

8293defaultAll :: InlineM ()

83−defaultAll = put defAttr

94+defaultAll = modify $ \s -> s { inlineAttr = defAttr }

8495

8596-- | Apply the provided display attribute changes to the given terminal

8697-- output device.

@@ -93,14 +104,14 @@ putAttrChange out c = liftIO $ do

93104 mfattr <- prevFattr <$> readIORef (assumedStateRef out)

94105 fattr <- case mfattr of

95106 Nothing -> do

96− liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc

97− return $ FixedAttr defaultStyleMask Nothing Nothing

107+ liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc False

108+ return $ FixedAttr defaultStyleMask Nothing Nothing Nothing

98109 Just v -> return v

99− let attr = execState c currentAttr

110+ let InlineState attr urlsEnabled = execState c (InlineState currentAttr False)

100111 attr' = limitAttrForDisplay out attr

101112 fattr' = fixDisplayAttr fattr attr'

102113 diffs = displayAttrDiffs fattr fattr'

103− outputByteBuffer out $ writeToByteString $ writeSetAttr dc fattr attr' diffs

114+ outputByteBuffer out $ writeToByteString $ writeSetAttr dc urlsEnabled fattr attr' diffs

104115 modifyIORef (assumedStateRef out) $ \s -> s { prevFattr = Just fattr' }

105116 inlineHack dc

106117

src/Graphics/Vty/Input.hs+14−23

@@ -1,4 +1,4 @@

1−{-# LANGUAGE RecordWildCards #-}

1+{-# LANGUAGE RecordWildCards, CPP #-}

33-- | This module provides the input layer for Vty, including methods

44-- for initializing an 'Input' structure and reading 'Event's from the

@@ -77,7 +77,7 @@

7777-- The input encoding determines how UTF-8 encoded characters are

7878-- recognized.

7979--

80−-- * 7-bit mode: UTF-8 can be input unambiguiously. UTF-8 input is

80+-- * 7-bit mode: UTF-8 can be input unambiguously. UTF-8 input is

8181-- a superset of ASCII. UTF-8 does not overlap escaped control key

8282-- sequences. However, the escape key must be differentiated from

8383-- escaped control key sequences by the timing of the input bytes.

@@ -95,7 +95,7 @@

9595--

9696-- == Terminal Input is Broken

9797--

98−-- Clearly terminal input has fundemental issues. There is no easy way

98+-- Clearly terminal input has fundamental issues. There is no easy way

9999-- to reliably resolve these issues.

100100--

101101-- One resolution would be to ditch standard terminal interfaces

@@ -132,7 +132,9 @@ import Lens.Micro

132132import qualified System.Console.Terminfo as Terminfo

133133import System.Posix.Signals.Exts

134134

135+#if !MIN_VERSION_base(4,11,0)

135136import Data.Monoid ((<>))

137+#endif

136138

137139-- | Set up the terminal with file descriptor `inputFd` for input.

138140-- Returns an 'Input'.

@@ -141,22 +143,8 @@ import Data.Monoid ((<>))

141143-- bytes comes from 'classifyMapForTerm' which is then overridden by

142144-- the the applicable entries from the configuration's 'inputMap'.

143145--

144−-- The terminal device is configured with the attributes:

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)

146+-- The terminal device's mode flags are configured by the

147+-- 'attributeControl' function.

160148inputForConfig :: Config -> IO Input

161149inputForConfig config@Config{ termName = Just termName

162150 , inputFd = Just termFd

@@ -166,20 +154,23 @@ inputForConfig config@Config{ termName = Just termName

166154 terminal <- Terminfo.setupTerm termName

167155 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]

168156 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides

169− (setAttrs,unsetAttrs) <- attributeControl termFd

157+ (setAttrs, unsetAttrs) <- attributeControl termFd

170158 setAttrs

171159 input <- initInput config activeInputMap

172160 let pokeIO = Catch $ do

173− let e = error "vty internal failure: this value should not propagate to users"

174161 setAttrs

175− atomically $ writeTChan (input^.eventChannel) (EvResize e e)

162+ atomically $ writeTChan (input^.eventChannel) ResumeAfterSignal

176163 _ <- installHandler windowChange pokeIO Nothing

177164 _ <- installHandler continueProcess pokeIO Nothing

165+

166+ let restore = unsetAttrs

167+

178168 return $ input

179169 { shutdownInput = do

180170 shutdownInput input

181171 _ <- installHandler windowChange Ignore Nothing

182172 _ <- installHandler continueProcess Ignore Nothing

183− unsetAttrs

173+ restore

174+ , restoreInputState = restoreInputState input >> restore

184175 }

185176inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig

src/Graphics/Vty/Input/Classify.hs+54−28

@@ -1,39 +1,55 @@

11{-# OPTIONS_HADDOCK hide #-}

2−-- This makes a kind of tri. Has space efficiency issues with large

2+-- This makes a kind of trie. Has space efficiency issues with large

33-- input blocks. Likely building a parser and just applying that would

44-- be better.

55module Graphics.Vty.Input.Classify

66 ( classify

77 , KClass(..)

8+ , ClassifierState(..)

89 )

910where

1011

1112import Graphics.Vty.Input.Events

1213import Graphics.Vty.Input.Mouse

14+import Graphics.Vty.Input.Focus

1315import Graphics.Vty.Input.Paste

1416import Graphics.Vty.Input.Classify.Types

1517

1618import Codec.Binary.UTF8.Generic (decode)

1719

18−import Data.List (inits)

20+import Control.Arrow (first)

1921import qualified Data.Map as M( fromList, lookup )

2022import Data.Maybe ( mapMaybe )

2123import qualified Data.Set as S( fromList, member )

2224

23−import Data.Char

2425import Data.Word

2526

26−compile :: ClassifyMap -> [Char] -> KClass

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

2743compile table = cl' where

2844 -- take all prefixes and create a set of these

29− prefixSet = S.fromList $ concatMap (init . inits . fst) $ table

45+ prefixSet = S.fromList $ concatMap (init . BS.inits . BS8.pack . fst) table

3046 maxValidInputLength = maximum (map (length . fst) table)

31− eventForInput = M.fromList table

32− cl' [] = Prefix

47+ eventForInput = M.fromList $ map (first BS8.pack) table

48+ cl' inputBlock | BS8.null inputBlock = Prefix

3349 cl' inputBlock = case M.lookup inputBlock eventForInput of

3450 -- if the inputBlock is exactly what is expected for an

3551 -- event then consume the whole block and return the event

36− Just e -> Valid e []

52+ Just e -> Valid e BS8.empty

3753 Nothing -> case S.member inputBlock prefixSet of

3854 True -> Prefix

3955 -- look up progressively smaller tails of the input

@@ -44,39 +60,49 @@ compile table = cl' where

4460 -- H: There will always be one match. The prefixSet

4561 -- contains, by definition, all prefixes of an event.

4662 False ->

47− let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock

63+ let inputPrefixes = reverse . take maxValidInputLength . tail . BS8.inits $ inputBlock

4864 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of

49− (s,e) : _ -> Valid e (drop (length s) inputBlock)

65+ (s,e) : _ -> Valid e (BS8.drop (BS8.length s) inputBlock)

5066 -- neither a prefix or a full event.

5167 [] -> Invalid

5268

53−classify :: ClassifyMap -> [Char] -> KClass

54−classify table =

55− let standardClassifier = compile table

56− in \s -> case s of

57− _ | bracketedPasteStarted s ->

69+classify :: ClassifyMap -> ClassifierState -> ByteString -> KClass

70+classify table = process

71+ where

72+ standardClassifier = compile table

73+

74+ process ClassifierStart s =

75+ case BS.uncons s of

76+ _ | 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 =

5886 if bracketedPasteFinished s

59− then parseBracketedPaste s

60− else Prefix

61− _ | isMouseEvent s -> classifyMouseEvent s

62− c:cs | ord c >= 0xC2 -> classifyUtf8 c cs

63− _ -> standardClassifier s

87+ then parseBracketedPaste $ BS.concat $ p:reverse (s:ps)

88+ else Chunk

89+ process ClassifierInChunk{} _ = Invalid

6490

65−classifyUtf8 :: Char -> [Char] -> KClass

91+classifyUtf8 :: Word8 -> ByteString -> KClass

6692classifyUtf8 c cs =

67− let n = utf8Length (ord c)

68− (codepoint,rest) = splitAt n (c:cs)

93+ let n = utf8Length c

94+ (codepoint,rest) = BS8.splitAt (n - 1) cs

6995

7096 codepoint8 :: [Word8]

71− codepoint8 = map (fromIntegral . ord) codepoint

97+ codepoint8 = c:BS.unpack codepoint

7298

7399 in case decode codepoint8 of

74− _ | n < length codepoint -> Prefix

75− Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest

100+ _ | n < BS.length codepoint + 1 -> Prefix

101+ Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest

76102 -- something bad happened; just ignore and continue.

77− Nothing -> Invalid

103+ Nothing -> Invalid

78104

79−utf8Length :: (Num t, Ord a, Num a) => a -> t

105+utf8Length :: Word8 -> Int

80106utf8Length c

81107 | c < 0x80 = 1

82108 | c < 0xE0 = 2

src/Graphics/Vty/Input/Classify/Parse.hs+10−7

@@ -16,12 +16,15 @@ import Graphics.Vty.Input.Classify.Types

1616import Control.Monad.Trans.Maybe

1717import Control.Monad.State

1818

19−type Parser a = MaybeT (State String) a

19+import qualified Data.ByteString.Char8 as BS8

20+import Data.ByteString.Char8 (ByteString)

21+

22+type Parser a = MaybeT (State ByteString) a

2023

2124-- | Run a parser on a given input string. If the parser fails, return

2225-- 'Invalid'. Otherwise return the valid event ('Valid') and the

2326-- remaining unparsed characters.

24−runParser :: String -> Parser Event -> KClass

27+runParser :: ByteString -> Parser Event -> KClass

2528runParser s parser =

2629 case runState (runMaybeT parser) s of

2730 (Nothing, _) -> Invalid

@@ -36,9 +39,9 @@ failParse = fail "invalid parse"

3639-- return '123' and consume those characters.

3740readInt :: Parser Int

3841readInt = do

39− s <- get

42+ s <- BS8.unpack <$> get

4043 case (reads :: ReadS Int) s of

41− [(i, rest)] -> put rest >> return i

44+ [(i, rest)] -> put (BS8.pack rest) >> return i

4245 _ -> failParse

4346

4447-- | Read a character from the input stream. If one cannot be read (e.g.

@@ -46,9 +49,9 @@ readInt = do

4649readChar :: Parser Char

4750readChar = do

4851 s <- get

49− case s of

50− c:rest -> put rest >> return c

51− _ -> failParse

52+ case BS8.uncons s of

53+ Just (c,rest) -> put rest >> return c

54+ Nothing -> failParse

5255

5356-- | Read a character from the input stream and fail parsing if it is

5457-- not the specified character.

src/Graphics/Vty/Input/Classify/Types.hs+7−1

@@ -1,5 +1,6 @@

11-- | This module exports the input classification type to avoid import

22-- cycles between other modules that need this.

3+{-# LANGUAGE StrictData #-}

34module Graphics.Vty.Input.Classify.Types

45 ( KClass(..)

56 )

@@ -7,8 +8,10 @@ where

89import Graphics.Vty.Input.Events

910

11+import Data.ByteString.Char8 (ByteString)

12+

1013data KClass

11− = Valid Event [Char]

14+ = Valid Event ByteString

1215 -- ^ A valid event was parsed. Any unused characters from the input

1316 -- stream are also provided.

1417 | Invalid

@@ -16,4 +19,7 @@ data KClass

1619 | Prefix

1720 -- ^ The input characters form the prefix of a valid event character

1821 -- 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.

1925 deriving(Show, Eq)

src/Graphics/Vty/Input/Events.hs+29−7

@@ -1,6 +1,8 @@

11{-# Language DeriveGeneric #-}

2+{-# Language StrictData #-}

23module Graphics.Vty.Input.Events where

5+import Control.DeepSeq

46import Data.ByteString

57import GHC.Generics

@@ -14,23 +16,29 @@ import GHC.Generics

1416--

1517-- * Actually, support for most of these but KEsc, KChar, KBS, and

1618-- KEnter vary by terminal and keyboard.

17−data Key = KEsc | KChar Char | KBS | KEnter

19+data Key = KEsc | KChar {-# UNPACK #-} Char | KBS | KEnter

1820 | KLeft | KRight | KUp | KDown

22+ | KFun {-# UNPACK #-} Int | KBackTab | KPrtScr | KPause | KIns

2224 deriving (Eq,Show,Read,Ord,Generic)

2325

26+instance NFData Key

27+

2428-- | Modifier keys. Key codes are interpreted such that users are more

2529-- likely to have Meta than Alt; for instance on the PC Linux console,

2630-- 'MMeta' will generally correspond to the physical Alt key.

2731data Modifier = MShift | MCtrl | MMeta | MAlt

2832 deriving (Eq,Show,Read,Ord,Generic)

2933

34+instance NFData Modifier

35+

3036-- | Mouse buttons.

31−data Button = BLeft | BMiddle | BRight

37+data Button = BLeft | BMiddle | BRight | BScrollUp | BScrollDown

3238 deriving (Eq,Show,Read,Ord,Generic)

3339

40+instance NFData Button

41+

3442-- | Events.

3543data Event

3644 = EvKey Key [Modifier]

@@ -44,10 +52,8 @@ data Event

4452 -- without specifying which one; in that case, Nothing is provided.

4553 -- Otherwise Just the button released is included in the event.

4654 | EvResize Int Int

47− -- ^ If read from 'eventChannel' this is the size at the time of the

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.

55+ -- The terminal window was resized and the size is provided in the

56+ -- integer fields (width, height).

5157 | EvPaste ByteString

5258 -- ^ A paste event occurs when a bracketed paste input sequence is

5359 -- received. For terminals that support bracketed paste mode, these

@@ -56,6 +62,22 @@ data Event

5662 -- input (which is probably bad, so beware!) Note that the data is

5763 -- provided in raw form and you'll have to decode (e.g. as UTF-8) if

5864 -- that's what your application expects.

65+ | EvLostFocus

66+ -- ^ The terminal running the application lost input focus.

67+ | EvGainedFocus

68+ -- ^ The terminal running the application gained input focus.

5969 deriving (Eq,Show,Read,Ord,Generic)

6070

71+instance NFData Event

72+

6173type 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.hsnew file+49

@@ -0,0 +1,49 @@

1+module Graphics.Vty.Input.Focus

2+ ( requestFocusEvents

3+ , disableFocusEvents

4+ , isFocusEvent

5+ , classifyFocusEvent

6+ )

7+where

9+import Graphics.Vty.Input.Events

10+import Graphics.Vty.Input.Classify.Types

11+import Graphics.Vty.Input.Classify.Parse

12+

13+import Control.Monad.State

14+

15+import qualified Data.ByteString.Char8 as BS8

16+import Data.ByteString.Char8 (ByteString)

17+

18+-- | These sequences set xterm-based terminals to send focus event

19+-- sequences.

20+requestFocusEvents :: ByteString

21+requestFocusEvents = BS8.pack "\ESC[?1004h"

22+

23+-- | These sequences disable focus events.

24+disableFocusEvents :: ByteString

25+disableFocusEvents = BS8.pack "\ESC[?1004l"

26+

27+-- | Does the specified string begin with a focus event?

28+isFocusEvent :: ByteString -> Bool

29+isFocusEvent s = BS8.isPrefixOf focusIn s ||

30+ BS8.isPrefixOf focusOut s

31+

32+focusIn :: ByteString

33+focusIn = BS8.pack "\ESC[I"

34+

35+focusOut :: ByteString

36+focusOut = BS8.pack "\ESC[O"

37+

38+-- | Attempt to classify an input string as a focus event.

39+classifyFocusEvent :: ByteString -> KClass

40+classifyFocusEvent s = runParser s $ do

41+ when (not $ isFocusEvent s) failParse

42+

43+ expectChar '\ESC'

44+ expectChar '['

45+ ty <- readChar

46+ case ty of

47+ 'I' -> return EvGainedFocus

48+ 'O' -> return EvLostFocus

49+ _ -> failParse

src/Graphics/Vty/Input/Loop.hs+87−30

@@ -1,8 +1,9 @@

1−{-# LANGUAGE RecordWildCards #-}

2−{-# OPTIONS_HADDOCK hide #-}

1+{-# LANGUAGE CPP #-}

32{-# LANGUAGE NoMonomorphismRestriction #-}

3+{-# LANGUAGE RecordWildCards #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

45{-# LANGUAGE TemplateHaskell #-}

5−{-# LANGUAGE CPP #-}

6+{-# OPTIONS_HADDOCK hide #-}

67-- | The input layer used to be a single function that correctly

78-- accounted for the non-threaded runtime by emulating the terminal

89-- VMIN adn VTIME handling. This has been removed and replace with a

@@ -24,7 +25,7 @@ import Control.Applicative

2425import Control.Concurrent

2526import Control.Concurrent.STM

2627import Control.Exception (mask, try, SomeException)

27−import Lens.Micro

28+import Lens.Micro hiding ((<>~))

2829import Lens.Micro.Mtl

2930import Lens.Micro.TH

3031import Control.Monad (when, mzero, forM_)

@@ -33,12 +34,15 @@ import Control.Monad.Trans.State (StateT(..), evalStateT)

3334import Control.Monad.State.Class (MonadState, modify)

3435import Control.Monad.Trans.Reader (ReaderT(..))

3536

36−import Data.Char

37+import qualified Data.ByteString.Char8 as BS8

38+import qualified Data.ByteString as BS

39+import Data.ByteString.Char8 (ByteString)

3740import Data.IORef

3841import Data.Word (Word8)

3942

40−import Foreign ( allocaArray, peekArray, Ptr )

43+import Foreign (allocaArray)

4144import Foreign.C.Types (CInt(..))

45+import Foreign.Ptr (Ptr, castPtr)

4246

4347import System.IO

4448import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))

@@ -51,10 +55,15 @@ data Input = Input

5155 { -- | Channel of events direct from input processing. Unlike

5256 -- 'nextEvent' this will not refresh the display if the next event

5357 -- is an 'EvResize'.

54− _eventChannel :: TChan Event

55− -- | Shuts down the input processing. This should return the

56− -- terminal input state to before he input initialized.

58+ _eventChannel :: TChan InternalEvent

59+ -- | Shuts down the input processing. As part of shutting down the

60+ -- input, this should also restore the input state.

5761 , 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 ()

5867 -- | Changes to this value are reflected after the next event.

5968 , _configRef :: IORef Config

6069 -- | input debug log

@@ -71,10 +80,11 @@ data InputBuffer = InputBuffer

7180makeLenses ''InputBuffer

7281

7382data InputState = InputState

74− { _unprocessedBytes :: String

83+ { _unprocessedBytes :: ByteString

84+ , _classifierState :: ClassifierState

7585 , _appliedConfig :: Config

7686 , _inputBuffer :: InputBuffer

77− , _classifier :: String -> KClass

87+ , _classifier :: ClassifierState -> ByteString -> KClass

7888 }

7989

8090makeLenses ''InputState

@@ -99,20 +109,20 @@ loopInputProcessor = do

99109 dropInvalid

100110 loopInputProcessor

101111

102−addBytesToProcess :: String -> InputM ()

112+addBytesToProcess :: ByteString -> InputM ()

103113addBytesToProcess block = unprocessedBytes <>= block

104114

105115emit :: Event -> InputM ()

106116emit event = do

107117 logMsg $ "parsed event: " ++ show event

108− view eventChannel >>= liftIO . atomically . flip writeTChan event

118+ view eventChannel >>= liftIO . atomically . flip writeTChan (InputEvent event)

109119

110120-- The timing requirements are assured by the VMIN and VTIME set for the

111121-- device.

112122--

113123-- Precondition: Under the threaded runtime. Only current use is from a

114124-- forkOS thread. That case satisfies precondition.

115−readFromDevice :: InputM String

125+readFromDevice :: InputM ByteString

116126readFromDevice = do

117127 newConfig <- view configRef >>= liftIO . readIORef

118128 oldConfig <- use appliedConfig

@@ -132,9 +142,10 @@ readFromDevice = do

132142 threadWaitRead fd

133143 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)

134144 if bytesRead > 0

135− then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr

136− else return []

137− when (not $ null stringRep) $ logMsg $ "input bytes: " ++ show stringRep

145+ then BS.packCStringLen (castPtr bufferPtr, fromIntegral bytesRead)

146+ else return BS.empty

147+ when (not $ BS.null stringRep) $

148+ logMsg $ "input bytes: " ++ show (BS8.unpack stringRep)

138149 return stringRep

139150

140151applyConfig :: Fd -> Config -> IO ()

@@ -145,41 +156,86 @@ applyConfig _ _ = fail "(vty) applyConfig was not provided a complete configurat

145156parseEvent :: InputM Event

146157parseEvent = do

147158 c <- use classifier

159+ s <- use classifierState

148160 b <- use unprocessedBytes

149− case c b of

161+ case c s b of

150162 Valid e remaining -> do

151163 logMsg $ "valid parse: " ++ show e

152164 logMsg $ "remaining: " ++ show remaining

165+ classifierState .= ClassifierStart

153166 unprocessedBytes .= remaining

154167 return e

155− _ -> mzero

168+ _ -> mzero

156169

157170dropInvalid :: InputM ()

158171dropInvalid = do

159172 c <- use classifier

173+ s <- use classifierState

160174 b <- use unprocessedBytes

161− when (c b == Invalid) $ do

162− logMsg "dropping input bytes"

163− 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

183+ logMsg "dropping input bytes"

184+ classifierState .= ClassifierStart

185+ unprocessedBytes .= BS8.empty

186+ _ -> return ()

164187

165188runInputProcessorLoop :: ClassifyMap -> Input -> IO ()

166189runInputProcessorLoop classifyTable input = do

167190 let bufferSize = 1024

168191 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do

169− s0 <- InputState [] <$> readIORef (_configRef input)

170− <*> pure (InputBuffer bufferPtr bufferSize)

171− <*> pure (classify classifyTable)

192+ s0 <- InputState BS8.empty ClassifierStart

193+ <$> readIORef (_configRef input)

194+ <*> pure (InputBuffer bufferPtr bufferSize)

195+ <*> pure (classify classifyTable)

172196 runReaderT (evalStateT loopInputProcessor s0) input

173197

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)

174223attributeControl :: Fd -> IO (IO (), IO ())

175224attributeControl fd = do

176225 original <- getTerminalAttributes fd

177− let vtyMode = foldl withoutMode original [ StartStopOutput, KeyboardInterrupts

178− , EnableEcho, ProcessInput, ExtendedFunctions

179− ]

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

232+ , EnableEcho -- ECHO

233+ , ProcessInput -- ICANON

234+ , ExtendedFunctions -- IEXTEN

235+ ]

180236 let setAttrs = setTerminalAttributes fd vtyMode Immediately

181237 unsetAttrs = setTerminalAttributes fd original Immediately

182− return (setAttrs,unsetAttrs)

238+ return (setAttrs, unsetAttrs)

183239

184240logInitialInputState :: Input -> ClassifyMap -> IO()

185241logInitialInputState input classifyTable = case _inputDebug input of

@@ -187,7 +243,7 @@ logInitialInputState input classifyTable = case _inputDebug input of

187243 Just h -> do

188244 Config{ vmin = Just theVmin

189245 , vtime = Just theVtime

190− , termName = Just theTerm, .. } <- readIORef $ _configRef input

246+ , termName = Just theTerm } <- readIORef $ _configRef input

191247 _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))

192248 forM_ classifyTable $ \i -> case i of

193249 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)

@@ -203,6 +259,7 @@ initInput config classifyTable = do

203259 applyConfig fd config

204260 stopSync <- newEmptyMVar

205261 input <- Input <$> atomically newTChan

262+ <*> pure (return ())

206263 <*> pure (return ())

207264 <*> newIORef config

208265 <*> maybe (return Nothing)

src/Graphics/Vty/Input/Mouse.hs+28−18

@@ -15,10 +15,12 @@ import Graphics.Vty.Input.Classify.Types

1515import Graphics.Vty.Input.Classify.Parse

1616

1717import Control.Monad.State

18−import Data.List (isPrefixOf)

1918import Data.Maybe (catMaybes)

2019import Data.Bits ((.&.))

2120

21+import qualified Data.ByteString.Char8 as BS8

22+import Data.ByteString.Char8 (ByteString)

23+

2224-- A mouse event in SGR extended mode is

2325--

2426-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')

@@ -32,28 +34,28 @@ import Data.Bits ((.&.))

3234

3335-- | These sequences set xterm-based terminals to send mouse event

3436-- sequences.

35−requestMouseEvents :: String

36−requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h\ESC[?1005h"

37+requestMouseEvents :: ByteString

38+requestMouseEvents = BS8.pack "\ESC[?1000h\ESC[?1002h\ESC[?1006h"

3739

3840-- | These sequences disable mouse events.

39−disableMouseEvents :: String

40−disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l\ESC[?1005l"

41+disableMouseEvents :: ByteString

42+disableMouseEvents = BS8.pack "\ESC[?1000l\ESC[?1002l\ESC[?1006l"

4143

4244-- | Does the specified string begin with a mouse event?

43−isMouseEvent :: String -> Bool

45+isMouseEvent :: ByteString -> Bool

4446isMouseEvent s = isSGREvent s || isNormalEvent s

4547

46−isSGREvent :: String -> Bool

47−isSGREvent = isPrefixOf sgrPrefix

48+isSGREvent :: ByteString -> Bool

49+isSGREvent = BS8.isPrefixOf sgrPrefix

4850

49−sgrPrefix :: String

50−sgrPrefix = "\ESC[M"

51+sgrPrefix :: ByteString

52+sgrPrefix = BS8.pack "\ESC[M"

5153

52−isNormalEvent :: String -> Bool

53−isNormalEvent = isPrefixOf normalPrefix

54+isNormalEvent :: ByteString -> Bool

55+isNormalEvent = BS8.isPrefixOf normalPrefix

5456

55−normalPrefix :: String

56−normalPrefix = "\ESC[<"

57+normalPrefix :: ByteString

58+normalPrefix = BS8.pack "\ESC[<"

5759

5860-- Modifier bits:

5961shiftBit :: Int

@@ -67,7 +69,7 @@ ctrlBit = 16

6769

6870-- These bits indicate the buttons involved:

6971buttonMask :: Int

70−buttonMask = 3

72+buttonMask = 67

7173

7274leftButton :: Int

7375leftButton = 0

@@ -78,11 +80,17 @@ middleButton = 1

7880rightButton :: Int

7981rightButton = 2

8082

83+scrollUp :: Int

84+scrollUp = 64

85+

86+scrollDown :: Int

87+scrollDown = 65

88+

8189hasBitSet :: Int -> Int -> Bool

8290hasBitSet val bit = val .&. bit > 0

8391

84−-- | Attempt to lassify an input string as a mouse event.

85−classifyMouseEvent :: String -> KClass

92+-- | Attempt to classify an input string as a mouse event.

93+classifyMouseEvent :: ByteString -> KClass

8694classifyMouseEvent s = runParser s $ do

8795 when (not $ isMouseEvent s) failParse

8896

@@ -94,12 +102,14 @@ classifyMouseEvent s = runParser s $ do

94102 'M' -> classifyNormalMouseEvent

95103 _ -> failParse

96104

97−-- Given a modifer/button value, determine which button was indicated

105+-- Given a modifier/button value, determine which button was indicated

98106getSGRButton :: Int -> Parser Button

99107getSGRButton mods =

100108 let buttonMap = [ (leftButton, BLeft)

101109 , (middleButton, BMiddle)

102110 , (rightButton, BRight)

111+ , (scrollUp, BScrollUp)

112+ , (scrollDown, BScrollDown)

103113 ]

104114 in case lookup (mods .&. buttonMask) buttonMap of

105115 Nothing -> failParse

src/Graphics/Vty/Input/Paste.hs+16−24

@@ -9,41 +9,33 @@ module Graphics.Vty.Input.Paste

99where

1010

1111import qualified Data.ByteString.Char8 as BS8

12+import Data.ByteString.Char8 (ByteString)

1213

1314import Graphics.Vty.Input.Events

1415import Graphics.Vty.Input.Classify.Types

1516

16−import Data.List (isPrefixOf, isInfixOf)

17+bracketedPasteStart :: ByteString

18+bracketedPasteStart = BS8.pack "\ESC[200~"

1719

18−bracketedPasteStart :: String

19−bracketedPasteStart = "\ESC[200~"

20−

21−bracketedPasteEnd :: String

22−bracketedPasteEnd = "\ESC[201~"

20+bracketedPasteEnd :: ByteString

21+bracketedPasteEnd = BS8.pack "\ESC[201~"

2322

2423-- | Does the input start a bracketed paste?

25−bracketedPasteStarted :: String -> Bool

26−bracketedPasteStarted = isPrefixOf bracketedPasteStart

24+bracketedPasteStarted :: ByteString -> Bool

25+bracketedPasteStarted = BS8.isPrefixOf bracketedPasteStart

2726

2827-- | Does the input contain a complete bracketed paste?

29−bracketedPasteFinished :: String -> Bool

30−bracketedPasteFinished = isInfixOf bracketedPasteEnd

28+bracketedPasteFinished :: ByteString -> Bool

29+bracketedPasteFinished = BS8.isInfixOf bracketedPasteEnd

3130

3231-- | Parse a bracketed paste. This should only be called on a string if

3332-- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return

3433-- 'True'.

35−parseBracketedPaste :: String -> KClass

34+parseBracketedPaste :: ByteString -> KClass

3635parseBracketedPaste 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

41− in Valid (EvPaste $ BS8.pack p) rest'

42−

43−takeUntil :: (Eq a) => [a] -> [a] -> ([a],[a])

44−takeUntil [] _ = ([], [])

45−takeUntil cs sub

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)

36+ Valid (EvPaste p) (BS8.drop endLen rest')

37+ where

38+ startLen = BS8.length bracketedPasteStart

39+ endLen = BS8.length bracketedPasteEnd

40+ (_, rest ) = BS8.breakSubstring bracketedPasteStart s

41+ (p, rest') = BS8.breakSubstring bracketedPasteEnd . BS8.drop startLen $ rest

src/Graphics/Vty/Input/Terminfo.hs+6−4

@@ -74,7 +74,7 @@ visibleChars = [ ([x], EvKey (KChar x) [])

7474ctrlChars :: ClassifyMap

7575ctrlChars =

7676 [ ([toEnum x],EvKey (KChar y) [MCtrl])

77− | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_'])

77+ | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_'])

7878 , y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.

7979 , y /= 'h' -- CTRL-h should not hide BS

8080 ]

@@ -86,10 +86,12 @@ ctrlMetaChars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrlChars

8686-- | Esc, meta-esc, delete, meta-delete, enter, meta-enter.

8787specialSupportKeys :: ClassifyMap

8888specialSupportKeys =

89− [ -- special support for ESC

90− ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

89+ [ ("\ESC\ESC[5~",EvKey KPageUp [MMeta])

90+ , ("\ESC\ESC[6~",EvKey KPageDown [MMeta])

91+ -- special support for ESC

92+ , ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

9193 -- Special support for backspace

92− , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])

94+ , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta]), ("\b",EvKey KBS [])

9395 -- Special support for Enter

9496 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])

9597 -- explicit support for tab

src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+1−1

@@ -59,7 +59,7 @@ navKeys3 =

5959-- This encoding depends on the terminal.

6060functionKeys1 :: ClassifyMap

6161functionKeys1 =

62− let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in

62+ let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-head nrs+ff) m) | n <- nrs ] in

6363 concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]

6464

6565-- | encoding for meta plus char

src/Graphics/Vty/Output.hs+15−14

@@ -1,5 +1,4 @@

1−{-# LANGUAGE RecordWildCards #-}

2−{-# LANGUAGE NamedFieldPuns #-}

1+{-# LANGUAGE RecordWildCards, CPP #-}

32-- | This module provides functions for accessing the current terminal

43-- or a specific terminal device.

54--

@@ -38,10 +37,11 @@ import Graphics.Vty.Output.TerminfoBased as TerminfoBased

3837

3938import Blaze.ByteString.Builder (writeToByteString)

4039

41−import Control.Monad.Trans

42−

4340import Data.List (isPrefixOf)

41+

42+#if !MIN_VERSION_base(4,11,0)

4443import Data.Monoid ((<>))

44+#endif

4545

4646-- | Returns an `Output` for the terminal specified in `Config`.

4747--

@@ -58,11 +58,12 @@ import Data.Monoid ((<>))

5858-- * If TERM contains "xterm" or "screen", use XTermColor.

5959-- * otherwise use the TerminfoBased driver.

6060outputForConfig :: Config -> IO Output

61−outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do

61+outputForConfig Config{ outputFd = Just fd, termName = Just termName

62+ , colorMode = Just colorMode, .. } = do

6263 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName

63− then XTermColor.reserveTerminal termName fd

64+ then XTermColor.reserveTerminal termName fd colorMode

6465 -- Not an xterm-like terminal. try for generic terminfo.

65− else TerminfoBased.reserveTerminal termName fd

66+ else TerminfoBased.reserveTerminal termName fd colorMode

6667

6768 case mouseMode of

6869 Just s -> setMode t Mouse s

@@ -77,30 +78,30 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig

7778

7879-- | Sets the cursor position to the given output column and row.

7980--

80−-- This is not necessarially the same as the character position with the

81+-- This is not necessarily the same as the character position with the

8182-- same coordinates. Characters can be a variable number of columns in

8283-- width.

8384--

8485-- Currently, the only way to set the cursor position to a given

8586-- character coordinate is to specify the coordinate in the Picture

8687-- instance provided to 'outputPicture' or 'refresh'.

87−setCursorPos :: MonadIO m => Output -> Int -> Int -> m ()

88+setCursorPos :: Output -> Int -> Int -> IO ()

8889setCursorPos t x y = do

8990 bounds <- displayBounds t

9091 when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do

9192 dc <- displayContext t bounds

92− liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

93+ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

9394

9495-- | Hides the cursor.

95−hideCursor :: MonadIO m => Output -> m ()

96+hideCursor :: Output -> IO ()

9697hideCursor t = do

9798 bounds <- displayBounds t

9899 dc <- displayContext t bounds

99− liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc

100+ outputByteBuffer t $ writeToByteString $ writeHideCursor dc

100101

101102-- | Shows the cursor.

102−showCursor :: MonadIO m => Output -> m ()

103+showCursor :: Output -> IO ()

103104showCursor t = do

104105 bounds <- displayBounds t

105106 dc <- displayContext t bounds

106− liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc

107+ outputByteBuffer t $ writeToByteString $ writeShowCursor dc

src/Graphics/Vty/Output/Interface.hs+88−52

@@ -1,9 +1,9 @@

11-- Copyright Corey O'Connor

2−{-# LANGUAGE BangPatterns #-}

32{-# LANGUAGE RankNTypes #-}

43{-# LANGUAGE ExistentialQuantification #-}

54{-# LANGUAGE GADTs #-}

65{-# LANGUAGE FlexibleContexts #-}

6+{-# LANGUAGE ScopedTypeVariables #-}

77-- | This module provides an abstract interface for performing terminal

88-- output. The only user-facing part of this API is 'Output'.

99module Graphics.Vty.Output.Interface

@@ -29,8 +29,6 @@ import Graphics.Vty.DisplayAttributes

2929import Blaze.ByteString.Builder (Write, writeToByteString)

3030import Blaze.ByteString.Builder.ByteString (writeByteString)

3131

32−import Control.Monad.Trans

33−

3432import qualified Data.ByteString as BS

3533import Data.IORef

3634import qualified Data.Text.Encoding as T

@@ -44,6 +42,15 @@ data Mode = Mouse

4442 | BracketedPaste

4543 -- ^ Paste mode (whether the terminal is configured to provide

4644 -- events on OS pastes)

45+ | Focus

46+ -- ^ Focus-in/focus-out events (whether the terminal is

47+ -- configured to provide events on focus change)

48+ | Hyperlink

49+ -- ^ Hyperlink mode via the 'withURL' attribute modifier (see

50+ -- https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda).

51+ -- Note that this may not work gracefully in all terminal

52+ -- emulators so be sure to test this mode with the terminals

53+ -- you intend to support. It is off by default.

4754 deriving (Eq, Read, Show)

4855

4956-- | The Vty terminal output interface.

@@ -52,7 +59,7 @@ data Output = Output

5259 terminalID :: String

5360 -- | Release the terminal just prior to application exit and reset

5461 -- it to its state prior to application startup.

55− , releaseTerminal :: forall m. MonadIO m => m ()

62+ , releaseTerminal :: IO ()

5663 -- | Clear the display and initialize the terminal to some initial

5764 -- display state.

5865 --

@@ -62,40 +69,57 @@ data Output = Output

6269 -- - cursor at top left

6370 -- - UTF-8 character encoding

6471 -- - drawing characteristics are the default

65− , reserveDisplay :: forall m. MonadIO m => m ()

72+ , reserveDisplay :: IO ()

6673 -- | Return the display to the state before `reserveDisplay` If no

6774 -- previous state then set the display state to the initial state.

68− , releaseDisplay :: forall m. MonadIO m => m ()

75+ , releaseDisplay :: IO ()

76+ -- | Sets the current display bounds (width, height).

77+ , setDisplayBounds :: (Int, Int) -> IO ()

6978 -- | Returns the current display bounds.

70− , displayBounds :: forall m. MonadIO m => m DisplayRegion

79+ , displayBounds :: IO DisplayRegion

7180 -- | Output the bytestring to the terminal device.

7281 , outputByteBuffer :: BS.ByteString -> IO ()

73− -- | Specifies the maximum number of colors supported by the

74− -- context.

75− , contextColorCount :: Int

7682 -- | Specifies whether the cursor can be shown / hidden.

7783 , supportsCursorVisibility :: Bool

7884 -- | Indicates support for terminal modes for this output device.

7985 , supportsMode :: Mode -> Bool

8086 -- | Enables or disables a mode (does nothing if the mode is

8187 -- unsupported).

82− , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()

88+ , setMode :: Mode -> Bool -> IO ()

8389 -- | Returns whether a mode is enabled.

84− , getModeStatus :: forall m. MonadIO m => Mode -> m Bool

90+ , getModeStatus :: Mode -> IO Bool

8591 , assumedStateRef :: IORef AssumedState

8692 -- | Acquire display access to the given region of the display.

8793 -- Currently all regions have the upper left corner of (0,0) and

8894 -- the lower right corner at (max displayWidth providedWidth, max

8995 -- displayHeight providedHeight)

90− , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext

96+ , mkDisplayContext :: Output -> DisplayRegion -> IO DisplayContext

9197 -- | Ring the terminal bell if supported.

92− , ringTerminalBell :: forall m. MonadIO m => m ()

98+ , ringTerminalBell :: IO ()

9399 -- | Returns whether the terminal has an audio bell feature.

94− , supportsBell :: forall m. MonadIO m => m Bool

100+ , supportsBell :: IO 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

95119 }

96120

97−displayContext :: MonadIO m => Output -> DisplayRegion -> m DisplayContext

98−displayContext t = liftIO . mkDisplayContext t t

121+displayContext :: Output -> DisplayRegion -> IO DisplayContext

122+displayContext t = mkDisplayContext t t

99123

100124data AssumedState = AssumedState

101125 { prevFattr :: Maybe FixedAttr

@@ -130,9 +154,9 @@ data DisplayContext = DisplayContext

130154 -- to support this the currently applied display attributes are

131155 -- required. In addition it may be possible to optimize the state

132156 -- changes based off the currently applied display attributes.

133− , writeSetAttr :: FixedAttr -> Attr -> DisplayAttrDiff -> Write

157+ , writeSetAttr :: Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write

134158 -- | Reset the display attributes to the default display attributes.

135− , writeDefaultAttr :: Write

159+ , writeDefaultAttr :: Bool -> Write

136160 , writeRowEnd :: Write

137161 -- | See `Graphics.Vty.Output.XTermColor.inlineHack`

138162 , inlineHack :: IO ()

@@ -154,24 +178,24 @@ writeUtf8Text = writeByteString

154178-- 4. Serialized to the display.

155179--

156180-- 5. The cursor is then shown and positioned or kept hidden.

157−outputPicture :: MonadIO m => DisplayContext -> Picture -> m ()

158−outputPicture dc pic = liftIO $ do

181+outputPicture :: DisplayContext -> Picture -> IO ()

182+outputPicture dc pic = do

183+ urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink

159184 as <- readIORef (assumedStateRef $ contextDevice dc)

160185 let manipCursor = supportsCursorVisibility (contextDevice dc)

161186 r = contextRegion dc

162187 ops = displayOpsForPic pic r

163− initialAttr = FixedAttr defaultStyleMask Nothing Nothing

188+ initialAttr = FixedAttr defaultStyleMask Nothing Nothing Nothing

164189 -- Diff the previous output against the requested output.

165190 -- Differences are currently on a per-row basis.

166191 diffs :: [Bool] = case prevOutputOps as of

167192 Nothing -> replicate (fromEnum $ regionHeight $ affectedRegion ops) True

168193 Just previousOps -> if affectedRegion previousOps /= affectedRegion ops

169194 then replicate (displayOpsRows ops) True

170− else zipWith (/=) (Vector.toList previousOps)

171− (Vector.toList ops)

195+ else Vector.toList $ Vector.zipWith (/=) previousOps ops

172196 -- build the Write corresponding to the output image

173197 out = (if manipCursor then writeHideCursor dc else mempty)

174− `mappend` writeOutputOps dc initialAttr diffs ops

198+ `mappend` writeOutputOps urlsEnabled dc initialAttr diffs ops

175199 `mappend`

176200 (let (w,h) = contextRegion dc

177201 clampX = max 0 . min (w-1)

@@ -182,9 +206,15 @@ outputPicture dc pic = liftIO $ do

182206 AbsoluteCursor x y ->

183207 writeShowCursor dc `mappend`

184208 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)

185215 Cursor x y ->

186216 let m = cursorOutputMap ops $ picCursor pic

187− (ox, oy) = charToOutputPos m (x,y)

217+ (ox, oy) = charToOutputPos m (clampX x, clampY y)

188218 in writeShowCursor dc `mappend`

189219 writeMoveCursor dc (clampX ox) (clampY oy)

190220 )

@@ -194,15 +224,15 @@ outputPicture dc pic = liftIO $ do

194224 let as' = as { prevOutputOps = Just ops }

195225 writeIORef (assumedStateRef $ contextDevice dc) as'

196226

197−writeOutputOps :: DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write

198−writeOutputOps dc initialAttr diffs ops =

227+writeOutputOps :: Bool -> DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write

228+writeOutputOps urlsEnabled dc initialAttr diffs ops =

199229 let (_, out, _) = Vector.foldl' writeOutputOps'

200230 (0, mempty, diffs)

201231 ops

202232 in out

203233 where

204234 writeOutputOps' (y, out, True : diffs') spanOps

205− = let spanOut = writeSpanOps dc y initialAttr spanOps

235+ = let spanOut = writeSpanOps urlsEnabled dc y initialAttr spanOps

206236 out' = out `mappend` spanOut

207237 in (y+1, out', diffs')

208238 writeOutputOps' (y, out, False : diffs') _spanOps

@@ -210,27 +240,27 @@ writeOutputOps dc initialAttr diffs ops =

210240 writeOutputOps' (_y, _out, []) _spanOps

211241 = error "vty - output spans without a corresponding diff."

212242

213−writeSpanOps :: DisplayContext -> Int -> FixedAttr -> SpanOps -> Write

214−writeSpanOps dc y initialAttr spanOps =

243+writeSpanOps :: Bool -> DisplayContext -> Int -> FixedAttr -> SpanOps -> Write

244+writeSpanOps urlsEnabled dc y initialAttr spanOps =

215245 -- The first operation is to set the cursor to the start of the row

216− let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc

246+ let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc urlsEnabled

217247 -- then the span ops are serialized in the order specified

218− in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp dc op fattr of

248+ in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp urlsEnabled dc op fattr of

219249 (opOut, fattr') -> (out `mappend` opOut, fattr')

220250 )

221251 (start, initialAttr)

222252 spanOps

223253

224−writeSpanOp :: DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)

225−writeSpanOp dc (TextSpan attr _ _ str) fattr =

254+writeSpanOp :: Bool -> DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)

255+writeSpanOp urlsEnabled dc (TextSpan attr _ _ str) fattr =

226256 let attr' = limitAttrForDisplay (contextDevice dc) attr

227257 fattr' = fixDisplayAttr fattr attr'

228258 diffs = displayAttrDiffs fattr fattr'

229− out = writeSetAttr dc fattr attr' diffs

259+ out = writeSetAttr dc urlsEnabled fattr attr' diffs

230260 `mappend` writeUtf8Text (T.encodeUtf8 $ TL.toStrict str)

231261 in (out, fattr')

232−writeSpanOp _dc (Skip _) _fattr = error "writeSpanOp for Skip"

233−writeSpanOp dc (RowEnd _) fattr = (writeDefaultAttr dc `mappend` writeRowEnd dc, fattr)

262+writeSpanOp _ _ (Skip _) _fattr = error "writeSpanOp for Skip"

263+writeSpanOp urlsEnabled dc (RowEnd _) fattr = (writeDefaultAttr dc urlsEnabled `mappend` writeRowEnd dc, fattr)

234264

235265-- | The cursor position is given in X,Y character offsets. Due to

236266-- multi-column characters this needs to be translated to column, row

@@ -279,17 +309,23 @@ limitAttrForDisplay t attr

279309 where

280310 clampColor Default = Default

281311 clampColor KeepCurrent = KeepCurrent

282− clampColor (SetTo c) = clampColor' c

283− clampColor' (ISOColor v)

284− | contextColorCount t < 8 = Default

285− | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8)

286− | otherwise = SetTo $ ISOColor v

287− clampColor' (Color240 v)

288− -- Should we choose closest ISO color?

289− | contextColorCount t < 8 = Default

290− | contextColorCount t < 16 = Default

291− | contextColorCount t <= 256 = SetTo $ Color240 v

292− | otherwise

293− = let p :: Double = fromIntegral v / 240.0

294− v' = floor $ p * (fromIntegral $ contextColorCount t)

295− in SetTo $ Color240 v'

312+ clampColor (SetTo c) = clampColor' (outputColorMode t) c

313+

314+ clampColor' NoColor _ = Default

315+

316+ clampColor' ColorMode8 (ISOColor v)

317+ | v >= 8 = SetTo $ ISOColor (v - 8)

318+ | otherwise = SetTo $ ISOColor v

319+ clampColor' ColorMode8 _ = Default

320+

321+ clampColor' ColorMode16 c@(ISOColor _) = SetTo c

322+ clampColor' ColorMode16 _ = Default

323+

324+ clampColor' (ColorMode240 _) c@(ISOColor _) = SetTo c

325+ clampColor' (ColorMode240 colorCount) c@(Color240 n)

326+ | n <= colorCount = SetTo c

327+ | otherwise = Default

328+ clampColor' colorMode@(ColorMode240 _) (RGBColor r g b) =

329+ clampColor' colorMode (color240 r g b)

330+

331+ clampColor' FullColor c = SetTo c

src/Graphics/Vty/Output/Mock.hs+8−4

@@ -11,6 +11,7 @@ module Graphics.Vty.Output.Mock

1111where

1212

1313import Graphics.Vty.Image (DisplayRegion)

14+import Graphics.Vty.Attributes.Color (ColorMode(ColorMode16))

1415import Graphics.Vty.Output.Interface

1516

1617import Blaze.ByteString.Builder.Word (writeWord8)

@@ -30,7 +31,7 @@ type MockData = IORef (UTF8.UTF8 BS.ByteString)

3031-- without considering terminal specific issues.

3132--

3233-- The mock implementation is useful in manually determining if the

33−-- sequence of terminal operations matche the expected sequence. The

34+-- sequence of terminal operations matches the expected sequence. The

3435-- requirement of the produced representation is simplicity in parsing

3536-- the text representation and determining how the picture was mapped to

3637-- terminal operations.

@@ -48,16 +49,19 @@ mockTerminal r = liftIO $ do

4849 , releaseDisplay = return ()

4950 , ringTerminalBell = return ()

5051 , supportsBell = return False

52+ , supportsItalics = return False

53+ , supportsStrikethrough = return False

54+ , setDisplayBounds = const $ return ()

5155 , displayBounds = return r

5256 , outputByteBuffer = \bytes -> do

5357 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"

5458 writeIORef outRef $ UTF8.fromRep bytes

55− , contextColorCount = 16

5659 , supportsCursorVisibility = True

5760 , supportsMode = const False

5861 , setMode = const $ const $ return ()

5962 , getModeStatus = const $ return False

6063 , assumedStateRef = newAssumedStateRef

64+ , outputColorMode = ColorMode16

6165 , mkDisplayContext = \tActual rActual -> return $ DisplayContext

6266 { contextRegion = rActual

6367 , contextDevice = tActual

@@ -72,10 +76,10 @@ mockTerminal r = liftIO $ do

7276 , writeHideCursor = writeWord8 $ toEnum $ fromEnum 'H'

7377 -- An attr change is always visualized as the single

7478 -- character 'A'

75− , writeSetAttr = \_fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'

79+ , writeSetAttr = \_ _fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'

7680 -- default attr is always visualized as the single

7781 -- character 'D'

78− , writeDefaultAttr = writeWord8 $ toEnum $ fromEnum 'D'

82+ , writeDefaultAttr = const $ writeWord8 $ toEnum $ fromEnum 'D'

7983 -- row end is always visualized as the single character

8084 -- 'E'

8185 , writeRowEnd = writeWord8 $ toEnum $ fromEnum 'E'

src/Graphics/Vty/Output/TerminfoBased.hs+190−63

@@ -1,5 +1,6 @@

1−{-# LANGUAGE RecordWildCards #-}

21{-# LANGUAGE FlexibleInstances #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE CPP #-}

34{-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-}

45{-# CFILES gwinsz.c #-}

@@ -8,10 +9,13 @@

89-- Copyright Corey O'Connor (coreyoconnor@gmail.com)

910module Graphics.Vty.Output.TerminfoBased

1011 ( reserveTerminal

12+ , setWindowSize

1113 )

1214where

1315

1416import Control.Monad (when)

17+import Data.Bits (shiftL, (.&.))

18+import qualified Data.ByteString as BS

1519import Data.ByteString.Internal (toForeignPtr)

1620import Data.Terminfo.Parse

1721import Data.Terminfo.Eval

@@ -21,15 +25,16 @@ import Graphics.Vty.Image (DisplayRegion)

2125import Graphics.Vty.DisplayAttributes

2226import Graphics.Vty.Output.Interface

2327

24−import Blaze.ByteString.Builder (Write, writeToByteString)

28+import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable, writeWord8)

2529

26−import Control.Monad.Trans

27−

28−import Data.Bits ((.&.))

2930import Data.IORef

3031import Data.Maybe (isJust, isNothing, fromJust)

3132import Data.Word

3233

34+#if !MIN_VERSION_base(4,8,0)

35+import Data.Foldable (foldMap)

36+#endif

37+

3338import Foreign.C.Types ( CInt(..), CLong(..) )

3439import Foreign.ForeignPtr (withForeignPtr)

3540import Foreign.Ptr (Ptr, plusPtr)

@@ -44,7 +49,6 @@ data TerminfoCaps = TerminfoCaps

4449 , cup :: CapExpression

4550 , cnorm :: Maybe CapExpression

4651 , civis :: Maybe CapExpression

47− , supportsNoColors :: Bool

4852 , useAltColorMap :: Bool

4953 , setForeColor :: CapExpression

5054 , setBackColor :: CapExpression

@@ -59,6 +63,10 @@ data DisplayAttrCaps = DisplayAttrCaps

5963 { setAttrStates :: Maybe CapExpression

6064 , enterStandout :: Maybe CapExpression

6165 , exitStandout :: Maybe CapExpression

66+ , enterItalic :: Maybe CapExpression

67+ , exitItalic :: Maybe CapExpression

68+ , enterStrikethrough :: Maybe CapExpression

69+ , exitStrikethrough :: Maybe CapExpression

6270 , enterUnderline :: Maybe CapExpression

6371 , exitUnderline :: Maybe CapExpression

6472 , enterReverseVideo :: Maybe CapExpression

@@ -95,62 +103,85 @@ sendCapToTerminal t cap capParams = do

95103--

96104-- * Providing independent string capabilities for all display

97105-- attributes.

98−reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

99−reserveTerminal termName outFd = liftIO $ do

106+reserveTerminal :: String -> Fd -> ColorMode -> IO Output

107+reserveTerminal termName outFd colorMode = do

100108 ti <- Terminfo.setupTerm termName

101109 -- assumes set foreground always implies set background exists.

102110 -- if set foreground is not set then all color changing style

103111 -- attributes are filtered.

104112 msetaf <- probeCap ti "setaf"

105113 msetf <- probeCap ti "setf"

106− let (noColors, useAlt, setForeCap)

114+ let (useAlt, setForeCap)

107115 = case msetaf of

108− Just setaf -> (False, False, setaf)

116+ Just setaf -> (False, setaf)

109117 Nothing -> case msetf of

110− Just setf -> (False, True, setf)

111− Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName)

118+ Just setf -> (True, setf)

119+ Nothing -> (True, error $ "no fore color support for terminal " ++ termName)

112120 msetab <- probeCap ti "setab"

113121 msetb <- probeCap ti "setb"

114− let set_back_cap

122+ let setBackCap

115123 = case msetab of

124+ Just setab -> setab

116125 Nothing -> case msetb of

117126 Just setb -> setb

118127 Nothing -> error $ "no back color support for terminal " ++ termName

119− Just setab -> setab

128+

129+ hyperlinkModeStatus <- newIORef False

130+ newAssumedStateRef <- newIORef initialAssumedState

131+

132+ let terminfoSetMode m newStatus = do

133+ curStatus <- terminfoModeStatus m

134+ when (newStatus /= curStatus) $

135+ case m of

136+ Hyperlink -> do

137+ writeIORef hyperlinkModeStatus newStatus

138+ writeIORef newAssumedStateRef initialAssumedState

139+ _ -> return ()

140+ terminfoModeStatus m =

141+ case m of

142+ Hyperlink -> readIORef hyperlinkModeStatus

143+ _ -> return False

144+ terminfoModeSupported Hyperlink = True

145+ terminfoModeSupported _ = False

146+

120147 terminfoCaps <- pure TerminfoCaps

121148 <*> probeCap ti "smcup"

122149 <*> probeCap ti "rmcup"

123150 <*> requireCap ti "cup"

124151 <*> probeCap ti "cnorm"

125152 <*> probeCap ti "civis"

126− <*> pure noColors

127153 <*> pure useAlt

128154 <*> pure setForeCap

129− <*> pure set_back_cap

155+ <*> pure setBackCap

130156 <*> requireCap ti "sgr0"

131157 <*> requireCap ti "clear"

132158 <*> requireCap ti "el"

133159 <*> currentDisplayAttrCaps ti

134160 <*> probeCap ti "bel"

135− newAssumedStateRef <- newIORef initialAssumedState

136161 let t = Output

137162 { terminalID = termName

138− , releaseTerminal = liftIO $ do

163+ , releaseTerminal = do

139164 sendCap setDefaultAttr []

140165 maybeSendCap cnorm []

141166 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps

142− , ringTerminalBell = liftIO $ maybeSendCap ringBellAudio []

143− , reserveDisplay = liftIO $ do

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 []

172+ , reserveDisplay = do

144173 -- If there is no support for smcup: Clear the screen

145174 -- and then move the mouse to the home position to

146175 -- approximate the behavior.

147176 maybeSendCap smcup []

148177 sendCap clearScreen []

149− , releaseDisplay = liftIO $ do

178+ , releaseDisplay = do

150179 maybeSendCap rmcup []

151180 maybeSendCap cnorm []

181+ , setDisplayBounds = \(w, h) ->

182+ setWindowSize outFd (w, h)

152183 , displayBounds = do

153− rawSize <- liftIO $ getWindowSize outFd

184+ rawSize <- getWindowSize outFd

154185 case rawSize of

155186 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize

156187 | otherwise -> return (w,h)

@@ -161,51 +192,48 @@ reserveTerminal termName outFd = liftIO $ do

161192 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "

162193 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen

163194 ++ " Please report this bug to vty project."

164− , contextColorCount

165− = case supportsNoColors terminfoCaps of

166− False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of

167− Nothing -> 8

168− Just v -> toEnum v

169− True -> 1

170195 , supportsCursorVisibility = isJust $ civis terminfoCaps

171− , supportsMode = const False

172− , setMode = const $ const $ return ()

173− , getModeStatus = const $ return False

196+ , supportsMode = terminfoModeSupported

197+ , setMode = terminfoSetMode

198+ , getModeStatus = terminfoModeStatus

174199 , assumedStateRef = newAssumedStateRef

200+ , outputColorMode = colorMode

175201 -- I think fix would help assure tActual is the only

176202 -- reference. I was having issues tho.

177− , mkDisplayContext = \tActual -> liftIO . terminfoDisplayContext tActual terminfoCaps

203+ , mkDisplayContext = (`terminfoDisplayContext` terminfoCaps)

178204 }

179205 sendCap s = sendCapToTerminal t (s terminfoCaps)

180206 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)

181207 return t

182208

183−requireCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m CapExpression

209+requireCap :: Terminfo.Terminal -> String -> IO CapExpression

184210requireCap ti capName

185211 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

186212 Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""

187213 Just capStr -> parseCap capStr

188214

189−probeCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m (Maybe CapExpression)

215+probeCap :: Terminfo.Terminal -> String -> IO (Maybe CapExpression)

190216probeCap ti capName

191217 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

192218 Nothing -> return Nothing

193219 Just capStr -> Just <$> parseCap capStr

194220

195−parseCap :: (Applicative m, MonadIO m) => String -> m CapExpression

221+parseCap :: String -> IO CapExpression

196222parseCap capStr = do

197223 case parseCapExpression capStr of

198224 Left e -> fail $ show e

199225 Right cap -> return cap

200226

201−currentDisplayAttrCaps :: ( Applicative m, MonadIO m )

202− => Terminfo.Terminal

203− -> m DisplayAttrCaps

227+currentDisplayAttrCaps :: Terminfo.Terminal -> IO DisplayAttrCaps

204228currentDisplayAttrCaps ti

205229 = pure DisplayAttrCaps

206230 <*> probeCap ti "sgr"

207231 <*> probeCap ti "smso"

208232 <*> probeCap ti "rmso"

233+ <*> probeCap ti "sitm"

234+ <*> probeCap ti "ritm"

235+ <*> probeCap ti "smxx"

236+ <*> probeCap ti "rmxx"

209237 <*> probeCap ti "smul"

210238 <*> probeCap ti "rmul"

211239 <*> probeCap ti "rev"

@@ -219,6 +247,13 @@ getWindowSize fd = do

219247 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd

220248 return (fromIntegral b, fromIntegral a)

221249

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+

222257terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext

223258terminfoDisplayContext tActual terminfoCaps r = return dc

224259 where dc = DisplayContext

@@ -232,15 +267,35 @@ terminfoDisplayContext tActual terminfoCaps r = return dc

232267 Nothing -> error "this terminal does not support hide cursor"

233268 Just c -> writeCapExpr c []

234269 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps

235− , writeDefaultAttr = writeCapExpr (setDefaultAttr terminfoCaps) []

270+ , writeDefaultAttr = \urlsEnabled ->

271+ writeCapExpr (setDefaultAttr terminfoCaps) [] `mappend`

272+ (if urlsEnabled then writeURLEscapes EndLink else mempty) `mappend`

273+ (case exitStrikethrough $ displayAttrCaps terminfoCaps of

274+ Just cap -> writeCapExpr cap []

275+ Nothing -> mempty

276+ )

236277 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []

237278 , inlineHack = return ()

238279 }

239280

281+-- | Write the escape sequences that are used in some terminals to

282+-- include embedded hyperlinks. As of yet, this information isn't

283+-- included in termcap or terminfo, so this writes them directly

284+-- instead of looking up the appropriate capabilities.

285+writeURLEscapes :: URLDiff -> Write

286+writeURLEscapes (LinkTo url) =

287+ foldMap writeStorable (BS.unpack "\x1b]8;;") `mappend`

288+ foldMap writeStorable (BS.unpack url) `mappend`

289+ writeStorable (0x07 :: Word8)

290+writeURLEscapes EndLink =

291+ foldMap writeStorable (BS.unpack "\x1b]8;;\a")

292+writeURLEscapes NoLinkChange =

293+ mempty

294+

240295-- | Portably setting the display attributes is a giant pain in the ass.

241296--

242297-- If the terminal supports the sgr capability (which sets the on/off

243−-- state of each style directly ; and, for no good reason, resets the

298+-- state of each style directly; and, for no good reason, resets the

244299-- colors to the default) this procedure is used:

245300--

246301-- 0. set the style attributes. This resets the fore and back color.

@@ -273,30 +328,30 @@ terminfoDisplayContext tActual terminfoCaps r = return dc

273328--

274329-- Note that this optimizes for fewer state changes followed by fewer

275330-- bytes.

276−terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> FixedAttr -> Attr -> DisplayAttrDiff -> Write

277−terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do

278− case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of

331+terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write

332+terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

333+ urlAttrs urlsEnabled `mappend` case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of

279334 -- The only way to reset either color, portably, to the default

280335 -- is to use either the set state capability or the set default

281336 -- capability.

282− True -> do

337+ True -> do

283338 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

284− (fixedStyle attr )

339+ (fixedStyle attr)

285340 (styleToApplySeq $ fixedStyle attr) of

286341 -- only way to reset a color to the defaults

287− EnterExitSeq caps -> writeDefaultAttr dc

342+ EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled

288343 `mappend`

289344 foldMap (\cap -> writeCapExpr cap []) caps

290345 `mappend`

291346 setColors

292347 -- implicitly resets the colors to the defaults

293348 SetState state -> writeCapExpr (fromJust $ setAttrStates

294− $ displayAttrCaps

295− $ terminfoCaps

349+ $ displayAttrCaps terminfoCaps

296350 )

297351 (sgrArgsForState state)

298− `mappend`

299− setColors

352+ `mappend` setItalics

353+ `mappend` setStrikethrough

354+ `mappend` setColors

300355 -- Otherwise the display colors are not changing or changing

301356 -- between two non-default points.

302357 False -> do

@@ -314,45 +369,99 @@ terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do

314369 -- applied states.

315370 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps

316371 `mappend`

317− writeColorDiff setForeColor (foreColorDiff diffs)

372+ writeColorDiff Foreground (foreColorDiff diffs)

318373 `mappend`

319− writeColorDiff setBackColor (backColorDiff diffs)

374+ writeColorDiff Background (backColorDiff diffs)

320375 -- implicitly resets the colors to the defaults

321376 SetState state -> writeCapExpr (fromJust $ setAttrStates

322377 $ displayAttrCaps terminfoCaps

323378 )

324379 (sgrArgsForState state)

380+ `mappend` setItalics

381+ `mappend` setStrikethrough

325382 `mappend` setColors

326383 where

384+ urlAttrs True = writeURLEscapes (urlDiff diffs)

385+ urlAttrs False = mempty

327386 colorMap = case useAltColorMap terminfoCaps of

328387 False -> ansiColorIndex

329388 True -> altColorIndex

330389 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

331404 setColors =

332405 (case fixedForeColor attr of

333− Just c -> writeCapExpr (setForeColor terminfoCaps)

334− [toEnum $ colorMap c]

406+ Just c -> writeColor Foreground c

335407 Nothing -> mempty)

336408 `mappend`

337409 (case fixedBackColor attr of

338− Just c -> writeCapExpr (setBackColor terminfoCaps)

339− [toEnum $ colorMap c]

410+ Just c -> writeColor Background c

340411 Nothing -> mempty)

341− writeColorDiff _f NoColorChange

412+ writeColorDiff _side NoColorChange

342413 = mempty

343− writeColorDiff _f ColorToDefault

414+ writeColorDiff _side ColorToDefault

344415 = error "ColorToDefault is not a possible case for applyColorDiffs"

345− writeColorDiff f (SetColor c)

346− = writeCapExpr (f terminfoCaps) [toEnum $ colorMap c]

416+ writeColorDiff side (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]

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"

347452

348453-- | The color table used by a terminal is a 16 color set followed by a

349454-- 240 color set that might not be supported by the terminal.

350455--

351−-- This takes a Color which clearly identifies which pallete to use and

352−-- computes the index into the full 256 color pallete.

456+-- This takes a Color which clearly identifies which palette to use and

457+-- computes the index into the full 256 color palette.

353458ansiColorIndex :: Color -> Int

354459ansiColorIndex (ISOColor v) = fromEnum v

355460ansiColorIndex (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+ ]

356465

357466-- | For terminals without setaf/setab

358467--

@@ -369,6 +478,10 @@ altColorIndex (ISOColor 6) = 3

369478altColorIndex (ISOColor 7) = 7

370479altColorIndex (ISOColor v) = fromEnum v

371480altColorIndex (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+ ]

372485

373486{- | The sequence of terminfo caps to apply a given style are determined

374487 - according to these rules.

@@ -395,6 +508,8 @@ data DisplayAttrSeq

395508data DisplayAttrState = DisplayAttrState

396509 { applyStandout :: Bool

397510 , applyUnderline :: Bool

511+ , applyItalic :: Bool

512+ , applyStrikethrough :: Bool

398513 , applyReverseVideo :: Bool

399514 , applyBlink :: Bool

400515 , applyDim :: Bool

@@ -431,6 +546,10 @@ reqDisplayCapSeqFor caps s diffs

431546 -- set state cap then just use the set state cap.

432547 ( True, True ) -> SetState $ stateForStyle s

433548 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

434553 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps

435554 noEnterExitCap RemoveStandout = isNothing $ exitStandout caps

436555 noEnterExitCap ApplyUnderline = isNothing $ enterUnderline caps

@@ -443,6 +562,10 @@ reqDisplayCapSeqFor caps s diffs

443562 noEnterExitCap RemoveDim = True

444563 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps

445564 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

446569 enterExitCap ApplyStandout = fromJust $ enterStandout caps

447570 enterExitCap RemoveStandout = fromJust $ exitStandout caps

448571 enterExitCap ApplyUnderline = fromJust $ enterUnderline caps

@@ -456,6 +579,8 @@ stateForStyle :: Style -> DisplayAttrState

456579stateForStyle s = DisplayAttrState

457580 { applyStandout = isStyleSet standout

458581 , applyUnderline = isStyleSet underline

582+ , applyItalic = isStyleSet italic

583+ , applyStrikethrough = isStyleSet strikethrough

459584 , applyReverseVideo = isStyleSet reverseVideo

460585 , applyBlink = isStyleSet blink

461586 , applyDim = isStyleSet dim

@@ -467,10 +592,12 @@ styleToApplySeq :: Style -> [StyleStateChange]

467592styleToApplySeq s = concat

468593 [ applyIfRequired ApplyStandout standout

469594 , applyIfRequired ApplyUnderline underline

595+ , applyIfRequired ApplyItalic italic

596+ , applyIfRequired ApplyStrikethrough strikethrough

470597 , applyIfRequired ApplyReverseVideo reverseVideo

471598 , applyIfRequired ApplyBlink blink

472599 , applyIfRequired ApplyDim dim

473− , applyIfRequired ApplyBlink bold

600+ , applyIfRequired ApplyBold bold

474601 ]

475602 where

476603 applyIfRequired op flag

src/Graphics/Vty/Output/XTermColor.hs+42−18

@@ -1,3 +1,4 @@

1+{-# Language CPP #-}

23-- | Xterm output driver. This uses the Terminfo driver with some

34-- extensions for Xterm.

@@ -8,26 +9,42 @@ where

910import Graphics.Vty.Output.Interface

1011import Graphics.Vty.Input.Mouse

12+import Graphics.Vty.Input.Focus

13+import Graphics.Vty.Attributes.Color (ColorMode)

1114import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased

1215

1316import Blaze.ByteString.Builder (writeToByteString)

1417import Blaze.ByteString.Builder.Word (writeWord8)

1518

19+import qualified Data.ByteString.Char8 as BS8

20+import Data.ByteString.Char8 (ByteString)

21+import Foreign.Ptr (castPtr)

22+

1623import Control.Monad (void, when)

1724import Control.Monad.Trans

25+import Data.Char (toLower)

1826import Data.IORef

1927

20−import System.Posix.IO (fdWrite)

21−import System.Posix.Types (Fd)

28+import System.Posix.IO (fdWriteBuf)

29+import System.Posix.Types (ByteCount, Fd)

2230import System.Posix.Env (getEnv)

2331

2432import Data.List (isInfixOf)

2533import Data.Maybe (catMaybes)

34+

35+#if !MIN_VERSION_base(4,11,0)

2636import 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)

2744

2845-- | Construct an Xterm output driver. Initialize the display to UTF-8.

29−reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

30−reserveTerminal variant outFd = liftIO $ do

46+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> ColorMode -> m Output

47+reserveTerminal variant outFd colorMode = liftIO $ do

3148 let flushedPut = void . fdWrite outFd

3249 -- If the terminal variant is xterm-color use xterm instead since,

3350 -- more often than not, xterm-color is broken.

@@ -35,15 +52,21 @@ reserveTerminal variant outFd = liftIO $ do

3552

3653 utf8a <- utf8Active

3754 when (not utf8a) $ flushedPut setUtf8CharSet

38− t <- TerminfoBased.reserveTerminal variant' outFd

55+ t <- TerminfoBased.reserveTerminal variant' outFd colorMode

3956

4057 mouseModeStatus <- newIORef False

58+ focusModeStatus <- newIORef False

4159 pasteModeStatus <- newIORef False

4260

4361 let xtermSetMode t' m newStatus = do

4462 curStatus <- getModeStatus t' m

4563 when (newStatus /= curStatus) $

4664 case m of

65+ Focus -> liftIO $ do

66+ case newStatus of

67+ True -> flushedPut requestFocusEvents

68+ False -> flushedPut disableFocusEvents

69+ writeIORef focusModeStatus newStatus

4770 Mouse -> liftIO $ do

4871 case newStatus of

4972 True -> flushedPut requestMouseEvents

@@ -54,9 +77,12 @@ reserveTerminal variant outFd = liftIO $ do

5477 True -> flushedPut enableBracketedPastes

5578 False -> flushedPut disableBracketedPastes

5679 writeIORef pasteModeStatus newStatus

80+ Hyperlink -> setMode t Hyperlink newStatus

5781

5882 xtermGetMode Mouse = liftIO $ readIORef mouseModeStatus

83+ xtermGetMode Focus = liftIO $ readIORef focusModeStatus

5984 xtermGetMode BracketedPaste = liftIO $ readIORef pasteModeStatus

85+ xtermGetMode Hyperlink = getModeStatus t Hyperlink

6086

6187 let t' = t

6288 { terminalID = terminalID t ++ " (xterm-color)"

@@ -64,6 +90,7 @@ reserveTerminal variant outFd = liftIO $ do

6490 when (not utf8a) $ liftIO $ flushedPut setDefaultCharSet

6591 setMode t' BracketedPaste False

6692 setMode t' Mouse False

93+ setMode t' Focus False

6794 releaseTerminal t

6895 , mkDisplayContext = \tActual r -> do

6996 dc <- mkDisplayContext t tActual r

@@ -77,30 +104,27 @@ reserveTerminal variant outFd = liftIO $ do

77104utf8Active :: IO Bool

78105utf8Active = do

79106 let vars = ["LC_ALL", "LANG", "LC_CTYPE"]

80− results <- catMaybes <$> mapM getEnv vars

81− let matches = filter ("UTF8" `isInfixOf`) results <>

82− filter ("UTF-8" `isInfixOf`) results

107+ results <- map (toLower <$>) . catMaybes <$> mapM getEnv vars

108+ let matches = filter ("utf8" `isInfixOf`) results <>

109+ filter ("utf-8" `isInfixOf`) results

83110 return $ not $ null matches

84111

85112-- | Enable bracketed paste mode:

86113-- http://cirw.in/blog/bracketed-paste

87−enableBracketedPastes :: String

88−enableBracketedPastes = "\ESC[?2004h"

114+enableBracketedPastes :: ByteString

115+enableBracketedPastes = BS8.pack "\ESC[?2004h"

89116

90117-- | Disable bracketed paste mode:

91−disableBracketedPastes :: String

92−disableBracketedPastes = "\ESC[?2004l"

118+disableBracketedPastes :: ByteString

119+disableBracketedPastes = BS8.pack "\ESC[?2004l"

93120

94121-- | These sequences set xterm based terminals to UTF-8 output.

95122--

96123-- There is no known terminfo capability equivalent to this.

97−setUtf8CharSet, setDefaultCharSet :: String

98−setUtf8CharSet = "\ESC%G"

99−setDefaultCharSet = "\ESC%@"

124+setUtf8CharSet, setDefaultCharSet :: ByteString

125+setUtf8CharSet = BS8.pack "\ESC%G"

126+setDefaultCharSet = BS8.pack "\ESC%@"

100127

101−-- | I think xterm is broken: Reseting the background color as the first

102−-- bytes serialized on a new line does not effect the background color

103−-- xterm uses to clear the line. Which is used *after* the next newline.

104128xtermInlineHack :: Output -> IO ()

105129xtermInlineHack t = do

106130 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"

src/Graphics/Vty/Picture.hs+11−2

@@ -1,4 +1,3 @@

1−{-# LANGUAGE BangPatterns #-}

21-- A 'Picture' is a background paired with a set of 'Image' layers. The

32-- 'Picture' data structure is representative of the final terminal

43-- view.

@@ -31,7 +30,7 @@ data Picture = Picture

3130 , picBackground :: Background

3231 -- ^ The picture's background to be displayed in locations with no

3332 -- Image data.

34− }

33+ } deriving Eq

3534

3635instance Show Picture where

3736 show (Picture _ layers _ ) = "Picture ?? " ++ show layers ++ " ??"

@@ -80,11 +79,20 @@ picForLayers is = Picture

8079data Cursor =

8180 -- | Hide the cursor

8281 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

8390 -- | Show the cursor at the given logical column accounting for

8491 -- character width in the presence of multi-column characters.

8592 | Cursor !Int !Int

8693 -- | Show the cursor at the given absolute terminal column and row

8794 | AbsoluteCursor !Int !Int

95+ deriving Eq

8896

8997instance NFData Cursor where

9098 rnf c = c `seq` ()

@@ -108,6 +116,7 @@ data Background

108116 --

109117 -- * End of line if there are no remaining non-skip ops.

110118 | ClearBackground

119+ deriving Eq

111120

112121instance NFData Background where

113122 rnf (Background c a) = c `seq` a `seq` ()

src/Graphics/Vty/PictureToSpans.hs+11−17

@@ -72,7 +72,7 @@ displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r)

7272-- | Returns the DisplayOps for an image rendered to a window the size

7373-- of the image.

7474--

75−-- largerly used only for debugging.

75+-- largely used only for debugging.

7676displayOpsForImage :: Image -> DisplayOps

7777displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeight i)

7878

@@ -81,7 +81,7 @@ combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s)

8181combinedOpsForLayers pic r

8282 | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0

8383 | otherwise = do

84− layerOps <- mapM (\layer -> buildSpans layer r) (picLayers pic)

84+ layerOps <- mapM (`buildSpans` r) (picLayers pic)

8585 case layerOps of

8686 [] -> fail "empty picture"

8787 [ops] -> substituteSkips (picBackground pic) ops

@@ -136,8 +136,8 @@ mergeUnder upper lower = do

136136 return upper

137137

138138mergeRowUnder :: SpanOps -> SpanOps -> SpanOps

139−mergeRowUnder upperRowOps lowerRowOps =

140− onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) lowerRowOps

139+mergeRowUnder upperRowOps =

140+ onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps)

141141 where

142142 -- H: it will never be the case that we are out of upper ops

143143 -- before lower ops.

@@ -298,11 +298,11 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do

298298 state <- get

299299 when (state^.remaining <= 0) $ fail $ name ++ " with remaining <= 0"

300300 case state^.skip of

301− s | s > size -> put $ state & skip -~ size

301+ s | s > size -> put $ state & skip %~ subtract size

302302 | s == 0 -> if state^.remaining > i0Dim

303303 then do

304304 addMaybeClipped i0

305− put $ state & offset +~ i0Dim & remaining -~ i0Dim

305+ put $ state & offset %~ (+ i0Dim) & remaining %~ subtract i0Dim

306306 addMaybeClipped i1

307307 else addMaybeClipped i0

308308 | s < i0Dim ->

@@ -311,10 +311,10 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do

311311 then addMaybeClipped i0

312312 else do

313313 addMaybeClipped i0

314− put $ state & offset +~ i0Dim' & remaining -~ i0Dim' & skip .~ 0

314+ put $ state & offset %~ (+ i0Dim') & remaining %~ subtract i0Dim' & skip .~ 0

315315 addMaybeClipped i1

316316 | s >= i0Dim -> do

317− put $ state & skip -~ i0Dim

317+ put $ state & skip %~ subtract i0Dim

318318 addMaybeClipped i1

319319 _ -> fail $ name ++ " has unhandled skip class"

320320

@@ -323,14 +323,14 @@ addUnclippedText a txt = do

323323 let op = TextSpan a usedDisplayColumns

324324 (fromIntegral $ TL.length txt)

325325 txt

326− usedDisplayColumns = wcswidth $ TL.unpack txt

326+ usedDisplayColumns = wctlwidth txt

327327 use rowOffset >>= snocOp op

328328

329329addRowCompletion :: DisplayRegion -> Int -> BlitM s ()

330330addRowCompletion displayRegion row = do

331331 allRowOps <- view mrowOps

332332 rowOps <- lift $ lift $ MVector.read allRowOps row

333− let endX = spanOpsEffectedColumns rowOps

333+ let endX = spanOpsAffectedColumns rowOps

334334 when (endX < regionWidth displayRegion) $ do

335335 let ow = regionWidth displayRegion - endX

336336 snocOp (Skip ow) row

@@ -343,12 +343,6 @@ snocOp !op !row = do

343343 lift $ lift $ do

344344 ops <- MVector.read theMrowOps row

345345 let ops' = Vector.snoc ops op

346− when (spanOpsEffectedColumns ops' > regionWidth theRegion)

346+ when (spanOpsAffectedColumns ops' > regionWidth theRegion)

347347 $ fail $ "row " ++ show row ++ " now exceeds region width"

348348 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+8−11

@@ -1,6 +1,4 @@

11-- Copyright Corey O'Connor

2−{-# LANGUAGE BangPatterns #-}

3−{-# LANGUAGE NamedFieldPuns #-}

42{-# LANGUAGE GADTs #-}

53-- | A picture is translated into a sequences of state changes and

64-- character spans. The attribute is applied to all following spans,

@@ -52,7 +50,7 @@ dropOps :: Int -> SpanOps -> SpanOps

5250dropOps w = snd . splitOpsAt w

5351

5452splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)

55−splitOpsAt inW inOps = splitOpsAt' inW inOps

53+splitOpsAt = splitOpsAt'

5654 where

5755 splitOpsAt' 0 ops = (Vector.empty, ops)

5856 splitOpsAt' remainingColumns ops = case Vector.head ops of

@@ -103,18 +101,18 @@ displayOpsColumns ops

103101

104102-- | The number of rows the DisplayOps are defined for.

105103displayOpsRows :: DisplayOps -> Int

106−displayOpsRows ops = Vector.length ops

104+displayOpsRows = Vector.length

107105

108106affectedRegion :: DisplayOps -> DisplayRegion

109107affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)

110108

111109-- | The number of columns a SpanOps affects.

112−spanOpsEffectedColumns :: SpanOps -> Int

113−spanOpsEffectedColumns inOps = Vector.foldl' spanOpsEffectedColumns' 0 inOps

110+spanOpsAffectedColumns :: SpanOps -> Int

111+spanOpsAffectedColumns inOps = Vector.foldl' spanOpsAffectedColumns' 0 inOps

114112 where

115− spanOpsEffectedColumns' t (TextSpan _ w _ _ ) = t + w

116− spanOpsEffectedColumns' t (Skip w) = t + w

117− spanOpsEffectedColumns' t (RowEnd w) = t + w

113+ spanOpsAffectedColumns' t (TextSpan _ w _ _ ) = t + w

114+ spanOpsAffectedColumns' t (Skip w) = t + w

115+ spanOpsAffectedColumns' t (RowEnd w) = t + w

118116

119117-- | The width of a single SpanOp in columns.

120118spanOpHasWidth :: SpanOp -> Maybe (Int, Int)

@@ -126,7 +124,6 @@ spanOpHasWidth (RowEnd ow) = Just (ow,ow)

126124-- span op.

127125columnsToCharOffset :: Int -> SpanOp -> Int

128126columnsToCharOffset cx (TextSpan _ _ _ utf8Str) =

129− let str = TL.unpack utf8Str

130− in wcswidth (take cx str)

127+ wctlwidth (TL.take (fromIntegral cx) utf8Str)

131128columnsToCharOffset cx (Skip _) = cx

132129columnsToCharOffset cx (RowEnd _) = cx

src/Graphics/Vty/UnicodeWidthTable/IO.hsnew file+105

@@ -0,0 +1,105 @@

1+{-# LANGUAGE CPP #-}

2+module Graphics.Vty.UnicodeWidthTable.IO

3+ ( readUnicodeWidthTable

4+ , parseUnicodeWidthTable

5+ , writeUnicodeWidthTable

6+ )

7+where

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.hsnew file+129

@@ -0,0 +1,129 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE ForeignFunctionInterface #-}

3+module Graphics.Vty.UnicodeWidthTable.Install

4+ ( TableInstallException(..)

5+ , installUnicodeWidthTable

6+ , isCustomTableReady

7+ )

8+where

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.hsnew file+79

@@ -0,0 +1,79 @@

1+{-# LANGUAGE TupleSections #-}

2+module Graphics.Vty.UnicodeWidthTable.Query

3+ ( buildUnicodeWidthTable

4+ , defaultUnicodeTableUpperBound

5+ )

6+where

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.hsnew file+29

@@ -0,0 +1,29 @@

1+module Graphics.Vty.UnicodeWidthTable.Types

2+ ( UnicodeWidthTable(..)

3+ , WidthTableRange(..)

4+ )

5+where

7+import Data.Word (Word8, Word32)

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/Rogue.hs−1

@@ -1,4 +1,3 @@

1−{-# LANGUAGE TemplateHaskell #-}

21module Main where

43import Graphics.Vty

test/Verify/Graphics/Vty/Span.hs+1−1

@@ -20,7 +20,7 @@ isAttrSpanOp TextSpan {} = True

2020isAttrSpanOp _ = False

2121

2222verifyAllSpansHaveWidth i spans w

23− = let v = map (\s -> (spanOpsEffectedColumns s /= w, s)) (Vector.toList spans)

23+ = let v = map (\s -> (spanOpsAffectedColumns s /= w, s)) (Vector.toList spans)

2424 in case any ((== True) . fst) v of

2525 False -> succeeded

2626 True -> failed { reason = "Not all spans contained operations defining exactly "

test/VerifyAttributeOps.hsdeleted−9

@@ -1,9 +0,0 @@

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.hsnew file+269

@@ -0,0 +1,269 @@

1+module VerifyColor240 where

3+import Data.Word(Word8)

4+import Verify

6+import Graphics.Vty.Attributes.Color240(rgbColorToColor240)

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,3 +1,4 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

12module VerifyEmptyImageProps where

34import Verify

test/VerifyEvalTerminfoCaps.hs+1

@@ -1,5 +1,6 @@

11{-# LANGUAGE BangPatterns #-}

22{-# LANGUAGE NamedFieldPuns #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

34module VerifyEvalTerminfoCaps where

56import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)

test/VerifyImageOps.hs+2−1

@@ -1,3 +1,4 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

12module VerifyImageOps where

34import Graphics.Vty.Attributes

@@ -136,7 +137,7 @@ cropBottomLimitsHeight :: Image -> Int -> Property

136137cropBottomLimitsHeight i v = v >= 0 ==>

137138 v >= imageHeight (cropBottom v i)

138139

139−-- rediculous tests just to satisfy my desire for nice code coverage :-P

140+-- ridiculous tests just to satisfy my desire for nice code coverage :-P

140141canShowImage :: Image -> Bool

141142canShowImage i = length (show i) > 0

142143

test/VerifyOutput.hs+7−3

@@ -1,6 +1,7 @@

1−-- We setup the environment to envoke certain terminals of interest.

1+-- We setup the environment to invoke certain terminals of interest.

22-- This assumes appropriate definitions exist in the current environment

33-- for the terminals of interest.

4+{-# LANGUAGE ScopedTypeVariables #-}

45module VerifyOutput where

67import Verify

@@ -13,7 +14,6 @@ import Verify.Graphics.Vty.Output

1314import Control.Monad

1415

1516import qualified System.Console.Terminfo as Terminfo

16−import System.Posix.Env

1717import System.Posix.IO

1818

1919tests :: IO [Test]

@@ -35,7 +35,11 @@ smokeTestTermNonMac termName i = liftIOResult $ do

3535smokeTestTerm :: String -> Image -> IO Result

3636smokeTestTerm termName i = do

3737 nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags

38− t <- outputForConfig $ defaultConfig { outputFd = Just nullOut, termName = Just termName }

38+ t <- outputForConfig $ defaultConfig

39+ { outputFd = Just nullOut

40+ , termName = Just termName

41+ , colorMode = Just NoColor

42+ }

3943 -- putStrLn $ "context color count: " ++ show (contextColorCount t)

4044 reserveDisplay t

4145 dc <- displayContext t (100,100)

test/VerifyParseTerminfoCaps.hs+1

@@ -1,4 +1,5 @@

11{-# LANGUAGE NamedFieldPuns #-}

2+{-# LANGUAGE ScopedTypeVariables #-}

23module VerifyParseTerminfoCaps where

45import Prelude hiding ( catch )

test/VerifySimpleSpanGeneration.hs+8−8

@@ -25,7 +25,7 @@ unitImageAndZeroWindow1 :: UnitImage -> EmptyWindow -> Bool

2525unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =

2626 let p = picForImage i

2727 ops = displayOpsForPic p (regionForWindow w)

28− in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

28+ in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

2929

3030horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

3131horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

@@ -37,7 +37,7 @@ horizSpanImageAndZeroWindow1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

3737horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

3838 let p = picForImage i

3939 ops = displayOpsForPic p (regionForWindow w)

40− in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

40+ in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

4141

4242horizSpanImageAndEqualWindow0 :: SingleRowSingleAttrImage -> Result

4343horizSpanImageAndEqualWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =

@@ -51,7 +51,7 @@ horizSpanImageAndEqualWindow1 (SingleRowSingleAttrImage { rowImage = i, expected

5151 let p = picForImage i

5252 w = MockWindow c 1

5353 ops = displayOpsForPic p (regionForWindow w)

54− in spanOpsEffectedRows ops == 1

54+ in spanOpsAffectedRows ops == 1

5555

5656horizSpanImageAndLesserWindow0 :: SingleRowSingleAttrImage -> Result

5757horizSpanImageAndLesserWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =

@@ -74,7 +74,7 @@ singleAttrSingleSpanStackCropped1 stack =

7474 expectedRowCount = stackHeight stack `div` 2

7575 w = MockWindow (stackWidth stack) expectedRowCount

7676 ops = displayOpsForPic p (regionForWindow w)

77− actualRowCount = spanOpsEffectedRows ops

77+ actualRowCount = spanOpsAffectedRows ops

7878 in expectedRowCount == actualRowCount

7979

8080singleAttrSingleSpanStackCropped2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

@@ -90,7 +90,7 @@ singleAttrSingleSpanStackCropped3 stack0 stack1 =

9090 w = MockWindow (imageWidth (picImage p)) expectedRowCount

9191 ops = displayOpsForPic p (regionForWindow w)

9292 expectedRowCount = imageHeight (picImage p) `div` 2

93− actualRowCount = spanOpsEffectedRows ops

93+ actualRowCount = spanOpsAffectedRows ops

9494 in expectedRowCount == actualRowCount

9595

9696singleAttrSingleSpanStackCropped4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

@@ -107,7 +107,7 @@ singleAttrSingleSpanStackCropped5 stack0 stack1 =

107107 w = MockWindow (imageWidth (picImage p)) (stackHeight stack0)

108108 ops = displayOpsForPic p (regionForWindow w)

109109 expectedRowCount = stackHeight stack0

110− actualRowCount = spanOpsEffectedRows ops

110+ actualRowCount = spanOpsAffectedRows ops

111111 in expectedRowCount == actualRowCount

112112

113113horizSpanImageAndGreaterWindow0 :: SingleRowSingleAttrImage -> Result

@@ -123,13 +123,13 @@ arbImageIsCropped :: DefaultImage -> MockWindow -> Bool

123123arbImageIsCropped (DefaultImage image) win@(MockWindow w h) =

124124 let pic = picForImage image

125125 ops = displayOpsForPic pic (regionForWindow win)

126− in ( spanOpsEffectedRows ops == h ) && ( allSpansHaveWidth ops w )

126+ in ( spanOpsAffectedRows ops == h ) && ( allSpansHaveWidth ops w )

127127

128128spanOpsActuallyFillRows :: DefaultPic -> Bool

129129spanOpsActuallyFillRows (DefaultPic pic win) =

130130 let ops = displayOpsForPic pic (regionForWindow win)

131131 expectedRowCount = regionHeight (regionForWindow win)

132− actualRowCount = spanOpsEffectedRows ops

132+ actualRowCount = spanOpsAffectedRows ops

133133 in expectedRowCount == actualRowCount

134134

135135spanOpsActuallyFillColumns :: DefaultPic -> Bool

test/VerifyUsingMockInput.hs+4−1

@@ -1,5 +1,6 @@

11{-# LANGUAGE MultiParamTypeClasses #-}

22{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

34-- Generate some input bytes and delays between blocks of input bytes.

45-- Verify the events produced are as expected.

56module Main where

@@ -131,7 +132,9 @@ assertEventsFromSynInput table inputSpec expectedEvents = do

131132 readLoop 0 = return ()

132133 readLoop n = do

133134 e <- atomically $ readTChan $ input^.eventChannel

134− modifyIORef eventsRef ((:) e)

135+ case e of

136+ InputEvent ev -> modifyIORef eventsRef ((:) ev)

137+ ResumeAfterSignal -> return ()

135138 readLoop (n - 1)

136139 genEventsUsingIoActions maxDuration writeWaitClose readEvents

137140 outEvents <- reverse <$> readIORef eventsRef

test/interactive_terminal_test.hs+1−1

@@ -364,7 +364,7 @@ Did the test output match the description?

364364|]

365365 defaultSuccessConfirmResults

366366

367−-- Explicitely definethe bytes that encode each example text.

367+-- Explicitly define the bytes that encode each example text.

368368-- This avoids any issues with how the compiler represents string literals.

369369--

370370-- This document is UTF-8 encoded so the UTF-8 string is still included for

tools/BuildWidthTable.hsnew file+144

@@ -0,0 +1,144 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

2+{-# LANGUAGE CPP #-}

3+module Main where

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+94−84

@@ -1,5 +1,5 @@

11name: vty

2−version: 5.15

2+version: 5.35.1

33license: BSD3

44license-file: LICENSE

55author: AUTHORS

@@ -24,13 +24,13 @@ description:

2525 .

27−cabal-version: >= 1.18

27+cabal-version: 1.18

2828build-type: Simple

2929extra-doc-files: README.md,

3030 AUTHORS,

3131 CHANGELOG.md,

3232 LICENSE

33−tested-with: GHC >= 7.6.2

33+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.5

3434

3535source-repository head

3636 type: git

@@ -38,17 +38,16 @@ source-repository head

3838

3939library

4040 default-language: Haskell2010

41− build-depends: base >= 4.6 && < 5,

41+ build-depends: base >= 4.8 && < 5,

4242 blaze-builder >= 0.3.3.2 && < 0.5,

4343 bytestring,

4444 containers,

4545 deepseq >= 1.1 && < 1.5,

4646 directory,

4747 filepath >= 1.0 && < 2.0,

48− microlens,

48+ microlens < 0.4.13,

4949 microlens-mtl,

5050 microlens-th,

51− -- required for nice installation with yi

5251 hashable >= 1.2,

5352 mtl >= 1.1.1.0 && < 2.3,

5453 parallel >= 2.2 && < 3.3,

@@ -59,10 +58,18 @@ library

5958 text >= 0.11.3,

6059 unix,

6160 utf8-string >= 0.3 && < 1.1,

62− vector >= 0.7

61+ vector >= 0.7,

62+ binary,

63+ ansi-terminal >= 0.10.3

64+

65+ if !impl(ghc >= 8.0)

66+ build-depends: semigroups >= 0.16,

67+ fail

6368

6469 exposed-modules: Graphics.Vty

6570 Graphics.Vty.Attributes

71+ Graphics.Vty.Attributes.Color

72+ Graphics.Vty.Attributes.Color240

6673 Graphics.Vty.Config

6774 Graphics.Vty.Error

6875 Graphics.Vty.Image

@@ -73,7 +80,6 @@ library

7380 Graphics.Vty.Picture

7481 Graphics.Vty.Output

7582 Graphics.Text.Width

76− -- the modules below are only meant to be used by the tests.

7783 Codec.Binary.UTF8.Debug

7884 Data.Terminfo.Parse

7985 Data.Terminfo.Eval

@@ -85,6 +91,7 @@ library

8591 Graphics.Vty.Input.Classify.Parse

8692 Graphics.Vty.Input.Loop

8793 Graphics.Vty.Input.Mouse

94+ Graphics.Vty.Input.Focus

8895 Graphics.Vty.Input.Paste

8996 Graphics.Vty.Input.Terminfo

9097 Graphics.Vty.PictureToSpans

@@ -93,39 +100,51 @@ library

93100 Graphics.Vty.Output.Interface

94101 Graphics.Vty.Output.XTermColor

95102 Graphics.Vty.Output.TerminfoBased

103+ Graphics.Vty.UnicodeWidthTable.Types

104+ Graphics.Vty.UnicodeWidthTable.IO

105+ Graphics.Vty.UnicodeWidthTable.Query

106+ Graphics.Vty.UnicodeWidthTable.Install

96107

97− other-modules: Graphics.Vty.Attributes.Color

98− Graphics.Vty.Attributes.Color240

99− Graphics.Vty.Debug.Image

108+ other-modules: Graphics.Vty.Debug.Image

100109 Graphics.Vty.Input.Terminfo.ANSIVT

101110

102111 c-sources: cbits/gwinsz.c

103112 cbits/set_term_timing.c

113+ cbits/get_tty_erase.c

104114 cbits/mk_wcwidth.c

105115

106116 include-dirs: cbits

107117

108118 hs-source-dirs: src

109119

110− default-extensions: ScopedTypeVariables

111− ForeignFunctionInterface

112−

113120 ghc-options: -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10

114121

115122 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10

116123

117− cc-options: -O2

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

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

118138

119139executable vty-mode-demo

120140 main-is: ModeDemo.hs

121141 hs-source-dirs: demos

122142

123143 default-language: Haskell2010

124− default-extensions: ScopedTypeVariables

125144 ghc-options: -threaded

126145

127146 build-depends: vty,

128− base >= 4.6 && < 5,

147+ base >= 4.8 && < 5,

129148 containers,

130149 microlens,

131150 microlens-mtl,

@@ -136,39 +155,17 @@ executable vty-demo

136155 hs-source-dirs: demos

137156

138157 default-language: Haskell2010

139− default-extensions: ScopedTypeVariables

140158 ghc-options: -threaded

141159

142160 build-depends: vty,

143− base >= 4.6 && < 5,

161+ base >= 4.8 && < 5,

144162 containers,

145163 microlens,

146164 microlens-mtl,

147165 mtl >= 1.1.1.0 && < 2.3

148166

149−test-suite verify-attribute-ops

150− default-language: Haskell2010

151− default-extensions: ScopedTypeVariables

152− type: detailed-0.9

153− hs-source-dirs: test

154− test-module: VerifyAttributeOps

155− build-depends: vty,

156− Cabal >= 1.20,

157− QuickCheck >= 2.7,

158− random >= 1.0 && < 1.2,

159− base >= 4.6 && < 5,

160− bytestring,

161− containers,

162− deepseq >= 1.1 && < 1.5,

163− mtl >= 1.1.1.0 && < 2.3,

164− text >= 0.11.3,

165− unix,

166− utf8-string >= 0.3 && < 1.1,

167− vector >= 0.7

168−

169167test-suite verify-using-mock-terminal

170168 default-language: Haskell2010

171− default-extensions: ScopedTypeVariables

172169

173170 type: detailed-0.9

174171

@@ -187,8 +184,8 @@ test-suite verify-using-mock-terminal

187184 build-depends: vty,

188185 Cabal >= 1.20,

189186 QuickCheck >= 2.7,

190− random >= 1.0 && < 1.2,

191− base >= 4.6 && < 5,

187+ random >= 1.0 && < 1.3,

188+ base >= 4.8 && < 5,

192189 bytestring,

193190 containers,

194191 deepseq >= 1.1 && < 1.5,

@@ -201,7 +198,6 @@ test-suite verify-using-mock-terminal

201198

202199test-suite verify-terminal

203200 default-language: Haskell2010

204− default-extensions: ScopedTypeVariables

205201

206202 type: detailed-0.9

207203

@@ -220,8 +216,8 @@ test-suite verify-terminal

220216 build-depends: vty,

221217 Cabal >= 1.20,

222218 QuickCheck >= 2.7,

223− random >= 1.0 && < 1.2,

224− base >= 4.6 && < 5,

219+ random >= 1.0 && < 1.3,

220+ base >= 4.8 && < 5,

225221 bytestring,

226222 containers,

227223 deepseq >= 1.1 && < 1.5,

@@ -234,7 +230,6 @@ test-suite verify-terminal

234230

235231test-suite verify-display-attributes

236232 default-language: Haskell2010

237− default-extensions: ScopedTypeVariables

238233

239234 type: detailed-0.9

240235

@@ -253,8 +248,8 @@ test-suite verify-display-attributes

253248 build-depends: vty,

254249 Cabal >= 1.20,

255250 QuickCheck >= 2.7,

256− random >= 1.0 && < 1.2,

257− base >= 4.6 && < 5,

251+ random >= 1.0 && < 1.3,

252+ base >= 4.8 && < 5,

258253 bytestring,

259254 containers,

260255 deepseq >= 1.1 && < 1.5,

@@ -266,7 +261,6 @@ test-suite verify-display-attributes

266261

267262test-suite verify-empty-image-props

268263 default-language: Haskell2010

269− default-extensions: ScopedTypeVariables

270264

271265 type: detailed-0.9

272266

@@ -279,8 +273,8 @@ test-suite verify-empty-image-props

279273 build-depends: vty,

280274 Cabal >= 1.20,

281275 QuickCheck >= 2.7,

282− random >= 1.0 && < 1.2,

283− base >= 4.6 && < 5,

276+ random >= 1.0 && < 1.3,

277+ base >= 4.8 && < 5,

284278 bytestring,

285279 containers,

286280 deepseq >= 1.1 && < 1.5,

@@ -292,7 +286,6 @@ test-suite verify-empty-image-props

292286

293287test-suite verify-eval-terminfo-caps

294288 default-language: Haskell2010

295− default-extensions: ScopedTypeVariables

296289

297290 type: detailed-0.9

298291

@@ -306,8 +299,8 @@ test-suite verify-eval-terminfo-caps

306299 build-depends: vty,

307300 Cabal >= 1.20,

308301 QuickCheck >= 2.7,

309− random >= 1.0 && < 1.2,

310− base >= 4.6 && < 5,

302+ random >= 1.0 && < 1.3,

303+ base >= 4.8 && < 5,

311304 blaze-builder >= 0.3.3.2 && < 0.5,

312305 bytestring,

313306 containers,

@@ -321,7 +314,6 @@ test-suite verify-eval-terminfo-caps

321314

322315test-suite verify-image-ops

323316 default-language: Haskell2010

324− default-extensions: ScopedTypeVariables

325317

326318 type: detailed-0.9

327319

@@ -336,8 +328,8 @@ test-suite verify-image-ops

336328 build-depends: vty,

337329 Cabal >= 1.20,

338330 QuickCheck >= 2.7,

339− random >= 1.0 && < 1.2,

340− base >= 4.6 && < 5,

331+ random >= 1.0 && < 1.3,

332+ base >= 4.8 && < 5,

341333 bytestring,

342334 containers,

343335 deepseq >= 1.1 && < 1.5,

@@ -349,7 +341,6 @@ test-suite verify-image-ops

349341

350342test-suite verify-image-trans

351343 default-language: Haskell2010

352− default-extensions: ScopedTypeVariables

353344

354345 type: detailed-0.9

355346

@@ -364,8 +355,8 @@ test-suite verify-image-trans

364355 build-depends: vty,

365356 Cabal >= 1.20,

366357 QuickCheck >= 2.7,

367− random >= 1.0 && < 1.2,

368− base >= 4.6 && < 5,

358+ random >= 1.0 && < 1.3,

359+ base >= 4.8 && < 5,

369360 bytestring,

370361 containers,

371362 deepseq >= 1.1 && < 1.5,

@@ -377,7 +368,6 @@ test-suite verify-image-trans

377368

378369test-suite verify-inline

379370 default-language: Haskell2010

380− default-extensions: ScopedTypeVariables

381371

382372 type: detailed-0.9

383373

@@ -391,8 +381,8 @@ test-suite verify-inline

391381 build-depends: vty,

392382 Cabal >= 1.20,

393383 QuickCheck >= 2.7,

394− random >= 1.0 && < 1.2,

395− base >= 4.6 && < 5,

384+ random >= 1.0 && < 1.3,

385+ base >= 4.8 && < 5,

396386 bytestring,

397387 containers,

398388 deepseq >= 1.1 && < 1.5,

@@ -404,7 +394,6 @@ test-suite verify-inline

404394

405395test-suite verify-parse-terminfo-caps

406396 default-language: Haskell2010

407− default-extensions: ScopedTypeVariables

408397

409398 type: detailed-0.9

410399

@@ -419,8 +408,8 @@ test-suite verify-parse-terminfo-caps

419408 build-depends: vty,

420409 Cabal >= 1.20,

421410 QuickCheck >= 2.7,

422− random >= 1.0 && < 1.2,

423− base >= 4.6 && < 5,

411+ random >= 1.0 && < 1.3,

412+ base >= 4.8 && < 5,

424413 bytestring,

425414 containers,

426415 deepseq >= 1.1 && < 1.5,

@@ -433,7 +422,6 @@ test-suite verify-parse-terminfo-caps

433422

434423test-suite verify-simple-span-generation

435424 default-language: Haskell2010

436− default-extensions: ScopedTypeVariables

437425

438426 type: detailed-0.9

439427

@@ -451,8 +439,8 @@ test-suite verify-simple-span-generation

451439 build-depends: vty,

452440 Cabal >= 1.20,

453441 QuickCheck >= 2.7,

454− random >= 1.0 && < 1.2,

455− base >= 4.6 && < 5,

442+ random >= 1.0 && < 1.3,

443+ base >= 4.8 && < 5,

456444 bytestring,

457445 containers,

458446 deepseq >= 1.1 && < 1.5,

@@ -465,7 +453,6 @@ test-suite verify-simple-span-generation

465453

466454test-suite verify-crop-span-generation

467455 default-language: Haskell2010

468− default-extensions: ScopedTypeVariables

469456

470457 type: detailed-0.9

471458

@@ -483,8 +470,8 @@ test-suite verify-crop-span-generation

483470 build-depends: vty,

484471 Cabal >= 1.20,

485472 QuickCheck >= 2.7,

486− random >= 1.0 && < 1.2,

487− base >= 4.6 && < 5,

473+ random >= 1.0 && < 1.3,

474+ base >= 4.8 && < 5,

488475 bytestring,

489476 containers,

490477 deepseq >= 1.1 && < 1.5,

@@ -497,7 +484,6 @@ test-suite verify-crop-span-generation

497484

498485test-suite verify-layers-span-generation

499486 default-language: Haskell2010

500− default-extensions: ScopedTypeVariables

501487

502488 type: detailed-0.9

503489

@@ -515,8 +501,33 @@ test-suite verify-layers-span-generation

515501 build-depends: vty,

516502 Cabal >= 1.20,

517503 QuickCheck >= 2.7,

518− random >= 1.0 && < 1.2,

519− base >= 4.6 && < 5,

504+ random >= 1.0 && < 1.3,

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,

520531 bytestring,

521532 containers,

522533 deepseq >= 1.1 && < 1.5,

@@ -528,7 +539,6 @@ test-suite verify-layers-span-generation

528539

529540test-suite verify-utf8-width

530541 default-language: Haskell2010

531− default-extensions: ScopedTypeVariables

532542

533543 type: detailed-0.9

534544

@@ -541,8 +551,8 @@ test-suite verify-utf8-width

541551 build-depends: vty,

542552 Cabal >= 1.20,

543553 QuickCheck >= 2.7,

544− random >= 1.0 && < 1.2,

545− base >= 4.6 && < 5,

554+ random >= 1.0 && < 1.3,

555+ base >= 4.8 && < 5,

546556 bytestring,

547557 containers,

548558 deepseq >= 1.1 && < 1.5,

@@ -554,7 +564,6 @@ test-suite verify-utf8-width

554564

555565test-suite verify-using-mock-input

556566 default-language: Haskell2010

557− default-extensions: ScopedTypeVariables

558567

559568 type: exitcode-stdio-1.0

560569

@@ -562,6 +571,8 @@ test-suite verify-using-mock-input

562571

563572 main-is: VerifyUsingMockInput.hs

564573

574+ other-modules: Verify.Graphics.Vty.Output

575+

565576 build-depends: vty,

566577 Cabal >= 1.20,

567578 QuickCheck >= 2.7,

@@ -569,8 +580,8 @@ test-suite verify-using-mock-input

569580 quickcheck-assertions >= 0.1.1,

570581 test-framework == 0.8.*,

571582 test-framework-smallcheck == 0.2.*,

572− random >= 1.0 && < 1.2,

573− base >= 4.6 && < 5,

583+ random >= 1.0 && < 1.3,

584+ base >= 4.8 && < 5,

574585 bytestring,

575586 containers,

576587 deepseq >= 1.1 && < 1.5,

@@ -588,7 +599,6 @@ test-suite verify-using-mock-input

588599

589600test-suite verify-config

590601 default-language: Haskell2010

591− default-extensions: ScopedTypeVariables

592602

593603 type: exitcode-stdio-1.0

594604

@@ -605,8 +615,8 @@ test-suite verify-config

605615 test-framework == 0.8.*,

606616 test-framework-smallcheck == 0.2.*,

607617 test-framework-hunit,

608− random >= 1.0 && < 1.2,

609− base >= 4.6 && < 5,

618+ random >= 1.0 && < 1.3,

619+ base >= 4.8 && < 5,

610620 bytestring,

611621 containers,

612622 deepseq >= 1.1 && < 1.5,