master..b9572e6 · vty · git.iko.soy

git.iko.soy/vty

on b9572e6 help sign in

.travis.yml+17−100

since splitsnapshots

unifiedsplit

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

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

2−#

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

4−#

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

6−#

7−language: c

1+language: haskell

8−sudo: false

10−git:

3+notifications:

11− submodules: false # whether to recursively clone submodules

4+ email: false

12−

13−cache:

14− directories:

15− - $HOME/.cabal/packages

16− - $HOME/.cabal/store

17−

18−before_cache:

19− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

20− # remove files that are regenerated by 'cabal update'

21− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*

22− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json

23− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache

24− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar

25− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx

26−

27− - rm -rfv $HOME/.cabal/packages/head.hackage

29matrix:

6matrix:

30− include:

7+ allow_failures:

31− - compiler: "ghc-8.4.3"

8+ - env: CABALVER=head GHCVER=head

32− # env: TEST=--disable-tests BENCH=--disable-benchmarks

33− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}

34− - compiler: "ghc-8.2.2"

35− # env: TEST=--disable-tests BENCH=--disable-benchmarks

36− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}}

37− - compiler: "ghc-8.0.2"

38− # env: TEST=--disable-tests BENCH=--disable-benchmarks

39− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}}

40− - compiler: "ghc-7.10.3"

41− # env: TEST=--disable-tests BENCH=--disable-benchmarks

42− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}}

44−before_install:

10+env:

45− - HC=${CC}

11+ - CABALVER=1.22 GHCVER=7.10.1

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

12+ - CABALVER=1.24 GHCVER=8.0.1

47− - unset CC

13+ - CABALVER=1.24 GHCVER=8.0.2

48− - ROOTDIR=$(pwd)

14+ - CABALVER=head GHCVER=head

49− - mkdir -p $HOME/.local/bin

50− - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"

51− - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))

52− - echo $HCNUMVER

54install:

16install:

55− - cabal --version

17+ - ./ci/travis_ci_install

56− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"

57− - BENCH=${BENCH---enable-benchmarks}

58− - TEST=${TEST---enable-tests}

59− - HADDOCK=${HADDOCK-true}

60− - UNCONSTRAINED=${UNCONSTRAINED-true}

61− - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}

62− - GHCHEAD=${GHCHEAD-false}

63− - travis_retry cabal update -v

64− - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"

65− - rm -fv cabal.project cabal.project.local

66− - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'

67− - "printf 'packages: \".\"\\n' > cabal.project"

68− - touch cabal.project.local

69− - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- vty | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"

70− - cat cabal.project || true

71− - cat cabal.project.local || true

72− - if [ -f "./configure.ac" ]; then

73− (cd "." && autoreconf -i);

74− fi

75− - rm -f cabal.project.freeze

76− - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all

77− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all

78− - rm -rf .ghc.environment.* "."/dist

79− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

81−# Here starts the actual work to be performed for the package under test;

82−# any command which exits with a non-zero exit code causes the build to fail.

83script:

19script:

84− # test that source-distributions can be generated

20+ - ./ci/travis_ci_script

85− - (cd "." && cabal sdist)

86− - mv "."/dist/vty-*.tar.gz ${DISTDIR}/

87− - cd ${DISTDIR} || false

88− - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;

89− - "printf 'packages: vty-*/*.cabal\\n' > cabal.project"

90− - touch cabal.project.local

91− - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- vty | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"

92− - cat cabal.project || true

93− - cat cabal.project.local || true

94− # this builds all libraries and executables (without tests/benchmarks)

95− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all

97− # build & run tests, build benchmarks

22+before_install:

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

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

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

24+ - sudo apt-get update

100−

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

101− # haddock

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

102− - rm -rf ./dist-newstyle

103− - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi

104−

105− # Build without installed constraints for packages in global-db

106− - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi

107−

108−# REGENDATA ["vty.cabal"]

109−# EOF

CHANGELOG.md+361−764

@@ -1,861 +1,458 @@

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−

293−5.19

294−----

295−

296−API changes:

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

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

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

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

301− Vty handle.

302−

303−5.18.1

304−------

305−

306−Bug fixes:

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

308−

309−5.18

310−----

311−

312−API changes:

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

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

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

316−

317−5.17.1

318−------

319−

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

321− untouched if the input style is the null style

322−

3235.17

15.17

324−----

325−

326API changes:

2API changes:

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

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

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

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

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

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

330− constructors, EvLostFocus and EvGainedFocus.

6+ constructors, EvLostFocus and EvGainedFocus.

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

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

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

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

333− etc.) work.

9+ etc.) work.

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

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

335− #131)

11+ #131)

336

3375.16

135.16

338−----

339−

340API changes:

14API changes:

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

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

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

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

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

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

344

345Bug fixes:

19Bug fixes:

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

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

21+ Mertens!)

347

3485.15.1

235.15.1

349−------

350−

351Package changes:

24Package changes:

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

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

353− Suchánek)

26+ Suchánek)

354

355Bug fixes:

28Bug fixes:

356−* translateX/Y: fix negative translations

29+ - translateX/Y: fix negative translations

357

3585.15

315.15

359−----

360−

361Package changes:

32Package changes:

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

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

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

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

364− are no longer supported.

35+ are no longer supported.

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

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

366− wanted, though!)

37+ wanted, though!)

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

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

368

369API changes:

40API changes:

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

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

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

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

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

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

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

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

374− Graphics.Vty.Output.Interface.

45+ Graphics.Vty.Output.Interface.

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

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

376− accessors to Graphics.Vty.Image.

47+ accessors to Graphics.Vty.Image.

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

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

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

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

379

3805.14

515.14

381−----

382−

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

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

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

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

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

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

386− zero

55+ zero

387−* 'string' and related text functions no longer treat an empty string

56+ - '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

57+ 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.

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

390

3915.13

605.13

392−----

393−

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

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

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

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

396− discussion at

63+ discussion at

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

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

398

3995.12

665.12

400−----

401−

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

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

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

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

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

405− characters.

70+ characters.

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

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

407

4085.11.3

735.11.3

409−------

410−

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

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

412

4135.11.2

765.11.2

414−------

415−

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

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

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

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

418

4195.11.1

805.11.1

420−------

421−

422−* Add Generic instance for Image

81+ - Add Generic instance for Image

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

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

424− on refresh with normal cursor positioning mode)

83+ on refresh with normal cursor positioning mode)

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

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

426−* Update maintainer

85+ - Update maintainer

427

4285.11

875.11

429−----

430−

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

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

432− evironment variable is missing (thanks Eric Mertens)

89+ evironment variable is missing (thanks Eric Mertens)

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

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

434− exporting internal types (thanks Eric Mertens)

91+ exporting internal types (thanks Eric Mertens)

435

4365.10

935.10

437−----

438−

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

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

440− mode provides greater control over cursor positioning by bypassing

95+ mode provides greater control over cursor positioning by bypassing

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

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

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

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

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

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

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

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

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

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

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

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

447− Mertens)

102+ Mertens)

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

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

449− behavior. Previously vty_mk_wcwidth was being imported with the

104+ behavior. Previously vty_mk_wcwidth was being imported with

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

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

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

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

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

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

453− (thanks Eric Mertens)

108+ non-negative. (thanks Eric Mertens)

454

109

4555.9.1

1105.9.1

456−-----

457−

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

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

459− preexisting UTF8 declaration to avoid emitting garbage sequences

112+ preexisting UTF8 declaration to avoid emitting garbage sequences

460− (fixes #89)

113+ (fixes #89)

461

114

4625.9

1155.9

463−---

464−

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

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

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

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

118+ #102)

467

119

4685.8.1

1205.8.1

469−-----

470−

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

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

472

122

4735.8

1235.8

474−---

475−

476−* API change: EvPaste input event now provides paste data as a raw

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

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

478− best to decode it

126+ how best to decode it

479

127

4805.7.1

1285.7.1

481−-----

482−

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

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

130+ GHCs

484

131

4855.7

1325.7

486−---

487−

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

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

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

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

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

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

491− terminals that support them).

136+ terminals that support them).

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

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

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

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

494− functions:

139+ functions:

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

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

496− mode

141+ mode

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

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

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

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

499− off

144+ off

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

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

501

146

5025.6

1475.6

503−---

504−

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

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

506− terminals via the MouseDown and MouseUp Event constructors

149+ terminals via the MouseDown and MouseUp Event constructors

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

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

508− the EvPaste event constructor

151+ the EvPaste event constructor

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

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

510− Hirn)

153+ Hirn)

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

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

512− XtermColor driver rather than just TerminfoBased

155+ XtermColor driver rather than just TerminfoBased

513

156

5145.5.0

1575.5.0

515−-----

516−

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

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

518− dependencies. Issue #90

159+ dependencies. Issue #90

519− * Thanks Jonathan Daugherty

160+ - Thanks Jonathan Daugherty

520−* Cabal corrections.

161+ - Cabal corrections.

521− * Thanks Lennart Spitzner

162+ - Thanks Lennart Spitzner

522

163

5235.4.0

1645.4.0

524−-----

525−

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

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

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

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

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

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

529− Clients that use eventChannel directly will require updating.

168+ eventChannel directly will require updating.

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

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

531−

5325.3.1

1705.3.1

533−-----

534−

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

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

536− possibly breaking this on reasonable GHC versions

172+ to possibly breaking this on reasonable GHC versions

537

173

5385.3

1745.3

539−---

540−

541−* Upgraded QuickCheck dependency to 2.7

175+ - Upgraded QuickCheck dependency to 2.7

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

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

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

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

544− changed if mkVty was used. Fixed.

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

545−* Correct handling of display attributes at end of line. The output

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

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

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

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

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

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

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

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

185+ correctly.

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

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

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

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

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

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

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

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

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

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

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

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

557

192

5585.2.11

1935.2.11

559−------

560−

561−* deepseq bounds increased for tests.

194+ - deepseq bounds increased for tests.

562−* Clean up warnings when compiling on 7.10

195+ - Clean up warnings when compiling on 7.10

563− * Thanks Eric Mertens

196+ - Thanks Eric Mertens

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

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

565− * Thanks Eric Mertens

198+ - Thanks Eric Mertens

566

199

5675.2.10

2005.2.10

568−------

569−

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

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

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

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

572− * Thanks Jonathan Daugherty

203+ - Thanks Jonathan Daugherty

573

204

5745.2.9

2055.2.9

575−-----

576−

577−* dependency version bumps

206+ - dependency version bumps

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

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

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

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

580−* Correct/Simplify the example code

209+ - Correct/Simplify the example code

581− * Thanks glguy

210+ - Thanks glguy

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

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

583

212

5845.2.8

2135.2.8

585−-----

586−

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

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

588− * Thanks glguy

215+ - Thanks glguy

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

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

590−* Do not differentiate based on TERM_PROGRAM

217+ - Do not differentiate based on TERM_PROGRAM

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

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

592

219

5935.2.7

2205.2.7

594−-----

595−

596−* lens and deepseq constraint bump + misc

221+ - lens and deepseq constraint bump + misc

597− * Thanks ethercrow

222+ - Thanks ethercrow

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

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

599

224

6005.2.6

2255.2.6

601−-----

602−

603−* lens constraint bump

226+ - lens constraint bump

604− * Thanks alexander-b!

227+ - Thanks alexander-b!

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

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

606

229

6075.2.5

2305.2.5

608−-----

609−

610−* lens and random version constraint bump.

231+ - lens and random version constraint bump.

611− * Thanks RyanGlScott!

232+ - Thanks RyanGlScott!

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

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

613

234

6145.2.4

2355.2.4

615−-----

616−

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

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

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

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

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

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

620− * Thanks Fuuzetsu!

239+ - Thanks Fuuzetsu!

621

240

6225.2.3

2415.2.3

623−-----

624−

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

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

626− keystroke.

243+ keystroke.

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

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

628− * Thanks ethercrow!

245+ - Thanks ethercrow!

629

246

6305.2.2

2475.2.2

631−-----

632−

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

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

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

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

635− * Thanks ethercrow!

250+ - Thanks ethercrow!

636

251

6375.2.1

2525.2.1

638−-----

639−

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

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

641

254

6425.2.0

2555.2.0

643−-----

644−

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

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

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

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

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

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

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

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

649− NoBuffering)

260+ NoBuffering)

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

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

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

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

652−* removed: derivedVtime, derivedVmin, inputForCurrentTerminal,

263+ - removed: derivedVtime, derivedVmin, inputForCurrentTerminal,

653− inputForNameAndIO, outputForCurrentTerminal, outputForNameAndIO

264+ inputForNameAndIO, outputForCurrentTerminal, outputForNameAndIO

654−* added: inputForConfig, outputForConfig

265+ - added: inputForConfig, outputForConfig

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

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

656−* the oldest version of GHC tested to support vty is 7.6.2.

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

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

658

269

6595.1.4

2705.1.4

660−-----

661−

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

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

663

272

6645.1.1

2735.1.1

665−-----

666−

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

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

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

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

669

276

6705.1.0

2775.1.0

671−-----

672−

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

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

674− See Graphics.Vty.Config.

279+ See Graphics.Vty.Config.

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

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

676

281

6775.0.0

2825.0.0

678−-----

679−

680−* The naming convention now matches:

283+ - The naming convention now matches:

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

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

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

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

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

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

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

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

685− vty with the default configuration.

288+ vty with the default configuration.

686−* input handling changes

289+ - input handling changes

687− * KASCII is now KChar

290+ - KASCII is now KChar

688− * KPN5 is now KCenter

291+ - KPN5 is now KCenter

689− * tests exist.

292+ - tests exist.

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

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

691− the Config. See Graphics.Vty.Config

294+ the Config. See Graphics.Vty.Config

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

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

693− applications. See Graphics.Vty.Config

296+ applications. See Graphics.Vty.Config

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

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

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

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

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

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

697− implies a requirement on -threaded.

300+ implies a requirement on -threaded.

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

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

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

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

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

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

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

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

702−* renamed the Terminal interface to Output

305+ - renamed the Terminal interface to Output

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

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

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

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

705− line.

308+ line.

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

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

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

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

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

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

709−* Layer support

312+ - Layer support

710− * Each layer is an image.

313+ - Each layer is an image.

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

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

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

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

713− top to bottom.

316+ top to bottom.

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

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

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

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

716− sizes are joined.

319+ sizes are joined.

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

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

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

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

719− background layer.

322+ background layer.

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

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

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

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

722− given Picture.

325+ given Picture.

723−* compatibility improvements:

326+ - compatibility improvements:

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

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

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

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

726− no effect.

329+ no effect.

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

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

728− the first 8 are just a guess.

331+ the first 8 are just a guess.

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

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

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

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

731− translate from input bytes to events.

334+ translate from input bytes to events.

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

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

733− appended to a debug log

336+ appended to a debug log

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

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

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

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

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

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

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

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

738− file.

341+ file.

739− * vty-interactive-terminal-test

342+ - vty-interactive-terminal-test

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

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

741− author.

344+ author.

742− * test/interactive_terminal_test.hs

345+ - test/interactive_terminal_test.hs

743− * vty-event-echo

346+ - vty-event-echo

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

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

745− user.

348+ user.

746− * test/EventEcho.hs

349+ - test/EventEcho.hs

747− * vty-rogue

350+ - vty-rogue

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

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

749− build operations.

352+ build operations.

750− * test/Rogue.hs

353+ - test/Rogue.hs

751− * vty-benchmark

354+ - vty-benchmark

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

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

753− the terminal. The random pictures are generated using

356+ the terminal. The random pictures are generated using

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

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

755− * test/benchmark.hs

358+ - test/benchmark.hs

756

359

7574.7.0.0

3604.7.0.0

758−-------

361+ - API changes:

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

363+ than the specified size.

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

365+ than the specified size.

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

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

759

368

760−API changes:

369+4.3.0.0

761−* Added Graphics.Vty.Image.crop: Ensure an image is no larger

762− than the specified size.

763−* Added Graphics.Vty.Image.pad: Ensure an image is no smaller

764− than the specified size.

765−* Added Graphics.Vty.Image.translate: Offset an image.

766−* Thanks Ben Boeckel <MathStuf@gmail.com> for these features.

767

370

7684.2.1.0

3714.2.1.0

769−-------

770−

771−API changes:

372+ - API changes:

772−* Attr record accessor fore_color changed to attr_fore_color

373+ - Attr record accessor fore_color changed to attr_fore_color

773−* Attr record accessor back_color changed to attr_back_color

374+ - Attr record accessor back_color changed to attr_back_color

774−* Attr record accessor style changed to attr_style

375+ - Attr record accessor style changed to attr_style

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

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

776− * put_attr_change applies a display attribute change

377+ - put_attr_change applies a display attribute change

777− immediately to a terminal

378+ immediately to a terminal

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

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

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

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

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

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

781− color to red.

382+ color to red.

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

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

783− * See Graphics.Vty.Inline

384+ - See Graphics.Vty.Inline

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

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

785

386

7864.0.0.1

3874.0.0.1

787−-------

788−

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

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

790− magically worked due to coincidence.

389+ magically worked due to coincidence.

791

390

7924.0.0

3914.0.0

793−-----

794−

795−API changes:

392+ - API changes:

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

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

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

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

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

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

799− TerminalHandle associated with the Vty instance.

396+ TerminalHandle associated with the Vty instance.

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

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

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

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

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

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

803− for final picture construction.

400+ for final picture construction.

804−* Graphics.Vty.Attributes:

401+ - Graphics.Vty.Attributes:

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

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

806− "with_back_color"

403+ "with_back_color"

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

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

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

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

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

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

810− attributes"

407+ attributes"

811−* Graphics.Vty.Image:

408+ - Graphics.Vty.Image:

812− * "horzcat" is now "horiz_cat"

409+ - "horzcat" is now "horiz_cat"

813− * "vertcat" is now "vert_cat"

410+ - "vertcat" is now "vert_cat"

814− * "renderBS" is now "utf8_bytestring"

411+ - "renderBS" is now "utf8_bytestring"

815− * "renderChar" is now "char"

412+ - "renderChar" is now "char"

816− * "renderFill" is now "char_fill"

413+ - "renderFill" is now "char_fill"

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

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

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

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

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

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

820−* Graphics.Vty.Picture:

417+ - Graphics.Vty.Picture:

821− * exports Graphics.Vty.Image

418+ - exports Graphics.Vty.Image

822− * "pic" is now "pic_for_image"

419+ - "pic" is now "pic_for_image"

823− * added API for setting background fill pattern.

420+ - added API for setting background fill pattern.

824−* Completely rewritten output backend.

421+ - Completely rewritten output backend.

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

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

826− fully optimized, but good enough.

423+ fully optimized, but good enough.

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

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

828− terminal are well encapsulated.

425+ terminal are well encapsulated.

829− * Terminfo based display terminal implementation. With specialized

426+ - Terminfo based display terminal implementation. With specialized

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

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

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

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

832− support all display attributes.

429+ support all display attributes.

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

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

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

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

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

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

836− successfull.

433+ successfull.

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

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

838− expected.

435+ expected.

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

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

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

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

841− terminal supports.

438+ terminal supports.

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

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

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

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

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

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

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

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

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

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

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

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

848

445

849Issues resolved:

446Issues resolved:

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

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

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

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

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

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

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

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

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

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

855− width characters"

452+ width characters"

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

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

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

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

858− dimensions"

455+ dimensions"

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

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

860−* "256-color support"

457+ - "256-color support"

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

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

LICENSE−2

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

1−BSD 3-Clause License

2−

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

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

5All rights reserved.

3All rights reserved.

README.md+54−109

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

7Install via `git` with:

9```

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

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

11```

13Install via `cabal` with:

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

19# Features

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

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

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

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

24−* Automatically handles window resizes.

24+* Automatic handling of window resizes.

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

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

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

29+ terminal.)

30+

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

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

29− state changes are minimized.

32+ minimized.

31* Minimizes repaint area, which virtually eliminates the flicker

34* Minimizes repaint area, which virtually eliminates the flicker

32 problems that plague ncurses programs.

35 problems that plague ncurses programs.

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

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

35− display images.

38+ images.

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

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

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

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

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

42 customizable.

45 customizable.

44−* Provides extensible input and output interfaces.

47+* The interface is designed for easy extension.

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

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

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

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

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

57* Supports bracketed paste mode as described at

60* Supports bracketed paste mode as described at

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

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

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−

71# Platform Support

63# Platform Support

73## Posix Terminals

65## Posix Terminals

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

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

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

68+handle some omissions from terminfo.

78## Windows

70## Windows

80−Windows is not supported.

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

81−

82−# Multi-Column Character Support

83−

84−Vty supports rendering of multi-column characters such as two-column

85−Asian characters and Emoji characters. This section details how to

86−take advantage of this feature, since its behavior will depend on the

87−terminal emulator in use.

88−

89−Terminal emulators support Unicode to varying degrees, and each terminal

90−emulator relies on a table of column widths for each supported Unicode

91−character. Vty also needs to rely on such a table to compute the width

92−of Vty images to do image layout. Since those tables can disagree if

93−Vty and the terminal emulator support different versions of Unicode,

94−and since different terminal emulators will support different versions

95−of Unicode, it's likely that for some wide characters, Vty applications

96−will exhibit rendering problems. Those rendering problems arise from Vty

97−and the terminal emulator coming to different conclusions about how wide

98−some characters are.

99−

100−To address this, Vty supports loading custom character width tables

101−that are based on the terminal's behavior in order to eliminate these

102−disagreements. By default, though, Vty will use its built-in Unicode

103−character width table. Since the built-in table is likely to eventually

104−disagree with your terminal, Vty provides an API and a command-line tool

105−to generate and install custom tables.

106−

107−Custom Unicode width tables based on your terminal emulator can be

108−built by running Vty's built-in tool, `vty-build-width-table`. The tool

109−works by querying the current terminal emulator to obtain its width

110−measurements for the entire supported Unicode range. The

111−results are then saved to a disk file. These custom tables

112−can also be generated programmatically by using the API in

113−`Graphics.Vty.UnicodeWidthTable.Query`.

114−

115−Saved width tables can then be loaded in one of two ways:

116−

117−* Via the library API in `Graphics.Vty.UnicodeWidthTable.IO`

118−* By adding a `widthMap` directive to your Vty configuration file and

119− then invoking `mkVty` to initialize Vty

120−

121−The Vty configuration file supports the `widthMap` directive to allow

122−users to specify which custom width table should be loaded for a given

123−terminal type. This is done by specifying, e.g.,

124−

125−```

126−widthMap "xterm" "/path/to/map.dat"

127−```

128−

129−where the first argument is the value that `TERM` must have in order for

130−the table to be loaded, and the second argument is the path to the table

131−file itself as generated by the two alternatives listed above. If the

132−Vty configuration file contains multiple matching `widthMap` directives

133−for the current value of `TERM`, the last one listed in the file is

134−used.

135−

136−The tables declared in the configuration file are only ever

137−automatically loaded when applications set up Vty by calling

138−`Graphics.Vty.mkVty`.

139−

140−Before a custom table has been loaded, calls to the library's character

141−width functions (e.g. `wcwidth`) will use the default built-in table.

142−Once a custom table has been loaded, the functions will use the new

143−custom table. Only one custom table load can be performed in a Vty

144−program. Once a custom table has been loaded, it cannot be replaced or

145−removed.

146−

147−Without using a custom width table, users of Vty-based applications

148−are likely to eventually experience rendering problems with with wide

149−characters. We recommend that developers of Vty-based applications either:

150−

151−* Provide the `vty-build-width-table` tool and documentation for running

152− it and updating the Vty configuration, or

153−* Have the application invoke the Vty library's table-building

154− functionality and load the table at startup without using the Vty

155− configuration.

156−

157−The best option will depend on a number of factors: the user audience,

158−the amount of risk posed by wide character rendering, the terminal

159−emulators in use, etc.

160

161# Contributing

74# Contributing

162

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

170 conventions already used in the codebase.

83 conventions already used in the codebase.

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

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

172

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+

173# Known Issues

119# Known Issues

174

120

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

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

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

122+ the author in ambiguous or buggy situations.

177− terminal emulator, operating system, etc.

178

123

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

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

180

125

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

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

182 unicode is used.

127 unicode is used.

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

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

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

187 particular terminal.

132 particular terminal.

188

133

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

190 appears to be limited to Linux and BSD.

135 appears to be limited to Linux and BSD.

191

136

192−# Further Reading

137+# Sources

193

138

194Good sources of documentation for terminal programming are:

139Good sources of documentation for terminal programming are:

195

140

cbits/get_tty_erase.cdeleted−18

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

1−#include <termios.h>

2−#include <stdio.h>

3−#include <unistd.h>

4−#include <stdlib.h>

5−

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

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

8−// zero.

9−char vty_get_tty_erase(int fd)

10−{

11− struct termios trm;

12−

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

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

15− } else {

16− return (char) 0;

17− }

18−}

cbits/gwinsz.c+5−14

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

1#include <sys/ioctl.h>

3unsigned long vty_c_get_window_size(int fd) {

4− struct winsize w;

4+ struct winsize w;

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

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

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

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

7− else

7+ else

8− return 0x190050;

8+ return 0x190050;

9−}

10−

11−void vty_c_set_window_size(int fd, unsigned long val) {

12− struct winsize w;

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

14− w.ws_row = val >> 16;

15− w.ws_col = val & 0xFFFF;

16− ioctl(fd, TIOCSWINSZ, &w);

17− }

18}

cbits/gwinsz.h+1−2

@@ -1,2 +1 @@

1−unsigned long vty_c_get_window_size(int fd);

1+unsigned long vty_c_get_window_size(void);

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

cbits/mk_wcwidth.c+2−136

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

60 */

62#include <HsFFI.h>

63−#include <stdlib.h>

64−#include <string.h>

65−

66−// The maximum size for a custom character width table is the total

67−// number of possible characters as dictated by the compiler.

68−#define MAX_CUSTOM_TABLE_SIZE (HS_CHAR_MAX + 1)

69−

70−// The pointer to the start of the custom character width table, if

71−// any. If this is NULL or this is set but the ready flag is false, the

72−// built-in tree search logic is used.

73−static uint8_t* custom_table = NULL;

74−

75−// The size of the custom table, in entries. This should only be set

76−// if custom_table is not NULL. Its value should be the size of the

77−// custom_table array.

78−static uint32_t custom_table_size = 0;

79−

80−// A flag indicating whether the custom table is ready for

81−// use. This should only be set once the table has been

82−// allocated with vty_init_custom_table and initialized with

83−// vty_set_custom_table_range.

84−static uint8_t custom_table_ready = 0;

86struct interval {

64struct interval {

87 int first;

65 int first;

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

141 * in ISO 10646.

119 * in ISO 10646.

142 */

120 */

143

121

144−static HsInt builtin_wcwidth(HsChar ucs)

122+HsInt vty_mk_wcwidth(HsChar ucs)

145{

123{

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

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

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

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

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

204

182

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

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

206 if (vty_bisearch(ucs, combining,

184 if (vty_bisearch(ucs, combining,

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

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

208 return 0;

186 return 0;

209

187

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

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

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

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

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

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

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

226}

204}

227−

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

229−//

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

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

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

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

234−HsInt vty_mk_wcwidth(HsChar ch)

235−{

236− if (custom_table_ready) {

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

238− return custom_table[ch];

239− } else {

240− return -1;

241− }

242− } else {

243− return builtin_wcwidth(ch);

244− }

245−}

246−

247−// Initialize a custom character width table.

248−//

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

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

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

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

253−//

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

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

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

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

258−int vty_init_custom_table(int size)

259−{

260− if (custom_table == NULL) {

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

262− custom_table_ready = 0;

263− custom_table = malloc(size);

264− memset(custom_table, 1, size);

265− custom_table_size = size;

266− return 0;

267− } else {

268− return 1;

269− }

270− } else {

271− return 1;

272− }

273−}

274−

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

276−// specified width.

277−//

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

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

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

281−//

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

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

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

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

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

287−{

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

289− (size >= custom_table_size) ||

290− (start >= custom_table_size) ||

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

292− custom_table_ready) {

293− return 1;

294− } else {

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

296− return 0;

297− }

298−}

299−

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

301−//

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

303−// fail.

304−//

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

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

307−// allocated.

308−int vty_activate_custom_table()

309−{

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

311− return 1;

312− } else {

313− custom_table_ready = 1;

314− return 0;

315− }

316−}

317−

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

319−int vty_custom_table_ready()

320−{

321− return custom_table_ready;

322−}

323−

324−// Deallocate the custom width table.

325−//

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

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

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

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

330−// leaving it in an intermediate state.

331−void vty_deallocate_custom_table()

332−{

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

334− free(custom_table);

335− custom_table = NULL;

336− custom_table_size = 0;

337− }

338−}

demos/Demo.hs+4−12

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

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

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

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

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

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

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

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

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

37 , "claims 240 colors are not supported."

36 , "claims 240 colors are not supported."

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

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

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

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

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

44 ]

43 ]

46−splitColorImages :: [Image] -> [[Image]]

47−splitColorImages [] = []

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

49−

50−fullcolorbox :: Image

51−fullcolorbox = vertCat $ map horizCat $ splitColorImages colorImages

52− where

53− colorImages = map (\i -> string (currentAttr `withBackColor` linearColor i 0 0) " ") [0..255]

54−

55colorbox_240 :: Image

45colorbox_240 :: Image

56colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages

46colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages

57 where

47 where

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

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

49+ splitColorImages [] = []

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

60colorbox_16 :: Image

52colorbox_16 :: Image

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

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

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

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

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

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

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

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

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

82 vty <- ask

74 vty <- ask

83 liftIO $ update vty pic

75 liftIO $ update vty pic

demos/ModeDemo.hs−2

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

3import Control.Applicative

4import Data.Monoid

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

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

8import Graphics.Vty

6import Graphics.Vty

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

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

14utf8FromIso = encode . map toEnum

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

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

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

18+

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

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

7import Control.Parallel.Strategies

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

10− rnf = rnf' . viewl

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

11 where

12 rnf' EmptyL = ()

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

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

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

43readParam :: Word -> Eval CapParam

44readParam pn = do

45− !params <- evalParams <$> get

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

46 return $! genericIndex params pn

48push :: CapParam -> Eval ()

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

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

66writeCapOps :: CapOps -> Eval ()

67−writeCapOps = mapM_ writeCapOp

67+writeCapOps ops = mapM_ writeCapOp ops

69writeCapOp :: CapOp -> Eval ()

70writeCapOp (Bytes !offset !count) = do

71− !cap <- evalExpression <$> get

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

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

73 Vector.forM_ bytes $ tell.writeWord8

74writeCapOp DecOut = do

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

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

