master..5979798 · vty · git.iko.soy

git.iko.soy/vty

61 files changed+1344−3479

unifiedsplit

.travis.yml+17−100

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

1−# This Travis job script has been generated by a script via

2−#

3−# runghc make_travis_yml_2.hs 'vty.cabal'

4−#

5−# For more information, see https://github.com/haskell-CI/haskell-ci

6−#

7−language: c

8−sudo: false

1+language: haskell

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

3+notifications:

4+ email: false

285

296matrix:

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

7+ allow_failures:

8+ - env: CABALVER=head GHCVER=head

439

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

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

5315

5416install:

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)

17+ - ./ci/travis_ci_install

8018

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.

8319script:

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

20+ - ./ci/travis_ci_script

9621

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

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

CHANGELOG.md+372−753

@@ -1,861 +1,480 @@

1−

2−5.35.1

3−------

4−

5−Bug fixes:

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

7−

8−5.35

9−----

10−

11−New features:

12− * Add support for 24-bit color (thanks @u-quark). This change

13− updates Vty to look at the `COLORTERM` environment variable that is

14− conventionally used to advertise support for truecolor escape

15− sequences. The change also updates the Vty demo to demonstrate

16− 24-bit colors. This change also adds a new data type, `ColorMode`,

17− to represent the color mode in use, as well as an `Output` interface

18− field, `outputColorMode`, to track the active color mode and use it

19− to clamp emitted color escape sequences to the active color range.

20−

21−API changes:

22− * All types in `Graphics.Vty.Input.Events` now have strict constructor

23− fields.

24− * Internal events are now wrapped in a new `InternalEvent` type to

25− improve how signal handling is done. This change modifies the `Input`

26− type's event channel API to produce `InternalEvents`, not `Events`.

27− The new `InternalEvent` either wraps `Event` with the `InputEvent`

28− constructor (the previous behavior) or indicates that Vty resumed

29− after handling a signal using the `ResumeAfterSignal` constructor.

30− This change avoids the previous use of `EvResize` with lazy exception

31− arguments as a sentinel value for `ResumeAfterSignal`.

32−

33−Other enhancements:

34− * Bracketed paste parsing performance has been greatly improved thanks

35− to benchmarking and optimization work by @iphydf. As part of that

36− work, Vty now uses bytestrings rather than Strings internally when

37− parsing input to look for events.

38− * The `\b` value is now interpreted as `KBS` (thanks @vglfr)

39−

40−5.34

41−----

42−

43−API changes:

44− * Added an `NFData` instance for `Event` (thanks Mario Lang)

45− * Removed `Monoid` and `Semigroup` instances for `Attr` and

46− `MaybeDefault`. This change removed the instances because they were

47− misbehaved; merging `Attr` and `MaybeDefault` values with these

48− instances resulted in field value losses. For example, before this

49− change,

50−```

51−(defAttr `withForeColor` blue) <> (defAttr `withBackColor` green)

52−```

53− would result in just

54−```

55− (defAttr `withBackColor` green)

56−```

57− because the instances were designed to favor the right-hand

58− arguments' fields even if they had not been explicitly set

59− (a consequence of the `MaybeDefault` `Semigroup` instance).

60− While that behavior was sensible specifically in the context of

61− `Graphics.Vty.Inline`, it wasn't a useful user-facing API and it made

62− for surprising instance behavior. Since there is actually no good way

63− to handle this in a `Semigroup` instance for `Attr` -- some choices

64− have to be made about how to merge two attributes' foreground colors,

65− and that won't be much better than what we had -- the instance was

66− just removed.

67−

68−

69−5.33

70−----

71−

72−API changes:

73−* The `Cursor` type got a new `PositionOnly` constructor for cursor

74− placement without visibility.

75−

76−Package changes:

77−* Relaxed upper bound for `random`

78−* Updated `microlens` bounds to allow 0.4.12

79−

80−Other improvements:

81−* Various hlint-driven improvements (thanks Willem Van Onsem)