1{-# LANGUAGE BangPatterns #-}

2−{-# LANGUAGE CPP #-}

2+{-# OPTIONS_HADDOCK hide #-}

3{-# LANGUAGE NoMonomorphismRestriction #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

4+{-# LANGUAGE NamedFieldPuns #-}

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

6−{-# OPTIONS_HADDOCK hide #-}

8module Data.Terminfo.Parse

7module Data.Terminfo.Parse

9 ( module Data.Terminfo.Parse

8 ( module Data.Terminfo.Parse

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

14import Control.Monad ( liftM )

13import Control.Monad ( liftM )

15import Control.DeepSeq

14import Control.DeepSeq

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

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

19−#endif

20import Data.Word

16import Data.Word

21import qualified Data.Vector.Unboxed as Vector

17import qualified Data.Vector.Unboxed as Vector

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

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

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

40 where

36 where

41 hexDump :: [Word8] -> String

37 hexDump :: [Word8] -> String

42− hexDump = foldr showHex ""

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

44instance NFData CapExpression where

40instance NFData CapExpression where

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

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

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

99 Left e -> Left e

95 Left e -> Left e

100 Right buildResults -> Right $ constructCapExpression capString buildResults

96 Right buildResults -> Right $ constructCapExpression capString buildResults

101

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

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

103constructCapExpression capString buildResults =

99constructCapExpression capString buildResults =

104 let expr = CapExpression

100 let expr = CapExpression

105 { capOps = outCapOps buildResults

101 { capOps = outCapOps buildResults

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

128literalPercentParser :: CapParser BuildResults

124literalPercentParser :: CapParser BuildResults

129literalPercentParser = do

125literalPercentParser = do

130 _ <- char '%'

126 _ <- char '%'

131− startOffset <- nextOffset <$> getState

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

132 incOffset 1

128 incOffset 1

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

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

134

130

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

154pushOpParser :: CapParser BuildResults

150pushOpParser :: CapParser BuildResults

155pushOpParser = do

151pushOpParser = do

156 _ <- char 'p'

152 _ <- char 'p'

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

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

158 incOffset 2

154 incOffset 2

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

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

160

156

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

299bytesOpParser :: CapParser BuildResults

295bytesOpParser :: CapParser BuildResults

300bytesOpParser = do

296bytesOpParser = do

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

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

302− startOffset <- nextOffset <$> getState

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

303 let !c = length bytes

299 let !c = length bytes

304 !s <- getState

300 !s <- getState

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

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

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

333 , outParamOps :: !ParamOps

329 , outParamOps :: !ParamOps

334 }

330 }

335

331

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−

344instance Monoid BuildResults where

332instance Monoid BuildResults where

345 mempty = BuildResults 0 [] []

333 mempty = BuildResults 0 [] []

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

334+ v0 `mappend` v1

347− mappend = (<>)

335+ = BuildResults

348−#endif

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

2{-# OPTIONS_GHC -D_XOPEN_SOURCE #-}

3{-# LANGUAGE ForeignFunctionInterface #-}

4−-- | This module provides functions to measure the terminal column width

5−-- of characters and strings.

6−--

7−-- The functions provided in this module all ultimately make calls to

8−-- the C implementation in @cbits/mk_wcwidth.c@. That code manages some

9−-- global state that carries a table of Unicode character widths. For

10−-- more details, see 'Graphics.Vty.UnicodeWidthTable.Install', the C

11−-- code, and the "Multi-Column Character Support" section of the project

12−-- @README@.

13module Graphics.Text.Width

4module Graphics.Text.Width

14 ( wcwidth

5 ( wcwidth

15 , wcswidth

6 , wcswidth

16− , wctwidth

17− , wctlwidth

18 , safeWcwidth

7 , safeWcwidth

19 , safeWcswidth

8 , safeWcswidth

20− , safeWctwidth

21− , safeWctlwidth

22 )

9 )

23where

10where

25−import Data.List (foldl')

26−import qualified Data.Text as T

27−import qualified Data.Text.Lazy as TL

28−

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

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

31wcswidth :: String -> Int

14wcswidth :: String -> Int

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

15+wcswidth = sum . map wcwidth

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

34−

35−wctwidth :: T.Text -> Int

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

38−wctlwidth :: TL.Text -> Int

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

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

18+--

40−

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

41−{-# RULES

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

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

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

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

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

44− #-}

23+-- width needs to be implemented.

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

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

47-- with unknown widths are 0 width.

26-- with unknown widths are 0 width.

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

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

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

52-- unknown widths are 0 width.

31-- unknown widths are 0 width.

53safeWcswidth :: String -> Int

32safeWcswidth :: String -> Int

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

33+safeWcswidth = sum . map safeWcwidth

55−

56−-- | Returns the display width of a text. Assumes all characters with

57−-- unknown widths are 0 width.

58−safeWctwidth :: T.Text -> Int

59−safeWctwidth = T.foldl' (\l c -> safeWcwidth c + l) 0

60−

61−-- | Returns the display width of a lazy text. Assumes all characters

62−-- with unknown widths are 0 width.

63−safeWctlwidth :: TL.Text -> Int

64−safeWctlwidth = TL.foldl' (\l c -> safeWcwidth c + l) 0

src/Graphics/Vty.hs+38−134

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

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE ScopedTypeVariables #-}

3−

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

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

5-- output.

2-- output.

6--

3--

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

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

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

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

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

15--

12--

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

19-- @

13-- @

20-- import "Graphics.Vty"

14-- import "Graphics.Vty"

21--

15--

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

34module Graphics.Vty

28module Graphics.Vty

35 ( Vty(..)

29 ( Vty(..)

36 , mkVty

30 , mkVty

37− , setWindowTitle

38 , Mode(..)

31 , Mode(..)

39 , module Graphics.Vty.Config

32 , module Graphics.Vty.Config

40 , module Graphics.Vty.Input

33 , module Graphics.Vty.Input

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

49import Graphics.Vty.Config

42import Graphics.Vty.Config

50import Graphics.Vty.Input

43import Graphics.Vty.Input

51−import Graphics.Vty.Input.Events

52import Graphics.Vty.Output

44import Graphics.Vty.Output

53import Graphics.Vty.Output.Interface

45import Graphics.Vty.Output.Interface

54import Graphics.Vty.Picture

46import Graphics.Vty.Picture

55import Graphics.Vty.Image

47import Graphics.Vty.Image

56import Graphics.Vty.Attributes

48import Graphics.Vty.Attributes

57−import Graphics.Vty.UnicodeWidthTable.IO

58−import Graphics.Vty.UnicodeWidthTable.Install

60−import Data.Char (isPrint, showLitChar)

61−import qualified Data.ByteString.Char8 as BS8

62−

63−import qualified Control.Exception as E

64−import Control.Monad (when)

65import Control.Concurrent.STM

50import Control.Concurrent.STM

67import Data.IORef

52import Data.IORef

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

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

53+import Data.Monoid

70−#endif

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

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

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

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

74--

57--

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

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

76--

59--

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

60+-- 1. Initialize vty

78--

61--

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

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

80--

63--

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

82--

65--

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

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

84--

67--

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

68+-- 5. Shutdown vty.

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

87--

69--

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

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

89−data Vty =

71+data Vty = Vty

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

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

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

92− , nextEvent :: IO Event

73+ update :: Picture -> IO ()

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

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

94− -- available.

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

95− , nextEventNonblocking :: IO (Maybe Event)

76+ , nextEvent :: IO Event

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

97− , inputIface :: Input

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

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

78+ , inputIface :: Input

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

99− , outputIface :: Output

80+ , outputIface :: Output

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

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

101− , refresh :: IO ()

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

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

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

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

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

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

85+ -- refresh using this function.

105− , shutdown :: IO ()

86+ , refresh :: IO ()

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

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

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

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

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

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

109− -- this is executed. Idempotent.

90+ -- executed.

110− , isShutdown :: IO Bool

91+ , shutdown :: IO ()

111− }

92+ }

112

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

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

114-- for a given terminal device.

95-- for a given terminal device.

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

121mkVty :: Config -> IO Vty

102mkVty :: Config -> IO Vty

122mkVty appConfig = do

103mkVty appConfig = do

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

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

105+ input <- inputForConfig config

106+ out <- outputForConfig config

107+ intMkVty input out

124

108

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

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

168−internalMkVty input out = do

110+intMkVty input out = do

169 reserveDisplay out

111 reserveDisplay out

170−

171− shutdownVar <- newTVarIO False

172 let shutdownIo = do

112 let shutdownIo = do

173− alreadyShutdown <- atomically $ swapTVar shutdownVar True

174− when (not alreadyShutdown) $ do

175− shutdownInput input

113+ shutdownInput input

176− releaseDisplay out

114+ releaseDisplay out

177− releaseTerminal out

115+ releaseTerminal out

178−

179− let shutdownStatus = readTVarIO shutdownVar

180−

181 lastPicRef <- newIORef Nothing

116 lastPicRef <- newIORef Nothing

182 lastUpdateRef <- newIORef Nothing

117 lastUpdateRef <- newIORef Nothing

183

118

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

209 mPic <- readIORef lastPicRef

144 mPic <- readIORef lastPicRef

210 maybe (return ()) innerUpdate mPic

145 maybe (return ()) innerUpdate mPic

211

146

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

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

219− translateInternalEvent e

220− gkey' = do

221− mEv <- atomically $ tryReadTChan $ _eventChannel input

222− case mEv of

148+ case k of

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

149+ (EvResize _ _) -> displayBounds out

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

224− Nothing -> return Nothing

151+ _ -> return k

225

152

226 return $ Vty { update = innerUpdate

153 return $ Vty { update = innerUpdate

227 , nextEvent = gkey

154 , nextEvent = gkey

228− , nextEventNonblocking = gkey'

229 , inputIface = input

155 , inputIface = input

230 , outputIface = out

156 , outputIface = out

231 , refresh = innerRefresh

157 , refresh = innerRefresh

232 , shutdown = shutdownIo

158 , shutdown = shutdownIo

233− , isShutdown = shutdownStatus

234 }

159 }

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

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

1−{-# LANGUAGE CPP #-}

1+{-# LANGUAGE StandaloneDeriving #-}

2−{-# LANGUAGE DeriveGeneric #-}

2+{-# LANGUAGE GADTs #-}

3−{-# LANGUAGE DeriveAnyClass #-}

3+{-# LANGUAGE RankNTypes #-}

5-- | Display attributes

6--

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

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

28-- output previously.

29module Graphics.Vty.Attributes

30− ( module Graphics.Vty.Attributes.Color

31−

32− , Attr(..)

30+ ( Attr(..)

33 , FixedAttr(..)

31 , FixedAttr(..)

34 , MaybeDefault(..)

32 , MaybeDefault(..)

35 , defAttr

33 , defAttr

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

39 , Style

37 , Style

40 , withStyle

38 , withStyle

41 , standout

39 , standout

42− , italic

43− , strikethrough

44 , underline

40 , underline

45 , reverseVideo

41 , reverseVideo

46 , blink

42 , blink

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

54 , withForeColor

50 , withForeColor

55 , withBackColor

51 , withBackColor

57− -- * Setting hyperlinks

53+ -- * Colors

58− , withURL

54+ , module Graphics.Vty.Attributes.Color

55+ , module Graphics.Vty.Attributes.Color240

59 )

56 )

60where

57where

62−import Control.DeepSeq

63import Data.Bits

59import Data.Bits

64−import Data.Text (Text)

65import Data.Word

60import Data.Word

66−import GHC.Generics

68import Graphics.Vty.Attributes.Color

62import Graphics.Vty.Attributes.Color

63+import Graphics.Vty.Attributes.Color240

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

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

71-- characters rendered after the attribute is applied.

66-- characters rendered after the attribute is applied.

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

78 { attrStyle :: !(MaybeDefault Style)

73 { attrStyle :: !(MaybeDefault Style)

79 , attrForeColor :: !(MaybeDefault Color)

74 , attrForeColor :: !(MaybeDefault Color)

80 , attrBackColor :: !(MaybeDefault Color)

75 , attrBackColor :: !(MaybeDefault Color)

81− , attrURL :: !(MaybeDefault Text)

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

76+ } deriving ( Eq, Show, Read )

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

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

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

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

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

100-- __ - unused

94-- __ - unused

101--

95--

102-- Next is the style flags

96-- Next is the style flags

103−-- SURBDOI_

97+-- SURBDO__

104-- S - standout

98-- S - standout

105-- U - underline

99-- U - underline

106-- R - reverse video

100-- R - reverse video

107-- B - blink

101-- B - blink

108-- D - dim

102-- D - dim

109-- O - bold

103-- O - bold

110−-- I - italic

111−-- _ - unused

104+-- __ - unused

112--

105--

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

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

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

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

115

108

109+instance Monoid Attr where

110+ mempty = Attr mempty mempty mempty

111+ mappend attr0 attr1 =

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

113+ ( attrForeColor attr0 `mappend` attrForeColor attr1 )

114+ ( attrBackColor attr0 `mappend` attrBackColor attr1 )

115+

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

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

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

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

121 { fixedStyle :: !Style

122 , fixedForeColor :: !(Maybe Color)

123 , fixedBackColor :: !(Maybe Color)

124− , fixedURL :: !(Maybe Text)

125 } deriving ( Eq, Show )

124 } deriving ( Eq, Show )

126

125

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

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

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

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

129-- value.

128-- value.

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

129+data MaybeDefault v where

131− deriving (Eq, Read, Show)

130+ Default :: MaybeDefault v

132−

131+ KeepCurrent :: MaybeDefault v

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

133+

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

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

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

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

134− rnf Default = ()

137+

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

139+ mempty = KeepCurrent

140+ mappend Default Default = Default

141+ mappend Default KeepCurrent = Default

142+ mappend Default ( SetTo v ) = SetTo v

135− rnf KeepCurrent = ()

143+ mappend KeepCurrent Default = Default

136− rnf (SetTo v) = rnf v

144+ mappend KeepCurrent KeepCurrent = KeepCurrent

145+ mappend KeepCurrent ( SetTo v ) = SetTo v

146+ mappend ( SetTo _v ) Default = Default

147+ mappend ( SetTo v ) KeepCurrent = SetTo v

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

137

149

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

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

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

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

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

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

141type Style = Word8

153type Style = Word8

142

154

143−-- | Valid style attributes include:

155+-- | The 6 possible style attributes:

144--

156--

145-- * standout

157-- * standout

146--

158--

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

154--

166--

155-- * bold/bright

167-- * bold/bright

156--

168--

157−-- * italic

158−--

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

160−--

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

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

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

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

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

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

164standout = 0x01

172standout = 0x01

165underline = 0x02

173underline = 0x02

166−reverseVideo = 0x04

174+reverseVideo = 0x04

167blink = 0x08

175blink = 0x08

168dim = 0x10

176dim = 0x10

169bold = 0x20

177bold = 0x20

170−italic = 0x40

171−strikethrough = 0x80

172

178

173defaultStyleMask :: Style

179defaultStyleMask :: Style

174defaultStyleMask = 0x00

180defaultStyleMask = 0x00

@@ -197,25 +203,11 @@ withStyle :: Attr -> Style -> Attr

197withStyle attr 0 = attr

203withStyle attr 0 = attr

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

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

199

205

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

201−-- hyperlinked

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

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

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

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

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

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

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

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

210−-- interface.

211−withURL :: Attr -> Text -> Attr

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

213−

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

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

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

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

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

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

217defAttr :: Attr

209defAttr :: Attr

218−defAttr = Attr Default Default Default Default

210+defAttr = Attr Default Default Default

219

211

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

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

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

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

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

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

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

226-- with the foreground color set to brightMagenta.

218-- with the foreground color set to brightMagenta.

227currentAttr :: Attr

219currentAttr :: Attr

228−currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent KeepCurrent

220+currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent

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

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

1−{-# LANGUAGE DeriveGeneric #-}

2−{-# LANGUAGE DeriveAnyClass #-}

3−{-# LANGUAGE MultiWayIf #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

5−

6module Graphics.Vty.Attributes.Color

1module Graphics.Vty.Attributes.Color

7 ( Color(..)

2 ( Color(..)

8− , ColorMode(..)

9−

10− -- * Detecting Terminal Color Support

11− , detectColorMode

12−

13− -- ** Fixed Colors

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

15− --

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

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

18− -- white.

19− --

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

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

22 , black

3 , black

23 , red

4 , red

24 , green

5 , green

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

27 , magenta

8 , magenta

28 , cyan

9 , cyan

29 , white

10 , white

30−

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

32 , brightBlack

11 , brightBlack

33 , brightRed

12 , brightRed

34 , brightGreen

13 , brightGreen

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

37 , brightMagenta

16 , brightMagenta

38 , brightCyan

17 , brightCyan

39 , brightWhite

18 , brightWhite

40− -- ** Creating Colors From RGB

41− , linearColor

42− , srgbColor

43− , rgbColor

44− , color240

45− , module Graphics.Vty.Attributes.Color240

46 )

19 )

47where

20where

49import Data.Word

22import Data.Word

50−import GHC.Generics

51−import Control.DeepSeq

52−import System.Environment (lookupEnv)

53−

54−import qualified System.Console.Terminfo as Terminfo

55−import Control.Exception (catch)

56−import Data.Maybe

57−

58−import Graphics.Vty.Attributes.Color240

60-- | Abstract data type representing a color.

24-- | Abstract data type representing a color.

61--

25--

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

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

59-- reported then the color reproduction will be incorrect.

96--

60--

97-- If the terminal reports <= 16 colors then the 240 color palette

61-- If the terminal reports <= 16 colors then the 240 color palette

98−-- points are only mapped to the 8 color palette. I'm not sure of

62+-- points are only mapped to the 8 color pallete. I'm not sure of

99-- the RGB points for the "bright" colors which is why they are not

63-- the RGB points for the "bright" colors which is why they are not

100-- addressable via the 240 color palette.

64-- addressable via the 240 color palette.

101--

65--

@@ -109,33 +73,10 @@ import Graphics.Vty.Attributes.Color240

109-- terminfo but I don't know it.

73-- terminfo but I don't know it.

110--

74--

111-- Seriously, terminal color support is INSANE.

75-- Seriously, terminal color support is INSANE.

112−data Color = ISOColor !Word8 | Color240 !Word8 | RGBColor !Word8 !Word8 !Word8

76+data Color = ISOColor !Word8 | Color240 !Word8

113− deriving ( Eq, Show, Read, Generic, NFData )

77+ deriving ( Eq, Show, Read )

114−

115−data ColorMode

116− = NoColor

117− | ColorMode8

118− | ColorMode16

119− | ColorMode240 !Word8

120− | FullColor

121− deriving ( Eq, Show )

122−

123−detectColorMode :: String -> IO ColorMode

124−detectColorMode termName' = do

125− term <- catch (Just <$> Terminfo.setupTerm termName')

126− (\(_ :: Terminfo.SetupTermError) -> return Nothing)

127− let getCap cap = term >>= \t -> Terminfo.getCapability t cap

128− termColors = fromMaybe 0 $ getCap (Terminfo.tiGetNum "colors")

129− colorterm <- lookupEnv "COLORTERM"

130− return $ if

131− | termColors < 8 -> NoColor

132− | termColors < 16 -> ColorMode8

133− | termColors == 16 -> ColorMode16

134− | termColors < 256 -> ColorMode240 (fromIntegral termColors - 16)

135− | colorterm == Just "truecolor" -> FullColor

136− | colorterm == Just "24bit" -> FullColor

137− | otherwise -> ColorMode240 240

138

79+-- | Standard 8-color ANSI terminal color codes.

139black, red, green, yellow, blue, magenta, cyan, white :: Color

80black, red, green, yellow, blue, magenta, cyan, white :: Color

140black = ISOColor 0

81black = ISOColor 0

141red = ISOColor 1

82red = ISOColor 1

@@ -146,6 +87,7 @@ magenta= ISOColor 5

146cyan = ISOColor 6

87cyan = ISOColor 6

147white = ISOColor 7

88white = ISOColor 7

148

90+-- | Bright/Vivid variants of the standard 8-color ANSI

149brightBlack, brightRed, brightGreen, brightYellow :: Color

91brightBlack, brightRed, brightGreen, brightYellow :: Color

150brightBlue, brightMagenta, brightCyan, brightWhite :: Color

92brightBlue, brightMagenta, brightCyan, brightWhite :: Color

151brightBlack = ISOColor 8

93brightBlack = ISOColor 8

@@ -156,36 +98,3 @@ brightBlue = ISOColor 12

156brightMagenta= ISOColor 13

98brightMagenta= ISOColor 13

157brightCyan = ISOColor 14

99brightCyan = ISOColor 14

158brightWhite = ISOColor 15

100brightWhite = ISOColor 15

159−

160−linearColor :: Integral i => i -> i -> i -> Color

161−linearColor r g b = RGBColor r' g' b'

162− where

163− r' = fromIntegral (clamp r) :: Word8

164− g' = fromIntegral (clamp g) :: Word8

165− b' = fromIntegral (clamp b) :: Word8

166− clamp = min 255 . max 0

167−

168−srgbColor :: Integral i => i -> i -> i -> Color

169−srgbColor r g b =

170− -- srgb to rgb transformation as described at

171− -- https://en.wikipedia.org/wiki/SRGB#The_reverse_transformation

172− --

173− -- TODO: it may be worth translating this to a lookup table, as with color240

174− let shrink n = fromIntegral n / 255 :: Double

175− -- called gamma^-1 in wiki

176− gamma u

177− | u <= 0.04045 = u/12.92

178− | otherwise = ((u + 0.055) / 1.055) ** 2.4

179− -- TODO: this is a slightly inaccurate conversion. is it worth doing proterly?

180− expand n = round (255 * n)

181− convert = expand . gamma . shrink

182− in RGBColor (convert r) (convert g) (convert b)

183−

184−color240 :: Integral i => i -> i -> i -> Color

185−color240 r g b = Color240 (rgbColorToColor240 r g b)

186−

187−-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.

188−-- This function is lossy in the sense that we only internally support 240 colors but the

189−-- #RRGGBB format supports 16^3 colors.

190−rgbColor :: Integral i => i -> i -> i -> Color

191−rgbColor = color240

src/Graphics/Vty/Attributes/Color240.hs+248−285

@@ -1,298 +1,261 @@

1-- This header file was generated by ./256colres.pl

2module Graphics.Vty.Attributes.Color240

3− ( rgbColorToColor240

3+ ( rgbColor

4− , color240CodeToRGB

5 )

4 )

6where

5where

8−import Data.Word (Word8)

7+import Graphics.Vty.Attributes.Color

9import Text.Printf

11-- Note: rgbColor's mapping from RGB to 240 colors was generated from

12-- 256colres.pl which is forked from xterm 256colres.pl.

14−-- | Create a value in the Color240 set from an RGB triple

14+-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.

15−rgbColorToColor240 :: Integral i => i -> i -> i -> Word8

15+rgbColor :: Integral i => i -> i -> i -> Color

16−rgbColorToColor240 r g b

16+rgbColor r g b

17 | r < 0 && g < 0 && b < 0 = error "rgbColor with negative color component intensity"

18− | r == 8 && g == 8 && b == 8 = 216

18+ | r == 8 && g == 8 && b == 8 = Color240 216

19− | r == 18 && g == 18 && b == 18 = 217

19+ | r == 18 && g == 18 && b == 18 = Color240 217

20− | r == 28 && g == 28 && b == 28 = 218

20+ | r == 28 && g == 28 && b == 28 = Color240 218

21− | r == 38 && g == 38 && b == 38 = 219

21+ | r == 38 && g == 38 && b == 38 = Color240 219

22− | r == 48 && g == 48 && b == 48 = 220

22+ | r == 48 && g == 48 && b == 48 = Color240 220

23− | r == 58 && g == 58 && b == 58 = 221

23+ | r == 58 && g == 58 && b == 58 = Color240 221

24− | r == 68 && g == 68 && b == 68 = 222

24+ | r == 68 && g == 68 && b == 68 = Color240 222

25− | r == 78 && g == 78 && b == 78 = 223

25+ | r == 78 && g == 78 && b == 78 = Color240 223

26− | r == 88 && g == 88 && b == 88 = 224

26+ | r == 88 && g == 88 && b == 88 = Color240 224

27− | r == 98 && g == 98 && b == 98 = 225

27+ | r == 98 && g == 98 && b == 98 = Color240 225

28− | r == 108 && g == 108 && b == 108 = 226

28+ | r == 108 && g == 108 && b == 108 = Color240 226

29− | r == 118 && g == 118 && b == 118 = 227

29+ | r == 118 && g == 118 && b == 118 = Color240 227

30− | r == 128 && g == 128 && b == 128 = 228

30+ | r == 128 && g == 128 && b == 128 = Color240 228

31− | r == 138 && g == 138 && b == 138 = 229

31+ | r == 138 && g == 138 && b == 138 = Color240 229

32− | r == 148 && g == 148 && b == 148 = 230

32+ | r == 148 && g == 148 && b == 148 = Color240 230

33− | r == 158 && g == 158 && b == 158 = 231

33+ | r == 158 && g == 158 && b == 158 = Color240 231

34− | r == 168 && g == 168 && b == 168 = 232

34+ | r == 168 && g == 168 && b == 168 = Color240 232

35− | r == 178 && g == 178 && b == 178 = 233

35+ | r == 178 && g == 178 && b == 178 = Color240 233

36− | r == 188 && g == 188 && b == 188 = 234

36+ | r == 188 && g == 188 && b == 188 = Color240 234

37− | r == 198 && g == 198 && b == 198 = 235

37+ | r == 198 && g == 198 && b == 198 = Color240 235

38− | r == 208 && g == 208 && b == 208 = 236

38+ | r == 208 && g == 208 && b == 208 = Color240 236

39− | r == 218 && g == 218 && b == 218 = 237

39+ | r == 218 && g == 218 && b == 218 = Color240 237

40− | r == 228 && g == 228 && b == 228 = 238

40+ | r == 228 && g == 228 && b == 228 = Color240 238

41− | r == 238 && g == 238 && b == 238 = 239

41+ | r == 238 && g == 238 && b == 238 = Color240 239

42− | otherwise = 36 * go r + 6 * go g + go b

42+ | r <= 0 && g <= 0 && b <= 0 = Color240 0

43− where go = simpleColor_ (error (printf "RGB color %d %d %d does not map to 240 palette."

43+ | r <= 0 && g <= 0 && b <= 95 = Color240 1

44+ | r <= 0 && g <= 0 && b <= 135 = Color240 2

45+ | r <= 0 && g <= 0 && b <= 175 = Color240 3

46+ | r <= 0 && g <= 0 && b <= 215 = Color240 4

47+ | r <= 0 && g <= 0 && b <= 255 = Color240 5

48+ | r <= 0 && g <= 95 && b <= 0 = Color240 6

49+ | r <= 0 && g <= 95 && b <= 95 = Color240 7

50+ | r <= 0 && g <= 95 && b <= 135 = Color240 8

51+ | r <= 0 && g <= 95 && b <= 175 = Color240 9

52+ | r <= 0 && g <= 95 && b <= 215 = Color240 10

53+ | r <= 0 && g <= 95 && b <= 255 = Color240 11

54+ | r <= 0 && g <= 135 && b <= 0 = Color240 12

55+ | r <= 0 && g <= 135 && b <= 95 = Color240 13

56+ | r <= 0 && g <= 135 && b <= 135 = Color240 14

57+ | r <= 0 && g <= 135 && b <= 175 = Color240 15

58+ | r <= 0 && g <= 135 && b <= 215 = Color240 16

59+ | r <= 0 && g <= 135 && b <= 255 = Color240 17

60+ | r <= 0 && g <= 175 && b <= 0 = Color240 18

61+ | r <= 0 && g <= 175 && b <= 95 = Color240 19

62+ | r <= 0 && g <= 175 && b <= 135 = Color240 20

63+ | r <= 0 && g <= 175 && b <= 175 = Color240 21

64+ | r <= 0 && g <= 175 && b <= 215 = Color240 22

65+ | r <= 0 && g <= 175 && b <= 255 = Color240 23

66+ | r <= 0 && g <= 215 && b <= 0 = Color240 24

67+ | r <= 0 && g <= 215 && b <= 95 = Color240 25

68+ | r <= 0 && g <= 215 && b <= 135 = Color240 26

69+ | r <= 0 && g <= 215 && b <= 175 = Color240 27

70+ | r <= 0 && g <= 215 && b <= 215 = Color240 28

71+ | r <= 0 && g <= 215 && b <= 255 = Color240 29

72+ | r <= 0 && g <= 255 && b <= 0 = Color240 30

73+ | r <= 0 && g <= 255 && b <= 95 = Color240 31

74+ | r <= 0 && g <= 255 && b <= 135 = Color240 32

75+ | r <= 0 && g <= 255 && b <= 175 = Color240 33

76+ | r <= 0 && g <= 255 && b <= 215 = Color240 34

77+ | r <= 0 && g <= 255 && b <= 255 = Color240 35

78+ | r <= 95 && g <= 0 && b <= 0 = Color240 36

79+ | r <= 95 && g <= 0 && b <= 95 = Color240 37

80+ | r <= 95 && g <= 0 && b <= 135 = Color240 38

81+ | r <= 95 && g <= 0 && b <= 175 = Color240 39

82+ | r <= 95 && g <= 0 && b <= 215 = Color240 40

83+ | r <= 95 && g <= 0 && b <= 255 = Color240 41

84+ | r <= 95 && g <= 95 && b <= 0 = Color240 42

85+ | r <= 95 && g <= 95 && b <= 95 = Color240 43

86+ | r <= 95 && g <= 95 && b <= 135 = Color240 44

87+ | r <= 95 && g <= 95 && b <= 175 = Color240 45

88+ | r <= 95 && g <= 95 && b <= 215 = Color240 46

89+ | r <= 95 && g <= 95 && b <= 255 = Color240 47

90+ | r <= 95 && g <= 135 && b <= 0 = Color240 48

91+ | r <= 95 && g <= 135 && b <= 95 = Color240 49

92+ | r <= 95 && g <= 135 && b <= 135 = Color240 50

93+ | r <= 95 && g <= 135 && b <= 175 = Color240 51

94+ | r <= 95 && g <= 135 && b <= 215 = Color240 52

95+ | r <= 95 && g <= 135 && b <= 255 = Color240 53

96+ | r <= 95 && g <= 175 && b <= 0 = Color240 54

97+ | r <= 95 && g <= 175 && b <= 95 = Color240 55

98+ | r <= 95 && g <= 175 && b <= 135 = Color240 56

99+ | r <= 95 && g <= 175 && b <= 175 = Color240 57

100+ | r <= 95 && g <= 175 && b <= 215 = Color240 58

101+ | r <= 95 && g <= 175 && b <= 255 = Color240 59

102+ | r <= 95 && g <= 215 && b <= 0 = Color240 60

103+ | r <= 95 && g <= 215 && b <= 95 = Color240 61

104+ | r <= 95 && g <= 215 && b <= 135 = Color240 62

105+ | r <= 95 && g <= 215 && b <= 175 = Color240 63

106+ | r <= 95 && g <= 215 && b <= 215 = Color240 64

107+ | r <= 95 && g <= 215 && b <= 255 = Color240 65

108+ | r <= 95 && g <= 255 && b <= 0 = Color240 66

109+ | r <= 95 && g <= 255 && b <= 95 = Color240 67

110+ | r <= 95 && g <= 255 && b <= 135 = Color240 68

111+ | r <= 95 && g <= 255 && b <= 175 = Color240 69

112+ | r <= 95 && g <= 255 && b <= 215 = Color240 70

113+ | r <= 95 && g <= 255 && b <= 255 = Color240 71

114+ | r <= 135 && g <= 0 && b <= 0 = Color240 72

115+ | r <= 135 && g <= 0 && b <= 95 = Color240 73

116+ | r <= 135 && g <= 0 && b <= 135 = Color240 74

117+ | r <= 135 && g <= 0 && b <= 175 = Color240 75

118+ | r <= 135 && g <= 0 && b <= 215 = Color240 76

119+ | r <= 135 && g <= 0 && b <= 255 = Color240 77

120+ | r <= 135 && g <= 95 && b <= 0 = Color240 78

121+ | r <= 135 && g <= 95 && b <= 95 = Color240 79

122+ | r <= 135 && g <= 95 && b <= 135 = Color240 80

123+ | r <= 135 && g <= 95 && b <= 175 = Color240 81

124+ | r <= 135 && g <= 95 && b <= 215 = Color240 82

125+ | r <= 135 && g <= 95 && b <= 255 = Color240 83

126+ | r <= 135 && g <= 135 && b <= 0 = Color240 84

127+ | r <= 135 && g <= 135 && b <= 95 = Color240 85

128+ | r <= 135 && g <= 135 && b <= 135 = Color240 86

129+ | r <= 135 && g <= 135 && b <= 175 = Color240 87

130+ | r <= 135 && g <= 135 && b <= 215 = Color240 88

131+ | r <= 135 && g <= 135 && b <= 255 = Color240 89

132+ | r <= 135 && g <= 175 && b <= 0 = Color240 90

133+ | r <= 135 && g <= 175 && b <= 95 = Color240 91

134+ | r <= 135 && g <= 175 && b <= 135 = Color240 92

135+ | r <= 135 && g <= 175 && b <= 175 = Color240 93

136+ | r <= 135 && g <= 175 && b <= 215 = Color240 94

137+ | r <= 135 && g <= 175 && b <= 255 = Color240 95

138+ | r <= 135 && g <= 215 && b <= 0 = Color240 96

139+ | r <= 135 && g <= 215 && b <= 95 = Color240 97

140+ | r <= 135 && g <= 215 && b <= 135 = Color240 98

141+ | r <= 135 && g <= 215 && b <= 175 = Color240 99

142+ | r <= 135 && g <= 215 && b <= 215 = Color240 100

143+ | r <= 135 && g <= 215 && b <= 255 = Color240 101

144+ | r <= 135 && g <= 255 && b <= 0 = Color240 102

145+ | r <= 135 && g <= 255 && b <= 95 = Color240 103

146+ | r <= 135 && g <= 255 && b <= 135 = Color240 104

147+ | r <= 135 && g <= 255 && b <= 175 = Color240 105

148+ | r <= 135 && g <= 255 && b <= 215 = Color240 106

149+ | r <= 135 && g <= 255 && b <= 255 = Color240 107

150+ | r <= 175 && g <= 0 && b <= 0 = Color240 108

151+ | r <= 175 && g <= 0 && b <= 95 = Color240 109

152+ | r <= 175 && g <= 0 && b <= 135 = Color240 110

153+ | r <= 175 && g <= 0 && b <= 175 = Color240 111

154+ | r <= 175 && g <= 0 && b <= 215 = Color240 112

155+ | r <= 175 && g <= 0 && b <= 255 = Color240 113

156+ | r <= 175 && g <= 95 && b <= 0 = Color240 114

157+ | r <= 175 && g <= 95 && b <= 95 = Color240 115

158+ | r <= 175 && g <= 95 && b <= 135 = Color240 116

159+ | r <= 175 && g <= 95 && b <= 175 = Color240 117

160+ | r <= 175 && g <= 95 && b <= 215 = Color240 118

161+ | r <= 175 && g <= 95 && b <= 255 = Color240 119

162+ | r <= 175 && g <= 135 && b <= 0 = Color240 120

163+ | r <= 175 && g <= 135 && b <= 95 = Color240 121

164+ | r <= 175 && g <= 135 && b <= 135 = Color240 122

165+ | r <= 175 && g <= 135 && b <= 175 = Color240 123

166+ | r <= 175 && g <= 135 && b <= 215 = Color240 124

167+ | r <= 175 && g <= 135 && b <= 255 = Color240 125

168+ | r <= 175 && g <= 175 && b <= 0 = Color240 126

169+ | r <= 175 && g <= 175 && b <= 95 = Color240 127

170+ | r <= 175 && g <= 175 && b <= 135 = Color240 128

171+ | r <= 175 && g <= 175 && b <= 175 = Color240 129

172+ | r <= 175 && g <= 175 && b <= 215 = Color240 130

173+ | r <= 175 && g <= 175 && b <= 255 = Color240 131

174+ | r <= 175 && g <= 215 && b <= 0 = Color240 132

175+ | r <= 175 && g <= 215 && b <= 95 = Color240 133

176+ | r <= 175 && g <= 215 && b <= 135 = Color240 134

177+ | r <= 175 && g <= 215 && b <= 175 = Color240 135

178+ | r <= 175 && g <= 215 && b <= 215 = Color240 136

179+ | r <= 175 && g <= 215 && b <= 255 = Color240 137

180+ | r <= 175 && g <= 255 && b <= 0 = Color240 138

181+ | r <= 175 && g <= 255 && b <= 95 = Color240 139

182+ | r <= 175 && g <= 255 && b <= 135 = Color240 140

183+ | r <= 175 && g <= 255 && b <= 175 = Color240 141

184+ | r <= 175 && g <= 255 && b <= 215 = Color240 142

185+ | r <= 175 && g <= 255 && b <= 255 = Color240 143

186+ | r <= 215 && g <= 0 && b <= 0 = Color240 144

187+ | r <= 215 && g <= 0 && b <= 95 = Color240 145

188+ | r <= 215 && g <= 0 && b <= 135 = Color240 146

189+ | r <= 215 && g <= 0 && b <= 175 = Color240 147

190+ | r <= 215 && g <= 0 && b <= 215 = Color240 148

191+ | r <= 215 && g <= 0 && b <= 255 = Color240 149

192+ | r <= 215 && g <= 95 && b <= 0 = Color240 150

193+ | r <= 215 && g <= 95 && b <= 95 = Color240 151

194+ | r <= 215 && g <= 95 && b <= 135 = Color240 152

195+ | r <= 215 && g <= 95 && b <= 175 = Color240 153

196+ | r <= 215 && g <= 95 && b <= 215 = Color240 154

197+ | r <= 215 && g <= 95 && b <= 255 = Color240 155

198+ | r <= 215 && g <= 135 && b <= 0 = Color240 156

199+ | r <= 215 && g <= 135 && b <= 95 = Color240 157

200+ | r <= 215 && g <= 135 && b <= 135 = Color240 158

201+ | r <= 215 && g <= 135 && b <= 175 = Color240 159

202+ | r <= 215 && g <= 135 && b <= 215 = Color240 160

203+ | r <= 215 && g <= 135 && b <= 255 = Color240 161

204+ | r <= 215 && g <= 175 && b <= 0 = Color240 162

205+ | r <= 215 && g <= 175 && b <= 95 = Color240 163

206+ | r <= 215 && g <= 175 && b <= 135 = Color240 164

207+ | r <= 215 && g <= 175 && b <= 175 = Color240 165

208+ | r <= 215 && g <= 175 && b <= 215 = Color240 166

209+ | r <= 215 && g <= 175 && b <= 255 = Color240 167

210+ | r <= 215 && g <= 215 && b <= 0 = Color240 168

211+ | r <= 215 && g <= 215 && b <= 95 = Color240 169

212+ | r <= 215 && g <= 215 && b <= 135 = Color240 170

213+ | r <= 215 && g <= 215 && b <= 175 = Color240 171

214+ | r <= 215 && g <= 215 && b <= 215 = Color240 172

215+ | r <= 215 && g <= 215 && b <= 255 = Color240 173

216+ | r <= 215 && g <= 255 && b <= 0 = Color240 174

217+ | r <= 215 && g <= 255 && b <= 95 = Color240 175

218+ | r <= 215 && g <= 255 && b <= 135 = Color240 176

219+ | r <= 215 && g <= 255 && b <= 175 = Color240 177

220+ | r <= 215 && g <= 255 && b <= 215 = Color240 178

221+ | r <= 215 && g <= 255 && b <= 255 = Color240 179

222+ | r <= 255 && g <= 0 && b <= 0 = Color240 180

223+ | r <= 255 && g <= 0 && b <= 95 = Color240 181

224+ | r <= 255 && g <= 0 && b <= 135 = Color240 182

225+ | r <= 255 && g <= 0 && b <= 175 = Color240 183

226+ | r <= 255 && g <= 0 && b <= 215 = Color240 184

227+ | r <= 255 && g <= 0 && b <= 255 = Color240 185

228+ | r <= 255 && g <= 95 && b <= 0 = Color240 186

229+ | r <= 255 && g <= 95 && b <= 95 = Color240 187

230+ | r <= 255 && g <= 95 && b <= 135 = Color240 188

231+ | r <= 255 && g <= 95 && b <= 175 = Color240 189

232+ | r <= 255 && g <= 95 && b <= 215 = Color240 190

233+ | r <= 255 && g <= 95 && b <= 255 = Color240 191

234+ | r <= 255 && g <= 135 && b <= 0 = Color240 192

235+ | r <= 255 && g <= 135 && b <= 95 = Color240 193

236+ | r <= 255 && g <= 135 && b <= 135 = Color240 194

237+ | r <= 255 && g <= 135 && b <= 175 = Color240 195

238+ | r <= 255 && g <= 135 && b <= 215 = Color240 196

239+ | r <= 255 && g <= 135 && b <= 255 = Color240 197

240+ | r <= 255 && g <= 175 && b <= 0 = Color240 198

241+ | r <= 255 && g <= 175 && b <= 95 = Color240 199

242+ | r <= 255 && g <= 175 && b <= 135 = Color240 200

243+ | r <= 255 && g <= 175 && b <= 175 = Color240 201

244+ | r <= 255 && g <= 175 && b <= 215 = Color240 202

245+ | r <= 255 && g <= 175 && b <= 255 = Color240 203

246+ | r <= 255 && g <= 215 && b <= 0 = Color240 204

247+ | r <= 255 && g <= 215 && b <= 95 = Color240 205

248+ | r <= 255 && g <= 215 && b <= 135 = Color240 206

249+ | r <= 255 && g <= 215 && b <= 175 = Color240 207

250+ | r <= 255 && g <= 215 && b <= 215 = Color240 208

251+ | r <= 255 && g <= 215 && b <= 255 = Color240 209

252+ | r <= 255 && g <= 255 && b <= 0 = Color240 210

253+ | r <= 255 && g <= 255 && b <= 95 = Color240 211

254+ | r <= 255 && g <= 255 && b <= 135 = Color240 212

255+ | r <= 255 && g <= 255 && b <= 175 = Color240 213

256+ | r <= 255 && g <= 255 && b <= 215 = Color240 214

257+ | r <= 255 && g <= 255 && b <= 255 = Color240 215

258+ | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."

44 (fromIntegral r :: Int)

259 (fromIntegral r :: Int)

45 (fromIntegral g :: Int)

260 (fromIntegral g :: Int)

46− (fromIntegral b :: Int)))

261+ (fromIntegral b :: Int))

47−

48−simpleColor_ :: Integral i => Word8 -> i -> Word8

49−simpleColor_ e c

50− | c <= 0 = 0

51− | c <= 95 = 1

52− | c <= 255 = fromIntegral ((c-16) `div` 40)

53− | otherwise = e

54−

55−-- | Create a RGB triple from a value in the Color240 set.

56−color240CodeToRGB :: Word8 -> Maybe (Int, Int, Int)

57−color240CodeToRGB n = case n of

58− 0 -> Just (0, 0, 0)

59− 1 -> Just (0, 0, 95)

60− 2 -> Just (0, 0, 135)

61− 3 -> Just (0, 0, 175)

62− 4 -> Just (0, 0, 215)

63− 5 -> Just (0, 0, 255)

64− 6 -> Just (0, 95, 0)

65− 7 -> Just (0, 95, 95)

66− 8 -> Just (0, 95, 135)

67− 9 -> Just (0, 95, 175)

68− 10 -> Just (0, 95, 215)

69− 11 -> Just (0, 95, 255)

70− 12 -> Just (0, 135, 0)

71− 13 -> Just (0, 135, 95)

72− 14 -> Just (0, 135, 135)

73− 15 -> Just (0, 135, 175)

74− 16 -> Just (0, 135, 215)

75− 17 -> Just (0, 135, 255)

76− 18 -> Just (0, 175, 0)

77− 19 -> Just (0, 175, 95)

78− 20 -> Just (0, 175, 135)

79− 21 -> Just (0, 175, 175)

80− 22 -> Just (0, 175, 215)

81− 23 -> Just (0, 175, 255)

82− 24 -> Just (0, 215, 0)

83− 25 -> Just (0, 215, 95)

84− 26 -> Just (0, 215, 135)

85− 27 -> Just (0, 215, 175)

86− 28 -> Just (0, 215, 215)

87− 29 -> Just (0, 215, 255)

88− 30 -> Just (0, 255, 0)

89− 31 -> Just (0, 255, 95)

90− 32 -> Just (0, 255, 135)

91− 33 -> Just (0, 255, 175)

92− 34 -> Just (0, 255, 215)

93− 35 -> Just (0, 255, 255)

94− 36 -> Just (95, 0, 0)

95− 37 -> Just (95, 0, 95)

96− 38 -> Just (95, 0, 135)

97− 39 -> Just (95, 0, 175)

98− 40 -> Just (95, 0, 215)

99− 41 -> Just (95, 0, 255)

100− 42 -> Just (95, 95, 0)

101− 43 -> Just (95, 95, 95)

102− 44 -> Just (95, 95, 135)

103− 45 -> Just (95, 95, 175)

104− 46 -> Just (95, 95, 215)

105− 47 -> Just (95, 95, 255)

106− 48 -> Just (95, 135, 0)

107− 49 -> Just (95, 135, 95)

108− 50 -> Just (95, 135, 135)

109− 51 -> Just (95, 135, 175)

110− 52 -> Just (95, 135, 215)

111− 53 -> Just (95, 135, 255)

112− 54 -> Just (95, 175, 0)

113− 55 -> Just (95, 175, 95)

114− 56 -> Just (95, 175, 135)

115− 57 -> Just (95, 175, 175)

116− 58 -> Just (95, 175, 215)

117− 59 -> Just (95, 175, 255)

118− 60 -> Just (95, 215, 0)

119− 61 -> Just (95, 215, 95)

120− 62 -> Just (95, 215, 135)

121− 63 -> Just (95, 215, 175)

122− 64 -> Just (95, 215, 215)

123− 65 -> Just (95, 215, 255)

124− 66 -> Just (95, 255, 0)

125− 67 -> Just (95, 255, 95)

126− 68 -> Just (95, 255, 135)

127− 69 -> Just (95, 255, 175)

128− 70 -> Just (95, 255, 215)

129− 71 -> Just (95, 255, 255)

130− 72 -> Just (135, 0, 0)

131− 73 -> Just (135, 0, 95)

132− 74 -> Just (135, 0, 135)

133− 75 -> Just (135, 0, 175)

134− 76 -> Just (135, 0, 215)

135− 77 -> Just (135, 0, 255)

136− 78 -> Just (135, 95, 0)

137− 79 -> Just (135, 95, 95)

138− 80 -> Just (135, 95, 135)

139− 81 -> Just (135, 95, 175)

140− 82 -> Just (135, 95, 215)

141− 83 -> Just (135, 95, 255)

142− 84 -> Just (135, 135, 0)

143− 85 -> Just (135, 135, 95)

144− 86 -> Just (135, 135, 135)

145− 87 -> Just (135, 135, 175)

146− 88 -> Just (135, 135, 215)

147− 89 -> Just (135, 135, 255)

148− 90 -> Just (135, 175, 0)

149− 91 -> Just (135, 175, 95)

150− 92 -> Just (135, 175, 135)

151− 93 -> Just (135, 175, 175)

152− 94 -> Just (135, 175, 215)

153− 95 -> Just (135, 175, 255)

154− 96 -> Just (135, 215, 0)

155− 97 -> Just (135, 215, 95)

156− 98 -> Just (135, 215, 135)

157− 99 -> Just (135, 215, 175)

158− 100 -> Just (135, 215, 215)

159− 101 -> Just (135, 215, 255)

160− 102 -> Just (135, 255, 0)

161− 103 -> Just (135, 255, 95)

162− 104 -> Just (135, 255, 135)

163− 105 -> Just (135, 255, 175)

164− 106 -> Just (135, 255, 215)

165− 107 -> Just (135, 255, 255)

166− 108 -> Just (175, 0, 0)

167− 109 -> Just (175, 0, 95)

168− 110 -> Just (175, 0, 135)

169− 111 -> Just (175, 0, 175)

170− 112 -> Just (175, 0, 215)

171− 113 -> Just (175, 0, 255)

172− 114 -> Just (175, 95, 0)

173− 115 -> Just (175, 95, 95)

174− 116 -> Just (175, 95, 135)

175− 117 -> Just (175, 95, 175)

176− 118 -> Just (175, 95, 215)

177− 119 -> Just (175, 95, 255)

178− 120 -> Just (175, 135, 0)

179− 121 -> Just (175, 135, 95)

180− 122 -> Just (175, 135, 135)

181− 123 -> Just (175, 135, 175)

182− 124 -> Just (175, 135, 215)

183− 125 -> Just (175, 135, 255)

184− 126 -> Just (175, 175, 0)

185− 127 -> Just (175, 175, 95)

186− 128 -> Just (175, 175, 135)

187− 129 -> Just (175, 175, 175)

188− 130 -> Just (175, 175, 215)

189− 131 -> Just (175, 175, 255)

190− 132 -> Just (175, 215, 0)

191− 133 -> Just (175, 215, 95)

192− 134 -> Just (175, 215, 135)

193− 135 -> Just (175, 215, 175)

194− 136 -> Just (175, 215, 215)

195− 137 -> Just (175, 215, 255)

196− 138 -> Just (175, 255, 0)

197− 139 -> Just (175, 255, 95)

198− 140 -> Just (175, 255, 135)

199− 141 -> Just (175, 255, 175)

200− 142 -> Just (175, 255, 215)

201− 143 -> Just (175, 255, 255)

202− 144 -> Just (215, 0, 0)

203− 145 -> Just (215, 0, 95)

204− 146 -> Just (215, 0, 135)

205− 147 -> Just (215, 0, 175)

206− 148 -> Just (215, 0, 215)

207− 149 -> Just (215, 0, 255)

208− 150 -> Just (215, 95, 0)

209− 151 -> Just (215, 95, 95)

210− 152 -> Just (215, 95, 135)

211− 153 -> Just (215, 95, 175)

212− 154 -> Just (215, 95, 215)

213− 155 -> Just (215, 95, 255)

214− 156 -> Just (215, 135, 0)

215− 157 -> Just (215, 135, 95)

216− 158 -> Just (215, 135, 135)

217− 159 -> Just (215, 135, 175)

218− 160 -> Just (215, 135, 215)

219− 161 -> Just (215, 135, 255)

220− 162 -> Just (215, 175, 0)

221− 163 -> Just (215, 175, 95)

222− 164 -> Just (215, 175, 135)

223− 165 -> Just (215, 175, 175)

224− 166 -> Just (215, 175, 215)

225− 167 -> Just (215, 175, 255)

226− 168 -> Just (215, 215, 0)

227− 169 -> Just (215, 215, 95)

228− 170 -> Just (215, 215, 135)

229− 171 -> Just (215, 215, 175)

230− 172 -> Just (215, 215, 215)

231− 173 -> Just (215, 215, 255)

232− 174 -> Just (215, 255, 0)

233− 175 -> Just (215, 255, 95)

234− 176 -> Just (215, 255, 135)

235− 177 -> Just (215, 255, 175)

236− 178 -> Just (215, 255, 215)

237− 179 -> Just (215, 255, 255)

238− 180 -> Just (255, 0, 0)

239− 181 -> Just (255, 0, 95)

240− 182 -> Just (255, 0, 135)

241− 183 -> Just (255, 0, 175)

242− 184 -> Just (255, 0, 215)

243− 185 -> Just (255, 0, 255)

244− 186 -> Just (255, 95, 0)

245− 187 -> Just (255, 95, 95)

246− 188 -> Just (255, 95, 135)

247− 189 -> Just (255, 95, 175)

248− 190 -> Just (255, 95, 215)

249− 191 -> Just (255, 95, 255)

250− 192 -> Just (255, 135, 0)

251− 193 -> Just (255, 135, 95)

252− 194 -> Just (255, 135, 135)

253− 195 -> Just (255, 135, 175)

254− 196 -> Just (255, 135, 215)

255− 197 -> Just (255, 135, 255)

256− 198 -> Just (255, 175, 0)

257− 199 -> Just (255, 175, 95)

258− 200 -> Just (255, 175, 135)

259− 201 -> Just (255, 175, 175)

260− 202 -> Just (255, 175, 215)

261− 203 -> Just (255, 175, 255)

262− 204 -> Just (255, 215, 0)

263− 205 -> Just (255, 215, 95)

264− 206 -> Just (255, 215, 135)

265− 207 -> Just (255, 215, 175)

266− 208 -> Just (255, 215, 215)

267− 209 -> Just (255, 215, 255)

268− 210 -> Just (255, 255, 0)

269− 211 -> Just (255, 255, 95)

270− 212 -> Just (255, 255, 135)

271− 213 -> Just (255, 255, 175)

272− 214 -> Just (255, 255, 215)

273− 215 -> Just (255, 255, 255)

274− 216 -> Just (8, 8, 8)

275− 217 -> Just (18, 18, 18)

276− 218 -> Just (28, 28, 28)

277− 219 -> Just (38, 38, 38)

278− 220 -> Just (48, 48, 48)

279− 221 -> Just (58, 58, 58)

280− 222 -> Just (68, 68, 68)

281− 223 -> Just (78, 78, 78)

282− 224 -> Just (88, 88, 88)

283− 225 -> Just (98, 98, 98)

284− 226 -> Just (108, 108, 108)

285− 227 -> Just (118, 118, 118)

286− 228 -> Just (128, 128, 128)

287− 229 -> Just (138, 138, 138)

288− 230 -> Just (148, 148, 148)

289− 231 -> Just (158, 158, 158)

290− 232 -> Just (168, 168, 168)

291− 233 -> Just (178, 178, 178)

292− 234 -> Just (188, 188, 188)

293− 235 -> Just (198, 198, 198)

294− 236 -> Just (208, 208, 208)

295− 237 -> Just (218, 218, 218)

296− 238 -> Just (228, 228, 228)

297− 239 -> Just (238, 238, 238)

298− _ -> Nothing

src/Graphics/Vty/Config.hs+68−259

@@ -1,9 +1,7 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveDataTypeable #-}

1{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

2{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

4{-# LANGUAGE TypeOperators #-}

3{-# LANGUAGE TypeOperators #-}

5{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE ScopedTypeVariables #-}

6−{-# LANGUAGE LambdaCase, MultiWayIf #-}

7-- | Vty supports a configuration file format and associated 'Config'

5-- | Vty supports a configuration file format and associated 'Config'

8-- data type. The 'Config' can be provided to 'mkVty' to customize the

6-- data type. The 'Config' can be provided to 'mkVty' to customize the

9-- application's use of Vty.

7-- application's use of Vty.

@@ -55,33 +53,7 @@

55-- If a debug log is requested then vty will output the current input

53-- If a debug log is requested then vty will output the current input

56-- table to the log in the above format. A workflow for using this is

54-- table to the log in the above format. A workflow for using this is

57-- to set @VTY_DEBUG_LOG@. Run the application. Check the debug log for

55-- to set @VTY_DEBUG_LOG@. Run the application. Check the debug log for

58−-- incorrect mappings. Add corrected mappings to @$HOME\/.vty\/config@.

56+-- incorrect mappings. Add corrected mappings to @$HOME/.vty/config@.

59−--

60−-- = Unicode Character Width Maps

61−--

62−-- == @widthMap@

63−--

64−-- Format:

65−--

66−-- @

67−-- \"widthMap\" string string

68−-- @

69−--

70−-- E.g.,

71−--

72−-- @

73−-- widthMap \"xterm\" \"\/home\/user\/.vty\/xterm\_map.dat\"

74−-- @

75−--

76−-- This directive specifies the path to a Unicode character width

77−-- map (the second argument) that should be loaded and used when

78−-- the value of TERM matches the first argument. Unicode character

79−-- width maps can be produced either by running the provided binary

80−-- @vty-build-width-table@ or by calling the library routine

81−-- 'Graphics.Vty.UnicodeWidthTable.Query.buildUnicodeWidthTable'. The

82−-- 'Graphics.Vty.mkVty' function will use these configuration settings

83−-- to attempt to load and install the specified width map. See the

84−-- documentation for 'Graphics.Vty.mkVty' for details.

85module Graphics.Vty.Config

57module Graphics.Vty.Config

86 ( InputMap

58 ( InputMap

87 , Config(..)

59 , Config(..)

@@ -92,17 +64,6 @@ module Graphics.Vty.Config

92 , runParseConfig

64 , runParseConfig

93 , parseConfigFile

65 , parseConfigFile

94 , defaultConfig

66 , defaultConfig

95− , getTtyEraseChar

96− , currentTerminalName

97−

98− , vtyConfigPath

99− , widthTableFilename

100− , vtyDataDirectory

101− , terminalWidthTablePath

102− , vtyConfigFileEnvName

103−

104− , ConfigUpdateResult(..)

105− , addConfigWidthMap

106 )

67 )

107where

68where

108

@@ -114,40 +75,29 @@ import Control.Exception (catch, IOException, Exception(..), throwIO)

114import Control.Monad (liftM, guard, void)

75import Control.Monad (liftM, guard, void)

115

116import qualified Data.ByteString as BS

77import qualified Data.ByteString as BS

117−#if !(MIN_VERSION_base(4,8,0))

118−import Data.Monoid (Monoid(..))

78+import Data.Monoid

119−#endif

120−#if !(MIN_VERSION_base(4,11,0))

121−import Data.Semigroup (Semigroup(..))

122−#endif

123import Data.Typeable (Typeable)

79import Data.Typeable (Typeable)

124

125import Graphics.Vty.Input.Events

81import Graphics.Vty.Input.Events

126−import Graphics.Vty.Attributes.Color (ColorMode(..), detectColorMode)

127

128import GHC.Generics

83import GHC.Generics

129

130−import System.Directory ( getAppUserDataDirectory, doesFileExist

85+import System.Directory (getAppUserDataDirectory)

131− , createDirectoryIfMissing

132− )

133−import System.Environment (lookupEnv)

86+import System.Posix.Env (getEnv)

134−import System.FilePath ((</>), takeDirectory)

135import System.Posix.IO (stdInput, stdOutput)

87import System.Posix.IO (stdInput, stdOutput)

136import System.Posix.Types (Fd(..))

88import System.Posix.Types (Fd(..))

137−import Foreign.C.Types (CInt(..), CChar(..))

138

139import Text.Parsec hiding ((<|>))

90import Text.Parsec hiding ((<|>))

140import Text.Parsec.Token ( GenLanguageDef(..) )

91import Text.Parsec.Token ( GenLanguageDef(..) )

141import qualified Text.Parsec.Token as P

92import qualified Text.Parsec.Token as P

142

143-- | Type of errors that can be thrown when configuring VTY

94-- | Type of errors that can be thrown when configuring VTY

144−data VtyConfigurationError =

95+data VtyConfigurationError

145− VtyMissingTermEnvVar

146− -- ^ TERM environment variable not set

96+ = VtyMissingTermEnvVar -- ^ TERM environment variable not set

147− deriving (Show, Eq, Typeable)

97+ deriving (Show, Eq, Typeable)

148

149instance Exception VtyConfigurationError where

99instance Exception VtyConfigurationError where

150− displayException VtyMissingTermEnvVar = "TERM environment variable not set"

100+ displayException VtyMissingTermEnvVar = "TERM environment variable not set"

151

101

152-- | Mappings from input bytes to event in the order specified. Later

102-- | Mappings from input bytes to event in the order specified. Later

153-- entries take precedence over earlier in the case multiple entries

103-- entries take precedence over earlier in the case multiple entries

@@ -155,144 +105,85 @@ instance Exception VtyConfigurationError where

155type InputMap = [(Maybe String, String, Event)]

105type InputMap = [(Maybe String, String, Event)]

156

106

157-- | A Vty configuration.

107-- | A Vty configuration.

158−data Config =

108+data Config = Config

109+ {

110+ -- | The default is 1 character.

159− Config { vmin :: Maybe Int

111+ vmin :: Maybe Int

160− -- ^ The default is 1 character.

161− , vtime :: Maybe Int

162− -- ^ The default is 100 milliseconds, 0.1 seconds.

112+ -- | The default is 100 milliseconds, 0.1 seconds.

113+ , vtime :: Maybe Int

114+ -- | The default is False.

163− , mouseMode :: Maybe Bool

115+ , mouseMode :: Maybe Bool

164− -- ^ The default is False.

116+ -- | The default is False.

165− , bracketedPasteMode :: Maybe Bool

117+ , bracketedPasteMode :: Maybe Bool

166− -- ^ The default is False.

167− , debugLog :: Maybe FilePath

168− -- ^ Debug information is appended to this file if not

118+ -- | Debug information is appended to this file if not Nothing.

169− -- Nothing.

119+ , debugLog :: Maybe FilePath

170− , inputMap :: InputMap

171− -- ^ The (input byte, output event) pairs extend the internal

120+ -- | The (input byte, output event) pairs extend the internal input

172− -- input table of VTY and the table from terminfo.

121+ -- table of VTY and the table from terminfo.

173− --

122+ --

174− -- See "Graphics.Vty.Config" module documentation for

123+ -- See "Graphics.Vty.Config" module documentation for documentation

175− -- documentation of the @map@ directive.

124+ -- of the @map@ directive.

176− , inputFd :: Maybe Fd

125+ , inputMap :: InputMap

177− -- ^ The input file descriptor to use. The default is

126+ -- | The input file descriptor to use. The default is

178− -- 'System.Posix.IO.stdInput'

127+ -- 'System.Posix.IO.stdInput'

179− , outputFd :: Maybe Fd

128+ , inputFd :: Maybe Fd

180− -- ^ The output file descriptor to use. The default is

129+ -- | The output file descriptor to use. The default is

181− -- 'System.Posix.IO.stdOutput'

130+ -- 'System.Posix.IO.stdOutput'

182− , termName :: Maybe String

131+ , outputFd :: Maybe Fd

183− -- ^ The terminal name used to look up terminfo capabilities.

132+ -- | The terminal name used to look up terminfo capabilities.

184− -- The default is the value of the TERM environment variable.

133+ -- The default is the value of the TERM environment variable.

185− , termWidthMaps :: [(String, FilePath)]

134+ , termName :: Maybe String

186− -- ^ Terminal width map files.

187− , allowCustomUnicodeWidthTables :: Maybe Bool

188− -- ^ Whether to permit custom Unicode width table loading by

189− -- 'Graphics.Vty.mkVty'. @'Just' 'False'@ indicates that

190− -- table loading should not be performed. Other values permit

191− -- table loading.

192− --

193− -- If a table load is attempted and fails, information

194− -- about the failure will be logged to the debug log if the

195− -- configuration specifies one. If no custom table is loaded

196− -- (or if a load fails), the built-in character width table

197− -- will be used.

198− , colorMode :: Maybe ColorMode

199− -- ^ The color mode used to know how many colors the terminal

200− -- supports.

201− }

202− deriving (Show, Eq)

135+ } deriving (Show, Eq)

203

136

204defaultConfig :: Config

137defaultConfig :: Config

205defaultConfig = mempty

138defaultConfig = mempty

206

139

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−

225instance Monoid Config where

140instance Monoid Config where

226− mempty =

141+ mempty = Config

227− Config { vmin = Nothing

142+ { vmin = Nothing

228− , vtime = Nothing

143+ , vtime = Nothing

229− , mouseMode = Nothing

144+ , mouseMode = Nothing

230− , bracketedPasteMode = Nothing

145+ , bracketedPasteMode = Nothing

231− , debugLog = mempty

146+ , debugLog = mempty

232− , inputMap = mempty

147+ , inputMap = mempty

233− , inputFd = Nothing

148+ , inputFd = Nothing

234− , outputFd = Nothing

149+ , outputFd = Nothing

235− , termName = Nothing

150+ , termName = Nothing

236− , termWidthMaps = []

237− , allowCustomUnicodeWidthTables = Nothing

238− , colorMode = Nothing

239− }

151+ }

240−#if !(MIN_VERSION_base(4,11,0))

241− mappend = (<>)

152+ mappend c0 c1 = Config

242−#endif

153+ -- latter config takes priority for everything but inputMap

243−

154+ { vmin = vmin c1 <|> vmin c0

244−vtyDataDirectory :: IO FilePath

155+ , vtime = vtime c1 <|> vtime c0

245−vtyDataDirectory = getAppUserDataDirectory "vty"

156+ , mouseMode = mouseMode c1

246−

157+ , bracketedPasteMode = bracketedPasteMode c1

247−vtyConfigPath :: IO FilePath

158+ , debugLog = debugLog c1 <|> debugLog c0

248−vtyConfigPath = do

159+ , inputMap = inputMap c0 <> inputMap c1

249− dir <- vtyDataDirectory

160+ , inputFd = inputFd c1 <|> inputFd c0

250− return $ dir </> "config"

161+ , outputFd = outputFd c1 <|> outputFd c0

251−

162+ , termName = termName c1 <|> termName c0

252−vtyConfigFileEnvName :: String

163+ }

253−vtyConfigFileEnvName = "VTY_CONFIG_FILE"

164+

254−

255−-- | Load a configuration from 'vtyConfigPath' and @$VTY_CONFIG_FILE@.

165+-- | Load a configuration from @'getAppUserDataDirectory'/config@ and

166+-- @$VTY_CONFIG_FILE@.

256userConfig :: IO Config

167userConfig :: IO Config

257userConfig = do

168userConfig = do

258− configFile <- vtyConfigPath >>= parseConfigFile

169+ configFile <- (mappend <$> getAppUserDataDirectory "vty" <*> pure "/config") >>= parseConfigFile

259− overrideConfig <- maybe (return defaultConfig) parseConfigFile =<<

170+ overrideConfig <- maybe (return defaultConfig) parseConfigFile =<< getEnv "VTY_CONFIG_FILE"

260− lookupEnv vtyConfigFileEnvName

261 let base = configFile <> overrideConfig

171 let base = configFile <> overrideConfig

262 mappend base <$> overrideEnvConfig

172 mappend base <$> overrideEnvConfig

263

173

264−widthTableFilename :: String -> String

265−widthTableFilename term = "width_table_" <> term <> ".dat"

266−

267−termVariable :: String

268−termVariable = "TERM"

269−

270−currentTerminalName :: IO (Maybe String)

271−currentTerminalName = lookupEnv termVariable

272−

273−terminalWidthTablePath :: IO (Maybe FilePath)

274−terminalWidthTablePath = do

275− dataDir <- vtyDataDirectory

276− result <- lookupEnv termVariable

277− case result of

278− Nothing -> return Nothing

279− Just term -> do

280− return $ Just $ dataDir </> widthTableFilename term

281−

282overrideEnvConfig :: IO Config

174overrideEnvConfig :: IO Config

283overrideEnvConfig = do

175overrideEnvConfig = do

284− d <- lookupEnv "VTY_DEBUG_LOG"

176+ d <- getEnv "VTY_DEBUG_LOG"

285 return $ defaultConfig { debugLog = d }

177 return $ defaultConfig { debugLog = d }

286

178

287-- | Configures VTY using defaults suitable for terminals. This function

179-- | Configures VTY using defaults suitable for terminals. This function

288-- can raise 'VtyConfigurationError'.

180-- can raise 'VtyConfigurationError'.

289standardIOConfig :: IO Config

181standardIOConfig :: IO Config

290standardIOConfig = do

182standardIOConfig = do

291− mb <- lookupEnv termVariable

183+ mb <- getEnv "TERM"

292 case mb of

184 case mb of

293 Nothing -> throwIO VtyMissingTermEnvVar

185 Nothing -> throwIO VtyMissingTermEnvVar

294− Just t -> do

186+ Just t ->

295− mcolorMode <- detectColorMode t

296 return defaultConfig

187 return defaultConfig

297 { vmin = Just 1

188 { vmin = Just 1

298 , mouseMode = Just False

189 , mouseMode = Just False

@@ -301,7 +192,6 @@ standardIOConfig = do

301 , inputFd = Just stdInput

192 , inputFd = Just stdInput

302 , outputFd = Just stdOutput

193 , outputFd = Just stdOutput

303 , termName = Just t

194 , termName = Just t

304− , colorMode = Just mcolorMode

305 }

195 }

306

196

307parseConfigFile :: FilePath -> IO Config

197parseConfigFile :: FilePath -> IO Config

@@ -353,20 +243,13 @@ debugLogDecl = do

353 path <- P.stringLiteral configLexer

243 path <- P.stringLiteral configLexer

354 return defaultConfig { debugLog = Just path }

244 return defaultConfig { debugLog = Just path }

355

245

356−widthMapDecl :: Parser Config

357−widthMapDecl = do

358− "widthMap" <- P.identifier configLexer

359− tName <- P.stringLiteral configLexer

360− path <- P.stringLiteral configLexer

361− return defaultConfig { termWidthMaps = [(tName, path)] }

362−

363ignoreLine :: Parser ()

246ignoreLine :: Parser ()

364ignoreLine = void $ manyTill anyChar newline

247ignoreLine = void $ manyTill anyChar newline

365

248

366parseConfig :: Parser Config

249parseConfig :: Parser Config

367parseConfig = liftM mconcat $ many $ do

250parseConfig = liftM mconcat $ many $ do

368 P.whiteSpace configLexer

251 P.whiteSpace configLexer

369− let directives = [try mapDecl, try debugLogDecl, try widthMapDecl]

252+ let directives = [try mapDecl, try debugLogDecl]

370 choice directives <|> (ignoreLine >> return defaultConfig)

253 choice directives <|> (ignoreLine >> return defaultConfig)

371

254

372class Parse a where parseValue :: Parser a

255class Parse a where parseValue :: Parser a

@@ -412,77 +295,3 @@ instance (GParseAlts f, GParseAlts g) => GParseAlts (f :+: g) where

412 gparseAlts con = L1 <$> gparseAlts con <|> R1 <$> gparseAlts con

295 gparseAlts con = L1 <$> gparseAlts con <|> R1 <$> gparseAlts con

413

296

414instance GParseAlts V1 where gparseAlts _ = fail "GParse: V1"

297instance 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

13import qualified Data.Vector as Vector

15−rowOpsAffectedColumns :: DisplayOps -> [Int]

15+rowOpsEffectedColumns :: DisplayOps -> [Int]

16−rowOpsAffectedColumns ops

16+rowOpsEffectedColumns ops

17− = Vector.toList $ Vector.map spanOpsAffectedColumns ops

17+ = Vector.toList $ Vector.map spanOpsEffectedColumns ops

19allSpansHaveWidth :: DisplayOps -> Int -> Bool

20allSpansHaveWidth ops expected

21− = all (== expected) $ Vector.toList $ Vector.map spanOpsAffectedColumns ops

21+ = all (== expected) $ Vector.toList $ Vector.map spanOpsEffectedColumns ops

23−spanOpsAffectedRows :: DisplayOps -> Int

23+spanOpsEffectedRows :: DisplayOps -> Int

24−spanOpsAffectedRows ops

24+spanOpsEffectedRows ops

25 = toEnum $ length (filter (not . null . Vector.toList) (Vector.toList ops))

27type SpanConstructLog = [SpanConstructEvent]

src/Graphics/Vty/DisplayAttributes.hs+4−47

@@ -1,18 +1,11 @@

2{-# LANGUAGE BangPatterns #-}

3−{-# LANGUAGE CPP #-}

5module Graphics.Vty.DisplayAttributes where

4module Graphics.Vty.DisplayAttributes where

7import Graphics.Vty.Attributes

6import Graphics.Vty.Attributes

9import Data.Bits ((.&.))

8import Data.Bits ((.&.))

10−import Data.ByteString (ByteString)

11−#if !(MIN_VERSION_base(4,11,0))

12−import Data.Semigroup (Semigroup(..))

13−#endif

14−import Data.Text (Text)

15−import Data.Text.Encoding (encodeUtf8)

17-- | Given the previously applied display attributes as a FixedAttr and

10-- | Given the previously applied display attributes as a FixedAttr and

18-- the current display attributes as an Attr produces a FixedAttr that

11-- the current display attributes as an Attr produces a FixedAttr that

@@ -24,7 +17,6 @@ fixDisplayAttr fattr attr

24 = FixedAttr (fixStyle (fixedStyle fattr) (attrStyle attr))

17 = FixedAttr (fixStyle (fixedStyle fattr) (attrStyle attr))

25 (fixColor (fixedForeColor fattr) (attrForeColor attr))

18 (fixColor (fixedForeColor fattr) (attrForeColor attr))

26 (fixColor (fixedBackColor fattr) (attrBackColor attr))

19 (fixColor (fixedBackColor fattr) (attrBackColor attr))

27− (fixURL (fixedURL fattr) (attrURL attr))

28 where

20 where

29 fixStyle _s Default = defaultStyleMask

21 fixStyle _s Default = defaultStyleMask

30 fixStyle s KeepCurrent = s

22 fixStyle s KeepCurrent = s

@@ -32,9 +24,6 @@ fixDisplayAttr fattr attr

32 fixColor _c Default = Nothing

24 fixColor _c Default = Nothing

33 fixColor c KeepCurrent = c

25 fixColor c KeepCurrent = c

34 fixColor _c (SetTo c) = Just c

26 fixColor _c (SetTo c) = Just c

35− fixURL c KeepCurrent = c

36− fixURL _c (SetTo n) = Just n

37− fixURL _c Default = Nothing

39-- | difference between two display attributes. Used in the calculation

28-- | difference between two display attributes. Used in the calculation

40-- of the operations required to go from one display attribute to the

29-- of the operations required to go from one display attribute to the

@@ -47,23 +36,16 @@ data DisplayAttrDiff = DisplayAttrDiff

47 { styleDiffs :: [StyleStateChange]

36 { styleDiffs :: [StyleStateChange]

48 , foreColorDiff :: DisplayColorDiff

37 , foreColorDiff :: DisplayColorDiff

49 , backColorDiff :: DisplayColorDiff

38 , backColorDiff :: DisplayColorDiff

50− , urlDiff :: URLDiff

51 }

39 }

52 deriving (Show)

40 deriving (Show)

54−instance Semigroup DisplayAttrDiff where

42+instance Monoid DisplayAttrDiff where

43+ mempty = DisplayAttrDiff [] NoColorChange NoColorChange

55− d0 <> d1 =

44+ mappend d0 d1 =

56 let ds = simplifyStyleDiffs (styleDiffs d0) (styleDiffs d1)

45 let ds = simplifyStyleDiffs (styleDiffs d0) (styleDiffs d1)

57 fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1)

46 fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1)

58 bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1)

47 bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1)

59− ud = simplifyUrlDiffs (urlDiff d0) (urlDiff d1)

60− in DisplayAttrDiff ds fcd bcd ud

48+ in DisplayAttrDiff ds fcd bcd

61−

62−instance Monoid DisplayAttrDiff where

63− mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange

64−#if !(MIN_VERSION_base(4,11,0))

65− mappend = (<>)

66−#endif

68-- | Used in the computation of a final style attribute change.

50-- | Used in the computation of a final style attribute change.

69simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]

51simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]

@@ -76,12 +58,6 @@ simplifyColorDiffs _cd ColorToDefault = ColorToDefault

76simplifyColorDiffs cd NoColorChange = cd

58simplifyColorDiffs cd NoColorChange = cd

77simplifyColorDiffs _cd (SetColor !c) = SetColor c

59simplifyColorDiffs _cd (SetColor !c) = SetColor c

79−-- | Consider two URL changes, which are mostly going to be the latter

80−-- unless the latter specifies no change.

81−simplifyUrlDiffs :: URLDiff -> URLDiff -> URLDiff

82−simplifyUrlDiffs ud NoLinkChange = ud

83−simplifyUrlDiffs _ ud = ud

84−

85-- | Difference between two display color attribute changes.

61-- | Difference between two display color attribute changes.

86data DisplayColorDiff

62data DisplayColorDiff

87 = ColorToDefault

63 = ColorToDefault

@@ -94,10 +70,6 @@ data DisplayColorDiff

94data StyleStateChange

70data StyleStateChange

95 = ApplyStandout

71 = ApplyStandout

96 | RemoveStandout

72 | RemoveStandout

97− | ApplyItalic

98− | RemoveItalic

99− | ApplyStrikethrough

100− | RemoveStrikethrough

101 | ApplyUnderline

73 | ApplyUnderline

102 | RemoveUnderline

74 | RemoveUnderline

103 | ApplyReverseVideo

75 | ApplyReverseVideo

@@ -110,13 +82,6 @@ data StyleStateChange

110 | RemoveBold

82 | RemoveBold

111 deriving (Show, Eq)

83 deriving (Show, Eq)

112

113−-- Setting and unsetting hyperlinks

114−data URLDiff

115− = LinkTo !ByteString

116− | NoLinkChange

117− | EndLink

118− deriving (Show, Eq)

119−

120-- | Determines the diff between two display&color attributes. This diff

85-- | Determines the diff between two display&color attributes. This diff

121-- determines the operations that actually get output to the terminal.

86-- determines the operations that actually get output to the terminal.

122displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff

87displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff

@@ -124,14 +89,8 @@ displayAttrDiffs attr attr' = DisplayAttrDiff

124 { styleDiffs = diffStyles (fixedStyle attr) (fixedStyle attr')

89 { styleDiffs = diffStyles (fixedStyle attr) (fixedStyle attr')

125 , foreColorDiff = diffColor (fixedForeColor attr) (fixedForeColor attr')

90 , foreColorDiff = diffColor (fixedForeColor attr) (fixedForeColor attr')

126 , backColorDiff = diffColor (fixedBackColor attr) (fixedBackColor attr')

91 , backColorDiff = diffColor (fixedBackColor attr) (fixedBackColor attr')

127− , urlDiff = diffURL (fixedURL attr) (fixedURL attr')

128 }

92 }

129

130−diffURL :: Maybe Text -> Maybe Text -> URLDiff

131−diffURL Nothing Nothing = NoLinkChange

132−diffURL (Just _) Nothing = EndLink

133−diffURL _ (Just url) = LinkTo (encodeUtf8 url)

134−

135diffColor :: Maybe Color -> Maybe Color -> DisplayColorDiff

94diffColor :: Maybe Color -> Maybe Color -> DisplayColorDiff

136diffColor Nothing (Just c') = SetColor c'

95diffColor Nothing (Just c') = SetColor c'

137diffColor (Just c) (Just c')

96diffColor (Just c) (Just c')

@@ -145,8 +104,6 @@ diffStyles prev cur

145 = mconcat

104 = mconcat

146 [ styleDiff standout ApplyStandout RemoveStandout

105 [ styleDiff standout ApplyStandout RemoveStandout

147 , styleDiff underline ApplyUnderline RemoveUnderline

106 , styleDiff underline ApplyUnderline RemoveUnderline

148− , styleDiff italic ApplyItalic RemoveItalic

149− , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough

150 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo

107 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo

151 , styleDiff blink ApplyBlink RemoveBlink

108 , styleDiff blink ApplyBlink RemoveBlink

152 , styleDiff dim ApplyDim RemoveDim

109 , styleDiff dim ApplyDim RemoveDim

src/Graphics/Vty/Image.hs+8−17

@@ -1,4 +1,5 @@

2+{-# LANGUAGE BangPatterns #-}

2{-# LANGUAGE NamedFieldPuns #-}

3{-# LANGUAGE NamedFieldPuns #-}

3{-# LANGUAGE DisambiguateRecordFields #-}

4{-# LANGUAGE DisambiguateRecordFields #-}

4-- | A Vty program makes 'Picture's from 'Image's. This module provides

5-- | A Vty program makes 'Picture's from 'Image's. This module provides

@@ -45,12 +46,8 @@ module Graphics.Vty.Image

45 -- * Character width functions

46 -- * Character width functions

46 , safeWcwidth

47 , safeWcwidth

47 , safeWcswidth

48 , safeWcswidth

48− , safeWctwidth

49− , safeWctlwidth

50 , wcwidth

49 , wcwidth

51 , wcswidth

50 , wcswidth

52− , wctwidth

53− , wctlwidth

54 -- * Display Regions

51 -- * Display Regions

55 , DisplayText

52 , DisplayText

56 , DisplayRegion

53 , DisplayRegion

@@ -116,18 +113,14 @@ horizCat = foldr horizJoin EmptyImage

116vertCat :: [Image] -> Image

113vertCat :: [Image] -> Image

117vertCat = foldr vertJoin EmptyImage

114vertCat = foldr vertJoin EmptyImage

118

115

119−-- | Make an 'Image' from a lazy text value. The text value should be

116+-- | Make an 'Image' from a lazy text value.

120−-- sanitized of escape sequences (ASCII 27) and carriage returns;

121−-- otherwise layout and attribute problems may result.

122text :: Attr -> TL.Text -> Image

117text :: Attr -> TL.Text -> Image

123−text a txt = let displayWidth = safeWctlwidth txt

118+text a txt = let displayWidth = safeWcswidth (TL.unpack txt)

124 in HorizText a txt displayWidth (fromIntegral $! TL.length txt)

119 in HorizText a txt displayWidth (fromIntegral $! TL.length txt)

125

120

126−-- | Make an 'Image' from a text value. The text value should be

121+-- | Make an 'Image' from a text value.

127−-- sanitized of escape sequences (ASCII 27) and carriage returns;

128−-- otherwise layout and attribute problems may result.

129text' :: Attr -> T.Text -> Image

122text' :: Attr -> T.Text -> Image

130−text' a txt = let displayWidth = safeWctwidth txt

123+text' a txt = let displayWidth = safeWcswidth (T.unpack txt)

131 in HorizText a (TL.fromStrict txt) displayWidth (T.length txt)

124 in HorizText a (TL.fromStrict txt) displayWidth (T.length txt)

132

125

133-- | Make an image from a single character. This is a standard Haskell

126-- | Make an image from a single character. This is a standard Haskell

@@ -137,11 +130,9 @@ char a c =

137 let displayWidth = safeWcwidth c

130 let displayWidth = safeWcwidth c

138 in HorizText a (TL.singleton c) displayWidth 1

131 in HorizText a (TL.singleton c) displayWidth 1

139

132

140−-- | Make an image from a string of characters laid out on a single

133+-- | Make an image from a string of characters layed out on a single

141-- row with the same display attribute. The string is assumed to be a

134-- row with the same display attribute. The string is assumed to be a

142−-- sequence of ISO-10646 characters. The input string should be

135+-- sequence of ISO-10646 characters.

143−-- sanitized of escape sequences (ASCII 27) and carriage returns;

144−-- otherwise layout and attribute problems may result.

145--

136--

146-- Note: depending on how the Haskell compiler represents string

137-- Note: depending on how the Haskell compiler represents string

147-- literals, a string literal in a UTF-8 encoded source file, for

138-- literals, a string literal in a UTF-8 encoded source file, for

@@ -175,7 +166,7 @@ utf8String a bytes = utf8Bytestring a (BL.pack bytes)

175utf8Bytestring :: Attr -> BL.ByteString -> Image

166utf8Bytestring :: Attr -> BL.ByteString -> Image

176utf8Bytestring a bs = text a (TL.decodeUtf8 bs)

167utf8Bytestring a bs = text a (TL.decodeUtf8 bs)

177

168

178−-- | Make an 'Image' from a UTF-8 encoded strict bytestring.

169+-- | Make an 'Image' from a UTF-8 encoded lazy bytestring.

179utf8Bytestring' :: Attr -> B.ByteString -> Image

170utf8Bytestring' :: Attr -> B.ByteString -> Image

180utf8Bytestring' a bs = text' a (T.decodeUtf8 bs)

171utf8Bytestring' a bs = text' a (T.decodeUtf8 bs)

181

172

src/Graphics/Vty/Image/Internal.hs+32−16

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE NamedFieldPuns #-}

1{-# LANGUAGE NamedFieldPuns #-}

3{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE DeriveGeneric #-}

4{-# OPTIONS_HADDOCK hide #-}

3{-# OPTIONS_HADDOCK hide #-}

@@ -12,9 +11,6 @@ import GHC.Generics

13import Control.DeepSeq

12import Control.DeepSeq

15−#if !(MIN_VERSION_base(4,11,0))

16−import Data.Semigroup (Semigroup(..))

17−#endif

18import qualified Data.Text.Lazy as TL

14import qualified Data.Text.Lazy as TL

20-- | A display text is a Data.Text.Lazy

16-- | A display text is a Data.Text.Lazy

@@ -142,11 +138,37 @@ data Image =

142 --

138 --

143 -- Any image of zero size equals the empty image.

139 -- Any image of zero size equals the empty image.

144 | EmptyImage

140 | 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"

146

168

147-- | pretty print just the structure of an image.

169-- | pretty print just the structure of an image.

148ppImageStructure :: Image -> String

170ppImageStructure :: Image -> String

149−ppImageStructure = go 0

171+ppImageStructure inImg = go 0 inImg

150 where

172 where

151 go indent img = tab indent ++ pp indent img

173 go indent img = tab indent ++ pp indent img

152 tab indent = concat $ replicate indent " "

174 tab indent = concat $ replicate indent " "

@@ -210,16 +232,10 @@ imageHeight CropBottom { outputHeight = h } = h

210imageHeight CropTop { outputHeight = h } = h

232imageHeight CropTop { outputHeight = h } = h

211imageHeight EmptyImage = 0

233imageHeight EmptyImage = 0

212

234

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 <->.

218instance Monoid Image where

236instance Monoid Image where

219 mempty = EmptyImage

237 mempty = EmptyImage

220−#if !(MIN_VERSION_base(4,11,0))

221− mappend = (<>)

238+ mappend = vertJoin

222−#endif

223

239

224-- | combines two images side by side

240-- | combines two images side by side

225--

241--

@@ -228,7 +244,7 @@ instance Monoid Image where

228--

244--

229-- The result image will have a width equal to the sum of the two images

245-- The result image will have a width equal to the sum of the two images

230-- width. And the height will equal the largest height of the two

246-- 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

232-- will be filled with the background pattern.

248-- will be filled with the background pattern.

233horizJoin :: Image -> Image -> Image

249horizJoin :: Image -> Image -> Image

234horizJoin EmptyImage i = i

250horizJoin EmptyImage i = i

@@ -259,7 +275,7 @@ horizJoin _ _ = error "horizJoin applied to undefined values."

259--

275--

260-- The result image will have a height equal to the sum of the heights

276-- The result image will have a height equal to the sum of the heights

261-- of both images. The width will equal the largest width of the two

277-- 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

263-- will be filled with the background pattern.

279-- will be filled with the background pattern.

264vertJoin :: Image -> Image -> Image

280vertJoin :: Image -> Image -> Image

265vertJoin EmptyImage i = i

281vertJoin EmptyImage i = i

src/Graphics/Vty/Inline.hs+17−28

@@ -1,3 +1,5 @@

1+{-# LANGUAGE BangPatterns #-}

1-- | The inline module provides a limited interface to changing the

3-- | The inline module provides a limited interface to changing the

2-- style of terminal output. The intention is for this interface to be

4-- style of terminal output. The intention is for this interface to be

3-- used inline with other output systems.

5-- used inline with other output systems.

@@ -46,33 +48,22 @@ import Data.IORef

47import System.IO

49import System.IO

49−type InlineM v = State InlineState v

51+type InlineM v = State Attr v

50−

51−data InlineState =

52− InlineState { inlineAttr :: Attr

53− , inlineUrlsEnabled :: Bool

54− }

56-- | Set the background color to the provided 'Color'.

53-- | Set the background color to the provided 'Color'.

57backColor :: Color -> InlineM ()

54backColor :: Color -> InlineM ()

58−backColor c = modify $ \s ->

55+backColor c = modify $ flip mappend ( currentAttr `withBackColor` c )

59− s { inlineAttr = inlineAttr s `withBackColor` c

60− }

62-- | Set the foreground color to the provided 'Color'.

57-- | Set the foreground color to the provided 'Color'.

63foreColor :: Color -> InlineM ()

58foreColor :: Color -> InlineM ()

64−foreColor c = modify $ \s ->

59+foreColor c = modify $ flip mappend ( currentAttr `withForeColor` c )

65− s { inlineAttr = inlineAttr s `withForeColor` c

66− }

68-- | Attempt to change the 'Style' of the following text..

61-- | Attempt to change the 'Style' of the following text..

69--

62--

70-- If the terminal does not support the style change then no error is

63-- If the terminal does not support the style change then no error is

71-- produced. The style can still be removed.

64-- produced. The style can still be removed.

72applyStyle :: Style -> InlineM ()

65applyStyle :: Style -> InlineM ()

73−applyStyle st = modify $ \s ->

66+applyStyle s = modify $ flip mappend ( currentAttr `withStyle` s )

74− s { inlineAttr = inlineAttr s `withStyle` st

75− }

77-- | Attempt to remove the specified 'Style' from the display of the

68-- | Attempt to remove the specified 'Style' from the display of the

78-- following text.

69-- following text.

@@ -80,18 +71,16 @@ applyStyle st = modify $ \s ->

80-- This will fail if 'applyStyle' for the given style has not been

71-- This will fail if 'applyStyle' for the given style has not been

81-- previously called.

72-- previously called.

82removeStyle :: Style -> InlineM ()

73removeStyle :: Style -> InlineM ()

83−removeStyle sMask = modify $ \s ->

74+removeStyle sMask = modify $ \attr ->

84− s { inlineAttr =

85− let style' = case attrStyle (inlineAttr s) of

75+ let style' = case attrStyle attr of

86− Default -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

76+ Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

87− KeepCurrent -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

77+ KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

88− SetTo st -> st .&. complement sMask

78+ SetTo s -> s .&. complement sMask

89− in (inlineAttr s) { attrStyle = SetTo style' }

79+ in attr { attrStyle = SetTo style' }

90− }

92-- | Reset the display attributes.

81-- | Reset the display attributes.

93defaultAll :: InlineM ()

82defaultAll :: InlineM ()

94−defaultAll = modify $ \s -> s { inlineAttr = defAttr }

83+defaultAll = put defAttr

96-- | Apply the provided display attribute changes to the given terminal

85-- | Apply the provided display attribute changes to the given terminal

97-- output device.

86-- output device.

@@ -104,14 +93,14 @@ putAttrChange out c = liftIO $ do

104 mfattr <- prevFattr <$> readIORef (assumedStateRef out)

93 mfattr <- prevFattr <$> readIORef (assumedStateRef out)

105 fattr <- case mfattr of

94 fattr <- case mfattr of

106 Nothing -> do

95 Nothing -> do

107− liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc False

96+ liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc

108− return $ FixedAttr defaultStyleMask Nothing Nothing Nothing

97+ return $ FixedAttr defaultStyleMask Nothing Nothing

109 Just v -> return v

98 Just v -> return v

110− let InlineState attr urlsEnabled = execState c (InlineState currentAttr False)

99+ let attr = execState c currentAttr

111 attr' = limitAttrForDisplay out attr

100 attr' = limitAttrForDisplay out attr

112 fattr' = fixDisplayAttr fattr attr'

101 fattr' = fixDisplayAttr fattr attr'

113 diffs = displayAttrDiffs fattr fattr'

102 diffs = displayAttrDiffs fattr fattr'

114− outputByteBuffer out $ writeToByteString $ writeSetAttr dc urlsEnabled fattr attr' diffs

103+ outputByteBuffer out $ writeToByteString $ writeSetAttr dc fattr attr' diffs

115 modifyIORef (assumedStateRef out) $ \s -> s { prevFattr = Just fattr' }

104 modifyIORef (assumedStateRef out) $ \s -> s { prevFattr = Just fattr' }

116 inlineHack dc

105 inlineHack dc

117

106

src/Graphics/Vty/Input.hs+23−14

@@ -1,4 +1,4 @@

1−{-# LANGUAGE RecordWildCards, CPP #-}

1+{-# LANGUAGE RecordWildCards #-}

3-- | This module provides the input layer for Vty, including methods

4-- for initializing an 'Input' structure and reading 'Event's from the

@@ -77,7 +77,7 @@

77-- The input encoding determines how UTF-8 encoded characters are

78-- recognized.

79--

80−-- * 7-bit mode: UTF-8 can be input unambiguously. UTF-8 input is

80+-- * 7-bit mode: UTF-8 can be input unambiguiously. UTF-8 input is

81-- a superset of ASCII. UTF-8 does not overlap escaped control key

82-- sequences. However, the escape key must be differentiated from

83-- escaped control key sequences by the timing of the input bytes.

@@ -95,7 +95,7 @@

95--

96-- == Terminal Input is Broken

97--

98−-- Clearly terminal input has fundamental issues. There is no easy way

98+-- Clearly terminal input has fundemental issues. There is no easy way

99-- to reliably resolve these issues.

100--

101-- One resolution would be to ditch standard terminal interfaces

@@ -132,9 +132,7 @@ import Lens.Micro

132import qualified System.Console.Terminfo as Terminfo

133import System.Posix.Signals.Exts

134

135−#if !MIN_VERSION_base(4,11,0)

136import Data.Monoid ((<>))

135import Data.Monoid ((<>))

137−#endif

138

136

139-- | Set up the terminal with file descriptor `inputFd` for input.

137-- | Set up the terminal with file descriptor `inputFd` for input.

140-- Returns an 'Input'.

138-- Returns an 'Input'.

@@ -143,8 +141,22 @@ import Data.Monoid ((<>))

143-- bytes comes from 'classifyMapForTerm' which is then overridden by

141-- bytes comes from 'classifyMapForTerm' which is then overridden by

144-- the the applicable entries from the configuration's 'inputMap'.

142-- the the applicable entries from the configuration's 'inputMap'.

145--

143--

146−-- The terminal device's mode flags are configured by the

144+-- The terminal device is configured with the attributes:

147−-- 'attributeControl' function.

145+--

146+-- * IXON disabled: disables software flow control on outgoing data.

147+-- This stops the process from being suspended if the output terminal

148+-- cannot keep up.

149+--

150+-- * Raw mode is used for input.

151+--

152+-- * ISIG disabled (enables keyboard combinations that result in

153+-- signals)

154+--

155+-- * ECHO disabled (input is not echoed to the output)

156+--

157+-- * ICANON disabled (canonical mode (line mode) input is not used)

158+--

159+-- * IEXTEN disabled (extended functions are disabled)

148inputForConfig :: Config -> IO Input

160inputForConfig :: Config -> IO Input

149inputForConfig config@Config{ termName = Just termName

161inputForConfig config@Config{ termName = Just termName

150 , inputFd = Just termFd

162 , inputFd = Just termFd

@@ -154,23 +166,20 @@ inputForConfig config@Config{ termName = Just termName

154 terminal <- Terminfo.setupTerm termName

166 terminal <- Terminfo.setupTerm termName

155 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]

167 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]

156 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides

168 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides

157− (setAttrs, unsetAttrs) <- attributeControl termFd

169+ (setAttrs,unsetAttrs) <- attributeControl termFd

158 setAttrs

170 setAttrs

159 input <- initInput config activeInputMap

171 input <- initInput config activeInputMap

160 let pokeIO = Catch $ do

172 let pokeIO = Catch $ do

173+ let e = error "vty internal failure: this value should not propagate to users"

161 setAttrs

174 setAttrs

162− atomically $ writeTChan (input^.eventChannel) ResumeAfterSignal

175+ atomically $ writeTChan (input^.eventChannel) (EvResize e e)

163 _ <- installHandler windowChange pokeIO Nothing

176 _ <- installHandler windowChange pokeIO Nothing

164 _ <- installHandler continueProcess pokeIO Nothing

177 _ <- installHandler continueProcess pokeIO Nothing

165−

166− let restore = unsetAttrs

167−

168 return $ input

178 return $ input

169 { shutdownInput = do

179 { shutdownInput = do

170 shutdownInput input

180 shutdownInput input

171 _ <- installHandler windowChange Ignore Nothing

181 _ <- installHandler windowChange Ignore Nothing

172 _ <- installHandler continueProcess Ignore Nothing

182 _ <- installHandler continueProcess Ignore Nothing

173− restore

183+ unsetAttrs

174− , restoreInputState = restoreInputState input >> restore

175 }

184 }

176inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig

185inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig

src/Graphics/Vty/Input/Classify.hs+29−53

@@ -1,11 +1,10 @@

1{-# OPTIONS_HADDOCK hide #-}

2−-- This makes a kind of trie. Has space efficiency issues with large

2+-- This makes a kind of tri. Has space efficiency issues with large

3-- input blocks. Likely building a parser and just applying that would

4-- be better.

5module Graphics.Vty.Input.Classify

6 ( classify

7 , KClass(..)

8− , ClassifierState(..)

9 )

8 )

10where

9where

@@ -17,39 +16,25 @@ import Graphics.Vty.Input.Classify.Types

18import Codec.Binary.UTF8.Generic (decode)

17import Codec.Binary.UTF8.Generic (decode)

20−import Control.Arrow (first)

19+import Data.List (inits)

21import qualified Data.Map as M( fromList, lookup )

20import qualified Data.Map as M( fromList, lookup )

22import Data.Maybe ( mapMaybe )

21import Data.Maybe ( mapMaybe )

23import qualified Data.Set as S( fromList, member )

22import qualified Data.Set as S( fromList, member )

24+import Data.Char

25import Data.Word

27−import qualified Data.ByteString as BS

28−import qualified Data.ByteString.Char8 as BS8

29−import Data.ByteString.Char8 (ByteString)

30−

31−-- | Whether the classifier is currently processing a chunked format.

32−-- Currently, only bracketed pastes use this.

33−data ClassifierState

34− = ClassifierStart

35− -- ^ Not processing a chunked format.

36− | ClassifierInChunk ByteString [ByteString]

37− -- ^ Currently processing a chunked format. The initial chunk is in the

38− -- first argument and a reversed remainder of the chunks is collected in

39− -- the second argument. At the end of the processing, the chunks are

40− -- reversed and concatenated with the final chunk.

41−

42−compile :: ClassifyMap -> ByteString -> KClass

27+compile :: ClassifyMap -> [Char] -> KClass

43compile table = cl' where

28compile table = cl' where

44 -- take all prefixes and create a set of these

29 -- take all prefixes and create a set of these

45− prefixSet = S.fromList $ concatMap (init . BS.inits . BS8.pack . fst) table

30+ prefixSet = S.fromList $ concatMap (init . inits . fst) $ table

46 maxValidInputLength = maximum (map (length . fst) table)

31 maxValidInputLength = maximum (map (length . fst) table)

47− eventForInput = M.fromList $ map (first BS8.pack) table

32+ eventForInput = M.fromList table

48− cl' inputBlock | BS8.null inputBlock = Prefix

33+ cl' [] = Prefix

49 cl' inputBlock = case M.lookup inputBlock eventForInput of

34 cl' inputBlock = case M.lookup inputBlock eventForInput of

50 -- if the inputBlock is exactly what is expected for an

35 -- if the inputBlock is exactly what is expected for an

51 -- event then consume the whole block and return the event

36 -- event then consume the whole block and return the event

52− Just e -> Valid e BS8.empty

37+ Just e -> Valid e []

53 Nothing -> case S.member inputBlock prefixSet of

38 Nothing -> case S.member inputBlock prefixSet of

54 True -> Prefix

39 True -> Prefix

55 -- look up progressively smaller tails of the input

40 -- look up progressively smaller tails of the input

@@ -60,49 +45,40 @@ compile table = cl' where

60 -- H: There will always be one match. The prefixSet

45 -- H: There will always be one match. The prefixSet

61 -- contains, by definition, all prefixes of an event.

46 -- contains, by definition, all prefixes of an event.

62 False ->

47 False ->

63− let inputPrefixes = reverse . take maxValidInputLength . tail . BS8.inits $ inputBlock

48+ let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock

64 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of

49 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of

65− (s,e) : _ -> Valid e (BS8.drop (BS8.length s) inputBlock)

50+ (s,e) : _ -> Valid e (drop (length s) inputBlock)

66 -- neither a prefix or a full event.

51 -- neither a prefix or a full event.

67 [] -> Invalid

52 [] -> Invalid

69−classify :: ClassifyMap -> ClassifierState -> ByteString -> KClass

54+classify :: ClassifyMap -> [Char] -> KClass

70−classify table = process

55+classify table =

71− where

72− standardClassifier = compile table

56+ let standardClassifier = compile table

73−

74− process ClassifierStart s =

75− case BS.uncons s of

57+ in \s -> case s of

76− _ | bracketedPasteStarted s ->

58+ _ | bracketedPasteStarted s ->

77− if bracketedPasteFinished s

78− then parseBracketedPaste s

79− else Chunk

80− _ | isMouseEvent s -> classifyMouseEvent s

81− _ | isFocusEvent s -> classifyFocusEvent s

82− Just (c,cs) | c >= 0xC2 -> classifyUtf8 c cs

83− _ -> standardClassifier s

84−

85− process (ClassifierInChunk p ps) s | bracketedPasteStarted p =

86 if bracketedPasteFinished s

59 if bracketedPasteFinished s

87− then parseBracketedPaste $ BS.concat $ p:reverse (s:ps)

60+ then parseBracketedPaste s

88− else Chunk

61+ else Prefix

89− process ClassifierInChunk{} _ = Invalid

62+ _ | isMouseEvent s -> classifyMouseEvent s

63+ _ | isFocusEvent s -> classifyFocusEvent s

64+ c:cs | ord c >= 0xC2 -> classifyUtf8 c cs

65+ _ -> standardClassifier s

91−classifyUtf8 :: Word8 -> ByteString -> KClass

67+classifyUtf8 :: Char -> [Char] -> KClass

92classifyUtf8 c cs =

68classifyUtf8 c cs =

93− let n = utf8Length c

69+ let n = utf8Length (ord c)

94− (codepoint,rest) = BS8.splitAt (n - 1) cs

70+ (codepoint,rest) = splitAt n (c:cs)

96 codepoint8 :: [Word8]

72 codepoint8 :: [Word8]

97− codepoint8 = c:BS.unpack codepoint

73+ codepoint8 = map (fromIntegral . ord) codepoint

99 in case decode codepoint8 of

75 in case decode codepoint8 of

100− _ | n < BS.length codepoint + 1 -> Prefix

76+ _ | n < length codepoint -> Prefix

101− Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest

77+ Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest

102 -- something bad happened; just ignore and continue.

78 -- something bad happened; just ignore and continue.

103− Nothing -> Invalid

79+ Nothing -> Invalid

104

105−utf8Length :: Word8 -> Int

81+utf8Length :: (Num t, Ord a, Num a) => a -> t

106utf8Length c

82utf8Length c

107 | c < 0x80 = 1

83 | c < 0x80 = 1

108 | c < 0xE0 = 2

84 | c < 0xE0 = 2

src/Graphics/Vty/Input/Classify/Parse.hs+7−10

@@ -16,15 +16,12 @@ import Graphics.Vty.Input.Classify.Types

16import Control.Monad.Trans.Maybe

17import Control.Monad.State

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

24-- | Run a parser on a given input string. If the parser fails, return

21-- | Run a parser on a given input string. If the parser fails, return

25-- 'Invalid'. Otherwise return the valid event ('Valid') and the

22-- 'Invalid'. Otherwise return the valid event ('Valid') and the

26-- remaining unparsed characters.

23-- remaining unparsed characters.

27−runParser :: ByteString -> Parser Event -> KClass

24+runParser :: String -> Parser Event -> KClass

28runParser s parser =

25runParser s parser =

29 case runState (runMaybeT parser) s of

26 case runState (runMaybeT parser) s of

30 (Nothing, _) -> Invalid

27 (Nothing, _) -> Invalid

@@ -39,9 +36,9 @@ failParse = fail "invalid parse"

39-- return '123' and consume those characters.

36-- return '123' and consume those characters.

40readInt :: Parser Int

37readInt :: Parser Int

41readInt = do

38readInt = do

42− s <- BS8.unpack <$> get

39+ s <- get

43 case (reads :: ReadS Int) s of

40 case (reads :: ReadS Int) s of

44− [(i, rest)] -> put (BS8.pack rest) >> return i

41+ [(i, rest)] -> put rest >> return i

45 _ -> failParse

42 _ -> failParse

47-- | Read a character from the input stream. If one cannot be read (e.g.

44-- | Read a character from the input stream. If one cannot be read (e.g.

@@ -49,9 +46,9 @@ readInt = do

49readChar :: Parser Char

46readChar :: Parser Char

50readChar = do

47readChar = do

51 s <- get

48 s <- get

52− case BS8.uncons s of

49+ case s of

53− Just (c,rest) -> put rest >> return c

50+ c:rest -> put rest >> return c

54− Nothing -> failParse

51+ _ -> failParse

56-- | Read a character from the input stream and fail parsing if it is

53-- | Read a character from the input stream and fail parsing if it is

57-- not the specified character.

54-- not the specified character.

src/Graphics/Vty/Input/Classify/Types.hs+1−7

@@ -1,6 +1,5 @@

1-- | This module exports the input classification type to avoid import

2-- cycles between other modules that need this.

3−{-# LANGUAGE StrictData #-}

4module Graphics.Vty.Input.Classify.Types

3module Graphics.Vty.Input.Classify.Types

5 ( KClass(..)

4 ( KClass(..)

6 )

5 )

@@ -8,10 +7,8 @@ where

9import Graphics.Vty.Input.Events

8import Graphics.Vty.Input.Events

11−import Data.ByteString.Char8 (ByteString)

12−

13data KClass

10data KClass

14− = Valid Event ByteString

11+ = Valid Event [Char]

15 -- ^ A valid event was parsed. Any unused characters from the input

12 -- ^ A valid event was parsed. Any unused characters from the input

16 -- stream are also provided.

13 -- stream are also provided.

17 | Invalid

14 | Invalid

@@ -19,7 +16,4 @@ data KClass

19 | Prefix

16 | Prefix

20 -- ^ The input characters form the prefix of a valid event character

17 -- ^ The input characters form the prefix of a valid event character

21 -- sequence.

18 -- sequence.

22− | Chunk

23− -- ^ The input characters are either start of a bracketed paste chunk

24− -- or in the middle of a bracketed paste chunk.

25 deriving(Show, Eq)

19 deriving(Show, Eq)

src/Graphics/Vty/Input/Events.hs+6−24

@@ -1,8 +1,6 @@

1{-# Language DeriveGeneric #-}

2−{-# Language StrictData #-}

3module Graphics.Vty.Input.Events where

2module Graphics.Vty.Input.Events where

5−import Control.DeepSeq

6import Data.ByteString

4import Data.ByteString

7import GHC.Generics

5import GHC.Generics

@@ -16,29 +14,23 @@ import GHC.Generics

16--

14--

17-- * Actually, support for most of these but KEsc, KChar, KBS, and

15-- * Actually, support for most of these but KEsc, KChar, KBS, and

18-- KEnter vary by terminal and keyboard.

16-- KEnter vary by terminal and keyboard.

19−data Key = KEsc | KChar {-# UNPACK #-} Char | KBS | KEnter

17+data Key = KEsc | KChar Char | KBS | KEnter

20 | KLeft | KRight | KUp | KDown

18 | KLeft | KRight | KUp | KDown

22− | KFun {-# UNPACK #-} Int | KBackTab | KPrtScr | KPause | KIns

24 deriving (Eq,Show,Read,Ord,Generic)

22 deriving (Eq,Show,Read,Ord,Generic)

26−instance NFData Key

27−

28-- | Modifier keys. Key codes are interpreted such that users are more

24-- | Modifier keys. Key codes are interpreted such that users are more

29-- likely to have Meta than Alt; for instance on the PC Linux console,

25-- likely to have Meta than Alt; for instance on the PC Linux console,

30-- 'MMeta' will generally correspond to the physical Alt key.

26-- 'MMeta' will generally correspond to the physical Alt key.

31data Modifier = MShift | MCtrl | MMeta | MAlt

27data Modifier = MShift | MCtrl | MMeta | MAlt

32 deriving (Eq,Show,Read,Ord,Generic)

28 deriving (Eq,Show,Read,Ord,Generic)

34−instance NFData Modifier

35−

36-- | Mouse buttons.

30-- | Mouse buttons.

37data Button = BLeft | BMiddle | BRight | BScrollUp | BScrollDown

31data Button = BLeft | BMiddle | BRight | BScrollUp | BScrollDown

38 deriving (Eq,Show,Read,Ord,Generic)

32 deriving (Eq,Show,Read,Ord,Generic)

40−instance NFData Button

41−

42-- | Events.

34-- | Events.

43data Event

35data Event

44 = EvKey Key [Modifier]

36 = EvKey Key [Modifier]

@@ -52,8 +44,10 @@ data Event

52 -- without specifying which one; in that case, Nothing is provided.

44 -- without specifying which one; in that case, Nothing is provided.

53 -- Otherwise Just the button released is included in the event.

45 -- Otherwise Just the button released is included in the event.

54 | EvResize Int Int

46 | EvResize Int Int

55− -- The terminal window was resized and the size is provided in the

47+ -- ^ If read from 'eventChannel' this is the size at the time of the

56− -- integer fields (width, height).

48+ -- signal. If read from 'nextEvent' this is the size at the time the

49+ -- event was processed by Vty. Typically these are the same, but if

50+ -- somebody is resizing the terminal quickly they can be different.

57 | EvPaste ByteString

51 | EvPaste ByteString

58 -- ^ A paste event occurs when a bracketed paste input sequence is

52 -- ^ A paste event occurs when a bracketed paste input sequence is

59 -- received. For terminals that support bracketed paste mode, these

53 -- received. For terminals that support bracketed paste mode, these

@@ -68,16 +62,4 @@ data Event

68 -- ^ The terminal running the application gained input focus.

62 -- ^ The terminal running the application gained input focus.

69 deriving (Eq,Show,Read,Ord,Generic)

63 deriving (Eq,Show,Read,Ord,Generic)

71−instance NFData Event

72−

73type ClassifyMap = [(String,Event)]

65type ClassifyMap = [(String,Event)]

74−

75−-- | The type of internal events that drive the internal Vty event

76−-- dispatching to the application.

77−data InternalEvent =

78− ResumeAfterSignal

79− -- ^ Vty resumed operation after the process was interrupted with a

80− -- signal. In practice this translates into a screen redraw in the

81− -- input event loop.

82− | InputEvent Event

83− -- ^ An input event was received.

src/Graphics/Vty/Input/Focus.hs+13−15

@@ -11,32 +11,30 @@ import Graphics.Vty.Input.Classify.Types

11import Graphics.Vty.Input.Classify.Parse

13import Control.Monad.State

14−

14+import Data.List (isPrefixOf)

15−import qualified Data.ByteString.Char8 as BS8

16−import Data.ByteString.Char8 (ByteString)

18-- | These sequences set xterm-based terminals to send focus event

16-- | These sequences set xterm-based terminals to send focus event

19-- sequences.

17-- sequences.

20−requestFocusEvents :: ByteString

18+requestFocusEvents :: String

21−requestFocusEvents = BS8.pack "\ESC[?1004h"

19+requestFocusEvents = "\ESC[?1004h"

23-- | These sequences disable focus events.

21-- | These sequences disable focus events.

24−disableFocusEvents :: ByteString

22+disableFocusEvents :: String

25−disableFocusEvents = BS8.pack "\ESC[?1004l"

23+disableFocusEvents = "\ESC[?1004l"

27-- | Does the specified string begin with a focus event?

25-- | Does the specified string begin with a focus event?

28−isFocusEvent :: ByteString -> Bool

26+isFocusEvent :: String -> Bool

29−isFocusEvent s = BS8.isPrefixOf focusIn s ||

27+isFocusEvent s = isPrefixOf focusIn s ||

30− BS8.isPrefixOf focusOut s

28+ isPrefixOf focusOut s

32−focusIn :: ByteString

30+focusIn :: String

33−focusIn = BS8.pack "\ESC[I"

31+focusIn = "\ESC[I"

35−focusOut :: ByteString

33+focusOut :: String

36−focusOut = BS8.pack "\ESC[O"

34+focusOut = "\ESC[O"

38-- | Attempt to classify an input string as a focus event.

36-- | Attempt to classify an input string as a focus event.

39−classifyFocusEvent :: ByteString -> KClass

37+classifyFocusEvent :: String -> KClass

40classifyFocusEvent s = runParser s $ do

38classifyFocusEvent s = runParser s $ do

41 when (not $ isFocusEvent s) failParse

39 when (not $ isFocusEvent s) failParse

src/Graphics/Vty/Input/Loop.hs+30−87

@@ -1,9 +1,8 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE NoMonomorphismRestriction #-}

3{-# LANGUAGE RecordWildCards #-}

1{-# LANGUAGE RecordWildCards #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

5−{-# LANGUAGE TemplateHaskell #-}

6{-# OPTIONS_HADDOCK hide #-}

2{-# OPTIONS_HADDOCK hide #-}

3+{-# LANGUAGE NoMonomorphismRestriction #-}

4+{-# LANGUAGE TemplateHaskell #-}

5+{-# LANGUAGE CPP #-}

7-- | The input layer used to be a single function that correctly

6-- | The input layer used to be a single function that correctly

8-- accounted for the non-threaded runtime by emulating the terminal

7-- accounted for the non-threaded runtime by emulating the terminal

9-- VMIN adn VTIME handling. This has been removed and replace with a

8-- VMIN adn VTIME handling. This has been removed and replace with a

@@ -25,7 +24,7 @@ import Control.Applicative

25import Control.Concurrent

24import Control.Concurrent

26import Control.Concurrent.STM

25import Control.Concurrent.STM

27import Control.Exception (mask, try, SomeException)

26import Control.Exception (mask, try, SomeException)

28−import Lens.Micro hiding ((<>~))

27+import Lens.Micro

29import Lens.Micro.Mtl

28import Lens.Micro.Mtl

30import Lens.Micro.TH

29import Lens.Micro.TH

31import Control.Monad (when, mzero, forM_)

30import Control.Monad (when, mzero, forM_)

@@ -34,15 +33,12 @@ import Control.Monad.Trans.State (StateT(..), evalStateT)

34import Control.Monad.State.Class (MonadState, modify)

33import Control.Monad.State.Class (MonadState, modify)

35import Control.Monad.Trans.Reader (ReaderT(..))

34import Control.Monad.Trans.Reader (ReaderT(..))

37−import qualified Data.ByteString.Char8 as BS8

36+import Data.Char

38−import qualified Data.ByteString as BS

39−import Data.ByteString.Char8 (ByteString)

40import Data.IORef

37import Data.IORef

41import Data.Word (Word8)

38import Data.Word (Word8)

43−import Foreign (allocaArray)

40+import Foreign ( allocaArray, peekArray, Ptr )

44import Foreign.C.Types (CInt(..))

41import Foreign.C.Types (CInt(..))

45−import Foreign.Ptr (Ptr, castPtr)

47import System.IO

43import System.IO

48import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))

44import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))

@@ -55,15 +51,10 @@ data Input = Input

55 { -- | Channel of events direct from input processing. Unlike

51 { -- | Channel of events direct from input processing. Unlike

56 -- 'nextEvent' this will not refresh the display if the next event

52 -- 'nextEvent' this will not refresh the display if the next event

57 -- is an 'EvResize'.

53 -- is an 'EvResize'.

58− _eventChannel :: TChan InternalEvent

54+ _eventChannel :: TChan Event

59− -- | Shuts down the input processing. As part of shutting down the

55+ -- | Shuts down the input processing. This should return the

60− -- input, this should also restore the input state.

56+ -- terminal input state to before he input initialized.

61 , shutdownInput :: IO ()

57 , shutdownInput :: IO ()

62− -- | Restore the terminal's input state to what it was prior

63− -- to configuring input for Vty. This should be done as part of

64− -- 'shutdownInput' but is exposed in case you need to access it

65− -- directly.

66− , restoreInputState :: IO ()

67 -- | Changes to this value are reflected after the next event.

58 -- | Changes to this value are reflected after the next event.

68 , _configRef :: IORef Config

59 , _configRef :: IORef Config

69 -- | input debug log

60 -- | input debug log

@@ -80,11 +71,10 @@ data InputBuffer = InputBuffer

80makeLenses ''InputBuffer

71makeLenses ''InputBuffer

82data InputState = InputState

73data InputState = InputState

83− { _unprocessedBytes :: ByteString

74+ { _unprocessedBytes :: String

84− , _classifierState :: ClassifierState

85 , _appliedConfig :: Config

75 , _appliedConfig :: Config

86 , _inputBuffer :: InputBuffer

76 , _inputBuffer :: InputBuffer

87− , _classifier :: ClassifierState -> ByteString -> KClass

77+ , _classifier :: String -> KClass

88 }

78 }

90makeLenses ''InputState

80makeLenses ''InputState

@@ -109,20 +99,20 @@ loopInputProcessor = do

109 dropInvalid

99 dropInvalid

110 loopInputProcessor

100 loopInputProcessor

111

101

112−addBytesToProcess :: ByteString -> InputM ()

102+addBytesToProcess :: String -> InputM ()

113addBytesToProcess block = unprocessedBytes <>= block

103addBytesToProcess block = unprocessedBytes <>= block

114

104

115emit :: Event -> InputM ()

105emit :: Event -> InputM ()

116emit event = do

106emit event = do

117 logMsg $ "parsed event: " ++ show event

107 logMsg $ "parsed event: " ++ show event

118− view eventChannel >>= liftIO . atomically . flip writeTChan (InputEvent event)

108+ view eventChannel >>= liftIO . atomically . flip writeTChan event

119

109

120-- The timing requirements are assured by the VMIN and VTIME set for the

110-- The timing requirements are assured by the VMIN and VTIME set for the

121-- device.

111-- device.

122--

112--

123-- Precondition: Under the threaded runtime. Only current use is from a

113-- Precondition: Under the threaded runtime. Only current use is from a

124-- forkOS thread. That case satisfies precondition.

114-- forkOS thread. That case satisfies precondition.

125−readFromDevice :: InputM ByteString

115+readFromDevice :: InputM String

126readFromDevice = do

116readFromDevice = do

127 newConfig <- view configRef >>= liftIO . readIORef

117 newConfig <- view configRef >>= liftIO . readIORef

128 oldConfig <- use appliedConfig

118 oldConfig <- use appliedConfig

@@ -142,10 +132,9 @@ readFromDevice = do

142 threadWaitRead fd

132 threadWaitRead fd

143 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)

133 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)

144 if bytesRead > 0

134 if bytesRead > 0

145− then BS.packCStringLen (castPtr bufferPtr, fromIntegral bytesRead)

135+ then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr

146− else return BS.empty

136+ else return []

147− when (not $ BS.null stringRep) $

148− logMsg $ "input bytes: " ++ show (BS8.unpack stringRep)

137+ when (not $ null stringRep) $ logMsg $ "input bytes: " ++ show stringRep

149 return stringRep

138 return stringRep

150

139

151applyConfig :: Fd -> Config -> IO ()

140applyConfig :: Fd -> Config -> IO ()

@@ -156,86 +145,41 @@ applyConfig _ _ = fail "(vty) applyConfig was not provided a complete configurat

156parseEvent :: InputM Event

145parseEvent :: InputM Event

157parseEvent = do

146parseEvent = do

158 c <- use classifier

147 c <- use classifier

159− s <- use classifierState

160 b <- use unprocessedBytes

148 b <- use unprocessedBytes

161− case c s b of

149+ case c b of

162 Valid e remaining -> do

150 Valid e remaining -> do

163 logMsg $ "valid parse: " ++ show e

151 logMsg $ "valid parse: " ++ show e

164 logMsg $ "remaining: " ++ show remaining

152 logMsg $ "remaining: " ++ show remaining

165− classifierState .= ClassifierStart

166 unprocessedBytes .= remaining

153 unprocessedBytes .= remaining

167 return e

154 return e

168− _ -> mzero

155+ _ -> mzero

169

156

170dropInvalid :: InputM ()

157dropInvalid :: InputM ()

171dropInvalid = do

158dropInvalid = do

172 c <- use classifier

159 c <- use classifier

173− s <- use classifierState

174 b <- use unprocessedBytes

160 b <- use unprocessedBytes

175− case c s b of

176− Chunk -> do

177− classifierState .=

178− case s of

179− ClassifierStart -> ClassifierInChunk b []

180− ClassifierInChunk p bs -> ClassifierInChunk p (b:bs)

181− unprocessedBytes .= BS8.empty

182− Invalid -> do

161+ when (c b == Invalid) $ do

183− logMsg "dropping input bytes"

162+ logMsg "dropping input bytes"

184− classifierState .= ClassifierStart

185− unprocessedBytes .= BS8.empty

163+ unprocessedBytes .= []

186− _ -> return ()

187

164

188runInputProcessorLoop :: ClassifyMap -> Input -> IO ()

165runInputProcessorLoop :: ClassifyMap -> Input -> IO ()

189runInputProcessorLoop classifyTable input = do

166runInputProcessorLoop classifyTable input = do

190 let bufferSize = 1024

167 let bufferSize = 1024

191 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do

168 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do

192− s0 <- InputState BS8.empty ClassifierStart

193− <$> readIORef (_configRef input)

169+ s0 <- InputState [] <$> readIORef (_configRef input)

194− <*> pure (InputBuffer bufferPtr bufferSize)

170+ <*> pure (InputBuffer bufferPtr bufferSize)

195− <*> pure (classify classifyTable)

171+ <*> pure (classify classifyTable)

196 runReaderT (evalStateT loopInputProcessor s0) input

172 runReaderT (evalStateT loopInputProcessor s0) input

197

173

198−-- | Construct two IO actions: one to configure the terminal for Vty and

199−-- one to restore the terminal mode flags to the values they had at the

200−-- time this function was called.

201−--

202−-- This function constructs a configuration action to clear the

203−-- following terminal mode flags:

204−--

205−-- * IXON disabled: disables software flow control on outgoing data.

206−-- This stops the process from being suspended if the output terminal

207−-- cannot keep up.

208−--

209−-- * Raw mode is used for input.

210−--

211−-- * ISIG (enables keyboard combinations that result in

212−-- signals)

213−--

214−-- * ECHO (input is not echoed to the output)

215−--

216−-- * ICANON (canonical mode (line mode) input is not used)

217−--

218−-- * IEXTEN (extended functions are disabled)

219−--

220−-- The configuration action also explicitly sets these flags:

221−--

222−-- * ICRNL (input carriage returns are mapped to newlines)

223attributeControl :: Fd -> IO (IO (), IO ())

174attributeControl :: Fd -> IO (IO (), IO ())

224attributeControl fd = do

175attributeControl fd = do

225 original <- getTerminalAttributes fd

176 original <- getTerminalAttributes fd

226− let vtyMode = foldl withMode clearedFlags flagsToSet

227− clearedFlags = foldl withoutMode original flagsToUnset

228− flagsToSet = [ MapCRtoLF -- ICRNL

229− ]

230− flagsToUnset = [ StartStopOutput -- IXON

231− , KeyboardInterrupts -- ISIG

177+ let vtyMode = foldl withoutMode original [ StartStopOutput, KeyboardInterrupts

232− , EnableEcho -- ECHO

233− , ProcessInput -- ICANON

234− , ExtendedFunctions -- IEXTEN

178+ , EnableEcho, ProcessInput, ExtendedFunctions

235− ]

179+ ]

236 let setAttrs = setTerminalAttributes fd vtyMode Immediately

180 let setAttrs = setTerminalAttributes fd vtyMode Immediately

237 unsetAttrs = setTerminalAttributes fd original Immediately

181 unsetAttrs = setTerminalAttributes fd original Immediately

238− return (setAttrs, unsetAttrs)

182+ return (setAttrs,unsetAttrs)

239

183

240logInitialInputState :: Input -> ClassifyMap -> IO()

184logInitialInputState :: Input -> ClassifyMap -> IO()

241logInitialInputState input classifyTable = case _inputDebug input of

185logInitialInputState input classifyTable = case _inputDebug input of

@@ -243,7 +187,7 @@ logInitialInputState input classifyTable = case _inputDebug input of

243 Just h -> do

187 Just h -> do

244 Config{ vmin = Just theVmin

188 Config{ vmin = Just theVmin

245 , vtime = Just theVtime

189 , vtime = Just theVtime

246− , termName = Just theTerm } <- readIORef $ _configRef input

190+ , termName = Just theTerm, .. } <- readIORef $ _configRef input

247 _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))

191 _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))

248 forM_ classifyTable $ \i -> case i of

192 forM_ classifyTable $ \i -> case i of

249 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)

193 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)

@@ -259,7 +203,6 @@ initInput config classifyTable = do

259 applyConfig fd config

203 applyConfig fd config

260 stopSync <- newEmptyMVar

204 stopSync <- newEmptyMVar

261 input <- Input <$> atomically newTChan

205 input <- Input <$> atomically newTChan

262− <*> pure (return ())

263 <*> pure (return ())

206 <*> pure (return ())

264 <*> newIORef config

207 <*> newIORef config

265 <*> maybe (return Nothing)

208 <*> maybe (return Nothing)

src/Graphics/Vty/Input/Mouse.hs+17−19

@@ -15,12 +15,10 @@ import Graphics.Vty.Input.Classify.Types

15import Graphics.Vty.Input.Classify.Parse

17import Control.Monad.State

18+import Data.List (isPrefixOf)

18import Data.Maybe (catMaybes)

19import Data.Maybe (catMaybes)

19import Data.Bits ((.&.))

20import Data.Bits ((.&.))

21−import qualified Data.ByteString.Char8 as BS8

22−import Data.ByteString.Char8 (ByteString)

23−

24-- A mouse event in SGR extended mode is

22-- A mouse event in SGR extended mode is

25--

23--

26-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')

24-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')

@@ -34,28 +32,28 @@ import Data.ByteString.Char8 (ByteString)

35-- | These sequences set xterm-based terminals to send mouse event

33-- | These sequences set xterm-based terminals to send mouse event

36-- sequences.

34-- sequences.

37−requestMouseEvents :: ByteString

35+requestMouseEvents :: String

38−requestMouseEvents = BS8.pack "\ESC[?1000h\ESC[?1002h\ESC[?1006h"

36+requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h"

40-- | These sequences disable mouse events.

38-- | These sequences disable mouse events.

41−disableMouseEvents :: ByteString

39+disableMouseEvents :: String

42−disableMouseEvents = BS8.pack "\ESC[?1000l\ESC[?1002l\ESC[?1006l"

40+disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l"

44-- | Does the specified string begin with a mouse event?

42-- | Does the specified string begin with a mouse event?

45−isMouseEvent :: ByteString -> Bool

43+isMouseEvent :: String -> Bool

46isMouseEvent s = isSGREvent s || isNormalEvent s

44isMouseEvent s = isSGREvent s || isNormalEvent s

48−isSGREvent :: ByteString -> Bool

46+isSGREvent :: String -> Bool

49−isSGREvent = BS8.isPrefixOf sgrPrefix

47+isSGREvent = isPrefixOf sgrPrefix

51−sgrPrefix :: ByteString

49+sgrPrefix :: String

52−sgrPrefix = BS8.pack "\ESC[M"

50+sgrPrefix = "\ESC[M"

54−isNormalEvent :: ByteString -> Bool

52+isNormalEvent :: String -> Bool

55−isNormalEvent = BS8.isPrefixOf normalPrefix

53+isNormalEvent = isPrefixOf normalPrefix

57−normalPrefix :: ByteString

55+normalPrefix :: String

58−normalPrefix = BS8.pack "\ESC[<"

56+normalPrefix = "\ESC[<"

60-- Modifier bits:

58-- Modifier bits:

61shiftBit :: Int

59shiftBit :: Int

@@ -89,8 +87,8 @@ scrollDown = 65

89hasBitSet :: Int -> Int -> Bool

87hasBitSet :: Int -> Int -> Bool

90hasBitSet val bit = val .&. bit > 0

88hasBitSet val bit = val .&. bit > 0

92−-- | Attempt to classify an input string as a mouse event.

90+-- | Attempt to lassify an input string as a mouse event.

93−classifyMouseEvent :: ByteString -> KClass

91+classifyMouseEvent :: String -> KClass

94classifyMouseEvent s = runParser s $ do

92classifyMouseEvent s = runParser s $ do

95 when (not $ isMouseEvent s) failParse

93 when (not $ isMouseEvent s) failParse

@@ -102,7 +100,7 @@ classifyMouseEvent s = runParser s $ do

102 'M' -> classifyNormalMouseEvent

100 'M' -> classifyNormalMouseEvent

103 _ -> failParse

101 _ -> failParse

104

102

105−-- Given a modifier/button value, determine which button was indicated

103+-- Given a modifer/button value, determine which button was indicated

106getSGRButton :: Int -> Parser Button

104getSGRButton :: Int -> Parser Button

107getSGRButton mods =

105getSGRButton mods =

108 let buttonMap = [ (leftButton, BLeft)

106 let buttonMap = [ (leftButton, BLeft)

src/Graphics/Vty/Input/Paste.hs+24−16

@@ -9,33 +9,41 @@ module Graphics.Vty.Input.Paste

9where

11import qualified Data.ByteString.Char8 as BS8

12−import Data.ByteString.Char8 (ByteString)

14import Graphics.Vty.Input.Events

13import Graphics.Vty.Input.Events

15import Graphics.Vty.Input.Classify.Types

14import Graphics.Vty.Input.Classify.Types

17−bracketedPasteStart :: ByteString

16+import Data.List (isPrefixOf, isInfixOf)

18−bracketedPasteStart = BS8.pack "\ESC[200~"

18+bracketedPasteStart :: String

19+bracketedPasteStart = "\ESC[200~"

20+

20−bracketedPasteEnd :: ByteString

21+bracketedPasteEnd :: String

21−bracketedPasteEnd = BS8.pack "\ESC[201~"

22+bracketedPasteEnd = "\ESC[201~"

23-- | Does the input start a bracketed paste?

24-- | Does the input start a bracketed paste?

24−bracketedPasteStarted :: ByteString -> Bool

25+bracketedPasteStarted :: String -> Bool

25−bracketedPasteStarted = BS8.isPrefixOf bracketedPasteStart

26+bracketedPasteStarted = isPrefixOf bracketedPasteStart

27-- | Does the input contain a complete bracketed paste?

28-- | Does the input contain a complete bracketed paste?

28−bracketedPasteFinished :: ByteString -> Bool

29+bracketedPasteFinished :: String -> Bool

29−bracketedPasteFinished = BS8.isInfixOf bracketedPasteEnd

30+bracketedPasteFinished = isInfixOf bracketedPasteEnd

31-- | Parse a bracketed paste. This should only be called on a string if

32-- | Parse a bracketed paste. This should only be called on a string if

32-- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return

33-- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return

33-- 'True'.

34-- 'True'.

34−parseBracketedPaste :: ByteString -> KClass

35+parseBracketedPaste :: String -> KClass

35parseBracketedPaste s =

36parseBracketedPaste s =

37+ let (p, rest) = takeUntil (drop (length bracketedPasteStart) s) bracketedPasteEnd

38+ rest' = if bracketedPasteEnd `isPrefixOf` rest

39+ then drop (length bracketedPasteEnd) rest

40+ else rest

36− Valid (EvPaste p) (BS8.drop endLen rest')

41+ in Valid (EvPaste $ BS8.pack p) rest'

37− where

42+

38− startLen = BS8.length bracketedPasteStart

43+takeUntil :: (Eq a) => [a] -> [a] -> ([a],[a])

39− endLen = BS8.length bracketedPasteEnd

44+takeUntil [] _ = ([], [])

40− (_, rest ) = BS8.breakSubstring bracketedPasteStart s

45+takeUntil cs sub

41− (p, rest') = BS8.breakSubstring bracketedPasteEnd . BS8.drop startLen $ rest

46+ | length cs < length sub = (cs, [])

47+ | take (length sub) cs == sub = ([], drop (length sub) cs)

48+ | otherwise = let (pre, suf) = takeUntil (tail cs) sub

49+ in (head cs:pre, suf)

src/Graphics/Vty/Input/Terminfo.hs+4−6

@@ -74,7 +74,7 @@ visibleChars = [ ([x], EvKey (KChar x) [])

74ctrlChars :: ClassifyMap

75ctrlChars =

76 [ ([toEnum x],EvKey (KChar y) [MCtrl])

77− | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_'])

77+ | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_'])

78 , y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.

79 , y /= 'h' -- CTRL-h should not hide BS

80 ]

@@ -86,12 +86,10 @@ ctrlMetaChars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrlChars

86-- | Esc, meta-esc, delete, meta-delete, enter, meta-enter.

87specialSupportKeys :: ClassifyMap

88specialSupportKeys =

89− [ ("\ESC\ESC[5~",EvKey KPageUp [MMeta])

90− , ("\ESC\ESC[6~",EvKey KPageDown [MMeta])

91− -- special support for ESC

89+ [ -- special support for ESC

92− , ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

90+ ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

93 -- Special support for backspace

91 -- Special support for backspace

94− , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta]), ("\b",EvKey KBS [])

92+ , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])

95 -- Special support for Enter

93 -- Special support for Enter

96 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])

94 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])

97 -- explicit support for tab

95 -- explicit support for tab

src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+1−1

@@ -59,7 +59,7 @@ navKeys3 =

59-- This encoding depends on the terminal.

60functionKeys1 :: ClassifyMap

61functionKeys1 =

62− let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-head nrs+ff) m) | n <- nrs ] in

62+ let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in

63 concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]

65-- | encoding for meta plus char

src/Graphics/Vty/Output.hs+14−15

@@ -1,4 +1,5 @@

1−{-# LANGUAGE RecordWildCards, CPP #-}

1+{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE NamedFieldPuns #-}

2-- | This module provides functions for accessing the current terminal

3-- | This module provides functions for accessing the current terminal

3-- or a specific terminal device.

4-- or a specific terminal device.

4--

5--

@@ -37,11 +38,10 @@ import Graphics.Vty.Output.TerminfoBased as TerminfoBased

38import Blaze.ByteString.Builder (writeToByteString)

39import Blaze.ByteString.Builder (writeToByteString)

40−import Data.List (isPrefixOf)

41+import Control.Monad.Trans

42−#if !MIN_VERSION_base(4,11,0)

43+import Data.List (isPrefixOf)

43import Data.Monoid ((<>))

44import Data.Monoid ((<>))

44−#endif

46-- | Returns an `Output` for the terminal specified in `Config`.

47--

@@ -58,12 +58,11 @@ import Data.Monoid ((<>))

58-- * If TERM contains "xterm" or "screen", use XTermColor.

59-- * otherwise use the TerminfoBased driver.

60outputForConfig :: Config -> IO Output

61−outputForConfig Config{ outputFd = Just fd, termName = Just termName

61+outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do

62− , colorMode = Just colorMode, .. } = do

63 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName

62 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName

64− then XTermColor.reserveTerminal termName fd colorMode

63+ then XTermColor.reserveTerminal termName fd

65 -- Not an xterm-like terminal. try for generic terminfo.

64 -- Not an xterm-like terminal. try for generic terminfo.

66− else TerminfoBased.reserveTerminal termName fd colorMode

65+ else TerminfoBased.reserveTerminal termName fd

68 case mouseMode of

67 case mouseMode of

69 Just s -> setMode t Mouse s

68 Just s -> setMode t Mouse s

@@ -78,30 +77,30 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig

79-- | Sets the cursor position to the given output column and row.

78-- | Sets the cursor position to the given output column and row.

80--

79--

81−-- This is not necessarily the same as the character position with the

80+-- This is not necessarially the same as the character position with the

82-- same coordinates. Characters can be a variable number of columns in

81-- same coordinates. Characters can be a variable number of columns in

83-- width.

82-- width.

84--

83--

85-- Currently, the only way to set the cursor position to a given

84-- Currently, the only way to set the cursor position to a given

86-- character coordinate is to specify the coordinate in the Picture

85-- character coordinate is to specify the coordinate in the Picture

87-- instance provided to 'outputPicture' or 'refresh'.

86-- instance provided to 'outputPicture' or 'refresh'.

88−setCursorPos :: Output -> Int -> Int -> IO ()

87+setCursorPos :: MonadIO m => Output -> Int -> Int -> m ()

89setCursorPos t x y = do

88setCursorPos t x y = do

90 bounds <- displayBounds t

89 bounds <- displayBounds t

91 when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do

90 when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do

92 dc <- displayContext t bounds

91 dc <- displayContext t bounds

93− outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

92+ liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

95-- | Hides the cursor.

94-- | Hides the cursor.

96−hideCursor :: Output -> IO ()

95+hideCursor :: MonadIO m => Output -> m ()

97hideCursor t = do

96hideCursor t = do

98 bounds <- displayBounds t

97 bounds <- displayBounds t

99 dc <- displayContext t bounds

98 dc <- displayContext t bounds

100− outputByteBuffer t $ writeToByteString $ writeHideCursor dc

99+ liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc

101

100

102-- | Shows the cursor.

101-- | Shows the cursor.

103−showCursor :: Output -> IO ()

102+showCursor :: MonadIO m => Output -> m ()

104showCursor t = do

103showCursor t = do

105 bounds <- displayBounds t

104 bounds <- displayBounds t

106 dc <- displayContext t bounds

105 dc <- displayContext t bounds

107− outputByteBuffer t $ writeToByteString $ writeShowCursor dc

106+ liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc

src/Graphics/Vty/Output/Interface.hs+52−85

@@ -1,9 +1,9 @@

1-- Copyright Corey O'Connor

2+{-# LANGUAGE BangPatterns #-}

2{-# LANGUAGE RankNTypes #-}

3{-# LANGUAGE RankNTypes #-}

3{-# LANGUAGE ExistentialQuantification #-}

4{-# LANGUAGE ExistentialQuantification #-}

4{-# LANGUAGE GADTs #-}

5{-# LANGUAGE GADTs #-}

5{-# LANGUAGE FlexibleContexts #-}

6{-# LANGUAGE FlexibleContexts #-}

6−{-# LANGUAGE ScopedTypeVariables #-}

7-- | This module provides an abstract interface for performing terminal

8-- output. The only user-facing part of this API is 'Output'.

9module Graphics.Vty.Output.Interface

@@ -29,6 +29,8 @@ import Graphics.Vty.DisplayAttributes

29import Blaze.ByteString.Builder (Write, writeToByteString)

30import Blaze.ByteString.Builder.ByteString (writeByteString)

32+import Control.Monad.Trans

33+

32import qualified Data.ByteString as BS

34import qualified Data.ByteString as BS

33import Data.IORef

35import Data.IORef

34import qualified Data.Text.Encoding as T

36import qualified Data.Text.Encoding as T

@@ -45,12 +47,6 @@ data Mode = Mouse

45 | Focus

47 | Focus

46 -- ^ Focus-in/focus-out events (whether the terminal is

48 -- ^ Focus-in/focus-out events (whether the terminal is

47 -- configured to provide events on focus change)

49 -- configured to provide events on focus change)

48− | Hyperlink

49− -- ^ Hyperlink mode via the 'withURL' attribute modifier (see

50− -- https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda).

51− -- Note that this may not work gracefully in all terminal

52− -- emulators so be sure to test this mode with the terminals

53− -- you intend to support. It is off by default.

54 deriving (Eq, Read, Show)

50 deriving (Eq, Read, Show)

56-- | The Vty terminal output interface.

52-- | The Vty terminal output interface.

@@ -59,7 +55,7 @@ data Output = Output

59 terminalID :: String

55 terminalID :: String

60 -- | Release the terminal just prior to application exit and reset

56 -- | Release the terminal just prior to application exit and reset

61 -- it to its state prior to application startup.

57 -- it to its state prior to application startup.

62− , releaseTerminal :: IO ()

58+ , releaseTerminal :: forall m. MonadIO m => m ()

63 -- | Clear the display and initialize the terminal to some initial

59 -- | Clear the display and initialize the terminal to some initial

64 -- display state.

60 -- display state.

65 --

61 --

@@ -69,57 +65,40 @@ data Output = Output

69 -- - cursor at top left

65 -- - cursor at top left

70 -- - UTF-8 character encoding

66 -- - UTF-8 character encoding

71 -- - drawing characteristics are the default

67 -- - drawing characteristics are the default

72− , reserveDisplay :: IO ()

68+ , reserveDisplay :: forall m. MonadIO m => m ()

73 -- | Return the display to the state before `reserveDisplay` If no

69 -- | Return the display to the state before `reserveDisplay` If no

74 -- previous state then set the display state to the initial state.

70 -- previous state then set the display state to the initial state.

75− , releaseDisplay :: IO ()

71+ , releaseDisplay :: forall m. MonadIO m => m ()

76− -- | Sets the current display bounds (width, height).

77− , setDisplayBounds :: (Int, Int) -> IO ()

78 -- | Returns the current display bounds.

72 -- | Returns the current display bounds.

79− , displayBounds :: IO DisplayRegion

73+ , displayBounds :: forall m. MonadIO m => m DisplayRegion

80 -- | Output the bytestring to the terminal device.

74 -- | Output the bytestring to the terminal device.

81 , outputByteBuffer :: BS.ByteString -> IO ()

75 , outputByteBuffer :: BS.ByteString -> IO ()

76+ -- | Specifies the maximum number of colors supported by the

77+ -- context.

78+ , contextColorCount :: Int

82 -- | Specifies whether the cursor can be shown / hidden.

79 -- | Specifies whether the cursor can be shown / hidden.

83 , supportsCursorVisibility :: Bool

80 , supportsCursorVisibility :: Bool

84 -- | Indicates support for terminal modes for this output device.

81 -- | Indicates support for terminal modes for this output device.

85 , supportsMode :: Mode -> Bool

82 , supportsMode :: Mode -> Bool

86 -- | Enables or disables a mode (does nothing if the mode is

83 -- | Enables or disables a mode (does nothing if the mode is

87 -- unsupported).

84 -- unsupported).

88− , setMode :: Mode -> Bool -> IO ()

85+ , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()

89 -- | Returns whether a mode is enabled.

86 -- | Returns whether a mode is enabled.

90− , getModeStatus :: Mode -> IO Bool

87+ , getModeStatus :: forall m. MonadIO m => Mode -> m Bool

91 , assumedStateRef :: IORef AssumedState

88 , assumedStateRef :: IORef AssumedState

92 -- | Acquire display access to the given region of the display.

89 -- | Acquire display access to the given region of the display.

93 -- Currently all regions have the upper left corner of (0,0) and

90 -- Currently all regions have the upper left corner of (0,0) and

94 -- the lower right corner at (max displayWidth providedWidth, max

91 -- the lower right corner at (max displayWidth providedWidth, max

95 -- displayHeight providedHeight)

92 -- displayHeight providedHeight)

96− , mkDisplayContext :: Output -> DisplayRegion -> IO DisplayContext

93+ , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext

97 -- | Ring the terminal bell if supported.

94 -- | Ring the terminal bell if supported.

98− , ringTerminalBell :: IO ()

95+ , ringTerminalBell :: forall m. MonadIO m => m ()

99 -- | Returns whether the terminal has an audio bell feature.

96 -- | Returns whether the terminal has an audio bell feature.

100− , supportsBell :: IO Bool

97+ , supportsBell :: forall m. MonadIO m => m Bool

101− -- | Returns whether the terminal supports italicized text.

102− --

103− -- This is terminal-dependent and should make a best effort to

104− -- determine whether this feature is supported, but even if the

105− -- terminal advertises support (e.g. via terminfo) that might not

106− -- be a reliable indicator of whether the feature will work as

107− -- desired.

108− , supportsItalics :: IO Bool

109− -- | Returns whether the terminal supports strikethrough text.

110− --

111− -- This is terminal-dependent and should make a best effort to

112− -- determine whether this feature is supported, but even if the

113− -- terminal advertises support (e.g. via terminfo) that might not

114− -- be a reliable indicator of whether the feature will work as

115− -- desired.

116− , supportsStrikethrough :: IO Bool

117− -- | Returns how many colors the terminal supports.

118− , outputColorMode :: ColorMode

119 }

98 }

120

121−displayContext :: Output -> DisplayRegion -> IO DisplayContext

100+displayContext :: MonadIO m => Output -> DisplayRegion -> m DisplayContext

122−displayContext t = mkDisplayContext t t

101+displayContext t = liftIO . mkDisplayContext t t

123

102

124data AssumedState = AssumedState

103data AssumedState = AssumedState

125 { prevFattr :: Maybe FixedAttr

104 { prevFattr :: Maybe FixedAttr

@@ -154,9 +133,9 @@ data DisplayContext = DisplayContext

154 -- to support this the currently applied display attributes are

133 -- to support this the currently applied display attributes are

155 -- required. In addition it may be possible to optimize the state

134 -- required. In addition it may be possible to optimize the state

156 -- changes based off the currently applied display attributes.

135 -- changes based off the currently applied display attributes.

157− , writeSetAttr :: Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write

136+ , writeSetAttr :: FixedAttr -> Attr -> DisplayAttrDiff -> Write

158 -- | Reset the display attributes to the default display attributes.

137 -- | Reset the display attributes to the default display attributes.

159− , writeDefaultAttr :: Bool -> Write

138+ , writeDefaultAttr :: Write

160 , writeRowEnd :: Write

139 , writeRowEnd :: Write

161 -- | See `Graphics.Vty.Output.XTermColor.inlineHack`

140 -- | See `Graphics.Vty.Output.XTermColor.inlineHack`

162 , inlineHack :: IO ()

141 , inlineHack :: IO ()

@@ -178,24 +157,24 @@ writeUtf8Text = writeByteString

178-- 4. Serialized to the display.

157-- 4. Serialized to the display.

179--

158--

180-- 5. The cursor is then shown and positioned or kept hidden.

159-- 5. The cursor is then shown and positioned or kept hidden.

181−outputPicture :: DisplayContext -> Picture -> IO ()

160+outputPicture :: MonadIO m => DisplayContext -> Picture -> m ()

182−outputPicture dc pic = do

161+outputPicture dc pic = liftIO $ do

183− urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink

184 as <- readIORef (assumedStateRef $ contextDevice dc)

162 as <- readIORef (assumedStateRef $ contextDevice dc)

185 let manipCursor = supportsCursorVisibility (contextDevice dc)

163 let manipCursor = supportsCursorVisibility (contextDevice dc)

186 r = contextRegion dc

164 r = contextRegion dc

187 ops = displayOpsForPic pic r

165 ops = displayOpsForPic pic r

188− initialAttr = FixedAttr defaultStyleMask Nothing Nothing Nothing

166+ initialAttr = FixedAttr defaultStyleMask Nothing Nothing

189 -- Diff the previous output against the requested output.

167 -- Diff the previous output against the requested output.

190 -- Differences are currently on a per-row basis.

168 -- Differences are currently on a per-row basis.

191 diffs :: [Bool] = case prevOutputOps as of

169 diffs :: [Bool] = case prevOutputOps as of

192 Nothing -> replicate (fromEnum $ regionHeight $ affectedRegion ops) True

170 Nothing -> replicate (fromEnum $ regionHeight $ affectedRegion ops) True

193 Just previousOps -> if affectedRegion previousOps /= affectedRegion ops

171 Just previousOps -> if affectedRegion previousOps /= affectedRegion ops

194 then replicate (displayOpsRows ops) True

172 then replicate (displayOpsRows ops) True

195− else Vector.toList $ Vector.zipWith (/=) previousOps ops

173+ else zipWith (/=) (Vector.toList previousOps)

174+ (Vector.toList ops)

196 -- build the Write corresponding to the output image

175 -- build the Write corresponding to the output image

197 out = (if manipCursor then writeHideCursor dc else mempty)

176 out = (if manipCursor then writeHideCursor dc else mempty)

198− `mappend` writeOutputOps urlsEnabled dc initialAttr diffs ops

177+ `mappend` writeOutputOps dc initialAttr diffs ops

199 `mappend`

178 `mappend`

200 (let (w,h) = contextRegion dc

179 (let (w,h) = contextRegion dc

201 clampX = max 0 . min (w-1)

180 clampX = max 0 . min (w-1)

@@ -206,15 +185,9 @@ outputPicture dc pic = do

206 AbsoluteCursor x y ->

185 AbsoluteCursor x y ->

207 writeShowCursor dc `mappend`

186 writeShowCursor dc `mappend`

208 writeMoveCursor dc (clampX x) (clampY y)

187 writeMoveCursor dc (clampX x) (clampY y)

209− PositionOnly isAbs x y ->

210− if isAbs

211− then writeMoveCursor dc (clampX x) (clampY y)

212− else let (ox, oy) = charToOutputPos m (clampX x, clampY y)

213− m = cursorOutputMap ops $ picCursor pic

214− in writeMoveCursor dc (clampX ox) (clampY oy)

215 Cursor x y ->

188 Cursor x y ->

216 let m = cursorOutputMap ops $ picCursor pic

189 let m = cursorOutputMap ops $ picCursor pic

217− (ox, oy) = charToOutputPos m (clampX x, clampY y)

190+ (ox, oy) = charToOutputPos m (x,y)

218 in writeShowCursor dc `mappend`

191 in writeShowCursor dc `mappend`

219 writeMoveCursor dc (clampX ox) (clampY oy)

192 writeMoveCursor dc (clampX ox) (clampY oy)

220 )

193 )

@@ -224,15 +197,15 @@ outputPicture dc pic = do

224 let as' = as { prevOutputOps = Just ops }

197 let as' = as { prevOutputOps = Just ops }

225 writeIORef (assumedStateRef $ contextDevice dc) as'

198 writeIORef (assumedStateRef $ contextDevice dc) as'

226

199

227−writeOutputOps :: Bool -> DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write

200+writeOutputOps :: DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write

228−writeOutputOps urlsEnabled dc initialAttr diffs ops =

201+writeOutputOps dc initialAttr diffs ops =

229 let (_, out, _) = Vector.foldl' writeOutputOps'

202 let (_, out, _) = Vector.foldl' writeOutputOps'

230 (0, mempty, diffs)

203 (0, mempty, diffs)

231 ops

204 ops

232 in out

205 in out

233 where

206 where

234 writeOutputOps' (y, out, True : diffs') spanOps

207 writeOutputOps' (y, out, True : diffs') spanOps

235− = let spanOut = writeSpanOps urlsEnabled dc y initialAttr spanOps

208+ = let spanOut = writeSpanOps dc y initialAttr spanOps

236 out' = out `mappend` spanOut

209 out' = out `mappend` spanOut

237 in (y+1, out', diffs')

210 in (y+1, out', diffs')

238 writeOutputOps' (y, out, False : diffs') _spanOps

211 writeOutputOps' (y, out, False : diffs') _spanOps

@@ -240,27 +213,27 @@ writeOutputOps urlsEnabled dc initialAttr diffs ops =

240 writeOutputOps' (_y, _out, []) _spanOps

213 writeOutputOps' (_y, _out, []) _spanOps

241 = error "vty - output spans without a corresponding diff."

214 = error "vty - output spans without a corresponding diff."

242

215

243−writeSpanOps :: Bool -> DisplayContext -> Int -> FixedAttr -> SpanOps -> Write

216+writeSpanOps :: DisplayContext -> Int -> FixedAttr -> SpanOps -> Write

244−writeSpanOps urlsEnabled dc y initialAttr spanOps =

217+writeSpanOps dc y initialAttr spanOps =

245 -- The first operation is to set the cursor to the start of the row

218 -- The first operation is to set the cursor to the start of the row

246− let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc urlsEnabled

219+ let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc

247 -- then the span ops are serialized in the order specified

220 -- then the span ops are serialized in the order specified

248− in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp urlsEnabled dc op fattr of

221+ in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp dc op fattr of

249 (opOut, fattr') -> (out `mappend` opOut, fattr')

222 (opOut, fattr') -> (out `mappend` opOut, fattr')

250 )

223 )

251 (start, initialAttr)

224 (start, initialAttr)

252 spanOps

225 spanOps

253

226

254−writeSpanOp :: Bool -> DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)

227+writeSpanOp :: DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)

255−writeSpanOp urlsEnabled dc (TextSpan attr _ _ str) fattr =

228+writeSpanOp dc (TextSpan attr _ _ str) fattr =

256 let attr' = limitAttrForDisplay (contextDevice dc) attr

229 let attr' = limitAttrForDisplay (contextDevice dc) attr

257 fattr' = fixDisplayAttr fattr attr'

230 fattr' = fixDisplayAttr fattr attr'

258 diffs = displayAttrDiffs fattr fattr'

231 diffs = displayAttrDiffs fattr fattr'

259− out = writeSetAttr dc urlsEnabled fattr attr' diffs

232+ out = writeSetAttr dc fattr attr' diffs

260 `mappend` writeUtf8Text (T.encodeUtf8 $ TL.toStrict str)

233 `mappend` writeUtf8Text (T.encodeUtf8 $ TL.toStrict str)

261 in (out, fattr')

234 in (out, fattr')

262−writeSpanOp _ _ (Skip _) _fattr = error "writeSpanOp for Skip"

235+writeSpanOp _dc (Skip _) _fattr = error "writeSpanOp for Skip"

263−writeSpanOp urlsEnabled dc (RowEnd _) fattr = (writeDefaultAttr dc urlsEnabled `mappend` writeRowEnd dc, fattr)

236+writeSpanOp dc (RowEnd _) fattr = (writeDefaultAttr dc `mappend` writeRowEnd dc, fattr)

264

237

265-- | The cursor position is given in X,Y character offsets. Due to

238-- | The cursor position is given in X,Y character offsets. Due to

266-- multi-column characters this needs to be translated to column, row

239-- multi-column characters this needs to be translated to column, row

@@ -309,23 +282,17 @@ limitAttrForDisplay t attr

309 where

282 where

310 clampColor Default = Default

283 clampColor Default = Default

311 clampColor KeepCurrent = KeepCurrent

284 clampColor KeepCurrent = KeepCurrent

312− clampColor (SetTo c) = clampColor' (outputColorMode t) c

285+ clampColor (SetTo c) = clampColor' c

313−

314− clampColor' NoColor _ = Default

286+ clampColor' (ISOColor v)

315−

287+ | contextColorCount t < 8 = Default

316− clampColor' ColorMode8 (ISOColor v)

317− | v >= 8 = SetTo $ ISOColor (v - 8)

288+ | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8)

318− | otherwise = SetTo $ ISOColor v

289+ | otherwise = SetTo $ ISOColor v

319− clampColor' ColorMode8 _ = Default

290+ clampColor' (Color240 v)

320−

291+ -- Should we choose closest ISO color?

321− clampColor' ColorMode16 c@(ISOColor _) = SetTo c

292+ | contextColorCount t < 8 = Default

322− clampColor' ColorMode16 _ = Default

293+ | contextColorCount t < 16 = Default

323−

294+ | contextColorCount t <= 256 = SetTo $ Color240 v

324− clampColor' (ColorMode240 _) c@(ISOColor _) = SetTo c

325− clampColor' (ColorMode240 colorCount) c@(Color240 n)

326− | n <= colorCount = SetTo c

327− | otherwise = Default

295+ | otherwise

328− clampColor' colorMode@(ColorMode240 _) (RGBColor r g b) =

296+ = let p :: Double = fromIntegral v / 240.0

329− clampColor' colorMode (color240 r g b)

297+ v' = floor $ p * (fromIntegral $ contextColorCount t)

330−

298+ in SetTo $ Color240 v'

331− clampColor' FullColor c = SetTo c

src/Graphics/Vty/Output/Mock.hs+4−8

@@ -11,7 +11,6 @@ module Graphics.Vty.Output.Mock

11where

13import Graphics.Vty.Image (DisplayRegion)

14−import Graphics.Vty.Attributes.Color (ColorMode(ColorMode16))

15import Graphics.Vty.Output.Interface

14import Graphics.Vty.Output.Interface

17import Blaze.ByteString.Builder.Word (writeWord8)

16import Blaze.ByteString.Builder.Word (writeWord8)

@@ -31,7 +30,7 @@ type MockData = IORef (UTF8.UTF8 BS.ByteString)

31-- without considering terminal specific issues.

30-- without considering terminal specific issues.

32--

31--

33-- The mock implementation is useful in manually determining if the

32-- The mock implementation is useful in manually determining if the

34−-- sequence of terminal operations matches the expected sequence. The

33+-- sequence of terminal operations matche the expected sequence. The

35-- requirement of the produced representation is simplicity in parsing

34-- requirement of the produced representation is simplicity in parsing

36-- the text representation and determining how the picture was mapped to

35-- the text representation and determining how the picture was mapped to

37-- terminal operations.

36-- terminal operations.

@@ -49,19 +48,16 @@ mockTerminal r = liftIO $ do

49 , releaseDisplay = return ()

48 , releaseDisplay = return ()

50 , ringTerminalBell = return ()

49 , ringTerminalBell = return ()

51 , supportsBell = return False

50 , supportsBell = return False

52− , supportsItalics = return False

53− , supportsStrikethrough = return False

54− , setDisplayBounds = const $ return ()

55 , displayBounds = return r

51 , displayBounds = return r

56 , outputByteBuffer = \bytes -> do

52 , outputByteBuffer = \bytes -> do

57 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"

53 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"

58 writeIORef outRef $ UTF8.fromRep bytes

54 writeIORef outRef $ UTF8.fromRep bytes

55+ , contextColorCount = 16

59 , supportsCursorVisibility = True

56 , supportsCursorVisibility = True

60 , supportsMode = const False

57 , supportsMode = const False

61 , setMode = const $ const $ return ()

58 , setMode = const $ const $ return ()

62 , getModeStatus = const $ return False

59 , getModeStatus = const $ return False

63 , assumedStateRef = newAssumedStateRef

60 , assumedStateRef = newAssumedStateRef

64− , outputColorMode = ColorMode16

65 , mkDisplayContext = \tActual rActual -> return $ DisplayContext

61 , mkDisplayContext = \tActual rActual -> return $ DisplayContext

66 { contextRegion = rActual

62 { contextRegion = rActual

67 , contextDevice = tActual

63 , contextDevice = tActual

@@ -76,10 +72,10 @@ mockTerminal r = liftIO $ do

76 , writeHideCursor = writeWord8 $ toEnum $ fromEnum 'H'

72 , writeHideCursor = writeWord8 $ toEnum $ fromEnum 'H'

77 -- An attr change is always visualized as the single

73 -- An attr change is always visualized as the single

78 -- character 'A'

74 -- character 'A'

79− , writeSetAttr = \_ _fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'

75+ , writeSetAttr = \_fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'

80 -- default attr is always visualized as the single

76 -- default attr is always visualized as the single

81 -- character 'D'

77 -- character 'D'

82− , writeDefaultAttr = const $ writeWord8 $ toEnum $ fromEnum 'D'

78+ , writeDefaultAttr = writeWord8 $ toEnum $ fromEnum 'D'

83 -- row end is always visualized as the single character

79 -- row end is always visualized as the single character

84 -- 'E'

80 -- 'E'

85 , writeRowEnd = writeWord8 $ toEnum $ fromEnum 'E'

81 , writeRowEnd = writeWord8 $ toEnum $ fromEnum 'E'

src/Graphics/Vty/Output/TerminfoBased.hs+63−190

@@ -1,6 +1,5 @@

1+{-# LANGUAGE RecordWildCards #-}

1{-# LANGUAGE FlexibleInstances #-}

2{-# LANGUAGE FlexibleInstances #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE CPP #-}

4{-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-}

3{-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-}

5{-# CFILES gwinsz.c #-}

4{-# CFILES gwinsz.c #-}

@@ -9,13 +8,10 @@

9-- Copyright Corey O'Connor (coreyoconnor@gmail.com)

8-- Copyright Corey O'Connor (coreyoconnor@gmail.com)

10module Graphics.Vty.Output.TerminfoBased

9module Graphics.Vty.Output.TerminfoBased

11 ( reserveTerminal

10 ( reserveTerminal

12− , setWindowSize

13 )

11 )

14where

12where

16import Control.Monad (when)

14import Control.Monad (when)

17−import Data.Bits (shiftL, (.&.))

18−import qualified Data.ByteString as BS

19import Data.ByteString.Internal (toForeignPtr)

15import Data.ByteString.Internal (toForeignPtr)

20import Data.Terminfo.Parse

16import Data.Terminfo.Parse

21import Data.Terminfo.Eval

17import Data.Terminfo.Eval

@@ -25,16 +21,15 @@ import Graphics.Vty.Image (DisplayRegion)

25import Graphics.Vty.DisplayAttributes

21import Graphics.Vty.DisplayAttributes

26import Graphics.Vty.Output.Interface

22import Graphics.Vty.Output.Interface

28−import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable, writeWord8)

24+import Blaze.ByteString.Builder (Write, writeToByteString)

26+import Control.Monad.Trans

27+

28+import Data.Bits ((.&.))

30import Data.IORef

29import Data.IORef

31import Data.Maybe (isJust, isNothing, fromJust)

30import Data.Maybe (isJust, isNothing, fromJust)

32import Data.Word

31import Data.Word

34−#if !MIN_VERSION_base(4,8,0)

35−import Data.Foldable (foldMap)

36−#endif

37−

38import Foreign.C.Types ( CInt(..), CLong(..) )

33import Foreign.C.Types ( CInt(..), CLong(..) )

39import Foreign.ForeignPtr (withForeignPtr)

34import Foreign.ForeignPtr (withForeignPtr)

40import Foreign.Ptr (Ptr, plusPtr)

35import Foreign.Ptr (Ptr, plusPtr)

@@ -49,6 +44,7 @@ data TerminfoCaps = TerminfoCaps

49 , cup :: CapExpression

44 , cup :: CapExpression

50 , cnorm :: Maybe CapExpression

45 , cnorm :: Maybe CapExpression

51 , civis :: Maybe CapExpression

46 , civis :: Maybe CapExpression

47+ , supportsNoColors :: Bool

52 , useAltColorMap :: Bool

48 , useAltColorMap :: Bool

53 , setForeColor :: CapExpression

49 , setForeColor :: CapExpression

54 , setBackColor :: CapExpression

50 , setBackColor :: CapExpression

@@ -63,10 +59,6 @@ data DisplayAttrCaps = DisplayAttrCaps

63 { setAttrStates :: Maybe CapExpression

59 { setAttrStates :: Maybe CapExpression

64 , enterStandout :: Maybe CapExpression

60 , enterStandout :: Maybe CapExpression

65 , exitStandout :: Maybe CapExpression

61 , exitStandout :: Maybe CapExpression

66− , enterItalic :: Maybe CapExpression

67− , exitItalic :: Maybe CapExpression

68− , enterStrikethrough :: Maybe CapExpression

69− , exitStrikethrough :: Maybe CapExpression

70 , enterUnderline :: Maybe CapExpression

62 , enterUnderline :: Maybe CapExpression

71 , exitUnderline :: Maybe CapExpression

63 , exitUnderline :: Maybe CapExpression

72 , enterReverseVideo :: Maybe CapExpression

64 , enterReverseVideo :: Maybe CapExpression

@@ -103,85 +95,62 @@ sendCapToTerminal t cap capParams = do

103--

95--

104-- * Providing independent string capabilities for all display

96-- * Providing independent string capabilities for all display

105-- attributes.

97-- attributes.

106−reserveTerminal :: String -> Fd -> ColorMode -> IO Output

98+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

107−reserveTerminal termName outFd colorMode = do

99+reserveTerminal termName outFd = liftIO $ do

108 ti <- Terminfo.setupTerm termName

100 ti <- Terminfo.setupTerm termName

109 -- assumes set foreground always implies set background exists.

101 -- assumes set foreground always implies set background exists.

110 -- if set foreground is not set then all color changing style

102 -- if set foreground is not set then all color changing style

111 -- attributes are filtered.

103 -- attributes are filtered.

112 msetaf <- probeCap ti "setaf"

104 msetaf <- probeCap ti "setaf"

113 msetf <- probeCap ti "setf"

105 msetf <- probeCap ti "setf"

114− let (useAlt, setForeCap)

106+ let (noColors, useAlt, setForeCap)

115 = case msetaf of

107 = case msetaf of

116− Just setaf -> (False, setaf)

108+ Just setaf -> (False, False, setaf)

117 Nothing -> case msetf of

109 Nothing -> case msetf of

118− Just setf -> (True, setf)

110+ Just setf -> (False, True, setf)

119− Nothing -> (True, error $ "no fore color support for terminal " ++ termName)

111+ Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName)

120 msetab <- probeCap ti "setab"

112 msetab <- probeCap ti "setab"

121 msetb <- probeCap ti "setb"

113 msetb <- probeCap ti "setb"

122− let setBackCap

114+ let set_back_cap

123 = case msetab of

115 = case msetab of

124− Just setab -> setab

125 Nothing -> case msetb of

116 Nothing -> case msetb of

126 Just setb -> setb

117 Just setb -> setb

127 Nothing -> error $ "no back color support for terminal " ++ termName

118 Nothing -> error $ "no back color support for terminal " ++ termName

128−

119+ Just setab -> setab

129− hyperlinkModeStatus <- newIORef False

130− newAssumedStateRef <- newIORef initialAssumedState

131−

132− let terminfoSetMode m newStatus = do

133− curStatus <- terminfoModeStatus m

134− when (newStatus /= curStatus) $

135− case m of

136− Hyperlink -> do

137− writeIORef hyperlinkModeStatus newStatus

138− writeIORef newAssumedStateRef initialAssumedState

139− _ -> return ()

140− terminfoModeStatus m =

141− case m of

142− Hyperlink -> readIORef hyperlinkModeStatus

143− _ -> return False

144− terminfoModeSupported Hyperlink = True

145− terminfoModeSupported _ = False

146−

147 terminfoCaps <- pure TerminfoCaps

120 terminfoCaps <- pure TerminfoCaps

148 <*> probeCap ti "smcup"

121 <*> probeCap ti "smcup"

149 <*> probeCap ti "rmcup"

122 <*> probeCap ti "rmcup"

150 <*> requireCap ti "cup"

123 <*> requireCap ti "cup"

151 <*> probeCap ti "cnorm"

124 <*> probeCap ti "cnorm"

152 <*> probeCap ti "civis"

125 <*> probeCap ti "civis"

126+ <*> pure noColors

153 <*> pure useAlt

127 <*> pure useAlt

154 <*> pure setForeCap

128 <*> pure setForeCap

155− <*> pure setBackCap

129+ <*> pure set_back_cap

156 <*> requireCap ti "sgr0"

130 <*> requireCap ti "sgr0"

157 <*> requireCap ti "clear"

131 <*> requireCap ti "clear"

158 <*> requireCap ti "el"

132 <*> requireCap ti "el"

159 <*> currentDisplayAttrCaps ti

133 <*> currentDisplayAttrCaps ti

160 <*> probeCap ti "bel"

134 <*> probeCap ti "bel"

135+ newAssumedStateRef <- newIORef initialAssumedState

161 let t = Output

136 let t = Output

162 { terminalID = termName

137 { terminalID = termName

163− , releaseTerminal = do

138+ , releaseTerminal = liftIO $ do

164 sendCap setDefaultAttr []

139 sendCap setDefaultAttr []

165 maybeSendCap cnorm []

140 maybeSendCap cnorm []

166 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps

141 , 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 []

142+ , ringTerminalBell = liftIO $ maybeSendCap ringBellAudio []

172− , reserveDisplay = do

143+ , reserveDisplay = liftIO $ do

173 -- If there is no support for smcup: Clear the screen

144 -- If there is no support for smcup: Clear the screen

174 -- and then move the mouse to the home position to

145 -- and then move the mouse to the home position to

175 -- approximate the behavior.

146 -- approximate the behavior.

176 maybeSendCap smcup []

147 maybeSendCap smcup []

177 sendCap clearScreen []

148 sendCap clearScreen []

178− , releaseDisplay = do

149+ , releaseDisplay = liftIO $ do

179 maybeSendCap rmcup []

150 maybeSendCap rmcup []

180 maybeSendCap cnorm []

151 maybeSendCap cnorm []

181− , setDisplayBounds = \(w, h) ->

182− setWindowSize outFd (w, h)

183 , displayBounds = do

152 , displayBounds = do

184− rawSize <- getWindowSize outFd

153+ rawSize <- liftIO $ getWindowSize outFd

185 case rawSize of

154 case rawSize of

186 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize

155 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize

187 | otherwise -> return (w,h)

156 | otherwise -> return (w,h)

@@ -192,48 +161,51 @@ reserveTerminal termName outFd colorMode = do

192 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "

161 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "

193 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen

162 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen

194 ++ " Please report this bug to vty project."

163 ++ " Please report this bug to vty project."

164+ , contextColorCount

165+ = case supportsNoColors terminfoCaps of

166+ False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of

167+ Nothing -> 8

168+ Just v -> toEnum v

169+ True -> 1

195 , supportsCursorVisibility = isJust $ civis terminfoCaps

170 , supportsCursorVisibility = isJust $ civis terminfoCaps

196− , supportsMode = terminfoModeSupported

171+ , supportsMode = const False

197− , setMode = terminfoSetMode

172+ , setMode = const $ const $ return ()

198− , getModeStatus = terminfoModeStatus

173+ , getModeStatus = const $ return False

199 , assumedStateRef = newAssumedStateRef

174 , assumedStateRef = newAssumedStateRef

200− , outputColorMode = colorMode

201 -- I think fix would help assure tActual is the only

175 -- I think fix would help assure tActual is the only

202 -- reference. I was having issues tho.

176 -- reference. I was having issues tho.

203− , mkDisplayContext = (`terminfoDisplayContext` terminfoCaps)

177+ , mkDisplayContext = \tActual -> liftIO . terminfoDisplayContext tActual terminfoCaps

204 }

178 }

205 sendCap s = sendCapToTerminal t (s terminfoCaps)

179 sendCap s = sendCapToTerminal t (s terminfoCaps)

206 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)

180 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)

207 return t

181 return t

208

182

209−requireCap :: Terminfo.Terminal -> String -> IO CapExpression

183+requireCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m CapExpression

210requireCap ti capName

184requireCap ti capName

211 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

185 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

212 Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""

186 Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""

213 Just capStr -> parseCap capStr

187 Just capStr -> parseCap capStr

214

188

215−probeCap :: Terminfo.Terminal -> String -> IO (Maybe CapExpression)

189+probeCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m (Maybe CapExpression)

216probeCap ti capName

190probeCap ti capName

217 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

191 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

218 Nothing -> return Nothing

192 Nothing -> return Nothing

219 Just capStr -> Just <$> parseCap capStr

193 Just capStr -> Just <$> parseCap capStr

220

194

221−parseCap :: String -> IO CapExpression

195+parseCap :: (Applicative m, MonadIO m) => String -> m CapExpression

222parseCap capStr = do

196parseCap capStr = do

223 case parseCapExpression capStr of

197 case parseCapExpression capStr of

224 Left e -> fail $ show e

198 Left e -> fail $ show e

225 Right cap -> return cap

199 Right cap -> return cap

226

200

227−currentDisplayAttrCaps :: Terminfo.Terminal -> IO DisplayAttrCaps

201+currentDisplayAttrCaps :: ( Applicative m, MonadIO m )

202+ => Terminfo.Terminal

203+ -> m DisplayAttrCaps

228currentDisplayAttrCaps ti

204currentDisplayAttrCaps ti

229 = pure DisplayAttrCaps

205 = pure DisplayAttrCaps

230 <*> probeCap ti "sgr"

206 <*> probeCap ti "sgr"

231 <*> probeCap ti "smso"

207 <*> probeCap ti "smso"

232 <*> probeCap ti "rmso"

208 <*> probeCap ti "rmso"

233− <*> probeCap ti "sitm"

234− <*> probeCap ti "ritm"

235− <*> probeCap ti "smxx"

236− <*> probeCap ti "rmxx"

237 <*> probeCap ti "smul"

209 <*> probeCap ti "smul"

238 <*> probeCap ti "rmul"

210 <*> probeCap ti "rmul"

239 <*> probeCap ti "rev"

211 <*> probeCap ti "rev"

@@ -247,13 +219,6 @@ getWindowSize fd = do

247 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd

219 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd

248 return (fromIntegral b, fromIntegral a)

220 return (fromIntegral b, fromIntegral a)

249

221

250−foreign import ccall "gwinsz.h vty_c_set_window_size" c_setWindowSize :: Fd -> CLong -> IO ()

251−

252−setWindowSize :: Fd -> (Int, Int) -> IO ()

253−setWindowSize fd (w, h) = do

254− let val = (h `shiftL` 16) + w

255− c_setWindowSize fd $ fromIntegral val

256−

257terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext

222terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext

258terminfoDisplayContext tActual terminfoCaps r = return dc

223terminfoDisplayContext tActual terminfoCaps r = return dc

259 where dc = DisplayContext

224 where dc = DisplayContext

@@ -267,35 +232,15 @@ terminfoDisplayContext tActual terminfoCaps r = return dc

267 Nothing -> error "this terminal does not support hide cursor"

232 Nothing -> error "this terminal does not support hide cursor"

268 Just c -> writeCapExpr c []

233 Just c -> writeCapExpr c []

269 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps

234 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps

270− , writeDefaultAttr = \urlsEnabled ->

271− writeCapExpr (setDefaultAttr terminfoCaps) [] `mappend`

235+ , writeDefaultAttr = writeCapExpr (setDefaultAttr terminfoCaps) []

272− (if urlsEnabled then writeURLEscapes EndLink else mempty) `mappend`

273− (case exitStrikethrough $ displayAttrCaps terminfoCaps of

274− Just cap -> writeCapExpr cap []

275− Nothing -> mempty

276− )

277 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []

236 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []

278 , inlineHack = return ()

237 , inlineHack = return ()

279 }

238 }

280

239

281−-- | Write the escape sequences that are used in some terminals to

282−-- include embedded hyperlinks. As of yet, this information isn't

283−-- included in termcap or terminfo, so this writes them directly

284−-- instead of looking up the appropriate capabilities.

285−writeURLEscapes :: URLDiff -> Write

286−writeURLEscapes (LinkTo url) =

287− foldMap writeStorable (BS.unpack "\x1b]8;;") `mappend`

288− foldMap writeStorable (BS.unpack url) `mappend`

289− writeStorable (0x07 :: Word8)

290−writeURLEscapes EndLink =

291− foldMap writeStorable (BS.unpack "\x1b]8;;\a")

292−writeURLEscapes NoLinkChange =

293− mempty

294−

295-- | Portably setting the display attributes is a giant pain in the ass.

240-- | Portably setting the display attributes is a giant pain in the ass.

296--

241--

297-- If the terminal supports the sgr capability (which sets the on/off

242-- 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

243+-- state of each style directly ; and, for no good reason, resets the

299-- colors to the default) this procedure is used:

244-- colors to the default) this procedure is used:

300--

245--

301-- 0. set the style attributes. This resets the fore and back color.

246-- 0. set the style attributes. This resets the fore and back color.

@@ -328,30 +273,30 @@ writeURLEscapes NoLinkChange =

328--

273--

329-- Note that this optimizes for fewer state changes followed by fewer

274-- Note that this optimizes for fewer state changes followed by fewer

330-- bytes.

275-- bytes.

331−terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write

276+terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> FixedAttr -> Attr -> DisplayAttrDiff -> Write

332−terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

277+terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do

333− urlAttrs urlsEnabled `mappend` case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of

278+ case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of

334 -- The only way to reset either color, portably, to the default

279 -- The only way to reset either color, portably, to the default

335 -- is to use either the set state capability or the set default

280 -- is to use either the set state capability or the set default

336 -- capability.

281 -- capability.

337− True -> do

282+ True -> do

338 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

283 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

339− (fixedStyle attr)

284+ (fixedStyle attr )

340 (styleToApplySeq $ fixedStyle attr) of

285 (styleToApplySeq $ fixedStyle attr) of

341 -- only way to reset a color to the defaults

286 -- only way to reset a color to the defaults

342− EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled

287+ EnterExitSeq caps -> writeDefaultAttr dc

343 `mappend`

288 `mappend`

344 foldMap (\cap -> writeCapExpr cap []) caps

289 foldMap (\cap -> writeCapExpr cap []) caps

345 `mappend`

290 `mappend`

346 setColors

291 setColors

347 -- implicitly resets the colors to the defaults

292 -- implicitly resets the colors to the defaults

348 SetState state -> writeCapExpr (fromJust $ setAttrStates

293 SetState state -> writeCapExpr (fromJust $ setAttrStates

349− $ displayAttrCaps terminfoCaps

294+ $ displayAttrCaps

295+ $ terminfoCaps

350 )

296 )

351 (sgrArgsForState state)

297 (sgrArgsForState state)

352− `mappend` setItalics

298+ `mappend`

353− `mappend` setStrikethrough

354− `mappend` setColors

299+ setColors

355 -- Otherwise the display colors are not changing or changing

300 -- Otherwise the display colors are not changing or changing

356 -- between two non-default points.

301 -- between two non-default points.

357 False -> do

302 False -> do

@@ -369,99 +314,45 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

369 -- applied states.

314 -- applied states.

370 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps

315 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps

371 `mappend`

316 `mappend`

372− writeColorDiff Foreground (foreColorDiff diffs)

317+ writeColorDiff setForeColor (foreColorDiff diffs)

373 `mappend`

318 `mappend`

374− writeColorDiff Background (backColorDiff diffs)

319+ writeColorDiff setBackColor (backColorDiff diffs)

375 -- implicitly resets the colors to the defaults

320 -- implicitly resets the colors to the defaults

376 SetState state -> writeCapExpr (fromJust $ setAttrStates

321 SetState state -> writeCapExpr (fromJust $ setAttrStates

377 $ displayAttrCaps terminfoCaps

322 $ displayAttrCaps terminfoCaps

378 )

323 )

379 (sgrArgsForState state)

324 (sgrArgsForState state)

380− `mappend` setItalics

381− `mappend` setStrikethrough

382 `mappend` setColors

325 `mappend` setColors

383 where

326 where

384− urlAttrs True = writeURLEscapes (urlDiff diffs)

385− urlAttrs False = mempty

386 colorMap = case useAltColorMap terminfoCaps of

327 colorMap = case useAltColorMap terminfoCaps of

387 False -> ansiColorIndex

328 False -> ansiColorIndex

388 True -> altColorIndex

329 True -> altColorIndex

389 attr = fixDisplayAttr prevAttr reqAttr

330 attr = fixDisplayAttr prevAttr reqAttr

390−

391− -- italics can't be set via SGR, so here we manually

392− -- apply the enter and exit sequences as needed after

393− -- changing the SGR

394− setItalics

395− | hasStyle (fixedStyle attr) italic

396− , Just sitm <- enterItalic (displayAttrCaps terminfoCaps)

397− = writeCapExpr sitm []

398− | otherwise = mempty

399− setStrikethrough

400− | hasStyle (fixedStyle attr) strikethrough

401− , Just smxx <- enterStrikethrough (displayAttrCaps terminfoCaps)

402− = writeCapExpr smxx []

403− | otherwise = mempty

404 setColors =

331 setColors =

405 (case fixedForeColor attr of

332 (case fixedForeColor attr of

406− Just c -> writeColor Foreground c

333+ Just c -> writeCapExpr (setForeColor terminfoCaps)

334+ [toEnum $ colorMap c]

407 Nothing -> mempty)

335 Nothing -> mempty)

408 `mappend`

336 `mappend`

409 (case fixedBackColor attr of

337 (case fixedBackColor attr of

410− Just c -> writeColor Background c

338+ Just c -> writeCapExpr (setBackColor terminfoCaps)

339+ [toEnum $ colorMap c]

411 Nothing -> mempty)

340 Nothing -> mempty)

412− writeColorDiff _side NoColorChange

341+ writeColorDiff _f NoColorChange

413 = mempty

342 = mempty

414− writeColorDiff _side ColorToDefault

343+ writeColorDiff _f ColorToDefault

415 = error "ColorToDefault is not a possible case for applyColorDiffs"

344 = error "ColorToDefault is not a possible case for applyColorDiffs"

416− writeColorDiff side (SetColor c)

345+ writeColorDiff f (SetColor c)

417− = writeColor side c

418−

419− writeColor side (RGBColor r g b) =

420− case outputColorMode (contextDevice dc) of

421− FullColor ->

422− hardcodeColor side (r, g, b)

423− _ ->

424− error "clampColor should remove rgb colors in standard mode"

425− writeColor side c =

426− writeCapExpr (setSideColor side terminfoCaps) [toEnum $ colorMap c]

346+ = writeCapExpr (f terminfoCaps) [toEnum $ colorMap c]

427−

428−-- a color can either be in the foreground or the background

429−data ColorSide = Foreground | Background

430−

431−-- get the capability for drawing a color on a specific side

432−setSideColor :: ColorSide -> TerminfoCaps -> CapExpression

433−setSideColor Foreground = setForeColor

434−setSideColor Background = setBackColor

435−

436−hardcodeColor :: ColorSide -> (Word8, Word8, Word8) -> Write

437−hardcodeColor side (r, g, b) =

438− -- hardcoded color codes are formatted as "\x1b[{side};2;{r};{g};{b}m"

439− mconcat [ writeStr "\x1b[", sideCode, delimiter, writeChar '2', delimiter

440− , writeColor r, delimiter, writeColor g, delimiter, writeColor b

441− , writeChar 'm']

442− where

443− writeChar = writeWord8 . fromIntegral . fromEnum

444− writeStr = mconcat . map writeChar

445− writeColor = writeStr . show

446− delimiter = writeChar ';'

447− -- 38/48 are used to set whether we should write to the

448− -- foreground/background. I really don't want to know why.

449− sideCode = case side of

450− Foreground -> writeStr "38"

451− Background -> writeStr "48"

452

347

453-- | The color table used by a terminal is a 16 color set followed by a

348-- | The color table used by a terminal is a 16 color set followed by a

454-- 240 color set that might not be supported by the terminal.

349-- 240 color set that might not be supported by the terminal.

455--

350--

456−-- This takes a Color which clearly identifies which palette to use and

351+-- This takes a Color which clearly identifies which pallete to use and

457−-- computes the index into the full 256 color palette.

352+-- computes the index into the full 256 color pallete.

458ansiColorIndex :: Color -> Int

353ansiColorIndex :: Color -> Int

459ansiColorIndex (ISOColor v) = fromEnum v

354ansiColorIndex (ISOColor v) = fromEnum v

460ansiColorIndex (Color240 v) = 16 + fromEnum v

355ansiColorIndex (Color240 v) = 16 + fromEnum v

461−ansiColorIndex (RGBColor _ _ _) =

462− error $ unlines [ "Attempted to create color index from rgb color."

463− , "This is currently unsupported, and shouldn't ever happen"

464− ]

465

356

466-- | For terminals without setaf/setab

357-- | For terminals without setaf/setab

467--

358--

@@ -478,10 +369,6 @@ altColorIndex (ISOColor 6) = 3

478altColorIndex (ISOColor 7) = 7

369altColorIndex (ISOColor 7) = 7

479altColorIndex (ISOColor v) = fromEnum v

370altColorIndex (ISOColor v) = fromEnum v

480altColorIndex (Color240 v) = 16 + fromEnum v

371altColorIndex (Color240 v) = 16 + fromEnum v

481−altColorIndex (RGBColor _ _ _) =

482− error $ unlines [ "Attempted to create color index from rgb color."

483− , "This is currently unsupported, and shouldn't ever happen"

484− ]

485

372

486{- | The sequence of terminfo caps to apply a given style are determined

373{- | The sequence of terminfo caps to apply a given style are determined

487 - according to these rules.

374 - according to these rules.

@@ -508,8 +395,6 @@ data DisplayAttrSeq

508data DisplayAttrState = DisplayAttrState

395data DisplayAttrState = DisplayAttrState

509 { applyStandout :: Bool

396 { applyStandout :: Bool

510 , applyUnderline :: Bool

397 , applyUnderline :: Bool

511− , applyItalic :: Bool

512− , applyStrikethrough :: Bool

513 , applyReverseVideo :: Bool

398 , applyReverseVideo :: Bool

514 , applyBlink :: Bool

399 , applyBlink :: Bool

515 , applyDim :: Bool

400 , applyDim :: Bool

@@ -546,10 +431,6 @@ reqDisplayCapSeqFor caps s diffs

546 -- set state cap then just use the set state cap.

431 -- set state cap then just use the set state cap.

547 ( True, True ) -> SetState $ stateForStyle s

432 ( True, True ) -> SetState $ stateForStyle s

548 where

433 where

549− noEnterExitCap ApplyStrikethrough = isNothing $ enterStrikethrough caps

550− noEnterExitCap RemoveStrikethrough = isNothing $ exitStrikethrough caps

551− noEnterExitCap ApplyItalic = isNothing $ enterItalic caps

552− noEnterExitCap RemoveItalic = isNothing $ exitItalic caps

553 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps

434 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps

554 noEnterExitCap RemoveStandout = isNothing $ exitStandout caps

435 noEnterExitCap RemoveStandout = isNothing $ exitStandout caps

555 noEnterExitCap ApplyUnderline = isNothing $ enterUnderline caps

436 noEnterExitCap ApplyUnderline = isNothing $ enterUnderline caps

@@ -562,10 +443,6 @@ reqDisplayCapSeqFor caps s diffs

562 noEnterExitCap RemoveDim = True

443 noEnterExitCap RemoveDim = True

563 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps

444 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps

564 noEnterExitCap RemoveBold = True

445 noEnterExitCap RemoveBold = True

565− enterExitCap ApplyStrikethrough = fromJust $ enterStrikethrough caps

566− enterExitCap RemoveStrikethrough = fromJust $ exitStrikethrough caps

567− enterExitCap ApplyItalic = fromJust $ enterItalic caps

568− enterExitCap RemoveItalic = fromJust $ exitItalic caps

569 enterExitCap ApplyStandout = fromJust $ enterStandout caps

446 enterExitCap ApplyStandout = fromJust $ enterStandout caps

570 enterExitCap RemoveStandout = fromJust $ exitStandout caps

447 enterExitCap RemoveStandout = fromJust $ exitStandout caps

571 enterExitCap ApplyUnderline = fromJust $ enterUnderline caps

448 enterExitCap ApplyUnderline = fromJust $ enterUnderline caps

@@ -579,8 +456,6 @@ stateForStyle :: Style -> DisplayAttrState

579stateForStyle s = DisplayAttrState

456stateForStyle s = DisplayAttrState

580 { applyStandout = isStyleSet standout

457 { applyStandout = isStyleSet standout

581 , applyUnderline = isStyleSet underline

458 , applyUnderline = isStyleSet underline

582− , applyItalic = isStyleSet italic

583− , applyStrikethrough = isStyleSet strikethrough

584 , applyReverseVideo = isStyleSet reverseVideo

459 , applyReverseVideo = isStyleSet reverseVideo

585 , applyBlink = isStyleSet blink

460 , applyBlink = isStyleSet blink

586 , applyDim = isStyleSet dim

461 , applyDim = isStyleSet dim

@@ -592,12 +467,10 @@ styleToApplySeq :: Style -> [StyleStateChange]

592styleToApplySeq s = concat

467styleToApplySeq s = concat

593 [ applyIfRequired ApplyStandout standout

468 [ applyIfRequired ApplyStandout standout

594 , applyIfRequired ApplyUnderline underline

469 , applyIfRequired ApplyUnderline underline

595− , applyIfRequired ApplyItalic italic

596− , applyIfRequired ApplyStrikethrough strikethrough

597 , applyIfRequired ApplyReverseVideo reverseVideo

470 , applyIfRequired ApplyReverseVideo reverseVideo

598 , applyIfRequired ApplyBlink blink

471 , applyIfRequired ApplyBlink blink

599 , applyIfRequired ApplyDim dim

472 , applyIfRequired ApplyDim dim

600− , applyIfRequired ApplyBold bold

473+ , applyIfRequired ApplyBlink bold

601 ]

474 ]

602 where

475 where

603 applyIfRequired op flag

476 applyIfRequired op flag

src/Graphics/Vty/Output/XTermColor.hs+18−33

@@ -1,4 +1,3 @@

1−{-# Language CPP #-}

3-- | Xterm output driver. This uses the Terminfo driver with some

2-- | Xterm output driver. This uses the Terminfo driver with some

4-- extensions for Xterm.

3-- extensions for Xterm.

@@ -10,41 +9,26 @@ where

10import Graphics.Vty.Output.Interface

9import Graphics.Vty.Output.Interface

11import Graphics.Vty.Input.Mouse

10import Graphics.Vty.Input.Mouse

12import Graphics.Vty.Input.Focus

11import Graphics.Vty.Input.Focus

13−import Graphics.Vty.Attributes.Color (ColorMode)

14import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased

12import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased

16import Blaze.ByteString.Builder (writeToByteString)

14import Blaze.ByteString.Builder (writeToByteString)

17import Blaze.ByteString.Builder.Word (writeWord8)

15import Blaze.ByteString.Builder.Word (writeWord8)

19−import qualified Data.ByteString.Char8 as BS8

20−import Data.ByteString.Char8 (ByteString)

21−import Foreign.Ptr (castPtr)

22−

23import Control.Monad (void, when)

17import Control.Monad (void, when)

24import Control.Monad.Trans

18import Control.Monad.Trans

25−import Data.Char (toLower)

26import Data.IORef

19import Data.IORef

28−import System.Posix.IO (fdWriteBuf)

21+import System.Posix.IO (fdWrite)

29−import System.Posix.Types (ByteCount, Fd)

22+import System.Posix.Types (Fd)

30import System.Posix.Env (getEnv)

23import System.Posix.Env (getEnv)

32import Data.List (isInfixOf)

25import Data.List (isInfixOf)

33import Data.Maybe (catMaybes)

26import Data.Maybe (catMaybes)

34−

35−#if !MIN_VERSION_base(4,11,0)

36import Data.Monoid ((<>))

27import Data.Monoid ((<>))

37−#endif

38−

39−-- | Write a 'ByteString' to an 'Fd'.

40−fdWrite :: Fd -> ByteString -> IO ByteCount

41−fdWrite fd s =

42− BS8.useAsCStringLen s $ \(buf,len) -> do

43− fdWriteBuf fd (castPtr buf) (fromIntegral len)

45-- | Construct an Xterm output driver. Initialize the display to UTF-8.

29-- | Construct an Xterm output driver. Initialize the display to UTF-8.

46−reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> ColorMode -> m Output

30+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

47−reserveTerminal variant outFd colorMode = liftIO $ do

31+reserveTerminal variant outFd = liftIO $ do

48 let flushedPut = void . fdWrite outFd

32 let flushedPut = void . fdWrite outFd

49 -- If the terminal variant is xterm-color use xterm instead since,

33 -- If the terminal variant is xterm-color use xterm instead since,

50 -- more often than not, xterm-color is broken.

34 -- more often than not, xterm-color is broken.

@@ -52,7 +36,7 @@ reserveTerminal variant outFd colorMode = liftIO $ do

53 utf8a <- utf8Active

37 utf8a <- utf8Active

54 when (not utf8a) $ flushedPut setUtf8CharSet

38 when (not utf8a) $ flushedPut setUtf8CharSet

55− t <- TerminfoBased.reserveTerminal variant' outFd colorMode

39+ t <- TerminfoBased.reserveTerminal variant' outFd

57 mouseModeStatus <- newIORef False

41 mouseModeStatus <- newIORef False

58 focusModeStatus <- newIORef False

42 focusModeStatus <- newIORef False

@@ -77,12 +61,10 @@ reserveTerminal variant outFd colorMode = liftIO $ do

77 True -> flushedPut enableBracketedPastes

61 True -> flushedPut enableBracketedPastes

78 False -> flushedPut disableBracketedPastes

62 False -> flushedPut disableBracketedPastes

79 writeIORef pasteModeStatus newStatus

63 writeIORef pasteModeStatus newStatus

80− Hyperlink -> setMode t Hyperlink newStatus

82 xtermGetMode Mouse = liftIO $ readIORef mouseModeStatus

65 xtermGetMode Mouse = liftIO $ readIORef mouseModeStatus

83 xtermGetMode Focus = liftIO $ readIORef focusModeStatus

66 xtermGetMode Focus = liftIO $ readIORef focusModeStatus

84 xtermGetMode BracketedPaste = liftIO $ readIORef pasteModeStatus

67 xtermGetMode BracketedPaste = liftIO $ readIORef pasteModeStatus

85− xtermGetMode Hyperlink = getModeStatus t Hyperlink

87 let t' = t

69 let t' = t

88 { terminalID = terminalID t ++ " (xterm-color)"

70 { terminalID = terminalID t ++ " (xterm-color)"

@@ -104,27 +86,30 @@ reserveTerminal variant outFd colorMode = liftIO $ do

104utf8Active :: IO Bool

86utf8Active :: IO Bool

105utf8Active = do

87utf8Active = do

106 let vars = ["LC_ALL", "LANG", "LC_CTYPE"]

88 let vars = ["LC_ALL", "LANG", "LC_CTYPE"]

107− results <- map (toLower <$>) . catMaybes <$> mapM getEnv vars

89+ results <- catMaybes <$> mapM getEnv vars

108− let matches = filter ("utf8" `isInfixOf`) results <>

90+ let matches = filter ("UTF8" `isInfixOf`) results <>

109− filter ("utf-8" `isInfixOf`) results

91+ filter ("UTF-8" `isInfixOf`) results

110 return $ not $ null matches

92 return $ not $ null matches

111

112-- | Enable bracketed paste mode:

94-- | Enable bracketed paste mode:

113-- http://cirw.in/blog/bracketed-paste

95-- http://cirw.in/blog/bracketed-paste

114−enableBracketedPastes :: ByteString

96+enableBracketedPastes :: String

115−enableBracketedPastes = BS8.pack "\ESC[?2004h"

97+enableBracketedPastes = "\ESC[?2004h"

116

117-- | Disable bracketed paste mode:

99-- | Disable bracketed paste mode:

118−disableBracketedPastes :: ByteString

100+disableBracketedPastes :: String

119−disableBracketedPastes = BS8.pack "\ESC[?2004l"

101+disableBracketedPastes = "\ESC[?2004l"

120

102

121-- | These sequences set xterm based terminals to UTF-8 output.

103-- | These sequences set xterm based terminals to UTF-8 output.

122--

104--

123-- There is no known terminfo capability equivalent to this.

105-- There is no known terminfo capability equivalent to this.

124−setUtf8CharSet, setDefaultCharSet :: ByteString

106+setUtf8CharSet, setDefaultCharSet :: String

125−setUtf8CharSet = BS8.pack "\ESC%G"

107+setUtf8CharSet = "\ESC%G"

126−setDefaultCharSet = BS8.pack "\ESC%@"

108+setDefaultCharSet = "\ESC%@"

127

109

110+-- | I think xterm is broken: Reseting the background color as the first

111+-- bytes serialized on a new line does not effect the background color

112+-- xterm uses to clear the line. Which is used *after* the next newline.

128xtermInlineHack :: Output -> IO ()

113xtermInlineHack :: Output -> IO ()

129xtermInlineHack t = do

114xtermInlineHack t = do

130 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"

115 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"

src/Graphics/Vty/Picture.hs+2−11

@@ -1,3 +1,4 @@

1+{-# LANGUAGE BangPatterns #-}

1-- A 'Picture' is a background paired with a set of 'Image' layers. The

2-- A 'Picture' is a background paired with a set of 'Image' layers. The

2-- 'Picture' data structure is representative of the final terminal

3-- 'Picture' data structure is representative of the final terminal

3-- view.

4-- view.

@@ -30,7 +31,7 @@ data Picture = Picture

30 , picBackground :: Background

31 , picBackground :: Background

31 -- ^ The picture's background to be displayed in locations with no

32 -- ^ The picture's background to be displayed in locations with no

32 -- Image data.

33 -- Image data.

33− } deriving Eq

34+ }

35instance Show Picture where

36instance Show Picture where

36 show (Picture _ layers _ ) = "Picture ?? " ++ show layers ++ " ??"

37 show (Picture _ layers _ ) = "Picture ?? " ++ show layers ++ " ??"

@@ -79,20 +80,11 @@ picForLayers is = Picture

79data Cursor =

80data Cursor =

80 -- | Hide the cursor

81 -- | Hide the cursor

81 NoCursor

82 NoCursor

82− -- | Set the terminal's cursor position without displaying a cursor

83− -- character. This is important for accessibility with screen

84− -- readers where a cursor position needs to be reported but we may

85− -- not want to show a block cursor in that location for cosmetic

86− -- reasons. The boolean argument indicates whether the positioning

87− -- should be absolute as with 'AbsoluteCursor' ('True') or logical

88− -- as with 'Cursor' ('False').

89− | PositionOnly !Bool !Int !Int

90 -- | Show the cursor at the given logical column accounting for

83 -- | Show the cursor at the given logical column accounting for

91 -- character width in the presence of multi-column characters.

84 -- character width in the presence of multi-column characters.

92 | Cursor !Int !Int

85 | Cursor !Int !Int

93 -- | Show the cursor at the given absolute terminal column and row

86 -- | Show the cursor at the given absolute terminal column and row

94 | AbsoluteCursor !Int !Int

87 | AbsoluteCursor !Int !Int

95− deriving Eq

97instance NFData Cursor where

89instance NFData Cursor where

98 rnf c = c `seq` ()

90 rnf c = c `seq` ()

@@ -116,7 +108,6 @@ data Background

116 --

108 --

117 -- * End of line if there are no remaining non-skip ops.

109 -- * End of line if there are no remaining non-skip ops.

118 | ClearBackground

110 | ClearBackground

119− deriving Eq

120

111

121instance NFData Background where

112instance NFData Background where

122 rnf (Background c a) = c `seq` a `seq` ()

113 rnf (Background c a) = c `seq` a `seq` ()

src/Graphics/Vty/PictureToSpans.hs+17−11

@@ -72,7 +72,7 @@ displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r)

72-- | Returns the DisplayOps for an image rendered to a window the size

73-- of the image.

74--

75−-- largely used only for debugging.

75+-- largerly used only for debugging.

76displayOpsForImage :: Image -> DisplayOps

77displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeight i)

@@ -81,7 +81,7 @@ combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s)

81combinedOpsForLayers pic r

82 | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0

83 | otherwise = do

84− layerOps <- mapM (`buildSpans` r) (picLayers pic)

84+ layerOps <- mapM (\layer -> buildSpans layer r) (picLayers pic)

85 case layerOps of

86 [] -> fail "empty picture"

87 [ops] -> substituteSkips (picBackground pic) ops

@@ -136,8 +136,8 @@ mergeUnder upper lower = do

136 return upper

137

138mergeRowUnder :: SpanOps -> SpanOps -> SpanOps

139−mergeRowUnder upperRowOps =

139+mergeRowUnder upperRowOps lowerRowOps =

140− onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps)

140+ onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) lowerRowOps

141 where

142 -- H: it will never be the case that we are out of upper ops

143 -- before lower ops.

@@ -298,11 +298,11 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do

298 state <- get

299 when (state^.remaining <= 0) $ fail $ name ++ " with remaining <= 0"

300 case state^.skip of

301− s | s > size -> put $ state & skip %~ subtract size

301+ s | s > size -> put $ state & skip -~ size

302 | s == 0 -> if state^.remaining > i0Dim

303 then do

304 addMaybeClipped i0

305− put $ state & offset %~ (+ i0Dim) & remaining %~ subtract i0Dim

305+ put $ state & offset +~ i0Dim & remaining -~ i0Dim

306 addMaybeClipped i1

307 else addMaybeClipped i0

308 | s < i0Dim ->

@@ -311,10 +311,10 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do

311 then addMaybeClipped i0

312 else do

313 addMaybeClipped i0

314− put $ state & offset %~ (+ i0Dim') & remaining %~ subtract i0Dim' & skip .~ 0

314+ put $ state & offset +~ i0Dim' & remaining -~ i0Dim' & skip .~ 0

315 addMaybeClipped i1

316 | s >= i0Dim -> do

317− put $ state & skip %~ subtract i0Dim

317+ put $ state & skip -~ i0Dim

318 addMaybeClipped i1

319 _ -> fail $ name ++ " has unhandled skip class"

320

@@ -323,14 +323,14 @@ addUnclippedText a txt = do

323 let op = TextSpan a usedDisplayColumns

324 (fromIntegral $ TL.length txt)

325 txt

326− usedDisplayColumns = wctlwidth txt

326+ usedDisplayColumns = wcswidth $ TL.unpack txt

327 use rowOffset >>= snocOp op

328

329addRowCompletion :: DisplayRegion -> Int -> BlitM s ()

330addRowCompletion displayRegion row = do

331 allRowOps <- view mrowOps

332 rowOps <- lift $ lift $ MVector.read allRowOps row

333− let endX = spanOpsAffectedColumns rowOps

333+ let endX = spanOpsEffectedColumns rowOps

334 when (endX < regionWidth displayRegion) $ do

335 let ow = regionWidth displayRegion - endX

336 snocOp (Skip ow) row

@@ -343,6 +343,12 @@ snocOp !op !row = do

343 lift $ lift $ do

344 ops <- MVector.read theMrowOps row

345 let ops' = Vector.snoc ops op

346− when (spanOpsAffectedColumns ops' > regionWidth theRegion)

346+ when (spanOpsEffectedColumns ops' > regionWidth theRegion)

347 $ fail $ "row " ++ show row ++ " now exceeds region width"

348 MVector.write theMrowOps row ops'

349+

350+(-~) :: Num a => ASetter s t a a -> a -> s -> t

351+l -~ n = over l (subtract n)

352+

353+(+~) :: Num a => ASetter s t a a -> a -> s -> t

354+l +~ n = over l (n +)

src/Graphics/Vty/Span.hs+11−8

@@ -1,4 +1,6 @@

1-- Copyright Corey O'Connor

2+{-# LANGUAGE BangPatterns #-}

3+{-# LANGUAGE NamedFieldPuns #-}

2{-# LANGUAGE GADTs #-}

4{-# LANGUAGE GADTs #-}

3-- | A picture is translated into a sequences of state changes and

5-- | A picture is translated into a sequences of state changes and

4-- character spans. The attribute is applied to all following spans,

6-- character spans. The attribute is applied to all following spans,

@@ -50,7 +52,7 @@ dropOps :: Int -> SpanOps -> SpanOps

50dropOps w = snd . splitOpsAt w

52dropOps w = snd . splitOpsAt w

52splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)

54splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)

53−splitOpsAt = splitOpsAt'

55+splitOpsAt inW inOps = splitOpsAt' inW inOps

54 where

56 where

55 splitOpsAt' 0 ops = (Vector.empty, ops)

57 splitOpsAt' 0 ops = (Vector.empty, ops)

56 splitOpsAt' remainingColumns ops = case Vector.head ops of

58 splitOpsAt' remainingColumns ops = case Vector.head ops of

@@ -101,18 +103,18 @@ displayOpsColumns ops

101

103

102-- | The number of rows the DisplayOps are defined for.

104-- | The number of rows the DisplayOps are defined for.

103displayOpsRows :: DisplayOps -> Int

105displayOpsRows :: DisplayOps -> Int

104−displayOpsRows = Vector.length

106+displayOpsRows ops = Vector.length ops

105

107

106affectedRegion :: DisplayOps -> DisplayRegion

108affectedRegion :: DisplayOps -> DisplayRegion

107affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)

109affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)

108

110

109-- | The number of columns a SpanOps affects.

111-- | The number of columns a SpanOps affects.

110−spanOpsAffectedColumns :: SpanOps -> Int

112+spanOpsEffectedColumns :: SpanOps -> Int

111−spanOpsAffectedColumns inOps = Vector.foldl' spanOpsAffectedColumns' 0 inOps

113+spanOpsEffectedColumns inOps = Vector.foldl' spanOpsEffectedColumns' 0 inOps

112 where

114 where

113− spanOpsAffectedColumns' t (TextSpan _ w _ _ ) = t + w

115+ spanOpsEffectedColumns' t (TextSpan _ w _ _ ) = t + w

114− spanOpsAffectedColumns' t (Skip w) = t + w

116+ spanOpsEffectedColumns' t (Skip w) = t + w

115− spanOpsAffectedColumns' t (RowEnd w) = t + w

117+ spanOpsEffectedColumns' t (RowEnd w) = t + w

116

118

117-- | The width of a single SpanOp in columns.

119-- | The width of a single SpanOp in columns.

118spanOpHasWidth :: SpanOp -> Maybe (Int, Int)

120spanOpHasWidth :: SpanOp -> Maybe (Int, Int)

@@ -124,6 +126,7 @@ spanOpHasWidth (RowEnd ow) = Just (ow,ow)

124-- span op.

126-- span op.

125columnsToCharOffset :: Int -> SpanOp -> Int

127columnsToCharOffset :: Int -> SpanOp -> Int

126columnsToCharOffset cx (TextSpan _ _ _ utf8Str) =

128columnsToCharOffset cx (TextSpan _ _ _ utf8Str) =

127− wctlwidth (TL.take (fromIntegral cx) utf8Str)

129+ let str = TL.unpack utf8Str

130+ in wcswidth (take cx str)

128columnsToCharOffset cx (Skip _) = cx

131columnsToCharOffset cx (Skip _) = cx

129columnsToCharOffset cx (RowEnd _) = cx

132columnsToCharOffset cx (RowEnd _) = cx

src/Graphics/Vty/UnicodeWidthTable/IO.hsdeleted−105

@@ -1,105 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−module Graphics.Vty.UnicodeWidthTable.IO

3− ( readUnicodeWidthTable

4− , parseUnicodeWidthTable

5− , writeUnicodeWidthTable

6− )

7−where

8−

9−import Control.Monad (when, forM)

10−import Data.Binary

11−import Data.Binary.Get

12−import Data.Binary.Put

13−import qualified Data.ByteString.Lazy as BSL

14−#if !(MIN_VERSION_base(4,11,0))

15−import Data.Semigroup ((<>))

16−#endif

17−

18−import Graphics.Vty.UnicodeWidthTable.Types

19−

20−-- | Load a binary unicode width table from the specified file.

21−--

22−-- This either returns a successfully parsed table or a table parsing

23−-- error message. This does not handle I/O exceptions.

24−readUnicodeWidthTable :: FilePath -> IO (Either String UnicodeWidthTable)

25−readUnicodeWidthTable path = parseUnicodeWidthTable <$> BSL.readFile path

26−

27−-- | Parse a binary unicode width table.

28−parseUnicodeWidthTable :: BSL.ByteString -> Either String UnicodeWidthTable

29−parseUnicodeWidthTable bs =

30− case runGetOrFail tableParser bs of

31− Left (_, _, msg) ->

32− Left msg

33−

34− -- Even if we parsed a table, leftover bytes indicate something

35− -- could be wrong.

36− Right (remainingBytes, _, _) | not (BSL.null remainingBytes) ->

37− Left $ "Error: " <> show (BSL.length remainingBytes) <>

38− " byte(s) left unconsumed"

39−

40− Right (_, _, table) ->

41− Right table

42−

43−-- | Write the unicode width table to the specified path.

44−--

45−-- This does not handle I/O exceptions.

46−writeUnicodeWidthTable :: FilePath -> UnicodeWidthTable -> IO ()

47−writeUnicodeWidthTable path table = do

48− let body = runPut (tableV1Writer table)

49− BSL.writeFile path body

50−

51−-- | Width table magic bytes for use in the binary format.

52−widthTableMagic :: Word32

53−widthTableMagic = 0xc1a9f7e0

54−

55−tableParser :: Get UnicodeWidthTable

56−tableParser = do

57− magic <- getWord32le

58−

59− when (magic /= widthTableMagic) $

60− fail "Table magic number invalid"

61−

62− version <- getWord8

63−

64− case version of

65− 1 -> tableV1Parser

66− _ -> fail "Table version invalid"

67−

68−tableV1Parser :: Get UnicodeWidthTable

69−tableV1Parser = do

70− numRanges <- getWord32le

71−

72− let parseRange = do

73− start <- getWord32le

74− size <- getWord32le

75− cols <- getWord8

76− return WidthTableRange { rangeStart = start

77− , rangeSize = size

78− , rangeColumns = cols

79− }

80−

81− ranges <- forM [1..numRanges] $ const parseRange

82−

83− return UnicodeWidthTable { unicodeWidthTableRanges = ranges

84− }

85−

86−tableV1Writer :: UnicodeWidthTable -> Put

87−tableV1Writer table = do

88− -- Magic bytes

89− putWord32le widthTableMagic

90−

91− -- Version

92− putWord8 1

93−

94− -- Number of ranges

95− let ranges = unicodeWidthTableRanges table

96− let numRanges = length ranges

97− putWord32le (fromIntegral numRanges)

98−

99− -- Ranges

100− let putRange r = do

101− putWord32le $ rangeStart r

102− putWord32le $ rangeSize r

103− putWord8 $ rangeColumns r

104−

105− mapM_ putRange ranges

src/Graphics/Vty/UnicodeWidthTable/Install.hsdeleted−129

@@ -1,129 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE ForeignFunctionInterface #-}

3−module Graphics.Vty.UnicodeWidthTable.Install

4− ( TableInstallException(..)

5− , installUnicodeWidthTable

6− , isCustomTableReady

7− )

8−where

9−

10−import Control.Monad (when, forM_)

11−import qualified Control.Exception as E

12−import GHC.Conc.Sync (withMVar)

13−import Control.Concurrent.MVar (MVar, newMVar)

14−import Data.Word (Word8, Word32)

15−#if !(MIN_VERSION_base(4,11,0))

16−import Data.Semigroup ((<>))

17−#endif

18−import System.IO.Unsafe (unsafePerformIO)

19−

20−import Graphics.Vty.UnicodeWidthTable.Types

21−

22−-- | The lock used to make functions in this module thread-safe.

23−installLock :: MVar ()

24−{-# NOINLINE installLock #-}

25−installLock = unsafePerformIO $ newMVar ()

26−

27−-- | Returns True if and only if a custom table has been allocated and

28−-- marked as ready for use.

29−--

30−-- This function is thread-safe.

31−isCustomTableReady :: IO Bool

32−isCustomTableReady = withInstallLock $ (== 1) <$> c_isCustomTableReady

33−

34−withInstallLock :: IO a -> IO a

35−withInstallLock act = withMVar installLock $ const act

36−

37−-- This is the size of the allocated custom character width table, in

38−-- character slots. It's important that this be large enough to hold all

39−-- possible Unicode character values. At the time of this writing, the

40−-- valid Unicode range is 0 - 0x10ffff, hence this value.

41−tableSize :: Int

42−tableSize = 0x110000

43−

44−-- | Exception type raised by 'installUnicodeWidthTable'.

45−data TableInstallException =

46− TableInitFailure Int Int

47− -- ^ The width table could not be initialized. Args: failure status,

48− -- requested table size.

49− | TableRangeFailure Int WidthTableRange

50− -- ^ A code point range could not be configured. Args: failure

51− -- status, offending range.

52− | TableActivationFailure Int

53− -- ^ The table could not be activated. Args: failure status.

54− deriving (Eq, Show)

55−

56−instance E.Exception TableInstallException

57−

58−-- | Install a custom unicode character width

59−-- table. Such tables are obtained with

60−-- 'Graphics.Vty.UnicodeWidthTable.Query.buildUnicodeWidthTable' and

61−-- 'Graphics.Vty.UnicodeWidthTable.IO.readUnicodeWidthTable'.

62−--

63−-- ALERT! This function is probably not what you want to use because

64−-- it is automatically called by 'Graphics.Vty.mkVty'. You will only

65−-- ever need to call this function if you want to use functions

66−-- in 'Graphics.Text.Width' without controlling the terminal with

67−-- 'Graphics.Vty.mkVty'.

68−--

69−-- This affects the behavior of the 'Graphics.Vty.Image.wcwidth'

70−-- function and functions that call it. It does so by

71−-- changing global state available to the C implementation

72−-- of 'Graphics.Vty.Image.wcwidth'. To ensure that your

73−-- program gets consistent results from evaluating calls to

74−-- 'Graphics.Vty.Image.wcwidth', the installation of a custom table

75−-- should be performed before you call 'Graphics.Vty.Image.wcwidth' in

76−-- your program.

77−--

78−-- This is best done at Vty startup, and if you use

79−-- 'Graphics.Vty.mkVty', that function calls this automatically based on

80−-- the Vty configuration's declared width tables. It is exposed as part

81−-- of the public API so that applications can call this as needed if

82−-- they don't want to control the terminal with 'mkVty' but do want to

83−-- make calls to 'Graphics.Vty.Image.wcwidth'.

84−--

85−-- It's also important to note that once a custom table has been

86−-- installed, it is permanent for the life of the process. No new table

87−-- can be installed, and the new custom table cannot be removed.

88−--

89−-- If this function fails for any reason -- if the table cannot be

90−-- installed or is invalid, or if a custom table already exists -- this

91−-- will raise a 'TableInstallException' exception.

92−--

93−-- This function is thread-safe.

94−installUnicodeWidthTable :: UnicodeWidthTable -> IO ()

95−installUnicodeWidthTable table = withInstallLock $ do

96− initResult <- initCustomTable tableSize

97− when (initResult /= 0) $

98− E.throwIO $ TableInitFailure initResult tableSize

99−

100− forM_ (unicodeWidthTableRanges table) $ \r -> do

101− result <- setCustomTableRange (rangeStart r)

102− (rangeSize r)

103− (rangeColumns r)

104−

105− when (result /= 0) $ do

106− deallocateCustomTable

107− E.throwIO $ TableRangeFailure result r

108−

109− actResult <- activateCustomTable

110− when (actResult /= 0) $

111− E.throwIO $ TableActivationFailure actResult

112−

113−------------------------------------------------------------------------

114−-- C imports

115−

116−foreign import ccall unsafe "vty_init_custom_table"

117− initCustomTable :: Int -> IO Int

118−

119−foreign import ccall unsafe "vty_set_custom_table_range"

120− setCustomTableRange :: Word32 -> Word32 -> Word8 -> IO Int

121−

122−foreign import ccall unsafe "vty_activate_custom_table"

123− activateCustomTable :: IO Int

124−

125−foreign import ccall unsafe "vty_custom_table_ready"

126− c_isCustomTableReady :: IO Int

127−

128−foreign import ccall unsafe "vty_deallocate_custom_table"

129− deallocateCustomTable :: IO ()

src/Graphics/Vty/UnicodeWidthTable/Query.hsdeleted−79

@@ -1,79 +0,0 @@

1−{-# LANGUAGE TupleSections #-}

2−module Graphics.Vty.UnicodeWidthTable.Query

3− ( buildUnicodeWidthTable

4− , defaultUnicodeTableUpperBound

5− )

6−where

7−

8−import Control.Monad (forM)

9−import Data.Char (generalCategory, GeneralCategory(..))

10−import System.Console.ANSI (getCursorPosition)

11−import Text.Printf (printf)

12−

13−import Graphics.Vty.UnicodeWidthTable.Types

14−

15−shouldConsider :: Char -> Bool

16−shouldConsider c =

17− case generalCategory c of

18− Control -> False

19− NotAssigned -> False

20− Surrogate -> False

21− _ -> True

22−

23−charWidth :: Char -> IO Int

24−charWidth c = do

25− printf "\r"

26− putChar c

27− Just (_, col) <- getCursorPosition

28− return col

29−

30−-- | Convert a sequence of character/width pairs into a list of

31−-- run-length encoded ranges. This function assumes the pairs come

32−-- sorted by character ordinal value. It does not require that the

33−-- character range is fully covered by the sequence.

34−--

35−-- The result of this function is a list of ranges in reverse order

36−-- relative to the input sequence.

37−mkRanges :: [(Char, Int)] -> [WidthTableRange]

38−mkRanges pairs =

39− let convertedPairs = convert <$> pairs

40− convert (c, i) = (fromIntegral $ fromEnum c, fromIntegral i)

41−

42− go Nothing finishedRanges [] = finishedRanges

43− go (Just r) finishedRanges [] = r:finishedRanges

44−

45− go Nothing finishedRanges ((c, width):rest) =

46− go (Just $ WidthTableRange c 1 width) finishedRanges rest

47−

48− go (Just r@(WidthTableRange prevCh sz prevWidth)) finishedRanges ((c, width):rest) =

49− if c == prevCh + sz && prevWidth == width

50− then go (Just (WidthTableRange prevCh (sz + 1) prevWidth)) finishedRanges rest

51− else go (Just (WidthTableRange c 1 width)) (r:finishedRanges) rest

52−

53− in go Nothing [] convertedPairs

54−

55−-- The uppermost code point to consider when building Unicode width

56−-- tables.

57−defaultUnicodeTableUpperBound :: Char

58−defaultUnicodeTableUpperBound = '\xe0000'

59−

60−-- | Construct a unicode character width table by querying the terminal

61−-- connected to stdout. This works by emitting characters to stdout

62−-- and then querying the terminal to determine the resulting cursor

63−-- position in order to measure character widths. Consequently this will

64−-- generate a lot of output and may take a while, depending on your

65−-- system performance. This should not be run in a terminal while it is

66−-- controlled by Vty.

67−--

68−-- The argument specifies the upper bound code point to test when

69−-- building the table. This allows callers to decide how much of the

70−-- Unicode code point space to scan when building the table.

71−--

72−-- This does not handle exceptions.

73−buildUnicodeWidthTable :: Char -> IO UnicodeWidthTable

74−buildUnicodeWidthTable tableUpperBound = do

75− pairs <- forM (filter shouldConsider ['\0'..tableUpperBound]) $ \i ->

76− (i,) <$> charWidth i

77−

78− return UnicodeWidthTable { unicodeWidthTableRanges = reverse $ mkRanges pairs

79− }

src/Graphics/Vty/UnicodeWidthTable/Types.hsdeleted−29

@@ -1,29 +0,0 @@

1−module Graphics.Vty.UnicodeWidthTable.Types

2− ( UnicodeWidthTable(..)

3− , WidthTableRange(..)

4− )

5−where

6−

7−import Data.Word (Word8, Word32)

8−

9−-- | A range of code points in a width table.

10−data WidthTableRange =

11− WidthTableRange { rangeStart :: Word32

12− -- ^ The range's starting code point.

13− , rangeSize :: Word32

14− -- ^ The number of code points in the contiguous

15− -- range, beginning with the starting code point

16− -- ('rangeStart').

17− , rangeColumns :: Word8

18− -- ^ The terminal width, in columns, of all of the

19− -- characters corresponding to the code points in

20− -- this range.

21− }

22− deriving (Eq, Show)

23−

24−-- | A run-length-encoded table of Unicode character widths.

25−data UnicodeWidthTable =

26− UnicodeWidthTable { unicodeWidthTableRanges :: [WidthTableRange]

27− -- ^ The ranges in the table.

28− }

29− deriving (Show)

test/Verify/Graphics/Vty/Span.hs+1−1

@@ -20,7 +20,7 @@ isAttrSpanOp TextSpan {} = True

20isAttrSpanOp _ = False

22verifyAllSpansHaveWidth i spans w

23− = let v = map (\s -> (spanOpsAffectedColumns s /= w, s)) (Vector.toList spans)

23+ = let v = map (\s -> (spanOpsEffectedColumns s /= w, s)) (Vector.toList spans)

24 in case any ((== True) . fst) v of

25 False -> succeeded

26 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 #-}

2module VerifyEmptyImageProps where

1module VerifyEmptyImageProps where

4import Verify

3import Verify

test/VerifyEvalTerminfoCaps.hs−1

@@ -1,6 +1,5 @@

1{-# LANGUAGE BangPatterns #-}

2{-# LANGUAGE NamedFieldPuns #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4module VerifyEvalTerminfoCaps where

3module VerifyEvalTerminfoCaps where

6import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)

5import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)

test/VerifyImageOps.hs+1−2

@@ -1,4 +1,3 @@

1−{-# LANGUAGE ScopedTypeVariables #-}

2module VerifyImageOps where

1module VerifyImageOps where

4import Graphics.Vty.Attributes

3import Graphics.Vty.Attributes

@@ -137,7 +136,7 @@ cropBottomLimitsHeight :: Image -> Int -> Property

137cropBottomLimitsHeight i v = v >= 0 ==>

136cropBottomLimitsHeight i v = v >= 0 ==>

138 v >= imageHeight (cropBottom v i)

137 v >= imageHeight (cropBottom v i)

139

138

140−-- ridiculous tests just to satisfy my desire for nice code coverage :-P

139+-- rediculous tests just to satisfy my desire for nice code coverage :-P

141canShowImage :: Image -> Bool

140canShowImage :: Image -> Bool

142canShowImage i = length (show i) > 0

141canShowImage i = length (show i) > 0

143

142

test/VerifyOutput.hs+3−7

@@ -1,7 +1,6 @@

1−-- We setup the environment to invoke certain terminals of interest.

1+-- We setup the environment to envoke certain terminals of interest.

2-- This assumes appropriate definitions exist in the current environment

3-- for the terminals of interest.

4−{-# LANGUAGE ScopedTypeVariables #-}

5module VerifyOutput where

4module VerifyOutput where

7import Verify

6import Verify

@@ -14,6 +13,7 @@ import Verify.Graphics.Vty.Output

14import Control.Monad

13import Control.Monad

16import qualified System.Console.Terminfo as Terminfo

15import qualified System.Console.Terminfo as Terminfo

16+import System.Posix.Env

17import System.Posix.IO

19tests :: IO [Test]

@@ -35,11 +35,7 @@ smokeTestTermNonMac termName i = liftIOResult $ do

35smokeTestTerm :: String -> Image -> IO Result

36smokeTestTerm termName i = do

37 nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags

38− t <- outputForConfig $ defaultConfig

38+ t <- outputForConfig $ defaultConfig { outputFd = Just nullOut, termName = Just termName }

39− { outputFd = Just nullOut

40− , termName = Just termName

41− , colorMode = Just NoColor

42− }

43 -- putStrLn $ "context color count: " ++ show (contextColorCount t)

39 -- putStrLn $ "context color count: " ++ show (contextColorCount t)

44 reserveDisplay t

40 reserveDisplay t

45 dc <- displayContext t (100,100)

41 dc <- displayContext t (100,100)

test/VerifyParseTerminfoCaps.hs−1

@@ -1,5 +1,4 @@

1{-# LANGUAGE NamedFieldPuns #-}

2−{-# LANGUAGE ScopedTypeVariables #-}

3module VerifyParseTerminfoCaps where

2module VerifyParseTerminfoCaps where

5import Prelude hiding ( catch )

4import Prelude hiding ( catch )

test/VerifySimpleSpanGeneration.hs+8−8

@@ -25,7 +25,7 @@ unitImageAndZeroWindow1 :: UnitImage -> EmptyWindow -> Bool

25unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =

26 let p = picForImage i

27 ops = displayOpsForPic p (regionForWindow w)

28− in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

28+ in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

30horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

31horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

@@ -37,7 +37,7 @@ horizSpanImageAndZeroWindow1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

37horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

38 let p = picForImage i

39 ops = displayOpsForPic p (regionForWindow w)

40− in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

40+ in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

42horizSpanImageAndEqualWindow0 :: SingleRowSingleAttrImage -> Result

43horizSpanImageAndEqualWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =

@@ -51,7 +51,7 @@ horizSpanImageAndEqualWindow1 (SingleRowSingleAttrImage { rowImage = i, expected

51 let p = picForImage i

52 w = MockWindow c 1

53 ops = displayOpsForPic p (regionForWindow w)

54− in spanOpsAffectedRows ops == 1

54+ in spanOpsEffectedRows ops == 1

56horizSpanImageAndLesserWindow0 :: SingleRowSingleAttrImage -> Result

57horizSpanImageAndLesserWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =

@@ -74,7 +74,7 @@ singleAttrSingleSpanStackCropped1 stack =

74 expectedRowCount = stackHeight stack `div` 2

75 w = MockWindow (stackWidth stack) expectedRowCount

76 ops = displayOpsForPic p (regionForWindow w)

77− actualRowCount = spanOpsAffectedRows ops

77+ actualRowCount = spanOpsEffectedRows ops

78 in expectedRowCount == actualRowCount

80singleAttrSingleSpanStackCropped2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

@@ -90,7 +90,7 @@ singleAttrSingleSpanStackCropped3 stack0 stack1 =

90 w = MockWindow (imageWidth (picImage p)) expectedRowCount

91 ops = displayOpsForPic p (regionForWindow w)

92 expectedRowCount = imageHeight (picImage p) `div` 2

93− actualRowCount = spanOpsAffectedRows ops

93+ actualRowCount = spanOpsEffectedRows ops

94 in expectedRowCount == actualRowCount

96singleAttrSingleSpanStackCropped4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

@@ -107,7 +107,7 @@ singleAttrSingleSpanStackCropped5 stack0 stack1 =

107 w = MockWindow (imageWidth (picImage p)) (stackHeight stack0)

108 ops = displayOpsForPic p (regionForWindow w)

109 expectedRowCount = stackHeight stack0

110− actualRowCount = spanOpsAffectedRows ops

110+ actualRowCount = spanOpsEffectedRows ops

111 in expectedRowCount == actualRowCount

112

113horizSpanImageAndGreaterWindow0 :: SingleRowSingleAttrImage -> Result

@@ -123,13 +123,13 @@ arbImageIsCropped :: DefaultImage -> MockWindow -> Bool

123arbImageIsCropped (DefaultImage image) win@(MockWindow w h) =

124 let pic = picForImage image

125 ops = displayOpsForPic pic (regionForWindow win)

126− in ( spanOpsAffectedRows ops == h ) && ( allSpansHaveWidth ops w )

126+ in ( spanOpsEffectedRows ops == h ) && ( allSpansHaveWidth ops w )

127

128spanOpsActuallyFillRows :: DefaultPic -> Bool

129spanOpsActuallyFillRows (DefaultPic pic win) =

130 let ops = displayOpsForPic pic (regionForWindow win)

131 expectedRowCount = regionHeight (regionForWindow win)

132− actualRowCount = spanOpsAffectedRows ops

132+ actualRowCount = spanOpsEffectedRows ops

133 in expectedRowCount == actualRowCount

134

135spanOpsActuallyFillColumns :: DefaultPic -> Bool

test/VerifyUsingMockInput.hs+1−4

@@ -1,6 +1,5 @@

1{-# LANGUAGE MultiParamTypeClasses #-}

2{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4-- Generate some input bytes and delays between blocks of input bytes.

3-- Generate some input bytes and delays between blocks of input bytes.

5-- Verify the events produced are as expected.

4-- Verify the events produced are as expected.

6module Main where

5module Main where

@@ -132,9 +131,7 @@ assertEventsFromSynInput table inputSpec expectedEvents = do

132 readLoop 0 = return ()

131 readLoop 0 = return ()

133 readLoop n = do

132 readLoop n = do

134 e <- atomically $ readTChan $ input^.eventChannel

133 e <- atomically $ readTChan $ input^.eventChannel

135− case e of

136− InputEvent ev -> modifyIORef eventsRef ((:) ev)

134+ modifyIORef eventsRef ((:) e)

137− ResumeAfterSignal -> return ()

138 readLoop (n - 1)

135 readLoop (n - 1)

139 genEventsUsingIoActions maxDuration writeWaitClose readEvents

136 genEventsUsingIoActions maxDuration writeWaitClose readEvents

140 outEvents <- reverse <$> readIORef eventsRef

137 outEvents <- reverse <$> readIORef eventsRef

test/interactive_terminal_test.hs+1−1

@@ -364,7 +364,7 @@ Did the test output match the description?

364|]

365 defaultSuccessConfirmResults

366

367−-- Explicitly define the bytes that encode each example text.

367+-- Explicitely definethe bytes that encode each example text.

368-- This avoids any issues with how the compiler represents string literals.

369--

370-- This document is UTF-8 encoded so the UTF-8 string is still included for

tools/BuildWidthTable.hsdeleted−144

@@ -1,144 +0,0 @@

1−{-# LANGUAGE ScopedTypeVariables #-}

2−{-# LANGUAGE CPP #-}

3−module Main where

4−

5−import qualified Control.Exception as E

6−import Control.Monad (when)

7−import Data.Maybe (fromMaybe)

8−#if !(MIN_VERSION_base(4,11,0))

9−import Data.Semigroup ((<>))

10−#endif

11−import System.Directory (createDirectoryIfMissing)

12−import System.Environment (getArgs, getProgName)

13−import System.FilePath (takeDirectory)

14−import System.Exit (exitFailure)

15−import System.Console.GetOpt

16−import Text.Read (readMaybe)

17−

18−import Graphics.Vty.Config ( terminalWidthTablePath, currentTerminalName

19− , vtyConfigPath, addConfigWidthMap

20− , ConfigUpdateResult(..)

21− )

22−import Graphics.Vty.UnicodeWidthTable.IO

23−import Graphics.Vty.UnicodeWidthTable.Query

24−

25−data Arg = Help

26− | OutputPath String

27− | TableUpperBound String

28− | UpdateConfig

29− | VtyConfigPath String

30− deriving (Eq, Show)

31−

32−options :: Config -> [OptDescr Arg]

33−options config =

34− [ Option "h" ["help"] (NoArg Help)

35− "This help output"

36− , Option "b" ["bound"] (ReqArg TableUpperBound "MAX_CHAR")

37− ("The maximum Unicode code point to test when building the table " <>

38− "(default: " <> (show $ fromEnum $ configBound config) <> ")")

39− , Option "p" ["path"] (ReqArg OutputPath "PATH")

40− ("The output path to write to (default: " <>

41− fromMaybe "<none>" (configOutputPath config) <> ")")

42− , Option "u" ["update-config"] (NoArg UpdateConfig)

43− "Create or update the Vty configuration file to use the new table (default: no)"

44− , Option "c" ["config-path"] (ReqArg VtyConfigPath "PATH")

45− ("Update the specified Vty configuration file path when -u is set (default: " <>

46− configPath config <> ")")

47− ]

48−

49−data Config =

50− Config { configOutputPath :: Maybe FilePath

51− , configBound :: Char

52− , configUpdate :: Bool

53− , configPath :: FilePath

54− }

55− deriving (Show)

56−

57−mkDefaultConfig :: IO Config

58−mkDefaultConfig = do

59− Config <$> terminalWidthTablePath

60− <*> pure defaultUnicodeTableUpperBound

61− <*> pure False

62− <*> vtyConfigPath

63−

64−usage :: IO ()

65−usage = do

66− config <- mkDefaultConfig

67− pn <- getProgName

68− putStrLn $ "Usage: " <> pn <> " [options]"

69− putStrLn ""

70− putStrLn "This tool queries the terminal on stdout to determine the widths"

71− putStrLn "of Unicode characters rendered to the terminal. The resulting data"

72− putStrLn "is written to a table at the specified output path for later"

73− putStrLn "loading by Vty-based applications."

74− putStrLn ""

75−

76− putStrLn $ usageInfo pn (options config)

77−

78−updateConfigFromArg :: Arg -> Config -> Config

79−updateConfigFromArg Help c =

80− c

81−updateConfigFromArg UpdateConfig c =

82− c { configUpdate = True }

83−updateConfigFromArg (VtyConfigPath p) c =

84− c { configPath = p }

85−updateConfigFromArg (TableUpperBound s) c =

86− case readMaybe s of

87− Nothing -> error $ "Invalid table upper bound: " <> show s

88− Just v -> c { configBound = toEnum v }

89−updateConfigFromArg (OutputPath p) c =

90− c { configOutputPath = Just p }

91−

92−main :: IO ()

93−main = do

94− defConfig <- mkDefaultConfig

95− strArgs <- getArgs

96− let (args, unused, errors) = getOpt Permute (options defConfig) strArgs

97−

98− when (not $ null errors) $ do

99− mapM_ putStrLn errors

100− exitFailure

101−

102− when ((not $ null unused) || (Help `elem` args)) $ do

103− usage

104− exitFailure

105−

106− let config = foldr updateConfigFromArg defConfig args

107−

108− outputPath <- case configOutputPath config of

109− Nothing -> do

110− putStrLn "Error: could not obtain terminal width table path"

111− exitFailure

112− Just path -> return path

113−

114− putStrLn "Querying terminal:"

115− builtTable <- buildUnicodeWidthTable $ configBound config

116−

117− let dir = takeDirectory outputPath

118− createDirectoryIfMissing True dir

119− writeUnicodeWidthTable outputPath builtTable

120−

121− putStrLn $ "\nOutput table written to " <> outputPath

122−

123− when (configUpdate config) $ do

124− let cPath = configPath config

125− Just tName <- currentTerminalName

126−

127− result <- E.try $ addConfigWidthMap cPath tName outputPath

128−

129− case result of

130− Left (e::E.SomeException) -> do

131− putStrLn $ "Error updating Vty configuration at " <> cPath <> ": " <>

132− show e

133− exitFailure

134− Right ConfigurationCreated -> do

135− putStrLn $ "Configuration file created: " <> cPath

136− Right ConfigurationModified -> do

137− putStrLn $ "Configuration file updated: " <> cPath

138− Right (ConfigurationConflict other) -> do

139− putStrLn $ "Configuration file not updated: uses a different table " <>

140− "for TERM=" <> tName <> ": " <> other

141− Right ConfigurationRedundant -> do

142− putStrLn $ "Configuration file not updated: configuration " <>

143− cPath <> " already uses table " <> outputPath <>

144− " for TERM=" <> tName

vty.cabal+66−75

@@ -1,5 +1,5 @@

1name: vty

2−version: 5.35.1

2+version: 5.17

3license: BSD3

4license-file: LICENSE

5author: AUTHORS

@@ -24,13 +24,13 @@ description:

25 .

27−cabal-version: 1.18

27+cabal-version: >= 1.18

28build-type: Simple

29extra-doc-files: README.md,

30 AUTHORS,

31 CHANGELOG.md,

32 LICENSE

33−tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.5

33+tested-with: GHC >= 7.6.2

35source-repository head

36 type: git

@@ -45,9 +45,10 @@ library

45 deepseq >= 1.1 && < 1.5,

46 directory,

47 filepath >= 1.0 && < 2.0,

48− microlens < 0.4.13,

48+ microlens,

49 microlens-mtl,

50 microlens-th,

51+ -- required for nice installation with yi

51 hashable >= 1.2,

52 hashable >= 1.2,

52 mtl >= 1.1.1.0 && < 2.3,

53 mtl >= 1.1.1.0 && < 2.3,

53 parallel >= 2.2 && < 3.3,

54 parallel >= 2.2 && < 3.3,

@@ -58,18 +59,10 @@ library

58 text >= 0.11.3,

59 text >= 0.11.3,

59 unix,

60 unix,

60 utf8-string >= 0.3 && < 1.1,

61 utf8-string >= 0.3 && < 1.1,

61− vector >= 0.7,

62+ vector >= 0.7

62− binary,

63− ansi-terminal >= 0.10.3

64−

65− if !impl(ghc >= 8.0)

66− build-depends: semigroups >= 0.16,

67− fail

69 exposed-modules: Graphics.Vty

64 exposed-modules: Graphics.Vty

70 Graphics.Vty.Attributes

65 Graphics.Vty.Attributes

71− Graphics.Vty.Attributes.Color

72− Graphics.Vty.Attributes.Color240

73 Graphics.Vty.Config

66 Graphics.Vty.Config

74 Graphics.Vty.Error

67 Graphics.Vty.Error

75 Graphics.Vty.Image

68 Graphics.Vty.Image

@@ -80,6 +73,7 @@ library

80 Graphics.Vty.Picture

73 Graphics.Vty.Picture

81 Graphics.Vty.Output

74 Graphics.Vty.Output

82 Graphics.Text.Width

75 Graphics.Text.Width

76+ -- the modules below are only meant to be used by the tests.

83 Codec.Binary.UTF8.Debug

77 Codec.Binary.UTF8.Debug

84 Data.Terminfo.Parse

78 Data.Terminfo.Parse

85 Data.Terminfo.Eval

79 Data.Terminfo.Eval

@@ -100,47 +94,35 @@ library

100 Graphics.Vty.Output.Interface

94 Graphics.Vty.Output.Interface

101 Graphics.Vty.Output.XTermColor

95 Graphics.Vty.Output.XTermColor

102 Graphics.Vty.Output.TerminfoBased

96 Graphics.Vty.Output.TerminfoBased

103− Graphics.Vty.UnicodeWidthTable.Types

104− Graphics.Vty.UnicodeWidthTable.IO

105− Graphics.Vty.UnicodeWidthTable.Query

106− Graphics.Vty.UnicodeWidthTable.Install

107

108− other-modules: Graphics.Vty.Debug.Image

98+ other-modules: Graphics.Vty.Attributes.Color

99+ Graphics.Vty.Attributes.Color240

100+ Graphics.Vty.Debug.Image

109 Graphics.Vty.Input.Terminfo.ANSIVT

101 Graphics.Vty.Input.Terminfo.ANSIVT

110

102

111 c-sources: cbits/gwinsz.c

103 c-sources: cbits/gwinsz.c

112 cbits/set_term_timing.c

104 cbits/set_term_timing.c

113− cbits/get_tty_erase.c

114 cbits/mk_wcwidth.c

105 cbits/mk_wcwidth.c

115

106

116 include-dirs: cbits

107 include-dirs: cbits

117

108

118 hs-source-dirs: src

109 hs-source-dirs: src

119

110

111+ default-extensions: ScopedTypeVariables

112+ ForeignFunctionInterface

113+

120 ghc-options: -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10

114 ghc-options: -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10

121

115

122 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10

116 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10

123

117

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

118+ cc-options: -O2

130−

131− if !impl(ghc >= 8.0)

132− build-depends: semigroups >= 0.16

133−

134− build-depends: vty,

135− directory,

136− filepath,

137− base >= 4.8 && < 5

138

119

139executable vty-mode-demo

120executable vty-mode-demo

140 main-is: ModeDemo.hs

121 main-is: ModeDemo.hs

141 hs-source-dirs: demos

122 hs-source-dirs: demos

142

123

143 default-language: Haskell2010

124 default-language: Haskell2010

125+ default-extensions: ScopedTypeVariables

144 ghc-options: -threaded

126 ghc-options: -threaded

145

127

146 build-depends: vty,

128 build-depends: vty,

@@ -155,6 +137,7 @@ executable vty-demo

155 hs-source-dirs: demos

137 hs-source-dirs: demos

156

138

157 default-language: Haskell2010

139 default-language: Haskell2010

140+ default-extensions: ScopedTypeVariables

158 ghc-options: -threaded

141 ghc-options: -threaded

159

142

160 build-depends: vty,

143 build-depends: vty,

@@ -164,8 +147,29 @@ executable vty-demo

164 microlens-mtl,

147 microlens-mtl,

165 mtl >= 1.1.1.0 && < 2.3

148 mtl >= 1.1.1.0 && < 2.3

166

149

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+

167test-suite verify-using-mock-terminal

170test-suite verify-using-mock-terminal

168 default-language: Haskell2010

171 default-language: Haskell2010

172+ default-extensions: ScopedTypeVariables

169

173

170 type: detailed-0.9

174 type: detailed-0.9

171

175

@@ -184,7 +188,7 @@ test-suite verify-using-mock-terminal

184 build-depends: vty,

188 build-depends: vty,

185 Cabal >= 1.20,

189 Cabal >= 1.20,

186 QuickCheck >= 2.7,

190 QuickCheck >= 2.7,

187− random >= 1.0 && < 1.3,

191+ random >= 1.0 && < 1.2,

188 base >= 4.8 && < 5,

192 base >= 4.8 && < 5,

189 bytestring,

193 bytestring,

190 containers,

194 containers,

@@ -198,6 +202,7 @@ test-suite verify-using-mock-terminal

198

202

199test-suite verify-terminal

203test-suite verify-terminal

200 default-language: Haskell2010

204 default-language: Haskell2010

205+ default-extensions: ScopedTypeVariables

201

206

202 type: detailed-0.9

207 type: detailed-0.9

203

208

@@ -216,7 +221,7 @@ test-suite verify-terminal

216 build-depends: vty,

221 build-depends: vty,

217 Cabal >= 1.20,

222 Cabal >= 1.20,

218 QuickCheck >= 2.7,

223 QuickCheck >= 2.7,

219− random >= 1.0 && < 1.3,

224+ random >= 1.0 && < 1.2,

220 base >= 4.8 && < 5,

225 base >= 4.8 && < 5,

221 bytestring,

226 bytestring,

222 containers,

227 containers,

@@ -230,6 +235,7 @@ test-suite verify-terminal

230

235

231test-suite verify-display-attributes

236test-suite verify-display-attributes

232 default-language: Haskell2010

237 default-language: Haskell2010

238+ default-extensions: ScopedTypeVariables

233

239

234 type: detailed-0.9

240 type: detailed-0.9

235

241

@@ -248,7 +254,7 @@ test-suite verify-display-attributes

248 build-depends: vty,

254 build-depends: vty,

249 Cabal >= 1.20,

255 Cabal >= 1.20,

250 QuickCheck >= 2.7,

256 QuickCheck >= 2.7,

251− random >= 1.0 && < 1.3,

257+ random >= 1.0 && < 1.2,

252 base >= 4.8 && < 5,

258 base >= 4.8 && < 5,

253 bytestring,

259 bytestring,

254 containers,

260 containers,

@@ -261,6 +267,7 @@ test-suite verify-display-attributes

261

267

262test-suite verify-empty-image-props

268test-suite verify-empty-image-props

263 default-language: Haskell2010

269 default-language: Haskell2010

270+ default-extensions: ScopedTypeVariables

264

271

265 type: detailed-0.9

272 type: detailed-0.9

266

273

@@ -273,7 +280,7 @@ test-suite verify-empty-image-props

273 build-depends: vty,

280 build-depends: vty,

274 Cabal >= 1.20,

281 Cabal >= 1.20,

275 QuickCheck >= 2.7,

282 QuickCheck >= 2.7,

276− random >= 1.0 && < 1.3,

283+ random >= 1.0 && < 1.2,

277 base >= 4.8 && < 5,

284 base >= 4.8 && < 5,

278 bytestring,

285 bytestring,

279 containers,

286 containers,

@@ -286,6 +293,7 @@ test-suite verify-empty-image-props

286

293

287test-suite verify-eval-terminfo-caps

294test-suite verify-eval-terminfo-caps

288 default-language: Haskell2010

295 default-language: Haskell2010

296+ default-extensions: ScopedTypeVariables

289

297

290 type: detailed-0.9

298 type: detailed-0.9

291

299

@@ -299,7 +307,7 @@ test-suite verify-eval-terminfo-caps

299 build-depends: vty,

307 build-depends: vty,

300 Cabal >= 1.20,

308 Cabal >= 1.20,

301 QuickCheck >= 2.7,

309 QuickCheck >= 2.7,

302− random >= 1.0 && < 1.3,

310+ random >= 1.0 && < 1.2,

303 base >= 4.8 && < 5,

311 base >= 4.8 && < 5,

304 blaze-builder >= 0.3.3.2 && < 0.5,

312 blaze-builder >= 0.3.3.2 && < 0.5,

305 bytestring,

313 bytestring,

@@ -314,6 +322,7 @@ test-suite verify-eval-terminfo-caps

314

322

315test-suite verify-image-ops

323test-suite verify-image-ops

316 default-language: Haskell2010

324 default-language: Haskell2010

325+ default-extensions: ScopedTypeVariables

317

326

318 type: detailed-0.9

327 type: detailed-0.9

319

328

@@ -328,7 +337,7 @@ test-suite verify-image-ops

328 build-depends: vty,

337 build-depends: vty,

329 Cabal >= 1.20,

338 Cabal >= 1.20,

330 QuickCheck >= 2.7,

339 QuickCheck >= 2.7,

331− random >= 1.0 && < 1.3,

340+ random >= 1.0 && < 1.2,

332 base >= 4.8 && < 5,

341 base >= 4.8 && < 5,

333 bytestring,

342 bytestring,

334 containers,

343 containers,

@@ -341,6 +350,7 @@ test-suite verify-image-ops

341

350

342test-suite verify-image-trans

351test-suite verify-image-trans

343 default-language: Haskell2010

352 default-language: Haskell2010

353+ default-extensions: ScopedTypeVariables

344

354

345 type: detailed-0.9

355 type: detailed-0.9

346

356

@@ -355,7 +365,7 @@ test-suite verify-image-trans

355 build-depends: vty,

365 build-depends: vty,

356 Cabal >= 1.20,

366 Cabal >= 1.20,

357 QuickCheck >= 2.7,

367 QuickCheck >= 2.7,

358− random >= 1.0 && < 1.3,

368+ random >= 1.0 && < 1.2,

359 base >= 4.8 && < 5,

369 base >= 4.8 && < 5,

360 bytestring,

370 bytestring,

361 containers,

371 containers,

@@ -368,6 +378,7 @@ test-suite verify-image-trans

368

378

369test-suite verify-inline

379test-suite verify-inline

370 default-language: Haskell2010

380 default-language: Haskell2010

381+ default-extensions: ScopedTypeVariables

371

382

372 type: detailed-0.9

383 type: detailed-0.9

373

384

@@ -381,7 +392,7 @@ test-suite verify-inline

381 build-depends: vty,

392 build-depends: vty,

382 Cabal >= 1.20,

393 Cabal >= 1.20,

383 QuickCheck >= 2.7,

394 QuickCheck >= 2.7,

384− random >= 1.0 && < 1.3,

395+ random >= 1.0 && < 1.2,

385 base >= 4.8 && < 5,

396 base >= 4.8 && < 5,

386 bytestring,

397 bytestring,

387 containers,

398 containers,

@@ -394,6 +405,7 @@ test-suite verify-inline

394

405

395test-suite verify-parse-terminfo-caps

406test-suite verify-parse-terminfo-caps

396 default-language: Haskell2010

407 default-language: Haskell2010

408+ default-extensions: ScopedTypeVariables

397

409

398 type: detailed-0.9

410 type: detailed-0.9

399

411

@@ -408,7 +420,7 @@ test-suite verify-parse-terminfo-caps

408 build-depends: vty,

420 build-depends: vty,

409 Cabal >= 1.20,

421 Cabal >= 1.20,

410 QuickCheck >= 2.7,

422 QuickCheck >= 2.7,

411− random >= 1.0 && < 1.3,

423+ random >= 1.0 && < 1.2,

412 base >= 4.8 && < 5,

424 base >= 4.8 && < 5,

413 bytestring,

425 bytestring,

414 containers,

426 containers,

@@ -422,6 +434,7 @@ test-suite verify-parse-terminfo-caps

422

434

423test-suite verify-simple-span-generation

435test-suite verify-simple-span-generation

424 default-language: Haskell2010

436 default-language: Haskell2010

437+ default-extensions: ScopedTypeVariables

425

438

426 type: detailed-0.9

439 type: detailed-0.9

427

440

@@ -439,7 +452,7 @@ test-suite verify-simple-span-generation

439 build-depends: vty,

452 build-depends: vty,

440 Cabal >= 1.20,

453 Cabal >= 1.20,

441 QuickCheck >= 2.7,

454 QuickCheck >= 2.7,

442− random >= 1.0 && < 1.3,

455+ random >= 1.0 && < 1.2,

443 base >= 4.8 && < 5,

456 base >= 4.8 && < 5,

444 bytestring,

457 bytestring,

445 containers,

458 containers,

@@ -453,6 +466,7 @@ test-suite verify-simple-span-generation

453

466

454test-suite verify-crop-span-generation

467test-suite verify-crop-span-generation

455 default-language: Haskell2010

468 default-language: Haskell2010

469+ default-extensions: ScopedTypeVariables

456

470

457 type: detailed-0.9

471 type: detailed-0.9

458

472

@@ -470,7 +484,7 @@ test-suite verify-crop-span-generation

470 build-depends: vty,

484 build-depends: vty,

471 Cabal >= 1.20,

485 Cabal >= 1.20,

472 QuickCheck >= 2.7,

486 QuickCheck >= 2.7,

473− random >= 1.0 && < 1.3,

487+ random >= 1.0 && < 1.2,

474 base >= 4.8 && < 5,

488 base >= 4.8 && < 5,

475 bytestring,

489 bytestring,

476 containers,

490 containers,

@@ -484,6 +498,7 @@ test-suite verify-crop-span-generation

484

498

485test-suite verify-layers-span-generation

499test-suite verify-layers-span-generation

486 default-language: Haskell2010

500 default-language: Haskell2010

501+ default-extensions: ScopedTypeVariables

487

502

488 type: detailed-0.9

503 type: detailed-0.9

489

504

@@ -501,32 +516,7 @@ test-suite verify-layers-span-generation

501 build-depends: vty,

516 build-depends: vty,

502 Cabal >= 1.20,

517 Cabal >= 1.20,

503 QuickCheck >= 2.7,

518 QuickCheck >= 2.7,

504− random >= 1.0 && < 1.3,

519+ random >= 1.0 && < 1.2,

505− base >= 4.8 && < 5,

506− bytestring,

507− containers,

508− deepseq >= 1.1 && < 1.5,

509− mtl >= 1.1.1.0 && < 2.3,

510− text >= 0.11.3,

511− unix,

512− utf8-string >= 0.3 && < 1.1,

513− vector >= 0.7

514−

515−test-suite verify-color-mapping

516− default-language: Haskell2010

517−

518− type: detailed-0.9

519−

520− hs-source-dirs: test

521−

522− test-module: VerifyColor240

523−

524− other-modules: Verify

525−

526− build-depends: vty,

527− Cabal >= 1.20,

528− QuickCheck >= 2.7,

529− random >= 1.0 && < 1.3,

530 base >= 4.8 && < 5,

520 base >= 4.8 && < 5,

531 bytestring,

521 bytestring,

532 containers,

522 containers,

@@ -539,6 +529,7 @@ test-suite verify-color-mapping

539

529

540test-suite verify-utf8-width

530test-suite verify-utf8-width

541 default-language: Haskell2010

531 default-language: Haskell2010

532+ default-extensions: ScopedTypeVariables

542

533

543 type: detailed-0.9

534 type: detailed-0.9

544

535

@@ -551,7 +542,7 @@ test-suite verify-utf8-width

551 build-depends: vty,

542 build-depends: vty,

552 Cabal >= 1.20,

543 Cabal >= 1.20,

553 QuickCheck >= 2.7,

544 QuickCheck >= 2.7,

554− random >= 1.0 && < 1.3,

545+ random >= 1.0 && < 1.2,

555 base >= 4.8 && < 5,

546 base >= 4.8 && < 5,

556 bytestring,

547 bytestring,

557 containers,

548 containers,

@@ -564,6 +555,7 @@ test-suite verify-utf8-width

564

555

565test-suite verify-using-mock-input

556test-suite verify-using-mock-input

566 default-language: Haskell2010

557 default-language: Haskell2010

558+ default-extensions: ScopedTypeVariables

567

559

568 type: exitcode-stdio-1.0

560 type: exitcode-stdio-1.0

569

561

@@ -571,8 +563,6 @@ test-suite verify-using-mock-input

571

563

572 main-is: VerifyUsingMockInput.hs

564 main-is: VerifyUsingMockInput.hs

573

565

574− other-modules: Verify.Graphics.Vty.Output

575−

576 build-depends: vty,

566 build-depends: vty,

577 Cabal >= 1.20,

567 Cabal >= 1.20,

578 QuickCheck >= 2.7,

568 QuickCheck >= 2.7,

@@ -580,7 +570,7 @@ test-suite verify-using-mock-input

580 quickcheck-assertions >= 0.1.1,

570 quickcheck-assertions >= 0.1.1,

581 test-framework == 0.8.*,

571 test-framework == 0.8.*,

582 test-framework-smallcheck == 0.2.*,

572 test-framework-smallcheck == 0.2.*,

583− random >= 1.0 && < 1.3,

573+ random >= 1.0 && < 1.2,

584 base >= 4.8 && < 5,

574 base >= 4.8 && < 5,

585 bytestring,

575 bytestring,

586 containers,

576 containers,

@@ -599,6 +589,7 @@ test-suite verify-using-mock-input

599

589

600test-suite verify-config

590test-suite verify-config

601 default-language: Haskell2010

591 default-language: Haskell2010

592+ default-extensions: ScopedTypeVariables

602

593

603 type: exitcode-stdio-1.0

594 type: exitcode-stdio-1.0

604

595

@@ -615,7 +606,7 @@ test-suite verify-config

615 test-framework == 0.8.*,

606 test-framework == 0.8.*,

616 test-framework-smallcheck == 0.2.*,

607 test-framework-smallcheck == 0.2.*,

617 test-framework-hunit,

608 test-framework-hunit,

618− random >= 1.0 && < 1.3,

609+ random >= 1.0 && < 1.2,

619 base >= 4.8 && < 5,

610 base >= 4.8 && < 5,

620 bytestring,

611 bytestring,

621 containers,

612 containers,