82−* The implementation of `color240` was improved (thanks (Willem Van

83− Onsem)

84−

85−5.32

86−----

87−

88−New features:

89− * Meta-PageUp and Meta-PageDown are now supported (#193)

90− * Added `supportsItalics` and `supportsStrikethrough` functions to

91− check for feature support in terminfo

92−

93−Bug fixes:

94− * Detect utf-8 mode in `LANG` regardless of case (thanks Emeka

95− Nkurumeh)

96−

97−5.31

98−----

99−

100−New features and API changes:

101− * Added support for strikethrough mode. This change adds a new

102− `strikethrough` `Style` value and uses the `smxx` and `rmxx`

103− Terminfo capabilities to activate and deactivate strikethrough mode,

104− respectively. If the terminfo does not report those capabilities,

105− this style is ignored.

106− * `Output`: added the `setDisplayBounds` field to set the output

107− dimensions of the output handle; added an implementation of this for

108− the `TerminfoBased` backend.

109−

110−Other changes:

111− * The C prototype for `vty_c_get_window_size` in `gwinsz.h` was fixed.

112−

113−5.30

114−----

115−

116−New features:

117− * Added `Graphics.Vty.setWindowTitle` to emit an escape

118− sequence to set the window title, provide the terminal emulator

119− accepts Xterm-style title sequences. For details, see:

120− https://tldp.org/HOWTO/Xterm-Title-3.html

121−

122−5.29

123−----

124−

125−API changes:

126− * The Input type got a new field, 'restoreInputState'. This field

127− allows the end user to have direct access to the logic needed to

128− restore the terminal's input state flags. Prior to having this field,

129− this state restoration logic could only be invoked as part of calling

130− 'shutdownInput', but since that function does other things (like

131− killing threads) it is not advisable to call it repeatedly (which is

132− necessary in the use case this change is intended to support). This

133− can be called directly to restore the input state flags as needed,

134− although this is not required if 'shutdown' (or 'shutdownInput') is

135− called.

136−

137−Other changes:

138− * attributeControl: explicitly enable the ICRNL terminal mode flag (see

139− #187 and c572ad).

140−

141−5.28.2

142−------

143−

144−Bug fixes:

145− * Added a package dependency on `semigroups` for the

146− `vty-build-width-table` tool on older GHCs (#185)

147−

148−5.28.1

149−------

150−

151−Bug fixes:

152− * `installUnicodeWidthTable`: use `throwIO`, not `throw`

153−

154−5.28

155−----

156−

157−This release improves Vty's support for multi-column Unicode characters

158−and provides greater compatibility with a wider array of terminal

159−emulators. The following sections summarize the relevant changes, but an

160−overview of the new functionality is motivated and detailed in the new

161−"Multi-Column Character Support" README section. For

162−historical context, please also consider reading over

163−[#175](https://github.com/jtdaugherty/vty/issues/175).

164−

165−API changes:

166− * New modules were added:

167− * `Graphics.Vty.UnicodeWidthTable.Types`

168− * `Graphics.Vty.UnicodeWidthTable.IO`

169− * `Graphics.Vty.UnicodeWidthTable.Query`

170− * `Graphics.Vty.UnicodeWidthTable.Install`

171− * The `Config` type got a new field, `allowCustomUnicodeWidthTables`,

172− that controls whether `mkVty` will attempt to load a Unicode width

173− table if specified in the configuration.

174−

175−Configuration file changes:

176− * A new syntax was added to support specifying Unicode width tables on

177− a per-`TERM` basis. The syntax is `widthMap <TERM> <PATH>`. See the

178− documentation for `Graphics.Vty.Config` for details. Since prior

179− versions of this library will silently ignore any configuration file

180− lines they cannot parse, this change to user configuration files is

181− at least non-breaking for older versions of Vty.

182−

183−Other changes:

184− * The `mkVty` function now automatically attempts to load a custom

185− Unicode width table if one is specified in the configuration,

186− provided `allowCustomUnicodeWidthTables` is not set to `Just False`.

187− See the documentation for `Graphics.Vty.mkVty` for details.

188− * Vty now includes a command line tool, `vty-build-width-table`, that

189− queries the terminal emulator to construct a custom Unicode width

190− table and optionally update the Vty configuration file to use it.

191− Programs that want to use that tool's functionality may also do so

192− via the API exposed in the various modules listed above.

193−

194−5.27

195−----

196−

197−* Added `Graphics.Vty.Config.getTtyEraseChar` to support querying the

198− kernel for the current terminal's settings to obtain the character

199− assigned by the `stty erase` command. That can then be added to the

200− Vty configuration's input map to map to `KBS` (backspace) if desired.

201−

202−5.26

203−----

204−

205−* Resolved various import warnings (thanks @glguy)

206−* Removed the `MonadIO` constraint from the Output type's fields and

207− removed `MonadFail` uses (PR #177, thanks @glguy)

208−* Clarified documentation for ANSI colors (thanks Colby Jenn)

209−* `Graphics.Vty.Attributes` no longer re-exports

210− `Graphics.Vty.Attributes.Color`

211−* The `Graphics.Vty.Attributes.Color` module is now exposed (thanks

212− Colby Jenn)

213−* Raised upper bound for `microlens` to 0.4.12 (thanks Artyom Kazak)

214−* Changed from using `System.Posix.Env.getEnv` to

215− `System.Environment.lookupEnv` (thanks Jonathan Osser)

216−* Added `Graphics.Vty.Image` functions for dealing with character width

217− computations on `Text` values instead of `Strings`:

218− * `safeWctwidth`

219− * `safeWctlwidth`

220− * `wctwidth`

221− * `wctlwidth`

222−

223−5.25.1

224−------

225−

226−* Avoided a conflict with a Microlens 0.4.10 operator and added an

227− upper bound on Microlens of 0.4.11.

228−

229−5.25

230−----

231−

232−* The Vty type got a new field, isShutdown, that returns whether the

233− Vty handle has had its 'shutdown' function called (thanks Ian

234− Jeffries)

235−* Vty's shutdown function is now thread-safe.

236−

237−5.24.1

238−------

239−

240−* The "shutdown" method of Vty handles is now idempotent (#159)

241−

242−5.24

243−----

244−

245−* Add Generic and NFData instances for some types

246−* Image: remove custom Show instance, add derived Show and Read

247− instances

248−* Updated Travis build settings (thanks Eric Mertens)

249−

250−5.23.1

251−------

252−

253−* Fixed a bug where italics did not combine properly with other display

254− modes (#155, thanks Eric Mertens)

255−

256−5.23

257−----

258−

259−* Added support for italicized output when terminfo supports it. This

260− takes the form of a new Style, "italic". Note that most terminfo

261− descriptors do not report capabilities for italics, so support for

262− this will be very spotty.

263−* Updateed text/string function documentation to indicate that escapes

264− are not permitted in their inputs.

265−

266−5.22

267−----

268−

269−* Added Graphics.Vty.Attributes.Color240.color240CodeToRGB function

270− (thanks Brent Carmer)

271−* Added nextEventNonblocking function (field) to Vty type (#87)

272−

273−5.21

274−----

275−

276−* Picture and Background now provide Eq instances (thanks Jaro Reinders)

277−* #145: vty builds with microlens 0.4.9 (thanks Daniel Wagner)

278−* #142: note requirement of threaded RTS

279−

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−

29315.19

294−----

295−

2962API 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.

3+ - URL hyperlinking (via 'withURL') is now optional and disabled by

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

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

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

7+ Vty handle.

3028

30395.18.1

304−------

305−

30610Bug fixes:

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

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

30812

309135.18

310−----

311−

31214API 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

15+ - Added support for hyperlinking attributes (thanks Getty Ritter). This

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

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

31618

317195.17.1

318−------

319−

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

321− untouched if the input style is the null style

20+ - withStyle now ignores zero arguments, leaving attribute styles

21+ untouched if the input style is the null style

32222

323235.17

324−----

325−

32624API 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)

25+ - Add support for terminal focus events. This change adds a new mode

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

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

28+ constructors, EvLostFocus and EvGainedFocus.

29+ - No longer enable UTF8 mouse event encoding. This encoding was not

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

31+ etc.) work.

32+ - Graphics.Vty.Attributes: escape backticks in Haddock comment (fixes

33+ #131)

33634

337355.16

338−----

339−

34036API 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!

37+ - Added support for mouse wheel events while in mouse mode. The Button

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

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

34440

34541Bug fixes:

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

42+ - charFill now clamps negative arguments to zero (thanks Eric

43+ Mertens!)

34744

348455.15.1

349−------

350−

35146Package changes:

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

353− Suchánek)

47+ - Documentation files are now marked accordingly (thanks Michal

48+ Suchánek)

35449

35550Bug fixes:

356−* translateX/Y: fix negative translations

51+ - translateX/Y: fix negative translations

35752

358535.15

359−----

360−

36154Package changes:

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

55+ - Discontinued support for GHC versions prior to 7.10.1.

56+ - Removed instructions and configuration for Stack builds since they

57+ are no longer supported.

58+ - Clarified README mention of (lack of) Windows support (contributors

59+ wanted, though!)

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

36861

36962API changes:

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.

63+ - Moved color definitions from Attributes to Color module.

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

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

66+ - Graphics.Vty.Output no longer re-exports

67+ Graphics.Vty.Output.Interface.

68+ - Removed Graphics.Vty.Prelude module and moved DisplayRegion and its

69+ accessors to Graphics.Vty.Image.

70+ - Graphics.Vty.Image no longer re-exports Graphics.Vty.Attributes.

71+ - Graphics.Vty.Picture no longer re-exports Graphics.Vty.Image.

37972

380735.14

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.

74+ - addMaybeClippedJoin: instead of raising an exception when the join

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

76+ - addMaybeClipped: skip blit of joins when their primary dimension is

77+ zero

78+ - 'string' and related text functions no longer treat an empty string

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

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

39081

391825.13

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

83+ - Reverted changes in 5.12 due to disagreements between terminal

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

85+ discussion at

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

39887

399885.12

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.

89+ - Replaced 'wcwidth' with a call to the utf8proc library's character

90+ width function, which is much more up to date (by several Unicode

91+ versions) and returns the right width for a much larger set of

92+ characters.

93+ - Added a bundled version of the utf8proc C library.

40794

408955.11.3

409−------

410−

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

96+ - Fix mouse event offsets in mouse-up events

41297

413985.11.2

414−------

415−

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

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

99+ - Mouse events were modified so that the upper-left corner of the

100+ window is (0,0) rather than (1,1).

418101

4191025.11.1

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

103+ - Add Generic instance for Image

104+ - nextEvent: stop trying to refresh on a resize event (fixes segfault

105+ on refresh with normal cursor positioning mode)

106+ - Remove redundant clause from clipForCharWidth (thanks Eric Mertens)

107+ - Update maintainer

427108

4281095.11

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)

110+ - Vty now raises a VtyConfigurationError exception when the TERM

111+ evironment variable is missing (thanks Eric Mertens)

112+ - Graphics.Vty.Config got an explicit export list to avoid accidentally

113+ exporting internal types (thanks Eric Mertens)

435114

4361155.10

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)

116+ - Add absolute cursor positioning mode AbsoluteCursor to Cursor. This

117+ mode provides greater control over cursor positioning by bypassing

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

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

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

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

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

123+ - Fixed the MShift case in the configuration file parser (thanks Eric

124+ Mertens)

125+ - Fixed wcwidth import and matched safeWcswidth to its documented

126+ behavior. Previously vty_mk_wcwidth was being imported with

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

128+ wrong Int value. Additionally safeWcswidth was using the unsafe

129+ character width function and only ensuring that the final result was

130+ non-negative. (thanks Eric Mertens)

454131

4551325.9.1

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)

133+ - Vty now only emits UTF8 charset sequences in terminals without a

134+ preexisting UTF8 declaration to avoid emitting garbage sequences

135+ (fixes #89)

461136

4621375.9

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)

138+ - Added new Output methods supportsBell and ringTerminalBell to find

139+ out whether the output device has an audio bell and to ring it (see

140+ #102)

467141

4681425.8.1

469−-----

470−

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

143+ - Fixed "refresh" to work as advertised (see #104)

472144

4731455.8

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

146+ - API change: EvPaste input event now provides paste data as a raw

147+ ByteString rather than a String to allow the application to decode

148+ how best to decode it

479149

4801505.7.1

481−-----

482−

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

151+ - ModeDemo: added an explicit Control.Applicative import for older

152+ GHCs

484153

4851545.7

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

155+ - Mouse and paste modes are now off by default.

156+ - The Config type got new fields: mouseMode and bracketedPasteMode.

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

158+ terminals that support them).

159+ - Added a Mode type for modal terminal features (mouse events,

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

161+ functions:

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

163+ mode

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

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

166+ off

167+ - Added a new demo program, ModeDemo.hs, to demonstrate usage of modes

501168

5021695.6

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

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

171+ terminals via the MouseDown and MouseUp Event constructors

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

173+ the EvPaste event constructor

174+ - Added derived Show instances for Event and Button (thanks Felix

175+ Hirn)

176+ - Now TERM values containing "screen" will automatically use the

177+ XtermColor driver rather than just TerminfoBased

513178

5141795.5.0

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

180+ - Replaced lens dependency with microlens, microlens-mtl, microlens-th

181+ dependencies. Issue #90

182+ - Thanks Jonathan Daugherty

183+ - Cabal corrections.

184+ - Thanks Lennart Spitzner

522185

5231865.4.0

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−

187+ - Changed eventChannel of Graphics.Vty.Input from Chan to TChan.

188+ This enables clients to query if there are no pending events. The

189+ Graphics.Vty interface nextEvent is unchanged. Clients that use

190+ eventChannel directly will require updating.

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

5321925.3.1

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

193+ - Reverted cabal file to depend on Cabal >= 1.18 instead of 1.20 due

194+ to possibly breaking this on reasonable GHC versions

537195

5381965.3

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.

197+ - Upgraded QuickCheck dependency to 2.7

198+ - The standard IO Config (standardIOConfig) was overriding any

199+ provided application config. In addition, the inputFd and outputFd

200+ could not be changed if mkVty was used. Fixed.

201+ - Correct handling of display attributes at end of line. The output

202+ attributes are set to default at the end of content for the line and

203+ at the start of a new line. Previously the current attribute would

204+ extend to the next start of content. This was odd to reason about

205+ and was the cause of https://github.com/coreyoconnor/vty/issues/76

206+ IIRC Yi requires the old behavior to display the selection region

207+ correctly.

208+ - shutdown of the input thread is now performed using killThread and

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

210+ read vmin and vtime the read must be a blocking read on an OS

211+ thread. This places a threadWaitRead, which will be interrupted by

212+ the killThread, prior to the uninterruptable read. An alternative

213+ would be to re-import the read foreign call as interruptable.

557214

5582155.2.11

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

216+ - deepseq bounds increased for tests.

217+ - Clean up warnings when compiling on 7.10

218+ - Thanks Eric Mertens

219+ - Avoid discarding input bytes after multi-byte encoded codepoint

220+ - Thanks Eric Mertens

566221

5672225.2.10

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

223+ - "str" now returns EmptyImage for empty strings to match behavior of

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

225+ - Thanks Jonathan Daugherty

573226

5742275.2.9

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

228+ - dependency version bumps

229+ - https://github.com/coreyoconnor/vty/pull/71

230+ - https://github.com/coreyoconnor/vty/pull/70

231+ - Correct/Simplify the example code

232+ - Thanks glguy

233+ - https://github.com/coreyoconnor/vty/pull/69

583234

5842355.2.8

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

236+ - blaze-builder, lens, utf8-string version constraint bump

237+ - Thanks glguy

238+ - https://github.com/coreyoconnor/vty/pull/67

239+ - Do not differentiate based on TERM_PROGRAM

240+ - https://github.com/coreyoconnor/vty/issues/68

592241

5932425.2.7

594−-----

595−

596−* lens and deepseq constraint bump + misc

597− * Thanks ethercrow

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

243+ - lens and deepseq constraint bump + misc

244+ - Thanks ethercrow

245+ - https://github.com/coreyoconnor/vty/pull/66

599246

6002475.2.6

601−-----

602−

603−* lens constraint bump

604− * Thanks alexander-b!

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

248+ - lens constraint bump

249+ - Thanks alexander-b!

250+ - https://github.com/coreyoconnor/vty/pull/64

606251

6072525.2.5

608−-----

609−

610−* lens and random version constraint bump.

611− * Thanks RyanGlScott!

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

253+ - lens and random version constraint bump.

254+ - Thanks RyanGlScott!

255+ - https://github.com/coreyoconnor/vty/pull/62

613256

6142575.2.4

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!

258+ - removed -fpic from cc-options. No longer required.

259+ - https://github.com/coreyoconnor/vty/issues/61

260+ - https://ghc.haskell.org/trac/ghc/ticket/9657

261+ - Thanks Fuuzetsu!

621262

6222635.2.3

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!

264+ - evaluate/compile the input parsing table once instead of each

265+ keystroke.

266+ - https://github.com/coreyoconnor/vty/pull/59

267+ - Thanks ethercrow!

629268

6302695.2.2

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!

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

271+ - https://github.com/coreyoconnor/vty/pull/57

272+ - Thanks ethercrow!

636273

6372745.2.1

638−-----

639−

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

275+ - Bump upper version bound for lens to 4.5. Thanks markus1189!

641276

6422775.2.0

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

278+ - Config structure now specifies file descriptor to use. The default

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

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

281+ - hDuplicate stdout >>= handleToFd >>= (`hSetBuffering`

282+ NoBuffering)

283+ - the difference was required by Vty.Inline. Now, Vty.Inline uses

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

285+ - removed: derivedVtime, derivedVmin, inputForCurrentTerminal,

286+ inputForNameAndIO, outputForCurrentTerminal, outputForNameAndIO

287+ - added: inputForConfig, outputForConfig

288+ - updates to vty-rogue from jtdaugherty. Thanks!

289+ - the oldest version of GHC tested to support vty is 7.6.2.

290+ - the oldest version of GHC that vty compiles under is 7.4.2

658291

6592925.1.4

660−-----

661−

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

293+ - merged https://github.com/coreyoconnor/vty/pull/51 thanks trofi!

663294

6642955.1.1

665−-----

666−

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

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

296+ - merged https://github.com/coreyoconnor/vty/pull/48 thanks sjmielke!

297+ - jtdaugherty resolved a number of compiler warnings. Thanks!

669298

6702995.1.0

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.

300+ - vmin and vtime can be specified however the application requires.

301+ See Graphics.Vty.Config.

302+ - fixed the processing of input when vmin is set > 1.

676303

6773045.0.0

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

305+ - The naming convention now matches:

306+ - http://www.haskell.org/haskellwiki/Programming_guidelines#Naming_Conventions

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

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

309+ - mkVtyEscDelay has been removed. Use "mkVty def". Which initialized

310+ vty with the default configuration.

311+ - input handling changes

312+ - KASCII is now KChar

313+ - KPN5 is now KCenter

314+ - tests exist.

315+ - Applications can add to the input tables by setting inputMap of

316+ the Config. See Graphics.Vty.Config

317+ - Users can define input table extensions that will apply to all vty

318+ applications. See Graphics.Vty.Config

319+ - terminal timing is now handled by selecting an appropriate VTIME.

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

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

322+ implies a requirement on -threaded.

323+ - The time vty will wait to verify an ESC byte means a single ESC

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

325+ - removed the typeclass based terminal and display context interface

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

327+ - renamed the Terminal interface to Output

328+ - The default picture for an image now uses the "clear" background.

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

330+ line.

331+ - Previously the background defaulted to the space character. This

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

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

334+ - Layer support

335+ - Each layer is an image.

336+ - The layers for a picture are a list of images.

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

338+ top to bottom.

339+ - The transparent areas for a layer are the backgroundFill areas.

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

341+ sizes are joined.

342+ - If the background is clear there is no background layer.

343+ - If there is a background character then the bottom layer is the

344+ background layer.

345+ - emptyPicture is a Picture with no layers and no cursor

346+ - addToTop and addToBottom add a layer to the top and bottom of the

347+ given Picture.

348+ - compatibility improvements:

349+ - terminfo based terminals with no cursor support are silently

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

351+ no effect.

352+ - alternate (setf/setb) color maps supported. Though colors beyond

353+ the first 8 are just a guess.

354+ - added "rgbColor" for easy support of RGB specified colors.

355+ - Both applications and users can add to the mapping used to

356+ translate from input bytes to events.

357+ - Additional information about input and output process can be

358+ appended to a debug log

359+ - Set environment variable VTY_DEBUG_LOG to path of debug log

360+ - Or use "debugLog <path>" config directive

361+ - Or set 'debugLog' property of the Config provided to mkVty.

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

363+ file.

364+ - vty-interactive-terminal-test

365+ - interactive test. Useful for building a bug report for vty's

366+ author.

367+ - test/interactive_terminal_test.hs

368+ - vty-event-echo

369+ - view a input event log for vty. Example of interacting with

370+ user.

371+ - test/EventEcho.hs

372+ - vty-rogue

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

374+ build operations.

375+ - test/Rogue.hs

376+ - vty-benchmark

377+ - benchmarks vty. A series of tests that push random pictures to

378+ the terminal. The random pictures are generated using

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

380+ - test/benchmark.hs

756381

7573824.7.0.0

758−-------

383+ - API changes:

384+ - Added Graphics.Vty.Image.crop: Ensure an image is no larger

385+ than the specified size.

386+ - Added Graphics.Vty.Image.pad: Ensure an image is no smaller

387+ than the specified size.

388+ - Added Graphics.Vty.Image.translate: Offset an image.

389+ - Thanks Ben Boeckel <MathStuf@gmail.com> for these features.

759390

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.

391+4.3.0.0

767392

7683934.2.1.0

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

394+ - API changes:

395+ - Attr record accessor fore_color changed to attr_fore_color

396+ - Attr record accessor back_color changed to attr_back_color

397+ - Attr record accessor style changed to attr_style

398+ - Added an "inline" display attribute changing DSL:

399+ - put_attr_change applies a display attribute change

400+ immediately to a terminal

401+ - For instance, can be used to change the display attrbiutes

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

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

404+ color to red.

405+ - Changes do not apply to a Picture output via output_picture.

406+ - See Graphics.Vty.Inline

407+ - Moved all IO actions into any monad an instance of MonadIO

785408

7864094.0.0.1

787−-------

788−

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

790− magically worked due to coincidence.

410+ - binding for mk_wcswidth was incorrect. Most platforms just

411+ magically worked due to coincidence.

791412

7924134.0.0

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.

414+ - API changes:

415+ - "getSize" has been removed. Use "terminal vty >>= display_bounds"

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

417+ - added a "terminal" field to the Vty data structure. Accesses the

418+ TerminalHandle associated with the Vty instance.

419+ - Graphics.Vty.Types has undergone a number of changes. Summary:

420+ - Partitioned into Graphics.Vty.Attributes for display attributes.

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

422+ for final picture construction.

423+ - Graphics.Vty.Attributes:

424+ - "setFG" and "setBG" are now "with_fore_color" and

425+ "with_back_color"

426+ - All other "set.." equations similarly replaced.

427+ - "attr" is now "def_attr", short for "default display attributes"

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

429+ attributes"

430+ - Graphics.Vty.Image:

431+ - "horzcat" is now "horiz_cat"

432+ - "vertcat" is now "vert_cat"

433+ - "renderBS" is now "utf8_bytestring"

434+ - "renderChar" is now "char"

435+ - "renderFill" is now "char_fill"

436+ - added a "utf8_string" and "string" (AKA "iso_10464_string") for

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

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

439+ - Graphics.Vty.Picture:

440+ - exports Graphics.Vty.Image

441+ - "pic" is now "pic_for_image"

442+ - added API for setting background fill pattern.

443+ - Completely rewritten output backend.

444+ - Efficient, scanline style output span generator. Has not been

445+ fully optimized, but good enough.

446+ - The details required to display the desired picture on a

447+ terminal are well encapsulated.

448+ - Terminfo based display terminal implementation. With specialized

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

450+ - Attempts to robustly handle even terminals that don't

451+ support all display attributes.

452+ - I've tested the following terminals with success: iTerm.app,

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

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

455+ successfull.

456+ - Improved unicode support. Double wide characters will display as

457+ expected.

458+ - 256 color support. See Graphics.Vty.Attributes.Color240. The actual

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

460+ terminal supports.

461+ - The Graphics.Vty.Image combinators no longer require matching

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

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

464+ - output images are always cropped to display size.

465+ - Significant code coverage by QuickCheck tests. An interactive test

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

848467

849468Issues resolved:

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

469+ - "gnome terminal displays non-basic attributes as strikethrough"

470+ - http://trac.haskell.org/vty/ticket/14

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

472+ - http://trac.haskell.org/vty/ticket/10

473+ - "Redraw does not handle rendering a line that extends beyond screen

474+ width characters"

475+ - http://trac.haskell.org/vty/ticket/13

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

477+ dimensions"

478+ - http://trac.haskell.org/vty/ticket/9

479+ - "256-color support"

480+ - http://trac.haskell.org/vty/ticket/19

LICENSE−2

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

1−BSD 3-Clause License

2−

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

53All rights reserved.

README.md+53−108

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

1818

1919# Features

2020

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

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

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

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

2323

24−* Automatically handles window resizes.

24+* Automatic handling of window resizes.

2525

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

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

2727

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

29− state changes are minimized.

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.

3033

3134* Minimizes repaint area, which virtually eliminates the flicker

3235 problems that plague ncurses programs.

3336

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

35− display images.

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

38+ images.

3639

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

3841

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

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

4245 customizable.

4346

44−* Provides extensible input and output interfaces.

47+* The interface is designed for easy extension.

4548

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

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

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

5760* Supports bracketed paste mode as described at

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

5962

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−

7163# Platform Support

7264

7365## Posix Terminals

7466

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

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

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

68+handle some omissions from terminfo.

7769

7870## Windows

7971

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.

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

16073

16174# Contributing

16275

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

17083 conventions already used in the codebase.

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

17285

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+

173119# Known Issues

174120

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.

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

122+ the author in ambiguous or buggy situations.

178123

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

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

180125

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

182127 unicode is used.

@@ -186,10 +131,10 @@ should consider to make submitting patches easier for all concerned:

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

187132 particular terminal.

188133

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

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

190135 appears to be limited to Linux and BSD.

191136

192−# Further Reading

137+# Sources

193138

194139Good sources of documentation for terminal programming are:

195140

cbits/get_tty_erase.cdeleted−18

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

1−#include <termios.h>

2−#include <stdio.h>

3−#include <unistd.h>

4−#include <stdlib.h>

5−

6−// Given a file descriptor for a terminal, get the ERASE character for

7−// the terminal. If the terminal info cannot be obtained, this returns

8−// zero.

9−char vty_get_tty_erase(int fd)

10−{

11− struct termios trm;

12−

13− if (0 == tcgetattr(fd, &trm)) {

14− return (char) trm.c_cc[VERASE];

15− } else {

16− return (char) 0;

17− }

18−}

cbits/gwinsz.c+5−14

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

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;

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

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;

189}

cbits/gwinsz.h+1−2

@@ -1,2 +1 @@

1−unsigned long vty_c_get_window_size(int fd);

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

1+unsigned long vty_c_get_window_size(void);

cbits/mk_wcwidth.c+2−136

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

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;

8563

8664struct interval {

8765 int first;

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

141119 * in ISO 10646.

142120 */

143121

144−static HsInt builtin_wcwidth(HsChar ucs)

122+HsInt vty_mk_wcwidth(HsChar ucs)

145123{

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

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

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

204182

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

206184 if (vty_bisearch(ucs, combining,

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

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

208186 return 0;

209187

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

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

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

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

226204}

227−

228−// Return the width, in terminal cells, of the specified character.

229−//

230−// If the global custom width table is present, that table will be

231−// consulted for the character's width. If the character is not in

232−// the table, zero will be returned. If the custom width table is not

233−// present, the built-in width table will be used.

234−HsInt vty_mk_wcwidth(HsChar ch)

235−{

236− if (custom_table_ready) {

237− if ((ch >= 0) && (ch < custom_table_size)) {

238− return custom_table[ch];

239− } else {

240− return -1;

241− }

242− } else {

243− return builtin_wcwidth(ch);

244− }

245−}

246−

247−// Initialize a custom character width table.

248−//

249−// This allocates a new character width table of the specified size

250−// (in characters). If a custom table has already been allocated, this

251−// returns 1. Otherwise it allocates a new table, initializes all of its

252−// entries to 1, and returns zero.

253−//

254−// Note that this does *not* mark the table as ready for use. Until the

255−// table is marked ready, it will not be used by vty_mk_wcwidth. To mark

256−// the table as ready, call vty_activate_custom_table() after the table

257−// has been set up with calls to vty_set_custom_table_range.

258−int vty_init_custom_table(int size)

259−{

260− if (custom_table == NULL) {

261− if (size > 0 && size <= MAX_CUSTOM_TABLE_SIZE) {

262− custom_table_ready = 0;

263− custom_table = malloc(size);

264− memset(custom_table, 1, size);

265− custom_table_size = size;

266− return 0;

267− } else {

268− return 1;

269− }

270− } else {

271− return 1;

272− }

273−}

274−

275−// Set the specified character range in the custom width table to the

276−// specified width.

277−//

278−// This function sets 'width' as the character width for all entries

279−// in the custom character table starting at the 'start' entry and

280−// including all entries up to and including 'start + size - 1'.

281−//

282−// If this succeeds, it returns zero. If it fails, it returns 1. It

283−// fails if the table is not allocated, marked as ready (i.e. it is in

284−// use and has already been populated), or if the start or size values

285−// are not in bounds for the table.

286−int vty_set_custom_table_range(uint32_t start, uint32_t size, uint8_t width)

287−{

288− if ((custom_table == NULL) ||

289− (size >= custom_table_size) ||

290− (start >= custom_table_size) ||

291− ((start + 1) >= (custom_table_size - size)) ||

292− custom_table_ready) {

293− return 1;

294− } else {

295− memset(custom_table + start, width, size);

296− return 0;

297− }

298−}

299−

300−// Mark the allocated custom character width table as ready for use.

301−//

302−// After this call, further calls to vty_set_custom_table_range will

303−// fail.

304−//

305−// This function returns 0 if it succeeds. If it fails, it returns 1.

306−// It fails if the custom table is already ready or if it has not been

307−// allocated.

308−int vty_activate_custom_table()

309−{

310− if (custom_table_ready || (custom_table == NULL)) {

311− return 1;

312− } else {

313− custom_table_ready = 1;

314− return 0;

315− }

316−}

317−

318−// Returns whether a custom character width table has been marked ready.

319−int vty_custom_table_ready()

320−{

321− return custom_table_ready;

322−}

323−

324−// Deallocate the custom width table.

325−//

326−// This does nothing if there is no allocated custom width table, or if

327−// there is one but it is in use (marked ready). This is only useful if

328−// an initial allocation succeeds, but range population fails, after

329−// which point the application may want to deallocate the table to avoid

330−// leaving it in an intermediate state.

331−void vty_deallocate_custom_table()

332−{

333− if ((custom_table != NULL) && (!custom_table_ready)) {

334− free(custom_table);

335− custom_table = NULL;

336− custom_table_size = 0;

337− }

338−}

demos/Demo.hs+4−12

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

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

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

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

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

3736 , "claims 240 colors are not supported."

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

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

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

4443 ]

4544

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−

5545colorbox_240 :: Image

5646colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages

5747 where

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

49+ splitColorImages [] = []

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

5951

6052colorbox_16 :: Image

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

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

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

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

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

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

8274 vty <- ask

8375 liftIO $ update vty pic

8476

demos/ModeDemo.hs−2

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

33import Control.Applicative

44import Data.Monoid

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

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

86import Graphics.Vty

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

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

1414utf8FromIso = encode . map toEnum

1515

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

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

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

18+

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

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

77import Control.Parallel.Strategies

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

10− rnf = rnf' . viewl

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

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 <- evalParams <$> get

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

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 = mapM_ writeCapOp

67+writeCapOps ops = mapM_ writeCapOp ops

6868

6969writeCapOp :: CapOp -> Eval ()

7070writeCapOp (Bytes !offset !count) = do

71− !cap <- evalExpression <$> get

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

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+13−22

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

11{-# LANGUAGE BangPatterns #-}

2−{-# LANGUAGE CPP #-}

2+{-# OPTIONS_HADDOCK hide #-}

33{-# LANGUAGE NoMonomorphismRestriction #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

4+{-# LANGUAGE NamedFieldPuns #-}

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

6−{-# OPTIONS_HADDOCK hide #-}

87module Data.Terminfo.Parse

98 ( module Data.Terminfo.Parse

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

1413import Control.Monad ( liftM )

1514import Control.DeepSeq

1615

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

18−import Data.Semigroup (Semigroup(..))

19−#endif

2016import Data.Word

2117import qualified Data.Vector.Unboxed as Vector

2218

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

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

4036 where

4137 hexDump :: [Word8] -> String

42− hexDump = foldr showHex ""

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

4339

4440instance NFData CapExpression where

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

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

9995 Left e -> Left e

10096 Right buildResults -> Right $ constructCapExpression capString buildResults

10197

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

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

10399constructCapExpression capString buildResults =

104100 let expr = CapExpression

105101 { capOps = outCapOps buildResults

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

128124literalPercentParser :: CapParser BuildResults

129125literalPercentParser = do

130126 _ <- char '%'

131− startOffset <- nextOffset <$> getState

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

132128 incOffset 1

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

134130

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

154150pushOpParser :: CapParser BuildResults

155151pushOpParser = do

156152 _ <- char 'p'

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

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

158154 incOffset 2

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

160156

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

299295bytesOpParser :: CapParser BuildResults

300296bytesOpParser = do

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

302− startOffset <- nextOffset <$> getState

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

303299 let !c = length bytes

304300 !s <- getState

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

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

333329 , outParamOps :: !ParamOps

334330 }

335331

336−instance Semigroup BuildResults where

337− v0 <> v1

338− = BuildResults

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

340− , outCapOps = outCapOps v0 <> outCapOps v1

341− , outParamOps = outParamOps v0 <> outParamOps v1

342− }

343−

344332instance Monoid BuildResults where

345333 mempty = BuildResults 0 [] []

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

347− mappend = (<>)

348−#endif

334+ v0 `mappend` v1

335+ = BuildResults

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

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

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

339+ }

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

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

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

134module Graphics.Text.Width

145 ( wcwidth

156 , wcswidth

16− , wctwidth

17− , wctlwidth

187 , safeWcwidth

198 , safeWcswidth

20− , safeWctwidth

21− , safeWctlwidth

229 )

2310where

2411

25−import Data.List (foldl')

26−import qualified Data.Text as T

27−import qualified Data.Text.Lazy as TL

28−

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

3013

3114wcswidth :: String -> Int

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

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

34−

35−wctwidth :: T.Text -> Int

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

15+wcswidth = sum . map wcwidth

3716

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− #-}

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.

4524

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

4726-- with unknown widths are 0 width.

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

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

5231-- unknown widths are 0 width.

5332safeWcswidth :: String -> Int

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

33+safeWcswidth = sum . map safeWcwidth

src/Graphics/Vty.hs+38−134

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

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE ScopedTypeVariables #-}

3−

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

52-- output.

63--

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

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

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

1512--

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−--

1913-- @

2014-- import "Graphics.Vty"

2115--

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

3428module Graphics.Vty

3529 ( Vty(..)

3630 , mkVty

37− , setWindowTitle

3831 , Mode(..)

3932 , module Graphics.Vty.Config

4033 , module Graphics.Vty.Input

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

4841

4942import Graphics.Vty.Config

5043import Graphics.Vty.Input

51−import Graphics.Vty.Input.Events

5244import Graphics.Vty.Output

5345import Graphics.Vty.Output.Interface

5446import Graphics.Vty.Picture

5547import Graphics.Vty.Image

5648import Graphics.Vty.Attributes

57−import Graphics.Vty.UnicodeWidthTable.IO

58−import Graphics.Vty.UnicodeWidthTable.Install

5949

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)

6550import Control.Concurrent.STM

6651

6752import Data.IORef

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

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

70−#endif

53+import Data.Monoid

7154

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

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

7457--

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

7659--

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

60+-- 1. Initialize vty

7861--

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

8063--

@@ -82,33 +65,31 @@ import Data.Semigroup ((<>))

8265--

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

8467--

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

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

68+-- 5. Shutdown vty.

8769--

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

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

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

11293

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

11495-- for a given terminal device.

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

121102mkVty :: Config -> IO Vty

122103mkVty appConfig = do

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

105+ input <- inputForConfig config

106+ out <- outputForConfig config

107+ intMkVty input out

124108

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

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

110+intMkVty input out = do

169111 reserveDisplay out

170−

171− shutdownVar <- newTVarIO False

172112 let shutdownIo = do

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−

113+ shutdownInput input

114+ releaseDisplay out

115+ releaseTerminal out

181116 lastPicRef <- newIORef Nothing

182117 lastUpdateRef <- newIORef Nothing

183118

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

209144 mPic <- readIORef lastPicRef

210145 maybe (return ()) innerUpdate mPic

211146

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

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

225152

226153 return $ Vty { update = innerUpdate

227154 , nextEvent = gkey

228− , nextEventNonblocking = gkey'

229155 , inputIface = input

230156 , outputIface = out

231157 , refresh = innerRefresh

232158 , shutdown = shutdownIo

233− , isShutdown = shutdownStatus

234159 }

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+43−30

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

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveGeneric #-}

3−{-# LANGUAGE DeriveAnyClass #-}

1+{-# LANGUAGE StandaloneDeriving #-}

2+{-# LANGUAGE GADTs #-}

3+{-# LANGUAGE RankNTypes #-}

55-- | Display attributes

66--

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

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

2828-- output previously.

2929module Graphics.Vty.Attributes

30− ( module Graphics.Vty.Attributes.Color

31−

32− , Attr(..)

30+ ( Attr(..)

3331 , FixedAttr(..)

3432 , MaybeDefault(..)

3533 , defAttr

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

3937 , Style

4038 , withStyle

4139 , standout

42− , italic

43− , strikethrough

4440 , underline

4541 , reverseVideo

4642 , blink

@@ -56,16 +52,19 @@ module Graphics.Vty.Attributes

5652

5753 -- * Setting hyperlinks

5854 , withURL

55+

56+ -- * Colors

57+ , module Graphics.Vty.Attributes.Color

58+ , module Graphics.Vty.Attributes.Color240

5959 )

6060where

6161

62−import Control.DeepSeq

6362import Data.Bits

6463import Data.Text (Text)

6564import Data.Word

66−import GHC.Generics

6765

6866import Graphics.Vty.Attributes.Color

67+import Graphics.Vty.Attributes.Color240

6968

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

7170-- characters rendered after the attribute is applied.

@@ -79,7 +78,7 @@ data Attr = Attr

7978 , attrForeColor :: !(MaybeDefault Color)

8079 , attrBackColor :: !(MaybeDefault Color)

8180 , attrURL :: !(MaybeDefault Text)

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

81+ } deriving ( Eq, Show, Read )

8382

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

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

@@ -100,19 +99,26 @@ data Attr = Attr

10099-- __ - unused

101100--

102101-- Next is the style flags

103−-- SURBDOI_

102+-- SURBDO__

104103-- S - standout

105104-- U - underline

106105-- R - reverse video

107106-- B - blink

108107-- D - dim

109108-- O - bold

110−-- I - italic

111−-- _ - unused

109+-- __ - unused

112110--

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

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

115113

114+instance Monoid Attr where

115+ mempty = Attr mempty mempty mempty mempty

116+ mappend attr0 attr1 =

117+ Attr ( attrStyle attr0 `mappend` attrStyle attr1 )

118+ ( attrForeColor attr0 `mappend` attrForeColor attr1 )

119+ ( attrBackColor attr0 `mappend` attrBackColor attr1 )

120+ ( attrURL attr0 `mappend` attrURL attr1 )

121+

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

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

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

@@ -127,20 +133,33 @@ data FixedAttr = FixedAttr

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

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

129135-- value.

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

136+data MaybeDefault v where

137+ Default :: MaybeDefault v

138+ KeepCurrent :: MaybeDefault v

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

140+

141+deriving instance Eq v => Eq (MaybeDefault v)

142+deriving instance Eq v => Show (MaybeDefault v)

143+deriving instance (Eq v, Show v, Read v) => Read (MaybeDefault v)

144+

145+instance Eq v => Monoid ( MaybeDefault v ) where

146+ mempty = KeepCurrent

147+ mappend Default Default = Default

148+ mappend Default KeepCurrent = Default

149+ mappend Default ( SetTo v ) = SetTo v

150+ mappend KeepCurrent Default = Default

151+ mappend KeepCurrent KeepCurrent = KeepCurrent

152+ mappend KeepCurrent ( SetTo v ) = SetTo v

153+ mappend ( SetTo _v ) Default = Default

154+ mappend ( SetTo v ) KeepCurrent = SetTo v

155+ mappend ( SetTo _ ) ( SetTo v ) = SetTo v

137156

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

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

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

141160type Style = Word8

142161

143−-- | Valid style attributes include:

162+-- | The 6 possible style attributes:

144163--

145164-- * standout

146165--

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

154173--

155174-- * bold/bright

156175--

157−-- * italic

158−--

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

160−--

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

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

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

178+standout, underline, reverseVideo, blink, dim, bold :: Style

164179standout = 0x01

165180underline = 0x02

166−reverseVideo = 0x04

181+reverseVideo = 0x04

167182blink = 0x08

168183dim = 0x10

169184bold = 0x20

170−italic = 0x40

171−strikethrough = 0x80

172185

173186defaultStyleMask :: Style

174187defaultStyleMask = 0x00

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

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

1−{-# LANGUAGE DeriveGeneric #-}

2−{-# LANGUAGE DeriveAnyClass #-}

3−{-# LANGUAGE MultiWayIf #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

5−

61module Graphics.Vty.Attributes.Color

72 ( Color(..)

8− , ColorMode(..)

9−

10− -- * Detecting Terminal Color Support

11− , detectColorMode

12−

13− -- ** Fixed Colors

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

15− --

16− -- Note that these map to colors in the terminal's custom palette. For

17− -- instance, `white` maps to whatever the terminal color theme uses for

18− -- white.

19− --

20− -- Use these functions if you want to make apps that fit the terminal theme.

21− -- If you want access to more/stronger colors use `rgbColor`

223 , black

234 , red

245 , green

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

278 , magenta

289 , cyan

2910 , white

30−

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

3211 , brightBlack

3312 , brightRed

3413 , brightGreen

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

3716 , brightMagenta

3817 , brightCyan

3918 , brightWhite

40− -- ** Creating Colors From RGB

41− , linearColor

42− , srgbColor

43− , rgbColor

44− , color240

45− , module Graphics.Vty.Attributes.Color240

4619 )

4720where

4821

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

5923

6024-- | Abstract data type representing a color.

6125--

@@ -95,7 +59,7 @@ import Graphics.Vty.Attributes.Color240

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

9660--

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

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

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

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

10064-- addressable via the 240 color palette.

10165--

@@ -109,33 +73,10 @@ import Graphics.Vty.Attributes.Color240

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

11074--

11175-- Seriously, terminal color support is INSANE.

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

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

77+ deriving ( Eq, Show, Read )

13878

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

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

14081black = ISOColor 0

14182red = ISOColor 1

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

14687cyan = ISOColor 6

14788white = ISOColor 7

14889

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

14991brightBlack, brightRed, brightGreen, brightYellow :: Color

15092brightBlue, brightMagenta, brightCyan, brightWhite :: Color

15193brightBlack = ISOColor 8

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

15698brightMagenta= ISOColor 13

15799brightCyan = ISOColor 14

158100brightWhite = ISOColor 15

159−

160−linearColor :: Integral i => i -> i -> i -> Color

161−linearColor r g b = RGBColor r' g' b'

162− where

163− r' = fromIntegral (clamp r) :: Word8

164− g' = fromIntegral (clamp g) :: Word8

165− b' = fromIntegral (clamp b) :: Word8

166− clamp = min 255 . max 0

167−

168−srgbColor :: Integral i => i -> i -> i -> Color

169−srgbColor r g b =

170− -- srgb to rgb transformation as described at

171− -- https://en.wikipedia.org/wiki/SRGB#The_reverse_transformation

172− --

173− -- TODO: it may be worth translating this to a lookup table, as with color240

174− let shrink n = fromIntegral n / 255 :: Double

175− -- called gamma^-1 in wiki

176− gamma u

177− | u <= 0.04045 = u/12.92

178− | otherwise = ((u + 0.055) / 1.055) ** 2.4

179− -- TODO: this is a slightly inaccurate conversion. is it worth doing proterly?

180− expand n = round (255 * n)

181− convert = expand . gamma . shrink

182− in RGBColor (convert r) (convert g) (convert b)

183−

184−color240 :: Integral i => i -> i -> i -> Color

185−color240 r g b = Color240 (rgbColorToColor240 r g b)

186−

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

188−-- This function is lossy in the sense that we only internally support 240 colors but the

189−-- #RRGGBB format supports 16^3 colors.

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

191−rgbColor = color240

src/Graphics/Vty/Attributes/Color240.hs+248−285

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

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

22module Graphics.Vty.Attributes.Color240

3− ( rgbColorToColor240

4− , color240CodeToRGB

3+ ( rgbColor

54 )

65where

8−import Data.Word (Word8)

7+import Graphics.Vty.Attributes.Color

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 value in the Color240 set from an RGB triple

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

16−rgbColorToColor240 r g b

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

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

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

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

44259 (fromIntegral r :: Int)

45260 (fromIntegral g :: 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

261+ (fromIntegral b :: Int))

src/Graphics/Vty/Config.hs+68−259

@@ -1,9 +1,7 @@

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE DeriveDataTypeable #-}

32{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

43{-# LANGUAGE TypeOperators #-}

54{-# LANGUAGE ScopedTypeVariables #-}

6−{-# LANGUAGE LambdaCase, MultiWayIf #-}

75-- | Vty supports a configuration file format and associated 'Config'

86-- data type. The 'Config' can be provided to 'mkVty' to customize the

97-- application's use of Vty.

@@ -55,33 +53,7 @@

5553-- If a debug log is requested then vty will output the current input

5654-- table to the log in the above format. A workflow for using this is

5755-- to set @VTY_DEBUG_LOG@. Run the application. Check the debug log for

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.

56+-- incorrect mappings. Add corrected mappings to @$HOME/.vty/config@.

8557module Graphics.Vty.Config

8658 ( InputMap

8759 , Config(..)

@@ -92,17 +64,6 @@ module Graphics.Vty.Config

9264 , runParseConfig

9365 , parseConfigFile

9466 , defaultConfig

95− , getTtyEraseChar

96− , currentTerminalName

97−

98− , vtyConfigPath

99− , widthTableFilename

100− , vtyDataDirectory

101− , terminalWidthTablePath

102− , vtyConfigFileEnvName

103−

104− , ConfigUpdateResult(..)

105− , addConfigWidthMap

10667 )

10768where

10869

@@ -114,40 +75,29 @@ import Control.Exception (catch, IOException, Exception(..), throwIO)

11475import Control.Monad (liftM, guard, void)

11576

11677import qualified Data.ByteString as BS

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

78+import Data.Monoid

12379import Data.Typeable (Typeable)

12480

12581import Graphics.Vty.Input.Events

126−import Graphics.Vty.Attributes.Color (ColorMode(..), detectColorMode)

12782

12883import GHC.Generics

12984

130−import System.Directory ( getAppUserDataDirectory, doesFileExist

131− , createDirectoryIfMissing

132− )

133−import System.Environment (lookupEnv)

134−import System.FilePath ((</>), takeDirectory)

85+import System.Directory (getAppUserDataDirectory)

86+import System.Posix.Env (getEnv)

13587import System.Posix.IO (stdInput, stdOutput)

13688import System.Posix.Types (Fd(..))

137−import Foreign.C.Types (CInt(..), CChar(..))

13889

13990import Text.Parsec hiding ((<|>))

14091import Text.Parsec.Token ( GenLanguageDef(..) )

14192import qualified Text.Parsec.Token as P

14293

14394-- | Type of errors that can be thrown when configuring VTY

144−data VtyConfigurationError =

145− VtyMissingTermEnvVar

146− -- ^ TERM environment variable not set

147− deriving (Show, Eq, Typeable)

95+data VtyConfigurationError

96+ = VtyMissingTermEnvVar -- ^ TERM environment variable not set

97+ deriving (Show, Eq, Typeable)

14898

14999instance Exception VtyConfigurationError where

150− displayException VtyMissingTermEnvVar = "TERM environment variable not set"

100+ displayException VtyMissingTermEnvVar = "TERM environment variable not set"

151101

152102-- | Mappings from input bytes to event in the order specified. Later

153103-- entries take precedence over earlier in the case multiple entries

@@ -155,144 +105,85 @@ instance Exception VtyConfigurationError where

155105type InputMap = [(Maybe String, String, Event)]

156106

157107-- | A Vty configuration.

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)

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)

203136

204137defaultConfig :: Config

205138defaultConfig = mempty

206139

207−instance Semigroup Config where

208− c0 <> c1 =

209− -- latter config takes priority for everything but inputMap

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−

225140instance 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@.

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

153+ -- 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@.

256167userConfig :: IO Config

257168userConfig = do

258− configFile <- vtyConfigPath >>= parseConfigFile

259− overrideConfig <- maybe (return defaultConfig) parseConfigFile =<<

260− lookupEnv vtyConfigFileEnvName

169+ configFile <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile

170+ overrideConfig <- maybe (return defaultConfig) parseConfigFile =<< getEnv "VTY_CONFIG_FILE"

261171 let base = configFile <> overrideConfig

262172 mappend base <$> overrideEnvConfig

263173

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−

282174overrideEnvConfig :: IO Config

283175overrideEnvConfig = do

284− d <- lookupEnv "VTY_DEBUG_LOG"

176+ d <- getEnv "VTY_DEBUG_LOG"

285177 return $ defaultConfig { debugLog = d }

286178

287179-- | Configures VTY using defaults suitable for terminals. This function

288180-- can raise 'VtyConfigurationError'.

289181standardIOConfig :: IO Config

290182standardIOConfig = do

291− mb <- lookupEnv termVariable

183+ mb <- getEnv "TERM"

292184 case mb of

293185 Nothing -> throwIO VtyMissingTermEnvVar

294− Just t -> do

295− mcolorMode <- detectColorMode t

186+ Just t ->

296187 return defaultConfig

297188 { vmin = Just 1

298189 , mouseMode = Just False

@@ -301,7 +192,6 @@ standardIOConfig = do

301192 , inputFd = Just stdInput

302193 , outputFd = Just stdOutput

303194 , termName = Just t

304− , colorMode = Just mcolorMode

305195 }

306196

307197parseConfigFile :: FilePath -> IO Config

@@ -353,20 +243,13 @@ debugLogDecl = do

353243 path <- P.stringLiteral configLexer

354244 return defaultConfig { debugLog = Just path }

355245

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−

363246ignoreLine :: Parser ()

364247ignoreLine = void $ manyTill anyChar newline

365248

366249parseConfig :: Parser Config

367250parseConfig = liftM mconcat $ many $ do

368251 P.whiteSpace configLexer

369− let directives = [try mapDecl, try debugLogDecl, try widthMapDecl]

252+ let directives = [try mapDecl, try debugLogDecl]

370253 choice directives <|> (ignoreLine >> return defaultConfig)

371254

372255class Parse a where parseValue :: Parser a

@@ -412,77 +295,3 @@ instance (GParseAlts f, GParseAlts g) => GParseAlts (f :+: g) where

412295 gparseAlts con = L1 <$> gparseAlts con <|> R1 <$> gparseAlts con

413296

414297instance 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−rowOpsAffectedColumns :: DisplayOps -> [Int]

16−rowOpsAffectedColumns ops

17− = Vector.toList $ Vector.map spanOpsAffectedColumns ops

15+rowOpsEffectedColumns :: DisplayOps -> [Int]

16+rowOpsEffectedColumns ops

17+ = Vector.toList $ Vector.map spanOpsEffectedColumns ops

1818

1919allSpansHaveWidth :: DisplayOps -> Int -> Bool

2020allSpansHaveWidth ops expected

21− = all (== expected) $ Vector.toList $ Vector.map spanOpsAffectedColumns ops

21+ = all (== expected) $ Vector.toList $ Vector.map spanOpsEffectedColumns ops

2222

23−spanOpsAffectedRows :: DisplayOps -> Int

24−spanOpsAffectedRows ops

23+spanOpsEffectedRows :: DisplayOps -> Int

24+spanOpsEffectedRows ops

2525 = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList ops))

2626

2727type SpanConstructLog = [SpanConstructEvent]

src/Graphics/Vty/DisplayAttributes.hs+3−18

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

22{-# LANGUAGE BangPatterns #-}

3−{-# LANGUAGE CPP #-}

54module Graphics.Vty.DisplayAttributes where

@@ -8,9 +7,6 @@ import Graphics.Vty.Attributes

98import Data.Bits ((.&.))

109import Data.ByteString (ByteString)

11−#if !(MIN_VERSION_base(4,11,0))

12−import Data.Semigroup (Semigroup(..))

13−#endif

1410import Data.Text (Text)

1511import Data.Text.Encoding (encodeUtf8)

1612

@@ -51,20 +47,15 @@ data DisplayAttrDiff = DisplayAttrDiff

5147 }

5248 deriving (Show)

5349

54−instance Semigroup DisplayAttrDiff where

55− d0 <> d1 =

50+instance Monoid DisplayAttrDiff where

51+ mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange

52+ mappend d0 d1 =

5653 let ds = simplifyStyleDiffs (styleDiffs d0) (styleDiffs d1)

5754 fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1)

5855 bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1)

5956 ud = simplifyUrlDiffs (urlDiff d0) (urlDiff d1)

6057 in DisplayAttrDiff ds fcd bcd ud

6158

62−instance Monoid DisplayAttrDiff where

63− mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange

64−#if !(MIN_VERSION_base(4,11,0))

65− mappend = (<>)

66−#endif

67−

6859-- | Used in the computation of a final style attribute change.

6960simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]

7061simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1

@@ -94,10 +85,6 @@ data DisplayColorDiff

9485data StyleStateChange

9586 = ApplyStandout

9687 | RemoveStandout

97− | ApplyItalic

98− | RemoveItalic

99− | ApplyStrikethrough

100− | RemoveStrikethrough

10188 | ApplyUnderline

10289 | RemoveUnderline

10390 | ApplyReverseVideo

@@ -145,8 +132,6 @@ diffStyles prev cur

145132 = mconcat

146133 [ styleDiff standout ApplyStandout RemoveStandout

147134 , styleDiff underline ApplyUnderline RemoveUnderline

148− , styleDiff italic ApplyItalic RemoveItalic

149− , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough

150135 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo

151136 , styleDiff blink ApplyBlink RemoveBlink

152137 , styleDiff dim ApplyDim RemoveDim

src/Graphics/Vty/Image.hs+8−17

@@ -1,4 +1,5 @@

2+{-# LANGUAGE BangPatterns #-}

23{-# LANGUAGE NamedFieldPuns #-}

34{-# LANGUAGE DisambiguateRecordFields #-}

45-- | A Vty program makes 'Picture's from 'Image's. This module provides

@@ -45,12 +46,8 @@ module Graphics.Vty.Image

4546 -- * Character width functions

4647 , safeWcwidth

4748 , safeWcswidth

48− , safeWctwidth

49− , safeWctlwidth

5049 , wcwidth

5150 , wcswidth

52− , wctwidth

53− , wctlwidth

5451 -- * Display Regions

5552 , DisplayText

5653 , DisplayRegion

@@ -116,18 +113,14 @@ horizCat = foldr horizJoin EmptyImage

116113vertCat :: [Image] -> Image

117114vertCat = foldr vertJoin EmptyImage

118115

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.

116+-- | Make an 'Image' from a lazy text value.

122117text :: Attr -> TL.Text -> Image

123−text a txt = let displayWidth = safeWctlwidth txt

118+text a txt = let displayWidth = safeWcswidth (TL.unpack txt)

124119 in HorizText a txt displayWidth (fromIntegral $! TL.length txt)

125120

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.

121+-- | Make an 'Image' from a text value.

129122text' :: Attr -> T.Text -> Image

130−text' a txt = let displayWidth = safeWctwidth txt

123+text' a txt = let displayWidth = safeWcswidth (T.unpack txt)

131124 in HorizText a (TL.fromStrict txt) displayWidth (T.length txt)

132125

133126-- | Make an image from a single character. This is a standard Haskell

@@ -137,11 +130,9 @@ char a c =

137130 let displayWidth = safeWcwidth c

138131 in HorizText a (TL.singleton c) displayWidth 1

139132

140−-- | Make an image from a string of characters laid out on a single

133+-- | Make an image from a string of characters layed out on a single

141134-- row with the same display attribute. The string is assumed to be a

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.

135+-- sequence of ISO-10646 characters.

145136--

146137-- Note: depending on how the Haskell compiler represents string

147138-- literals, a string literal in a UTF-8 encoded source file, for

@@ -175,7 +166,7 @@ utf8String a bytes = utf8Bytestring a (BL.pack bytes)

175166utf8Bytestring :: Attr -> BL.ByteString -> Image

176167utf8Bytestring a bs = text a (TL.decodeUtf8 bs)

177168

178−-- | Make an 'Image' from a UTF-8 encoded strict bytestring.

169+-- | Make an 'Image' from a UTF-8 encoded lazy bytestring.

179170utf8Bytestring' :: Attr -> B.ByteString -> Image

180171utf8Bytestring' a bs = text' a (T.decodeUtf8 bs)

181172

src/Graphics/Vty/Image/Internal.hs+32−16

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE NamedFieldPuns #-}

32{-# LANGUAGE DeriveGeneric #-}

43{-# OPTIONS_HADDOCK hide #-}

@@ -12,9 +11,6 @@ import GHC.Generics

1211

1312import Control.DeepSeq

1413

15−#if !(MIN_VERSION_base(4,11,0))

16−import Data.Semigroup (Semigroup(..))

17−#endif

1814import qualified Data.Text.Lazy as TL

1915

2016-- | A display text is a Data.Text.Lazy

@@ -142,11 +138,37 @@ data Image =

142138 --

143139 -- Any image of zero size equals the empty image.

144140 | EmptyImage

145− deriving (Eq, Generic, Show, Read)

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"

146168

147169-- | pretty print just the structure of an image.

148170ppImageStructure :: Image -> String

149−ppImageStructure = go 0

171+ppImageStructure inImg = go 0 inImg

150172 where

151173 go indent img = tab indent ++ pp indent img

152174 tab indent = concat $ replicate indent " "

@@ -210,16 +232,10 @@ imageHeight CropBottom { outputHeight = h } = h

210232imageHeight CropTop { outputHeight = h } = h

211233imageHeight EmptyImage = 0

212234

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

235+-- | Append in the Monoid instance is equivalent to '<->'.

218236instance Monoid Image where

219237 mempty = EmptyImage

220−#if !(MIN_VERSION_base(4,11,0))

221− mappend = (<>)

222−#endif

238+ mappend = vertJoin

223239

224240-- | combines two images side by side

225241--

@@ -228,7 +244,7 @@ instance Monoid Image where

228244--

229245-- The result image will have a width equal to the sum of the two images

230246-- width. And the height will equal the largest height of the two

231−-- images. The area not defined in one image due to a height mismatch

247+-- images. The area not defined in one image due to a height missmatch

232248-- will be filled with the background pattern.

233249horizJoin :: Image -> Image -> Image

234250horizJoin EmptyImage i = i

@@ -259,7 +275,7 @@ horizJoin _ _ = error "horizJoin applied to undefined values."

259275--

260276-- The result image will have a height equal to the sum of the heights

261277-- of both images. The width will equal the largest width of the two

262−-- images. The area not defined in one image due to a width mismatch

278+-- images. The area not defined in one image due to a width missmatch

263279-- will be filled with the background pattern.

264280vertJoin :: Image -> Image -> Image

265281vertJoin EmptyImage i = i

src/Graphics/Vty/Inline.hs+7−5

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

1+{-# LANGUAGE BangPatterns #-}

13-- | The inline module provides a limited interface to changing the

24-- style of terminal output. The intention is for this interface to be

35-- used inline with other output systems.

@@ -56,13 +58,13 @@ data InlineState =

5658-- | Set the background color to the provided 'Color'.

5759backColor :: Color -> InlineM ()

5860backColor c = modify $ \s ->

59− s { inlineAttr = inlineAttr s `withBackColor` c

61+ s { inlineAttr = inlineAttr s `mappend` (currentAttr `withBackColor` c)

6062 }

6163

6264-- | Set the foreground color to the provided 'Color'.

6365foreColor :: Color -> InlineM ()

6466foreColor c = modify $ \s ->

65− s { inlineAttr = inlineAttr s `withForeColor` c

67+ s { inlineAttr = inlineAttr s `mappend` (currentAttr `withForeColor` c)

6668 }

6769

6870-- | Attempt to change the 'Style' of the following text..

@@ -71,7 +73,7 @@ foreColor c = modify $ \s ->

7173-- produced. The style can still be removed.

7274applyStyle :: Style -> InlineM ()

7375applyStyle st = modify $ \s ->

74− s { inlineAttr = inlineAttr s `withStyle` st

76+ s { inlineAttr = inlineAttr s `mappend` (currentAttr `withStyle` st)

7577 }

7678

7779-- | Attempt to remove the specified 'Style' from the display of the

@@ -83,8 +85,8 @@ removeStyle :: Style -> InlineM ()

8385removeStyle sMask = modify $ \s ->

8486 s { inlineAttr =

8587 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+ Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

89+ KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

8890 SetTo st -> st .&. complement sMask

8991 in (inlineAttr s) { attrStyle = SetTo style' }

9092 }

src/Graphics/Vty/Input.hs+23−14

@@ -1,4 +1,4 @@

1−{-# LANGUAGE RecordWildCards, CPP #-}

1+{-# LANGUAGE RecordWildCards #-}

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 unambiguously. UTF-8 input is

80+-- * 7-bit mode: UTF-8 can be input unambiguiously. 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 fundamental issues. There is no easy way

98+-- Clearly terminal input has fundemental issues. There is no easy way

9999-- to reliably resolve these issues.

100100--

101101-- One resolution would be to ditch standard terminal interfaces

@@ -132,9 +132,7 @@ import Lens.Micro

132132import qualified System.Console.Terminfo as Terminfo

133133import System.Posix.Signals.Exts

134134

135−#if !MIN_VERSION_base(4,11,0)

136135import Data.Monoid ((<>))

137−#endif

138136

139137-- | Set up the terminal with file descriptor `inputFd` for input.

140138-- Returns an 'Input'.

@@ -143,8 +141,22 @@ import Data.Monoid ((<>))

143141-- bytes comes from 'classifyMapForTerm' which is then overridden by

144142-- the the applicable entries from the configuration's 'inputMap'.

145143--

146−-- The terminal device's mode flags are configured by the

147−-- 'attributeControl' function.

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)

148160inputForConfig :: Config -> IO Input

149161inputForConfig config@Config{ termName = Just termName

150162 , inputFd = Just termFd

@@ -154,23 +166,20 @@ inputForConfig config@Config{ termName = Just termName

154166 terminal <- Terminfo.setupTerm termName

155167 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]

156168 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides

157− (setAttrs, unsetAttrs) <- attributeControl termFd

169+ (setAttrs,unsetAttrs) <- attributeControl termFd

158170 setAttrs

159171 input <- initInput config activeInputMap

160172 let pokeIO = Catch $ do

173+ let e = error "vty internal failure: this value should not propagate to users"

161174 setAttrs

162− atomically $ writeTChan (input^.eventChannel) ResumeAfterSignal

175+ atomically $ writeTChan (input^.eventChannel) (EvResize e e)

163176 _ <- installHandler windowChange pokeIO Nothing

164177 _ <- installHandler continueProcess pokeIO Nothing

165−

166− let restore = unsetAttrs

167−

168178 return $ input

169179 { shutdownInput = do

170180 shutdownInput input

171181 _ <- installHandler windowChange Ignore Nothing

172182 _ <- installHandler continueProcess Ignore Nothing

173− restore

174− , restoreInputState = restoreInputState input >> restore

183+ unsetAttrs

175184 }

176185inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig

src/Graphics/Vty/Input/Classify.hs+29−53

@@ -1,11 +1,10 @@

11{-# OPTIONS_HADDOCK hide #-}

2−-- This makes a kind of trie. Has space efficiency issues with large

2+-- This makes a kind of tri. Has space efficiency issues with large

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(..)

98 )

109where

1110

@@ -17,39 +16,25 @@ import Graphics.Vty.Input.Classify.Types

1716

1817import Codec.Binary.UTF8.Generic (decode)

1918

20−import Control.Arrow (first)

19+import Data.List (inits)

2120import qualified Data.Map as M( fromList, lookup )

2221import Data.Maybe ( mapMaybe )

2322import qualified Data.Set as S( fromList, member )

2423

24+import Data.Char

2525import Data.Word

2626

27−import qualified Data.ByteString as BS

28−import qualified Data.ByteString.Char8 as BS8

29−import Data.ByteString.Char8 (ByteString)

30−

31−-- | Whether the classifier is currently processing a chunked format.

32−-- Currently, only bracketed pastes use this.

33−data ClassifierState

34− = ClassifierStart

35− -- ^ Not processing a chunked format.

36− | ClassifierInChunk ByteString [ByteString]

37− -- ^ Currently processing a chunked format. The initial chunk is in the

38− -- first argument and a reversed remainder of the chunks is collected in

39− -- the second argument. At the end of the processing, the chunks are

40− -- reversed and concatenated with the final chunk.

41−

42−compile :: ClassifyMap -> ByteString -> KClass

27+compile :: ClassifyMap -> [Char] -> KClass

4328compile table = cl' where

4429 -- take all prefixes and create a set of these

45− prefixSet = S.fromList $ concatMap (init . BS.inits . BS8.pack . fst) table

30+ prefixSet = S.fromList $ concatMap (init . inits . fst) $ table

4631 maxValidInputLength = maximum (map (length . fst) table)

47− eventForInput = M.fromList $ map (first BS8.pack) table

48− cl' inputBlock | BS8.null inputBlock = Prefix

32+ eventForInput = M.fromList table

33+ cl' [] = Prefix

4934 cl' inputBlock = case M.lookup inputBlock eventForInput of

5035 -- if the inputBlock is exactly what is expected for an

5136 -- event then consume the whole block and return the event

52− Just e -> Valid e BS8.empty

37+ Just e -> Valid e []

5338 Nothing -> case S.member inputBlock prefixSet of

5439 True -> Prefix

5540 -- look up progressively smaller tails of the input

@@ -60,49 +45,40 @@ compile table = cl' where

6045 -- H: There will always be one match. The prefixSet

6146 -- contains, by definition, all prefixes of an event.

6247 False ->

63− let inputPrefixes = reverse . take maxValidInputLength . tail . BS8.inits $ inputBlock

48+ let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock

6449 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of

65− (s,e) : _ -> Valid e (BS8.drop (BS8.length s) inputBlock)

50+ (s,e) : _ -> Valid e (drop (length s) inputBlock)

6651 -- neither a prefix or a full event.

6752 [] -> Invalid

6853

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 =

54+classify :: ClassifyMap -> [Char] -> KClass

55+classify table =

56+ let standardClassifier = compile table

57+ in \s -> case s of

58+ _ | bracketedPasteStarted s ->

8659 if bracketedPasteFinished s

87− then parseBracketedPaste $ BS.concat $ p:reverse (s:ps)

88− else Chunk

89− process ClassifierInChunk{} _ = Invalid

60+ then parseBracketedPaste s

61+ else Prefix

62+ _ | isMouseEvent s -> classifyMouseEvent s

63+ _ | isFocusEvent s -> classifyFocusEvent s

64+ c:cs | ord c >= 0xC2 -> classifyUtf8 c cs

65+ _ -> standardClassifier s

9066

91−classifyUtf8 :: Word8 -> ByteString -> KClass

67+classifyUtf8 :: Char -> [Char] -> KClass

9268classifyUtf8 c cs =

93− let n = utf8Length c

94− (codepoint,rest) = BS8.splitAt (n - 1) cs

69+ let n = utf8Length (ord c)

70+ (codepoint,rest) = splitAt n (c:cs)

9571

9672 codepoint8 :: [Word8]

97− codepoint8 = c:BS.unpack codepoint

73+ codepoint8 = map (fromIntegral . ord) codepoint

9874

9975 in case decode codepoint8 of

100− _ | n < BS.length codepoint + 1 -> Prefix

101− Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest

76+ _ | n < length codepoint -> Prefix

77+ Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest

10278 -- something bad happened; just ignore and continue.

103− Nothing -> Invalid

79+ Nothing -> Invalid

10480

105−utf8Length :: Word8 -> Int

81+utf8Length :: (Num t, Ord a, Num a) => a -> t

10682utf8Length c

10783 | c < 0x80 = 1

10884 | c < 0xE0 = 2

src/Graphics/Vty/Input/Classify/Parse.hs+7−10

@@ -16,15 +16,12 @@ import Graphics.Vty.Input.Classify.Types

1616import Control.Monad.Trans.Maybe

1717import Control.Monad.State

1818

19−import qualified Data.ByteString.Char8 as BS8

20−import Data.ByteString.Char8 (ByteString)

21−

22−type Parser a = MaybeT (State ByteString) a

19+type Parser a = MaybeT (State String) a

2320

2421-- | Run a parser on a given input string. If the parser fails, return

2522-- 'Invalid'. Otherwise return the valid event ('Valid') and the

2623-- remaining unparsed characters.

27−runParser :: ByteString -> Parser Event -> KClass

24+runParser :: String -> Parser Event -> KClass

2825runParser s parser =

2926 case runState (runMaybeT parser) s of

3027 (Nothing, _) -> Invalid

@@ -39,9 +36,9 @@ failParse = fail "invalid parse"

3936-- return '123' and consume those characters.

4037readInt :: Parser Int

4138readInt = do

42− s <- BS8.unpack <$> get

39+ s <- get

4340 case (reads :: ReadS Int) s of

44− [(i, rest)] -> put (BS8.pack rest) >> return i

41+ [(i, rest)] -> put rest >> return i

4542 _ -> failParse

4643

4744-- | Read a character from the input stream. If one cannot be read (e.g.

@@ -49,9 +46,9 @@ readInt = do

4946readChar :: Parser Char

5047readChar = do

5148 s <- get

52− case BS8.uncons s of

53− Just (c,rest) -> put rest >> return c

54− Nothing -> failParse

49+ case s of

50+ c:rest -> put rest >> return c

51+ _ -> failParse

5552

5653-- | Read a character from the input stream and fail parsing if it is

5754-- not the specified character.

src/Graphics/Vty/Input/Classify/Types.hs+1−7

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

11-- | This module exports the input classification type to avoid import

22-- cycles between other modules that need this.

3−{-# LANGUAGE StrictData #-}

43module Graphics.Vty.Input.Classify.Types

54 ( KClass(..)

65 )

@@ -8,10 +7,8 @@ where

98import Graphics.Vty.Input.Events

109

11−import Data.ByteString.Char8 (ByteString)

12−

1310data KClass

14− = Valid Event ByteString

11+ = Valid Event [Char]

1512 -- ^ A valid event was parsed. Any unused characters from the input

1613 -- stream are also provided.

1714 | Invalid

@@ -19,7 +16,4 @@ data KClass

1916 | Prefix

2017 -- ^ The input characters form the prefix of a valid event character

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

2519 deriving(Show, Eq)

src/Graphics/Vty/Input/Events.hs+6−24

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

11{-# Language DeriveGeneric #-}

2−{-# Language StrictData #-}

32module Graphics.Vty.Input.Events where

5−import Control.DeepSeq

64import Data.ByteString

75import GHC.Generics

@@ -16,29 +14,23 @@ import GHC.Generics

1614--

1715-- * Actually, support for most of these but KEsc, KChar, KBS, and

1816-- KEnter vary by terminal and keyboard.

19−data Key = KEsc | KChar {-# UNPACK #-} Char | KBS | KEnter

17+data Key = KEsc | KChar Char | KBS | KEnter

2018 | KLeft | KRight | KUp | KDown

22− | KFun {-# UNPACK #-} Int | KBackTab | KPrtScr | KPause | KIns

2422 deriving (Eq,Show,Read,Ord,Generic)

2523

26−instance NFData Key

27−

2824-- | Modifier keys. Key codes are interpreted such that users are more

2925-- likely to have Meta than Alt; for instance on the PC Linux console,

3026-- 'MMeta' will generally correspond to the physical Alt key.

3127data Modifier = MShift | MCtrl | MMeta | MAlt

3228 deriving (Eq,Show,Read,Ord,Generic)

3329

34−instance NFData Modifier

35−

3630-- | Mouse buttons.

3731data Button = BLeft | BMiddle | BRight | BScrollUp | BScrollDown

3832 deriving (Eq,Show,Read,Ord,Generic)

3933

40−instance NFData Button

41−

4234-- | Events.

4335data Event

4436 = EvKey Key [Modifier]

@@ -52,8 +44,10 @@ data Event

5244 -- without specifying which one; in that case, Nothing is provided.

5345 -- Otherwise Just the button released is included in the event.

5446 | EvResize Int Int

55− -- The terminal window was resized and the size is provided in the

56− -- integer fields (width, height).

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.

5751 | EvPaste ByteString

5852 -- ^ A paste event occurs when a bracketed paste input sequence is

5953 -- received. For terminals that support bracketed paste mode, these

@@ -68,16 +62,4 @@ data Event

6862 -- ^ The terminal running the application gained input focus.

6963 deriving (Eq,Show,Read,Ord,Generic)

7064

71−instance NFData Event

72−

7365type ClassifyMap = [(String,Event)]

74−

75−-- | The type of internal events that drive the internal Vty event

76−-- dispatching to the application.

77−data InternalEvent =

78− ResumeAfterSignal

79− -- ^ Vty resumed operation after the process was interrupted with a

80− -- signal. In practice this translates into a screen redraw in the

81− -- input event loop.

82− | InputEvent Event

83− -- ^ An input event was received.

src/Graphics/Vty/Input/Focus.hs+13−15

@@ -11,32 +11,30 @@ import Graphics.Vty.Input.Classify.Types

1111import Graphics.Vty.Input.Classify.Parse

1212

1313import Control.Monad.State

14−

15−import qualified Data.ByteString.Char8 as BS8

16−import Data.ByteString.Char8 (ByteString)

14+import Data.List (isPrefixOf)

1715

1816-- | These sequences set xterm-based terminals to send focus event

1917-- sequences.

20−requestFocusEvents :: ByteString

21−requestFocusEvents = BS8.pack "\ESC[?1004h"

18+requestFocusEvents :: String

19+requestFocusEvents = "\ESC[?1004h"

2220

2321-- | These sequences disable focus events.

24−disableFocusEvents :: ByteString

25−disableFocusEvents = BS8.pack "\ESC[?1004l"

22+disableFocusEvents :: String

23+disableFocusEvents = "\ESC[?1004l"

2624

2725-- | 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

26+isFocusEvent :: String -> Bool

27+isFocusEvent s = isPrefixOf focusIn s ||

28+ isPrefixOf focusOut s

3129

32−focusIn :: ByteString

33−focusIn = BS8.pack "\ESC[I"

30+focusIn :: String

31+focusIn = "\ESC[I"

3432

35−focusOut :: ByteString

36−focusOut = BS8.pack "\ESC[O"

33+focusOut :: String

34+focusOut = "\ESC[O"

3735

3836-- | Attempt to classify an input string as a focus event.

39−classifyFocusEvent :: ByteString -> KClass

37+classifyFocusEvent :: String -> KClass

4038classifyFocusEvent s = runParser s $ do

4139 when (not $ isFocusEvent s) failParse

4240

src/Graphics/Vty/Input/Loop.hs+30−87

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

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE NoMonomorphismRestriction #-}

31{-# LANGUAGE RecordWildCards #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

5−{-# LANGUAGE TemplateHaskell #-}

62{-# OPTIONS_HADDOCK hide #-}

3+{-# LANGUAGE NoMonomorphismRestriction #-}

4+{-# LANGUAGE TemplateHaskell #-}

5+{-# LANGUAGE CPP #-}

76-- | The input layer used to be a single function that correctly

87-- accounted for the non-threaded runtime by emulating the terminal

98-- VMIN adn VTIME handling. This has been removed and replace with a

@@ -25,7 +24,7 @@ import Control.Applicative

2524import Control.Concurrent

2625import Control.Concurrent.STM

2726import Control.Exception (mask, try, SomeException)

28−import Lens.Micro hiding ((<>~))

27+import Lens.Micro

2928import Lens.Micro.Mtl

3029import Lens.Micro.TH

3130import Control.Monad (when, mzero, forM_)

@@ -34,15 +33,12 @@ import Control.Monad.Trans.State (StateT(..), evalStateT)

3433import Control.Monad.State.Class (MonadState, modify)

3534import Control.Monad.Trans.Reader (ReaderT(..))

3635

37−import qualified Data.ByteString.Char8 as BS8

38−import qualified Data.ByteString as BS

39−import Data.ByteString.Char8 (ByteString)

36+import Data.Char

4037import Data.IORef

4138import Data.Word (Word8)

4239

43−import Foreign (allocaArray)

40+import Foreign ( allocaArray, peekArray, Ptr )

4441import Foreign.C.Types (CInt(..))

45−import Foreign.Ptr (Ptr, castPtr)

4642

4743import System.IO

4844import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))

@@ -55,15 +51,10 @@ data Input = Input

5551 { -- | Channel of events direct from input processing. Unlike

5652 -- 'nextEvent' this will not refresh the display if the next event

5753 -- is an 'EvResize'.

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.

54+ _eventChannel :: TChan Event

55+ -- | Shuts down the input processing. This should return the

56+ -- terminal input state to before he input initialized.

6157 , 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 ()

6758 -- | Changes to this value are reflected after the next event.

6859 , _configRef :: IORef Config

6960 -- | input debug log

@@ -80,11 +71,10 @@ data InputBuffer = InputBuffer

8071makeLenses ''InputBuffer

8172

8273data InputState = InputState

83− { _unprocessedBytes :: ByteString

84− , _classifierState :: ClassifierState

74+ { _unprocessedBytes :: String

8575 , _appliedConfig :: Config

8676 , _inputBuffer :: InputBuffer

87− , _classifier :: ClassifierState -> ByteString -> KClass

77+ , _classifier :: String -> KClass

8878 }

8979

9080makeLenses ''InputState

@@ -109,20 +99,20 @@ loopInputProcessor = do

10999 dropInvalid

110100 loopInputProcessor

111101

112−addBytesToProcess :: ByteString -> InputM ()

102+addBytesToProcess :: String -> InputM ()

113103addBytesToProcess block = unprocessedBytes <>= block

114104

115105emit :: Event -> InputM ()

116106emit event = do

117107 logMsg $ "parsed event: " ++ show event

118− view eventChannel >>= liftIO . atomically . flip writeTChan (InputEvent event)

108+ view eventChannel >>= liftIO . atomically . flip writeTChan event

119109

120110-- The timing requirements are assured by the VMIN and VTIME set for the

121111-- device.

122112--

123113-- Precondition: Under the threaded runtime. Only current use is from a

124114-- forkOS thread. That case satisfies precondition.

125−readFromDevice :: InputM ByteString

115+readFromDevice :: InputM String

126116readFromDevice = do

127117 newConfig <- view configRef >>= liftIO . readIORef

128118 oldConfig <- use appliedConfig

@@ -142,10 +132,9 @@ readFromDevice = do

142132 threadWaitRead fd

143133 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)

144134 if bytesRead > 0

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)

135+ then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr

136+ else return []

137+ when (not $ null stringRep) $ logMsg $ "input bytes: " ++ show stringRep

149138 return stringRep

150139

151140applyConfig :: Fd -> Config -> IO ()

@@ -156,86 +145,41 @@ applyConfig _ _ = fail "(vty) applyConfig was not provided a complete configurat

156145parseEvent :: InputM Event

157146parseEvent = do

158147 c <- use classifier

159− s <- use classifierState

160148 b <- use unprocessedBytes

161− case c s b of

149+ case c b of

162150 Valid e remaining -> do

163151 logMsg $ "valid parse: " ++ show e

164152 logMsg $ "remaining: " ++ show remaining

165− classifierState .= ClassifierStart

166153 unprocessedBytes .= remaining

167154 return e

168− _ -> mzero

155+ _ -> mzero

169156

170157dropInvalid :: InputM ()

171158dropInvalid = do

172159 c <- use classifier

173− s <- use classifierState

174160 b <- use unprocessedBytes

175− case c s b of

176− Chunk -> do

177− classifierState .=

178− case s of

179− ClassifierStart -> ClassifierInChunk b []

180− ClassifierInChunk p bs -> ClassifierInChunk p (b:bs)

181− unprocessedBytes .= BS8.empty

182− Invalid -> do

183− logMsg "dropping input bytes"

184− classifierState .= ClassifierStart

185− unprocessedBytes .= BS8.empty

186− _ -> return ()

161+ when (c b == Invalid) $ do

162+ logMsg "dropping input bytes"

163+ unprocessedBytes .= []

187164

188165runInputProcessorLoop :: ClassifyMap -> Input -> IO ()

189166runInputProcessorLoop classifyTable input = do

190167 let bufferSize = 1024

191168 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do

192− s0 <- InputState BS8.empty ClassifierStart

193− <$> readIORef (_configRef input)

194− <*> pure (InputBuffer bufferPtr bufferSize)

195− <*> pure (classify classifyTable)

169+ s0 <- InputState [] <$> readIORef (_configRef input)

170+ <*> pure (InputBuffer bufferPtr bufferSize)

171+ <*> pure (classify classifyTable)

196172 runReaderT (evalStateT loopInputProcessor s0) input

197173

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)

223174attributeControl :: Fd -> IO (IO (), IO ())

224175attributeControl fd = do

225176 original <- getTerminalAttributes fd

226− let vtyMode = foldl withMode clearedFlags flagsToSet

227− clearedFlags = foldl withoutMode original flagsToUnset

228− flagsToSet = [ MapCRtoLF -- ICRNL

229− ]

230− flagsToUnset = [ StartStopOutput -- IXON

231− , KeyboardInterrupts -- ISIG

232− , EnableEcho -- ECHO

233− , ProcessInput -- ICANON

234− , ExtendedFunctions -- IEXTEN

235− ]

177+ let vtyMode = foldl withoutMode original [ StartStopOutput, KeyboardInterrupts

178+ , EnableEcho, ProcessInput, ExtendedFunctions

179+ ]

236180 let setAttrs = setTerminalAttributes fd vtyMode Immediately

237181 unsetAttrs = setTerminalAttributes fd original Immediately

238− return (setAttrs, unsetAttrs)

182+ return (setAttrs,unsetAttrs)

239183

240184logInitialInputState :: Input -> ClassifyMap -> IO()

241185logInitialInputState input classifyTable = case _inputDebug input of

@@ -243,7 +187,7 @@ logInitialInputState input classifyTable = case _inputDebug input of

243187 Just h -> do

244188 Config{ vmin = Just theVmin

245189 , vtime = Just theVtime

246− , termName = Just theTerm } <- readIORef $ _configRef input

190+ , termName = Just theTerm, .. } <- readIORef $ _configRef input

247191 _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))

248192 forM_ classifyTable $ \i -> case i of

249193 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)

@@ -259,7 +203,6 @@ initInput config classifyTable = do

259203 applyConfig fd config

260204 stopSync <- newEmptyMVar

261205 input <- Input <$> atomically newTChan

262− <*> pure (return ())

263206 <*> pure (return ())

264207 <*> newIORef config

265208 <*> maybe (return Nothing)

src/Graphics/Vty/Input/Mouse.hs+17−19

@@ -15,12 +15,10 @@ import Graphics.Vty.Input.Classify.Types

1515import Graphics.Vty.Input.Classify.Parse

1616

1717import Control.Monad.State

18+import Data.List (isPrefixOf)

1819import Data.Maybe (catMaybes)

1920import Data.Bits ((.&.))

2021

21−import qualified Data.ByteString.Char8 as BS8

22−import Data.ByteString.Char8 (ByteString)

23−

2422-- A mouse event in SGR extended mode is

2523--

2624-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')

@@ -34,28 +32,28 @@ import Data.ByteString.Char8 (ByteString)

3432

3533-- | These sequences set xterm-based terminals to send mouse event

3634-- sequences.

37−requestMouseEvents :: ByteString

38−requestMouseEvents = BS8.pack "\ESC[?1000h\ESC[?1002h\ESC[?1006h"

35+requestMouseEvents :: String

36+requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h"

3937

4038-- | These sequences disable mouse events.

41−disableMouseEvents :: ByteString

42−disableMouseEvents = BS8.pack "\ESC[?1000l\ESC[?1002l\ESC[?1006l"

39+disableMouseEvents :: String

40+disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l"

4341

4442-- | Does the specified string begin with a mouse event?

45−isMouseEvent :: ByteString -> Bool

43+isMouseEvent :: String -> Bool

4644isMouseEvent s = isSGREvent s || isNormalEvent s

4745

48−isSGREvent :: ByteString -> Bool

49−isSGREvent = BS8.isPrefixOf sgrPrefix

46+isSGREvent :: String -> Bool

47+isSGREvent = isPrefixOf sgrPrefix

5048

51−sgrPrefix :: ByteString

52−sgrPrefix = BS8.pack "\ESC[M"

49+sgrPrefix :: String

50+sgrPrefix = "\ESC[M"

5351

54−isNormalEvent :: ByteString -> Bool

55−isNormalEvent = BS8.isPrefixOf normalPrefix

52+isNormalEvent :: String -> Bool

53+isNormalEvent = isPrefixOf normalPrefix

5654

57−normalPrefix :: ByteString

58−normalPrefix = BS8.pack "\ESC[<"

55+normalPrefix :: String

56+normalPrefix = "\ESC[<"

5957

6058-- Modifier bits:

6159shiftBit :: Int

@@ -89,8 +87,8 @@ scrollDown = 65

8987hasBitSet :: Int -> Int -> Bool

9088hasBitSet val bit = val .&. bit > 0

9189

92−-- | Attempt to classify an input string as a mouse event.

93−classifyMouseEvent :: ByteString -> KClass

90+-- | Attempt to lassify an input string as a mouse event.

91+classifyMouseEvent :: String -> KClass

9492classifyMouseEvent s = runParser s $ do

9593 when (not $ isMouseEvent s) failParse

9694

@@ -102,7 +100,7 @@ classifyMouseEvent s = runParser s $ do

102100 'M' -> classifyNormalMouseEvent

103101 _ -> failParse

104102

105−-- Given a modifier/button value, determine which button was indicated

103+-- Given a modifer/button value, determine which button was indicated

106104getSGRButton :: Int -> Parser Button

107105getSGRButton mods =

108106 let buttonMap = [ (leftButton, BLeft)

src/Graphics/Vty/Input/Paste.hs+24−16

@@ -9,33 +9,41 @@ module Graphics.Vty.Input.Paste

99where

1010

1111import qualified Data.ByteString.Char8 as BS8

12−import Data.ByteString.Char8 (ByteString)

1312

1413import Graphics.Vty.Input.Events

1514import Graphics.Vty.Input.Classify.Types

1615

17−bracketedPasteStart :: ByteString

18−bracketedPasteStart = BS8.pack "\ESC[200~"

16+import Data.List (isPrefixOf, isInfixOf)

1917

20−bracketedPasteEnd :: ByteString

21−bracketedPasteEnd = BS8.pack "\ESC[201~"

18+bracketedPasteStart :: String

19+bracketedPasteStart = "\ESC[200~"

20+

21+bracketedPasteEnd :: String

22+bracketedPasteEnd = "\ESC[201~"

2223

2324-- | Does the input start a bracketed paste?

24−bracketedPasteStarted :: ByteString -> Bool

25−bracketedPasteStarted = BS8.isPrefixOf bracketedPasteStart

25+bracketedPasteStarted :: String -> Bool

26+bracketedPasteStarted = isPrefixOf bracketedPasteStart

2627

2728-- | Does the input contain a complete bracketed paste?

28−bracketedPasteFinished :: ByteString -> Bool

29−bracketedPasteFinished = BS8.isInfixOf bracketedPasteEnd

29+bracketedPasteFinished :: String -> Bool

30+bracketedPasteFinished = isInfixOf bracketedPasteEnd

3031

3132-- | Parse a bracketed paste. This should only be called on a string if

3233-- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return

3334-- 'True'.

34−parseBracketedPaste :: ByteString -> KClass

35+parseBracketedPaste :: String -> KClass

3536parseBracketedPaste s =

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

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)

src/Graphics/Vty/Input/Terminfo.hs+4−6

@@ -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,12 +86,10 @@ 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− [ ("\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])

89+ [ -- special support for ESC

90+ ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

9391 -- Special support for backspace

94− , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta]), ("\b",EvKey KBS [])

92+ , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])

9593 -- Special support for Enter

9694 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])

9795 -- 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-head nrs+ff) m) | n <- nrs ] in

62+ let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in

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

@@ -1,4 +1,5 @@

1−{-# LANGUAGE RecordWildCards, CPP #-}

1+{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE NamedFieldPuns #-}

23-- | This module provides functions for accessing the current terminal

34-- or a specific terminal device.

45--

@@ -37,11 +38,10 @@ import Graphics.Vty.Output.TerminfoBased as TerminfoBased

3738

3839import Blaze.ByteString.Builder (writeToByteString)

3940

40−import Data.List (isPrefixOf)

41+import Control.Monad.Trans

4142

42−#if !MIN_VERSION_base(4,11,0)

43+import Data.List (isPrefixOf)

4344import Data.Monoid ((<>))

44−#endif

4545

4646-- | Returns an `Output` for the terminal specified in `Config`.

4747--

@@ -58,12 +58,11 @@ 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

62− , colorMode = Just colorMode, .. } = do

61+outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do

6362 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName

64− then XTermColor.reserveTerminal termName fd colorMode

63+ then XTermColor.reserveTerminal termName fd

6564 -- Not an xterm-like terminal. try for generic terminfo.

66− else TerminfoBased.reserveTerminal termName fd colorMode

65+ else TerminfoBased.reserveTerminal termName fd

6766

6867 case mouseMode of

6968 Just s -> setMode t Mouse s

@@ -78,30 +77,30 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig

7877

7978-- | Sets the cursor position to the given output column and row.

8079--

81−-- This is not necessarily the same as the character position with the

80+-- This is not necessarially the same as the character position with the

8281-- same coordinates. Characters can be a variable number of columns in

8382-- width.

8483--

8584-- Currently, the only way to set the cursor position to a given

8685-- character coordinate is to specify the coordinate in the Picture

8786-- instance provided to 'outputPicture' or 'refresh'.

88−setCursorPos :: Output -> Int -> Int -> IO ()

87+setCursorPos :: MonadIO m => Output -> Int -> Int -> m ()

8988setCursorPos t x y = do

9089 bounds <- displayBounds t

9190 when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do

9291 dc <- displayContext t bounds

93− outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

92+ liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

9493

9594-- | Hides the cursor.

96−hideCursor :: Output -> IO ()

95+hideCursor :: MonadIO m => Output -> m ()

9796hideCursor t = do

9897 bounds <- displayBounds t

9998 dc <- displayContext t bounds

100− outputByteBuffer t $ writeToByteString $ writeHideCursor dc

99+ liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc

101100

102101-- | Shows the cursor.

103−showCursor :: Output -> IO ()

102+showCursor :: MonadIO m => Output -> m ()

104103showCursor t = do

105104 bounds <- displayBounds t

106105 dc <- displayContext t bounds

107− outputByteBuffer t $ writeToByteString $ writeShowCursor dc

106+ liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc

src/Graphics/Vty/Output/Interface.hs+36−62

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

11-- Copyright Corey O'Connor

2+{-# LANGUAGE BangPatterns #-}

23{-# LANGUAGE RankNTypes #-}

34{-# LANGUAGE ExistentialQuantification #-}

45{-# LANGUAGE GADTs #-}

56{-# 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,6 +29,8 @@ import Graphics.Vty.DisplayAttributes

2929import Blaze.ByteString.Builder (Write, writeToByteString)

3030import Blaze.ByteString.Builder.ByteString (writeByteString)

3131

32+import Control.Monad.Trans

33+

3234import qualified Data.ByteString as BS

3335import Data.IORef

3436import qualified Data.Text.Encoding as T

@@ -59,7 +61,7 @@ data Output = Output

5961 terminalID :: String

6062 -- | Release the terminal just prior to application exit and reset

6163 -- it to its state prior to application startup.

62− , releaseTerminal :: IO ()

64+ , releaseTerminal :: forall m. MonadIO m => m ()

6365 -- | Clear the display and initialize the terminal to some initial

6466 -- display state.

6567 --

@@ -69,57 +71,40 @@ data Output = Output

6971 -- - cursor at top left

7072 -- - UTF-8 character encoding

7173 -- - drawing characteristics are the default

72− , reserveDisplay :: IO ()

74+ , reserveDisplay :: forall m. MonadIO m => m ()

7375 -- | Return the display to the state before `reserveDisplay` If no

7476 -- previous state then set the display state to the initial state.

75− , releaseDisplay :: IO ()

76− -- | Sets the current display bounds (width, height).

77− , setDisplayBounds :: (Int, Int) -> IO ()

77+ , releaseDisplay :: forall m. MonadIO m => m ()

7878 -- | Returns the current display bounds.

79− , displayBounds :: IO DisplayRegion

79+ , displayBounds :: forall m. MonadIO m => m DisplayRegion

8080 -- | Output the bytestring to the terminal device.

8181 , outputByteBuffer :: BS.ByteString -> IO ()

82+ -- | Specifies the maximum number of colors supported by the

83+ -- context.

84+ , contextColorCount :: Int

8285 -- | Specifies whether the cursor can be shown / hidden.

8386 , supportsCursorVisibility :: Bool

8487 -- | Indicates support for terminal modes for this output device.

8588 , supportsMode :: Mode -> Bool

8689 -- | Enables or disables a mode (does nothing if the mode is

8790 -- unsupported).

88− , setMode :: Mode -> Bool -> IO ()

91+ , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()

8992 -- | Returns whether a mode is enabled.

90− , getModeStatus :: Mode -> IO Bool

93+ , getModeStatus :: forall m. MonadIO m => Mode -> m Bool

9194 , assumedStateRef :: IORef AssumedState

9295 -- | Acquire display access to the given region of the display.

9396 -- Currently all regions have the upper left corner of (0,0) and

9497 -- the lower right corner at (max displayWidth providedWidth, max

9598 -- displayHeight providedHeight)

96− , mkDisplayContext :: Output -> DisplayRegion -> IO DisplayContext

99+ , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext

97100 -- | Ring the terminal bell if supported.

98− , ringTerminalBell :: IO ()

101+ , ringTerminalBell :: forall m. MonadIO m => m ()

99102 -- | Returns whether the terminal has an audio bell feature.

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

103+ , supportsBell :: forall m. MonadIO m => m Bool

119104 }

120105

121−displayContext :: Output -> DisplayRegion -> IO DisplayContext

122−displayContext t = mkDisplayContext t t

106+displayContext :: MonadIO m => Output -> DisplayRegion -> m DisplayContext

107+displayContext t = liftIO . mkDisplayContext t t

123108

124109data AssumedState = AssumedState

125110 { prevFattr :: Maybe FixedAttr

@@ -178,8 +163,8 @@ writeUtf8Text = writeByteString

178163-- 4. Serialized to the display.

179164--

180165-- 5. The cursor is then shown and positioned or kept hidden.

181−outputPicture :: DisplayContext -> Picture -> IO ()

182−outputPicture dc pic = do

166+outputPicture :: MonadIO m => DisplayContext -> Picture -> m ()

167+outputPicture dc pic = liftIO $ do

183168 urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink

184169 as <- readIORef (assumedStateRef $ contextDevice dc)

185170 let manipCursor = supportsCursorVisibility (contextDevice dc)

@@ -192,7 +177,8 @@ outputPicture dc pic = do

192177 Nothing -> replicate (fromEnum $ regionHeight $ affectedRegion ops) True

193178 Just previousOps -> if affectedRegion previousOps /= affectedRegion ops

194179 then replicate (displayOpsRows ops) True

195− else Vector.toList $ Vector.zipWith (/=) previousOps ops

180+ else zipWith (/=) (Vector.toList previousOps)

181+ (Vector.toList ops)

196182 -- build the Write corresponding to the output image

197183 out = (if manipCursor then writeHideCursor dc else mempty)

198184 `mappend` writeOutputOps urlsEnabled dc initialAttr diffs ops

@@ -206,15 +192,9 @@ outputPicture dc pic = do

206192 AbsoluteCursor x y ->

207193 writeShowCursor dc `mappend`

208194 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)

215195 Cursor x y ->

216196 let m = cursorOutputMap ops $ picCursor pic

217− (ox, oy) = charToOutputPos m (clampX x, clampY y)

197+ (ox, oy) = charToOutputPos m (x,y)

218198 in writeShowCursor dc `mappend`

219199 writeMoveCursor dc (clampX ox) (clampY oy)

220200 )

@@ -309,23 +289,17 @@ limitAttrForDisplay t attr

309289 where

310290 clampColor Default = Default

311291 clampColor KeepCurrent = KeepCurrent

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

292+ clampColor (SetTo c) = clampColor' c

293+ clampColor' (ISOColor v)

294+ | contextColorCount t < 8 = Default

295+ | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8)

296+ | otherwise = SetTo $ ISOColor v

297+ clampColor' (Color240 v)

298+ -- Should we choose closest ISO color?

299+ | contextColorCount t < 8 = Default

300+ | contextColorCount t < 16 = Default

301+ | contextColorCount t <= 256 = SetTo $ Color240 v

302+ | otherwise

303+ = let p :: Double = fromIntegral v / 240.0

304+ v' = floor $ p * (fromIntegral $ contextColorCount t)

305+ in SetTo $ Color240 v'

src/Graphics/Vty/Output/Mock.hs+2−6

@@ -11,7 +11,6 @@ module Graphics.Vty.Output.Mock

1111where

1212

1313import Graphics.Vty.Image (DisplayRegion)

14−import Graphics.Vty.Attributes.Color (ColorMode(ColorMode16))

1514import Graphics.Vty.Output.Interface

1615

1716import Blaze.ByteString.Builder.Word (writeWord8)

@@ -31,7 +30,7 @@ type MockData = IORef (UTF8.UTF8 BS.ByteString)

3130-- without considering terminal specific issues.

3231--

3332-- The mock implementation is useful in manually determining if the

34−-- sequence of terminal operations matches the expected sequence. The

33+-- sequence of terminal operations matche the expected sequence. The

3534-- requirement of the produced representation is simplicity in parsing

3635-- the text representation and determining how the picture was mapped to

3736-- terminal operations.

@@ -49,19 +48,16 @@ mockTerminal r = liftIO $ do

4948 , releaseDisplay = return ()

5049 , ringTerminalBell = return ()

5150 , supportsBell = return False

52− , supportsItalics = return False

53− , supportsStrikethrough = return False

54− , setDisplayBounds = const $ return ()

5551 , displayBounds = return r

5652 , outputByteBuffer = \bytes -> do

5753 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"

5854 writeIORef outRef $ UTF8.fromRep bytes

55+ , contextColorCount = 16

5956 , supportsCursorVisibility = True

6057 , supportsMode = const False

6158 , setMode = const $ const $ return ()

6259 , getModeStatus = const $ return False

6360 , assumedStateRef = newAssumedStateRef

64− , outputColorMode = ColorMode16

6561 , mkDisplayContext = \tActual rActual -> return $ DisplayContext

6662 { contextRegion = rActual

6763 , contextDevice = tActual

src/Graphics/Vty/Output/TerminfoBased.hs+59−147

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

1+{-# LANGUAGE RecordWildCards #-}

12{-# LANGUAGE FlexibleInstances #-}

23{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE CPP #-}

44{-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-}

55{-# CFILES gwinsz.c #-}

@@ -9,12 +9,10 @@

99-- Copyright Corey O'Connor (coreyoconnor@gmail.com)

1010module Graphics.Vty.Output.TerminfoBased

1111 ( reserveTerminal

12− , setWindowSize

1312 )

1413where

1514

1615import Control.Monad (when)

17−import Data.Bits (shiftL, (.&.))

1816import qualified Data.ByteString as BS

1917import Data.ByteString.Internal (toForeignPtr)

2018import Data.Terminfo.Parse

@@ -25,16 +23,16 @@ import Graphics.Vty.Image (DisplayRegion)

2523import Graphics.Vty.DisplayAttributes

2624import Graphics.Vty.Output.Interface

2725

28−import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable, writeWord8)

26+import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable)

2927

28+import Control.Monad.Trans

29+

30+import Data.Bits ((.&.))

31+import Data.Foldable (foldMap)

3032import Data.IORef

3133import Data.Maybe (isJust, isNothing, fromJust)

3234import Data.Word

3335

34−#if !MIN_VERSION_base(4,8,0)

35−import Data.Foldable (foldMap)

36−#endif

37−

3836import Foreign.C.Types ( CInt(..), CLong(..) )

3937import Foreign.ForeignPtr (withForeignPtr)

4038import Foreign.Ptr (Ptr, plusPtr)

@@ -49,6 +47,7 @@ data TerminfoCaps = TerminfoCaps

4947 , cup :: CapExpression

5048 , cnorm :: Maybe CapExpression

5149 , civis :: Maybe CapExpression

50+ , supportsNoColors :: Bool

5251 , useAltColorMap :: Bool

5352 , setForeColor :: CapExpression

5453 , setBackColor :: CapExpression

@@ -63,10 +62,6 @@ data DisplayAttrCaps = DisplayAttrCaps

6362 { setAttrStates :: Maybe CapExpression

6463 , enterStandout :: Maybe CapExpression

6564 , exitStandout :: Maybe CapExpression

66− , enterItalic :: Maybe CapExpression

67− , exitItalic :: Maybe CapExpression

68− , enterStrikethrough :: Maybe CapExpression

69− , exitStrikethrough :: Maybe CapExpression

7065 , enterUnderline :: Maybe CapExpression

7166 , exitUnderline :: Maybe CapExpression

7267 , enterReverseVideo :: Maybe CapExpression

@@ -103,28 +98,28 @@ sendCapToTerminal t cap capParams = do

10398--

10499-- * Providing independent string capabilities for all display

105100-- attributes.

106−reserveTerminal :: String -> Fd -> ColorMode -> IO Output

107−reserveTerminal termName outFd colorMode = do

101+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

102+reserveTerminal termName outFd = liftIO $ do

108103 ti <- Terminfo.setupTerm termName

109104 -- assumes set foreground always implies set background exists.

110105 -- if set foreground is not set then all color changing style

111106 -- attributes are filtered.

112107 msetaf <- probeCap ti "setaf"

113108 msetf <- probeCap ti "setf"

114− let (useAlt, setForeCap)

109+ let (noColors, useAlt, setForeCap)

115110 = case msetaf of

116− Just setaf -> (False, setaf)

111+ Just setaf -> (False, False, setaf)

117112 Nothing -> case msetf of

118− Just setf -> (True, setf)

119− Nothing -> (True, error $ "no fore color support for terminal " ++ termName)

113+ Just setf -> (False, True, setf)

114+ Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName)

120115 msetab <- probeCap ti "setab"

121116 msetb <- probeCap ti "setb"

122− let setBackCap

117+ let set_back_cap

123118 = case msetab of

124− Just setab -> setab

125119 Nothing -> case msetb of

126120 Just setb -> setb

127121 Nothing -> error $ "no back color support for terminal " ++ termName

122+ Just setab -> setab

128123

129124 hyperlinkModeStatus <- newIORef False

130125 newAssumedStateRef <- newIORef initialAssumedState

@@ -133,13 +128,13 @@ reserveTerminal termName outFd colorMode = do

133128 curStatus <- terminfoModeStatus m

134129 when (newStatus /= curStatus) $

135130 case m of

136− Hyperlink -> do

131+ Hyperlink -> liftIO $ do

137132 writeIORef hyperlinkModeStatus newStatus

138133 writeIORef newAssumedStateRef initialAssumedState

139134 _ -> return ()

140135 terminfoModeStatus m =

141136 case m of

142− Hyperlink -> readIORef hyperlinkModeStatus

137+ Hyperlink -> liftIO $ readIORef hyperlinkModeStatus

143138 _ -> return False

144139 terminfoModeSupported Hyperlink = True

145140 terminfoModeSupported _ = False

@@ -150,9 +145,10 @@ reserveTerminal termName outFd colorMode = do

150145 <*> requireCap ti "cup"

151146 <*> probeCap ti "cnorm"

152147 <*> probeCap ti "civis"

148+ <*> pure noColors

153149 <*> pure useAlt

154150 <*> pure setForeCap

155− <*> pure setBackCap

151+ <*> pure set_back_cap

156152 <*> requireCap ti "sgr0"

157153 <*> requireCap ti "clear"

158154 <*> requireCap ti "el"

@@ -160,28 +156,22 @@ reserveTerminal termName outFd colorMode = do

160156 <*> probeCap ti "bel"

161157 let t = Output

162158 { terminalID = termName

163− , releaseTerminal = do

159+ , releaseTerminal = liftIO $ do

164160 sendCap setDefaultAttr []

165161 maybeSendCap cnorm []

166162 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps

167− , supportsItalics = return $ (isJust $ enterItalic (displayAttrCaps terminfoCaps)) &&

168− (isJust $ exitItalic (displayAttrCaps terminfoCaps))

169− , supportsStrikethrough = return $ (isJust $ enterStrikethrough (displayAttrCaps terminfoCaps)) &&

170− (isJust $ exitStrikethrough (displayAttrCaps terminfoCaps))

171− , ringTerminalBell = maybeSendCap ringBellAudio []

172− , reserveDisplay = do

163+ , ringTerminalBell = liftIO $ maybeSendCap ringBellAudio []

164+ , reserveDisplay = liftIO $ do

173165 -- If there is no support for smcup: Clear the screen

174166 -- and then move the mouse to the home position to

175167 -- approximate the behavior.

176168 maybeSendCap smcup []

177169 sendCap clearScreen []

178− , releaseDisplay = do

170+ , releaseDisplay = liftIO $ do

179171 maybeSendCap rmcup []

180172 maybeSendCap cnorm []

181− , setDisplayBounds = \(w, h) ->

182− setWindowSize outFd (w, h)

183173 , displayBounds = do

184− rawSize <- getWindowSize outFd

174+ rawSize <- liftIO $ getWindowSize outFd

185175 case rawSize of

186176 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize

187177 | otherwise -> return (w,h)

@@ -192,48 +182,51 @@ reserveTerminal termName outFd colorMode = do

192182 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "

193183 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen

194184 ++ " Please report this bug to vty project."

185+ , contextColorCount

186+ = case supportsNoColors terminfoCaps of

187+ False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of

188+ Nothing -> 8

189+ Just v -> toEnum v

190+ True -> 1

195191 , supportsCursorVisibility = isJust $ civis terminfoCaps

196192 , supportsMode = terminfoModeSupported

197193 , setMode = terminfoSetMode

198194 , getModeStatus = terminfoModeStatus

199195 , assumedStateRef = newAssumedStateRef

200− , outputColorMode = colorMode

201196 -- I think fix would help assure tActual is the only

202197 -- reference. I was having issues tho.

203− , mkDisplayContext = (`terminfoDisplayContext` terminfoCaps)

198+ , mkDisplayContext = \tActual -> liftIO . terminfoDisplayContext tActual terminfoCaps

204199 }

205200 sendCap s = sendCapToTerminal t (s terminfoCaps)

206201 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)

207202 return t

208203

209−requireCap :: Terminfo.Terminal -> String -> IO CapExpression

204+requireCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m CapExpression

210205requireCap ti capName

211206 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

212207 Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""

213208 Just capStr -> parseCap capStr

214209

215−probeCap :: Terminfo.Terminal -> String -> IO (Maybe CapExpression)

210+probeCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m (Maybe CapExpression)

216211probeCap ti capName

217212 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

218213 Nothing -> return Nothing

219214 Just capStr -> Just <$> parseCap capStr

220215

221−parseCap :: String -> IO CapExpression

216+parseCap :: (Applicative m, MonadIO m) => String -> m CapExpression

222217parseCap capStr = do

223218 case parseCapExpression capStr of

224219 Left e -> fail $ show e

225220 Right cap -> return cap

226221

227−currentDisplayAttrCaps :: Terminfo.Terminal -> IO DisplayAttrCaps

222+currentDisplayAttrCaps :: ( Applicative m, MonadIO m )

223+ => Terminfo.Terminal

224+ -> m DisplayAttrCaps

228225currentDisplayAttrCaps ti

229226 = pure DisplayAttrCaps

230227 <*> probeCap ti "sgr"

231228 <*> probeCap ti "smso"

232229 <*> probeCap ti "rmso"

233− <*> probeCap ti "sitm"

234− <*> probeCap ti "ritm"

235− <*> probeCap ti "smxx"

236− <*> probeCap ti "rmxx"

237230 <*> probeCap ti "smul"

238231 <*> probeCap ti "rmul"

239232 <*> probeCap ti "rev"

@@ -247,13 +240,6 @@ getWindowSize fd = do

247240 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd

248241 return (fromIntegral b, fromIntegral a)

249242

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−

257243terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext

258244terminfoDisplayContext tActual terminfoCaps r = return dc

259245 where dc = DisplayContext

@@ -269,11 +255,7 @@ terminfoDisplayContext tActual terminfoCaps r = return dc

269255 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps

270256 , writeDefaultAttr = \urlsEnabled ->

271257 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− )

258+ (if urlsEnabled then writeURLEscapes EndLink else mempty)

277259 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []

278260 , inlineHack = return ()

279261 }

@@ -295,7 +277,7 @@ writeURLEscapes NoLinkChange =

295277-- | Portably setting the display attributes is a giant pain in the ass.

296278--

297279-- If the terminal supports the sgr capability (which sets the on/off

298−-- state of each style directly; and, for no good reason, resets the

280+-- state of each style directly ; and, for no good reason, resets the

299281-- colors to the default) this procedure is used:

300282--

301283-- 0. set the style attributes. This resets the fore and back color.

@@ -329,14 +311,14 @@ writeURLEscapes NoLinkChange =

329311-- Note that this optimizes for fewer state changes followed by fewer

330312-- bytes.

331313terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write

332−terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

314+terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs = do

333315 urlAttrs urlsEnabled `mappend` case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of

334316 -- The only way to reset either color, portably, to the default

335317 -- is to use either the set state capability or the set default

336318 -- capability.

337− True -> do

319+ True -> do

338320 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

339− (fixedStyle attr)

321+ (fixedStyle attr )

340322 (styleToApplySeq $ fixedStyle attr) of

341323 -- only way to reset a color to the defaults

342324 EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled

@@ -346,12 +328,12 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

346328 setColors

347329 -- implicitly resets the colors to the defaults

348330 SetState state -> writeCapExpr (fromJust $ setAttrStates

349− $ displayAttrCaps terminfoCaps

331+ $ displayAttrCaps

332+ $ terminfoCaps

350333 )

351334 (sgrArgsForState state)

352− `mappend` setItalics

353− `mappend` setStrikethrough

354− `mappend` setColors

335+ `mappend`

336+ setColors

355337 -- Otherwise the display colors are not changing or changing

356338 -- between two non-default points.

357339 False -> do

@@ -369,16 +351,14 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

369351 -- applied states.

370352 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps

371353 `mappend`

372− writeColorDiff Foreground (foreColorDiff diffs)

354+ writeColorDiff setForeColor (foreColorDiff diffs)

373355 `mappend`

374− writeColorDiff Background (backColorDiff diffs)

356+ writeColorDiff setBackColor (backColorDiff diffs)

375357 -- implicitly resets the colors to the defaults

376358 SetState state -> writeCapExpr (fromJust $ setAttrStates

377359 $ displayAttrCaps terminfoCaps

378360 )

379361 (sgrArgsForState state)

380− `mappend` setItalics

381− `mappend` setStrikethrough

382362 `mappend` setColors

383363 where

384364 urlAttrs True = writeURLEscapes (urlDiff diffs)

@@ -387,81 +367,31 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

387367 False -> ansiColorIndex

388368 True -> altColorIndex

389369 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

404370 setColors =

405371 (case fixedForeColor attr of

406− Just c -> writeColor Foreground c

372+ Just c -> writeCapExpr (setForeColor terminfoCaps)

373+ [toEnum $ colorMap c]

407374 Nothing -> mempty)

408375 `mappend`

409376 (case fixedBackColor attr of

410− Just c -> writeColor Background c

377+ Just c -> writeCapExpr (setBackColor terminfoCaps)

378+ [toEnum $ colorMap c]

411379 Nothing -> mempty)

412− writeColorDiff _side NoColorChange

380+ writeColorDiff _f NoColorChange

413381 = mempty

414− writeColorDiff _side ColorToDefault

382+ writeColorDiff _f ColorToDefault

415383 = error "ColorToDefault is not a possible case for applyColorDiffs"

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"

384+ writeColorDiff f (SetColor c)

385+ = writeCapExpr (f terminfoCaps) [toEnum $ colorMap c]

452386

453387-- | The color table used by a terminal is a 16 color set followed by a

454388-- 240 color set that might not be supported by the terminal.

455389--

456−-- This takes a Color which clearly identifies which palette to use and

457−-- computes the index into the full 256 color palette.

390+-- This takes a Color which clearly identifies which pallete to use and

391+-- computes the index into the full 256 color pallete.

458392ansiColorIndex :: Color -> Int

459393ansiColorIndex (ISOColor v) = fromEnum v

460394ansiColorIndex (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− ]

465395

466396-- | For terminals without setaf/setab

467397--

@@ -478,10 +408,6 @@ altColorIndex (ISOColor 6) = 3

478408altColorIndex (ISOColor 7) = 7

479409altColorIndex (ISOColor v) = fromEnum v

480410altColorIndex (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− ]

485411

486412{- | The sequence of terminfo caps to apply a given style are determined

487413 - according to these rules.

@@ -508,8 +434,6 @@ data DisplayAttrSeq

508434data DisplayAttrState = DisplayAttrState

509435 { applyStandout :: Bool

510436 , applyUnderline :: Bool

511− , applyItalic :: Bool

512− , applyStrikethrough :: Bool

513437 , applyReverseVideo :: Bool

514438 , applyBlink :: Bool

515439 , applyDim :: Bool

@@ -546,10 +470,6 @@ reqDisplayCapSeqFor caps s diffs

546470 -- set state cap then just use the set state cap.

547471 ( True, True ) -> SetState $ stateForStyle s

548472 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

553473 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps

554474 noEnterExitCap RemoveStandout = isNothing $ exitStandout caps

555475 noEnterExitCap ApplyUnderline = isNothing $ enterUnderline caps

@@ -562,10 +482,6 @@ reqDisplayCapSeqFor caps s diffs

562482 noEnterExitCap RemoveDim = True

563483 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps

564484 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

569485 enterExitCap ApplyStandout = fromJust $ enterStandout caps

570486 enterExitCap RemoveStandout = fromJust $ exitStandout caps

571487 enterExitCap ApplyUnderline = fromJust $ enterUnderline caps

@@ -579,8 +495,6 @@ stateForStyle :: Style -> DisplayAttrState

579495stateForStyle s = DisplayAttrState

580496 { applyStandout = isStyleSet standout

581497 , applyUnderline = isStyleSet underline

582− , applyItalic = isStyleSet italic

583− , applyStrikethrough = isStyleSet strikethrough

584498 , applyReverseVideo = isStyleSet reverseVideo

585499 , applyBlink = isStyleSet blink

586500 , applyDim = isStyleSet dim

@@ -592,12 +506,10 @@ styleToApplySeq :: Style -> [StyleStateChange]

592506styleToApplySeq s = concat

593507 [ applyIfRequired ApplyStandout standout

594508 , applyIfRequired ApplyUnderline underline

595− , applyIfRequired ApplyItalic italic

596− , applyIfRequired ApplyStrikethrough strikethrough

597509 , applyIfRequired ApplyReverseVideo reverseVideo

598510 , applyIfRequired ApplyBlink blink

599511 , applyIfRequired ApplyDim dim

600− , applyIfRequired ApplyBold bold

512+ , applyIfRequired ApplyBlink bold

601513 ]

602514 where

603515 applyIfRequired op flag

src/Graphics/Vty/Output/XTermColor.hs+18−31

@@ -1,4 +1,3 @@

1−{-# Language CPP #-}

32-- | Xterm output driver. This uses the Terminfo driver with some

43-- extensions for Xterm.

@@ -10,41 +9,26 @@ where

109import Graphics.Vty.Output.Interface

1110import Graphics.Vty.Input.Mouse

1211import Graphics.Vty.Input.Focus

13−import Graphics.Vty.Attributes.Color (ColorMode)

1412import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased

1513

1614import Blaze.ByteString.Builder (writeToByteString)

1715import Blaze.ByteString.Builder.Word (writeWord8)

1816

19−import qualified Data.ByteString.Char8 as BS8

20−import Data.ByteString.Char8 (ByteString)

21−import Foreign.Ptr (castPtr)

22−

2317import Control.Monad (void, when)

2418import Control.Monad.Trans

25−import Data.Char (toLower)

2619import Data.IORef

2720

28−import System.Posix.IO (fdWriteBuf)

29−import System.Posix.Types (ByteCount, Fd)

21+import System.Posix.IO (fdWrite)

22+import System.Posix.Types (Fd)

3023import System.Posix.Env (getEnv)

3124

3225import Data.List (isInfixOf)

3326import Data.Maybe (catMaybes)

34−

35−#if !MIN_VERSION_base(4,11,0)

3627import 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)

4428

4529-- | Construct an Xterm output driver. Initialize the display to UTF-8.

46−reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> ColorMode -> m Output

47−reserveTerminal variant outFd colorMode = liftIO $ do

30+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

31+reserveTerminal variant outFd = liftIO $ do

4832 let flushedPut = void . fdWrite outFd

4933 -- If the terminal variant is xterm-color use xterm instead since,

5034 -- more often than not, xterm-color is broken.

@@ -52,7 +36,7 @@ reserveTerminal variant outFd colorMode = liftIO $ do

5236

5337 utf8a <- utf8Active

5438 when (not utf8a) $ flushedPut setUtf8CharSet

55− t <- TerminfoBased.reserveTerminal variant' outFd colorMode

39+ t <- TerminfoBased.reserveTerminal variant' outFd

5640

5741 mouseModeStatus <- newIORef False

5842 focusModeStatus <- newIORef False

@@ -104,27 +88,30 @@ reserveTerminal variant outFd colorMode = liftIO $ do

10488utf8Active :: IO Bool

10589utf8Active = do

10690 let vars = ["LC_ALL", "LANG", "LC_CTYPE"]

107− results <- map (toLower <$>) . catMaybes <$> mapM getEnv vars

108− let matches = filter ("utf8" `isInfixOf`) results <>

109− filter ("utf-8" `isInfixOf`) results

91+ results <- catMaybes <$> mapM getEnv vars

92+ let matches = filter ("UTF8" `isInfixOf`) results <>

93+ filter ("UTF-8" `isInfixOf`) results

11094 return $ not $ null matches

11195

11296-- | Enable bracketed paste mode:

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

114−enableBracketedPastes :: ByteString

115−enableBracketedPastes = BS8.pack "\ESC[?2004h"

98+enableBracketedPastes :: String

99+enableBracketedPastes = "\ESC[?2004h"

116100

117101-- | Disable bracketed paste mode:

118−disableBracketedPastes :: ByteString

119−disableBracketedPastes = BS8.pack "\ESC[?2004l"

102+disableBracketedPastes :: String

103+disableBracketedPastes = "\ESC[?2004l"

120104

121105-- | These sequences set xterm based terminals to UTF-8 output.

122106--

123107-- There is no known terminfo capability equivalent to this.

124−setUtf8CharSet, setDefaultCharSet :: ByteString

125−setUtf8CharSet = BS8.pack "\ESC%G"

126−setDefaultCharSet = BS8.pack "\ESC%@"

108+setUtf8CharSet, setDefaultCharSet :: String

109+setUtf8CharSet = "\ESC%G"

110+setDefaultCharSet = "\ESC%@"

127111

112+-- | I think xterm is broken: Reseting the background color as the first

113+-- bytes serialized on a new line does not effect the background color

114+-- xterm uses to clear the line. Which is used *after* the next newline.

128115xtermInlineHack :: Output -> IO ()

129116xtermInlineHack t = do

130117 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"

src/Graphics/Vty/Picture.hs+2−11

@@ -1,3 +1,4 @@

1+{-# LANGUAGE BangPatterns #-}

12-- A 'Picture' is a background paired with a set of 'Image' layers. The

23-- 'Picture' data structure is representative of the final terminal

34-- view.

@@ -30,7 +31,7 @@ data Picture = Picture

3031 , picBackground :: Background

3132 -- ^ The picture's background to be displayed in locations with no

3233 -- Image data.

33− } deriving Eq

34+ }

3435

3536instance Show Picture where

3637 show (Picture _ layers _ ) = "Picture ?? " ++ show layers ++ " ??"

@@ -79,20 +80,11 @@ picForLayers is = Picture

7980data Cursor =

8081 -- | Hide the cursor

8182 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

9083 -- | Show the cursor at the given logical column accounting for

9184 -- character width in the presence of multi-column characters.

9285 | Cursor !Int !Int

9386 -- | Show the cursor at the given absolute terminal column and row

9487 | AbsoluteCursor !Int !Int

95− deriving Eq

9688

9789instance NFData Cursor where

9890 rnf c = c `seq` ()

@@ -116,7 +108,6 @@ data Background

116108 --

117109 -- * End of line if there are no remaining non-skip ops.

118110 | ClearBackground

119− deriving Eq

120111

121112instance NFData Background where

122113 rnf (Background c a) = c `seq` a `seq` ()

src/Graphics/Vty/PictureToSpans.hs+17−11

@@ -72,7 +72,7 @@ displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r)

7272-- | Returns the DisplayOps for an image rendered to a window the size

7373-- of the image.

7474--

75−-- largely used only for debugging.

75+-- largerly 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 (`buildSpans` r) (picLayers pic)

84+ layerOps <- mapM (\layer -> buildSpans layer 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 =

140− onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps)

139+mergeRowUnder upperRowOps lowerRowOps =

140+ onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) lowerRowOps

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 %~ subtract size

301+ s | s > size -> put $ state & skip -~ size

302302 | s == 0 -> if state^.remaining > i0Dim

303303 then do

304304 addMaybeClipped i0

305− put $ state & offset %~ (+ i0Dim) & remaining %~ subtract i0Dim

305+ put $ state & offset +~ i0Dim & remaining -~ 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 %~ subtract i0Dim' & skip .~ 0

314+ put $ state & offset +~ i0Dim' & remaining -~ i0Dim' & skip .~ 0

315315 addMaybeClipped i1

316316 | s >= i0Dim -> do

317− put $ state & skip %~ subtract i0Dim

317+ put $ state & skip -~ 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 = wctlwidth txt

326+ usedDisplayColumns = wcswidth $ TL.unpack 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 = spanOpsAffectedColumns rowOps

333+ let endX = spanOpsEffectedColumns rowOps

334334 when (endX < regionWidth displayRegion) $ do

335335 let ow = regionWidth displayRegion - endX

336336 snocOp (Skip ow) row

@@ -343,6 +343,12 @@ snocOp !op !row = do

343343 lift $ lift $ do

344344 ops <- MVector.read theMrowOps row

345345 let ops' = Vector.snoc ops op

346− when (spanOpsAffectedColumns ops' > regionWidth theRegion)

346+ when (spanOpsEffectedColumns 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+11−8

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

11-- Copyright Corey O'Connor

2+{-# LANGUAGE BangPatterns #-}

3+{-# LANGUAGE NamedFieldPuns #-}

24{-# LANGUAGE GADTs #-}

35-- | A picture is translated into a sequences of state changes and

46-- character spans. The attribute is applied to all following spans,

@@ -50,7 +52,7 @@ dropOps :: Int -> SpanOps -> SpanOps

5052dropOps w = snd . splitOpsAt w

5153

5254splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)

53−splitOpsAt = splitOpsAt'

55+splitOpsAt inW inOps = splitOpsAt' inW inOps

5456 where

5557 splitOpsAt' 0 ops = (Vector.empty, ops)

5658 splitOpsAt' remainingColumns ops = case Vector.head ops of

@@ -101,18 +103,18 @@ displayOpsColumns ops

101103

102104-- | The number of rows the DisplayOps are defined for.

103105displayOpsRows :: DisplayOps -> Int

104−displayOpsRows = Vector.length

106+displayOpsRows ops = Vector.length ops

105107

106108affectedRegion :: DisplayOps -> DisplayRegion

107109affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)

108110

109111-- | The number of columns a SpanOps affects.

110−spanOpsAffectedColumns :: SpanOps -> Int

111−spanOpsAffectedColumns inOps = Vector.foldl' spanOpsAffectedColumns' 0 inOps

112+spanOpsEffectedColumns :: SpanOps -> Int

113+spanOpsEffectedColumns inOps = Vector.foldl' spanOpsEffectedColumns' 0 inOps

112114 where

113− spanOpsAffectedColumns' t (TextSpan _ w _ _ ) = t + w

114− spanOpsAffectedColumns' t (Skip w) = t + w

115− spanOpsAffectedColumns' t (RowEnd w) = t + w

115+ spanOpsEffectedColumns' t (TextSpan _ w _ _ ) = t + w

116+ spanOpsEffectedColumns' t (Skip w) = t + w

117+ spanOpsEffectedColumns' t (RowEnd w) = t + w

116118

117119-- | The width of a single SpanOp in columns.

118120spanOpHasWidth :: SpanOp -> Maybe (Int, Int)

@@ -124,6 +126,7 @@ spanOpHasWidth (RowEnd ow) = Just (ow,ow)

124126-- span op.

125127columnsToCharOffset :: Int -> SpanOp -> Int

126128columnsToCharOffset cx (TextSpan _ _ _ utf8Str) =

127− wctlwidth (TL.take (fromIntegral cx) utf8Str)

129+ let str = TL.unpack utf8Str

130+ in wcswidth (take cx str)

128131columnsToCharOffset cx (Skip _) = cx

129132columnsToCharOffset cx (RowEnd _) = cx

src/Graphics/Vty/UnicodeWidthTable/IO.hsdeleted−105

@@ -1,105 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−module Graphics.Vty.UnicodeWidthTable.IO

3− ( readUnicodeWidthTable

4− , parseUnicodeWidthTable

5− , writeUnicodeWidthTable

6− )

7−where

8−

9−import Control.Monad (when, forM)

10−import Data.Binary

11−import Data.Binary.Get

12−import Data.Binary.Put

13−import qualified Data.ByteString.Lazy as BSL

14−#if !(MIN_VERSION_base(4,11,0))

15−import Data.Semigroup ((<>))

16−#endif

17−

18−import Graphics.Vty.UnicodeWidthTable.Types

19−

20−-- | Load a binary unicode width table from the specified file.

21−--

22−-- This either returns a successfully parsed table or a table parsing

23−-- error message. This does not handle I/O exceptions.

24−readUnicodeWidthTable :: FilePath -> IO (Either String UnicodeWidthTable)

25−readUnicodeWidthTable path = parseUnicodeWidthTable <$> BSL.readFile path

26−

27−-- | Parse a binary unicode width table.

28−parseUnicodeWidthTable :: BSL.ByteString -> Either String UnicodeWidthTable

29−parseUnicodeWidthTable bs =

30− case runGetOrFail tableParser bs of

31− Left (_, _, msg) ->

32− Left msg

33−

34− -- Even if we parsed a table, leftover bytes indicate something

35− -- could be wrong.

36− Right (remainingBytes, _, _) | not (BSL.null remainingBytes) ->

37− Left $ "Error: " <> show (BSL.length remainingBytes) <>

38− " byte(s) left unconsumed"

39−

40− Right (_, _, table) ->

41− Right table

42−

43−-- | Write the unicode width table to the specified path.

44−--

45−-- This does not handle I/O exceptions.

46−writeUnicodeWidthTable :: FilePath -> UnicodeWidthTable -> IO ()

47−writeUnicodeWidthTable path table = do

48− let body = runPut (tableV1Writer table)

49− BSL.writeFile path body

50−

51−-- | Width table magic bytes for use in the binary format.

52−widthTableMagic :: Word32

53−widthTableMagic = 0xc1a9f7e0

54−

55−tableParser :: Get UnicodeWidthTable

56−tableParser = do

57− magic <- getWord32le

58−

59− when (magic /= widthTableMagic) $

60− fail "Table magic number invalid"

61−

62− version <- getWord8

63−

64− case version of

65− 1 -> tableV1Parser

66− _ -> fail "Table version invalid"

67−

68−tableV1Parser :: Get UnicodeWidthTable

69−tableV1Parser = do

70− numRanges <- getWord32le

71−

72− let parseRange = do

73− start <- getWord32le

74− size <- getWord32le

75− cols <- getWord8

76− return WidthTableRange { rangeStart = start

77− , rangeSize = size

78− , rangeColumns = cols

79− }

80−

81− ranges <- forM [1..numRanges] $ const parseRange

82−

83− return UnicodeWidthTable { unicodeWidthTableRanges = ranges

84− }

85−

86−tableV1Writer :: UnicodeWidthTable -> Put

87−tableV1Writer table = do

88− -- Magic bytes

89− putWord32le widthTableMagic

90−

91− -- Version

92− putWord8 1

93−

94− -- Number of ranges

95− let ranges = unicodeWidthTableRanges table

96− let numRanges = length ranges

97− putWord32le (fromIntegral numRanges)

98−

99− -- Ranges

100− let putRange r = do

101− putWord32le $ rangeStart r

102− putWord32le $ rangeSize r

103− putWord8 $ rangeColumns r

104−

105− mapM_ putRange ranges

src/Graphics/Vty/UnicodeWidthTable/Install.hsdeleted−129

@@ -1,129 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE ForeignFunctionInterface #-}

3−module Graphics.Vty.UnicodeWidthTable.Install

4− ( TableInstallException(..)

5− , installUnicodeWidthTable

6− , isCustomTableReady

7− )

8−where

9−

10−import Control.Monad (when, forM_)

11−import qualified Control.Exception as E

12−import GHC.Conc.Sync (withMVar)

13−import Control.Concurrent.MVar (MVar, newMVar)

14−import Data.Word (Word8, Word32)

15−#if !(MIN_VERSION_base(4,11,0))

16−import Data.Semigroup ((<>))

17−#endif

18−import System.IO.Unsafe (unsafePerformIO)

19−

20−import Graphics.Vty.UnicodeWidthTable.Types

21−

22−-- | The lock used to make functions in this module thread-safe.

23−installLock :: MVar ()

24−{-# NOINLINE installLock #-}

25−installLock = unsafePerformIO $ newMVar ()

26−

27−-- | Returns True if and only if a custom table has been allocated and

28−-- marked as ready for use.

29−--

30−-- This function is thread-safe.

31−isCustomTableReady :: IO Bool

32−isCustomTableReady = withInstallLock $ (== 1) <$> c_isCustomTableReady

33−

34−withInstallLock :: IO a -> IO a

35−withInstallLock act = withMVar installLock $ const act

36−

37−-- This is the size of the allocated custom character width table, in

38−-- character slots. It's important that this be large enough to hold all

39−-- possible Unicode character values. At the time of this writing, the

40−-- valid Unicode range is 0 - 0x10ffff, hence this value.

41−tableSize :: Int

42−tableSize = 0x110000

43−

44−-- | Exception type raised by 'installUnicodeWidthTable'.

45−data TableInstallException =

46− TableInitFailure Int Int

47− -- ^ The width table could not be initialized. Args: failure status,

48− -- requested table size.

49− | TableRangeFailure Int WidthTableRange

50− -- ^ A code point range could not be configured. Args: failure

51− -- status, offending range.

52− | TableActivationFailure Int

53− -- ^ The table could not be activated. Args: failure status.

54− deriving (Eq, Show)

55−

56−instance E.Exception TableInstallException

57−

58−-- | Install a custom unicode character width

59−-- table. Such tables are obtained with

60−-- 'Graphics.Vty.UnicodeWidthTable.Query.buildUnicodeWidthTable' and

61−-- 'Graphics.Vty.UnicodeWidthTable.IO.readUnicodeWidthTable'.

62−--

63−-- ALERT! This function is probably not what you want to use because

64−-- it is automatically called by 'Graphics.Vty.mkVty'. You will only

65−-- ever need to call this function if you want to use functions

66−-- in 'Graphics.Text.Width' without controlling the terminal with

67−-- 'Graphics.Vty.mkVty'.

68−--

69−-- This affects the behavior of the 'Graphics.Vty.Image.wcwidth'

70−-- function and functions that call it. It does so by

71−-- changing global state available to the C implementation

72−-- of 'Graphics.Vty.Image.wcwidth'. To ensure that your

73−-- program gets consistent results from evaluating calls to

74−-- 'Graphics.Vty.Image.wcwidth', the installation of a custom table

75−-- should be performed before you call 'Graphics.Vty.Image.wcwidth' in

76−-- your program.

77−--

78−-- This is best done at Vty startup, and if you use

79−-- 'Graphics.Vty.mkVty', that function calls this automatically based on

80−-- the Vty configuration's declared width tables. It is exposed as part

81−-- of the public API so that applications can call this as needed if

82−-- they don't want to control the terminal with 'mkVty' but do want to

83−-- make calls to 'Graphics.Vty.Image.wcwidth'.

84−--

85−-- It's also important to note that once a custom table has been

86−-- installed, it is permanent for the life of the process. No new table

87−-- can be installed, and the new custom table cannot be removed.

88−--

89−-- If this function fails for any reason -- if the table cannot be

90−-- installed or is invalid, or if a custom table already exists -- this

91−-- will raise a 'TableInstallException' exception.

92−--

93−-- This function is thread-safe.

94−installUnicodeWidthTable :: UnicodeWidthTable -> IO ()

95−installUnicodeWidthTable table = withInstallLock $ do

96− initResult <- initCustomTable tableSize

97− when (initResult /= 0) $

98− E.throwIO $ TableInitFailure initResult tableSize

99−

100− forM_ (unicodeWidthTableRanges table) $ \r -> do

101− result <- setCustomTableRange (rangeStart r)

102− (rangeSize r)

103− (rangeColumns r)

104−

105− when (result /= 0) $ do

106− deallocateCustomTable

107− E.throwIO $ TableRangeFailure result r

108−

109− actResult <- activateCustomTable

110− when (actResult /= 0) $

111− E.throwIO $ TableActivationFailure actResult

112−

113−------------------------------------------------------------------------

114−-- C imports

115−

116−foreign import ccall unsafe "vty_init_custom_table"

117− initCustomTable :: Int -> IO Int

118−

119−foreign import ccall unsafe "vty_set_custom_table_range"

120− setCustomTableRange :: Word32 -> Word32 -> Word8 -> IO Int

121−

122−foreign import ccall unsafe "vty_activate_custom_table"

123− activateCustomTable :: IO Int

124−

125−foreign import ccall unsafe "vty_custom_table_ready"

126− c_isCustomTableReady :: IO Int

127−

128−foreign import ccall unsafe "vty_deallocate_custom_table"

129− deallocateCustomTable :: IO ()

src/Graphics/Vty/UnicodeWidthTable/Query.hsdeleted−79

@@ -1,79 +0,0 @@

1−{-# LANGUAGE TupleSections #-}

2−module Graphics.Vty.UnicodeWidthTable.Query

3− ( buildUnicodeWidthTable

4− , defaultUnicodeTableUpperBound

5− )

6−where

7−

8−import Control.Monad (forM)

9−import Data.Char (generalCategory, GeneralCategory(..))

10−import System.Console.ANSI (getCursorPosition)

11−import Text.Printf (printf)

12−

13−import Graphics.Vty.UnicodeWidthTable.Types

14−

15−shouldConsider :: Char -> Bool

16−shouldConsider c =

17− case generalCategory c of

18− Control -> False

19− NotAssigned -> False

20− Surrogate -> False

21− _ -> True

22−

23−charWidth :: Char -> IO Int

24−charWidth c = do

25− printf "\r"

26− putChar c

27− Just (_, col) <- getCursorPosition

28− return col

29−

30−-- | Convert a sequence of character/width pairs into a list of

31−-- run-length encoded ranges. This function assumes the pairs come

32−-- sorted by character ordinal value. It does not require that the

33−-- character range is fully covered by the sequence.

34−--

35−-- The result of this function is a list of ranges in reverse order

36−-- relative to the input sequence.

37−mkRanges :: [(Char, Int)] -> [WidthTableRange]

38−mkRanges pairs =

39− let convertedPairs = convert <$> pairs

40− convert (c, i) = (fromIntegral $ fromEnum c, fromIntegral i)

41−

42− go Nothing finishedRanges [] = finishedRanges

43− go (Just r) finishedRanges [] = r:finishedRanges

44−

45− go Nothing finishedRanges ((c, width):rest) =

46− go (Just $ WidthTableRange c 1 width) finishedRanges rest

47−

48− go (Just r@(WidthTableRange prevCh sz prevWidth)) finishedRanges ((c, width):rest) =

49− if c == prevCh + sz && prevWidth == width

50− then go (Just (WidthTableRange prevCh (sz + 1) prevWidth)) finishedRanges rest

51− else go (Just (WidthTableRange c 1 width)) (r:finishedRanges) rest

52−

53− in go Nothing [] convertedPairs

54−

55−-- The uppermost code point to consider when building Unicode width

56−-- tables.

57−defaultUnicodeTableUpperBound :: Char

58−defaultUnicodeTableUpperBound = '\xe0000'

59−

60−-- | Construct a unicode character width table by querying the terminal

61−-- connected to stdout. This works by emitting characters to stdout

62−-- and then querying the terminal to determine the resulting cursor

63−-- position in order to measure character widths. Consequently this will

64−-- generate a lot of output and may take a while, depending on your

65−-- system performance. This should not be run in a terminal while it is

66−-- controlled by Vty.

67−--

68−-- The argument specifies the upper bound code point to test when

69−-- building the table. This allows callers to decide how much of the

70−-- Unicode code point space to scan when building the table.

71−--

72−-- This does not handle exceptions.

73−buildUnicodeWidthTable :: Char -> IO UnicodeWidthTable

74−buildUnicodeWidthTable tableUpperBound = do

75− pairs <- forM (filter shouldConsider ['\0'..tableUpperBound]) $ \i ->

76− (i,) <$> charWidth i

77−

78− return UnicodeWidthTable { unicodeWidthTableRanges = reverse $ mkRanges pairs

79− }

src/Graphics/Vty/UnicodeWidthTable/Types.hsdeleted−29

@@ -1,29 +0,0 @@

1−module Graphics.Vty.UnicodeWidthTable.Types

2− ( UnicodeWidthTable(..)

3− , WidthTableRange(..)

4− )

5−where

6−

7−import Data.Word (Word8, Word32)

8−

9−-- | A range of code points in a width table.

10−data WidthTableRange =

11− WidthTableRange { rangeStart :: Word32

12− -- ^ The range's starting code point.

13− , rangeSize :: Word32

14− -- ^ The number of code points in the contiguous

15− -- range, beginning with the starting code point

16− -- ('rangeStart').

17− , rangeColumns :: Word8

18− -- ^ The terminal width, in columns, of all of the

19− -- characters corresponding to the code points in

20− -- this range.

21− }

22− deriving (Eq, Show)

23−

24−-- | A run-length-encoded table of Unicode character widths.

25−data UnicodeWidthTable =

26− UnicodeWidthTable { unicodeWidthTableRanges :: [WidthTableRange]

27− -- ^ The ranges in the table.

28− }

29− deriving (Show)

test/Verify/Graphics/Vty/Span.hs+1−1

@@ -20,7 +20,7 @@ isAttrSpanOp TextSpan {} = True

2020isAttrSpanOp _ = False

2121

2222verifyAllSpansHaveWidth i spans w

23− = let v = map (\s -> (spanOpsAffectedColumns s /= w, s)) (Vector.toList spans)

23+ = let v = map (\s -> (spanOpsEffectedColumns s /= w, s)) (Vector.toList spans)

2424 in case any ((== True) . fst) v of

2525 False -> succeeded

2626 True -> failed { reason = "Not all spans contained operations defining exactly "

test/VerifyAttributeOps.hsnew file+9

@@ -0,0 +1,9 @@

1+module VerifyAttributeOps where

3+import Verify.Graphics.Vty.Attributes

5+import Verify

7+tests :: IO [Test]

8+tests = return []

test/VerifyColor240.hsdeleted−269

@@ -1,269 +0,0 @@

1−module VerifyColor240 where

2−

3−import Data.Word(Word8)

4−import Verify

5−

6−import Graphics.Vty.Attributes.Color240(rgbColorToColor240)

7−

8−oldRgbColorToColor240 :: Integral i => i -> i -> i -> Word8

9−oldRgbColorToColor240 r g b

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

11− | r == 8 && g == 8 && b == 8 = 216

12− | r == 18 && g == 18 && b == 18 = 217

13− | r == 28 && g == 28 && b == 28 = 218

14− | r == 38 && g == 38 && b == 38 = 219

15− | r == 48 && g == 48 && b == 48 = 220

16− | r == 58 && g == 58 && b == 58 = 221

17− | r == 68 && g == 68 && b == 68 = 222

18− | r == 78 && g == 78 && b == 78 = 223

19− | r == 88 && g == 88 && b == 88 = 224

20− | r == 98 && g == 98 && b == 98 = 225

21− | r == 108 && g == 108 && b == 108 = 226

22− | r == 118 && g == 118 && b == 118 = 227

23− | r == 128 && g == 128 && b == 128 = 228

24− | r == 138 && g == 138 && b == 138 = 229

25− | r == 148 && g == 148 && b == 148 = 230

26− | r == 158 && g == 158 && b == 158 = 231

27− | r == 168 && g == 168 && b == 168 = 232

28− | r == 178 && g == 178 && b == 178 = 233

29− | r == 188 && g == 188 && b == 188 = 234

30− | r == 198 && g == 198 && b == 198 = 235

31− | r == 208 && g == 208 && b == 208 = 236

32− | r == 218 && g == 218 && b == 218 = 237

33− | r == 228 && g == 228 && b == 228 = 238

34− | r == 238 && g == 238 && b == 238 = 239

35− | r <= 0 && g <= 0 && b <= 0 = 0

36− | r <= 0 && g <= 0 && b <= 95 = 1

37− | r <= 0 && g <= 0 && b <= 135 = 2

38− | r <= 0 && g <= 0 && b <= 175 = 3

39− | r <= 0 && g <= 0 && b <= 215 = 4

40− | r <= 0 && g <= 0 && b <= 255 = 5

41− | r <= 0 && g <= 95 && b <= 0 = 6

42− | r <= 0 && g <= 95 && b <= 95 = 7

43− | r <= 0 && g <= 95 && b <= 135 = 8

44− | r <= 0 && g <= 95 && b <= 175 = 9

45− | r <= 0 && g <= 95 && b <= 215 = 10

46− | r <= 0 && g <= 95 && b <= 255 = 11

47− | r <= 0 && g <= 135 && b <= 0 = 12

48− | r <= 0 && g <= 135 && b <= 95 = 13

49− | r <= 0 && g <= 135 && b <= 135 = 14

50− | r <= 0 && g <= 135 && b <= 175 = 15

51− | r <= 0 && g <= 135 && b <= 215 = 16

52− | r <= 0 && g <= 135 && b <= 255 = 17

53− | r <= 0 && g <= 175 && b <= 0 = 18

54− | r <= 0 && g <= 175 && b <= 95 = 19

55− | r <= 0 && g <= 175 && b <= 135 = 20

56− | r <= 0 && g <= 175 && b <= 175 = 21

57− | r <= 0 && g <= 175 && b <= 215 = 22

58− | r <= 0 && g <= 175 && b <= 255 = 23

59− | r <= 0 && g <= 215 && b <= 0 = 24

60− | r <= 0 && g <= 215 && b <= 95 = 25

61− | r <= 0 && g <= 215 && b <= 135 = 26

62− | r <= 0 && g <= 215 && b <= 175 = 27

63− | r <= 0 && g <= 215 && b <= 215 = 28

64− | r <= 0 && g <= 215 && b <= 255 = 29

65− | r <= 0 && g <= 255 && b <= 0 = 30

66− | r <= 0 && g <= 255 && b <= 95 = 31

67− | r <= 0 && g <= 255 && b <= 135 = 32

68− | r <= 0 && g <= 255 && b <= 175 = 33

69− | r <= 0 && g <= 255 && b <= 215 = 34

70− | r <= 0 && g <= 255 && b <= 255 = 35

71− | r <= 95 && g <= 0 && b <= 0 = 36

72− | r <= 95 && g <= 0 && b <= 95 = 37

73− | r <= 95 && g <= 0 && b <= 135 = 38

74− | r <= 95 && g <= 0 && b <= 175 = 39

75− | r <= 95 && g <= 0 && b <= 215 = 40

76− | r <= 95 && g <= 0 && b <= 255 = 41

77− | r <= 95 && g <= 95 && b <= 0 = 42

78− | r <= 95 && g <= 95 && b <= 95 = 43

79− | r <= 95 && g <= 95 && b <= 135 = 44

80− | r <= 95 && g <= 95 && b <= 175 = 45

81− | r <= 95 && g <= 95 && b <= 215 = 46

82− | r <= 95 && g <= 95 && b <= 255 = 47

83− | r <= 95 && g <= 135 && b <= 0 = 48

84− | r <= 95 && g <= 135 && b <= 95 = 49

85− | r <= 95 && g <= 135 && b <= 135 = 50

86− | r <= 95 && g <= 135 && b <= 175 = 51

87− | r <= 95 && g <= 135 && b <= 215 = 52

88− | r <= 95 && g <= 135 && b <= 255 = 53

89− | r <= 95 && g <= 175 && b <= 0 = 54

90− | r <= 95 && g <= 175 && b <= 95 = 55

91− | r <= 95 && g <= 175 && b <= 135 = 56

92− | r <= 95 && g <= 175 && b <= 175 = 57

93− | r <= 95 && g <= 175 && b <= 215 = 58

94− | r <= 95 && g <= 175 && b <= 255 = 59

95− | r <= 95 && g <= 215 && b <= 0 = 60

96− | r <= 95 && g <= 215 && b <= 95 = 61

97− | r <= 95 && g <= 215 && b <= 135 = 62

98− | r <= 95 && g <= 215 && b <= 175 = 63

99− | r <= 95 && g <= 215 && b <= 215 = 64

100− | r <= 95 && g <= 215 && b <= 255 = 65

101− | r <= 95 && g <= 255 && b <= 0 = 66

102− | r <= 95 && g <= 255 && b <= 95 = 67

103− | r <= 95 && g <= 255 && b <= 135 = 68

104− | r <= 95 && g <= 255 && b <= 175 = 69

105− | r <= 95 && g <= 255 && b <= 215 = 70

106− | r <= 95 && g <= 255 && b <= 255 = 71

107− | r <= 135 && g <= 0 && b <= 0 = 72

108− | r <= 135 && g <= 0 && b <= 95 = 73

109− | r <= 135 && g <= 0 && b <= 135 = 74

110− | r <= 135 && g <= 0 && b <= 175 = 75

111− | r <= 135 && g <= 0 && b <= 215 = 76

112− | r <= 135 && g <= 0 && b <= 255 = 77

113− | r <= 135 && g <= 95 && b <= 0 = 78

114− | r <= 135 && g <= 95 && b <= 95 = 79

115− | r <= 135 && g <= 95 && b <= 135 = 80

116− | r <= 135 && g <= 95 && b <= 175 = 81

117− | r <= 135 && g <= 95 && b <= 215 = 82

118− | r <= 135 && g <= 95 && b <= 255 = 83

119− | r <= 135 && g <= 135 && b <= 0 = 84

120− | r <= 135 && g <= 135 && b <= 95 = 85

121− | r <= 135 && g <= 135 && b <= 135 = 86

122− | r <= 135 && g <= 135 && b <= 175 = 87

123− | r <= 135 && g <= 135 && b <= 215 = 88

124− | r <= 135 && g <= 135 && b <= 255 = 89

125− | r <= 135 && g <= 175 && b <= 0 = 90

126− | r <= 135 && g <= 175 && b <= 95 = 91

127− | r <= 135 && g <= 175 && b <= 135 = 92

128− | r <= 135 && g <= 175 && b <= 175 = 93

129− | r <= 135 && g <= 175 && b <= 215 = 94

130− | r <= 135 && g <= 175 && b <= 255 = 95

131− | r <= 135 && g <= 215 && b <= 0 = 96

132− | r <= 135 && g <= 215 && b <= 95 = 97

133− | r <= 135 && g <= 215 && b <= 135 = 98

134− | r <= 135 && g <= 215 && b <= 175 = 99

135− | r <= 135 && g <= 215 && b <= 215 = 100

136− | r <= 135 && g <= 215 && b <= 255 = 101

137− | r <= 135 && g <= 255 && b <= 0 = 102

138− | r <= 135 && g <= 255 && b <= 95 = 103

139− | r <= 135 && g <= 255 && b <= 135 = 104

140− | r <= 135 && g <= 255 && b <= 175 = 105

141− | r <= 135 && g <= 255 && b <= 215 = 106

142− | r <= 135 && g <= 255 && b <= 255 = 107

143− | r <= 175 && g <= 0 && b <= 0 = 108

144− | r <= 175 && g <= 0 && b <= 95 = 109

145− | r <= 175 && g <= 0 && b <= 135 = 110

146− | r <= 175 && g <= 0 && b <= 175 = 111

147− | r <= 175 && g <= 0 && b <= 215 = 112

148− | r <= 175 && g <= 0 && b <= 255 = 113

149− | r <= 175 && g <= 95 && b <= 0 = 114

150− | r <= 175 && g <= 95 && b <= 95 = 115

151− | r <= 175 && g <= 95 && b <= 135 = 116

152− | r <= 175 && g <= 95 && b <= 175 = 117

153− | r <= 175 && g <= 95 && b <= 215 = 118

154− | r <= 175 && g <= 95 && b <= 255 = 119

155− | r <= 175 && g <= 135 && b <= 0 = 120

156− | r <= 175 && g <= 135 && b <= 95 = 121

157− | r <= 175 && g <= 135 && b <= 135 = 122

158− | r <= 175 && g <= 135 && b <= 175 = 123

159− | r <= 175 && g <= 135 && b <= 215 = 124

160− | r <= 175 && g <= 135 && b <= 255 = 125

161− | r <= 175 && g <= 175 && b <= 0 = 126

162− | r <= 175 && g <= 175 && b <= 95 = 127

163− | r <= 175 && g <= 175 && b <= 135 = 128

164− | r <= 175 && g <= 175 && b <= 175 = 129

165− | r <= 175 && g <= 175 && b <= 215 = 130

166− | r <= 175 && g <= 175 && b <= 255 = 131

167− | r <= 175 && g <= 215 && b <= 0 = 132

168− | r <= 175 && g <= 215 && b <= 95 = 133

169− | r <= 175 && g <= 215 && b <= 135 = 134

170− | r <= 175 && g <= 215 && b <= 175 = 135

171− | r <= 175 && g <= 215 && b <= 215 = 136

172− | r <= 175 && g <= 215 && b <= 255 = 137

173− | r <= 175 && g <= 255 && b <= 0 = 138

174− | r <= 175 && g <= 255 && b <= 95 = 139

175− | r <= 175 && g <= 255 && b <= 135 = 140

176− | r <= 175 && g <= 255 && b <= 175 = 141

177− | r <= 175 && g <= 255 && b <= 215 = 142

178− | r <= 175 && g <= 255 && b <= 255 = 143

179− | r <= 215 && g <= 0 && b <= 0 = 144

180− | r <= 215 && g <= 0 && b <= 95 = 145

181− | r <= 215 && g <= 0 && b <= 135 = 146

182− | r <= 215 && g <= 0 && b <= 175 = 147

183− | r <= 215 && g <= 0 && b <= 215 = 148

184− | r <= 215 && g <= 0 && b <= 255 = 149

185− | r <= 215 && g <= 95 && b <= 0 = 150

186− | r <= 215 && g <= 95 && b <= 95 = 151

187− | r <= 215 && g <= 95 && b <= 135 = 152

188− | r <= 215 && g <= 95 && b <= 175 = 153

189− | r <= 215 && g <= 95 && b <= 215 = 154

190− | r <= 215 && g <= 95 && b <= 255 = 155

191− | r <= 215 && g <= 135 && b <= 0 = 156

192− | r <= 215 && g <= 135 && b <= 95 = 157

193− | r <= 215 && g <= 135 && b <= 135 = 158

194− | r <= 215 && g <= 135 && b <= 175 = 159

195− | r <= 215 && g <= 135 && b <= 215 = 160

196− | r <= 215 && g <= 135 && b <= 255 = 161

197− | r <= 215 && g <= 175 && b <= 0 = 162

198− | r <= 215 && g <= 175 && b <= 95 = 163

199− | r <= 215 && g <= 175 && b <= 135 = 164

200− | r <= 215 && g <= 175 && b <= 175 = 165

201− | r <= 215 && g <= 175 && b <= 215 = 166

202− | r <= 215 && g <= 175 && b <= 255 = 167

203− | r <= 215 && g <= 215 && b <= 0 = 168

204− | r <= 215 && g <= 215 && b <= 95 = 169

205− | r <= 215 && g <= 215 && b <= 135 = 170

206− | r <= 215 && g <= 215 && b <= 175 = 171

207− | r <= 215 && g <= 215 && b <= 215 = 172

208− | r <= 215 && g <= 215 && b <= 255 = 173

209− | r <= 215 && g <= 255 && b <= 0 = 174

210− | r <= 215 && g <= 255 && b <= 95 = 175

211− | r <= 215 && g <= 255 && b <= 135 = 176

212− | r <= 215 && g <= 255 && b <= 175 = 177

213− | r <= 215 && g <= 255 && b <= 215 = 178

214− | r <= 215 && g <= 255 && b <= 255 = 179

215− | r <= 255 && g <= 0 && b <= 0 = 180

216− | r <= 255 && g <= 0 && b <= 95 = 181

217− | r <= 255 && g <= 0 && b <= 135 = 182

218− | r <= 255 && g <= 0 && b <= 175 = 183

219− | r <= 255 && g <= 0 && b <= 215 = 184

220− | r <= 255 && g <= 0 && b <= 255 = 185

221− | r <= 255 && g <= 95 && b <= 0 = 186

222− | r <= 255 && g <= 95 && b <= 95 = 187

223− | r <= 255 && g <= 95 && b <= 135 = 188

224− | r <= 255 && g <= 95 && b <= 175 = 189

225− | r <= 255 && g <= 95 && b <= 215 = 190

226− | r <= 255 && g <= 95 && b <= 255 = 191

227− | r <= 255 && g <= 135 && b <= 0 = 192

228− | r <= 255 && g <= 135 && b <= 95 = 193

229− | r <= 255 && g <= 135 && b <= 135 = 194

230− | r <= 255 && g <= 135 && b <= 175 = 195

231− | r <= 255 && g <= 135 && b <= 215 = 196

232− | r <= 255 && g <= 135 && b <= 255 = 197

233− | r <= 255 && g <= 175 && b <= 0 = 198

234− | r <= 255 && g <= 175 && b <= 95 = 199

235− | r <= 255 && g <= 175 && b <= 135 = 200

236− | r <= 255 && g <= 175 && b <= 175 = 201

237− | r <= 255 && g <= 175 && b <= 215 = 202

238− | r <= 255 && g <= 175 && b <= 255 = 203

239− | r <= 255 && g <= 215 && b <= 0 = 204

240− | r <= 255 && g <= 215 && b <= 95 = 205

241− | r <= 255 && g <= 215 && b <= 135 = 206

242− | r <= 255 && g <= 215 && b <= 175 = 207

243− | r <= 255 && g <= 215 && b <= 215 = 208

244− | r <= 255 && g <= 215 && b <= 255 = 209

245− | r <= 255 && g <= 255 && b <= 0 = 210

246− | r <= 255 && g <= 255 && b <= 95 = 211

247− | r <= 255 && g <= 255 && b <= 135 = 212

248− | r <= 255 && g <= 255 && b <= 175 = 213

249− | r <= 255 && g <= 255 && b <= 215 = 214

250− | r <= 255 && g <= 255 && b <= 255 = 215

251− | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."

252− (fromIntegral r :: Int)

253− (fromIntegral g :: Int)

254− (fromIntegral b :: Int))

255−

256−sameColor :: Int -> Int -> Int -> Bool

257−sameColor r g b = oldRgbColorToColor240 r g b == rgbColorToColor240 r g b

258−

259−genVal :: Gen Int

260−genVal = chooseInt (0, 255)

261−

262−sameColorCheck :: Property

263−sameColorCheck = forAll genVal (\r -> forAll genVal (\g -> forAll genVal (sameColor r g)))

264−

265−tests :: IO [Test]

266−tests = return

267− [ verify "check rgbColorToColor240 optimization is correct" sameColorCheck

268− ]

269−

test/VerifyEmptyImageProps.hs−1

@@ -1,4 +1,3 @@

1−{-# LANGUAGE ScopedTypeVariables #-}

21module VerifyEmptyImageProps where

43import Verify

test/VerifyEvalTerminfoCaps.hs−1

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

11{-# LANGUAGE BangPatterns #-}

22{-# LANGUAGE NamedFieldPuns #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

43module VerifyEvalTerminfoCaps where

65import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)

test/VerifyImageOps.hs+1−2

@@ -1,4 +1,3 @@

1−{-# LANGUAGE ScopedTypeVariables #-}

21module VerifyImageOps where

43import Graphics.Vty.Attributes

@@ -137,7 +136,7 @@ cropBottomLimitsHeight :: Image -> Int -> Property

137136cropBottomLimitsHeight i v = v >= 0 ==>

138137 v >= imageHeight (cropBottom v i)

139138

140−-- ridiculous tests just to satisfy my desire for nice code coverage :-P

139+-- rediculous tests just to satisfy my desire for nice code coverage :-P

141140canShowImage :: Image -> Bool

142141canShowImage i = length (show i) > 0

143142

test/VerifyOutput.hs+3−7

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

1−-- We setup the environment to invoke certain terminals of interest.

1+-- We setup the environment to envoke certain terminals of interest.

22-- This assumes appropriate definitions exist in the current environment

33-- for the terminals of interest.

4−{-# LANGUAGE ScopedTypeVariables #-}

54module VerifyOutput where

76import Verify

@@ -14,6 +13,7 @@ import Verify.Graphics.Vty.Output

1413import Control.Monad

1514

1615import qualified System.Console.Terminfo as Terminfo

16+import System.Posix.Env

1717import System.Posix.IO

1818

1919tests :: IO [Test]

@@ -35,11 +35,7 @@ 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

39− { outputFd = Just nullOut

40− , termName = Just termName

41− , colorMode = Just NoColor

42− }

38+ t <- outputForConfig $ defaultConfig { outputFd = Just nullOut, termName = Just termName }

4339 -- putStrLn $ "context color count: " ++ show (contextColorCount t)

4440 reserveDisplay t

4541 dc <- displayContext t (100,100)

test/VerifyParseTerminfoCaps.hs−1

@@ -1,5 +1,4 @@

11{-# LANGUAGE NamedFieldPuns #-}

2−{-# LANGUAGE ScopedTypeVariables #-}

32module VerifyParseTerminfoCaps where

54import 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 ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

28+ in ( spanOpsEffectedRows 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 ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

40+ in ( spanOpsEffectedRows 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 spanOpsAffectedRows ops == 1

54+ in spanOpsEffectedRows 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 = spanOpsAffectedRows ops

77+ actualRowCount = spanOpsEffectedRows 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 = spanOpsAffectedRows ops

93+ actualRowCount = spanOpsEffectedRows 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 = spanOpsAffectedRows ops

110+ actualRowCount = spanOpsEffectedRows 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 ( spanOpsAffectedRows ops == h ) && ( allSpansHaveWidth ops w )

126+ in ( spanOpsEffectedRows 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 = spanOpsAffectedRows ops

132+ actualRowCount = spanOpsEffectedRows ops

133133 in expectedRowCount == actualRowCount

134134

135135spanOpsActuallyFillColumns :: DefaultPic -> Bool

test/VerifyUsingMockInput.hs+1−4

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

11{-# LANGUAGE MultiParamTypeClasses #-}

22{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

43-- Generate some input bytes and delays between blocks of input bytes.

54-- Verify the events produced are as expected.

65module Main where

@@ -132,9 +131,7 @@ assertEventsFromSynInput table inputSpec expectedEvents = do

132131 readLoop 0 = return ()

133132 readLoop n = do

134133 e <- atomically $ readTChan $ input^.eventChannel

135− case e of

136− InputEvent ev -> modifyIORef eventsRef ((:) ev)

137− ResumeAfterSignal -> return ()

134+ modifyIORef eventsRef ((:) e)

138135 readLoop (n - 1)

139136 genEventsUsingIoActions maxDuration writeWaitClose readEvents

140137 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−-- Explicitly define the bytes that encode each example text.

367+-- Explicitely definethe 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.hsdeleted−144

@@ -1,144 +0,0 @@

1−{-# LANGUAGE ScopedTypeVariables #-}

2−{-# LANGUAGE CPP #-}

3−module Main where

4−

5−import qualified Control.Exception as E

6−import Control.Monad (when)

7−import Data.Maybe (fromMaybe)

8−#if !(MIN_VERSION_base(4,11,0))

9−import Data.Semigroup ((<>))

10−#endif

11−import System.Directory (createDirectoryIfMissing)

12−import System.Environment (getArgs, getProgName)

13−import System.FilePath (takeDirectory)

14−import System.Exit (exitFailure)

15−import System.Console.GetOpt

16−import Text.Read (readMaybe)

17−

18−import Graphics.Vty.Config ( terminalWidthTablePath, currentTerminalName

19− , vtyConfigPath, addConfigWidthMap

20− , ConfigUpdateResult(..)

21− )

22−import Graphics.Vty.UnicodeWidthTable.IO

23−import Graphics.Vty.UnicodeWidthTable.Query

24−

25−data Arg = Help

26− | OutputPath String

27− | TableUpperBound String

28− | UpdateConfig

29− | VtyConfigPath String

30− deriving (Eq, Show)

31−

32−options :: Config -> [OptDescr Arg]

33−options config =

34− [ Option "h" ["help"] (NoArg Help)

35− "This help output"

36− , Option "b" ["bound"] (ReqArg TableUpperBound "MAX_CHAR")

37− ("The maximum Unicode code point to test when building the table " <>

38− "(default: " <> (show $ fromEnum $ configBound config) <> ")")

39− , Option "p" ["path"] (ReqArg OutputPath "PATH")

40− ("The output path to write to (default: " <>

41− fromMaybe "<none>" (configOutputPath config) <> ")")

42− , Option "u" ["update-config"] (NoArg UpdateConfig)

43− "Create or update the Vty configuration file to use the new table (default: no)"

44− , Option "c" ["config-path"] (ReqArg VtyConfigPath "PATH")

45− ("Update the specified Vty configuration file path when -u is set (default: " <>

46− configPath config <> ")")

47− ]

48−

49−data Config =

50− Config { configOutputPath :: Maybe FilePath

51− , configBound :: Char

52− , configUpdate :: Bool

53− , configPath :: FilePath

54− }

55− deriving (Show)

56−

57−mkDefaultConfig :: IO Config

58−mkDefaultConfig = do

59− Config <$> terminalWidthTablePath

60− <*> pure defaultUnicodeTableUpperBound

61− <*> pure False

62− <*> vtyConfigPath

63−

64−usage :: IO ()

65−usage = do

66− config <- mkDefaultConfig

67− pn <- getProgName

68− putStrLn $ "Usage: " <> pn <> " [options]"

69− putStrLn ""

70− putStrLn "This tool queries the terminal on stdout to determine the widths"

71− putStrLn "of Unicode characters rendered to the terminal. The resulting data"

72− putStrLn "is written to a table at the specified output path for later"

73− putStrLn "loading by Vty-based applications."

74− putStrLn ""

75−

76− putStrLn $ usageInfo pn (options config)

77−

78−updateConfigFromArg :: Arg -> Config -> Config

79−updateConfigFromArg Help c =

80− c

81−updateConfigFromArg UpdateConfig c =

82− c { configUpdate = True }

83−updateConfigFromArg (VtyConfigPath p) c =

84− c { configPath = p }

85−updateConfigFromArg (TableUpperBound s) c =

86− case readMaybe s of

87− Nothing -> error $ "Invalid table upper bound: " <> show s

88− Just v -> c { configBound = toEnum v }

89−updateConfigFromArg (OutputPath p) c =

90− c { configOutputPath = Just p }

91−

92−main :: IO ()

93−main = do

94− defConfig <- mkDefaultConfig

95− strArgs <- getArgs

96− let (args, unused, errors) = getOpt Permute (options defConfig) strArgs

97−

98− when (not $ null errors) $ do

99− mapM_ putStrLn errors

100− exitFailure

101−

102− when ((not $ null unused) || (Help `elem` args)) $ do

103− usage

104− exitFailure

105−

106− let config = foldr updateConfigFromArg defConfig args

107−

108− outputPath <- case configOutputPath config of

109− Nothing -> do

110− putStrLn "Error: could not obtain terminal width table path"

111− exitFailure

112− Just path -> return path

113−

114− putStrLn "Querying terminal:"

115− builtTable <- buildUnicodeWidthTable $ configBound config

116−

117− let dir = takeDirectory outputPath

118− createDirectoryIfMissing True dir

119− writeUnicodeWidthTable outputPath builtTable

120−

121− putStrLn $ "\nOutput table written to " <> outputPath

122−

123− when (configUpdate config) $ do

124− let cPath = configPath config

125− Just tName <- currentTerminalName

126−

127− result <- E.try $ addConfigWidthMap cPath tName outputPath

128−

129− case result of

130− Left (e::E.SomeException) -> do

131− putStrLn $ "Error updating Vty configuration at " <> cPath <> ": " <>

132− show e

133− exitFailure

134− Right ConfigurationCreated -> do

135− putStrLn $ "Configuration file created: " <> cPath

136− Right ConfigurationModified -> do

137− putStrLn $ "Configuration file updated: " <> cPath

138− Right (ConfigurationConflict other) -> do

139− putStrLn $ "Configuration file not updated: uses a different table " <>

140− "for TERM=" <> tName <> ": " <> other

141− Right ConfigurationRedundant -> do

142− putStrLn $ "Configuration file not updated: configuration " <>

143− cPath <> " already uses table " <> outputPath <>

144− " for TERM=" <> tName

vty.cabal+66−75

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

11name: vty

2−version: 5.35.1

2+version: 5.19

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.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.5

33+tested-with: GHC >= 7.6.2

3434

3535source-repository head

3636 type: git

@@ -45,9 +45,10 @@ library

4545 deepseq >= 1.1 && < 1.5,

4646 directory,

4747 filepath >= 1.0 && < 2.0,

48− microlens < 0.4.13,

48+ microlens,

4949 microlens-mtl,

5050 microlens-th,

51+ -- required for nice installation with yi

5152 hashable >= 1.2,

5253 mtl >= 1.1.1.0 && < 2.3,

5354 parallel >= 2.2 && < 3.3,

@@ -58,18 +59,10 @@ library

5859 text >= 0.11.3,

5960 unix,

6061 utf8-string >= 0.3 && < 1.1,

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

62+ vector >= 0.7

6863

6964 exposed-modules: Graphics.Vty

7065 Graphics.Vty.Attributes

71− Graphics.Vty.Attributes.Color

72− Graphics.Vty.Attributes.Color240

7366 Graphics.Vty.Config

7467 Graphics.Vty.Error

7568 Graphics.Vty.Image

@@ -80,6 +73,7 @@ library

8073 Graphics.Vty.Picture

8174 Graphics.Vty.Output

8275 Graphics.Text.Width

76+ -- the modules below are only meant to be used by the tests.

8377 Codec.Binary.UTF8.Debug

8478 Data.Terminfo.Parse

8579 Data.Terminfo.Eval

@@ -100,47 +94,35 @@ library

10094 Graphics.Vty.Output.Interface

10195 Graphics.Vty.Output.XTermColor

10296 Graphics.Vty.Output.TerminfoBased

103− Graphics.Vty.UnicodeWidthTable.Types

104− Graphics.Vty.UnicodeWidthTable.IO

105− Graphics.Vty.UnicodeWidthTable.Query

106− Graphics.Vty.UnicodeWidthTable.Install

10797

108− other-modules: Graphics.Vty.Debug.Image

98+ other-modules: Graphics.Vty.Attributes.Color

99+ Graphics.Vty.Attributes.Color240

100+ Graphics.Vty.Debug.Image

109101 Graphics.Vty.Input.Terminfo.ANSIVT

110102

111103 c-sources: cbits/gwinsz.c

112104 cbits/set_term_timing.c

113− cbits/get_tty_erase.c

114105 cbits/mk_wcwidth.c

115106

116107 include-dirs: cbits

117108

118109 hs-source-dirs: src

119110

111+ default-extensions: ScopedTypeVariables

112+ ForeignFunctionInterface

113+

120114 ghc-options: -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10

121115

122116 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10

123117

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

118+ cc-options: -O2

138119

139120executable vty-mode-demo

140121 main-is: ModeDemo.hs

141122 hs-source-dirs: demos

142123

143124 default-language: Haskell2010

125+ default-extensions: ScopedTypeVariables

144126 ghc-options: -threaded

145127

146128 build-depends: vty,

@@ -155,6 +137,7 @@ executable vty-demo

155137 hs-source-dirs: demos

156138

157139 default-language: Haskell2010

140+ default-extensions: ScopedTypeVariables

158141 ghc-options: -threaded

159142

160143 build-depends: vty,

@@ -164,8 +147,29 @@ executable vty-demo

164147 microlens-mtl,

165148 mtl >= 1.1.1.0 && < 2.3

166149

150+test-suite verify-attribute-ops

151+ default-language: Haskell2010

152+ default-extensions: ScopedTypeVariables

153+ type: detailed-0.9

154+ hs-source-dirs: test

155+ test-module: VerifyAttributeOps

156+ build-depends: vty,

157+ Cabal >= 1.20,

158+ QuickCheck >= 2.7,

159+ random >= 1.0 && < 1.2,

160+ base >= 4.8 && < 5,

161+ bytestring,

162+ containers,

163+ deepseq >= 1.1 && < 1.5,

164+ mtl >= 1.1.1.0 && < 2.3,

165+ text >= 0.11.3,

166+ unix,

167+ utf8-string >= 0.3 && < 1.1,

168+ vector >= 0.7

169+

167170test-suite verify-using-mock-terminal

168171 default-language: Haskell2010

172+ default-extensions: ScopedTypeVariables

169173

170174 type: detailed-0.9

171175

@@ -184,7 +188,7 @@ test-suite verify-using-mock-terminal

184188 build-depends: vty,

185189 Cabal >= 1.20,

186190 QuickCheck >= 2.7,

187− random >= 1.0 && < 1.3,

191+ random >= 1.0 && < 1.2,

188192 base >= 4.8 && < 5,

189193 bytestring,

190194 containers,

@@ -198,6 +202,7 @@ test-suite verify-using-mock-terminal

198202

199203test-suite verify-terminal

200204 default-language: Haskell2010

205+ default-extensions: ScopedTypeVariables

201206

202207 type: detailed-0.9

203208

@@ -216,7 +221,7 @@ test-suite verify-terminal

216221 build-depends: vty,

217222 Cabal >= 1.20,

218223 QuickCheck >= 2.7,

219− random >= 1.0 && < 1.3,

224+ random >= 1.0 && < 1.2,

220225 base >= 4.8 && < 5,

221226 bytestring,

222227 containers,

@@ -230,6 +235,7 @@ test-suite verify-terminal

230235

231236test-suite verify-display-attributes

232237 default-language: Haskell2010

238+ default-extensions: ScopedTypeVariables

233239

234240 type: detailed-0.9

235241

@@ -248,7 +254,7 @@ test-suite verify-display-attributes

248254 build-depends: vty,

249255 Cabal >= 1.20,

250256 QuickCheck >= 2.7,

251− random >= 1.0 && < 1.3,

257+ random >= 1.0 && < 1.2,

252258 base >= 4.8 && < 5,

253259 bytestring,

254260 containers,

@@ -261,6 +267,7 @@ test-suite verify-display-attributes

261267

262268test-suite verify-empty-image-props

263269 default-language: Haskell2010

270+ default-extensions: ScopedTypeVariables

264271

265272 type: detailed-0.9

266273

@@ -273,7 +280,7 @@ test-suite verify-empty-image-props

273280 build-depends: vty,

274281 Cabal >= 1.20,

275282 QuickCheck >= 2.7,

276− random >= 1.0 && < 1.3,

283+ random >= 1.0 && < 1.2,

277284 base >= 4.8 && < 5,

278285 bytestring,

279286 containers,

@@ -286,6 +293,7 @@ test-suite verify-empty-image-props

286293

287294test-suite verify-eval-terminfo-caps

288295 default-language: Haskell2010

296+ default-extensions: ScopedTypeVariables

289297

290298 type: detailed-0.9

291299

@@ -299,7 +307,7 @@ test-suite verify-eval-terminfo-caps

299307 build-depends: vty,

300308 Cabal >= 1.20,

301309 QuickCheck >= 2.7,

302− random >= 1.0 && < 1.3,

310+ random >= 1.0 && < 1.2,

303311 base >= 4.8 && < 5,

304312 blaze-builder >= 0.3.3.2 && < 0.5,

305313 bytestring,

@@ -314,6 +322,7 @@ test-suite verify-eval-terminfo-caps

314322

315323test-suite verify-image-ops

316324 default-language: Haskell2010

325+ default-extensions: ScopedTypeVariables

317326

318327 type: detailed-0.9

319328

@@ -328,7 +337,7 @@ test-suite verify-image-ops

328337 build-depends: vty,

329338 Cabal >= 1.20,

330339 QuickCheck >= 2.7,

331− random >= 1.0 && < 1.3,

340+ random >= 1.0 && < 1.2,

332341 base >= 4.8 && < 5,

333342 bytestring,

334343 containers,

@@ -341,6 +350,7 @@ test-suite verify-image-ops

341350

342351test-suite verify-image-trans

343352 default-language: Haskell2010

353+ default-extensions: ScopedTypeVariables

344354

345355 type: detailed-0.9

346356

@@ -355,7 +365,7 @@ test-suite verify-image-trans

355365 build-depends: vty,

356366 Cabal >= 1.20,

357367 QuickCheck >= 2.7,

358− random >= 1.0 && < 1.3,

368+ random >= 1.0 && < 1.2,

359369 base >= 4.8 && < 5,

360370 bytestring,

361371 containers,

@@ -368,6 +378,7 @@ test-suite verify-image-trans

368378

369379test-suite verify-inline

370380 default-language: Haskell2010

381+ default-extensions: ScopedTypeVariables

371382

372383 type: detailed-0.9

373384

@@ -381,7 +392,7 @@ test-suite verify-inline

381392 build-depends: vty,

382393 Cabal >= 1.20,

383394 QuickCheck >= 2.7,

384− random >= 1.0 && < 1.3,

395+ random >= 1.0 && < 1.2,

385396 base >= 4.8 && < 5,

386397 bytestring,

387398 containers,

@@ -394,6 +405,7 @@ test-suite verify-inline

394405

395406test-suite verify-parse-terminfo-caps

396407 default-language: Haskell2010

408+ default-extensions: ScopedTypeVariables

397409

398410 type: detailed-0.9

399411

@@ -408,7 +420,7 @@ test-suite verify-parse-terminfo-caps

408420 build-depends: vty,

409421 Cabal >= 1.20,

410422 QuickCheck >= 2.7,

411− random >= 1.0 && < 1.3,

423+ random >= 1.0 && < 1.2,

412424 base >= 4.8 && < 5,

413425 bytestring,

414426 containers,

@@ -422,6 +434,7 @@ test-suite verify-parse-terminfo-caps

422434

423435test-suite verify-simple-span-generation

424436 default-language: Haskell2010

437+ default-extensions: ScopedTypeVariables

425438

426439 type: detailed-0.9

427440

@@ -439,7 +452,7 @@ test-suite verify-simple-span-generation

439452 build-depends: vty,

440453 Cabal >= 1.20,

441454 QuickCheck >= 2.7,

442− random >= 1.0 && < 1.3,

455+ random >= 1.0 && < 1.2,

443456 base >= 4.8 && < 5,

444457 bytestring,

445458 containers,

@@ -453,6 +466,7 @@ test-suite verify-simple-span-generation

453466

454467test-suite verify-crop-span-generation

455468 default-language: Haskell2010

469+ default-extensions: ScopedTypeVariables

456470

457471 type: detailed-0.9

458472

@@ -470,7 +484,7 @@ test-suite verify-crop-span-generation

470484 build-depends: vty,

471485 Cabal >= 1.20,

472486 QuickCheck >= 2.7,

473− random >= 1.0 && < 1.3,

487+ random >= 1.0 && < 1.2,

474488 base >= 4.8 && < 5,

475489 bytestring,

476490 containers,

@@ -484,6 +498,7 @@ test-suite verify-crop-span-generation

484498

485499test-suite verify-layers-span-generation

486500 default-language: Haskell2010

501+ default-extensions: ScopedTypeVariables

487502

488503 type: detailed-0.9

489504

@@ -501,32 +516,7 @@ test-suite verify-layers-span-generation

501516 build-depends: vty,

502517 Cabal >= 1.20,

503518 QuickCheck >= 2.7,

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,

519+ random >= 1.0 && < 1.2,

530520 base >= 4.8 && < 5,

531521 bytestring,

532522 containers,

@@ -539,6 +529,7 @@ test-suite verify-color-mapping

539529

540530test-suite verify-utf8-width

541531 default-language: Haskell2010

532+ default-extensions: ScopedTypeVariables

542533

543534 type: detailed-0.9

544535

@@ -551,7 +542,7 @@ test-suite verify-utf8-width

551542 build-depends: vty,

552543 Cabal >= 1.20,

553544 QuickCheck >= 2.7,

554− random >= 1.0 && < 1.3,

545+ random >= 1.0 && < 1.2,

555546 base >= 4.8 && < 5,

556547 bytestring,

557548 containers,

@@ -564,6 +555,7 @@ test-suite verify-utf8-width

564555

565556test-suite verify-using-mock-input

566557 default-language: Haskell2010

558+ default-extensions: ScopedTypeVariables

567559

568560 type: exitcode-stdio-1.0

569561

@@ -571,8 +563,6 @@ test-suite verify-using-mock-input

571563

572564 main-is: VerifyUsingMockInput.hs

573565

574− other-modules: Verify.Graphics.Vty.Output

575−

576566 build-depends: vty,

577567 Cabal >= 1.20,

578568 QuickCheck >= 2.7,

@@ -580,7 +570,7 @@ test-suite verify-using-mock-input

580570 quickcheck-assertions >= 0.1.1,

581571 test-framework == 0.8.*,

582572 test-framework-smallcheck == 0.2.*,

583− random >= 1.0 && < 1.3,

573+ random >= 1.0 && < 1.2,

584574 base >= 4.8 && < 5,

585575 bytestring,

586576 containers,

@@ -599,6 +589,7 @@ test-suite verify-using-mock-input

599589

600590test-suite verify-config

601591 default-language: Haskell2010

592+ default-extensions: ScopedTypeVariables

602593

603594 type: exitcode-stdio-1.0

604595

@@ -615,7 +606,7 @@ test-suite verify-config

615606 test-framework == 0.8.*,

616607 test-framework-smallcheck == 0.2.*,

617608 test-framework-hunit,

618− random >= 1.0 && < 1.3,

609+ random >= 1.0 && < 1.2,

619610 base >= 4.8 && < 5,

620611 bytestring,

621612 containers,