7d2807d..master · vty · git.iko.soy

.gitignore+3

@@ -4,6 +4,9 @@

44*.prof

55Setup

66dist

7+dist-newstyle

8+cabal.project.local

9+.ghc.environment.*

710test/benchmark

811.hpc

912.cabal-sandbox

.travis.yml+101−21

@@ -1,29 +1,109 @@

1−language: haskell

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

2+#

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

4+#

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

6+#

7+language: c

8+sudo: false

29

3−notifications:

4− email: false

10+git:

11+ submodules: false # whether to recursively clone submodules

12+

13+cache:

14+ directories:

15+ - $HOME/.cabal/packages

16+ - $HOME/.cabal/store

17+

18+before_cache:

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

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

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

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

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

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

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

26+

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

528

629matrix:

7− allow_failures:

8− - env: CABALVER=head GHCVER=head

9− - env: CABALVER=1.20 GHCVER=7.4.2

10−

11−env:

12− - CABALVER=1.20 GHCVER=7.4.2

13− - CABALVER=1.20 GHCVER=7.6.3

14− - CABALVER=1.20 GHCVER=7.8.3

15− - CABALVER=1.22 GHCVER=7.10.1

16− - CABALVER=1.24 GHCVER=8.0.1

17− - CABALVER=head GHCVER=head

30+ include:

31+ - compiler: "ghc-8.4.3"

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

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

34+ - compiler: "ghc-8.2.2"

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

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

37+ - compiler: "ghc-8.0.2"

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

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

40+ - compiler: "ghc-7.10.3"

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

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

43+

44+before_install:

45+ - HC=${CC}

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

47+ - unset CC

48+ - ROOTDIR=$(pwd)

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

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

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

52+ - echo $HCNUMVER

1853

1954install:

20− - ./ci/travis_ci_install

55+ - cabal --version

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

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

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

59+ - HADDOCK=${HADDOCK-true}

60+ - UNCONSTRAINED=${UNCONSTRAINED-true}

61+ - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}

62+ - GHCHEAD=${GHCHEAD-false}

63+ - travis_retry cabal update -v

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

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

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

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

68+ - touch cabal.project.local

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

70+ - cat cabal.project || true

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

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

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

74+ fi

75+ - rm -f cabal.project.freeze

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

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

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

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

2180

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.

2283script:

23− - ./ci/travis_ci_script

84+ # test that source-distributions can be generated

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

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

87+ - cd ${DISTDIR} || false

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

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

90+ - touch cabal.project.local

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

92+ - cat cabal.project || true

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

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

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

2496

25−before_install:

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

27− - sudo apt-get update

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

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

97+ # build & run tests, build benchmarks

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

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

100+

101+ # haddock

102+ - rm -rf ./dist-newstyle

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

104+

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

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

107+

108+# REGENDATA ["vty.cabal"]

109+# EOF

AUTHORS+4−2

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

1−The following people should be thanked for contributing to the vty library:

1+The following people should be thanked for contributing to the vty

2+library:

3+

24 * Andrea Vezzosi

35 * Corey O'Connor

46 * Emily Backes

@@ -17,4 +19,4 @@ The following people should be thanked for contributing to the vty library:

1719 * Yoshikuni Jujo

1820 * Dmitry Ivanov

1921

20−Plus others.. Check the git log for a full list.

22+Plus others.. Check the git log and CHANGELOG.md for a full list.

CHANGELOGdeleted−367

@@ -1,367 +0,0 @@

1−5.14

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

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

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

5− zero

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

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

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

9−

10−5.13

11− - Reverted changes in 5.12 due to disagreements between terminal emulators

12− and utf8proc; for more details, please see the ticket discussion at

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

14−

15−5.12

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

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

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

19− characters.

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

21−

22−5.11.3

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

24−

25−5.11.2

26− - Mouse events were modified so that the upper-left corner of the window is

27− (0,0) rather than (1,1).

28−

29−5.11.1

30− - Add Generic instance for Image

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

32− on refresh with normal cursor positioning mode)

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

34− - Update maintainer

35−

36−5.11

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

38− evironment variable is missing (thanks Eric Mertens)

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

40− exporting internal types (thanks Eric Mertens)

41−

42−5.10

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

44− mode provides greater control over cursor positioning by bypassing

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

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

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

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

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

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

51− Mertens)

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

53− behavior. Previously vty_mk_wcwidth was being imported with

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

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

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

57− non-negative. (thanks Eric Mertens)

58−

59−5.9.1

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

61− preexisting UTF8 declaration to avoid emitting garbage sequences

62− (fixes #89)

63−

64−5.9

65− - Added new Output methods supportsBell and ringTerminalBell to find out

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

67−

68−5.8.1

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

70−

71−5.8

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

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

74− how best to decode it

75−

76−5.7.1

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

78−

79−5.7

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

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

82− determine whether these modes are enabled initially (for terminals

83− that support them).

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

85− paste mode) that is used with new Output interface functions:

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

87− mode

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

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

90− off

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

92−

93−5.6

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

95− terminals via the MouseDown and MouseUp Event constructors

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

97− the EvPaste event constructor

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

99− Hirn)

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

101− XtermColor driver rather than just TerminfoBased

102−

103−5.5.0

104− - Replaced lens dependency with microlens, microlens-mtl, microlens-th dependencies. Issue #90

105− - Thanks Jonathan Daugherty

106− - Cabal corrections.

107− - Thanks Lennart Spitzner

108−

109−5.4.0

110− - Changed eventChannel of Graphics.Vty.Input from Chan to TChan. This enables clients to query if

111− there are no pending events. The Graphics.Vty interface nextEvent is unchanged. Clients that use

112− eventChannel directly will require updating.

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

114−5.3.1

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

116− to possibly breaking this on reasonable GHC versions

117−

118−5.3

119− - Upgraded QuickCheck dependency to 2.7

120− - The standard IO Config (standardIOConfig) was overriding any provided application config.

121− In addition, the inputFd and outputFd could not be changed if mkVty was used.

122− Fixed.

123− - Correct handling of display attributes at end of line. The output attributes are set to default

124− at the end of content for the line and at the start of a new line. Previously the current

125− attribute would extend to the next start of content. This was odd to reason about and was the

126− cause of https://github.com/coreyoconnor/vty/issues/76

127− IIRC Yi requires the old behavior to display the selection region correctly.

128− - shutdown of the input thread is now performed using killThread and synchronization on an MVar.

129− For correct handling of the terminal read vmin and vtime the read must be a blocking read on an

130− OS thread. This places a threadWaitRead, which will be interrupted by the killThread, prior to

131− the uninterruptable read. An alternative would be to re-import the read foreign call as

132− interruptable.

133−

134−5.2.11

135− - deepseq bounds increased for tests.

136− - Clean up warnings when compiling on 7.10

137− - Thanks Eric Mertens

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

139− - Thanks Eric Mertens

140−

141−5.2.10

142− - "str" now returns EmptyImage for empty strings to match behavior of other string-like Image constructors (fixes #74)

143− - Thanks Jonathan Daugherty

144−

145−5.2.9

146− - dependency version bumps

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

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

149− - Correct/Simplify the example code

150− - Thanks glguy

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

152−

153−5.2.8

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

155− - Thanks glguy

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

157− - Do not differentiate based on TERM_PROGRAM

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

159−

160−5.2.7

161− - lens and deepseq constraint bump + misc

162− - Thanks ethercrow

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

164−

165−5.2.6

166− - lens constraint bump

167− - Thanks alexander-b!

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

169−

170−5.2.5

171− - lens and random version constraint bump.

172− - Thanks RyanGlScott!

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

174−

175−5.2.4

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

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

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

179− - Thanks Fuuzetsu!

180−

181−5.2.3

182− - evaluate/compile the input parsing table once instead of each keystroke.

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

184− - Thanks ethercrow!

185−

186−5.2.2

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

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

189− - Thanks ethercrow!

190−

191−5.2.1

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

193−

194−5.2.0

195− - Config structure now specifies file descriptor to use. The default is stdInput and stdOutput

196− file descriptors. Previously Vty used stdInput for input and the follow code for output:

197− - hDuplicate stdout >>= handleToFd >>= (`hSetBuffering` NoBuffering)

198− - the difference was required by Vty.Inline. Now, Vty.Inline uses the Config structure options

199− to acheive the same effect.

200− - removed: derivedVtime, derivedVmin, inputForCurrentTerminal, inputForNameAndIO,

201− outputForCurrentTerminal, outputForNameAndIO

202− - added: inputForConfig, outputForConfig

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

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

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

206−

207−5.1.4

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

209−

210−5.1.1

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

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

213−

214−5.1.0

215− - vmin and vtime can be specified however the application requires. See Graphics.Vty.Config.

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

217−

218−5.0.0

219− - The naming convention now matches:

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

221− - all projects using vty for input must be compiled with -threaded. Please notify vty author if

222− this is not acceptable.

223− - mkVtyEscDelay has been removed. Use "mkVty def". Which initialized vty with the default

224− configuration.

225− - input handling changes

226− - KASCII is now KChar

227− - KPN5 is now KCenter

228− - tests exist.

229− - Applications can add to the input tables by setting inputMap of the Config.

230− See Graphics.Vty.Config

231− - Users can define input table extensions that will apply to all vty applications.

232− See Graphics.Vty.Config

233− - terminal timing is now handled by selecting an appropriate VTIME. Previously this was

234− implemented within Vty itself. This reduced complexity in vty but provides a different meta

235− key behavior and implies a requirement on -threaded.

236− - The time vty will wait to verify an ESC byte means a single ESC key is the

237− singleEscPeriod of the Input Config structure.

238− - removed the typeclass based terminal and display context interface in favor of a data

239− structure of properties interface.

240− - renamed the Terminal interface to Output

241− - The default picture for an image now uses the "clear" background. This background fills

242− background spans with spaces or just ends the line.

243− - Previously the background defaulted to the space character. This causes issues copying

244− text from a text editor. The text would end up with extra spaces at the end of the line.

245− - Layer support

246− - Each layer is an image.

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

248− - The first image is the top-most layer. The images are ordered from top to bottom.

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

250− added to pad images when images of different sizes are joined.

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

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

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

254− - addToTop and addToBottom add a layer to the top and bottom of the given Picture.

255− - compatibility improvements:

256− - terminfo based terminals with no cursor support are silently accepted. The cursor

257− visibility changes in the Picture will have no effect.

258− - alternate (setf/setb) color maps supported. Though colors beyond the first 8 are just a

259− guess.

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

261− - Both applications and users can add to the mapping used to translate from input bytes to

262− events.

263− - Additional information about input and output process can be appended to a debug log

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

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

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

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

268− - vty-interactive-terminal-test

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

270− - test/interactive_terminal_test.hs

271− - vty-event-echo

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

273− - test/EventEcho.hs

274− - vty-rogue

275− - The start of a rogue-like game. Example of layers and image build operations.

276− - test/Rogue.hs

277− - vty-benchmark

278− - benchmarks vty. A series of tests that push random pictures to the terminal. The

279− random pictures are generated using QuickCheck. The same generators used in the

280− automated tests.

281− - test/benchmark.hs

282−

283−4.7.0.0

284− - API changes:

285− - Added Graphics.Vty.Image.crop: Ensure an image is no larger than the specified size.

286− - Added Graphics.Vty.Image.pad: Ensure an image is no smaller than the specified size.

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

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

289−

290−4.3.0.0

291−

292−4.2.1.0

293− - API changes:

294− - Attr record accessor fore_color changed to attr_fore_color

295− - Attr record accessor back_color changed to attr_back_color

296− - Attr record accessor style changed to attr_style

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

298− - put_attr_change applies a display attribute change immediately to a terminal

299− - For instance, can be used to change the display attrbiutes of text output via putStrLn

300− and putStr. EX: "put_attr_change $ back_color red" will set the

301− background color to red.

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

303− - See Graphics.Vty.Inline

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

305−

306−4.0.0.1

307− - binding for mk_wcswidth was incorrect. Most platforms just magically worked due to

308− coincidence.

309−

310−4.0.0

311− - API changes:

312− - "getSize" has been removed. Use "terminal vty >>= display_bounds" where "vty" is an

313− instance of the Vty data structure.

314− - added a "terminal" field to the Vty data structure. Accesses the TerminalHandle associated

315− with the Vty instance.

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

317− - Partitioned into Graphics.Vty.Attributes for display attributes. Graphics.Vty.Image for

318− image combinators. Graphics.Vty.Picture for final picture construction.

319− - Graphics.Vty.Attributes:

320− - "setFG" and "setBG" are now "with_fore_color" and "with_back_color"

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

322− - "attr" is now "def_attr", short for "default display attributes" Also added a

323− "current_attr" for "currently applied display attributes"

324− - Graphics.Vty.Image:

325− - "horzcat" is now "horiz_cat"

326− - "vertcat" is now "vert_cat"

327− - "renderBS" is now "utf8_bytestring"

328− - "renderChar" is now "char"

329− - "renderFill" is now "char_fill"

330− - added a "utf8_string" and "string" (AKA "iso_10464_string") for UTF-8 encoded Strings

331− and ISO-10464 encoded Strings. String literals in GHC have an ISO-10464 runtime

332− representation.

333− - Graphics.Vty.Picture:

334− - exports Graphics.Vty.Image

335− - "pic" is now "pic_for_image"

336− - added API for setting background fill pattern.

337− - Completely rewritten output backend.

338− - Efficient, scanline style output span generator. Has not been fully optimized, but good

339− enough.

340− - The details required to display the desired picture on a terminal are well encapsulated.

341− - Terminfo based display terminal implementation. With specialized derivitives for xterm,

342− Terminal.app, and iTerm.app.

343− - Attempts to robustly handle even terminals that don't support all display attributes.

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

345− rxvt, mlterm, Eterm, gnome-terminal, konsole, screen, linux vty. Hopefully you will be

346− as successfull.

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

348− - 256 color support. See Graphics.Vty.Attributes.Color240. The actual output color is adjusted

349− according to the number of colors the terminal supports.

350− - The Graphics.Vty.Image combinators no longer require matching dimensions to arguments.

351− Unspecified areas are filled in with a user-customizable background pattern. See

352− Graphics.Vty.Picture.

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

354− - Significant code coverage by QuickCheck tests. An interactive test for those final properties

355− that couldn't be automatically verified.

356−

357− issues resolved:

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

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

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

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

362− - "Redraw does not handle rendering a line that extends beyond screen width characters"

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

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

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

366− - "256-color support"

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

CHANGELOG.mdnew file+861

@@ -0,0 +1,861 @@

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+

323+5.17

324+----

325+

326+API changes:

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

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

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

330+ constructors, EvLostFocus and EvGainedFocus.

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

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

333+ etc.) work.

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

335+ #131)

336+

337+5.16

338+----

339+

340+API changes:

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

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

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

344+

345+Bug fixes:

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

347+

348+5.15.1

349+------

350+

351+Package changes:

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

353+ Suchánek)

354+

355+Bug fixes:

356+* translateX/Y: fix negative translations

357+

358+5.15

359+----

360+

361+Package changes:

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

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

364+ are no longer supported.

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

366+ wanted, though!)

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

368+

369+API changes:

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

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

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

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

374+ Graphics.Vty.Output.Interface.

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

376+ accessors to Graphics.Vty.Image.

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

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

379+

380+5.14

381+----

382+

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

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

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

386+ zero

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

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

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

390+

391+5.13

392+----

393+

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

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

396+ discussion at

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

398+

399+5.12

400+----

401+

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

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

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

405+ characters.

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

407+

408+5.11.3

409+------

410+

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

412+

413+5.11.2

414+------

415+

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

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

418+

419+5.11.1

420+------

421+

422+* Add Generic instance for Image

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

424+ on refresh with normal cursor positioning mode)

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

426+* Update maintainer

427+

428+5.11

429+----

430+

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

432+ evironment variable is missing (thanks Eric Mertens)

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

434+ exporting internal types (thanks Eric Mertens)

435+

436+5.10

437+----

438+

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

440+ mode provides greater control over cursor positioning by bypassing

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

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

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

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

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

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

447+ Mertens)

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

449+ behavior. Previously vty_mk_wcwidth was being imported with the

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

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

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

453+ (thanks Eric Mertens)

454+

455+5.9.1

456+-----

457+

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

459+ preexisting UTF8 declaration to avoid emitting garbage sequences

460+ (fixes #89)

461+

462+5.9

463+---

464+

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

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

467+

468+5.8.1

469+-----

470+

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

472+

473+5.8

474+---

475+

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

477+ ByteString rather than a String to allow the application to decode how

478+ best to decode it

479+

480+5.7.1

481+-----

482+

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

484+

485+5.7

486+---

487+

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

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

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

491+ terminals that support them).

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

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

494+ functions:

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

496+ mode

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

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

499+ off

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

501+

502+5.6

503+---

504+

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

506+ terminals via the MouseDown and MouseUp Event constructors

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

508+ the EvPaste event constructor

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

510+ Hirn)

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

512+ XtermColor driver rather than just TerminfoBased

513+

514+5.5.0

515+-----

516+

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

518+ dependencies. Issue #90

519+ * Thanks Jonathan Daugherty

520+* Cabal corrections.

521+ * Thanks Lennart Spitzner

522+

523+5.4.0

524+-----

525+

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

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

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

529+ Clients that use eventChannel directly will require updating.

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

531+

532+5.3.1

533+-----

534+

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

536+ possibly breaking this on reasonable GHC versions

537+

538+5.3

539+---

540+

541+* Upgraded QuickCheck dependency to 2.7

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

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

544+ changed if mkVty was used. Fixed.

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

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

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

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

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

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

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

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

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

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

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

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

557+

558+5.2.11

559+------

560+

561+* deepseq bounds increased for tests.

562+* Clean up warnings when compiling on 7.10

563+ * Thanks Eric Mertens

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

565+ * Thanks Eric Mertens

566+

567+5.2.10

568+------

569+

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

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

572+ * Thanks Jonathan Daugherty

573+

574+5.2.9

575+-----

576+

577+* dependency version bumps

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

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

580+* Correct/Simplify the example code

581+ * Thanks glguy

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

583+

584+5.2.8

585+-----

586+

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

588+ * Thanks glguy

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

590+* Do not differentiate based on TERM_PROGRAM

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

592+

593+5.2.7

594+-----

595+

596+* lens and deepseq constraint bump + misc

597+ * Thanks ethercrow

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

599+

600+5.2.6

601+-----

602+

603+* lens constraint bump

604+ * Thanks alexander-b!

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

606+

607+5.2.5

608+-----

609+

610+* lens and random version constraint bump.

611+ * Thanks RyanGlScott!

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

613+

614+5.2.4

615+-----

616+

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

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

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

620+ * Thanks Fuuzetsu!

621+

622+5.2.3

623+-----

624+

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

626+ keystroke.

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

628+ * Thanks ethercrow!

629+

630+5.2.2

631+-----

632+

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

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

635+ * Thanks ethercrow!

636+

637+5.2.1

638+-----

639+

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

641+

642+5.2.0

643+-----

644+

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

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

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

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

649+ NoBuffering)

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

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

652+* removed: derivedVtime, derivedVmin, inputForCurrentTerminal,

653+ inputForNameAndIO, outputForCurrentTerminal, outputForNameAndIO

654+* added: inputForConfig, outputForConfig

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

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

657+* the oldest version of GHC that vty compiles under is 7.4.2

658+

659+5.1.4

660+-----

661+

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

663+

664+5.1.1

665+-----

666+

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

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

669+

670+5.1.0

671+-----

672+

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

674+ See Graphics.Vty.Config.

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

676+

677+5.0.0

678+-----

679+

680+* The naming convention now matches:

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

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

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

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

685+ vty with the default configuration.

686+* input handling changes

687+ * KASCII is now KChar

688+ * KPN5 is now KCenter

689+ * tests exist.

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

691+ the Config. See Graphics.Vty.Config

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

693+ applications. See Graphics.Vty.Config

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

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

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

697+ implies a requirement on -threaded.

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

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

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

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

702+* renamed the Terminal interface to Output

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

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

705+ line.

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

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

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

709+* Layer support

710+ * Each layer is an image.

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

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

713+ top to bottom.

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

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

716+ sizes are joined.

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

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

719+ background layer.

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

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

722+ given Picture.

723+* compatibility improvements:

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

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

726+ no effect.

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

728+ the first 8 are just a guess.

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

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

731+ translate from input bytes to events.

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

733+ appended to a debug log

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

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

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

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

738+ file.

739+ * vty-interactive-terminal-test

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

741+ author.

742+ * test/interactive_terminal_test.hs

743+ * vty-event-echo

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

745+ user.

746+ * test/EventEcho.hs

747+ * vty-rogue

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

749+ build operations.

750+ * test/Rogue.hs

751+ * vty-benchmark

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

753+ the terminal. The random pictures are generated using

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

755+ * test/benchmark.hs

756+

757+4.7.0.0

758+-------

759+

760+API changes:

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

762+ than the specified size.

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

764+ than the specified size.

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

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

767+

768+4.2.1.0

769+-------

770+

771+API changes:

772+* Attr record accessor fore_color changed to attr_fore_color

773+* Attr record accessor back_color changed to attr_back_color

774+* Attr record accessor style changed to attr_style

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

776+ * put_attr_change applies a display attribute change

777+ immediately to a terminal

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

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

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

781+ color to red.

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

783+ * See Graphics.Vty.Inline

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

785+

786+4.0.0.1

787+-------

788+

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

790+ magically worked due to coincidence.

791+

792+4.0.0

793+-----

794+

795+API changes:

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

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

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

799+ TerminalHandle associated with the Vty instance.

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

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

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

803+ for final picture construction.

804+* Graphics.Vty.Attributes:

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

806+ "with_back_color"

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

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

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

810+ attributes"

811+* Graphics.Vty.Image:

812+ * "horzcat" is now "horiz_cat"

813+ * "vertcat" is now "vert_cat"

814+ * "renderBS" is now "utf8_bytestring"

815+ * "renderChar" is now "char"

816+ * "renderFill" is now "char_fill"

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

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

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

820+* Graphics.Vty.Picture:

821+ * exports Graphics.Vty.Image

822+ * "pic" is now "pic_for_image"

823+ * added API for setting background fill pattern.

824+* Completely rewritten output backend.

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

826+ fully optimized, but good enough.

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

828+ terminal are well encapsulated.

829+ * Terminfo based display terminal implementation. With specialized

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

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

832+ support all display attributes.

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

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

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

836+ successfull.

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

838+ expected.

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

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

841+ terminal supports.

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

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

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

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

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

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

848+

849+Issues resolved:

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

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

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

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

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

855+ width characters"

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

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

858+ dimensions"

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

860+* "256-color support"

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

LICENSE+2

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

1+BSD 3-Clause License

2+

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

24

35All rights reserved.

README.md+146−73

@@ -1,13 +1,13 @@

1−[![Build Status](https://travis-ci.org/coreyoconnor/vty.png)](https://travis-ci.org/coreyoconnor/vty)

1+[![Build Status](https://travis-ci.org/jtdaugherty/vty.png)](https://travis-ci.org/jtdaugherty/vty)

22

3−`vty` is a terminal interface library.

4−

5−This project is hosted on github.com: https://github.com/coreyoconnor/vty

3+`vty` is a terminal interface library. It provides a high-level

4+interface for doing terminal I/O. Vty is supported on GHC versions

5+7.10.1 and up.

66

77Install via `git` with:

88

99```

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

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

1111```

1212

1313Install via `cabal` with:

@@ -18,55 +18,38 @@ cabal install vty

1818

1919# Features

2020

21−* Support for a large number of terminals. vt100, ansi, hurd, linux, screen etc

22− etc. Anything with a sufficient terminfo entry.

23−

24−* Automatic handling of window resizes.

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

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

2523

26−* If the terminal support UTF-8 then vty supports Unicode output.

24+* Automatically handles window resizes.

2725

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

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

2927

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

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

29+ state changes are minimized.

3130

32−* Minimizes repaint area. Virtually eliminating the flicker problems that

33− plagues ncurses programs.

31+* Minimizes repaint area, which virtually eliminates the flicker

32+ problems that plague ncurses programs.

3433

35−* A pure, compositional interface for efficiently constructing display images.

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

35+ display images.

3636

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

3838

3939* Automatically supports refresh on Ctrl-L.

4040

41−* Automatically supports timeout after for lone ESC. The timeout is

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

4242 customizable.

4343

44−* Interface is designed for easy compatible extension.

45−

46−* Supports ANSI graphics modes (SGR as defined in console_codes(4)) with a

47− type-safe interface. Gracefull fallback for terminals that do not support, or

48− partially support the standard ANSI graphics modes.

49−

50−* Properly handles cleanup, but not due to signals.

51−

52−* Comprehensive test suite.

53−

54−# Known Issues

55−

56−* Terminals have numerous quirks and bugs. vty picks what works best for the

57− author in ambigious, or buggy situations.

58−

59−* Signal handling of STOP, TERM and INT are non existent.

44+* Provides extensible input and output interfaces.

6045

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

62− unicode is used.

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

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

48+ with limited or nonexistent support for such modes.

6349

64−* Terminfo is assumed to be correct unless there is an override configured.

65− Some terminals will not have correct special key support (shifted F10 etc).

66− See Config for customizing vty's behavior for a particular terminal.

50+* Properly handles cleanup (but not due to signals).

6751

68−* Uses the TIOCGWINSZ ioctl to find the current window size, which appears to be

69− limited to Linux and BSD.

52+* Provides a comprehensive test suite.

7053

7154* Supports "normal" and "extended" (SGR) mouse modes as described at

7255 http://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking

@@ -74,55 +57,145 @@ cabal install vty

7457* Supports bracketed paste mode as described at

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

7659

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+

7771# Platform Support

7872

7973## Posix Terminals

8074

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

82−some omissions from terminfo.

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

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

8377

8478## Windows

8579

86−cygwin only.

87−

88−# Development Notes

89−

90−## Under NixOS

80+Windows is not supported.

81+

82+# Multi-Column Character Support

83+

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

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

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

87+terminal emulator in use.

88+

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

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

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

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

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

94+and since different terminal emulators will support different versions

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

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

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

98+some characters are.

99+

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

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

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

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

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

105+to generate and install custom tables.

106+

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

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

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

110+measurements for the entire supported Unicode range. The

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

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

113+`Graphics.Vty.UnicodeWidthTable.Query`.

114+

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

116+

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

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

119+ then invoking `mkVty` to initialize Vty

120+

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

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

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

91124

92−### Using cabal

125+```

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

127+```

93128

94−After installing ncurses to user env.

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

162+

163+If you decide to contribute, that's great! Here are some guidelines you

164+should consider to make submitting patches easier for all concerned:

165+

166+ - If you want to take on big things, talk to me first; let's have a

167+ design/vision discussion before you start coding. Create a GitHub

168+ issue and we can use that as the place to hash things out.

169+ - If you make changes, make them consistent with the syntactic

170+ conventions already used in the codebase.

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

95172

96−~~~

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

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

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

100−~~~

173+# Known Issues

101174

102−### Using stack

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

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

177+ terminal emulator, operating system, etc.

103178

104−~~~

105−stack build

106−stack test

107−stack install

108−~~~

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

109180

110−## Coverage

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

182+ unicode is used.

111183

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

113−evaluate coverage configure as follows:

184+* Terminfo is assumed to be correct unless there is an override

185+ configured. Some terminals will not have correct special key support

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

187+ particular terminal.

114188

115−~~~

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

117− --disable-library-profiling \

118− --disable-executable-profiling

119−~~~

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

190+ appears to be limited to Linux and BSD.

120191

121−## Profiling

192+# Further Reading

122193

194+Good sources of documentation for terminal programming are:

123195

124−~~~

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

126− --enable-library-profiling \

127− --enable-executable-profiling

128−~~~

196+* https://github.com/b4winckler/vim/blob/master/src/term.c

197+* http://invisible-island.net/xterm/ctlseqs/ctlseqs.html

198+* http://ulisse.elettra.trieste.it/services/doc/serial/config.html

199+* http://www.leonerd.org.uk/hacks/hints/xterm-8bit.html

200+* http://www.unixwiz.net/techtips/termios-vmin-vtime.html

201+* http://vt100.net/docs/vt100-ug/chapter3.html

TODOdeleted−15

@@ -1,15 +0,0 @@

1−- Improve input handling

2− - base off of haskeline input system. The haskeline input system appears to be excellent and

3− satisfy all of Vty's input requirements. The current haskeline distribution does not appear to

4− export the required modules. Either:

5− 0. Add the required exports to the haskeline distribution.

6− - fine for development but complicates the UI for production clients. Though, exposing

7− the modules would only complicate the appearance of haskeline's interface.

8− 1. Partition the backend of haskeline into a separate package usable by both vty and

9− haskeline.

10−- use compact-string for character encoding handling

11−- Custom cursor appearance handling?

12− - specific color?

13− - reverse video?

14− - auto?

15−

build_examplesdeleted−2

@@ -1,2 +0,0 @@

1−#!/bin/bash

2−(cd test && cabal build)

cbits/get_tty_erase.cnew file+18

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

1+#include <termios.h>

2+#include <stdio.h>

3+#include <unistd.h>

4+#include <stdlib.h>

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

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

11#include <sys/ioctl.h>

22

33unsigned long vty_c_get_window_size(int fd) {

4− struct winsize w;

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

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

7− else

8− return 0x190050;

4+ struct winsize w;

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

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

7+ else

8+ return 0x190050;

9+}

10+

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

12+ struct winsize w;

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

14+ w.ws_row = val >> 16;

15+ w.ws_col = val & 0xFFFF;

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

17+ }

918}

cbits/gwinsz.h+2−1

@@ -1 +1,2 @@

1−unsigned long vty_c_get_window_size(void);

1+unsigned long vty_c_get_window_size(int fd);

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

cbits/mk_wcwidth.c+136−2

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

6060 */

6161

6262#include <HsFFI.h>

63+#include <stdlib.h>

64+#include <string.h>

65+

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

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

68+#define MAX_CUSTOM_TABLE_SIZE (HS_CHAR_MAX + 1)

69+

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

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

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

73+static uint8_t* custom_table = NULL;

74+

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

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

77+// custom_table array.

78+static uint32_t custom_table_size = 0;

79+

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

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

82+// allocated with vty_init_custom_table and initialized with

83+// vty_set_custom_table_range.

84+static uint8_t custom_table_ready = 0;

6385

6486struct interval {

6587 int first;

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

119141 * in ISO 10646.

120142 */

121143

122−HsInt vty_mk_wcwidth(HsChar ucs)

144+static HsInt builtin_wcwidth(HsChar ucs)

123145{

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

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

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

182204

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

184206 if (vty_bisearch(ucs, combining,

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

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

186208 return 0;

187209

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

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

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

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

204226}

227+

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

229+//

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

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

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

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

234+HsInt vty_mk_wcwidth(HsChar ch)

235+{

236+ if (custom_table_ready) {

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

238+ return custom_table[ch];

239+ } else {

240+ return -1;

241+ }

242+ } else {

243+ return builtin_wcwidth(ch);

244+ }

245+}

246+

247+// Initialize a custom character width table.

248+//

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

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

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

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

253+//

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

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

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

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

258+int vty_init_custom_table(int size)

259+{

260+ if (custom_table == NULL) {

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

262+ custom_table_ready = 0;

263+ custom_table = malloc(size);

264+ memset(custom_table, 1, size);

265+ custom_table_size = size;

266+ return 0;

267+ } else {

268+ return 1;

269+ }

270+ } else {

271+ return 1;

272+ }

273+}

274+

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

276+// specified width.

277+//

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

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

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

281+//

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

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

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

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

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

287+{

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

289+ (size >= custom_table_size) ||

290+ (start >= custom_table_size) ||

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

292+ custom_table_ready) {

293+ return 1;

294+ } else {

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

296+ return 0;

297+ }

298+}

299+

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

301+//

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

303+// fail.

304+//

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

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

307+// allocated.

308+int vty_activate_custom_table()

309+{

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

311+ return 1;

312+ } else {

313+ custom_table_ready = 1;

314+ return 0;

315+ }

316+}

317+

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

319+int vty_custom_table_ready()

320+{

321+ return custom_table_ready;

322+}

323+

324+// Deallocate the custom width table.

325+//

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

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

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

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

330+// leaving it in an intermediate state.

331+void vty_deallocate_custom_table()

332+{

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

334+ free(custom_table);

335+ custom_table = NULL;

336+ custom_table_size = 0;

337+ }

338+}

Demo.hs → demos/Demo.hsrenamed+14−8

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

11{-# LANGUAGE FlexibleContexts #-}

2−

32module Main where

43

54import Graphics.Vty

@@ -8,7 +7,6 @@ import Control.Applicative hiding ((<|>))

87import Control.Arrow

98import Control.Monad.RWS

109

11−import Data.Default (def)

1210import Data.Sequence (Seq, (<|) )

1311import qualified Data.Sequence as Seq

1412import Data.Foldable

@@ -19,8 +17,8 @@ type App = RWST Vty () (Seq String) IO

1917

2018main = do

2119 vty <- if True -- change to false for emacs-like input processing

22− then mkVty def

23− else mkVty (def { vmin = Just 2, vtime = Just 300 } )

20+ then mkVty defaultConfig

21+ else mkVty (defaultConfig { vmin = Just 2, vtime = Just 300 } )

2422 _ <- execRWST (vtyInteract False) vty Seq.empty

2523 shutdown vty

2624

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

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

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

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

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

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

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

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

3837 , "claims 240 colors are not supported."

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

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

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

4544 ]

4645

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+

4755colorbox_240 :: Image

4856colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages

4957 where

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

51− splitColorImages [] = []

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

5359

5460colorbox_16 :: Image

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

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

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

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

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

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

7682 vty <- ask

7783 liftIO $ update vty pic

7884

ModeDemo.hs → demos/ModeDemo.hsrenamed+2

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

22

33import Control.Applicative

44import Data.Monoid

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

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

57

68import Graphics.Vty

79

DESIGN → docs/DESIGNrenamed

The content is the same.

install_examplesdeleted−4

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

1−#!/bin/bash

2−set -ex

3−cabal install

4−(cd test && cabal install)

src/Codec/Binary/UTF8/Debug.hs+4−6

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

11{-# OPTIONS_HADDOCK hide #-}

3−module Codec.Binary.UTF8.Debug

4− where

3+module Codec.Binary.UTF8.Debug where

54

65import Codec.Binary.UTF8.String ( encode )

76

@@ -9,11 +8,10 @@ import Data.Word

98

109import Numeric

1110

12−-- | Converts an array of ISO-10646 characters (Char type) to an array of Word8 bytes that is the

13−-- corresponding UTF8 byte sequence

11+-- | Converts an array of ISO-10646 characters (Char type) to an array

12+-- of Word8 bytes that is the corresponding UTF8 byte sequence

1413utf8FromIso :: [Int] -> [Word8]

1514utf8FromIso = encode . map toEnum

1615

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

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

19−

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

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

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

77import Control.Parallel.Strategies

88

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

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

11− where

10+ rnf = rnf' . viewl

11+ where

1212 rnf' EmptyL = ()

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

src/Data/Terminfo/Eval.hs+15−23

@@ -1,18 +1,14 @@

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE BangPatterns #-}

32{-# LANGUAGE NoMonomorphismRestriction #-}

43{-# OPTIONS_GHC -funbox-strict-fields #-}

54{-# OPTIONS_HADDOCK hide #-}

65

7−#ifndef MIN_VERSION_base

8−#defined MIN_VERSION_base(x,y,z) 1

9−#endif

10−

11−{- Evaluates the paramaterized terminfo string capability with the given parameters.

12− -

13− -}

14−module Data.Terminfo.Eval (writeCapExpr)

15− where

6+-- | Evaluates the paramaterized terminfo string capability with the

7+-- given parameters.

8+module Data.Terminfo.Eval

9+ ( writeCapExpr

10+ )

11+where

1612

1713import Blaze.ByteString.Builder.Word

1814import Blaze.ByteString.Builder

@@ -27,10 +23,6 @@ import Data.List

2723

2824import qualified Data.Vector.Unboxed as Vector

2925

30−#if !(MIN_VERSION_base(4,8,0))

31−import Data.Word

32−#endif

33−

3426-- | capability evaluator state

3527data EvalState = EvalState

3628 { evalStack :: ![CapParam]

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

5042

5143readParam :: Word -> Eval CapParam

5244readParam pn = do

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

45+ !params <- evalParams <$> get

5446 return $! genericIndex params pn

5547

5648push :: CapParam -> Eval ()

@@ -72,18 +64,18 @@ writeCapExpr cap params =

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

7365

7466writeCapOps :: CapOps -> Eval ()

75−writeCapOps ops = mapM_ writeCapOp ops

67+writeCapOps = mapM_ writeCapOp

7668

7769writeCapOp :: CapOp -> Eval ()

7870writeCapOp (Bytes !offset !count) = do

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

71+ !cap <- evalExpression <$> get

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

8173 Vector.forM_ bytes $ tell.writeWord8

8274writeCapOp DecOut = do

8375 p <- pop

8476 forM_ (show p) $ tell.writeWord8.toEnum.fromEnum

8577writeCapOp CharOut = do

86− pop >>= tell.writeWord8.toEnum.fromEnum

78+ pop >>= tell.writeWord8.toEnum.fromEnum

8779writeCapOp (PushParam pn) = do

8880 readParam pn >>= push

8981writeCapOp (PushValue v) = do

@@ -91,13 +83,14 @@ writeCapOp (PushValue v) = do

9183writeCapOp (Conditional expr parts) = do

9284 writeCapOps expr

9385 writeContitionalParts parts

94− where

86+ where

9587 writeContitionalParts [] = return ()

9688 writeContitionalParts ((trueOps, falseOps) : falseParts) = do

9789 -- (man 5 terminfo)

98− -- Usually the %? expr part pushes a value onto the stack, and %t pops it from the

99− -- stack, testing if it is nonzero (true). If it is zero (false), control

100− -- passes to the %e (else) part.

90+ -- Usually the %? expr part pushes a value onto the stack,

91+ -- and %t pops it from the stack, testing if it is nonzero

92+ -- (true). If it is zero (false), control passes to the %e

93+ -- (else) part.

10194 v <- pop

10295 if v /= 0

10396 then writeCapOps trueOps

@@ -137,4 +130,3 @@ writeCapOp CompareGt = do

137130 v1 <- pop

138131 v0 <- pop

139132 push $ if v0 > v1 then 1 else 0

140−

src/Data/Terminfo/Parse.hs+61−61

@@ -1,22 +1,22 @@

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE BangPatterns #-}

3−{-# OPTIONS_HADDOCK hide #-}

2+{-# LANGUAGE CPP #-}

43{-# LANGUAGE NoMonomorphismRestriction #-}

5−{-# LANGUAGE NamedFieldPuns #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

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

6+{-# OPTIONS_HADDOCK hide #-}

77

8−#ifndef MIN_VERSION_base

9−#defined MIN_VERSION_base(x,y,z) 1

10−#endif

11−

12−module Data.Terminfo.Parse ( module Data.Terminfo.Parse

13− , Text.Parsec.ParseError

14− )

15− where

8+module Data.Terminfo.Parse

9+ ( module Data.Terminfo.Parse

10+ , Text.Parsec.ParseError

11+ )

12+where

1613

1714import Control.Monad ( liftM )

1815import Control.DeepSeq

1916

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

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

19+#endif

2020import Data.Word

2121import qualified Data.Vector.Unboxed as Vector

2222

@@ -24,10 +24,6 @@ import Numeric (showHex)

2424

2525import Text.Parsec

2626

27−#if !(MIN_VERSION_base(4,8,0))

28−import Data.Monoid

29−#endif

30−

3127data CapExpression = CapExpression

3228 { capOps :: !CapOps

3329 , capBytes :: !(Vector.Vector Word8)

@@ -43,24 +39,24 @@ instance Show CapExpression where

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

4440 where

4541 hexDump :: [Word8] -> String

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

42+ hexDump = foldr showHex ""

4743

4844instance NFData CapExpression where

49− rnf (CapExpression ops !_bytes !str !c !pOps)

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

5046 = rnf ops `seq` rnf str `seq` rnf c `seq` rnf pOps

5147

5248type CapParam = Word

5349

5450type CapOps = [CapOp]

55−data CapOp =

51+data CapOp =

5652 Bytes !Int !Int -- offset count

5753 | DecOut | CharOut

58− -- This stores a 0-based index to the parameter. However the operation that implies this op is

59− -- 1-based

54+ -- This stores a 0-based index to the parameter. However the

55+ -- operation that implies this op is 1-based

6056 | PushParam !Word | PushValue !Word

61− -- The conditional parts are the sequence of (%t expression, %e expression) pairs.

62− -- The %e expression may be NOP

63− | Conditional

57+ -- The conditional parts are the sequence of (%t expression, %e

58+ -- The expression) pairs. %e expression may be NOP

59+ | Conditional

6460 { conditionalExpr :: !CapOps

6561 , conditionalParts :: ![(CapOps, CapOps)]

6662 }

@@ -72,8 +68,8 @@ data CapOp =

7268instance NFData CapOp where

7369 rnf (Bytes offset byteCount ) = rnf offset `seq` rnf byteCount

7470 rnf (PushParam pn) = rnf pn

75− rnf (PushValue v) = rnf v

76− rnf (Conditional cExpr cParts) = rnf cExpr `seq` rnf cParts

71+ rnf (PushValue v) = rnf v

72+ rnf (Conditional cExpr cParts) = rnf cExpr `seq` rnf cParts

7773 rnf BitwiseOr = ()

7874 rnf BitwiseXOr = ()

7975 rnf BitwiseAnd = ()

@@ -94,51 +90,51 @@ instance NFData ParamOp where

9490 rnf IncFirstTwo = ()

9591

9692parseCapExpression :: String -> Either ParseError CapExpression

97−parseCapExpression capString =

93+parseCapExpression capString =

9894 let v = runParser capExpressionParser

9995 initialBuildState

100− "terminfo cap"

101− capString

96+ "terminfo cap"

97+ capString

10298 in case v of

10399 Left e -> Left e

104100 Right buildResults -> Right $ constructCapExpression capString buildResults

105101

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

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

107103constructCapExpression capString buildResults =

108104 let expr = CapExpression

109105 { capOps = outCapOps buildResults

110− -- The cap bytes are the lower 8 bits of the input string's characters.

111− -- \todo Verify the input string actually contains an 8bit byte per character.

106+ -- The cap bytes are the lower 8 bits of the input

107+ -- string's characters.

112108 , capBytes = Vector.fromList $ map (toEnum.fromEnum) capString

113109 , sourceString = capString

114110 , paramCount = outParamCount buildResults

115111 , paramOps = outParamOps buildResults

116− }

112+ }

117113 in rnf expr `seq` expr

118114

119−type CapParser a = Parsec String BuildState a

115+type CapParser a = Parsec String BuildState a

120116

121117capExpressionParser :: CapParser BuildResults

122118capExpressionParser = do

123− rs <- many $ paramEscapeParser <|> bytesOpParser

119+ rs <- many $ paramEscapeParser <|> bytesOpParser

124120 return $ mconcat rs

125121

126122paramEscapeParser :: CapParser BuildResults

127123paramEscapeParser = do

128124 _ <- char '%'

129125 incOffset 1

130− literalPercentParser <|> paramOpParser

126+ literalPercentParser <|> paramOpParser

131127

132128literalPercentParser :: CapParser BuildResults

133129literalPercentParser = do

134130 _ <- char '%'

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

131+ startOffset <- nextOffset <$> getState

136132 incOffset 1

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

138134

139135paramOpParser :: CapParser BuildResults

140136paramOpParser

141− = incrementOpParser

137+ = incrementOpParser

142138 <|> pushOpParser

143139 <|> decOutParser

144140 <|> charOutParser

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

158154pushOpParser :: CapParser BuildResults

159155pushOpParser = do

160156 _ <- char 'p'

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

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

162158 incOffset 2

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

164160

@@ -179,16 +175,16 @@ conditionalOpParser = do

179175 _ <- char '?'

180176 incOffset 1

181177 condPart <- manyExpr conditionalTrueParser

182− parts <- manyP

178+ parts <- manyP

183179 ( do

184180 truePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser

185− , conditionalFalseParser

181+ , conditionalFalseParser

186182 ]

187183 falsePart <- manyExpr $ choice [ try $ lookAhead conditionalEndParser

188184 , conditionalTrueParser

189185 ]

190186 return ( truePart, falsePart )

191− )

187+ )

192188 conditionalEndParser

193189

194190 let trueParts = map fst parts

@@ -208,10 +204,10 @@ conditionalOpParser = do

208204

209205 return $ BuildResults n'' [ Conditional cond condParts ] pOps

210206

211− where

212− manyP !p !end = choice

207+ where

208+ manyP !p !end = choice

213209 [ try end >> return []

214− , do !v <- p

210+ , do !v <- p

215211 !vs <- manyP p end

216212 return $! v : vs

217213 ]

@@ -233,7 +229,7 @@ conditionalEndParser = do

233229 incOffset 2

234230

235231bitwiseOpParser :: CapParser BuildResults

236−bitwiseOpParser

232+bitwiseOpParser

237233 = bitwiseOrParser

238234 <|> bitwiseAndParser

239235 <|> bitwiseXorParser

@@ -257,9 +253,9 @@ bitwiseXorParser = do

257253 return $ BuildResults 0 [ BitwiseXOr ] [ ]

258254

259255arithOpParser :: CapParser BuildResults

260−arithOpParser

261− = plusOp

262− <|> minusOp

256+arithOpParser

257+ = plusOp

258+ <|> minusOp

263259 where

264260 plusOp = do

265261 _ <- char '+'

@@ -282,10 +278,10 @@ literalIntOpParser = do

282278 return $ BuildResults 0 [ PushValue n ] [ ]

283279

284280compareOpParser :: CapParser BuildResults

285−compareOpParser

281+compareOpParser

286282 = compareEqOp

287− <|> compareLtOp

288− <|> compareGtOp

283+ <|> compareLtOp

284+ <|> compareGtOp

289285 where

290286 compareEqOp = do

291287 _ <- char '='

@@ -303,7 +299,7 @@ compareOpParser

303299bytesOpParser :: CapParser BuildResults

304300bytesOpParser = do

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

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

302+ startOffset <- nextOffset <$> getState

307303 let !c = length bytes

308304 !s <- getState

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

@@ -313,14 +309,14 @@ bytesOpParser = do

313309charConstParser :: CapParser BuildResults

314310charConstParser = do

315311 _ <- char '\''

316− charValue <- liftM (toEnum . fromEnum) anyChar

312+ charValue <- liftM (toEnum . fromEnum) anyChar

317313 _ <- char '\''

318314 incOffset 3

319315 return $ BuildResults 0 [ PushValue charValue ] [ ]

320316

321−data BuildState = BuildState

317+data BuildState = BuildState

322318 { nextOffset :: Int

323− }

319+ }

324320

325321incOffset :: Int -> CapParser ()

326322incOffset n = do

@@ -337,12 +333,16 @@ data BuildResults = BuildResults

337333 , outParamOps :: !ParamOps

338334 }

339335

340−instance Monoid BuildResults where

341− mempty = BuildResults 0 [] []

342− v0 `mappend` v1

336+instance Semigroup BuildResults where

337+ v0 <> v1

343338 = BuildResults

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

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

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

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

340+ , outCapOps = outCapOps v0 <> outCapOps v1

341+ , outParamOps = outParamOps v0 <> outParamOps v1

347342 }

348343

344+instance Monoid BuildResults where

345+ mempty = BuildResults 0 [] []

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

347+ mappend = (<>)

348+#endif

src/Graphics/Text/Width.hs+51−16

@@ -1,29 +1,64 @@

22{-# OPTIONS_GHC -D_XOPEN_SOURCE #-}

33{-# LANGUAGE ForeignFunctionInterface #-}

4−module Graphics.Text.Width ( wcwidth

5− , wcswidth

6− , safeWcwidth

7− , safeWcswidth

8− )

9− where

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

13+module Graphics.Text.Width

14+ ( wcwidth

15+ , wcswidth

16+ , wctwidth

17+ , wctlwidth

18+ , safeWcwidth

19+ , safeWcswidth

20+ , safeWctwidth

21+ , safeWctlwidth

22+ )

23+where

24+

25+import Data.List (foldl')

26+import qualified Data.Text as T

27+import qualified Data.Text.Lazy as TL

1028

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

1230

1331wcswidth :: String -> Int

14−wcswidth = sum . map wcwidth

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

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

34+

35+wctwidth :: T.Text -> Int

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

37+

38+wctlwidth :: TL.Text -> Int

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

1540

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

17−--

18−-- Not sure if this is actually correct. I presume there is a replacement character that is output

19−-- by the terminal instead of the character and this replacement character is 1 column wide. If this

20−-- is not true for all terminals then a per-terminal replacement character width needs to be

21−-- implemented.

41+{-# RULES

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

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

44+ #-}

2245

23−-- | Returns the display width of a character. Assumes all characters with unknown widths are 0 width

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

47+-- with unknown widths are 0 width.

2448safeWcwidth :: Char -> Int

2549safeWcwidth = max 0 . wcwidth

2650

27−-- | Returns the display width of a string. Assumes all characters with unknown widths are 0 width

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

52+-- unknown widths are 0 width.

2853safeWcswidth :: String -> Int

29−safeWcswidth = sum . map safeWcwidth

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

55+

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

57+-- unknown widths are 0 width.

58+safeWctwidth :: T.Text -> Int

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

60+

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

62+-- with unknown widths are 0 width.

63+safeWctlwidth :: TL.Text -> Int

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

src/Graphics/Vty.hs+173−90

@@ -1,17 +1,20 @@

1−-- | Vty supports input and output to terminal devices.

2−--

3−-- - Input to the terminal is provided to the app as a sequence of 'Event's.

4−--

5−-- - The output is defined by a 'Picture'. Which is one or more layers of 'Image's.

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE ScopedTypeVariables #-}

3+

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

5+-- output.

66--

7−-- - The module "Graphics.Vty.Image" provides a number of constructor equations that will build

8−-- correct 'Image' values. See 'string', '<|>', and '<->' for starters.

7+-- - Input to the terminal is provided to the Vty application as a

8+-- sequence of 'Event's.

99--

10−-- - The constructors in "Graphics.Vty.Image.Internal" should not be used.

10+-- - Output is provided to Vty by the application in the form of a

11+-- 'Picture'. A 'Picture' is one or more layers of 'Image's.

12+-- 'Image' values can be built by the various constructors in

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

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

1115--

12−-- - 'Image's can be styled using 'Attr'. See "Graphics.Vty.Attributes".

13−--

14−-- See the vty-examples package for a number of examples.

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

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

1518--

1619-- @

1720-- import "Graphics.Vty"

@@ -28,103 +31,153 @@

2831-- 'shutdown' vty

2932-- 'print' (\"Last event was: \" '++' 'show' e)

3033-- @

31−--

32−-- Good sources of documentation for terminal programming are:

33−--

34−-- - <https://github.com/b4winckler/vim/blob/master/src/term.c>

35−--

36−-- - <http://invisible-island.net/xterm/ctlseqs/ctlseqs.html>

37−--

38−-- - <http://ulisse.elettra.trieste.it/services/doc/serial/config.html>

39−--

40−-- - <http://www.leonerd.org.uk/hacks/hints/xterm-8bit.html>

41−--

42−-- - <http://www.unixwiz.net/techtips/termios-vmin-vtime.html>

43−--

44−-- - <http://vt100.net/docs/vt100-ug/chapter3.html vt100 control sequences>

45−module Graphics.Vty ( Vty(..)

46− , mkVty

47− , module Graphics.Vty.Config

48− , module Graphics.Vty.Input

49− , module Graphics.Vty.Output

50− , module Graphics.Vty.Picture

51− , DisplayRegion

52− , Mode(..)

53− )

54− where

55−

56−import Graphics.Vty.Prelude

34+module Graphics.Vty

35+ ( Vty(..)

36+ , mkVty

37+ , setWindowTitle

38+ , Mode(..)

39+ , module Graphics.Vty.Config

40+ , module Graphics.Vty.Input

41+ , module Graphics.Vty.Output

42+ , module Graphics.Vty.Output.Interface

43+ , module Graphics.Vty.Picture

44+ , module Graphics.Vty.Image

45+ , module Graphics.Vty.Attributes

46+ )

47+where

5748

5849import Graphics.Vty.Config

5950import Graphics.Vty.Input

51+import Graphics.Vty.Input.Events

6052import Graphics.Vty.Output

6153import Graphics.Vty.Output.Interface

6254import Graphics.Vty.Picture

55+import Graphics.Vty.Image

56+import Graphics.Vty.Attributes

57+import Graphics.Vty.UnicodeWidthTable.IO

58+import Graphics.Vty.UnicodeWidthTable.Install

6359

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)

6465import Control.Concurrent.STM

6566

6667import Data.IORef

67−import Data.Monoid

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

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

70+#endif

6871

69−-- | The main object. At most one should be created.

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

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

7074--

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

7276--

73−-- 0. initialize vty

74−--

75−-- 1. use the update equation of Vty to display a picture

76−--

77−-- 2. repeat

78−--

79−-- 3. shutdown vty.

80−--

81−-- An alternative to tracking the Vty instance is to use 'withVty' in "Graphics.Vty.Inline.Unsafe".

82−--

83−-- This does not assure any thread safety. In theory, as long as an update action is not executed

84−-- when another update action is already then it's safe to call this on multiple threads.

85−--

86−-- \todo Remove explicit `shutdown` requirement.

87−data Vty = Vty

88− { -- | Outputs the given Picture. Equivalent to 'outputPicture' applied to a display context

89− -- implicitly managed by Vty. The managed display context is reset on resize.

90− update :: Picture -> IO ()

91− -- | Get one Event object, blocking if necessary. This will refresh the terminal if the event

92− -- is a 'EvResize'.

93− , nextEvent :: IO Event

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

95− , inputIface :: Input

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

97− , outputIface :: Output

98− -- | Refresh the display. 'nextEvent' will refresh the display if a resize occurs.

99− -- If other programs output to the terminal and mess up the display then the application might

100− -- want to force a refresh.

101− , refresh :: IO ()

102− -- | Clean up after vty.

103− -- The above methods will throw an exception if executed after this is executed.

104− , shutdown :: IO ()

105− }

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

78+--

79+-- 2. Use 'update' to display a picture.

80+--

81+-- 3. Use 'nextEvent' to get the next input event.

82+--

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

84+--

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

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

87+--

88+-- Operations on Vty handles are not thread-safe.

89+data Vty =

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

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

92+ , nextEvent :: IO Event

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

94+ -- available.

95+ , nextEventNonblocking :: IO (Maybe Event)

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

97+ , inputIface :: Input

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

99+ , outputIface :: Output

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

101+ , refresh :: IO ()

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

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

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

105+ , shutdown :: IO ()

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

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

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

109+ -- this is executed. Idempotent.

110+ , isShutdown :: IO Bool

111+ }

106112

107−-- | Set up the state object for using vty. At most one state object should be

108−-- created at a time for a given terminal device.

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

114+-- for a given terminal device.

109115--

110−-- The specified config is added to the 'userConfig'. With the 'userConfig' taking precedence.

111−-- See "Graphics.Vty.Config"

116+-- The specified configuration is added to the the configuration

117+-- loaded by 'userConfig' with the 'userConfig' configuration taking

118+-- precedence. See "Graphics.Vty.Config".

112119--

113−-- For most applications @mkVty def@ is sufficient.

120+-- For most applications @mkVty defaultConfig@ is sufficient.

114121mkVty :: Config -> IO Vty

115122mkVty appConfig = do

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

117− input <- inputForConfig config

118− out <- outputForConfig config

119− intMkVty input out

120124

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

122−intMkVty input out = do

125+ when (allowCustomUnicodeWidthTables config /= Just False) $

126+ installCustomWidthTable config

127+

128+ input <- inputForConfig config

129+ out <- outputForConfig config

130+ internalMkVty input out

131+

132+installCustomWidthTable :: Config -> IO ()

133+installCustomWidthTable c = do

134+ let doLog s = case debugLog c of

135+ Nothing -> return ()

136+ Just path -> appendFile path $ "installWidthTable: " <> s <> "\n"

137+

138+ customInstalled <- isCustomTableReady

139+ when (not customInstalled) $ do

140+ mTerm <- currentTerminalName

141+ case mTerm of

142+ Nothing ->

143+ doLog "No current terminal name available"

144+ Just currentTerm ->

145+ case lookup currentTerm (termWidthMaps c) of

146+ Nothing ->

147+ doLog "Current terminal not found in custom character width mapping list"

148+ Just path -> do

149+ tableResult <- E.try $ readUnicodeWidthTable path

150+ case tableResult of

151+ Left (e::E.SomeException) ->

152+ doLog $ "Error reading custom character width table " <>

153+ "at " <> show path <> ": " <> show e

154+ Right (Left msg) ->

155+ doLog $ "Error reading custom character width table " <>

156+ "at " <> show path <> ": " <> msg

157+ Right (Right table) -> do

158+ installResult <- E.try $ installUnicodeWidthTable table

159+ case installResult of

160+ Left (e::E.SomeException) ->

161+ doLog $ "Error installing unicode table (" <>

162+ show path <> ": " <> show e

163+ Right () ->

164+ doLog $ "Successfully installed Unicode width table " <>

165+ " from " <> show path

166+

167+internalMkVty :: Input -> Output -> IO Vty

168+internalMkVty input out = do

123169 reserveDisplay out

170+

171+ shutdownVar <- newTVarIO False

124172 let shutdownIo = do

125− shutdownInput input

126− releaseDisplay out

127− releaseTerminal out

173+ alreadyShutdown <- atomically $ swapTVar shutdownVar True

174+ when (not alreadyShutdown) $ do

175+ shutdownInput input

176+ releaseDisplay out

177+ releaseTerminal out

178+

179+ let shutdownStatus = readTVarIO shutdownVar

180+

128181 lastPicRef <- newIORef Nothing

129182 lastUpdateRef <- newIORef Nothing

130183

@@ -156,17 +209,47 @@ intMkVty input out = do

156209 mPic <- readIORef lastPicRef

157210 maybe (return ()) innerUpdate mPic

158211

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

160− case k of

161− (EvResize _ _) -> displayBounds out

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

163− _ -> return k

212+ let mkResize = uncurry EvResize <$> displayBounds out

213+

214+ translateInternalEvent ResumeAfterSignal = mkResize

215+ translateInternalEvent (InputEvent e) = return e

216+

217+ gkey = do

218+ e <- atomically $ readTChan $ _eventChannel input

219+ translateInternalEvent e

220+ gkey' = do

221+ mEv <- atomically $ tryReadTChan $ _eventChannel input

222+ case mEv of

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

224+ Nothing -> return Nothing

164225

165226 return $ Vty { update = innerUpdate

166227 , nextEvent = gkey

228+ , nextEventNonblocking = gkey'

167229 , inputIface = input

168230 , outputIface = out

169231 , refresh = innerRefresh

170232 , shutdown = shutdownIo

233+ , isShutdown = shutdownStatus

171234 }

172235

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+121−120

@@ -1,68 +1,89 @@

11{-# LANGUAGE CPP #-}

2−{-# LANGUAGE StandaloneDeriving #-}

3−{-# LANGUAGE GADTs #-}

4−{-# LANGUAGE RankNTypes #-}

5−

6−#ifndef MIN_VERSION_base

7−#defined MIN_VERSION_base(x,y,z) 1

8−#endif

2+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE DeriveAnyClass #-}

94

105-- | Display attributes

116--

12−-- Typically the values 'defAttr' or 'currentAttr' are modified to form attributes:

7+-- Attributes have three components: a foreground color, a background

8+-- color, and a style mask. The simplest attribute is the default

9+-- attribute, or 'defAttr'. Attributes can be modified with

10+-- 'withForeColor', 'withBackColor', and 'withStyle', e.g.,

1311--

1412-- @

15−-- defAttr `withForeColor` red

13+-- defAttr \`withForeColor\` red

1614-- @

1715--

18−-- Is the attribute that will set the foreground color to red and the background color to the

19−-- default.

20−--

21−-- This can then be used to build an image wiht a red foreground like so:

16+-- 'Image' constructors often require an 'Attr' to indicate the

17+-- attributes used in the image, e.g.,

2218--

2319-- @

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

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

2521-- @

2622--

27−-- The default attributes set by 'defAttr' have a presentation determined by the terminal. This is

28−-- not something VTY can control. The user is free to define the color scheme of the terminal as

29−-- they see fit. Up to the limits of the terminal anyways.

30−--

31−-- The value 'currentAttr' will keep the attributes of whatever was output previously.

32−--

33−-- \todo This API is very verbose IMO. I'd like something more succinct.

34−module Graphics.Vty.Attributes ( module Graphics.Vty.Attributes

35− , module Graphics.Vty.Attributes.Color

36− , module Graphics.Vty.Attributes.Color240

37− )

38− where

39−

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

24+-- terminal, so this is not something VTY can control. The user is free

25+-- to The define the color scheme of the terminal as they see fit.

26+--

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

28+-- output previously.

29+module Graphics.Vty.Attributes

30+ ( module Graphics.Vty.Attributes.Color

31+

32+ , Attr(..)

33+ , FixedAttr(..)

34+ , MaybeDefault(..)

35+ , defAttr

36+ , currentAttr

37+

38+ -- * Styles

39+ , Style

40+ , withStyle

41+ , standout

42+ , italic

43+ , strikethrough

44+ , underline

45+ , reverseVideo

46+ , blink

47+ , dim

48+ , bold

49+ , defaultStyleMask

50+ , styleMask

51+ , hasStyle

52+

53+ -- * Setting attribute colors

54+ , withForeColor

55+ , withBackColor

56+

57+ -- * Setting hyperlinks

58+ , withURL

59+ )

60+where

61+

62+import Control.DeepSeq

4063import Data.Bits

41−import Data.Default

64+import Data.Text (Text)

4265import Data.Word

66+import GHC.Generics

4367

4468import Graphics.Vty.Attributes.Color

45−import Graphics.Vty.Attributes.Color240

46−

47−#if !(MIN_VERSION_base(4,8,0))

48−import Data.Monoid

49−#endif

5069

51−-- | A display attribute defines the Color and Style of all the characters rendered after the

52−-- attribute is applied.

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

71+-- characters rendered after the attribute is applied.

5372--

54−-- At most 256 colors, picked from a 240 and 16 color palette, are possible for the background and

55−-- foreground. The 240 colors and 16 colors are points in different palettes. See Color for more

56−-- information.

73+-- At most 256 colors, picked from a 240 and 16 color palette, are

74+-- possible for the background and foreground. The 240 colors and

75+-- 16 colors are points in different palettes. See Color for more

76+-- information.

5777data Attr = Attr

5878 { attrStyle :: !(MaybeDefault Style)

5979 , attrForeColor :: !(MaybeDefault Color)

6080 , attrBackColor :: !(MaybeDefault Color)

61− } deriving ( Eq, Show, Read )

81+ , attrURL :: !(MaybeDefault Text)

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

6283

63−-- This could be encoded into a single 32 bit word. The 32 bit word is first divided

64−-- into 4 groups of 8 bits where: The first group codes what action should be taken with regards to

65−-- the other groups.

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

86+-- what action should be taken with regards to the other groups.

6687-- XXYYZZ__

6788-- XX - style action

6889-- 00 => reset to default

@@ -79,85 +100,47 @@ data Attr = Attr

79100-- __ - unused

80101--

81102-- Next is the style flags

82−-- SURBDO__

103+-- SURBDOI_

83104-- S - standout

84105-- U - underline

85106-- R - reverse video

86107-- B - blink

87108-- D - dim

88109-- O - bold

89−-- __ - unused

110+-- I - italic

111+-- _ - unused

90112--

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

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

93115

94−instance Monoid Attr where

95− mempty = Attr mempty mempty mempty

96− mappend attr0 attr1 =

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

98− ( attrForeColor attr0 `mappend` attrForeColor attr1 )

99− ( attrBackColor attr0 `mappend` attrBackColor attr1 )

100−

101−-- | Specifies the display attributes such that the final style and color values do not depend on

102−-- the previously applied display attribute. The display attributes can still depend on the

103−-- terminal's default colors (unfortunately).

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

119+-- default colors (unfortunately).

104120data FixedAttr = FixedAttr

105121 { fixedStyle :: !Style

106122 , fixedForeColor :: !(Maybe Color)

107123 , fixedBackColor :: !(Maybe Color)

124+ , fixedURL :: !(Maybe Text)

108125 } deriving ( Eq, Show )

109126

110−-- | The style and color attributes can either be the terminal defaults. Or be equivalent to the

111−-- previously applied style. Or be a specific value.

112−data MaybeDefault v where

113− Default :: MaybeDefault v

114− KeepCurrent :: MaybeDefault v

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

116−

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

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

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

120−

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

122− mempty = KeepCurrent

123− mappend Default Default = Default

124− mappend Default KeepCurrent = Default

125− mappend Default ( SetTo v ) = SetTo v

126− mappend KeepCurrent Default = Default

127− mappend KeepCurrent KeepCurrent = KeepCurrent

128− mappend KeepCurrent ( SetTo v ) = SetTo v

129− mappend ( SetTo _v ) Default = Default

130− mappend ( SetTo v ) KeepCurrent = SetTo v

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

132−

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

134−black, red, green, yellow, blue, magenta, cyan, white :: Color

135−black = ISOColor 0

136−red = ISOColor 1

137−green = ISOColor 2

138−yellow = ISOColor 3

139−blue = ISOColor 4

140−magenta= ISOColor 5

141−cyan = ISOColor 6

142−white = ISOColor 7

143−

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

145−brightBlack, brightRed, brightGreen, brightYellow :: Color

146−brightBlue, brightMagenta, brightCyan, brightWhite :: Color

147−brightBlack = ISOColor 8

148−brightRed = ISOColor 9

149−brightGreen = ISOColor 10

150−brightYellow = ISOColor 11

151−brightBlue = ISOColor 12

152−brightMagenta= ISOColor 13

153−brightCyan = ISOColor 14

154−brightWhite = ISOColor 15

155−

156−-- | Styles are represented as an 8 bit word. Each bit in the word is 1 if the style attribute

157−-- assigned to that bit should be applied and 0 if the style attribute should not be applied.

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

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

129+-- value.

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

131+ deriving (Eq, Read, Show)

132+

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

134+ rnf Default = ()

135+ rnf KeepCurrent = ()

136+ rnf (SetTo v) = rnf v

137+

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

140+-- if the style attribute should not be applied.

158141type Style = Word8

159142

160−-- | The 6 possible style attributes:

143+-- | Valid style attributes include:

161144--

162145-- * standout

163146--

@@ -171,21 +154,27 @@ type Style = Word8

171154--

172155-- * bold/bright

173156--

174−-- ( The invisible, protect, and altcharset display attributes some terminals support are not

175−-- supported via VTY.)

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

157+-- * italic

158+--

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

160+--

161+-- (The invisible, protect, and altcharset display attributes some

162+-- terminals support are not supported via VTY.)

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

177164standout = 0x01

178165underline = 0x02

179−reverseVideo = 0x04

166+reverseVideo = 0x04

180167blink = 0x08

181168dim = 0x10

182169bold = 0x20

170+italic = 0x40

171+strikethrough = 0x80

183172

184173defaultStyleMask :: Style

185174defaultStyleMask = 0x00

186175

187176styleMask :: Attr -> Word8

188−styleMask attr

177+styleMask attr

189178 = case attrStyle attr of

190179 Default -> 0

191180 KeepCurrent -> 0

@@ -205,23 +194,35 @@ withBackColor attr c = attr { attrBackColor = SetTo c }

205194

206195-- | Add the given style attribute

207196withStyle :: Attr -> Style -> Attr

197+withStyle attr 0 = attr

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

209199

210−-- | Sets the style, background color and foreground color to the default values for the terminal.

211−-- There is no easy way to determine what the default background and foreground colors are.

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

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

216+-- what the default background and foreground colors are.

212217defAttr :: Attr

213−defAttr = Attr Default Default Default

214−

215−instance Default Attr where

216− def = defAttr

218+defAttr = Attr Default Default Default Default

217219

218−-- | Keeps the style, background color and foreground color that was previously set. Used to

219−-- override some part of the previous style.

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

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

220222--

221223-- EG: current_style `withForeColor` brightMagenta

222224--

223−-- Would be the currently applied style (be it underline, bold, etc) but with the foreground color

224−-- set to brightMagenta.

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

226+-- with the foreground color set to brightMagenta.

225227currentAttr :: Attr

226−currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent

227−

228+currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent KeepCurrent

src/Graphics/Vty/Attributes/Color.hs+162−22

@@ -1,16 +1,75 @@

1−module Graphics.Vty.Attributes.Color where

1+{-# LANGUAGE DeriveGeneric #-}

2+{-# LANGUAGE DeriveAnyClass #-}

3+{-# LANGUAGE MultiWayIf #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

5+

6+module Graphics.Vty.Attributes.Color

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

23+ , red

24+ , green

25+ , yellow

26+ , blue

27+ , magenta

28+ , cyan

29+ , white

30+

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

32+ , brightBlack

33+ , brightRed

34+ , brightGreen

35+ , brightYellow

36+ , brightBlue

37+ , brightMagenta

38+ , brightCyan

39+ , brightWhite

40+ -- ** Creating Colors From RGB

41+ , linearColor

42+ , srgbColor

43+ , rgbColor

44+ , color240

45+ , module Graphics.Vty.Attributes.Color240

46+ )

47+where

48+

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

359

460-- | Abstract data type representing a color.

5−--

6−-- Currently the foreground and background color are specified as points in either a:

761--

8−-- * 16 color palette. Where the first 8 colors are equal to the 8 colors of the ISO 6429 (ANSI) 8

9−-- color palette and the second 8 colors are bright/vivid versions of the first 8 colors.

62+-- Currently the foreground and background color are specified as points

63+-- in either a:

64+--

65+-- * 16 color palette. Where the first 8 colors are equal to the 8

66+-- colors of the ISO 6429 (ANSI) 8 color palette and the second 8

67+-- colors are bright/vivid versions of the first 8 colors.

68+--

69+-- * 240 color palette. This palette is a regular sampling of the full

70+-- RGB colorspace for the first 224 colors. The remaining 16 colors is

71+-- a greyscale palette.

1072--

11−-- * 240 color palette. This palette is a regular sampling of the full RGB colorspace for the first

12−-- 224 colors. The remaining 16 colors is a greyscale palette.

13−--

1473-- The 8 ISO 6429 (ANSI) colors are as follows:

1574--

1675-- 0. black

@@ -29,23 +88,104 @@ import Data.Word

2988--

3089-- 7. white

3190--

32−-- The mapping from points in the 240 color palette to colors actually displayable by the terminal

33−-- depends on the number of colors the terminal claims to support. Which is usually determined by

34−-- the terminfo "colors" property. If this property is not being accurately reported then the color

35−-- reproduction will be incorrect.

91+-- The mapping from points in the 240 color palette to colors actually

92+-- displayable by the terminal depends on the number of colors the

93+-- terminal claims to support. Which is usually determined by the

94+-- terminfo "colors" property. If this property is not being accurately

95+-- reported then the color reproduction will be incorrect.

3696--

37−-- If the terminal reports <= 16 colors then the 240 color palette points are only mapped to the 8

38−-- color pallete. I'm not sure of the RGB points for the "bright" colors which is why they are not

39−-- addressable via the 240 color palette.

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

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

100+-- addressable via the 240 color palette.

40101--

41−-- If the terminal reports > 16 colors then the 240 color palette points are mapped to the nearest

42−-- points in a ("color count" - 16) subsampling of the 240 color palette.

102+-- If the terminal reports > 16 colors then the 240 color palette

103+-- points are mapped to the nearest points in a ("color count" - 16)

104+-- subsampling of the 240 color palette.

43105--

44−-- All of this assumes the terminals are behaving similarly to xterm and rxvt when handling colors.

45−-- And that the individual colors have not been remapped by the user. There may be a way to verify

46−-- this through terminfo but I don't know it.

106+-- All of this assumes the terminals are behaving similarly to xterm and

107+-- rxvt when handling colors. And that the individual colors have not

108+-- been remapped by the user. There may be a way to verify this through

109+-- terminfo but I don't know it.

47110--

48111-- Seriously, terminal color support is INSANE.

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

50− deriving ( Eq, Show, Read )

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

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

114+

115+data ColorMode

116+ = NoColor

117+ | ColorMode8

118+ | ColorMode16

119+ | ColorMode240 !Word8

120+ | FullColor

121+ deriving ( Eq, Show )

122+

123+detectColorMode :: String -> IO ColorMode

124+detectColorMode termName' = do

125+ term <- catch (Just <$> Terminfo.setupTerm termName')

126+ (\(_ :: Terminfo.SetupTermError) -> return Nothing)

127+ let getCap cap = term >>= \t -> Terminfo.getCapability t cap

128+ termColors = fromMaybe 0 $ getCap (Terminfo.tiGetNum "colors")

129+ colorterm <- lookupEnv "COLORTERM"

130+ return $ if

131+ | termColors < 8 -> NoColor

132+ | termColors < 16 -> ColorMode8

133+ | termColors == 16 -> ColorMode16

134+ | termColors < 256 -> ColorMode240 (fromIntegral termColors - 16)

135+ | colorterm == Just "truecolor" -> FullColor

136+ | colorterm == Just "24bit" -> FullColor

137+ | otherwise -> ColorMode240 240

138+

139+black, red, green, yellow, blue, magenta, cyan, white :: Color

140+black = ISOColor 0

141+red = ISOColor 1

142+green = ISOColor 2

143+yellow = ISOColor 3

144+blue = ISOColor 4

145+magenta= ISOColor 5

146+cyan = ISOColor 6

147+white = ISOColor 7

148+

149+brightBlack, brightRed, brightGreen, brightYellow :: Color

150+brightBlue, brightMagenta, brightCyan, brightWhite :: Color

151+brightBlack = ISOColor 8

152+brightRed = ISOColor 9

153+brightGreen = ISOColor 10

154+brightYellow = ISOColor 11

155+brightBlue = ISOColor 12

156+brightMagenta= ISOColor 13

157+brightCyan = ISOColor 14

158+brightWhite = 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)

51186

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+291−254

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

1−{-

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

3− -}

4−module Graphics.Vty.Attributes.Color240 where

5−

6−import Graphics.Vty.Attributes.Color

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

2+module Graphics.Vty.Attributes.Color240

3+ ( rgbColorToColor240

4+ , color240CodeToRGB

5+ )

6+where

77

8+import Data.Word (Word8)

89import Text.Printf

910

10−-- | RGB color to 240 color palette.

11−--

12−-- generated from 256colres.pl which is forked from xterm 256colres.pl

13−-- todo: all values get clamped high.

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

15−rgbColor r g b

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

12+-- 256colres.pl which is forked from xterm 256colres.pl.

13+

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

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

16+rgbColorToColor240 r g b

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

43− | r <= 0 && g <= 0 && b <= 135 = Color240 2

44− | r <= 0 && g <= 0 && b <= 175 = Color240 3

45− | r <= 0 && g <= 0 && b <= 215 = Color240 4

46− | r <= 0 && g <= 0 && b <= 255 = Color240 5

47− | r <= 0 && g <= 95 && b <= 0 = Color240 6

48− | r <= 0 && g <= 95 && b <= 95 = Color240 7

49− | r <= 0 && g <= 95 && b <= 135 = Color240 8

50− | r <= 0 && g <= 95 && b <= 175 = Color240 9

51− | r <= 0 && g <= 95 && b <= 215 = Color240 10

52− | r <= 0 && g <= 95 && b <= 255 = Color240 11

53− | r <= 0 && g <= 135 && b <= 0 = Color240 12

54− | r <= 0 && g <= 135 && b <= 95 = Color240 13

55− | r <= 0 && g <= 135 && b <= 135 = Color240 14

56− | r <= 0 && g <= 135 && b <= 175 = Color240 15

57− | r <= 0 && g <= 135 && b <= 215 = Color240 16

58− | r <= 0 && g <= 135 && b <= 255 = Color240 17

59− | r <= 0 && g <= 175 && b <= 0 = Color240 18

60− | r <= 0 && g <= 175 && b <= 95 = Color240 19

61− | r <= 0 && g <= 175 && b <= 135 = Color240 20

62− | r <= 0 && g <= 175 && b <= 175 = Color240 21

63− | r <= 0 && g <= 175 && b <= 215 = Color240 22

64− | r <= 0 && g <= 175 && b <= 255 = Color240 23

65− | r <= 0 && g <= 215 && b <= 0 = Color240 24

66− | r <= 0 && g <= 215 && b <= 95 = Color240 25

67− | r <= 0 && g <= 215 && b <= 135 = Color240 26

68− | r <= 0 && g <= 215 && b <= 175 = Color240 27

69− | r <= 0 && g <= 215 && b <= 215 = Color240 28

70− | r <= 0 && g <= 215 && b <= 255 = Color240 29

71− | r <= 0 && g <= 255 && b <= 0 = Color240 30

72− | r <= 0 && g <= 255 && b <= 95 = Color240 31

73− | r <= 0 && g <= 255 && b <= 135 = Color240 32

74− | r <= 0 && g <= 255 && b <= 175 = Color240 33

75− | r <= 0 && g <= 255 && b <= 215 = Color240 34

76− | r <= 0 && g <= 255 && b <= 255 = Color240 35

77− | r <= 95 && g <= 0 && b <= 0 = Color240 36

78− | r <= 95 && g <= 0 && b <= 95 = Color240 37

79− | r <= 95 && g <= 0 && b <= 135 = Color240 38

80− | r <= 95 && g <= 0 && b <= 175 = Color240 39

81− | r <= 95 && g <= 0 && b <= 215 = Color240 40

82− | r <= 95 && g <= 0 && b <= 255 = Color240 41

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

84− | r <= 95 && g <= 95 && b <= 95 = Color240 43

85− | r <= 95 && g <= 95 && b <= 135 = Color240 44

86− | r <= 95 && g <= 95 && b <= 175 = Color240 45

87− | r <= 95 && g <= 95 && b <= 215 = Color240 46

88− | r <= 95 && g <= 95 && b <= 255 = Color240 47

89− | r <= 95 && g <= 135 && b <= 0 = Color240 48

90− | r <= 95 && g <= 135 && b <= 95 = Color240 49

91− | r <= 95 && g <= 135 && b <= 135 = Color240 50

92− | r <= 95 && g <= 135 && b <= 175 = Color240 51

93− | r <= 95 && g <= 135 && b <= 215 = Color240 52

94− | r <= 95 && g <= 135 && b <= 255 = Color240 53

95− | r <= 95 && g <= 175 && b <= 0 = Color240 54

96− | r <= 95 && g <= 175 && b <= 95 = Color240 55

97− | r <= 95 && g <= 175 && b <= 135 = Color240 56

98− | r <= 95 && g <= 175 && b <= 175 = Color240 57

99− | r <= 95 && g <= 175 && b <= 215 = Color240 58

100− | r <= 95 && g <= 175 && b <= 255 = Color240 59

101− | r <= 95 && g <= 215 && b <= 0 = Color240 60

102− | r <= 95 && g <= 215 && b <= 95 = Color240 61

103− | r <= 95 && g <= 215 && b <= 135 = Color240 62

104− | r <= 95 && g <= 215 && b <= 175 = Color240 63

105− | r <= 95 && g <= 215 && b <= 215 = Color240 64

106− | r <= 95 && g <= 215 && b <= 255 = Color240 65

107− | r <= 95 && g <= 255 && b <= 0 = Color240 66

108− | r <= 95 && g <= 255 && b <= 95 = Color240 67

109− | r <= 95 && g <= 255 && b <= 135 = Color240 68

110− | r <= 95 && g <= 255 && b <= 175 = Color240 69

111− | r <= 95 && g <= 255 && b <= 215 = Color240 70

112− | r <= 95 && g <= 255 && b <= 255 = Color240 71

113− | r <= 135 && g <= 0 && b <= 0 = Color240 72

114− | r <= 135 && g <= 0 && b <= 95 = Color240 73

115− | r <= 135 && g <= 0 && b <= 135 = Color240 74

116− | r <= 135 && g <= 0 && b <= 175 = Color240 75

117− | r <= 135 && g <= 0 && b <= 215 = Color240 76

118− | r <= 135 && g <= 0 && b <= 255 = Color240 77

119− | r <= 135 && g <= 95 && b <= 0 = Color240 78

120− | r <= 135 && g <= 95 && b <= 95 = Color240 79

121− | r <= 135 && g <= 95 && b <= 135 = Color240 80

122− | r <= 135 && g <= 95 && b <= 175 = Color240 81

123− | r <= 135 && g <= 95 && b <= 215 = Color240 82

124− | r <= 135 && g <= 95 && b <= 255 = Color240 83

125− | r <= 135 && g <= 135 && b <= 0 = Color240 84

126− | r <= 135 && g <= 135 && b <= 95 = Color240 85

127− | r <= 135 && g <= 135 && b <= 135 = Color240 86

128− | r <= 135 && g <= 135 && b <= 175 = Color240 87

129− | r <= 135 && g <= 135 && b <= 215 = Color240 88

130− | r <= 135 && g <= 135 && b <= 255 = Color240 89

131− | r <= 135 && g <= 175 && b <= 0 = Color240 90

132− | r <= 135 && g <= 175 && b <= 95 = Color240 91

133− | r <= 135 && g <= 175 && b <= 135 = Color240 92

134− | r <= 135 && g <= 175 && b <= 175 = Color240 93

135− | r <= 135 && g <= 175 && b <= 215 = Color240 94

136− | r <= 135 && g <= 175 && b <= 255 = Color240 95

137− | r <= 135 && g <= 215 && b <= 0 = Color240 96

138− | r <= 135 && g <= 215 && b <= 95 = Color240 97

139− | r <= 135 && g <= 215 && b <= 135 = Color240 98

140− | r <= 135 && g <= 215 && b <= 175 = Color240 99

141− | r <= 135 && g <= 215 && b <= 215 = Color240 100

142− | r <= 135 && g <= 215 && b <= 255 = Color240 101

143− | r <= 135 && g <= 255 && b <= 0 = Color240 102

144− | r <= 135 && g <= 255 && b <= 95 = Color240 103

145− | r <= 135 && g <= 255 && b <= 135 = Color240 104

146− | r <= 135 && g <= 255 && b <= 175 = Color240 105

147− | r <= 135 && g <= 255 && b <= 215 = Color240 106

148− | r <= 135 && g <= 255 && b <= 255 = Color240 107

149− | r <= 175 && g <= 0 && b <= 0 = Color240 108

150− | r <= 175 && g <= 0 && b <= 95 = Color240 109

151− | r <= 175 && g <= 0 && b <= 135 = Color240 110

152− | r <= 175 && g <= 0 && b <= 175 = Color240 111

153− | r <= 175 && g <= 0 && b <= 215 = Color240 112

154− | r <= 175 && g <= 0 && b <= 255 = Color240 113

155− | r <= 175 && g <= 95 && b <= 0 = Color240 114

156− | r <= 175 && g <= 95 && b <= 95 = Color240 115

157− | r <= 175 && g <= 95 && b <= 135 = Color240 116

158− | r <= 175 && g <= 95 && b <= 175 = Color240 117

159− | r <= 175 && g <= 95 && b <= 215 = Color240 118

160− | r <= 175 && g <= 95 && b <= 255 = Color240 119

161− | r <= 175 && g <= 135 && b <= 0 = Color240 120

162− | r <= 175 && g <= 135 && b <= 95 = Color240 121

163− | r <= 175 && g <= 135 && b <= 135 = Color240 122

164− | r <= 175 && g <= 135 && b <= 175 = Color240 123

165− | r <= 175 && g <= 135 && b <= 215 = Color240 124

166− | r <= 175 && g <= 135 && b <= 255 = Color240 125

167− | r <= 175 && g <= 175 && b <= 0 = Color240 126

168− | r <= 175 && g <= 175 && b <= 95 = Color240 127

169− | r <= 175 && g <= 175 && b <= 135 = Color240 128

170− | r <= 175 && g <= 175 && b <= 175 = Color240 129

171− | r <= 175 && g <= 175 && b <= 215 = Color240 130

172− | r <= 175 && g <= 175 && b <= 255 = Color240 131

173− | r <= 175 && g <= 215 && b <= 0 = Color240 132

174− | r <= 175 && g <= 215 && b <= 95 = Color240 133

175− | r <= 175 && g <= 215 && b <= 135 = Color240 134

176− | r <= 175 && g <= 215 && b <= 175 = Color240 135

177− | r <= 175 && g <= 215 && b <= 215 = Color240 136

178− | r <= 175 && g <= 215 && b <= 255 = Color240 137

179− | r <= 175 && g <= 255 && b <= 0 = Color240 138

180− | r <= 175 && g <= 255 && b <= 95 = Color240 139

181− | r <= 175 && g <= 255 && b <= 135 = Color240 140

182− | r <= 175 && g <= 255 && b <= 175 = Color240 141

183− | r <= 175 && g <= 255 && b <= 215 = Color240 142

184− | r <= 175 && g <= 255 && b <= 255 = Color240 143

185− | r <= 215 && g <= 0 && b <= 0 = Color240 144

186− | r <= 215 && g <= 0 && b <= 95 = Color240 145

187− | r <= 215 && g <= 0 && b <= 135 = Color240 146

188− | r <= 215 && g <= 0 && b <= 175 = Color240 147

189− | r <= 215 && g <= 0 && b <= 215 = Color240 148

190− | r <= 215 && g <= 0 && b <= 255 = Color240 149

191− | r <= 215 && g <= 95 && b <= 0 = Color240 150

192− | r <= 215 && g <= 95 && b <= 95 = Color240 151

193− | r <= 215 && g <= 95 && b <= 135 = Color240 152

194− | r <= 215 && g <= 95 && b <= 175 = Color240 153

195− | r <= 215 && g <= 95 && b <= 215 = Color240 154

196− | r <= 215 && g <= 95 && b <= 255 = Color240 155

197− | r <= 215 && g <= 135 && b <= 0 = Color240 156

198− | r <= 215 && g <= 135 && b <= 95 = Color240 157

199− | r <= 215 && g <= 135 && b <= 135 = Color240 158

200− | r <= 215 && g <= 135 && b <= 175 = Color240 159

201− | r <= 215 && g <= 135 && b <= 215 = Color240 160

202− | r <= 215 && g <= 135 && b <= 255 = Color240 161

203− | r <= 215 && g <= 175 && b <= 0 = Color240 162

204− | r <= 215 && g <= 175 && b <= 95 = Color240 163

205− | r <= 215 && g <= 175 && b <= 135 = Color240 164

206− | r <= 215 && g <= 175 && b <= 175 = Color240 165

207− | r <= 215 && g <= 175 && b <= 215 = Color240 166

208− | r <= 215 && g <= 175 && b <= 255 = Color240 167

209− | r <= 215 && g <= 215 && b <= 0 = Color240 168

210− | r <= 215 && g <= 215 && b <= 95 = Color240 169

211− | r <= 215 && g <= 215 && b <= 135 = Color240 170

212− | r <= 215 && g <= 215 && b <= 175 = Color240 171

213− | r <= 215 && g <= 215 && b <= 215 = Color240 172

214− | r <= 215 && g <= 215 && b <= 255 = Color240 173

215− | r <= 215 && g <= 255 && b <= 0 = Color240 174

216− | r <= 215 && g <= 255 && b <= 95 = Color240 175

217− | r <= 215 && g <= 255 && b <= 135 = Color240 176

218− | r <= 215 && g <= 255 && b <= 175 = Color240 177

219− | r <= 215 && g <= 255 && b <= 215 = Color240 178

220− | r <= 215 && g <= 255 && b <= 255 = Color240 179

221− | r <= 255 && g <= 0 && b <= 0 = Color240 180

222− | r <= 255 && g <= 0 && b <= 95 = Color240 181

223− | r <= 255 && g <= 0 && b <= 135 = Color240 182

224− | r <= 255 && g <= 0 && b <= 175 = Color240 183

225− | r <= 255 && g <= 0 && b <= 215 = Color240 184

226− | r <= 255 && g <= 0 && b <= 255 = Color240 185

227− | r <= 255 && g <= 95 && b <= 0 = Color240 186

228− | r <= 255 && g <= 95 && b <= 95 = Color240 187

229− | r <= 255 && g <= 95 && b <= 135 = Color240 188

230− | r <= 255 && g <= 95 && b <= 175 = Color240 189

231− | r <= 255 && g <= 95 && b <= 215 = Color240 190

232− | r <= 255 && g <= 95 && b <= 255 = Color240 191

233− | r <= 255 && g <= 135 && b <= 0 = Color240 192

234− | r <= 255 && g <= 135 && b <= 95 = Color240 193

235− | r <= 255 && g <= 135 && b <= 135 = Color240 194

236− | r <= 255 && g <= 135 && b <= 175 = Color240 195

237− | r <= 255 && g <= 135 && b <= 215 = Color240 196

238− | r <= 255 && g <= 135 && b <= 255 = Color240 197

239− | r <= 255 && g <= 175 && b <= 0 = Color240 198

240− | r <= 255 && g <= 175 && b <= 95 = Color240 199

241− | r <= 255 && g <= 175 && b <= 135 = Color240 200

242− | r <= 255 && g <= 175 && b <= 175 = Color240 201

243− | r <= 255 && g <= 175 && b <= 215 = Color240 202

244− | r <= 255 && g <= 175 && b <= 255 = Color240 203

245− | r <= 255 && g <= 215 && b <= 0 = Color240 204

246− | r <= 255 && g <= 215 && b <= 95 = Color240 205

247− | r <= 255 && g <= 215 && b <= 135 = Color240 206

248− | r <= 255 && g <= 215 && b <= 175 = Color240 207

249− | r <= 255 && g <= 215 && b <= 215 = Color240 208

250− | r <= 255 && g <= 215 && b <= 255 = Color240 209

251− | r <= 255 && g <= 255 && b <= 0 = Color240 210

252− | r <= 255 && g <= 255 && b <= 95 = Color240 211

253− | r <= 255 && g <= 255 && b <= 135 = Color240 212

254− | r <= 255 && g <= 255 && b <= 175 = Color240 213

255− | r <= 255 && g <= 255 && b <= 215 = Color240 214

256− | r <= 255 && g <= 255 && b <= 255 = Color240 215

257− | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

25844 (fromIntegral r :: Int)

25945 (fromIntegral g :: Int)

260− (fromIntegral b :: Int))

46+ (fromIntegral b :: Int)))

47+

48+simpleColor_ :: Integral i => Word8 -> i -> Word8

49+simpleColor_ e c

50+ | c <= 0 = 0

51+ | c <= 95 = 1

52+ | c <= 255 = fromIntegral ((c-16) `div` 40)

53+ | otherwise = e

26154

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+290−111

@@ -3,21 +3,13 @@

33{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

44{-# LANGUAGE TypeOperators #-}

55{-# LANGUAGE ScopedTypeVariables #-}

6−-- | A 'Config' can be provided to mkVty to customize the applications use of vty. A config file can

7−-- be used to customize vty for a user's system.

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

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

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

9+-- application's use of Vty.

810--

9−-- The 'Config' provided is mappend'd to 'Config's loaded from @'getAppUserDataDirectory'/config@

10−-- and @$VTY_CONFIG_FILE@. The @$VTY_CONFIG_FILE@ takes precedence over the @config@ file or the

11−-- application provided 'Config'.

12−--

13−-- Lines in config files that fail to parse are ignored. Later entries take precedence over

14−-- earlier.

15−--

16−-- For all directives:

17−--

18−-- @

19−-- string := \"\\\"\" chars+ \"\\\"\"

20−-- @

11+-- Lines in config files that fail to parse are ignored. Later entries

12+-- take precedence over earlier ones.

2113--

2214-- = Debug

2315--

@@ -29,8 +21,8 @@

2921-- \"debugLog\" string

3022-- @

3123--

32−-- The value of the environment variable @VTY_DEBUG_LOG@ is equivalent to a debugLog entry at the

33−-- end of the last config file.

24+-- The value of the environment variable @VTY_DEBUG_LOG@ is equivalent

25+-- to a debugLog entry at the end of the last config file.

3426--

3527-- = Input Processing

3628--

@@ -40,14 +32,14 @@

4032--

4133-- @

4234-- \"map\" term string key modifier_list

43−-- where

35+-- where

4436-- key := KEsc | KChar Char | KBS ... (same as 'Key')

4537-- modifier_list := \"[\" modifier+ \"]\"

4638-- modifier := MShift | MCtrl | MMeta | MAlt

4739-- term := "_" | string

4840-- @

4941--

50−-- EG: If the contents are

42+-- E.g., if the contents are

5143--

5244-- @

5345-- map _ \"\\ESC[B\" KUp []

@@ -55,16 +47,41 @@

5547-- map \"xterm\" \"\\ESC[D\" KLeft []

5648-- @

5749--

58−-- Then the bytes @\"\\ESC[B\"@ will result in the KUp event on all terminals. The bytes

59−-- @\"\\ESC[1;3B\"@ will result in the event KDown with the MAlt modifier on all terminals.

60−-- The bytes @\"\\ESC[D\"@ will result in the KLeft event when @TERM@ is @xterm@.

50+-- Then the bytes @\"\\ESC[B\"@ will result in the KUp event on all

51+-- terminals. The bytes @\"\\ESC[1;3B\"@ will result in the event KDown

52+-- with the MAlt modifier on all terminals. The bytes @\"\\ESC[D\"@ will

53+-- result in the KLeft event when @TERM@ is @xterm@.

54+--

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

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

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

59+--

60+-- = Unicode Character Width Maps

61+--

62+-- == @widthMap@

63+--

64+-- Format:

65+--

66+-- @

67+-- \"widthMap\" string string

68+-- @

6169--

62−-- If a debug log is requested then vty will output the current input table to the log in the above

63−-- format.

70+-- E.g.,

6471--

65−-- Set VTY_DEBUG_LOG. Run vty. Check debug log for incorrect mappings. Add corrected mappings to

66−-- .vty/config

72+-- @

73+-- widthMap \"xterm\" \"\/home\/user\/.vty\/xterm\_map.dat\"

74+-- @

6775--

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.

6885module Graphics.Vty.Config

6986 ( InputMap

7087 , Config(..)

@@ -74,13 +91,22 @@ module Graphics.Vty.Config

7491 , standardIOConfig

7592 , runParseConfig

7693 , parseConfigFile

77− ) where

94+ , defaultConfig

95+ , getTtyEraseChar

96+ , currentTerminalName

97+

98+ , vtyConfigPath

99+ , widthTableFilename

100+ , vtyDataDirectory

101+ , terminalWidthTablePath

102+ , vtyConfigFileEnvName

103+

104+ , ConfigUpdateResult(..)

105+ , addConfigWidthMap

106+ )

107+where

78108

79−#if __GLASGOW_HASKELL__ > 704

80109import Prelude

81−#else

82−import Prelude hiding (catch)

83−#endif

84110

85111import Control.Applicative hiding (many)

86112

@@ -88,113 +114,186 @@ import Control.Exception (catch, IOException, Exception(..), throwIO)

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

89115

90116import qualified Data.ByteString as BS

91−import Data.Default

92−import Data.Monoid

117+#if !(MIN_VERSION_base(4,8,0))

118+import Data.Monoid (Monoid(..))

119+#endif

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

121+import Data.Semigroup (Semigroup(..))

122+#endif

93123import Data.Typeable (Typeable)

94124

95125import Graphics.Vty.Input.Events

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

96127

97128import GHC.Generics

98129

99−import System.Directory (getAppUserDataDirectory)

100−import System.Posix.Env (getEnv)

130+import System.Directory ( getAppUserDataDirectory, doesFileExist

131+ , createDirectoryIfMissing

132+ )

133+import System.Environment (lookupEnv)

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

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

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

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

103138

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

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

106141import qualified Text.Parsec.Token as P

107142

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

109−data VtyConfigurationError

110− = VtyMissingTermEnvVar -- ^ TERM environment variable not set

111− deriving (Show, Eq, Typeable)

144+data VtyConfigurationError =

145+ VtyMissingTermEnvVar

146+ -- ^ TERM environment variable not set

147+ deriving (Show, Eq, Typeable)

112148

113149instance Exception VtyConfigurationError where

114−#if MIN_VERSION_base(4,8,0)

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

116−#endif

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

117151

118−-- | Mappings from input bytes to event in the order specified. Later entries take precedence over

119−-- earlier in the case multiple entries have the same byte string.

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

153+-- entries take precedence over earlier in the case multiple entries

154+-- have the same byte string.

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

121156

122−data Config = Config

123− {

124− -- | The default is 1 character.

125− vmin :: Maybe Int

126− -- | The default is 100 milliseconds, 0.1 seconds.

127− , vtime :: Maybe Int

128− -- | The default is False.

129− , mouseMode :: Maybe Bool

130− -- | The default is False.

131− , bracketedPasteMode :: Maybe Bool

132− -- | Debug information is appended to this file if not Nothing.

133− , debugLog :: Maybe FilePath

134− -- | The (input byte, output event) pairs extend the internal input table of VTY and the table

135− -- from terminfo.

136− --

137− -- See "Graphics.Vty.Config" module documentation for documentation of the @map@ directive.

138− , inputMap :: InputMap

139− -- | The input file descriptor to use. The default is 'System.Posix.IO.stdInput'

140− , inputFd :: Maybe Fd

141− -- | The output file descriptor to use. The default is 'System.Posix.IO.stdOutput'

142− , outputFd :: Maybe Fd

143− -- | The terminal name used to look up terminfo capabilities.

144− -- The default is the value of the TERM environment variable.

145− , termName :: Maybe String

146− } deriving (Show, Eq)

147−

148−instance Default Config where

149− def = mempty

157+-- | A Vty configuration.

158+data Config =

159+ Config { vmin :: Maybe Int

160+ -- ^ The default is 1 character.

161+ , vtime :: Maybe Int

162+ -- ^ The default is 100 milliseconds, 0.1 seconds.

163+ , mouseMode :: Maybe Bool

164+ -- ^ The default is False.

165+ , bracketedPasteMode :: Maybe Bool

166+ -- ^ The default is False.

167+ , debugLog :: Maybe FilePath

168+ -- ^ Debug information is appended to this file if not

169+ -- Nothing.

170+ , inputMap :: InputMap

171+ -- ^ The (input byte, output event) pairs extend the internal

172+ -- input table of VTY and the table from terminfo.

173+ --

174+ -- See "Graphics.Vty.Config" module documentation for

175+ -- documentation of the @map@ directive.

176+ , inputFd :: Maybe Fd

177+ -- ^ The input file descriptor to use. The default is

178+ -- 'System.Posix.IO.stdInput'

179+ , outputFd :: Maybe Fd

180+ -- ^ The output file descriptor to use. The default is

181+ -- 'System.Posix.IO.stdOutput'

182+ , termName :: Maybe String

183+ -- ^ The terminal name used to look up terminfo capabilities.

184+ -- The default is the value of the TERM environment variable.

185+ , termWidthMaps :: [(String, FilePath)]

186+ -- ^ Terminal width map files.

187+ , allowCustomUnicodeWidthTables :: Maybe Bool

188+ -- ^ Whether to permit custom Unicode width table loading by

189+ -- 'Graphics.Vty.mkVty'. @'Just' 'False'@ indicates that

190+ -- table loading should not be performed. Other values permit

191+ -- table loading.

192+ --

193+ -- If a table load is attempted and fails, information

194+ -- about the failure will be logged to the debug log if the

195+ -- configuration specifies one. If no custom table is loaded

196+ -- (or if a load fails), the built-in character width table

197+ -- will be used.

198+ , colorMode :: Maybe ColorMode

199+ -- ^ The color mode used to know how many colors the terminal

200+ -- supports.

201+ }

202+ deriving (Show, Eq)

203+

204+defaultConfig :: Config

205+defaultConfig = mempty

206+

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

150224

151225instance Monoid Config where

152− mempty = Config

153− { vmin = Nothing

154− , vtime = Nothing

155− , mouseMode = Nothing

156− , bracketedPasteMode = Nothing

157− , debugLog = mempty

158− , inputMap = mempty

159− , inputFd = Nothing

160− , outputFd = Nothing

161− , termName = Nothing

162− }

163− mappend c0 c1 = Config

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

165− { vmin = vmin c1 <|> vmin c0

166− , vtime = vtime c1 <|> vtime c0

167− , mouseMode = mouseMode c1

168− , bracketedPasteMode = bracketedPasteMode c1

169− , debugLog = debugLog c1 <|> debugLog c0

170− , inputMap = inputMap c0 <> inputMap c1

171− , inputFd = inputFd c1 <|> inputFd c0

172− , outputFd = outputFd c1 <|> outputFd c0

173− , termName = termName c1 <|> termName c0

174− }

175−

176−-- | Config from @'getAppUserDataDirectory'/config@ and @$VTY_CONFIG_FILE@

226+ mempty =

227+ Config { vmin = Nothing

228+ , vtime = Nothing

229+ , mouseMode = Nothing

230+ , bracketedPasteMode = Nothing

231+ , debugLog = mempty

232+ , inputMap = mempty

233+ , inputFd = Nothing

234+ , outputFd = Nothing

235+ , termName = Nothing

236+ , termWidthMaps = []

237+ , allowCustomUnicodeWidthTables = Nothing

238+ , colorMode = Nothing

239+ }

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

241+ mappend = (<>)

242+#endif

243+

244+vtyDataDirectory :: IO FilePath

245+vtyDataDirectory = getAppUserDataDirectory "vty"

246+

247+vtyConfigPath :: IO FilePath

248+vtyConfigPath = do

249+ dir <- vtyDataDirectory

250+ return $ dir </> "config"

251+

252+vtyConfigFileEnvName :: String

253+vtyConfigFileEnvName = "VTY_CONFIG_FILE"

254+

255+-- | Load a configuration from 'vtyConfigPath' and @$VTY_CONFIG_FILE@.

177256userConfig :: IO Config

178257userConfig = do

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

180− overrideConfig <- maybe (return def) parseConfigFile =<< getEnv "VTY_CONFIG_FILE"

258+ configFile <- vtyConfigPath >>= parseConfigFile

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

260+ lookupEnv vtyConfigFileEnvName

181261 let base = configFile <> overrideConfig

182262 mappend base <$> overrideEnvConfig

183263

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+

184282overrideEnvConfig :: IO Config

185283overrideEnvConfig = do

186− d <- getEnv "VTY_DEBUG_LOG"

187− return $ def { debugLog = d }

284+ d <- lookupEnv "VTY_DEBUG_LOG"

285+ return $ defaultConfig { debugLog = d }

188286

189−-- | Configures VTY using defaults suitable for terminals. This action

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

190288-- can raise 'VtyConfigurationError'.

191289standardIOConfig :: IO Config

192290standardIOConfig = do

193− mb <- getEnv "TERM"

291+ mb <- lookupEnv termVariable

194292 case mb of

195293 Nothing -> throwIO VtyMissingTermEnvVar

196− Just t ->

197− return def

294+ Just t -> do

295+ mcolorMode <- detectColorMode t

296+ return defaultConfig

198297 { vmin = Just 1

199298 , mouseMode = Just False

200299 , bracketedPasteMode = Just False

@@ -202,25 +301,24 @@ standardIOConfig = do

202301 , inputFd = Just stdInput

203302 , outputFd = Just stdOutput

204303 , termName = Just t

304+ , colorMode = Just mcolorMode

205305 }

206306

207307parseConfigFile :: FilePath -> IO Config

208308parseConfigFile path = do

209309 catch (runParseConfig path <$> BS.readFile path)

210− (\(_ :: IOException) -> return def)

310+ (\(_ :: IOException) -> return defaultConfig)

211311

212312runParseConfig :: String -> BS.ByteString -> Config

213313runParseConfig name cfgTxt =

214314 case runParser parseConfig () name cfgTxt of

215315 Right cfg -> cfg

216− Left{} -> def

316+ Left{} -> defaultConfig

217317

218318------------------------------------------------------------------------

219319

220320type Parser = Parsec BS.ByteString ()

221321

222−-- I tried to use the haskellStyle here but that was specialized (without requirement?) to the

223−-- String stream type.

224322configLanguage :: Monad m => P.GenLanguageDef BS.ByteString () m

225323configLanguage = LanguageDef

226324 { commentStart = "{-"

@@ -247,13 +345,20 @@ mapDecl = do

247345 bytes <- P.stringLiteral configLexer

248346 key <- parseValue

249347 modifiers <- parseValue

250− return def { inputMap = [(termIdent, bytes, EvKey key modifiers)] }

348+ return defaultConfig { inputMap = [(termIdent, bytes, EvKey key modifiers)] }

251349

252350debugLogDecl :: Parser Config

253351debugLogDecl = do

254352 "debugLog" <- P.identifier configLexer

255353 path <- P.stringLiteral configLexer

256− return def { debugLog = Just path }

354+ return defaultConfig { debugLog = Just path }

355+

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

257362

258363ignoreLine :: Parser ()

259364ignoreLine = void $ manyTill anyChar newline

@@ -261,8 +366,8 @@ ignoreLine = void $ manyTill anyChar newline

261366parseConfig :: Parser Config

262367parseConfig = liftM mconcat $ many $ do

263368 P.whiteSpace configLexer

264− let directives = [try mapDecl, try debugLogDecl]

265− choice directives <|> (ignoreLine >> return def)

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

370+ choice directives <|> (ignoreLine >> return defaultConfig)

266371

267372class Parse a where parseValue :: Parser a

268373instance Parse Char where parseValue = P.charLiteral configLexer

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

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

308413

309414instance 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+13−14

@@ -1,29 +1,29 @@

2−module Graphics.Vty.Debug ( module Graphics.Vty.Debug

3− , module Graphics.Vty.Debug.Image

4− )

2+module Graphics.Vty.Debug

3+ ( module Graphics.Vty.Debug

4+ , module Graphics.Vty.Debug.Image

5+ )

56where

67

7−import Graphics.Vty.Prelude

8−

98import Graphics.Vty.Attributes

9+import Graphics.Vty.Image (DisplayRegion)

1010import Graphics.Vty.Debug.Image

1111import Graphics.Vty.Span

1212

13−import qualified Data.Vector as Vector

13+import qualified Data.Vector as Vector

1414

15−rowOpsEffectedColumns :: DisplayOps -> [Int]

16−rowOpsEffectedColumns ops

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

15+rowOpsAffectedColumns :: DisplayOps -> [Int]

16+rowOpsAffectedColumns ops

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

1818

1919allSpansHaveWidth :: DisplayOps -> Int -> Bool

2020allSpansHaveWidth ops expected

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

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

2222

23−spanOpsEffectedRows :: DisplayOps -> Int

24−spanOpsEffectedRows ops

23+spanOpsAffectedRows :: DisplayOps -> Int

24+spanOpsAffectedRows ops

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

26−

26+

2727type SpanConstructLog = [SpanConstructEvent]

2828data SpanConstructEvent = SpanSetAttr Attr

2929

@@ -37,4 +37,3 @@ data MockWindow = MockWindow Int Int

3737

3838regionForWindow :: MockWindow -> DisplayRegion

3939regionForWindow (MockWindow w h) = (w,h)

40−

src/Graphics/Vty/Debug/Image.hs+1−1

@@ -19,7 +19,7 @@ data ImageOp = ImageOp ImageEndo ImageEndo

1919type ImageEndo = Image -> Image

2020

2121debugImageOps :: [ImageOp]

22−debugImageOps =

22+debugImageOps =

2323 [ idImageOp

2424 -- , renderSingleColumnCharOp

2525 -- , renderDoubleColumnCharOp

src/Graphics/Vty/DisplayAttributes.hs+64−33

@@ -1,31 +1,30 @@

2−{-# LANGUAGE CPP #-}

32{-# LANGUAGE BangPatterns #-}

3+{-# LANGUAGE CPP #-}

44

5−#ifndef MIN_VERSION_base

6−#defined MIN_VERSION_base(x,y,z) 1

7−#endif

8−

9−module Graphics.Vty.DisplayAttributes

10− where

5+module Graphics.Vty.DisplayAttributes where

116

127import Graphics.Vty.Attributes

138

149import Data.Bits ((.&.))

15−

16−#if !(MIN_VERSION_base(4,8,0))

17−import Data.Monoid (Monoid(..), mconcat)

10+import Data.ByteString (ByteString)

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

12+import Data.Semigroup (Semigroup(..))

1813#endif

14+import Data.Text (Text)

15+import Data.Text.Encoding (encodeUtf8)

1916

20−-- | Given the previously applied display attributes as a FixedAttr and the current display

21−-- attributes as an Attr produces a FixedAttr that represents the current display attributes. This

22−-- is done by using the previously applied display attributes to remove the "KeepCurrent"

17+-- | Given the previously applied display attributes as a FixedAttr and

18+-- the current display attributes as an Attr produces a FixedAttr that

19+-- represents the current display attributes. This is done by using the

20+-- previously applied display attributes to remove the "KeepCurrent"

2321-- abstraction.

2422fixDisplayAttr :: FixedAttr -> Attr -> FixedAttr

2523fixDisplayAttr fattr attr

2624 = FixedAttr (fixStyle (fixedStyle fattr) (attrStyle attr))

2725 (fixColor (fixedForeColor fattr) (attrForeColor attr))

2826 (fixColor (fixedBackColor fattr) (attrBackColor attr))

27+ (fixURL (fixedURL fattr) (attrURL attr))

2928 where

3029 fixStyle _s Default = defaultStyleMask

3130 fixStyle s KeepCurrent = s

@@ -33,43 +32,56 @@ fixDisplayAttr fattr attr

3332 fixColor _c Default = Nothing

3433 fixColor c KeepCurrent = c

3534 fixColor _c (SetTo c) = Just c

35+ fixURL c KeepCurrent = c

36+ fixURL _c (SetTo n) = Just n

37+ fixURL _c Default = Nothing

3638

37−-- | difference between two display attributes. Used in the calculation of the operations required

38−-- to go from one display attribute to the next.

39+-- | difference between two display attributes. Used in the calculation

40+-- of the operations required to go from one display attribute to the

41+-- next.

3942--

40−-- Previously, vty would reset display attributes to default then apply the new display attributes.

41−-- This turned out to be very expensive: A *lot* more data would be sent to the terminal than

42−-- required.

43+-- Previously, vty would reset display attributes to default then apply

44+-- the new display attributes. This turned out to be very expensive: A

45+-- *lot* more data would be sent to the terminal than required.

4346data DisplayAttrDiff = DisplayAttrDiff

4447 { styleDiffs :: [StyleStateChange]

4548 , foreColorDiff :: DisplayColorDiff

4649 , backColorDiff :: DisplayColorDiff

50+ , urlDiff :: URLDiff

4751 }

4852 deriving (Show)

4953

50−instance Monoid DisplayAttrDiff where

51− mempty = DisplayAttrDiff [] NoColorChange NoColorChange

52− mappend d0 d1 =

54+instance Semigroup DisplayAttrDiff where

55+ d0 <> d1 =

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

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

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

56− in DisplayAttrDiff ds fcd bcd

59+ ud = simplifyUrlDiffs (urlDiff d0) (urlDiff d1)

60+ in DisplayAttrDiff ds fcd bcd ud

61+

62+instance Monoid DisplayAttrDiff where

63+ mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange

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

65+ mappend = (<>)

66+#endif

5767

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

59−--

60−-- TODO(corey): not really a simplify but a monoid instance.

6169simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]

6270simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1

6371

64−-- | Consider two display color attributes diffs. What display color attribute diff are these

65−-- equivalent to?

66−--

67−-- TODO(corey): not really a simplify but a monoid instance.

72+-- | Consider two display color attributes diffs. What display color

73+-- attribute diff are these equivalent to?

6874simplifyColorDiffs :: DisplayColorDiff -> DisplayColorDiff -> DisplayColorDiff

6975simplifyColorDiffs _cd ColorToDefault = ColorToDefault

7076simplifyColorDiffs cd NoColorChange = cd

7177simplifyColorDiffs _cd (SetColor !c) = SetColor c

7278

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+

7385-- | Difference between two display color attribute changes.

7486data DisplayColorDiff

7587 = ColorToDefault

@@ -77,11 +89,15 @@ data DisplayColorDiff

7789 | SetColor !Color

7890 deriving (Show, Eq)

7991

80−-- | Style attribute changes are transformed into a sequence of apply/removes of the individual

81−-- attributes.

82−data StyleStateChange

92+-- | Style attribute changes are transformed into a sequence of

93+-- apply/removes of the individual attributes.

94+data StyleStateChange

8395 = ApplyStandout

8496 | RemoveStandout

97+ | ApplyItalic

98+ | RemoveItalic

99+ | ApplyStrikethrough

100+ | RemoveStrikethrough

85101 | ApplyUnderline

86102 | RemoveUnderline

87103 | ApplyReverseVideo

@@ -94,15 +110,28 @@ data StyleStateChange

94110 | RemoveBold

95111 deriving (Show, Eq)

96112

97−-- | Determines the diff between two display&color attributes. This diff determines the operations

98−-- that actually get output to the terminal.

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

121+-- determines the operations that actually get output to the terminal.

99122displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff

100123displayAttrDiffs attr attr' = DisplayAttrDiff

101124 { styleDiffs = diffStyles (fixedStyle attr) (fixedStyle attr')

102125 , foreColorDiff = diffColor (fixedForeColor attr) (fixedForeColor attr')

103126 , backColorDiff = diffColor (fixedBackColor attr) (fixedBackColor attr')

127+ , urlDiff = diffURL (fixedURL attr) (fixedURL attr')

104128 }

105129

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+

106135diffColor :: Maybe Color -> Maybe Color -> DisplayColorDiff

107136diffColor Nothing (Just c') = SetColor c'

108137diffColor (Just c) (Just c')

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

116145 = mconcat

117146 [ styleDiff standout ApplyStandout RemoveStandout

118147 , styleDiff underline ApplyUnderline RemoveUnderline

148+ , styleDiff italic ApplyItalic RemoveItalic

149+ , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough

119150 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo

120151 , styleDiff blink ApplyBlink RemoveBlink

121152 , styleDiff dim ApplyDim RemoveDim

src/Graphics/Vty/Error.hs+3−3

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

1−module Graphics.Vty.Error

2− where

1+module Graphics.Vty.Error where

32

43-- | The type of exceptions specific to vty.

54--

6−-- These have fully qualified names by default since, IMO, exception handling requires this.

5+-- These have fully qualified names by default since, IMO, exception

6+-- handling requires this.

77data VtyException

88 = VtyFailure String -- ^ Uncategorized failure specific to vty.

src/Graphics/Vty/Image.hs+198−119

@@ -1,48 +1,63 @@

2−{-# LANGUAGE BangPatterns #-}

32{-# LANGUAGE NamedFieldPuns #-}

43{-# LANGUAGE DisambiguateRecordFields #-}

5−module Graphics.Vty.Image ( DisplayText

6− , Image

7− , imageWidth

8− , imageHeight

9− , horizJoin

10− , (<|>)

11− , vertJoin

12− , (<->)

13− , horizCat

14− , vertCat

15− , backgroundFill

16− , text

17− , text'

18− , char

19− , string

20− , iso10646String

21− , utf8String

22− , utf8Bytestring

23− , utf8Bytestring'

24− , charFill

25− , emptyImage

26− , safeWcwidth

27− , safeWcswidth

28− , wcwidth

29− , wcswidth

30− , crop

31− , cropRight

32− , cropLeft

33− , cropBottom

34− , cropTop

35− , pad

36− , resize

37− , resizeWidth

38− , resizeHeight

39− , translate

40− , translateX

41− , translateY

42− -- | The possible display attributes used in constructing an `Image`.

43− , module Graphics.Vty.Attributes

44− )

45− where

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

5+-- the core constructors for creating, combining, and modifying

6+-- 'Image's.

7+module Graphics.Vty.Image

8+ (

9+ -- * Images

10+ Image

11+ , imageWidth

12+ , imageHeight

13+ -- * Image constructors

14+ , emptyImage

15+ , char

16+ , string

17+ , iso10646String

18+ , utf8String

19+ , text

20+ , text'

21+ , backgroundFill

22+ , utf8Bytestring

23+ , utf8Bytestring'

24+ , charFill

25+ -- * Combinators

26+ , horizJoin

27+ , (<|>)

28+ , vertJoin

29+ , (<->)

30+ , horizCat

31+ , vertCat

32+ -- * Image modifications

33+ , crop

34+ , cropRight

35+ , cropLeft

36+ , cropBottom

37+ , cropTop

38+ , pad

39+ , resize

40+ , resizeWidth

41+ , resizeHeight

42+ , translate

43+ , translateX

44+ , translateY

45+ -- * Character width functions

46+ , safeWcwidth

47+ , safeWcswidth

48+ , safeWctwidth

49+ , safeWctlwidth

50+ , wcwidth

51+ , wcswidth

52+ , wctwidth

53+ , wctlwidth

54+ -- * Display Regions

55+ , DisplayText

56+ , DisplayRegion

57+ , regionWidth

58+ , regionHeight

59+ )

60+where

4661

4762import Graphics.Vty.Attributes

4863import Graphics.Vty.Image.Internal

@@ -56,115 +71,163 @@ import qualified Data.Text.Lazy as TL

5671import qualified Data.Text.Lazy.Encoding as TL

5772import Data.Word

5873

74+-- | A region of the display (first width, then height)

75+type DisplayRegion = (Int,Int)

76+

77+regionWidth :: DisplayRegion -> Int

78+regionWidth = fst

79+

80+regionHeight :: DisplayRegion -> Int

81+regionHeight = snd

82+

5983infixr 5 <|>

6084infixr 4 <->

6185

62−-- | An area of the picture's bacground (See Background) of w columns and h rows.

63−backgroundFill :: Int -> Int -> Image

64−backgroundFill w h

86+-- | An area of the picture's background (See 'Background').

87+backgroundFill :: Int

88+ -- ^ Fill width in columns

89+ -> Int

90+ -- ^ Fill height in rows

91+ -> Image

92+backgroundFill w h

6593 | w == 0 = EmptyImage

6694 | h == 0 = EmptyImage

6795 | otherwise = BGFill w h

6896

69−-- | Combines two images horizontally. Alias for horizJoin

97+-- | Combines two images horizontally. This is an alias for 'horizJoin'.

7098--

7199-- infixr 5

72100(<|>) :: Image -> Image -> Image

73101(<|>) = horizJoin

74102

75−-- | Combines two images vertically. Alias for vertJoin

103+-- | Combines two images vertically. This is an alias for 'vertJoin'.

76104--

77105-- infixr 4

78106(<->) :: Image -> Image -> Image

79107(<->) = vertJoin

80108

81−-- | Compose any number of images horizontally.

109+-- | Compose any number of images together horizontally, with the first

110+-- in the list being leftmost.

82111horizCat :: [Image] -> Image

83112horizCat = foldr horizJoin EmptyImage

84113

85−-- | Compose any number of images vertically.

114+-- | Compose any number of images vertically, with the first in the list

115+-- being topmost.

86116vertCat :: [Image] -> Image

87117vertCat = foldr vertJoin EmptyImage

88118

89−-- | A Data.Text.Lazy value

119+-- | Make an 'Image' from a lazy text value. The text value should be

120+-- sanitized of escape sequences (ASCII 27) and carriage returns;

121+-- otherwise layout and attribute problems may result.

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

91−text a txt = let displayWidth = safeWcswidth (TL.unpack txt)

123+text a txt = let displayWidth = safeWctlwidth txt

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

93125

94−-- | A Data.Text value

126+-- | Make an 'Image' from a text value. The text value should be

127+-- sanitized of escape sequences (ASCII 27) and carriage returns;

128+-- otherwise layout and attribute problems may result.

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

96−text' a txt = let displayWidth = safeWcswidth (T.unpack txt)

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

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

98132

99−-- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in

100−-- the ISO-10646 encoding.

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

134+-- 31-bit character assumed to be in the ISO-10646 encoding.

101135char :: Attr -> Char -> Image

102136char a c =

103137 let displayWidth = safeWcwidth c

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

105139

106−-- | A string of characters layed out on a single row with the same display attribute. The string is

107−-- assumed to be a sequence of ISO-10646 characters.

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

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

142+-- sequence of ISO-10646 characters. The input string should be

143+-- sanitized of escape sequences (ASCII 27) and carriage returns;

144+-- otherwise layout and attribute problems may result.

108145--

109−-- Note: depending on how the Haskell compiler represents string literals a string literal in a

110−-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string.

111−-- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry

112−-- about the encoding format when outputting string literals. Just provide the string literal

113−-- directly to iso10646String or string.

114−--

146+-- Note: depending on how the Haskell compiler represents string

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

148+-- example, may be represented as a ISO-10646 string. That is, I think,

149+-- the case with GHC 6.10. This means, for the most part, you don't need

150+-- to worry about the encoding format when outputting string literals.

151+-- Just provide the string literal directly to iso10646String or string.

115152iso10646String :: Attr -> String -> Image

116153iso10646String a str =

117154 let displayWidth = safeWcswidth str

118155 in HorizText a (TL.pack str) displayWidth (length str)

119156

120−-- | Alias for iso10646String. Since the usual case is that a literal string like "foo" is

121−-- represented internally as a list of ISO 10646 31 bit characters.

157+-- | Make an 'Image' from a 'String'.

122158--

123−-- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while

124−-- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime

125−-- representation.

159+-- This is an alias for iso10646String since the usual case is that a

160+-- literal string like "foo" is represented internally as a list of ISO

161+-- 10646 31 bit characters.

162+--

163+-- Note: Keep in mind that GHC will compile source encoded as UTF-8

164+-- but the literal strings, while UTF-8 encoded in the source, will be

165+-- transcoded to a ISO 10646 31 bit characters runtime representation.

126166string :: Attr -> String -> Image

127167string = iso10646String

128168

129−-- | A string of characters layed out on a single row. The input is assumed to be the bytes for

130−-- UTF-8 encoded text.

169+-- | Make an 'Image' from a string of characters layed out on a single

170+-- row. The input is assumed to be the bytes for UTF-8 encoded text.

131171utf8String :: Attr -> [Word8] -> Image

132172utf8String a bytes = utf8Bytestring a (BL.pack bytes)

133173

134−-- | Renders a UTF-8 encoded lazy bytestring.

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

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

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

137177

138−-- | Renders a UTF-8 encoded strict bytestring.

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

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

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

141181

142−-- | creates a fill of the specified character. The dimensions are in number of characters wide and

143−-- number of rows high.

144−charFill :: Integral d => Attr -> Char -> d -> d -> Image

145−charFill _a _c 0 _h = EmptyImage

146−charFill _a _c _w 0 = EmptyImage

147−charFill a c w h =

148− vertCat $ replicate (fromIntegral h) $ HorizText a txt displayWidth charWidth

149− where

150− txt = TL.replicate (fromIntegral w) (TL.singleton c)

151− displayWidth = safeWcwidth c * (fromIntegral w)

152− charWidth = fromIntegral w

153−

154−-- | The empty image. Useful for fold combinators. These occupy no space nor define any display

155−-- attributes.

156−emptyImage :: Image

182+-- | Make an image filling a region with the specified character.

183+--

184+-- If either the width or height are less than or equal to 0, then

185+-- the result is the empty image.

186+charFill :: Integral d

187+ => Attr

188+ -- ^ The attribute to use.

189+ -> Char

190+ -- ^ The character to use in filling the region.

191+ -> d

192+ -- ^ The region width.

193+ -> d

194+ -- ^ The region height.

195+ -> Image

196+charFill a c w h

197+ | w <= 0 || h <= 0 = EmptyImage

198+ | otherwise = vertCat

199+ $ replicate (fromIntegral h)

200+ $ HorizText a txt displayWidth charWidth

201+ where

202+ txt = TL.replicate charWidth (TL.singleton c)

203+ displayWidth = safeWcwidth c * charWidth

204+

205+ charWidth :: Num a => a

206+ charWidth = fromIntegral w

207+

208+-- | The empty image. Useful for fold combinators. These occupy no space

209+-- and do not affect display attributes.

210+emptyImage :: Image

157211emptyImage = EmptyImage

158212

159−-- | pad the given image. This adds background character fills to the left, top, right, bottom.

160−-- The pad values are how many display columns or rows to add.

161−pad :: Int -> Int -> Int -> Int -> Image -> Image

213+-- | Pad the given image. This adds background character fills to the

214+-- left, top, right, bottom.

215+pad :: Int

216+ -- ^ How much padding to add to the left side of the image.

217+ -> Int

218+ -- ^ How much padding to add to the top of the image.

219+ -> Int

220+ -- ^ How much padding to add to the right side of the image.

221+ -> Int

222+ -- ^ How much padding to add to the bottom of the image.

223+ -> Image

224+ -- ^ The image to pad.

225+ -> Image

162226pad 0 0 0 0 i = i

163227pad inL inT inR inB inImage

164228 | inL < 0 || inT < 0 || inR < 0 || inB < 0 = error "cannot pad by negative amount"

165229 | otherwise = go inL inT inR inB inImage

166− where

167− -- TODO: uh.

230+ where

168231 go 0 0 0 0 i = i

169232 go 0 0 0 b i = VertJoin i (BGFill w b) w h

170233 where w = imageWidth i

@@ -179,40 +242,53 @@ pad inL inT inR inB inImage

179242 where w = imageWidth i + l

180243 h = imageHeight i

181244

182−-- | translates an image by padding or cropping the left and top. First param is amount to translate

183−-- left. Second param is amount to translate top.

245+-- | Translates an image by padding or cropping the left and top.

184246--

185−-- This can have an unexpected effect: Translating an image to less than (0,0) then to greater than

186−-- (0,0) will crop the image.

187−translate :: Int -> Int -> Image -> Image

247+-- If translation offsets are negative then the image is cropped.

248+translate :: Int

249+ -- ^ The horizontal translation offset (can be negative)

250+ -> Int

251+ -- ^ The vertical translation offset (can be negative)

252+ -> Image

253+ -- ^ The image to translate.

254+ -> Image

188255translate x y i = translateX x (translateY y i)

189256

190−-- | translates an image by padding or cropping the left

257+-- | Translates an image by padding or cropping its left side.

191258translateX :: Int -> Image -> Image

192259translateX x i

260+ | x < 0 && (abs x > imageWidth i) = emptyImage

193261 | x < 0 = let s = abs x in CropLeft i s (imageWidth i - s) (imageHeight i)

194262 | x == 0 = i

195263 | otherwise = let h = imageHeight i in HorizJoin (BGFill x h) i (imageWidth i + x) h

196264

197−-- | translates an image by padding or cropping the top

265+-- | Translates an image by padding or cropping its top.

198266translateY :: Int -> Image -> Image

199267translateY y i

268+ | y < 0 && (abs y > imageHeight i) = emptyImage

200269 | y < 0 = let s = abs y in CropTop i s (imageWidth i) (imageHeight i - s)

201270 | y == 0 = i

202271 | otherwise = let w = imageWidth i in VertJoin (BGFill w y) i w (imageHeight i + y)

203272

204−-- | Ensure an image is no larger than the provided size. If the image is larger then crop the right

205−-- or bottom.

273+-- | Ensure an image is no larger than the provided size. If the image

274+-- is larger then crop the right or bottom.

206275--

207−-- This is transformed to a vertical crop from the bottom followed by horizontal crop from the

208−-- right.

209−crop :: Int -> Int -> Image -> Image

276+-- This is equivalent to a vertical crop from the bottom followed by

277+-- horizontal crop from the right.

278+crop :: Int

279+ -- ^ Cropping width

280+ -> Int

281+ -- ^ Cropping height

282+ -> Image

283+ -- ^ The image to crop

284+ -> Image

210285crop 0 _ _ = EmptyImage

211286crop _ 0 _ = EmptyImage

212287crop w h i = cropBottom h (cropRight w i)

213288

214−-- | crop the display height. If the image is less than or equal in height then this operation has

215−-- no effect. Otherwise the image is cropped from the bottom.

289+-- | Crop an image's height. If the image's height is less than or equal

290+-- to the specified height then this operation has no effect. Otherwise

291+-- the image is cropped from the bottom.

216292cropBottom :: Int -> Image -> Image

217293cropBottom 0 _ = EmptyImage

218294cropBottom h inI

@@ -227,8 +303,9 @@ cropBottom h inI

227303 | h >= imageHeight i = i

228304 | otherwise = CropBottom i (imageWidth i) h

229305

230−-- | ensure the image is no wider than the given width. If the image is wider then crop the right

231−-- side.

306+-- | Crop an image's width. If the image's width is less than or equal

307+-- to the specified width then this operation has no effect. Otherwise

308+-- the image is cropped from the right.

232309cropRight :: Int -> Image -> Image

233310cropRight 0 _ = EmptyImage

234311cropRight w inI

@@ -243,8 +320,9 @@ cropRight w inI

243320 | w >= imageWidth i = i

244321 | otherwise = CropRight i w (imageHeight i)

245322

246−-- | ensure the image is no wider than the given width. If the image is wider then crop the left

247−-- side.

323+-- | Crop an image's width. If the image's width is less than or equal

324+-- to the specified width then this operation has no effect. Otherwise

325+-- the image is cropped from the left.

248326cropLeft :: Int -> Image -> Image

249327cropLeft 0 _ = EmptyImage

250328cropLeft w inI

@@ -261,8 +339,9 @@ cropLeft w inI

261339 | imageWidth i <= w = i

262340 | otherwise = CropLeft i (imageWidth i - w) w (imageHeight i)

263341

264−-- | crop the display height. If the image is less than or equal in height then this operation has

265−-- no effect. Otherwise the image is cropped from the top.

342+-- | Crop an image's height. If the image's height is less than or equal

343+-- to the specified height then this operation has no effect. Otherwise

344+-- the image is cropped from the top.

266345cropTop :: Int -> Image -> Image

267346cropTop 0 _ = EmptyImage

268347cropTop h inI

@@ -279,24 +358,24 @@ cropTop h inI

279358 | imageHeight i <= h = i

280359 | otherwise = CropTop i (imageHeight i - h) (imageWidth i) h

281360

282−-- | Generic resize. Pads and crops as required to assure the given display width and height.

283−-- This is biased to pad/crop the right and bottom.

361+-- | Generic resize. Pads and crops are added to ensure that the

362+-- resulting image matches the specified dimensions. This is biased to

363+-- pad/crop the right and bottom.

284364resize :: Int -> Int -> Image -> Image

285365resize w h i = resizeHeight h (resizeWidth w i)

286366

287−-- | Resize the width. Pads and crops as required to assure the given display width.

288−-- This is biased to pad/crop the right.

367+-- | Resize the width. Pads and crops as required to assure the given

368+-- display width. This is biased to pad/crop on the right.

289369resizeWidth :: Int -> Image -> Image

290370resizeWidth w i = case w `compare` imageWidth i of

291371 LT -> cropRight w i

292372 EQ -> i

293373 GT -> i <|> BGFill (w - imageWidth i) (imageHeight i)

294374

295−-- | Resize the height. Pads and crops as required to assure the given display height.

296−-- This is biased to pad/crop the bottom.

375+-- | Resize the height. Pads and crops as required to assure the given

376+-- display height. This is biased to pad/crop on the bottom.

297377resizeHeight :: Int -> Image -> Image

298378resizeHeight h i = case h `compare` imageHeight i of

299379 LT -> cropBottom h i

300380 EQ -> i

301381 GT -> i <-> BGFill (imageWidth i) (h - imageHeight i)

302−

src/Graphics/Vty/Image/Internal.hs+72−92

@@ -3,10 +3,6 @@

33{-# LANGUAGE DeriveGeneric #-}

44{-# OPTIONS_HADDOCK hide #-}

55

6−#ifndef MIN_VERSION_base

7−#defined MIN_VERSION_base(x,y,z) 1

8−#endif

9−

106module Graphics.Vty.Image.Internal where

117

128import Graphics.Vty.Attributes

@@ -16,24 +12,14 @@ import GHC.Generics

1612

1713import Control.DeepSeq

1814

19−import qualified Data.Text.Lazy as TL

20−

21−#if !(MIN_VERSION_base(4,8,0))

22−import Data.Monoid

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

16+import Data.Semigroup (Semigroup(..))

2317#endif

18+import qualified Data.Text.Lazy as TL

2419

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

26−--

27−-- TODO(corey): hm. there is an explicit equation for each type which goes to a lazy text. Each

28−-- application probably uses a single type. Perhaps parameterize the entire vty interface by the

29−-- input text type?

30−-- TODO: Try using a builder instead of a TL.Text instance directly. That might improve performance

31−-- for the usual case of appending a bunch of characters with the same attribute together.

3221type DisplayText = TL.Text

3322

34−-- TODO: store a skip list in HorizText(?)

35−-- TODO: represent display strings containing chars that are not 1 column chars as a separate

36−-- display string value?

3723clipText :: DisplayText -> Int -> Int -> DisplayText

3824clipText txt leftSkip rightClip =

3925 -- CPS would clarify this I think

@@ -42,8 +28,8 @@ clipText txt leftSkip rightClip =

4228 (toTake,padSuffix) = clipForCharWidth rightClip txt' 0

4329 txt'' = TL.append (TL.take toTake txt') (if padSuffix then TL.singleton '…' else TL.empty)

4430 -- Note: some characters and zero-width and combining characters

45− -- combine to the left, so keep taking characters even if the width

46− -- is zero.

31+ -- combine to the left, so keep taking characters even if the

32+ -- width is zero.

4733 clipForCharWidth w t n

4834 | TL.null t = (n, False)

4935 | w < cw = (n, w /= 0)

@@ -51,8 +37,8 @@ clipText txt leftSkip rightClip =

5137 where cw = safeWcwidth (TL.head t)

5238 in txt''

5339

54−-- | This is the internal representation of Images. Use the constructors in "Graphics.Vty.Image" to

55−-- create instances.

40+-- | This is the internal representation of Images. Use the constructors

41+-- in "Graphics.Vty.Image" to create instances.

5642--

5743-- Images are:

5844--

@@ -65,49 +51,61 @@ clipText txt leftSkip rightClip =

6551-- * a cropped image

6652--

6753-- * an empty image of no size or content.

68−data Image =

54+data Image =

6955 -- | A horizontal text span has a row height of 1.

7056 HorizText

7157 { attr :: Attr

72− -- | The text to display. The display width of the text is always outputWidth.

58+ -- | The text to display. The display width of the text is always

59+ -- outputWidth.

7360 , displayText :: DisplayText

7461 -- | The number of display columns for the text.

7562 , outputWidth :: Int

7663 -- | the number of characters in the text.

7764 , charWidth :: Int

7865 }

79− -- | A horizontal join can be constructed between any two images. However a HorizJoin instance is

80− -- required to be between two images of equal height. The horizJoin constructor adds background

81− -- fills to the provided images that assure this is true for the HorizJoin value produced.

66+ -- | A horizontal join can be constructed between any two images.

67+ -- However a HorizJoin instance is required to be between two images

68+ -- of equal height. The horizJoin constructor adds background fills

69+ -- to the provided images that assure this is true for the HorizJoin

70+ -- value produced.

8271 | HorizJoin

83− { partLeft :: Image

72+ { partLeft :: Image

8473 , partRight :: Image

85− , outputWidth :: Int -- ^ imageWidth partLeft == imageWidth partRight. Always > 0

86− , outputHeight :: Int -- ^ imageHeight partLeft == imageHeight partRight. Always > 0

74+ , outputWidth :: Int

75+ -- ^ imageWidth partLeft == imageWidth partRight. Always > 0

76+ , outputHeight :: Int

77+ -- ^ imageHeight partLeft == imageHeight partRight. Always > 0

8778 }

88− -- | A veritical join can be constructed between any two images. However a VertJoin instance is

89− -- required to be between two images of equal width. The vertJoin constructor adds background

90− -- fills to the provides images that assure this is true for the VertJoin value produced.

79+ -- | A veritical join can be constructed between any two images.

80+ -- However a VertJoin instance is required to be between two images

81+ -- of equal width. The vertJoin constructor adds background fills

82+ -- to the provides images that assure this is true for the VertJoin

83+ -- value produced.

9184 | VertJoin

9285 { partTop :: Image

9386 , partBottom :: Image

94− , outputWidth :: Int -- ^ imageWidth partTop == imageWidth partBottom. always > 0

95− , outputHeight :: Int -- ^ imageHeight partTop == imageHeight partBottom. always > 1

87+ , outputWidth :: Int

88+ -- ^ imageWidth partTop == imageWidth partBottom. always > 0

89+ , outputHeight :: Int

90+ -- ^ imageHeight partTop == imageHeight partBottom. always > 1

9691 }

97− -- | A background fill will be filled with the background char. The background char is

98− -- defined as a property of the Picture this Image is used to form.

92+ -- | A background fill will be filled with the background char. The

93+ -- background char is defined as a property of the Picture this

94+ -- Image is used to form.

9995 | BGFill

10096 { outputWidth :: Int -- ^ always > 0

10197 , outputHeight :: Int -- ^ always > 0

10298 }

103− -- | Crop an image horizontally to a size by reducing the size from the right.

99+ -- | Crop an image horizontally to a size by reducing the size from

100+ -- the right.

104101 | CropRight

105102 { croppedImage :: Image

106103 -- | Always < imageWidth croppedImage > 0

107104 , outputWidth :: Int

108105 , outputHeight :: Int -- ^ imageHeight croppedImage

109106 }

110− -- | Crop an image horizontally to a size by reducing the size from the left.

107+ -- | Crop an image horizontally to a size by reducing the size from

108+ -- the left.

111109 | CropLeft

112110 { croppedImage :: Image

113111 -- | Always < imageWidth croppedImage > 0

@@ -116,7 +114,8 @@ data Image =

116114 , outputWidth :: Int

117115 , outputHeight :: Int

118116 }

119− -- | Crop an image vertically to a size by reducing the size from the bottom

117+ -- | Crop an image vertically to a size by reducing the size from

118+ -- the bottom

120119 | CropBottom

121120 { croppedImage :: Image

122121 -- | imageWidth croppedImage

@@ -124,7 +123,8 @@ data Image =

124123 -- | height image is cropped to. Always < imageHeight croppedImage > 0

125124 , outputHeight :: Int

126125 }

127− -- | Crop an image vertically to a size by reducing the size from the top

126+ -- | Crop an image vertically to a size by reducing the size from

127+ -- the top

128128 | CropTop

129129 { croppedImage :: Image

130130 -- | Always < imageHeight croppedImage > 0

@@ -136,43 +136,17 @@ data Image =

136136 }

137137 -- | The empty image

138138 --

139− -- The combining operators identity constant.

139+ -- The combining operators identity constant.

140140 -- EmptyImage <|> a = a

141141 -- EmptyImage <-> a = a

142− --

142+ --

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

144144 | EmptyImage

145− deriving (Eq, Generic)

146−

147−instance Show Image where

148− show ( HorizText { attr, displayText, outputWidth, charWidth } )

149− = "HorizText " ++ show displayText

150− ++ "@(" ++ show attr ++ ","

151− ++ show outputWidth ++ ","

152− ++ show charWidth ++ ")"

153− show ( BGFill { outputWidth, outputHeight } )

154− = "BGFill (" ++ show outputWidth ++ "," ++ show outputHeight ++ ")"

155− show ( HorizJoin { partLeft = l, partRight = r, outputWidth = c } )

156− = "HorizJoin " ++ show c ++ " (" ++ show l ++ " <|> " ++ show r ++ ")"

157− show ( VertJoin { partTop = t, partBottom = b, outputWidth = c, outputHeight = r } )

158− = "VertJoin [" ++ show c ++ ", " ++ show r ++ "] (" ++ show t ++ ") <-> (" ++ show b ++ ")"

159− show ( CropRight { croppedImage, outputWidth, outputHeight } )

160− = "CropRight [" ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

161− ++ " (" ++ show croppedImage ++ ")"

162− show ( CropLeft { croppedImage, leftSkip, outputWidth, outputHeight } )

163− = "CropLeft [" ++ show leftSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

164− ++ " (" ++ show croppedImage ++ ")"

165− show ( CropBottom { croppedImage, outputWidth, outputHeight } )

166− = "CropBottom [" ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

167− ++ " (" ++ show croppedImage ++ ")"

168− show ( CropTop { croppedImage, topSkip, outputWidth, outputHeight } )

169− = "CropTop [" ++ show topSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

170− ++ " (" ++ show croppedImage ++ ")"

171− show ( EmptyImage ) = "EmptyImage"

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

172146

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

174148ppImageStructure :: Image -> String

175−ppImageStructure inImg = go 0 inImg

149+ppImageStructure = go 0

176150 where

177151 go indent img = tab indent ++ pp indent img

178152 tab indent = concat $ replicate indent " "

@@ -198,7 +172,7 @@ ppImageStructure inImg = go 0 inImg

198172 = "CropTop("++ show outputWidth ++ "," ++ show topSkip ++ "->" ++ show outputHeight ++ ")\n"

199173 ++ go (i+1) croppedImage

200174 pp _ EmptyImage = "EmptyImage"

201−

175+

202176instance NFData Image where

203177 rnf EmptyImage = ()

204178 rnf (CropRight i w h) = i `deepseq` w `seq` h `seq` ()

@@ -210,7 +184,8 @@ instance NFData Image where

210184 rnf (HorizJoin l r w h) = l `deepseq` r `deepseq` w `seq` h `seq` ()

211185 rnf (HorizText a s w cw) = a `seq` s `deepseq` w `seq` cw `seq` ()

212186

213−-- | The width of an Image. This is the number display columns the image will occupy.

187+-- | The width of an Image. This is the number display columns the image

188+-- will occupy.

214189imageWidth :: Image -> Int

215190imageWidth HorizText { outputWidth = w } = w

216191imageWidth HorizJoin { outputWidth = w } = w

@@ -222,7 +197,8 @@ imageWidth CropBottom { outputWidth = w } = w

222197imageWidth CropTop { outputWidth = w } = w

223198imageWidth EmptyImage = 0

224199

225−-- | The height of an Image. This is the number of display rows the image will occupy.

200+-- | The height of an Image. This is the number of display rows the

201+-- image will occupy.

226202imageHeight :: Image -> Int

227203imageHeight HorizText {} = 1

228204imageHeight HorizJoin { outputHeight = h } = h

@@ -234,27 +210,32 @@ imageHeight CropBottom { outputHeight = h } = h

234210imageHeight CropTop { outputHeight = h } = h

235211imageHeight EmptyImage = 0

236212

237−-- | Append in the Monoid instance is equivalent to <->.

213+-- | Append in the 'Semigroup' instance is equivalent to '<->'.

214+instance Semigroup Image where

215+ (<>) = vertJoin

216+

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

238218instance Monoid Image where

239219 mempty = EmptyImage

240− mappend = vertJoin

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

221+ mappend = (<>)

222+#endif

241223

242224-- | combines two images side by side

243225--

244−-- Combines text chunks where possible. Assures outputWidth and outputHeight properties are not

245−-- violated.

246−--

247−-- The result image will have a width equal to the sum of the two images width. And the height will

248−-- equal the largest height of the two images. The area not defined in one image due to a height

249−-- missmatch will be filled with the background pattern.

226+-- Combines text chunks where possible. Assures outputWidth and

227+-- outputHeight properties are not violated.

250228--

251−-- TODO: the bg fill is biased towards top to bottom languages(?)

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

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

232+-- will be filled with the background pattern.

252233horizJoin :: Image -> Image -> Image

253234horizJoin EmptyImage i = i

254235horizJoin i EmptyImage = i

255236horizJoin i0@(HorizText a0 t0 w0 cw0) i1@(HorizText a1 t1 w1 cw1)

256237 | a0 == a1 = HorizText a0 (TL.append t0 t1) (w0 + w1) (cw0 + cw1)

257− -- TODO: assumes horiz text height is always 1

238+ -- assumes horiz text height is always 1

258239 | otherwise = HorizJoin i0 i1 (w0 + w1) 1

259240horizJoin i0 i1

260241 -- If the images are of the same height then no padding is required

@@ -276,19 +257,19 @@ horizJoin _ _ = error "horizJoin applied to undefined values."

276257

277258-- | combines two images vertically

278259--

279−-- The result image will have a height equal to the sum of the heights of both images.

280−-- The width will equal the largest width of the two images.

281−-- The area not defined in one image due to a width missmatch will be filled with the background

282−-- pattern.

283−--

284−-- TODO: the bg fill is biased towards right to left languages(?)

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

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

263+-- will be filled with the background pattern.

285264vertJoin :: Image -> Image -> Image

286265vertJoin EmptyImage i = i

287266vertJoin i EmptyImage = i

288267vertJoin i0 i1

289− -- If the images are of the same width then no background padding is required

268+ -- If the images are of the same width then no background padding is

269+ -- required

290270 | w0 == w1 = VertJoin i0 i1 w0 h

291− -- Otherwise one of the images needs to be padded to the size of the other image.

271+ -- Otherwise one of the images needs to be padded to the size of the

272+ -- other image.

292273 | w0 < w1

293274 = let padAmount = w1 - w0

294275 in VertJoin (HorizJoin i0 (BGFill padAmount h0) w1 h0) i1 w1 h

@@ -302,4 +283,3 @@ vertJoin i0 i1

302283 h1 = imageHeight i1

303284 h = h0 + h1

304285vertJoin _ _ = error "vertJoin applied to undefined values."

305−

src/Graphics/Vty/Inline.hs+62−55

@@ -1,45 +1,41 @@

1−-- | The inline module provides a limited interface to changing the style of terminal output. The

2−-- intention is for this interface to be used inline with other output systems.

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

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

3+-- used inline with other output systems.

34--

4−-- The changes specified by the InlineM monad are applied to the terminals display attributes. These

5−-- display attributes effect the display of all following text output to the terminal file

6−-- descriptor.

5+-- The changes specified by the InlineM monad are applied to the

6+-- terminal's display attributes. These display attributes affect the

7+-- display of all following text output to the terminal file descriptor.

78--

8−-- For example, in an IO monad the following code with print the text \"Not styled. \" Followed by the

9−-- text \" Styled! \" drawn over a red background and underlined.

9+-- For example, in an IO monad the following code will print the text

10+-- \"Not styled. \" Followed by the text \" Styled! \" drawn over a red

11+-- background and underlined.

1012--

1113-- @

1214-- putStr \"Not styled. \"

1315-- putAttrChange_ $ do

14−-- backColor red

16+-- backColor red

1517-- applyStyle underline

1618-- putStr \" Styled! \"

1719-- putAttrChange_ $ defaultAll

1820-- putStrLn \"Not styled.\"

1921-- @

2022--

21−-- 'putAttrChange' outputs the control codes to the terminal device 'Handle'. This is a duplicate

22−-- of the 'stdout' handle when the 'terminalHandle' was (first) acquired. If 'stdout' has since been

23−-- changed then 'putStr', 'putStrLn', 'print' etc.. will output to a different 'Handle' than

24−-- 'putAttrChange'

23+-- 'putAttrChange' emits the control codes to the terminal device

24+-- attached to 'Handle'. This is a duplicate of the 'stdout' handle when

25+-- the 'terminalHandle' was (first) acquired. If 'stdout' has since been

26+-- changed then 'putStr', 'putStrLn', 'print' etc. will output to a

27+-- different 'Handle' than 'putAttrChange'.

2528--

27−{-# LANGUAGE CPP #-}

28−{-# LANGUAGE BangPatterns #-}

29−

30−#ifndef MIN_VERSION_base

31−#defined MIN_VERSION_base(x,y,z) 1

32−#endif

33−

34−module Graphics.Vty.Inline ( module Graphics.Vty.Inline

35− , withVty

36− )

37− where

30+module Graphics.Vty.Inline

31+ ( module Graphics.Vty.Inline

32+ , withVty

33+ )

34+where

3835

3936import Graphics.Vty

4037import Graphics.Vty.DisplayAttributes

4138import Graphics.Vty.Inline.Unsafe

42−import Graphics.Vty.Output.Interface

4339

4440import Blaze.ByteString.Builder (writeToByteString)

4541

@@ -50,44 +46,55 @@ import Data.IORef

5046

5147import System.IO

5248

53−#if !(MIN_VERSION_base(4,8,0))

54−import Control.Applicative

55−import Data.Monoid ( mappend )

56−#endif

49+type InlineM v = State InlineState v

5750

58−type InlineM v = State Attr v

51+data InlineState =

52+ InlineState { inlineAttr :: Attr

53+ , inlineUrlsEnabled :: Bool

54+ }

5955

60−-- | Set the background color to the provided 'Color'

56+-- | Set the background color to the provided 'Color'.

6157backColor :: Color -> InlineM ()

62−backColor c = modify $ flip mappend ( currentAttr `withBackColor` c )

58+backColor c = modify $ \s ->

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

60+ }

6361

64−-- | Set the foreground color to the provided 'Color'

62+-- | Set the foreground color to the provided 'Color'.

6563foreColor :: Color -> InlineM ()

66−foreColor c = modify $ flip mappend ( currentAttr `withForeColor` c )

64+foreColor c = modify $ \s ->

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

66+ }

6767

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

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

6969--

70−-- If the terminal does not support the style change no error is produced. The style can still be

71−-- removed.

70+-- If the terminal does not support the style change then no error is

71+-- produced. The style can still be removed.

7272applyStyle :: Style -> InlineM ()

73−applyStyle s = modify $ flip mappend ( currentAttr `withStyle` s )

73+applyStyle st = modify $ \s ->

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

75+ }

7476

75−-- | Attempt to remove the specified 'Style' from the display of the following text.

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

78+-- following text.

7679--

77−-- This will fail if applyStyle for the given style has not been previously called.

80+-- This will fail if 'applyStyle' for the given style has not been

81+-- previously called.

7882removeStyle :: Style -> InlineM ()

79−removeStyle sMask = modify $ \attr ->

80− let style' = case attrStyle attr of

81− Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

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

83− SetTo s -> s .&. complement sMask

84− in attr { attrStyle = SetTo style' }

85−

86−-- | Reset the display attributes

83+removeStyle sMask = modify $ \s ->

84+ s { inlineAttr =

85+ let style' = case attrStyle (inlineAttr s) of

86+ Default -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."

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

88+ SetTo st -> st .&. complement sMask

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

90+ }

91+

92+-- | Reset the display attributes.

8793defaultAll :: InlineM ()

88−defaultAll = put defAttr

94+defaultAll = modify $ \s -> s { inlineAttr = defAttr }

8995

90−-- | Apply the provided display attribute changes to the given terminal output device.

96+-- | Apply the provided display attribute changes to the given terminal

97+-- output device.

9198--

9299-- This does not flush the terminal.

93100putAttrChange :: ( Applicative m, MonadIO m ) => Output -> InlineM () -> m ()

@@ -97,19 +104,19 @@ putAttrChange out c = liftIO $ do

97104 mfattr <- prevFattr <$> readIORef (assumedStateRef out)

98105 fattr <- case mfattr of

99106 Nothing -> do

100− liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc

101− return $ FixedAttr defaultStyleMask Nothing Nothing

107+ liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc False

108+ return $ FixedAttr defaultStyleMask Nothing Nothing Nothing

102109 Just v -> return v

103− let attr = execState c currentAttr

110+ let InlineState attr urlsEnabled = execState c (InlineState currentAttr False)

104111 attr' = limitAttrForDisplay out attr

105112 fattr' = fixDisplayAttr fattr attr'

106113 diffs = displayAttrDiffs fattr fattr'

107− outputByteBuffer out $ writeToByteString $ writeSetAttr dc fattr attr' diffs

114+ outputByteBuffer out $ writeToByteString $ writeSetAttr dc urlsEnabled fattr attr' diffs

108115 modifyIORef (assumedStateRef out) $ \s -> s { prevFattr = Just fattr' }

109116 inlineHack dc

110117

111−-- | Apply the provided display attributes changes to the terminal output device that was current at

112−-- the time this was first used. Which, for most use cases, is the current terminal.

118+-- | Apply the provided display attributes changes to the terminal

119+-- output device.

113120--

114121-- This will flush the terminal output.

115122putAttrChange_ :: ( Applicative m, MonadIO m ) => InlineM () -> m ()

src/Graphics/Vty/Inline/Unsafe.hs+4−14

@@ -1,16 +1,9 @@

1−{-# LANGUAGE CPP #-}

21{-# OPTIONS_HADDOCK hide #-}

32

4−#ifndef MIN_VERSION_base

5−#defined MIN_VERSION_base(x,y,z) 1

6−#endif

7−

83module Graphics.Vty.Inline.Unsafe where

94

105import Graphics.Vty

116

12−import Data.Default

13−import Data.Monoid

147import Data.IORef

158

169import GHC.IO.Handle (hDuplicate)

@@ -21,10 +14,6 @@ import System.IO.Unsafe

2114

2215import System.Posix.IO (handleToFd)

2316

24−#if !(MIN_VERSION_base(4,8,0))

25−import Control.Applicative

26−#endif

27−

2817globalVty :: IORef (Maybe Vty)

2918{-# NOINLINE globalVty #-}

3019globalVty = unsafePerformIO $ newIORef Nothing

@@ -39,10 +28,11 @@ mkDupeConfig = do

3928 hSetBuffering stdin NoBuffering

4029 stdinDupe <- hDuplicate stdin >>= handleToFd

4130 stdoutDupe <- hDuplicate stdout >>= handleToFd

42− return $ def { inputFd = Just stdinDupe, outputFd = Just stdoutDupe }

31+ return $ defaultConfig { inputFd = Just stdinDupe, outputFd = Just stdoutDupe }

4332

44−-- | This will create a Vty instance using 'mkVty' and execute an IO action provided that instance.

45−-- The created Vty instance will be stored to the unsafe 'IORef' 'globalVty'.

33+-- | This will create a Vty instance using 'mkVty' and execute an IO

34+-- action provided that instance. The created Vty instance will be

35+-- stored to the unsafe 'IORef' 'globalVty'.

4636--

4737-- This instance will use duplicates of the stdin and stdout Handles.

4838withVty :: (Vty -> IO b) -> IO b

src/Graphics/Vty/Input.hs+97−127

@@ -1,135 +1,125 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE RecordWildCards #-}

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

32

4−#ifndef MIN_VERSION_base

5−#defined MIN_VERSION_base(x,y,z) 1

6−#endif

7−

8−-- | The input layer for VTY. This provides methods for initializing an 'Input' structure which can

9−-- then be used to read 'Event's from the terminal.

10−--

11−-- The history of terminals has resulted in a broken input process. Some keys and combinations will

12−-- not reliably map to the expected events by any terminal program. Even those not using vty. There

13−-- is no 1:1 mapping from key events to bytes read from the terminal input device. In very limited

14−-- cases the terminal and vty's input process can be customized to resolve these issues.

15−--

16−-- See "Graphics.Vty.Config" for how to configure vty's input processing. Customizing terminfo and

17−-- the terminal is beyond the scope of this documentation.

3+-- | This module provides the input layer for Vty, including methods

4+-- for initializing an 'Input' structure and reading 'Event's from the

5+-- terminal.

6+--

7+-- Note that due to the evolution of terminal emulators, some keys

8+-- and combinations will not reliably map to the expected events by

9+-- any terminal program. There is no 1:1 mapping from key events to

10+-- bytes read from the terminal input device. In very limited cases the

11+-- terminal and vty's input process can be customized to resolve these

12+-- issues; see "Graphics.Vty.Config" for how to configure vty's input

13+-- processing.

1814--

1915-- = VTY's Implementation

2016--

21−-- One can get the brain rot trying to understand all this. So, as far as I can care...

22−--

2317-- There are two input modes:

2418--

25−-- 1. 7 bit

19+-- 1. 7-bit

2620--

27−-- 2. 8 bit

21+-- 2. 8-bit

2822--

29−-- 7 bit input is the default and the expected in most use cases. This is what vty uses.

23+-- The 7-bit input mode is the default and the expected mode in most use

24+-- cases. This is what Vty uses.

3025--

31−-- == 7 bit input encoding

26+-- == 7-bit input encoding

3227--

33−-- Control key combinations are represented by masking the two high bits of the 7bit input. Back in

34−-- the day the control key actually grounded the two high bit wires: 6 and 7. This is why

35−-- control key combos map to single character events: The input bytes are identical. The input byte

36−-- is the bit encoding of the character with bits 6 and 7 masked. Bit 6 is set by shift. Bit 6 and

37−-- 7 are masked by control. EG:

28+-- Control key combinations are represented by masking the two high bits

29+-- of the 7-bit input. Historically the control key actually grounded

30+-- the two high bit wires: 6 and 7. This is why control key combos

31+-- map to single character events: the input bytes are identical. The

32+-- input byte is the bit encoding of the character with bits 6 and 7

33+-- masked. Bit 6 is set by shift. Bit 6 and 7 are masked by control. For

34+-- example,

3835--

39−-- * Control-I is 'i', `01101001`, has bit 6 and 7 masked to become `00001001`. Which is the ASCII

40−-- and UTF-8 encoding of the tab key.

36+-- * Control-I is 'i', `01101001`, and has bit 6 and 7 masked to become

37+-- `00001001`, which is the ASCII and UTF-8 encoding of the Tab key.

4138--

42−-- * Control+Shift-C is 'C', `01000011`, with bit 6 and 7 set to zero which makes `0000011` and

43−-- is the "End of Text" code.

39+-- * Control+Shift-C is 'C', `01000011`, with bit 6 and 7 set to zero

40+-- which is `0000011` and is the "End of Text" code.

4441--

45−-- * Hypothesis: This is why capital-A, 'A', has value 65 in ASCII: This is the value 1 with bit 7

46−-- set and 6 unset.

42+-- * Hypothesis: This is why capital-A, 'A', has value 65 in ASCII: this

43+-- is the value 1 with bit 7 set and 6 unset.

4744--

48−-- * Hypothesis: Bit 6 is unset by upper case letters because, initially, there were only upper case

49−-- letters used and a 5 bit encoding.

45+-- * Hypothesis: Bit 6 is unset by upper case letters because,

46+-- initially, there were only upper case letters used and a 5 bit

47+-- encoding.

5048--

51−-- == 8 bit encoding

49+-- == 8-bit encoding

5250--

53−-- The 8th bit was originally used for parity checking. Useless for emulators. Some terminal

54−-- emulators support a 8 bit input encoding. While this provides some advantages the actual usage is

55−-- low. Most systems use 7bit mode but recognize 8bit control characters when escaped. This is what

56−-- vty does.

51+-- The 8th bit was originally used for parity checking which is useless

52+-- for terminal emulators. Some terminal emulators support an 8-bit

53+-- input encoding. While this provides some advantages, the actual usage

54+-- is low. Most systems use 7-bit mode but recognize 8-bit control

55+-- characters when escaped. This is what Vty does.

5756--

5857-- == Escaped Control Keys

5958--

60−-- Using 7 bit input encoding the @ESC@ byte can signal the start of an encoded control key. To

61−-- differentiate a single @ESC@ eventfrom a control key the timing of the input is used.

59+-- Using 7-bit input encoding, the @ESC@ byte can signal the start of

60+-- an encoded control key. To differentiate a single @ESC@ event from a

61+-- control key, the timing of the input is used.

6262--

63−-- 1. @ESC@ individually: @ESC@ byte; no bytes for 'singleEscPeriod'.

63+-- 1. @ESC@ individually: @ESC@ byte; no bytes following for a period of

64+-- 'VMIN' milliseconds.

6465--

65−-- 2. control keys that contain @ESC@ in their encoding: The @ESC byte; followed by more bytes read

66−-- within 'singleEscPeriod'. All bytes up until the next valid input block are passed to the

67−-- classifier.

66+-- 2. Control keys that contain @ESC@ in their encoding: The @ESC byte

67+-- is followed by more bytes read within 'VMIN' milliseconds. All bytes

68+-- up until the next valid input block are passed to the classifier.

6869--

69−-- If the current runtime is the threaded runtime then the terminal's @VMIN@ and @VTIME@ behavior

70−-- reliably implement the above rules. If the current runtime does not support forkOS then there is

71−-- currently no implementation.

72−--

73−-- Vty used to emulate @VMIN@ and @VTIME@. This was a input loop which did tricky things with

74−-- non-blocking reads and timers. The implementation was not reliable. A reliable implementation is

75−-- possible, but there are no plans to implement this.

70+-- If the current runtime is the threaded runtime then the terminal's

71+-- @VMIN@ and @VTIME@ behavior reliably implement the above rules. If

72+-- the current runtime does not support 'forkOS' then there is currently

73+-- no implementation.

7674--

7775-- == Unicode Input and Escaped Control Key Sequences

7876--

79−-- The input encoding determines how UTF-8 encoded characters are recognize.

77+-- The input encoding determines how UTF-8 encoded characters are

78+-- recognized.

8079--

81−-- * 7 bit mode: UTF-8 can be input unambiguiously. UTF-8 input is a superset of ASCII. UTF-8 does

82−-- not overlap escaped control key sequences. However, the escape key must be differentiated from

80+-- * 7-bit mode: UTF-8 can be input unambiguously. 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

8383-- escaped control key sequences by the timing of the input bytes.

8484--

85−-- * 8 bit mode: UTF-8 cannot be input unambiguously. This does not require using the timing of

86−-- input bytes to differentiate the escape key. Many terminals do not support 8 bit mode.

85+-- * 8-bit mode: UTF-8 cannot be input unambiguously. This does not

86+-- require using the timing of input bytes to differentiate the escape

87+-- key. Many terminals do not support 8-bit mode.

8788--

8889-- == Terminfo

8990--

90−-- The terminfo system is used to determine how some keys are encoded. Terminfo is incomplete. In

91−-- some cases terminfo is incorrect. Vty assumes terminfo is correct but provides a mechanism to

92−-- override terminfo. See "Graphics.Vty.Config" specifically 'inputOverrides'.

91+-- The terminfo system is used to determine how some keys are encoded.

92+-- Terminfo is incomplete and in some cases terminfo is incorrect. Vty

93+-- assumes terminfo is correct but provides a mechanism to override

94+-- terminfo; see "Graphics.Vty.Config", specifically 'inputOverrides'.

9395--

9496-- == Terminal Input is Broken

9597--

96−-- Clearly terminal input has fundemental issues. There is no easy way to reliably resolve these

97−-- issues.

98−--

99−-- One resolution would be to ditch standard terminal interfaces entirely and just go directly to

100−-- scancodes. A reasonable option for vty if everybody used the linux kernel console. I hear GUIs

101−-- are popular these days. Sadly, GUI terminal emulators don't provide access to scancodes AFAIK.

102−--

103−-- All is lost? Not really. "Graphics.Vty.Config" supports customizing the input byte to event

104−-- mapping and xterm supports customizing the scancode to input byte mapping. With a lot of work a

105−-- user's system can be set up to encode all the key combos in an almost-sane manner.

106−--

107−-- There are other tricky work arounds that can be done. I have no interest in implementing most of

108−-- these. They are not really worth the time.

98+-- Clearly terminal input has fundamental issues. There is no easy way

99+-- to reliably resolve these issues.

109100--

110−-- == Terminal Output is Also Broken

101+-- One resolution would be to ditch standard terminal interfaces

102+-- entirely and just go directly to scancodes. This would be a

103+-- reasonable option for Vty if everybody used the linux kernel console

104+-- but for obvious reasons this is not possible.

111105--

112−-- This isn't the only odd aspect of terminals due to historical aspects that no longer apply. EG:

113−-- Some terminfo capabilities specify millisecond delays. (Capabilities are how terminfo describes

114−-- the control sequence to output red, for instance) This is to account for the slow speed of

115−-- hardcopy teletype interfaces. Cause, uh, we totally still use those.

116−--

117−-- The output encoding of colors and attributes are also rife with issues.

106+-- The "Graphics.Vty.Config" module supports customizing the

107+-- input-byte-to-event mapping and xterm supports customizing the

108+-- scancode-to-input-byte mapping. With a lot of work a user's system

109+-- can be set up to encode all the key combos in an almost-sane manner.

118110--

119111-- == See also

120112--

121113-- * http://www.leonerd.org.uk/hacks/fixterms/

122−--

123−-- In my experience this cannot resolve the issues without changes to the terminal emulator and

124−-- device.

125−module Graphics.Vty.Input ( Key(..)

126− , Modifier(..)

127− , Button(..)

128− , Event(..)

129− , Input(..)

130− , inputForConfig

131− )

132− where

114+module Graphics.Vty.Input

115+ ( Key(..)

116+ , Modifier(..)

117+ , Button(..)

118+ , Event(..)

119+ , Input(..)

120+ , inputForConfig

121+ )

122+where

133123

134124import Graphics.Vty.Config

135125import Graphics.Vty.Input.Events

@@ -142,42 +132,19 @@ import Lens.Micro

142132import qualified System.Console.Terminfo as Terminfo

143133import System.Posix.Signals.Exts

144134

145−#if !(MIN_VERSION_base(4,8,0))

146−import Data.Functor ((<$>))

147−import Data.Monoid

148−#else

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

149136import Data.Monoid ((<>))

150137#endif

151138

152−-- | Set up the terminal with file descriptor `inputFd` for input. Returns a 'Input'.

153−--

154−-- The table used to determine the 'Events' to produce for the input bytes comes from

155−-- 'classifyMapForTerm'. Which is then overridden by the the applicable entries from

156−-- 'inputMap'.

157−--

158−-- The terminal device is configured with the attributes:

159−--

160−-- * IXON disabled

161−-- - disables software flow control on outgoing data. This stops the process from being

162−-- suspended if the output terminal cannot keep up. I presume this has little effect these

163−-- days. I hope this means that output will be buffered if the terminal cannot keep up. In the

164−-- old days the output might of been dropped?

165−--

166−-- "raw" mode is used for input.

167−--

168−-- * ISIG disabled

169−-- - enables keyboard combinations that result in signals. TODO: should probably be a dynamic

170−-- option.

139+-- | Set up the terminal with file descriptor `inputFd` for input.

140+-- Returns an 'Input'.

171141--

172−-- * ECHO disabled

173−-- - input is not echod to the output. TODO: should be a dynamic option.

174−--

175−-- * ICANON disabled

176−-- - canonical mode (line mode) input is not used. TODO: should be a dynamic option.

177−--

178−-- * IEXTEN disabled

179−-- - extended functions are disabled. TODO: I don't know what those are.

142+-- The table used to determine the 'Events' to produce for the input

143+-- bytes comes from 'classifyMapForTerm' which is then overridden by

144+-- the the applicable entries from the configuration's 'inputMap'.

180145--

146+-- The terminal device's mode flags are configured by the

147+-- 'attributeControl' function.

181148inputForConfig :: Config -> IO Input

182149inputForConfig config@Config{ termName = Just termName

183150 , inputFd = Just termFd

@@ -187,20 +154,23 @@ inputForConfig config@Config{ termName = Just termName

187154 terminal <- Terminfo.setupTerm termName

188155 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]

189156 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides

190− (setAttrs,unsetAttrs) <- attributeControl termFd

157+ (setAttrs, unsetAttrs) <- attributeControl termFd

191158 setAttrs

192159 input <- initInput config activeInputMap

193160 let pokeIO = Catch $ do

194− let e = error "vty internal failure: this value should not propagate to users"

195161 setAttrs

196− atomically $ writeTChan (input^.eventChannel) (EvResize e e)

162+ atomically $ writeTChan (input^.eventChannel) ResumeAfterSignal

197163 _ <- installHandler windowChange pokeIO Nothing

198164 _ <- installHandler continueProcess pokeIO Nothing

165+

166+ let restore = unsetAttrs

167+

199168 return $ input

200169 { shutdownInput = do

201170 shutdownInput input

202171 _ <- installHandler windowChange Ignore Nothing

203172 _ <- installHandler continueProcess Ignore Nothing

204− unsetAttrs

173+ restore

174+ , restoreInputState = restoreInputState input >> restore

205175 }

206176inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig

src/Graphics/Vty/Input/Classify.hs+69−45

@@ -1,84 +1,108 @@

11{-# OPTIONS_HADDOCK hide #-}

2−-- This makes a kind of tri. Has space efficiency issues with large input blocks.

3−-- Likely building a parser and just applying that would be better.

4−-- I did not write this so I might just rewrite it for better understanding. Which is not the best

5−-- of reasons.

6−-- TODO: measure and rewrite if required.

7−-- TODO: The ClassifyMap interface requires this code to always assure later entries override

8−-- earlier.

2+-- This makes a kind of trie. Has space efficiency issues with large

3+-- input blocks. Likely building a parser and just applying that would

4+-- be better.

95module Graphics.Vty.Input.Classify

10− ( classify

11− , KClass(..)

12− ) where

6+ ( classify

7+ , KClass(..)

8+ , ClassifierState(..)

9+ )

10+where

1311

1412import Graphics.Vty.Input.Events

1513import Graphics.Vty.Input.Mouse

14+import Graphics.Vty.Input.Focus

1615import Graphics.Vty.Input.Paste

1716import Graphics.Vty.Input.Classify.Types

1817

1918import Codec.Binary.UTF8.Generic (decode)

2019

21−import Data.List (inits)

20+import Control.Arrow (first)

2221import qualified Data.Map as M( fromList, lookup )

2322import Data.Maybe ( mapMaybe )

2423import qualified Data.Set as S( fromList, member )

2524

26−import Data.Char

2725import Data.Word

2826

29−compile :: ClassifyMap -> [Char] -> KClass

27+import qualified Data.ByteString as BS

28+import qualified Data.ByteString.Char8 as BS8

29+import Data.ByteString.Char8 (ByteString)

30+

31+-- | Whether the classifier is currently processing a chunked format.

32+-- Currently, only bracketed pastes use this.

33+data ClassifierState

34+ = ClassifierStart

35+ -- ^ Not processing a chunked format.

36+ | ClassifierInChunk ByteString [ByteString]

37+ -- ^ Currently processing a chunked format. The initial chunk is in the

38+ -- first argument and a reversed remainder of the chunks is collected in

39+ -- the second argument. At the end of the processing, the chunks are

40+ -- reversed and concatenated with the final chunk.

41+

42+compile :: ClassifyMap -> ByteString -> KClass

3043compile table = cl' where

3144 -- take all prefixes and create a set of these

32− prefixSet = S.fromList $ concatMap (init . inits . fst) $ table

45+ prefixSet = S.fromList $ concatMap (init . BS.inits . BS8.pack . fst) table

3346 maxValidInputLength = maximum (map (length . fst) table)

34− eventForInput = M.fromList table

35− cl' [] = Prefix

47+ eventForInput = M.fromList $ map (first BS8.pack) table

48+ cl' inputBlock | BS8.null inputBlock = Prefix

3649 cl' inputBlock = case M.lookup inputBlock eventForInput of

37− -- if the inputBlock is exactly what is expected for an event then consume the whole

38− -- block and return the event

39− Just e -> Valid e []

50+ -- if the inputBlock is exactly what is expected for an

51+ -- event then consume the whole block and return the event

52+ Just e -> Valid e BS8.empty

4053 Nothing -> case S.member inputBlock prefixSet of

4154 True -> Prefix

42− -- look up progressively smaller tails of the input block until an event is found

43− -- The assumption is that the event that consumes the most input bytes should be

44− -- produced.

55+ -- look up progressively smaller tails of the input

56+ -- block until an event is found The assumption is that

57+ -- the event that consumes the most input bytes should

58+ -- be produced.

4559 -- The test verifyFullSynInputToEvent2x verifies this.

46− -- H: There will always be one match. The prefixSet contains, by definition, all

47− -- prefixes of an event.

60+ -- H: There will always be one match. The prefixSet

61+ -- contains, by definition, all prefixes of an event.

4862 False ->

49− let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock

63+ let inputPrefixes = reverse . take maxValidInputLength . tail . BS8.inits $ inputBlock

5064 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of

51− (s,e) : _ -> Valid e (drop (length s) inputBlock)

65+ (s,e) : _ -> Valid e (BS8.drop (BS8.length s) inputBlock)

5266 -- neither a prefix or a full event.

53− -- TODO: debug log

5467 [] -> Invalid

5568

56−classify :: ClassifyMap -> [Char] -> KClass

57−classify table =

58− let standardClassifier = compile table

59− in \s -> case s of

60− _ | bracketedPasteStarted s ->

69+classify :: ClassifyMap -> ClassifierState -> ByteString -> KClass

70+classify table = process

71+ where

72+ standardClassifier = compile table

73+

74+ process ClassifierStart s =

75+ case BS.uncons s of

76+ _ | bracketedPasteStarted s ->

77+ if bracketedPasteFinished s

78+ then parseBracketedPaste s

79+ else Chunk

80+ _ | isMouseEvent s -> classifyMouseEvent s

81+ _ | isFocusEvent s -> classifyFocusEvent s

82+ Just (c,cs) | c >= 0xC2 -> classifyUtf8 c cs

83+ _ -> standardClassifier s

84+

85+ process (ClassifierInChunk p ps) s | bracketedPasteStarted p =

6186 if bracketedPasteFinished s

62− then parseBracketedPaste s

63− else Prefix

64− _ | isMouseEvent s -> classifyMouseEvent s

65− c:cs | ord c >= 0xC2 -> classifyUtf8 c cs

66− _ -> standardClassifier s

87+ then parseBracketedPaste $ BS.concat $ p:reverse (s:ps)

88+ else Chunk

89+ process ClassifierInChunk{} _ = Invalid

6790

68−classifyUtf8 :: Char -> [Char] -> KClass

91+classifyUtf8 :: Word8 -> ByteString -> KClass

6992classifyUtf8 c cs =

70− let n = utf8Length (ord c)

71− (codepoint,rest) = splitAt n (c:cs)

93+ let n = utf8Length c

94+ (codepoint,rest) = BS8.splitAt (n - 1) cs

7295

7396 codepoint8 :: [Word8]

74− codepoint8 = map (fromIntegral . ord) codepoint

97+ codepoint8 = c:BS.unpack codepoint

7598

7699 in case decode codepoint8 of

77− _ | n < length codepoint -> Prefix

78− Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest

79− Nothing -> Invalid -- something bad happened; just ignore and continue.

100+ _ | n < BS.length codepoint + 1 -> Prefix

101+ Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest

102+ -- something bad happened; just ignore and continue.

103+ Nothing -> Invalid

80104

81−utf8Length :: (Num t, Ord a, Num a) => a -> t

105+utf8Length :: Word8 -> Int

82106utf8Length c

83107 | c < 0x80 = 1

84108 | c < 0xE0 = 2

src/Graphics/Vty/Input/Classify/Parse.hs+18−14

@@ -1,13 +1,14 @@

11-- | This module provides a simple parser for parsing input event

22-- control sequences.

33module Graphics.Vty.Input.Classify.Parse

4− ( Parser

5− , runParser

6− , failParse

7− , readInt

8− , readChar

9− , expectChar

10− ) where

4+ ( Parser

5+ , runParser

6+ , failParse

7+ , readInt

8+ , readChar

9+ , expectChar

10+ )

11+where

1112

1213import Graphics.Vty.Input.Events

1314import Graphics.Vty.Input.Classify.Types

@@ -15,12 +16,15 @@ import Graphics.Vty.Input.Classify.Types

1516import Control.Monad.Trans.Maybe

1617import Control.Monad.State

1718

18−type Parser a = MaybeT (State String) a

19+import qualified Data.ByteString.Char8 as BS8

20+import Data.ByteString.Char8 (ByteString)

21+

22+type Parser a = MaybeT (State ByteString) a

1923

2024-- | Run a parser on a given input string. If the parser fails, return

2125-- 'Invalid'. Otherwise return the valid event ('Valid') and the

2226-- remaining unparsed characters.

23−runParser :: String -> Parser Event -> KClass

27+runParser :: ByteString -> Parser Event -> KClass

2428runParser s parser =

2529 case runState (runMaybeT parser) s of

2630 (Nothing, _) -> Invalid

@@ -35,9 +39,9 @@ failParse = fail "invalid parse"

3539-- return '123' and consume those characters.

3640readInt :: Parser Int

3741readInt = do

38− s <- get

42+ s <- BS8.unpack <$> get

3943 case (reads :: ReadS Int) s of

40− [(i, rest)] -> put rest >> return i

44+ [(i, rest)] -> put (BS8.pack rest) >> return i

4145 _ -> failParse

4246

4347-- | Read a character from the input stream. If one cannot be read (e.g.

@@ -45,9 +49,9 @@ readInt = do

4549readChar :: Parser Char

4650readChar = do

4751 s <- get

48− case s of

49− c:rest -> put rest >> return c

50− _ -> failParse

52+ case BS8.uncons s of

53+ Just (c,rest) -> put rest >> return c

54+ Nothing -> failParse

5155

5256-- | Read a character from the input stream and fail parsing if it is

5357-- not the specified character.

src/Graphics/Vty/Input/Classify/Types.hs+10−3

@@ -1,13 +1,17 @@

11-- | This module exports the input classification type to avoid import

22-- cycles between other modules that need this.

3+{-# LANGUAGE StrictData #-}

34module Graphics.Vty.Input.Classify.Types

4− ( KClass(..)

5− ) where

5+ ( KClass(..)

6+ )

7+where

68

79import Graphics.Vty.Input.Events

810

11+import Data.ByteString.Char8 (ByteString)

12+

913data KClass

10− = Valid Event [Char]

14+ = Valid Event ByteString

1115 -- ^ A valid event was parsed. Any unused characters from the input

1216 -- stream are also provided.

1317 | Invalid

@@ -15,4 +19,7 @@ data KClass

1519 | Prefix

1620 -- ^ The input characters form the prefix of a valid event character

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

1825 deriving(Show, Eq)

src/Graphics/Vty/Input/Events.hs+38−14

@@ -1,34 +1,44 @@

11{-# Language DeriveGeneric #-}

2+{-# Language StrictData #-}

23module Graphics.Vty.Input.Events where

34

5+import Control.DeepSeq

46import Data.ByteString

57import GHC.Generics

68

79-- | Representations of non-modifier keys.

810--

9−-- * KFun is indexed from 0 to 63. Range of supported FKeys varies by terminal and keyboard.

11+-- * KFun is indexed from 0 to 63. Range of supported FKeys varies by

12+-- terminal and keyboard.

1013--

11−-- * KUpLeft, KUpRight, KDownLeft, KDownRight, KCenter support varies by terminal and keyboard.

14+-- * KUpLeft, KUpRight, KDownLeft, KDownRight, KCenter support varies by

15+-- terminal and keyboard.

1216--

13−-- * Actually, support for most of these but KEsc, KChar, KBS, and KEnter vary by terminal and

14−-- keyboard.

15−data Key = KEsc | KChar Char | KBS | KEnter

17+-- * Actually, support for most of these but KEsc, KChar, KBS, and

18+-- KEnter vary by terminal and keyboard.

19+data Key = KEsc | KChar {-# UNPACK #-} Char | KBS | KEnter

1620 | KLeft | KRight | KUp | KDown

22+ | KFun {-# UNPACK #-} Int | KBackTab | KPrtScr | KPause | KIns

2024 deriving (Eq,Show,Read,Ord,Generic)

2125

22−-- | Modifier keys. Key codes are interpreted such that users are more likely to

23−-- have Meta than Alt; for instance on the PC Linux console, 'MMeta' will

24−-- generally correspond to the physical Alt key.

26+instance NFData Key

27+

28+-- | 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,

30+-- 'MMeta' will generally correspond to the physical Alt key.

2531data Modifier = MShift | MCtrl | MMeta | MAlt

2632 deriving (Eq,Show,Read,Ord,Generic)

2733

34+instance NFData Modifier

35+

2836-- | Mouse buttons.

29−data Button = BLeft | BMiddle | BRight

37+data Button = BLeft | BMiddle | BRight | BScrollUp | BScrollDown

3038 deriving (Eq,Show,Read,Ord,Generic)

3139

40+instance NFData Button

41+

3242-- | Events.

3343data Event

3444 = EvKey Key [Modifier]

@@ -42,10 +52,8 @@ data Event

4252 -- without specifying which one; in that case, Nothing is provided.

4353 -- Otherwise Just the button released is included in the event.

4454 | EvResize Int Int

45− -- ^ If read from 'eventChannel' this is the size at the time of the

46− -- signal. If read from 'nextEvent' this is the size at the time the

47− -- event was processed by Vty. Typically these are the same, but if

48− -- somebody is resizing the terminal quickly they can be different.

55+ -- The terminal window was resized and the size is provided in the

56+ -- integer fields (width, height).

4957 | EvPaste ByteString

5058 -- ^ A paste event occurs when a bracketed paste input sequence is

5159 -- received. For terminals that support bracketed paste mode, these

@@ -54,6 +62,22 @@ data Event

5462 -- input (which is probably bad, so beware!) Note that the data is

5563 -- provided in raw form and you'll have to decode (e.g. as UTF-8) if

5664 -- that's what your application expects.

65+ | EvLostFocus

66+ -- ^ The terminal running the application lost input focus.

67+ | EvGainedFocus

68+ -- ^ The terminal running the application gained input focus.

5769 deriving (Eq,Show,Read,Ord,Generic)

5870

71+instance NFData Event

72+

5973type ClassifyMap = [(String,Event)]

74+

75+-- | The type of internal events that drive the internal Vty event

76+-- dispatching to the application.

77+data InternalEvent =

78+ ResumeAfterSignal

79+ -- ^ Vty resumed operation after the process was interrupted with a

80+ -- signal. In practice this translates into a screen redraw in the

81+ -- input event loop.

82+ | InputEvent Event

83+ -- ^ An input event was received.

src/Graphics/Vty/Input/Focus.hsnew file+49

@@ -0,0 +1,49 @@

1+module Graphics.Vty.Input.Focus

2+ ( requestFocusEvents

3+ , disableFocusEvents

4+ , isFocusEvent

5+ , classifyFocusEvent

6+ )

7+where

8+

9+import Graphics.Vty.Input.Events

10+import Graphics.Vty.Input.Classify.Types

11+import Graphics.Vty.Input.Classify.Parse

12+

13+import Control.Monad.State

14+

15+import qualified Data.ByteString.Char8 as BS8

16+import Data.ByteString.Char8 (ByteString)

17+

18+-- | These sequences set xterm-based terminals to send focus event

19+-- sequences.

20+requestFocusEvents :: ByteString

21+requestFocusEvents = BS8.pack "\ESC[?1004h"

22+

23+-- | These sequences disable focus events.

24+disableFocusEvents :: ByteString

25+disableFocusEvents = BS8.pack "\ESC[?1004l"

26+

27+-- | Does the specified string begin with a focus event?

28+isFocusEvent :: ByteString -> Bool

29+isFocusEvent s = BS8.isPrefixOf focusIn s ||

30+ BS8.isPrefixOf focusOut s

31+

32+focusIn :: ByteString

33+focusIn = BS8.pack "\ESC[I"

34+

35+focusOut :: ByteString

36+focusOut = BS8.pack "\ESC[O"

37+

38+-- | Attempt to classify an input string as a focus event.

39+classifyFocusEvent :: ByteString -> KClass

40+classifyFocusEvent s = runParser s $ do

41+ when (not $ isFocusEvent s) failParse

42+

43+ expectChar '\ESC'

44+ expectChar '['

45+ ty <- readChar

46+ case ty of

47+ 'I' -> return EvGainedFocus

48+ 'O' -> return EvLostFocus

49+ _ -> failParse

src/Graphics/Vty/Input/Loop.hs+109−47

@@ -1,14 +1,18 @@

1−{-# LANGUAGE RecordWildCards #-}

2−{-# OPTIONS_HADDOCK hide #-}

1+{-# LANGUAGE CPP #-}

32{-# LANGUAGE NoMonomorphismRestriction #-}

3+{-# LANGUAGE RecordWildCards #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

45{-# LANGUAGE TemplateHaskell #-}

5−{-# LANGUAGE CPP #-}

6−-- | The input layer used to be a single function that correctly accounted for the non-threaded

7−-- runtime by emulating the terminal VMIN adn VTIME handling. This has been removed and replace with

8−-- a more straightforward parser. The non-threaded runtime is no longer supported.

6+{-# OPTIONS_HADDOCK hide #-}

7+-- | The input layer used to be a single function that correctly

8+-- accounted for the non-threaded runtime by emulating the terminal

9+-- VMIN adn VTIME handling. This has been removed and replace with a

10+-- more straightforward parser. The non-threaded runtime is no longer

11+-- supported.

912--

10−-- This is an example of an algorithm where code coverage could be high, even 100%, but the

11−-- behavior is still under tested. I should collect more of these examples...

13+-- This is an example of an algorithm where code coverage could be high,

14+-- even 100%, but the behavior is still under tested. I should collect

15+-- more of these examples...

1216--

1317-- reference: http://www.unixwiz.net/techtips/termios-vmin-vtime.html

1418module Graphics.Vty.Input.Loop where

@@ -21,8 +25,7 @@ import Control.Applicative

2125import Control.Concurrent

2226import Control.Concurrent.STM

2327import Control.Exception (mask, try, SomeException)

24−import Data.Monoid

25−import Lens.Micro

28+import Lens.Micro hiding ((<>~))

2629import Lens.Micro.Mtl

2730import Lens.Micro.TH

2831import Control.Monad (when, mzero, forM_)

@@ -31,12 +34,15 @@ import Control.Monad.Trans.State (StateT(..), evalStateT)

3134import Control.Monad.State.Class (MonadState, modify)

3235import Control.Monad.Trans.Reader (ReaderT(..))

3336

34−import Data.Char

37+import qualified Data.ByteString.Char8 as BS8

38+import qualified Data.ByteString as BS

39+import Data.ByteString.Char8 (ByteString)

3540import Data.IORef

3641import Data.Word (Word8)

3742

38−import Foreign ( allocaArray, peekArray, Ptr )

43+import Foreign (allocaArray)

3944import Foreign.C.Types (CInt(..))

45+import Foreign.Ptr (Ptr, castPtr)

4046

4147import System.IO

4248import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))

@@ -46,12 +52,18 @@ import System.Posix.Types (Fd(..))

4652import Text.Printf (hPrintf)

4753

4854data Input = Input

49− { -- | Channel of events direct from input processing. Unlike 'nextEvent' this will not refresh

50− -- the display if the next event is an 'EvResize'.

51− _eventChannel :: TChan Event

52− -- | Shuts down the input processing. This should return the terminal input state to before

53− -- the input initialized.

55+ { -- | Channel of events direct from input processing. Unlike

56+ -- 'nextEvent' this will not refresh the display if the next event

57+ -- is an 'EvResize'.

58+ _eventChannel :: TChan InternalEvent

59+ -- | Shuts down the input processing. As part of shutting down the

60+ -- input, this should also restore the input state.

5461 , 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 ()

5567 -- | Changes to this value are reflected after the next event.

5668 , _configRef :: IORef Config

5769 -- | input debug log

@@ -68,10 +80,11 @@ data InputBuffer = InputBuffer

6880makeLenses ''InputBuffer

6981

7082data InputState = InputState

71− { _unprocessedBytes :: String

83+ { _unprocessedBytes :: ByteString

84+ , _classifierState :: ClassifierState

7285 , _appliedConfig :: Config

7386 , _inputBuffer :: InputBuffer

74− , _classifier :: String -> KClass

87+ , _classifier :: ClassifierState -> ByteString -> KClass

7588 }

7689

7790makeLenses ''InputState

@@ -86,7 +99,8 @@ logMsg msg = do

8699 Just h -> liftIO $ hPutStrLn h msg >> hFlush h

87100

88101-- this must be run on an OS thread dedicated to this input handling.

89−-- otherwise the terminal timing read behavior will block the execution of the lightweight threads.

102+-- otherwise the terminal timing read behavior will block the execution

103+-- of the lightweight threads.

90104loopInputProcessor :: InputM ()

91105loopInputProcessor = do

92106 readFromDevice >>= addBytesToProcess

@@ -95,20 +109,20 @@ loopInputProcessor = do

95109 dropInvalid

96110 loopInputProcessor

97111

98−addBytesToProcess :: String -> InputM ()

112+addBytesToProcess :: ByteString -> InputM ()

99113addBytesToProcess block = unprocessedBytes <>= block

100114

101115emit :: Event -> InputM ()

102116emit event = do

103117 logMsg $ "parsed event: " ++ show event

104− view eventChannel >>= liftIO . atomically . flip writeTChan event

118+ view eventChannel >>= liftIO . atomically . flip writeTChan (InputEvent event)

105119

106−-- The timing requirements are assured by the VMIN and VTIME set for the device.

120+-- The timing requirements are assured by the VMIN and VTIME set for the

121+-- device.

107122--

108−-- Precondition: Under the threaded runtime. Only current use is from a forkOS thread. That case

109−-- satisfies precondition.

110−-- TODO: When under the non-threaded runtime emulate VMIN and VTIME

111−readFromDevice :: InputM String

123+-- Precondition: Under the threaded runtime. Only current use is from a

124+-- forkOS thread. That case satisfies precondition.

125+readFromDevice :: InputM ByteString

112126readFromDevice = do

113127 newConfig <- view configRef >>= liftIO . readIORef

114128 oldConfig <- use appliedConfig

@@ -120,16 +134,18 @@ readFromDevice = do

120134 bufferPtr <- use $ inputBuffer.ptr

121135 maxBytes <- use $ inputBuffer.size

122136 stringRep <- liftIO $ do

123− -- The killThread used in shutdownInput will not interrupt the foreign call fdReadBuf uses

124− -- this provides a location to be interrupted prior to the foreign call. If there is input

125− -- on the FD then the fdReadBuf will return in a finite amount of time due to the vtime

126− -- terminal setting.

137+ -- The killThread used in shutdownInput will not interrupt the

138+ -- foreign call fdReadBuf uses this provides a location to be

139+ -- interrupted prior to the foreign call. If there is input on

140+ -- the FD then the fdReadBuf will return in a finite amount of

141+ -- time due to the vtime terminal setting.

127142 threadWaitRead fd

128143 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)

129144 if bytesRead > 0

130− then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr

131− else return []

132− when (not $ null stringRep) $ logMsg $ "input bytes: " ++ show stringRep

145+ then BS.packCStringLen (castPtr bufferPtr, fromIntegral bytesRead)

146+ else return BS.empty

147+ when (not $ BS.null stringRep) $

148+ logMsg $ "input bytes: " ++ show (BS8.unpack stringRep)

133149 return stringRep

134150

135151applyConfig :: Fd -> Config -> IO ()

@@ -140,41 +156,86 @@ applyConfig _ _ = fail "(vty) applyConfig was not provided a complete configurat

140156parseEvent :: InputM Event

141157parseEvent = do

142158 c <- use classifier

159+ s <- use classifierState

143160 b <- use unprocessedBytes

144− case c b of

161+ case c s b of

145162 Valid e remaining -> do

146163 logMsg $ "valid parse: " ++ show e

147164 logMsg $ "remaining: " ++ show remaining

165+ classifierState .= ClassifierStart

148166 unprocessedBytes .= remaining

149167 return e

150− _ -> mzero

168+ _ -> mzero

151169

152170dropInvalid :: InputM ()

153171dropInvalid = do

154172 c <- use classifier

173+ s <- use classifierState

155174 b <- use unprocessedBytes

156− when (c b == Invalid) $ do

157− logMsg "dropping input bytes"

158− unprocessedBytes .= []

175+ case c s b of

176+ Chunk -> do

177+ classifierState .=

178+ case s of

179+ ClassifierStart -> ClassifierInChunk b []

180+ ClassifierInChunk p bs -> ClassifierInChunk p (b:bs)

181+ unprocessedBytes .= BS8.empty

182+ Invalid -> do

183+ logMsg "dropping input bytes"

184+ classifierState .= ClassifierStart

185+ unprocessedBytes .= BS8.empty

186+ _ -> return ()

159187

160188runInputProcessorLoop :: ClassifyMap -> Input -> IO ()

161189runInputProcessorLoop classifyTable input = do

162190 let bufferSize = 1024

163191 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do

164− s0 <- InputState [] <$> readIORef (_configRef input)

165− <*> pure (InputBuffer bufferPtr bufferSize)

166− <*> pure (classify classifyTable)

192+ s0 <- InputState BS8.empty ClassifierStart

193+ <$> readIORef (_configRef input)

194+ <*> pure (InputBuffer bufferPtr bufferSize)

195+ <*> pure (classify classifyTable)

167196 runReaderT (evalStateT loopInputProcessor s0) input

168197

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)

169223attributeControl :: Fd -> IO (IO (), IO ())

170224attributeControl fd = do

171225 original <- getTerminalAttributes fd

172− let vtyMode = foldl withoutMode original [ StartStopOutput, KeyboardInterrupts

173− , EnableEcho, ProcessInput, ExtendedFunctions

174− ]

226+ let vtyMode = foldl withMode clearedFlags flagsToSet

227+ clearedFlags = foldl withoutMode original flagsToUnset

228+ flagsToSet = [ MapCRtoLF -- ICRNL

229+ ]

230+ flagsToUnset = [ StartStopOutput -- IXON

231+ , KeyboardInterrupts -- ISIG

232+ , EnableEcho -- ECHO

233+ , ProcessInput -- ICANON

234+ , ExtendedFunctions -- IEXTEN

235+ ]

175236 let setAttrs = setTerminalAttributes fd vtyMode Immediately

176237 unsetAttrs = setTerminalAttributes fd original Immediately

177− return (setAttrs,unsetAttrs)

238+ return (setAttrs, unsetAttrs)

178239

179240logInitialInputState :: Input -> ClassifyMap -> IO()

180241logInitialInputState input classifyTable = case _inputDebug input of

@@ -182,7 +243,7 @@ logInitialInputState input classifyTable = case _inputDebug input of

182243 Just h -> do

183244 Config{ vmin = Just theVmin

184245 , vtime = Just theVtime

185− , termName = Just theTerm, .. } <- readIORef $ _configRef input

246+ , termName = Just theTerm } <- readIORef $ _configRef input

186247 _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))

187248 forM_ classifyTable $ \i -> case i of

188249 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)

@@ -198,6 +259,7 @@ initInput config classifyTable = do

198259 applyConfig fd config

199260 stopSync <- newEmptyMVar

200261 input <- Input <$> atomically newTChan

262+ <*> pure (return ())

201263 <*> pure (return ())

202264 <*> newIORef config

203265 <*> maybe (return Nothing)

src/Graphics/Vty/Input/Mouse.hs+34−23

@@ -3,21 +3,24 @@

33--

44-- http://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking

55module Graphics.Vty.Input.Mouse

6− ( requestMouseEvents

7− , disableMouseEvents

8− , isMouseEvent

9− , classifyMouseEvent

10− ) where

6+ ( requestMouseEvents

7+ , disableMouseEvents

8+ , isMouseEvent

9+ , classifyMouseEvent

10+ )

11+where

1112

1213import Graphics.Vty.Input.Events

1314import Graphics.Vty.Input.Classify.Types

1415import Graphics.Vty.Input.Classify.Parse

1516

1617import Control.Monad.State

17−import Data.List (isPrefixOf)

1818import Data.Maybe (catMaybes)

1919import Data.Bits ((.&.))

2020

21+import qualified Data.ByteString.Char8 as BS8

22+import Data.ByteString.Char8 (ByteString)

23+

2124-- A mouse event in SGR extended mode is

2225--

2326-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')

@@ -31,28 +34,28 @@ import Data.Bits ((.&.))

3134

3235-- | These sequences set xterm-based terminals to send mouse event

3336-- sequences.

34−requestMouseEvents :: String

35−requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h\ESC[?1005h"

37+requestMouseEvents :: ByteString

38+requestMouseEvents = BS8.pack "\ESC[?1000h\ESC[?1002h\ESC[?1006h"

3639

3740-- | These sequences disable mouse events.

38−disableMouseEvents :: String

39−disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l\ESC[?1005l"

41+disableMouseEvents :: ByteString

42+disableMouseEvents = BS8.pack "\ESC[?1000l\ESC[?1002l\ESC[?1006l"

4043

4144-- | Does the specified string begin with a mouse event?

42−isMouseEvent :: String -> Bool

45+isMouseEvent :: ByteString -> Bool

4346isMouseEvent s = isSGREvent s || isNormalEvent s

4447

45−isSGREvent :: String -> Bool

46−isSGREvent = isPrefixOf sgrPrefix

48+isSGREvent :: ByteString -> Bool

49+isSGREvent = BS8.isPrefixOf sgrPrefix

4750

48−sgrPrefix :: String

49−sgrPrefix = "\ESC[M"

51+sgrPrefix :: ByteString

52+sgrPrefix = BS8.pack "\ESC[M"

5053

51−isNormalEvent :: String -> Bool

52−isNormalEvent = isPrefixOf normalPrefix

54+isNormalEvent :: ByteString -> Bool

55+isNormalEvent = BS8.isPrefixOf normalPrefix

5356

54−normalPrefix :: String

55−normalPrefix = "\ESC[<"

57+normalPrefix :: ByteString

58+normalPrefix = BS8.pack "\ESC[<"

5659

5760-- Modifier bits:

5861shiftBit :: Int

@@ -66,7 +69,7 @@ ctrlBit = 16

6669

6770-- These bits indicate the buttons involved:

6871buttonMask :: Int

69−buttonMask = 3

72+buttonMask = 67

7073

7174leftButton :: Int

7275leftButton = 0

@@ -77,11 +80,17 @@ middleButton = 1

7780rightButton :: Int

7881rightButton = 2

7982

83+scrollUp :: Int

84+scrollUp = 64

85+

86+scrollDown :: Int

87+scrollDown = 65

88+

8089hasBitSet :: Int -> Int -> Bool

8190hasBitSet val bit = val .&. bit > 0

8291

83−-- | Attempt to lassify an input string as a mouse event.

84−classifyMouseEvent :: String -> KClass

92+-- | Attempt to classify an input string as a mouse event.

93+classifyMouseEvent :: ByteString -> KClass

8594classifyMouseEvent s = runParser s $ do

8695 when (not $ isMouseEvent s) failParse

8796

@@ -93,12 +102,14 @@ classifyMouseEvent s = runParser s $ do

93102 'M' -> classifyNormalMouseEvent

94103 _ -> failParse

95104

96−-- Given a modifer/button value, determine which button was indicated

105+-- Given a modifier/button value, determine which button was indicated

97106getSGRButton :: Int -> Parser Button

98107getSGRButton mods =

99108 let buttonMap = [ (leftButton, BLeft)

100109 , (middleButton, BMiddle)

101110 , (rightButton, BRight)

111+ , (scrollUp, BScrollUp)

112+ , (scrollDown, BScrollDown)

102113 ]

103114 in case lookup (mods .&. buttonMask) buttonMap of

104115 Nothing -> failParse

src/Graphics/Vty/Input/Paste.hs+21−28

@@ -2,47 +2,40 @@

22--

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

44module Graphics.Vty.Input.Paste

5− ( parseBracketedPaste

6− , bracketedPasteStarted

7− , bracketedPasteFinished

8− ) where

5+ ( parseBracketedPaste

6+ , bracketedPasteStarted

7+ , bracketedPasteFinished

8+ )

9+where

910

1011import qualified Data.ByteString.Char8 as BS8

12+import Data.ByteString.Char8 (ByteString)

1113

1214import Graphics.Vty.Input.Events

1315import Graphics.Vty.Input.Classify.Types

1416

15−import Data.List (isPrefixOf, isInfixOf)

17+bracketedPasteStart :: ByteString

18+bracketedPasteStart = BS8.pack "\ESC[200~"

1619

17−bracketedPasteStart :: String

18−bracketedPasteStart = "\ESC[200~"

19−

20−bracketedPasteEnd :: String

21−bracketedPasteEnd = "\ESC[201~"

20+bracketedPasteEnd :: ByteString

21+bracketedPasteEnd = BS8.pack "\ESC[201~"

2222

2323-- | Does the input start a bracketed paste?

24−bracketedPasteStarted :: String -> Bool

25−bracketedPasteStarted = isPrefixOf bracketedPasteStart

24+bracketedPasteStarted :: ByteString -> Bool

25+bracketedPasteStarted = BS8.isPrefixOf bracketedPasteStart

2626

2727-- | Does the input contain a complete bracketed paste?

28−bracketedPasteFinished :: String -> Bool

29−bracketedPasteFinished = isInfixOf bracketedPasteEnd

28+bracketedPasteFinished :: ByteString -> Bool

29+bracketedPasteFinished = BS8.isInfixOf bracketedPasteEnd

3030

3131-- | Parse a bracketed paste. This should only be called on a string if

3232-- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return

3333-- 'True'.

34−parseBracketedPaste :: String -> KClass

34+parseBracketedPaste :: ByteString -> KClass

3535parseBracketedPaste s =

36− let (p, rest) = takeUntil (drop (length bracketedPasteStart) s) bracketedPasteEnd

37− rest' = if bracketedPasteEnd `isPrefixOf` rest

38− then drop (length bracketedPasteEnd) rest

39− else rest

40− in Valid (EvPaste $ BS8.pack p) rest'

41−

42−takeUntil :: (Eq a) => [a] -> [a] -> ([a],[a])

43−takeUntil [] _ = ([], [])

44−takeUntil cs sub

45− | length cs < length sub = (cs, [])

46− | take (length sub) cs == sub = ([], drop (length sub) cs)

47− | otherwise = let (pre, suf) = takeUntil (tail cs) sub

48− in (head cs:pre, suf)

36+ Valid (EvPaste p) (BS8.drop endLen rest')

37+ where

38+ startLen = BS8.length bracketedPasteStart

39+ endLen = BS8.length bracketedPasteEnd

40+ (_, rest ) = BS8.breakSubstring bracketedPasteStart s

41+ (p, rest') = BS8.breakSubstring bracketedPasteEnd . BS8.drop startLen $ rest

src/Graphics/Vty/Input/Terminfo.hs+34−33

@@ -7,8 +7,8 @@ import qualified Graphics.Vty.Input.Terminfo.ANSIVT as ANSIVT

77import Control.Arrow

88import System.Console.Terminfo

99

10−-- | queries the terminal for all capability based input sequences then adds on a terminal dependent

11−-- input sequence mapping.

10+-- | Queries the terminal for all capability-based input sequences and

11+-- then adds on a terminal-dependent input sequence mapping.

1212--

1313-- For reference see:

1414--

@@ -20,29 +20,29 @@ import System.Console.Terminfo

2020--

2121-- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html

2222--

23−-- This is painful. Terminfo is incomplete. The vim source implies that terminfo is also incorrect.

24−-- Vty assumes that the an internal terminfo table added to the system provided terminfo table is

25−-- correct.

23+-- Terminfo is incomplete. The vim source implies that terminfo is also

24+-- incorrect. Vty assumes that the internal terminfo table added to the

25+-- system-provided terminfo table is correct.

2626--

27−-- 1. build terminfo table for all caps. Missing caps are not added.

27+-- The procedure used here is:

2828--

29−-- 2. add tables for visible chars, esc, del plus ctrl and meta

29+-- 1. Build terminfo table for all caps. Missing caps are not added.

3030--

31−-- 3. add internally defined table for given terminal type.

31+-- 2. Add tables for visible chars, esc, del, ctrl, and meta.

3232--

33−-- Precedence is currently implicit in the 'compile' algorithm. Which is a bit odd.

33+-- 3. Add internally-defined table for given terminal type.

3434--

35−-- \todo terminfo meta is not supported.

36−-- \todo no 8bit

35+-- Precedence is currently implicit in the 'compile' algorithm.

3736classifyMapForTerm :: String -> Terminal -> ClassifyMap

3837classifyMapForTerm termName term =

3938 concat $ capsClassifyMap term keysFromCapsTable

4039 : universalTable

4140 : termSpecificTables termName

4241

43−-- | key table applicable to all terminals.

42+-- | The key table applicable to all terminals.

4443--

45−-- TODO: some probably only applicable to ANSI/VT100 terminals.

44+-- Note that some of these entries are probably only applicable to

45+-- ANSI/VT100 terminals.

4646universalTable :: ClassifyMap

4747universalTable = concat [visibleChars, ctrlChars, ctrlMetaChars, specialSupportKeys]

4848

@@ -50,31 +50,31 @@ capsClassifyMap :: Terminal -> [(String,Event)] -> ClassifyMap

5050capsClassifyMap terminal table = [(x,y) | (Just x,y) <- map extractCap table]

5151 where extractCap = first (getCapability terminal . tiGetStr)

5252

53−-- | tables specific to a given terminal that are not derivable from terminfo.

53+-- | Tables specific to a given terminal that are not derivable from

54+-- terminfo.

5455--

55−-- TODO: Adds the ANSI/VT100/VT50 tables regardless of term identifier.

56+-- Note that this adds the ANSI/VT100/VT50 tables regardless of term

57+-- identifier.

5658termSpecificTables :: String -> [ClassifyMap]

5759termSpecificTables _termName = ANSIVT.classifyTable

5860

5961-- | Visible characters in the ISO-8859-1 and UTF-8 common set.

6062--

61−-- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this

62−-- classify table is reached.

63−--

64−-- TODO: resolve

65−-- 1. start at ' '. The earlier characters are all 'ctrlChar'

63+-- We limit to < 0xC1. The UTF8 sequence detector will catch all values

64+-- 0xC2 and above before this classify table is reached.

6665visibleChars :: ClassifyMap

6766visibleChars = [ ([x], EvKey (KChar x) [])

6867 | x <- [' ' .. toEnum 0xC1]

6968 ]

7069

71−-- | Non visible characters in the ISO-8859-1 and UTF-8 common set translated to ctrl + char.

70+-- | Non-printable characters in the ISO-8859-1 and UTF-8 common set

71+-- translated to ctrl + char.

7272--

73−-- \todo resolve CTRL-i is the same as tab

73+-- This treats CTRL-i the same as tab.

7474ctrlChars :: ClassifyMap

7575ctrlChars =

7676 [ ([toEnum x],EvKey (KChar y) [MCtrl])

77− | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_'])

77+ | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_'])

7878 , y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.

7979 , y /= 'h' -- CTRL-h should not hide BS

8080 ]

@@ -83,22 +83,23 @@ ctrlChars =

8383ctrlMetaChars :: ClassifyMap

8484ctrlMetaChars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrlChars

8585

86−-- | esc, meta esc, delete, meta delete, enter, meta enter

86+-- | Esc, meta-esc, delete, meta-delete, enter, meta-enter.

8787specialSupportKeys :: ClassifyMap

8888specialSupportKeys =

89− [ -- special support for ESC

90− ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

89+ [ ("\ESC\ESC[5~",EvKey KPageUp [MMeta])

90+ , ("\ESC\ESC[6~",EvKey KPageDown [MMeta])

91+ -- special support for ESC

92+ , ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

9193 -- Special support for backspace

92− , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])

94+ , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta]), ("\b",EvKey KBS [])

9395 -- Special support for Enter

9496 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])

9597 -- explicit support for tab

9698 , ("\t", EvKey (KChar '\t') [])

9799 ]

98100

99−-- | classify table directly generated from terminfo cap strings

100−--

101−-- these are:

101+-- | A classification table directly generated from terminfo cap

102+-- strings. These are:

102103--

103104-- * ka1 - keypad up-left

104105--

@@ -113,7 +114,7 @@ specialSupportKeys =

113114-- * kcbt - back tab

114115--

115116-- * kc1 - keypad left-down

116−--

117+--

117118-- * kc3 - keypad right-down

118119--

119120-- * kdch1 - delete

@@ -121,7 +122,7 @@ specialSupportKeys =

121122-- * kcud1 - down

122123--

123124-- * kend - end

124−--

125+--

125126-- * kent - enter

126127--

127128-- * kf0 - kf63 - function keys

@@ -180,6 +181,6 @@ keysFromCapsTable =

180181 , ("kcuu1", EvKey KUp [])

181182 ] ++ functionKeyCapsTable

182183

183−-- | cap names for function keys

184+-- | Cap names for function keys.

184185functionKeyCapsTable :: ClassifyMap

185186functionKeyCapsTable = flip map [0..63] $ \n -> ("kf" ++ show n, EvKey (KFun n) [])

src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+21−20

@@ -1,15 +1,15 @@

1−-- | Input mappings for ANSI/VT100/VT50 terminals that is missing from terminfo.

2−--

3−-- Or that are sent regardless of terminfo by terminal emulators. EG: Terminal emulators will often

4−-- use VT50 input bytes regardless of declared terminal type. This provides compatibility with

5−-- programs that don't follow terminfo.

1+-- | Input mappings for ANSI/VT100/VT50 terminals that is missing from

2+-- terminfo.

3+--

4+-- Or that are sent regardless of terminfo by terminal emulators. EG:

5+-- Terminal emulators will often use VT50 input bytes regardless of

6+-- declared terminal type. This provides compatibility with programs

7+-- that don't follow terminfo.

68module Graphics.Vty.Input.Terminfo.ANSIVT where

79

810import Graphics.Vty.Input.Events

911

1012-- | Encoding for navigation keys.

11−--

12−-- TODO: This is not the same as the input bytes pulled from teh caps table.

1313navKeys0 :: ClassifyMap

1414navKeys0 =

1515 [ k "G" KCenter

@@ -30,8 +30,10 @@ navKeys1 =

3030 [("\ESC[" ++ charCnt ++ show mc++c,EvKey s m)

3131 | charCnt <- ["1;", ""], -- we can have a count or not

3232 (m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),

33− ([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes

34− (c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft), ("H", KHome), ("F", KEnd)] -- directions and their codes

33+ -- modifiers and their codes

34+ ([MShift, MCtrl],6), ([MShift, MMeta],4)],

35+ -- directions and their codes

36+ (c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft), ("H", KHome), ("F", KEnd)]

3537 ]

3638

3739-- | encoding for ins, del, pageup, pagedown, home, end

@@ -49,26 +51,26 @@ navKeys3 =

4951 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

5052

5153-- | encoding for shift plus function keys

52−--

53−-- According to

54+--

55+-- According to

5456--

5557-- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html

5658--

5759-- This encoding depends on the terminal.

5860functionKeys1 :: ClassifyMap

5961functionKeys1 =

60− let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in

62+ let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-head nrs+ff) m) | n <- nrs ] in

6163 concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]

6264

6365-- | encoding for meta plus char

6466--

65−-- TODO: resolve -

66−--

67−-- 1. removed 'ESC' from second list due to duplication with "special_support_keys".

68−-- 2. removed '[' from second list due to conflict with 7-bit encoding for ESC. Whether meta+[ is

69−-- the same as ESC should examine km and current encoding.

70−-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped to KBS by

71−-- special_support_keys.

67+-- 1. removed 'ESC' from second list due to duplication with

68+-- "special_support_keys".

69+-- 2. removed '[' from second list due to conflict with 7-bit encoding

70+-- for ESC. Whether meta+[ is the same as ESC should examine km and

71+-- current encoding.

72+-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped

73+-- to KBS by special_support_keys.

7274functionKeys2 :: ClassifyMap

7375functionKeys2 = [ ('\ESC':[x],EvKey (KChar x) [MMeta])

7476 | x <- '\t':[' ' .. '~']

@@ -84,4 +86,3 @@ classifyTable =

8486 , functionKeys1

8587 , functionKeys2

8688 ]

87−

src/Graphics/Vty/Output.hs+53−52

@@ -1,70 +1,69 @@

1−{-# LANGUAGE RecordWildCards #-}

2−{-# LANGUAGE NamedFieldPuns #-}

3−-- | Output interface.

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

2+-- | This module provides functions for accessing the current terminal

3+-- or a specific terminal device.

44--

5−-- Access to the current terminal or a specific terminal device.

5+-- See also:

66--

7−-- See also:

7+-- 1. "Graphics.Vty.Output": This instantiates an abtract interface

8+-- to the terminal based on the @TERM@ and @COLORTERM@ environment

9+-- variables.

810--

9−-- 1. "Graphics.Vty.Output": This instantiates an abtract interface to the terminal interface based

10−-- on the TERM and COLORTERM environment variables.

11+-- 2. "Graphics.Vty.Output.Interface": Defines the generic interface all

12+-- terminal modules need to implement.

1113--

12−-- 2. "Graphics.Vty.Output.Interface": Defines the generic interface all terminals need to implement.

14+-- 3. "Graphics.Vty.Output.TerminfoBased": Defines a terminal instance

15+-- that uses terminfo for all control strings. No attempt is made to

16+-- change the character set to UTF-8 for these terminals.

1317--

14−-- 3. "Graphics.Vty.Output.TerminfoBased": Defines a terminal instance that uses terminfo for all

15−-- control strings. No attempt is made to change the character set to UTF-8 for these terminals.

16−-- I don't know a way to reliably determine if that is required or how to do so.

17−--

18−-- 4. "Graphics.Vty.Output.XTermColor": This module contains an interface suitable for xterm-like

19−-- terminals. These are the terminals where TERM == xterm. This does use terminfo for as many

20−-- control codes as possible.

21−module Graphics.Vty.Output ( module Graphics.Vty.Output

22− , Output(..) -- \todo hide constructors

23− , AssumedState(..)

24− , DisplayContext(..) -- \todo hide constructors

25− , outputPicture

26− , displayContext

27− )

28− where

18+-- 4. "Graphics.Vty.Output.XTermColor": This module contains an

19+-- interface suitable for xterm-like terminals. These are the terminals

20+-- where @TERM@ begins with @xterm@. This does use terminfo for as many

21+-- control codes as possible.

22+module Graphics.Vty.Output

23+ ( outputForConfig

24+ , setCursorPos

25+ , hideCursor

26+ , showCursor

27+ )

28+where

2929

30−import Graphics.Vty.Prelude

30+import Control.Monad (when)

3131

3232import Graphics.Vty.Config

33−

33+import Graphics.Vty.Image (regionWidth, regionHeight)

3434import Graphics.Vty.Output.Interface

3535import Graphics.Vty.Output.XTermColor as XTermColor

3636import Graphics.Vty.Output.TerminfoBased as TerminfoBased

3737

3838import Blaze.ByteString.Builder (writeToByteString)

3939

40−import Control.Monad.Trans

41−

4240import Data.List (isPrefixOf)

41+

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

4343import Data.Monoid ((<>))

44+#endif

4445

45−-- | Returns a `Output` for the terminal specified in `Config`

46+-- | Returns an `Output` for the terminal specified in `Config`.

4647--

47−-- The specific Output implementation used is hidden from the API user. All terminal implementations

48−-- are assumed to perform more, or less, the same. Currently, all implementations use terminfo for at

49−-- least some terminal specific information.

48+-- The specific Output implementation used is hidden from the API user.

49+-- All terminal implementations are assumed to perform more, or less,

50+-- the same. Currently, all implementations use terminfo for at least

51+-- some terminal specific information.

5052--

51−-- Specifics about it being based on terminfo are hidden from the API user. If a terminal

52−-- implementation is developed for a terminal without terminfo support then Vty should work as

53−-- expected on that terminal.

53+-- If a terminal implementation is developed for a terminal without

54+-- terminfo support then Vty should work as expected on that terminal.

5455--

5556-- Selection of a terminal is done as follows:

5657--

5758-- * If TERM contains "xterm" or "screen", use XTermColor.

5859-- * otherwise use the TerminfoBased driver.

59−--

60−-- \todo add an implementation for windows that does not depend on terminfo. Should be installable

61−-- with only what is provided in the haskell platform. Use ansi-terminal

6260outputForConfig :: Config -> IO Output

63−outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do

61+outputForConfig Config{ outputFd = Just fd, termName = Just termName

62+ , colorMode = Just colorMode, .. } = do

6463 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName

65− then XTermColor.reserveTerminal termName fd

64+ then XTermColor.reserveTerminal termName fd colorMode

6665 -- Not an xterm-like terminal. try for generic terminfo.

67− else TerminfoBased.reserveTerminal termName fd

66+ else TerminfoBased.reserveTerminal termName fd colorMode

6867

6968 case mouseMode of

7069 Just s -> setMode t Mouse s

@@ -79,28 +78,30 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig

7978

8079-- | Sets the cursor position to the given output column and row.

8180--

82−-- This is not necessarially the same as the character position with the same coordinates.

83−-- Characters can be a variable number of columns in width.

81+-- This is not necessarily the same as the character position with the

82+-- same coordinates. Characters can be a variable number of columns in

83+-- width.

8484--

85−-- Currently, the only way to set the cursor position to a given character coordinate is to specify

86−-- the coordinate in the Picture instance provided to outputPicture or refresh.

87−setCursorPos :: MonadIO m => Output -> Int -> Int -> m ()

85+-- Currently, the only way to set the cursor position to a given

86+-- character coordinate is to specify the coordinate in the Picture

87+-- instance provided to 'outputPicture' or 'refresh'.

88+setCursorPos :: Output -> Int -> Int -> IO ()

8889setCursorPos t x y = do

8990 bounds <- displayBounds t

9091 when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do

9192 dc <- displayContext t bounds

92− liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

93+ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

9394

94−-- | Hides the cursor

95−hideCursor :: MonadIO m => Output -> m ()

95+-- | Hides the cursor.

96+hideCursor :: Output -> IO ()

9697hideCursor t = do

9798 bounds <- displayBounds t

9899 dc <- displayContext t bounds

99− liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc

100+ outputByteBuffer t $ writeToByteString $ writeHideCursor dc

100101

101−-- | Shows the cursor

102−showCursor :: MonadIO m => Output -> m ()

102+-- | Shows the cursor.

103+showCursor :: Output -> IO ()

103104showCursor t = do

104105 bounds <- displayBounds t

105106 dc <- displayContext t bounds

106− liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc

107+ outputByteBuffer t $ writeToByteString $ writeShowCursor dc

src/Graphics/Vty/Output/Interface.hs+176−132

@@ -1,21 +1,25 @@

11-- Copyright Corey O'Connor

2−-- General philosophy is: MonadIO is for equations exposed to clients.

3−{-# LANGUAGE CPP #-}

4−{-# LANGUAGE BangPatterns #-}

52{-# LANGUAGE RankNTypes #-}

63{-# LANGUAGE ExistentialQuantification #-}

74{-# LANGUAGE GADTs #-}

85{-# LANGUAGE FlexibleContexts #-}

9−

10−#ifndef MIN_VERSION_base

11−#defined MIN_VERSION_base(x,y,z) 1

12−#endif

13−

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'.

149module Graphics.Vty.Output.Interface

10+ ( Output(..)

11+ , AssumedState(..)

12+ , DisplayContext(..)

13+ , Mode(..)

14+ , displayContext

15+ , outputPicture

16+ , initialAssumedState

17+ , limitAttrForDisplay

18+ )

1519where

1620

17−import Graphics.Vty.Prelude

18−

21+import Graphics.Vty.Attributes

22+import Graphics.Vty.Image (DisplayRegion, regionHeight)

1923import Graphics.Vty.Picture

2024import Graphics.Vty.PictureToSpans

2125import Graphics.Vty.Span

@@ -25,72 +29,97 @@ import Graphics.Vty.DisplayAttributes

2529import Blaze.ByteString.Builder (Write, writeToByteString)

2630import Blaze.ByteString.Builder.ByteString (writeByteString)

2731

28−import Control.Monad.Trans

29−

3032import qualified Data.ByteString as BS

3133import Data.IORef

3234import qualified Data.Text.Encoding as T

3335import qualified Data.Text.Lazy as TL

3436import qualified Data.Vector as Vector

3537

36−#if !(MIN_VERSION_base(4,8,0))

37−import Data.Monoid (mempty, mappend)

38−#endif

39−

4038-- | Modal terminal features that can be enabled and disabled.

4139data Mode = Mouse

40+ -- ^ Mouse mode (whether the terminal is configured to provide

41+ -- mouse input events)

4242 | BracketedPaste

43+ -- ^ Paste mode (whether the terminal is configured to provide

44+ -- events on OS pastes)

45+ | Focus

46+ -- ^ Focus-in/focus-out events (whether the terminal is

47+ -- configured to provide events on focus change)

48+ | Hyperlink

49+ -- ^ Hyperlink mode via the 'withURL' attribute modifier (see

50+ -- https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda).

51+ -- Note that this may not work gracefully in all terminal

52+ -- emulators so be sure to test this mode with the terminals

53+ -- you intend to support. It is off by default.

4354 deriving (Eq, Read, Show)

4455

56+-- | The Vty terminal output interface.

4557data Output = Output

46− { -- | Text identifier for the output device. Used for debugging.

58+ { -- | Text identifier for the output device. Used for debugging.

4759 terminalID :: String

48− , releaseTerminal :: forall m. MonadIO m => m ()

49− -- | Clear the display and initialize the terminal to some initial display state.

50− --

51− -- The expectation of a program is that the display starts in some initial state.

52− -- The initial state would consist of fixed values:

53− --

54− -- - cursor at top left

55− -- - UTF-8 character encoding

56− -- - drawing characteristics are the default

57− --

58− -- The abstract operation I think all these behaviors are instances of is reserving exclusive

59− -- access to a display such that:

60− --

61− -- - The previous state cannot be determined

62− -- - When exclusive access to a display is released the display returns to the previous state.

63− , reserveDisplay :: forall m. MonadIO m => m ()

64− -- | Return the display to the state before `reserveDisplay`

65− -- If no previous state then set the display state to the initial state.

66− , releaseDisplay :: forall m. MonadIO m => m ()

67− -- | Returns the current display bounds.

68− , displayBounds :: forall m. MonadIO m => m DisplayRegion

69− -- | Output the byte string to the terminal device.

60+ -- | Release the terminal just prior to application exit and reset

61+ -- it to its state prior to application startup.

62+ , releaseTerminal :: IO ()

63+ -- | Clear the display and initialize the terminal to some initial

64+ -- display state.

65+ --

66+ -- The expectation of a program is that the display starts in some

67+ -- The initial state. initial state would consist of fixed values:

68+ --

69+ -- - cursor at top left

70+ -- - UTF-8 character encoding

71+ -- - drawing characteristics are the default

72+ , reserveDisplay :: IO ()

73+ -- | Return the display to the state before `reserveDisplay` If no

74+ -- previous state then set the display state to the initial state.

75+ , releaseDisplay :: IO ()

76+ -- | Sets the current display bounds (width, height).

77+ , setDisplayBounds :: (Int, Int) -> IO ()

78+ -- | Returns the current display bounds.

79+ , displayBounds :: IO DisplayRegion

80+ -- | Output the bytestring to the terminal device.

7081 , outputByteBuffer :: BS.ByteString -> IO ()

71− -- | Maximum number of colors supported by the context.

72− , contextColorCount :: Int

73− -- | if the cursor can be shown / hidden

82+ -- | Specifies whether the cursor can be shown / hidden.

7483 , supportsCursorVisibility :: Bool

75− -- | Indicates support for terminal modes for this output device

84+ -- | Indicates support for terminal modes for this output device.

7685 , supportsMode :: Mode -> Bool

77− -- | Enables or disables a mode (does nothing if the mode is unsupported)

78− , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()

79− -- | Returns whether a mode is enabled

80− , getModeStatus :: forall m. MonadIO m => Mode -> m Bool

86+ -- | Enables or disables a mode (does nothing if the mode is

87+ -- unsupported).

88+ , setMode :: Mode -> Bool -> IO ()

89+ -- | Returns whether a mode is enabled.

90+ , getModeStatus :: Mode -> IO Bool

8191 , assumedStateRef :: IORef AssumedState

82− -- | Acquire display access to the given region of the display.

83− -- Currently all regions have the upper left corner of (0,0) and the lower right corner at

84− -- (max displayWidth providedWidth, max displayHeight providedHeight)

85− , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext

86− -- | Ring the terminal bell if supported.

87− , ringTerminalBell :: forall m. MonadIO m => m ()

88− -- | Returns whether the terminal has an audio bell feature.

89− , supportsBell :: forall m. MonadIO m => m Bool

92+ -- | Acquire display access to the given region of the display.

93+ -- Currently all regions have the upper left corner of (0,0) and

94+ -- the lower right corner at (max displayWidth providedWidth, max

95+ -- displayHeight providedHeight)

96+ , mkDisplayContext :: Output -> DisplayRegion -> IO DisplayContext

97+ -- | Ring the terminal bell if supported.

98+ , ringTerminalBell :: IO ()

99+ -- | Returns whether the terminal has an audio bell feature.

100+ , supportsBell :: IO Bool

101+ -- | Returns whether the terminal supports italicized text.

102+ --

103+ -- This is terminal-dependent and should make a best effort to

104+ -- determine whether this feature is supported, but even if the

105+ -- terminal advertises support (e.g. via terminfo) that might not

106+ -- be a reliable indicator of whether the feature will work as

107+ -- desired.

108+ , supportsItalics :: IO Bool

109+ -- | Returns whether the terminal supports strikethrough text.

110+ --

111+ -- This is terminal-dependent and should make a best effort to

112+ -- determine whether this feature is supported, but even if the

113+ -- terminal advertises support (e.g. via terminfo) that might not

114+ -- be a reliable indicator of whether the feature will work as

115+ -- desired.

116+ , supportsStrikethrough :: IO Bool

117+ -- | Returns how many colors the terminal supports.

118+ , outputColorMode :: ColorMode

90119 }

91120

92−displayContext :: MonadIO m => Output -> DisplayRegion -> m DisplayContext

93−displayContext t = liftIO . mkDisplayContext t t

121+displayContext :: Output -> DisplayRegion -> IO DisplayContext

122+displayContext t = mkDisplayContext t t

94123

95124data AssumedState = AssumedState

96125 { prevFattr :: Maybe FixedAttr

@@ -102,69 +131,71 @@ initialAssumedState = AssumedState Nothing Nothing

102131

103132data DisplayContext = DisplayContext

104133 { contextDevice :: Output

105− -- | Provide the bounds of the display context.

134+ -- | Provide the bounds of the display context.

106135 , contextRegion :: DisplayRegion

107− -- | sets the output position to the specified row and column. Where the number of bytes

108− -- required for the control codes can be specified seperate from the actual byte sequence.

136+ -- | Sets the output position to the specified row and column

137+ -- where the number of bytes required for the control codes can be

138+ -- specified seperate from the actual byte sequence.

109139 , writeMoveCursor :: Int -> Int -> Write

110140 , writeShowCursor :: Write

111141 , writeHideCursor :: Write

112− -- | Assure the specified output attributes will be applied to all the following text until the

113− -- next output attribute change. Where the number of bytes required for the control codes can

114− -- be specified seperate from the actual byte sequence. The required number of bytes must be

115− -- at least the maximum number of bytes required by any attribute changes. The serialization

116− -- equations must provide the ptr to the next byte to be specified in the output buffer.

142+ -- Ensure that the specified output attributes will be applied to

143+ -- all the following text until the next output attribute change

144+ -- where the number of bytes required for the control codes can be

145+ -- specified seperately from the actual byte sequence. The required

146+ -- number of bytes must be at least the maximum number of bytes

147+ -- required by any attribute changes. The serialization equations

148+ -- must provide the ptr to the next byte to be specified in the

149+ -- output buffer.

117150 --

118− -- The currently applied display attributes are provided as well. The Attr data type can

119− -- specify the style or color should not be changed from the currently applied display

120− -- attributes. In order to support this the currently applied display attributes are required.

121− -- In addition it may be possible to optimize the state changes based off the currently applied

122− -- display attributes.

123− , writeSetAttr :: FixedAttr -> Attr -> DisplayAttrDiff -> Write

124− -- | Reset the display attributes to the default display attributes

125− , writeDefaultAttr :: Write

151+ -- The currently applied display attributes are provided as well.

152+ -- The Attr data type can specify the style or color should not be

153+ -- changed from the currently applied display attributes. In order

154+ -- to support this the currently applied display attributes are

155+ -- required. In addition it may be possible to optimize the state

156+ -- changes based off the currently applied display attributes.

157+ , writeSetAttr :: Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write

158+ -- | Reset the display attributes to the default display attributes.

159+ , writeDefaultAttr :: Bool -> Write

126160 , writeRowEnd :: Write

127161 -- | See `Graphics.Vty.Output.XTermColor.inlineHack`

128162 , inlineHack :: IO ()

129163 }

130164

131−-- | All terminals serialize UTF8 text to the terminal device exactly as serialized in memory.

165+-- | All terminals serialize UTF8 text to the terminal device exactly as

166+-- serialized in memory.

132167writeUtf8Text :: BS.ByteString -> Write

133168writeUtf8Text = writeByteString

134169

135170-- | Displays the given `Picture`.

136171--

137−-- 0. The image is cropped to the display size.

172+-- 1. The image is cropped to the display size.

138173--

139−-- 1. Converted into a sequence of attribute changes and text spans.

140−--

141−-- 2. The cursor is hidden.

174+-- 2. Converted into a sequence of attribute changes and text spans.

142175--

143−-- 3. Serialized to the display.

176+-- 3. The cursor is hidden.

144177--

145−-- 4. The cursor is then shown and positioned or kept hidden.

146−--

147−-- todo: specify possible IO exceptions.

148−-- abstract from IO monad to a MonadIO instance.

149−outputPicture :: MonadIO m => DisplayContext -> Picture -> m ()

150−outputPicture dc pic = liftIO $ do

178+-- 4. Serialized to the display.

179+--

180+-- 5. The cursor is then shown and positioned or kept hidden.

181+outputPicture :: DisplayContext -> Picture -> IO ()

182+outputPicture dc pic = do

183+ urlsEnabled <- getModeStatus (contextDevice dc) Hyperlink

151184 as <- readIORef (assumedStateRef $ contextDevice dc)

152185 let manipCursor = supportsCursorVisibility (contextDevice dc)

153186 r = contextRegion dc

154187 ops = displayOpsForPic pic r

155− initialAttr = FixedAttr defaultStyleMask Nothing Nothing

156− -- Diff the previous output against the requested output. Differences are currently on a per-row

157− -- basis.

158− -- \todo handle resizes that crop the dominate directions better.

188+ initialAttr = FixedAttr defaultStyleMask Nothing Nothing Nothing

189+ -- Diff the previous output against the requested output.

190+ -- Differences are currently on a per-row basis.

159191 diffs :: [Bool] = case prevOutputOps as of

160− Nothing -> replicate (fromEnum $ regionHeight $ effectedRegion ops) True

161− Just previousOps -> if effectedRegion previousOps /= effectedRegion ops

192+ Nothing -> replicate (fromEnum $ regionHeight $ affectedRegion ops) True

193+ Just previousOps -> if affectedRegion previousOps /= affectedRegion ops

162194 then replicate (displayOpsRows ops) True

163− else zipWith (/=) (Vector.toList previousOps)

164− (Vector.toList ops)

195+ else Vector.toList $ Vector.zipWith (/=) previousOps ops

165196 -- build the Write corresponding to the output image

166197 out = (if manipCursor then writeHideCursor dc else mempty)

167− `mappend` writeOutputOps dc initialAttr diffs ops

198+ `mappend` writeOutputOps urlsEnabled dc initialAttr diffs ops

168199 `mappend`

169200 (let (w,h) = contextRegion dc

170201 clampX = max 0 . min (w-1)

@@ -175,9 +206,15 @@ outputPicture dc pic = liftIO $ do

175206 AbsoluteCursor x y ->

176207 writeShowCursor dc `mappend`

177208 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)

178215 Cursor x y ->

179216 let m = cursorOutputMap ops $ picCursor pic

180− (ox, oy) = charToOutputPos m (x,y)

217+ (ox, oy) = charToOutputPos m (clampX x, clampY y)

181218 in writeShowCursor dc `mappend`

182219 writeMoveCursor dc (clampX ox) (clampY oy)

183220 )

@@ -187,15 +224,15 @@ outputPicture dc pic = liftIO $ do

187224 let as' = as { prevOutputOps = Just ops }

188225 writeIORef (assumedStateRef $ contextDevice dc) as'

189226

190−writeOutputOps :: DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write

191−writeOutputOps dc initialAttr diffs ops =

227+writeOutputOps :: Bool -> DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write

228+writeOutputOps urlsEnabled dc initialAttr diffs ops =

192229 let (_, out, _) = Vector.foldl' writeOutputOps'

193230 (0, mempty, diffs)

194231 ops

195232 in out

196− where

233+ where

197234 writeOutputOps' (y, out, True : diffs') spanOps

198− = let spanOut = writeSpanOps dc y initialAttr spanOps

235+ = let spanOut = writeSpanOps urlsEnabled dc y initialAttr spanOps

199236 out' = out `mappend` spanOut

200237 in (y+1, out', diffs')

201238 writeOutputOps' (y, out, False : diffs') _spanOps

@@ -203,33 +240,34 @@ writeOutputOps dc initialAttr diffs ops =

203240 writeOutputOps' (_y, _out, []) _spanOps

204241 = error "vty - output spans without a corresponding diff."

205242

206−writeSpanOps :: DisplayContext -> Int -> FixedAttr -> SpanOps -> Write

207−writeSpanOps dc y initialAttr spanOps =

243+writeSpanOps :: Bool -> DisplayContext -> Int -> FixedAttr -> SpanOps -> Write

244+writeSpanOps urlsEnabled dc y initialAttr spanOps =

208245 -- The first operation is to set the cursor to the start of the row

209− let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc

246+ let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc urlsEnabled

210247 -- then the span ops are serialized in the order specified

211− in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp dc op fattr of

248+ in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp urlsEnabled dc op fattr of

212249 (opOut, fattr') -> (out `mappend` opOut, fattr')

213250 )

214251 (start, initialAttr)

215252 spanOps

216253

217−writeSpanOp :: DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)

218−writeSpanOp dc (TextSpan attr _ _ str) fattr =

254+writeSpanOp :: Bool -> DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)

255+writeSpanOp urlsEnabled dc (TextSpan attr _ _ str) fattr =

219256 let attr' = limitAttrForDisplay (contextDevice dc) attr

220257 fattr' = fixDisplayAttr fattr attr'

221258 diffs = displayAttrDiffs fattr fattr'

222− out = writeSetAttr dc fattr attr' diffs

259+ out = writeSetAttr dc urlsEnabled fattr attr' diffs

223260 `mappend` writeUtf8Text (T.encodeUtf8 $ TL.toStrict str)

224261 in (out, fattr')

225−writeSpanOp _dc (Skip _) _fattr = error "writeSpanOp for Skip"

226−writeSpanOp dc (RowEnd _) fattr = (writeDefaultAttr dc `mappend` writeRowEnd dc, fattr)

262+writeSpanOp _ _ (Skip _) _fattr = error "writeSpanOp for Skip"

263+writeSpanOp urlsEnabled dc (RowEnd _) fattr = (writeDefaultAttr dc urlsEnabled `mappend` writeRowEnd dc, fattr)

227264

228−-- | The cursor position is given in X,Y character offsets. Due to multi-column characters this

229−-- needs to be translated to column, row positions.

265+-- | The cursor position is given in X,Y character offsets. Due to

266+-- multi-column characters this needs to be translated to column, row

267+-- positions.

230268data CursorOutputMap = CursorOutputMap

231269 { charToOutputPos :: (Int, Int) -> (Int, Int)

232− }

270+ }

233271

234272cursorOutputMap :: DisplayOps -> Cursor -> CursorOutputMap

235273cursorOutputMap spanOps _cursor = CursorOutputMap

@@ -239,18 +277,18 @@ cursorOutputMap spanOps _cursor = CursorOutputMap

239277cursorColumnOffset :: DisplayOps -> Int -> Int -> Int

240278cursorColumnOffset ops cx cy =

241279 let cursorRowOps = Vector.unsafeIndex ops (fromEnum cy)

242− (outOffset, _, _)

243− = Vector.foldl' ( \(d, currentCx, done) op ->

280+ (outOffset, _, _)

281+ = Vector.foldl' ( \(d, currentCx, done) op ->

244282 if done then (d, currentCx, done) else case spanOpHasWidth op of

245283 Nothing -> (d, currentCx, False)

246284 Just (cw, ow) -> case compare cx (currentCx + cw) of

247285 GT -> ( d + ow

248286 , currentCx + cw

249− , False

287+ , False

250288 )

251289 EQ -> ( d + ow

252290 , currentCx + cw

253− , True

291+ , True

254292 )

255293 LT -> ( d + columnsToCharOffset (cx - currentCx) op

256294 , currentCx + cw

@@ -261,27 +299,33 @@ cursorColumnOffset ops cx cy =

261299 cursorRowOps

262300 in outOffset

263301

264−-- | Not all terminals support all display attributes. This filters a display attribute to what the

265−-- given terminal can display.

302+-- | Not all terminals support all display attributes. This filters a

303+-- display attribute to what the given terminal can display.

266304limitAttrForDisplay :: Output -> Attr -> Attr

267−limitAttrForDisplay t attr

305+limitAttrForDisplay t attr

268306 = attr { attrForeColor = clampColor $ attrForeColor attr

269307 , attrBackColor = clampColor $ attrBackColor attr

270308 }

271309 where

272310 clampColor Default = Default

273311 clampColor KeepCurrent = KeepCurrent

274− clampColor (SetTo c) = clampColor' c

275− clampColor' (ISOColor v)

276− | contextColorCount t < 8 = Default

277− | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8)

278− | otherwise = SetTo $ ISOColor v

279− clampColor' (Color240 v)

280− -- TODO: Choose closes ISO color?

281− | contextColorCount t < 8 = Default

282− | contextColorCount t < 16 = Default

283− | contextColorCount t <= 256 = SetTo $ Color240 v

284− | otherwise

285− = let p :: Double = fromIntegral v / 240.0

286− v' = floor $ p * (fromIntegral $ contextColorCount t)

287− in SetTo $ Color240 v'

312+ clampColor (SetTo c) = clampColor' (outputColorMode t) c

313+

314+ clampColor' NoColor _ = Default

315+

316+ clampColor' ColorMode8 (ISOColor v)

317+ | v >= 8 = SetTo $ ISOColor (v - 8)

318+ | otherwise = SetTo $ ISOColor v

319+ clampColor' ColorMode8 _ = Default

320+

321+ clampColor' ColorMode16 c@(ISOColor _) = SetTo c

322+ clampColor' ColorMode16 _ = Default

323+

324+ clampColor' (ColorMode240 _) c@(ISOColor _) = SetTo c

325+ clampColor' (ColorMode240 colorCount) c@(Color240 n)

326+ | n <= colorCount = SetTo c

327+ | otherwise = Default

328+ clampColor' colorMode@(ColorMode240 _) (RGBColor r g b) =

329+ clampColor' colorMode (color240 r g b)

330+

331+ clampColor' FullColor c = SetTo c

src/Graphics/Vty/Output/Mock.hs+40−25

@@ -1,13 +1,17 @@

11-- Copyright Corey O'Connor

22{-# LANGUAGE FlexibleInstances #-}

33{-# LANGUAGE TypeFamilies #-}

4−-- | This provides a mock terminal implementation that is nice for testing. This transforms the

5−-- output operations to visible characters. Which is nice for some tests.

6−module Graphics.Vty.Output.Mock ( MockData, mockTerminal )

7− where

8−

9−import Graphics.Vty.Prelude

4+-- | This provides a mock terminal implementation that is nice for

5+-- testing. This transforms the output operations to visible characters

6+-- which is useful for testing.

7+module Graphics.Vty.Output.Mock

8+ ( MockData

9+ , mockTerminal

10+ )

11+where

1012

13+import Graphics.Vty.Image (DisplayRegion)

14+import Graphics.Vty.Attributes.Color (ColorMode(ColorMode16))

1115import Graphics.Vty.Output.Interface

1216

1317import Blaze.ByteString.Builder.Word (writeWord8)

@@ -20,18 +24,20 @@ import qualified Data.String.UTF8 as UTF8

2024

2125type MockData = IORef (UTF8.UTF8 BS.ByteString)

2226

23−-- | The mock display terminal produces a string representation of the requested picture. There is

24−-- *not* an isomorphism between the string representation and the picture. The string

25−-- representation is a simplification of the picture that is only useful in debugging VTY without

26−-- considering terminal specific issues.

27+-- | The mock display terminal produces a string representation of

28+-- the requested picture. There is *not* an isomorphism between the

29+-- string representation and the picture. The string representation is

30+-- a simplification of the picture that is only useful in debugging VTY

31+-- without considering terminal specific issues.

2732--

28−-- The mock implementation is useful in manually determining if the sequence of terminal operations

29−-- matches the expected sequence. So requirement of the produced representation is simplicity in

30−-- parsing the text representation and determining how the picture was mapped to terminal

31−-- operations.

33+-- The mock implementation is useful in manually determining if the

34+-- sequence of terminal operations matches the expected sequence. The

35+-- requirement of the produced representation is simplicity in parsing

36+-- the text representation and determining how the picture was mapped to

37+-- terminal operations.

3238--

33−-- The string representation is a sequence of identifiers where each identifier is the name of an

34−-- operation in the algebra.

39+-- The string representation is a sequence of identifiers where each

40+-- identifier is the name of an operation in the algebra.

3541mockTerminal :: (Applicative m, MonadIO m) => DisplayRegion -> m (MockData, Output)

3642mockTerminal r = liftIO $ do

3743 outRef <- newIORef undefined

@@ -43,30 +49,39 @@ mockTerminal r = liftIO $ do

4349 , releaseDisplay = return ()

4450 , ringTerminalBell = return ()

4551 , supportsBell = return False

52+ , supportsItalics = return False

53+ , supportsStrikethrough = return False

54+ , setDisplayBounds = const $ return ()

4655 , displayBounds = return r

4756 , outputByteBuffer = \bytes -> do

4857 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"

4958 writeIORef outRef $ UTF8.fromRep bytes

50− , contextColorCount = 16

5159 , supportsCursorVisibility = True

5260 , supportsMode = const False

5361 , setMode = const $ const $ return ()

5462 , getModeStatus = const $ return False

5563 , assumedStateRef = newAssumedStateRef

64+ , outputColorMode = ColorMode16

5665 , mkDisplayContext = \tActual rActual -> return $ DisplayContext

5766 { contextRegion = rActual

5867 , contextDevice = tActual

59− -- A cursor move is always visualized as the single character 'M'

68+ -- A cursor move is always visualized as the single

69+ -- character 'M'

6070 , writeMoveCursor = \_x _y -> writeWord8 $ toEnum $ fromEnum 'M'

61− -- Show cursor is always visualized as the single character 'S'

71+ -- Show cursor is always visualized as the single

72+ -- character 'S'

6273 , writeShowCursor = writeWord8 $ toEnum $ fromEnum 'S'

63− -- Hide cursor is always visualized as the single character 'H'

74+ -- Hide cursor is always visualized as the single

75+ -- character 'H'

6476 , writeHideCursor = writeWord8 $ toEnum $ fromEnum 'H'

65− -- An attr change is always visualized as the single character 'A'

66− , writeSetAttr = \_fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'

67− -- default attr is always visualized as the single character 'D'

68− , writeDefaultAttr = writeWord8 $ toEnum $ fromEnum 'D'

69− -- row end is always visualized as the single character 'E'

77+ -- An attr change is always visualized as the single

78+ -- character 'A'

79+ , writeSetAttr = \_ _fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'

80+ -- default attr is always visualized as the single

81+ -- character 'D'

82+ , writeDefaultAttr = const $ writeWord8 $ toEnum $ fromEnum 'D'

83+ -- row end is always visualized as the single character

84+ -- 'E'

7085 , writeRowEnd = writeWord8 $ toEnum $ fromEnum 'E'

7186 , inlineHack = return ()

7287 }

src/Graphics/Vty/Output/TerminfoBased.hs+290−161

@@ -1,42 +1,40 @@

1−{-# LANGUAGE RecordWildCards #-}

2−{-# LANGUAGE CPP #-}

31{-# LANGUAGE FlexibleInstances #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE CPP #-}

44{-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-}

55{-# CFILES gwinsz.c #-}

66

7−#ifndef MIN_VERSION_base

8−#defined MIN_VERSION_base(x,y,z) 1

9−#endif

10−

11−-- | Terminfo based terminal handling.

12−--

13−-- The color handling assumes tektronix like. No HP support provided. If the terminal is not one I

14−-- have easy access to then color support is entirely based of the docs. Probably with some

15−-- assumptions mixed in.

7+-- | Terminfo-based terminal output driver.

168--

179-- Copyright Corey O'Connor (coreyoconnor@gmail.com)

18−module Graphics.Vty.Output.TerminfoBased ( reserveTerminal )

19− where

20−

21−import Graphics.Vty.Prelude

22−

10+module Graphics.Vty.Output.TerminfoBased

11+ ( reserveTerminal

12+ , setWindowSize

13+ )

14+where

15+

16+import Control.Monad (when)

17+import Data.Bits (shiftL, (.&.))

18+import qualified Data.ByteString as BS

2319import Data.ByteString.Internal (toForeignPtr)

2420import Data.Terminfo.Parse

2521import Data.Terminfo.Eval

2622

2723import Graphics.Vty.Attributes

24+import Graphics.Vty.Image (DisplayRegion)

2825import Graphics.Vty.DisplayAttributes

2926import Graphics.Vty.Output.Interface

3027

31−import Blaze.ByteString.Builder (Write, writeToByteString)

32−

33−import Control.Monad.Trans

28+import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable, writeWord8)

3429

35−import Data.Bits ((.&.))

3630import Data.IORef

3731import Data.Maybe (isJust, isNothing, fromJust)

3832import Data.Word

3933

34+#if !MIN_VERSION_base(4,8,0)

35+import Data.Foldable (foldMap)

36+#endif

37+

4038import Foreign.C.Types ( CInt(..), CLong(..) )

4139import Foreign.ForeignPtr (withForeignPtr)

4240import Foreign.Ptr (Ptr, plusPtr)

@@ -45,18 +43,12 @@ import qualified System.Console.Terminfo as Terminfo

4543import System.Posix.IO (fdWriteBuf)

4644import System.Posix.Types (Fd(..))

4745

48−#if !(MIN_VERSION_base(4,8,0))

49−import Data.Foldable (foldMap)

50−import Data.Monoid

51−#endif

52−

53−data TerminfoCaps = TerminfoCaps

46+data TerminfoCaps = TerminfoCaps

5447 { smcup :: Maybe CapExpression

5548 , rmcup :: Maybe CapExpression

5649 , cup :: CapExpression

5750 , cnorm :: Maybe CapExpression

5851 , civis :: Maybe CapExpression

59− , supportsNoColors :: Bool

6052 , useAltColorMap :: Bool

6153 , setForeColor :: CapExpression

6254 , setBackColor :: CapExpression

@@ -71,15 +63,21 @@ data DisplayAttrCaps = DisplayAttrCaps

7163 { setAttrStates :: Maybe CapExpression

7264 , enterStandout :: Maybe CapExpression

7365 , exitStandout :: Maybe CapExpression

66+ , enterItalic :: Maybe CapExpression

67+ , exitItalic :: Maybe CapExpression

68+ , enterStrikethrough :: Maybe CapExpression

69+ , exitStrikethrough :: Maybe CapExpression

7470 , enterUnderline :: Maybe CapExpression

7571 , exitUnderline :: Maybe CapExpression

7672 , enterReverseVideo :: Maybe CapExpression

7773 , enterDimMode :: Maybe CapExpression

7874 , enterBoldMode :: Maybe CapExpression

7975 }

80−

81−-- kinda like: https://code.google.com/p/vim/source/browse/src/fileio.c#10422

82−-- fdWriteBuf will throw on error. Unless the error is EINTR. On EINTR the write will be retried.

76+

77+-- kinda like:

78+-- https://code.google.com/p/vim/source/browse/src/fileio.c#10422

79+-- fdWriteBuf will throw on error. Unless the error is EINTR. On EINTR

80+-- the write will be retried.

8381fdWriteAll :: Fd -> Ptr Word8 -> Int -> Int -> IO Int

8482fdWriteAll outFd ptr len count

8583 | len < 0 = fail "fdWriteAll: len is less than 0"

@@ -95,71 +93,95 @@ sendCapToTerminal :: Output -> CapExpression -> [CapParam] -> IO ()

9593sendCapToTerminal t cap capParams = do

9694 outputByteBuffer t $ writeToByteString $ writeCapExpr cap capParams

9795

98−{- | Uses terminfo for all control codes. While this should provide the most compatible terminal

99− - terminfo does not support some features that would increase efficiency and improve compatibility:

100− -

101− - * determine the character encoding supported by the terminal. Should this be taken from the LANG

102− - environment variable?

103− -

104− - * Provide independent string capabilities for all display attributes.

105− -

106− - todo: Some display attributes like underline and bold have independent string capabilities that

107− - should be used instead of the generic "sgr" string capability.

108− -}

109−reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

110−reserveTerminal termName outFd = liftIO $ do

96+-- | Constructs an output driver that uses terminfo for all control

97+-- codes. While this should provide the most compatible terminal,

98+-- terminfo does not support some features that would increase

99+-- efficiency and improve compatibility:

100+--

101+-- * determining the character encoding supported by the terminal.

102+-- Should this be taken from the LANG environment variable?

103+--

104+-- * Providing independent string capabilities for all display

105+-- attributes.

106+reserveTerminal :: String -> Fd -> ColorMode -> IO Output

107+reserveTerminal termName outFd colorMode = do

111108 ti <- Terminfo.setupTerm termName

112109 -- assumes set foreground always implies set background exists.

113− -- if set foreground is not set then all color changing style attributes are filtered.

110+ -- if set foreground is not set then all color changing style

111+ -- attributes are filtered.

114112 msetaf <- probeCap ti "setaf"

115113 msetf <- probeCap ti "setf"

116− let (noColors, useAlt, setForeCap)

114+ let (useAlt, setForeCap)

117115 = case msetaf of

118− Just setaf -> (False, False, setaf)

116+ Just setaf -> (False, setaf)

119117 Nothing -> case msetf of

120− Just setf -> (False, True, setf)

121− Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName)

118+ Just setf -> (True, setf)

119+ Nothing -> (True, error $ "no fore color support for terminal " ++ termName)

122120 msetab <- probeCap ti "setab"

123121 msetb <- probeCap ti "setb"

124− let set_back_cap

122+ let setBackCap

125123 = case msetab of

124+ Just setab -> setab

126125 Nothing -> case msetb of

127126 Just setb -> setb

128127 Nothing -> error $ "no back color support for terminal " ++ termName

129− Just setab -> setab

128+

129+ hyperlinkModeStatus <- newIORef False

130+ newAssumedStateRef <- newIORef initialAssumedState

131+

132+ let terminfoSetMode m newStatus = do

133+ curStatus <- terminfoModeStatus m

134+ when (newStatus /= curStatus) $

135+ case m of

136+ Hyperlink -> do

137+ writeIORef hyperlinkModeStatus newStatus

138+ writeIORef newAssumedStateRef initialAssumedState

139+ _ -> return ()

140+ terminfoModeStatus m =

141+ case m of

142+ Hyperlink -> readIORef hyperlinkModeStatus

143+ _ -> return False

144+ terminfoModeSupported Hyperlink = True

145+ terminfoModeSupported _ = False

146+

130147 terminfoCaps <- pure TerminfoCaps

131148 <*> probeCap ti "smcup"

132149 <*> probeCap ti "rmcup"

133150 <*> requireCap ti "cup"

134151 <*> probeCap ti "cnorm"

135152 <*> probeCap ti "civis"

136− <*> pure noColors

137153 <*> pure useAlt

138154 <*> pure setForeCap

139− <*> pure set_back_cap

155+ <*> pure setBackCap

140156 <*> requireCap ti "sgr0"

141157 <*> requireCap ti "clear"

142158 <*> requireCap ti "el"

143159 <*> currentDisplayAttrCaps ti

144160 <*> probeCap ti "bel"

145− newAssumedStateRef <- newIORef initialAssumedState

146161 let t = Output

147162 { terminalID = termName

148− , releaseTerminal = liftIO $ do

163+ , releaseTerminal = do

149164 sendCap setDefaultAttr []

150165 maybeSendCap cnorm []

151166 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps

152− , ringTerminalBell = liftIO $ maybeSendCap ringBellAudio []

153− , reserveDisplay = liftIO $ do

154− -- If there is no support for smcup: Clear the screen and then move the mouse to the

155− -- home position to approximate the behavior.

167+ , supportsItalics = return $ (isJust $ enterItalic (displayAttrCaps terminfoCaps)) &&

168+ (isJust $ exitItalic (displayAttrCaps terminfoCaps))

169+ , supportsStrikethrough = return $ (isJust $ enterStrikethrough (displayAttrCaps terminfoCaps)) &&

170+ (isJust $ exitStrikethrough (displayAttrCaps terminfoCaps))

171+ , ringTerminalBell = maybeSendCap ringBellAudio []

172+ , reserveDisplay = do

173+ -- If there is no support for smcup: Clear the screen

174+ -- and then move the mouse to the home position to

175+ -- approximate the behavior.

156176 maybeSendCap smcup []

157177 sendCap clearScreen []

158− , releaseDisplay = liftIO $ do

178+ , releaseDisplay = do

159179 maybeSendCap rmcup []

160180 maybeSendCap cnorm []

181+ , setDisplayBounds = \(w, h) ->

182+ setWindowSize outFd (w, h)

161183 , displayBounds = do

162− rawSize <- liftIO $ getWindowSize outFd

184+ rawSize <- getWindowSize outFd

163185 case rawSize of

164186 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize

165187 | otherwise -> return (w,h)

@@ -170,51 +192,48 @@ reserveTerminal termName outFd = liftIO $ do

170192 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "

171193 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen

172194 ++ " Please report this bug to vty project."

173− , contextColorCount

174− = case supportsNoColors terminfoCaps of

175− False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of

176− Nothing -> 8

177− Just v -> toEnum v

178− True -> 1

179195 , supportsCursorVisibility = isJust $ civis terminfoCaps

180− , supportsMode = const False

181− , setMode = const $ const $ return ()

182− , getModeStatus = const $ return False

196+ , supportsMode = terminfoModeSupported

197+ , setMode = terminfoSetMode

198+ , getModeStatus = terminfoModeStatus

183199 , assumedStateRef = newAssumedStateRef

184− -- I think fix would help assure tActual is the only reference. I was having issues

185− -- tho.

186− , mkDisplayContext = \tActual -> liftIO . terminfoDisplayContext tActual terminfoCaps

200+ , outputColorMode = colorMode

201+ -- I think fix would help assure tActual is the only

202+ -- reference. I was having issues tho.

203+ , mkDisplayContext = (`terminfoDisplayContext` terminfoCaps)

187204 }

188205 sendCap s = sendCapToTerminal t (s terminfoCaps)

189206 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)

190207 return t

191208

192−requireCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m CapExpression

193−requireCap ti capName

209+requireCap :: Terminfo.Terminal -> String -> IO CapExpression

210+requireCap ti capName

194211 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

195212 Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""

196213 Just capStr -> parseCap capStr

197214

198−probeCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m (Maybe CapExpression)

199−probeCap ti capName

215+probeCap :: Terminfo.Terminal -> String -> IO (Maybe CapExpression)

216+probeCap ti capName

200217 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

201218 Nothing -> return Nothing

202219 Just capStr -> Just <$> parseCap capStr

203220

204−parseCap :: (Applicative m, MonadIO m) => String -> m CapExpression

221+parseCap :: String -> IO CapExpression

205222parseCap capStr = do

206223 case parseCapExpression capStr of

207224 Left e -> fail $ show e

208225 Right cap -> return cap

209226

210−currentDisplayAttrCaps :: ( Applicative m, MonadIO m )

211− => Terminfo.Terminal

212− -> m DisplayAttrCaps

213−currentDisplayAttrCaps ti

214− = pure DisplayAttrCaps

227+currentDisplayAttrCaps :: Terminfo.Terminal -> IO DisplayAttrCaps

228+currentDisplayAttrCaps ti

229+ = pure DisplayAttrCaps

215230 <*> probeCap ti "sgr"

216231 <*> probeCap ti "smso"

217232 <*> probeCap ti "rmso"

233+ <*> probeCap ti "sitm"

234+ <*> probeCap ti "ritm"

235+ <*> probeCap ti "smxx"

236+ <*> probeCap ti "rmxx"

218237 <*> probeCap ti "smul"

219238 <*> probeCap ti "rmul"

220239 <*> probeCap ti "rev"

@@ -224,10 +243,17 @@ currentDisplayAttrCaps ti

224243foreign import ccall "gwinsz.h vty_c_get_window_size" c_getWindowSize :: Fd -> IO CLong

225244

226245getWindowSize :: Fd -> IO (Int,Int)

227−getWindowSize fd = do

246+getWindowSize fd = do

228247 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd

229248 return (fromIntegral b, fromIntegral a)

230249

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+

231257terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext

232258terminfoDisplayContext tActual terminfoCaps r = return dc

233259 where dc = DisplayContext

@@ -241,123 +267,204 @@ terminfoDisplayContext tActual terminfoCaps r = return dc

241267 Nothing -> error "this terminal does not support hide cursor"

242268 Just c -> writeCapExpr c []

243269 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps

244− , writeDefaultAttr = writeCapExpr (setDefaultAttr terminfoCaps) []

270+ , writeDefaultAttr = \urlsEnabled ->

271+ writeCapExpr (setDefaultAttr terminfoCaps) [] `mappend`

272+ (if urlsEnabled then writeURLEscapes EndLink else mempty) `mappend`

273+ (case exitStrikethrough $ displayAttrCaps terminfoCaps of

274+ Just cap -> writeCapExpr cap []

275+ Nothing -> mempty

276+ )

245277 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []

246278 , inlineHack = return ()

247279 }

248280

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+

249295-- | Portably setting the display attributes is a giant pain in the ass.

250296--

251−-- If the terminal supports the sgr capability (which sets the on/off state of each style

252−-- directly ; and, for no good reason, resets the colors to the default) this procedure is used:

297+-- 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

299+-- colors to the default) this procedure is used:

253300--

254301-- 0. set the style attributes. This resets the fore and back color.

255302--

256303-- 1, If a foreground color is to be set then set the foreground color

257304--

258305-- 2. likewise with the background color

259−--

260−-- If the terminal does not support the sgr cap then:

261−-- if there is a change from an applied color to the default (in either the fore or back color)

262−-- then:

263306--

264−-- 0. reset all display attributes (sgr0)

307+-- If the terminal does not support the sgr cap then: if there is a

308+-- change from an applied color to the default (in either the fore or

309+-- back color) then:

265310--

266−-- 1. enter required style modes

311+-- 0. reset all display attributes (sgr0)

267312--

268−-- 2. set the fore color if required

313+-- 1. enter required style modes

269314--

270−-- 3. set the back color if required

315+-- 2. set the fore color if required

271316--

272−-- Entering the required style modes could require a reset of the display attributes. If this is

273−-- the case then the back and fore colors always need to be set if not default.

317+-- 3. set the back color if required

318+--

319+-- Entering the required style modes could require a reset of the

320+-- display attributes. If this is the case then the back and fore colors

321+-- always need to be set if not default.

274322--

275323-- This equation implements the above logic.

276324--

277−-- \todo This assumes the removal of color changes in the display attributes is done as expected

278−-- with noColors == True. See `limitAttrForDisplay`

325+-- Note that this assumes the removal of color changes in the

326+-- display attributes is done as expected with noColors == True. See

327+-- `limitAttrForDisplay`.

279328--

280−-- \todo This assumes that fewer state changes, followed by fewer bytes, is what to optimize. I

281−-- haven't measured this or even examined terminal implementations. *shrug*

282−terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> FixedAttr -> Attr -> DisplayAttrDiff -> Write

283−terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do

284− case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of

285− -- The only way to reset either color, portably, to the default is to use either the set

286− -- state capability or the set default capability.

287− True -> do

329+-- Note that this optimizes for fewer state changes followed by fewer

330+-- bytes.

331+terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write

332+terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

333+ urlAttrs urlsEnabled `mappend` case (foreColorDiff diffs == ColorToDefault) || (backColorDiff diffs == ColorToDefault) of

334+ -- The only way to reset either color, portably, to the default

335+ -- is to use either the set state capability or the set default

336+ -- capability.

337+ True -> do

288338 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

289− (fixedStyle attr )

339+ (fixedStyle attr)

290340 (styleToApplySeq $ fixedStyle attr) of

291341 -- only way to reset a color to the defaults

292− EnterExitSeq caps -> writeDefaultAttr dc

293− `mappend`

342+ EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled

343+ `mappend`

294344 foldMap (\cap -> writeCapExpr cap []) caps

295345 `mappend`

296346 setColors

297347 -- implicitly resets the colors to the defaults

298− SetState state -> writeCapExpr (fromJust $ setAttrStates

299− $ displayAttrCaps

300− $ terminfoCaps

348+ SetState state -> writeCapExpr (fromJust $ setAttrStates

349+ $ displayAttrCaps terminfoCaps

301350 )

302351 (sgrArgsForState state)

303− `mappend`

304− setColors

305− -- Otherwise the display colors are not changing or changing between two non-default

306− -- points.

352+ `mappend` setItalics

353+ `mappend` setStrikethrough

354+ `mappend` setColors

355+ -- Otherwise the display colors are not changing or changing

356+ -- between two non-default points.

307357 False -> do

308− -- Still, it could be the case that the change in display attributes requires the

309− -- colors to be reset because the required capability was not available.

358+ -- Still, it could be the case that the change in display

359+ -- attributes requires the colors to be reset because the

360+ -- required capability was not available.

310361 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

311362 (fixedStyle attr)

312363 (styleDiffs diffs) of

313− -- Really, if terminals were re-implemented with modern concepts instead of bowing

314− -- down to 40 yr old dumb terminal requirements this would be the only case ever

315− -- reached! Changes the style and color states according to the differences with

316− -- the currently applied states.

364+ -- Really, if terminals were re-implemented with modern

365+ -- concepts instead of bowing down to 40 yr old dumb

366+ -- terminal requirements this would be the only case

367+ -- ever reached! Changes the style and color states

368+ -- according to the differences with the currently

369+ -- applied states.

317370 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps

318371 `mappend`

319− writeColorDiff setForeColor (foreColorDiff diffs)

372+ writeColorDiff Foreground (foreColorDiff diffs)

320373 `mappend`

321− writeColorDiff setBackColor (backColorDiff diffs)

374+ writeColorDiff Background (backColorDiff diffs)

322375 -- implicitly resets the colors to the defaults

323− SetState state -> writeCapExpr (fromJust $ setAttrStates

376+ SetState state -> writeCapExpr (fromJust $ setAttrStates

324377 $ displayAttrCaps terminfoCaps

325378 )

326379 (sgrArgsForState state)

380+ `mappend` setItalics

381+ `mappend` setStrikethrough

327382 `mappend` setColors

328− where

383+ where

384+ urlAttrs True = writeURLEscapes (urlDiff diffs)

385+ urlAttrs False = mempty

329386 colorMap = case useAltColorMap terminfoCaps of

330387 False -> ansiColorIndex

331388 True -> altColorIndex

332389 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

333404 setColors =

334405 (case fixedForeColor attr of

335− Just c -> writeCapExpr (setForeColor terminfoCaps)

336− [toEnum $ colorMap c]

406+ Just c -> writeColor Foreground c

337407 Nothing -> mempty)

338408 `mappend`

339409 (case fixedBackColor attr of

340− Just c -> writeCapExpr (setBackColor terminfoCaps)

341− [toEnum $ colorMap c]

410+ Just c -> writeColor Background c

342411 Nothing -> mempty)

343− writeColorDiff _f NoColorChange

412+ writeColorDiff _side NoColorChange

344413 = mempty

345− writeColorDiff _f ColorToDefault

414+ writeColorDiff _side ColorToDefault

346415 = error "ColorToDefault is not a possible case for applyColorDiffs"

347− writeColorDiff f (SetColor c)

348− = writeCapExpr (f terminfoCaps) [toEnum $ colorMap c]

349−

350−-- | The color table used by a terminal is a 16 color set followed by a 240 color set that might not

351−-- be supported by the terminal.

416+ writeColorDiff side (SetColor c)

417+ = writeColor side c

418+

419+ writeColor side (RGBColor r g b) =

420+ case outputColorMode (contextDevice dc) of

421+ FullColor ->

422+ hardcodeColor side (r, g, b)

423+ _ ->

424+ error "clampColor should remove rgb colors in standard mode"

425+ writeColor side c =

426+ writeCapExpr (setSideColor side terminfoCaps) [toEnum $ colorMap c]

427+

428+-- a color can either be in the foreground or the background

429+data ColorSide = Foreground | Background

430+

431+-- get the capability for drawing a color on a specific side

432+setSideColor :: ColorSide -> TerminfoCaps -> CapExpression

433+setSideColor Foreground = setForeColor

434+setSideColor Background = setBackColor

435+

436+hardcodeColor :: ColorSide -> (Word8, Word8, Word8) -> Write

437+hardcodeColor side (r, g, b) =

438+ -- hardcoded color codes are formatted as "\x1b[{side};2;{r};{g};{b}m"

439+ mconcat [ writeStr "\x1b[", sideCode, delimiter, writeChar '2', delimiter

440+ , writeColor r, delimiter, writeColor g, delimiter, writeColor b

441+ , writeChar 'm']

442+ where

443+ writeChar = writeWord8 . fromIntegral . fromEnum

444+ writeStr = mconcat . map writeChar

445+ writeColor = writeStr . show

446+ delimiter = writeChar ';'

447+ -- 38/48 are used to set whether we should write to the

448+ -- foreground/background. I really don't want to know why.

449+ sideCode = case side of

450+ Foreground -> writeStr "38"

451+ Background -> writeStr "48"

452+

453+-- | 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.

352455--

353−-- This takes a Color which clearly identifies which pallete to use and computes the index

354−-- into the full 256 color pallete.

456+-- This takes a Color which clearly identifies which palette to use and

457+-- computes the index into the full 256 color palette.

355458ansiColorIndex :: Color -> Int

356459ansiColorIndex (ISOColor v) = fromEnum v

357460ansiColorIndex (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+ ]

358465

359466-- | For terminals without setaf/setab

360−--

467+--

361468-- See table in `man terminfo`

362469-- Will error if not in table.

363470altColorIndex :: Color -> Int

@@ -371,21 +478,28 @@ altColorIndex (ISOColor 6) = 3

371478altColorIndex (ISOColor 7) = 7

372479altColorIndex (ISOColor v) = fromEnum v

373480altColorIndex (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+ ]

374485

375−{- | The sequence of terminfo caps to apply a given style are determined according to these rules.

376− -

377− - 1. The assumption is that it's preferable to use the simpler enter/exit mode capabilities than

378− - the full set display attribute state capability.

486+{- | The sequence of terminfo caps to apply a given style are determined

487+ - according to these rules.

379488 -

380− - 2. If a mode is supposed to be removed but there is not an exit capability defined then the

381− - display attributes are reset to defaults then the display attribute state is set.

489+ - 1. The assumption is that it's preferable to use the simpler

490+ - enter/exit mode capabilities than the full set display attribute

491+ - state capability.

382492 -

383− - 3. If a mode is supposed to be applied but there is not an enter capability defined then then

384− - display attribute state is set if possible. Otherwise the mode is not applied.

493+ - 2. If a mode is supposed to be removed but there is not an exit

494+ - capability defined then the display attributes are reset to defaults

495+ - then the display attribute state is set.

385496 -

386− - 4. If the display attribute state is being set then just update the arguments to that for any

387− - apply/remove.

497+ - 3. If a mode is supposed to be applied but there is not an enter

498+ - capability defined then then display attribute state is set if

499+ - possible. Otherwise the mode is not applied.

388500 -

501+ - 4. If the display attribute state is being set then just update the

502+ - arguments to that for any apply/remove.

389503 -}

390504data DisplayAttrSeq

391505 = EnterExitSeq [CapExpression]

@@ -394,6 +508,8 @@ data DisplayAttrSeq

394508data DisplayAttrState = DisplayAttrState

395509 { applyStandout :: Bool

396510 , applyUnderline :: Bool

511+ , applyItalic :: Bool

512+ , applyStrikethrough :: Bool

397513 , applyReverseVideo :: Bool

398514 , applyBlink :: Bool

399515 , applyDim :: Bool

@@ -415,19 +531,25 @@ sgrArgsForState attrState = map (\b -> if b then 1 else 0)

415531

416532reqDisplayCapSeqFor :: DisplayAttrCaps -> Style -> [StyleStateChange] -> DisplayAttrSeq

417533reqDisplayCapSeqFor caps s diffs

418− -- if the state transition implied by any diff cannot be supported with an enter/exit mode cap

419− -- then either the state needs to be set or the attribute change ignored.

534+ -- if the state transition implied by any diff cannot be supported

535+ -- with an enter/exit mode cap then either the state needs to be set

536+ -- or the attribute change ignored.

420537 = case (any noEnterExitCap diffs, isJust $ setAttrStates caps) of

421538 -- If all the diffs have an enter-exit cap then just use those

422539 ( False, _ ) -> EnterExitSeq $ map enterExitCap diffs

423− -- If not all the diffs have an enter-exit cap and there is no set state cap then filter out

424− -- all unsupported diffs and just apply the rest

425− ( True, False ) -> EnterExitSeq $ map enterExitCap

540+ -- If not all the diffs have an enter-exit cap and there is no

541+ -- set state cap then filter out all unsupported diffs and just

542+ -- apply the rest

543+ ( True, False ) -> EnterExitSeq $ map enterExitCap

426544 $ filter (not . noEnterExitCap) diffs

427− -- if not all the diffs have an enter-exit can and there is a set state cap then just use

428− -- the set state cap.

545+ -- if not all the diffs have an enter-exit can and there is a

546+ -- set state cap then just use the set state cap.

429547 ( True, True ) -> SetState $ stateForStyle s

430548 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

431553 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps

432554 noEnterExitCap RemoveStandout = isNothing $ exitStandout caps

433555 noEnterExitCap ApplyUnderline = isNothing $ enterUnderline caps

@@ -440,6 +562,10 @@ reqDisplayCapSeqFor caps s diffs

440562 noEnterExitCap RemoveDim = True

441563 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps

442564 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

443569 enterExitCap ApplyStandout = fromJust $ enterStandout caps

444570 enterExitCap RemoveStandout = fromJust $ exitStandout caps

445571 enterExitCap ApplyUnderline = fromJust $ enterUnderline caps

@@ -453,6 +579,8 @@ stateForStyle :: Style -> DisplayAttrState

453579stateForStyle s = DisplayAttrState

454580 { applyStandout = isStyleSet standout

455581 , applyUnderline = isStyleSet underline

582+ , applyItalic = isStyleSet italic

583+ , applyStrikethrough = isStyleSet strikethrough

456584 , applyReverseVideo = isStyleSet reverseVideo

457585 , applyBlink = isStyleSet blink

458586 , applyDim = isStyleSet dim

@@ -464,14 +592,15 @@ styleToApplySeq :: Style -> [StyleStateChange]

464592styleToApplySeq s = concat

465593 [ applyIfRequired ApplyStandout standout

466594 , applyIfRequired ApplyUnderline underline

595+ , applyIfRequired ApplyItalic italic

596+ , applyIfRequired ApplyStrikethrough strikethrough

467597 , applyIfRequired ApplyReverseVideo reverseVideo

468598 , applyIfRequired ApplyBlink blink

469599 , applyIfRequired ApplyDim dim

470− , applyIfRequired ApplyBlink bold

600+ , applyIfRequired ApplyBold bold

471601 ]

472− where

473− applyIfRequired op flag

602+ where

603+ applyIfRequired op flag

474604 = if 0 == (flag .&. s)

475605 then []

476606 else [op]

477−

src/Graphics/Vty/Output/XTermColor.hs+53−37

@@ -1,56 +1,72 @@

1−{-# LANGUAGE CPP #-}

2−

3−#ifndef MIN_VERSION_base

4−#defined MIN_VERSION_base(x,y,z) 1

5−#endif

6−

1+{-# Language CPP #-}

8−module Graphics.Vty.Output.XTermColor ( reserveTerminal )

9− where

3+-- | Xterm output driver. This uses the Terminfo driver with some

4+-- extensions for Xterm.

5+module Graphics.Vty.Output.XTermColor

6+ ( reserveTerminal

7+ )

8+where

109

1110import Graphics.Vty.Output.Interface

1211import Graphics.Vty.Input.Mouse

12+import Graphics.Vty.Input.Focus

13+import Graphics.Vty.Attributes.Color (ColorMode)

1314import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased

1415

1516import Blaze.ByteString.Builder (writeToByteString)

1617import Blaze.ByteString.Builder.Word (writeWord8)

1718

19+import qualified Data.ByteString.Char8 as BS8

20+import Data.ByteString.Char8 (ByteString)

21+import Foreign.Ptr (castPtr)

22+

1823import Control.Monad (void, when)

1924import Control.Monad.Trans

25+import Data.Char (toLower)

2026import Data.IORef

2127

22−import System.Posix.IO (fdWrite)

23−import System.Posix.Types (Fd)

28+import System.Posix.IO (fdWriteBuf)

29+import System.Posix.Types (ByteCount, Fd)

2430import System.Posix.Env (getEnv)

2531

26−#if !(MIN_VERSION_base(4,8,0))

27−import Control.Applicative

28−import Data.Foldable (foldMap)

29−#endif

30−

3132import Data.List (isInfixOf)

3233import Data.Maybe (catMaybes)

34+

35+#if !MIN_VERSION_base(4,11,0)

3336import 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)

3444

35−-- | Initialize the display to UTF-8.

36−reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

37−reserveTerminal variant outFd = liftIO $ do

45+-- | Construct an Xterm output driver. Initialize the display to UTF-8.

46+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> ColorMode -> m Output

47+reserveTerminal variant outFd colorMode = liftIO $ do

3848 let flushedPut = void . fdWrite outFd

39− -- If the terminal variant is xterm-color use xterm instead since, more often than not,

40− -- xterm-color is broken.

49+ -- If the terminal variant is xterm-color use xterm instead since,

50+ -- more often than not, xterm-color is broken.

4151 let variant' = if variant == "xterm-color" then "xterm" else variant

4252

4353 utf8a <- utf8Active

4454 when (not utf8a) $ flushedPut setUtf8CharSet

45− t <- TerminfoBased.reserveTerminal variant' outFd

55+ t <- TerminfoBased.reserveTerminal variant' outFd colorMode

4656

4757 mouseModeStatus <- newIORef False

58+ focusModeStatus <- newIORef False

4859 pasteModeStatus <- newIORef False

4960

5061 let xtermSetMode t' m newStatus = do

5162 curStatus <- getModeStatus t' m

5263 when (newStatus /= curStatus) $

5364 case m of

65+ Focus -> liftIO $ do

66+ case newStatus of

67+ True -> flushedPut requestFocusEvents

68+ False -> flushedPut disableFocusEvents

69+ writeIORef focusModeStatus newStatus

5470 Mouse -> liftIO $ do

5571 case newStatus of

5672 True -> flushedPut requestMouseEvents

@@ -61,9 +77,12 @@ reserveTerminal variant outFd = liftIO $ do

6177 True -> flushedPut enableBracketedPastes

6278 False -> flushedPut disableBracketedPastes

6379 writeIORef pasteModeStatus newStatus

80+ Hyperlink -> setMode t Hyperlink newStatus

6481

6582 xtermGetMode Mouse = liftIO $ readIORef mouseModeStatus

83+ xtermGetMode Focus = liftIO $ readIORef focusModeStatus

6684 xtermGetMode BracketedPaste = liftIO $ readIORef pasteModeStatus

85+ xtermGetMode Hyperlink = getModeStatus t Hyperlink

6786

6887 let t' = t

6988 { terminalID = terminalID t ++ " (xterm-color)"

@@ -71,6 +90,7 @@ reserveTerminal variant outFd = liftIO $ do

7190 when (not utf8a) $ liftIO $ flushedPut setDefaultCharSet

7291 setMode t' BracketedPaste False

7392 setMode t' Mouse False

93+ setMode t' Focus False

7494 releaseTerminal t

7595 , mkDisplayContext = \tActual r -> do

7696 dc <- mkDisplayContext t tActual r

@@ -84,32 +104,28 @@ reserveTerminal variant outFd = liftIO $ do

84104utf8Active :: IO Bool

85105utf8Active = do

86106 let vars = ["LC_ALL", "LANG", "LC_CTYPE"]

87− results <- catMaybes <$> mapM getEnv vars

88− let matches = filter ("UTF8" `isInfixOf`) results <>

89− filter ("UTF-8" `isInfixOf`) results

107+ results <- map (toLower <$>) . catMaybes <$> mapM getEnv vars

108+ let matches = filter ("utf8" `isInfixOf`) results <>

109+ filter ("utf-8" `isInfixOf`) results

90110 return $ not $ null matches

91111

92112-- | Enable bracketed paste mode:

93113-- http://cirw.in/blog/bracketed-paste

94−enableBracketedPastes :: String

95−enableBracketedPastes = "\ESC[?2004h"

114+enableBracketedPastes :: ByteString

115+enableBracketedPastes = BS8.pack "\ESC[?2004h"

96116

97117-- | Disable bracketed paste mode:

98−disableBracketedPastes :: String

99−disableBracketedPastes = "\ESC[?2004l"

118+disableBracketedPastes :: ByteString

119+disableBracketedPastes = BS8.pack "\ESC[?2004l"

100120

101121-- | These sequences set xterm based terminals to UTF-8 output.

102122--

103−-- \todo I don't know of a terminfo cap that is equivalent to this.

104−setUtf8CharSet, setDefaultCharSet :: String

105−setUtf8CharSet = "\ESC%G"

106−setDefaultCharSet = "\ESC%@"

107−

108−-- | I think xterm is broken: Reseting the background color as the first bytes serialized on a

109−-- new line does not effect the background color xterm uses to clear the line. Which is used

110−-- *after* the next newline.

123+-- There is no known terminfo capability equivalent to this.

124+setUtf8CharSet, setDefaultCharSet :: ByteString

125+setUtf8CharSet = BS8.pack "\ESC%G"

126+setDefaultCharSet = BS8.pack "\ESC%@"

127+

111128xtermInlineHack :: Output -> IO ()

112129xtermInlineHack t = do

113130 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"

114131 outputByteBuffer t $ writeToByteString writeReset

115−

src/Graphics/Vty/Picture.hs+65−42

@@ -1,25 +1,36 @@

1−{-# LANGUAGE BangPatterns #-}

2−-- | The 'Picture' data structure is representative of the final terminal view.

3−--

4−-- A 'Picture' is a background paired with a layer of 'Image's.

5−module Graphics.Vty.Picture ( module Graphics.Vty.Picture

6− , module Graphics.Vty.Image

7− )

8− where

1+-- A 'Picture' is a background paired with a set of 'Image' layers. The

2+-- 'Picture' data structure is representative of the final terminal

3+-- view.

4+module Graphics.Vty.Picture

5+ ( Picture(..)

6+ , Cursor(..)

7+ , Background(..)

8+ , emptyPicture

9+ , addToTop

10+ , addToBottom

11+ , picForImage

12+ , picForLayers

13+ , picImage

14+ )

15+where

916

1017import Graphics.Vty.Image

18+import Graphics.Vty.Attributes

1119

1220import Control.DeepSeq

1321

14−-- | The type of images to be displayed using 'update'.

22+-- | A Vty picture.

1523--

16−-- Can be constructed directly or using `picForImage`. Which provides an initial instance with

17−-- reasonable defaults for picCursor and picBackground.

24+-- These can be constructed directly or using `picForImage`.

1825data Picture = Picture

1926 { picCursor :: Cursor

27+ -- ^ The picture's cursor.

2028 , picLayers :: [Image]

29+ -- ^ The picture's image layers (top-most first).

2130 , picBackground :: Background

22− }

31+ -- ^ The picture's background to be displayed in locations with no

32+ -- Image data.

33+ } deriving Eq

2334

2435instance Show Picture where

2536 show (Picture _ layers _ ) = "Picture ?? " ++ show layers ++ " ??"

@@ -27,66 +38,73 @@ instance Show Picture where

2738instance NFData Picture where

2839 rnf (Picture c l b) = c `deepseq` l `deepseq` b `deepseq` ()

2940

30−-- | a picture with no cursor, background or image layers

41+-- | A picture with no cursor, background or image layers.

3142emptyPicture :: Picture

3243emptyPicture = Picture NoCursor [] ClearBackground

3344

34−-- | The given 'Image' is added as the top layer of the 'Picture'

45+-- | Add an 'Image' as the top-most layer of a 'Picture'.

3546addToTop :: Picture -> Image -> Picture

3647addToTop p i = p {picLayers = i : picLayers p}

3748

38−-- | The given 'Image' is added as the bottom layer of the 'Picture'

49+-- | Add an 'Image' as the bottom-most layer of a 'Picture'.

3950addToBottom :: Picture -> Image -> Picture

4051addToBottom p i = p {picLayers = picLayers p ++ [i]}

4152

42−-- | Create a picture for display for the given image. The picture will not have a displayed cursor

43−-- and no background pattern (ClearBackground) will be used.

53+-- | Create a picture from the given image. The picture will not have a

54+-- displayed cursor and no background pattern (ClearBackground) will be

55+-- used.

4456picForImage :: Image -> Picture

45−picForImage i = Picture

57+picForImage i = Picture

4658 { picCursor = NoCursor

4759 , picLayers = [i]

4860 , picBackground = ClearBackground

4961 }

5062

51−-- | Create a picture for display with the given layers. Ordered top to bottom.

63+-- | Create a picture with the given layers, top-most first.

5264--

53−-- The picture will not have a displayed cursor and no background apttern (ClearBackgroun) will be

54−-- used.

55−--

56−-- The first 'Image' is the top layer.

65+-- The picture will not have a displayed cursor and no background

66+-- pattern (ClearBackgroun) will be used.

5767picForLayers :: [Image] -> Picture

58−picForLayers is = Picture

68+picForLayers is = Picture

5969 { picCursor = NoCursor

6070 , picLayers = is

6171 , picBackground = ClearBackground

6272 }

6373

64−-- | A picture can be configured either to not show the cursor or show the cursor at the specified

65−-- character position.

74+-- | A picture can be configured to hide the cursor or to show the

75+-- cursor at the specified character position.

6676--

67−-- There is not a 1 to 1 map from character positions to a row and column on the screen due to

68−-- characters that take more than 1 column.

69−--

70−-- todo: The Cursor can be given a (character,row) offset outside of the visible bounds of the

71−-- output region. In this case the cursor will not be shown.

77+-- There is not a 1:1 map from character positions to a row and column

78+-- on the screen due to characters that take more than 1 column.

7279data Cursor =

73− -- | Hide the cursor

74− NoCursor

75− -- | Show the cursor at the given logical column accounting for char width and row

80+ -- | Hide the cursor

81+ 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

91+ -- character width in the presence of multi-column characters.

7692 | Cursor !Int !Int

77− -- | Show the cursor at the given absolute terminal column and row

93+ -- | Show the cursor at the given absolute terminal column and row

7894 | AbsoluteCursor !Int !Int

95+ deriving Eq

7996

8097instance NFData Cursor where

8198 rnf c = c `seq` ()

8299

83−-- | A 'Picture' has a background pattern. The background is either ClearBackground. Which shows the

84−-- layer below or is blank if the bottom layer. Or the background pattern is a character and a

85−-- display attribute. If the display attribute used previously should be used for a background fill

86−-- then use `currentAttr` for the background attribute.

100+-- | A 'Picture' has a background pattern. The background is either:

101+--

102+-- * ClearBackground, which shows the layer below or is blank if the

103+-- bottom layer

104+-- * A character and a display attribute

87105--

88−-- \todo The current attribute is always set to the default attributes at the start of updating the

89−-- screen to a picture.

106+-- If the display attribute used previously should be used for a

107+-- background fill then use `currentAttr` for the background attribute.

90108data Background

91109 = Background

92110 { backgroundChar :: Char

@@ -98,11 +116,16 @@ data Background

98116 --

99117 -- * End of line if there are no remaining non-skip ops.

100118 | ClearBackground

119+ deriving Eq

101120

102121instance NFData Background where

103122 rnf (Background c a) = c `seq` a `seq` ()

104123 rnf ClearBackground = ()

105124

106−-- | Compatibility with applications that do not use more than a single layer.

125+-- | Return the top-most 'Image' layer for a picture. This is unsafe for

126+-- 'Picture's without at least one layer.

127+--

128+-- This is provided for compatibility with applications that do not use

129+-- more than a single layer.

107130picImage :: Picture -> Image

108131picImage = head . picLayers

src/Graphics/Vty/PictureToSpans.hs+68−87

@@ -1,21 +1,14 @@

11-- Copyright Corey O'Connor<coreyoconnor@gmail.com>

22{-# LANGUAGE BangPatterns #-}

3−{-# LANGUAGE CPP #-}

43{-# LANGUAGE ExistentialQuantification #-}

54{-# LANGUAGE NamedFieldPuns #-}

65{-# LANGUAGE RankNTypes #-}

76{-# LANGUAGE TemplateHaskell #-}

87

9−#ifndef MIN_VERSION_base

10−#defined MIN_VERSION_base(x,y,z) 1

11−#endif

12−

13−{- | Transforms an image into rows of operations.

14− -}

8+-- | Transforms an image into rows of operations.

159module Graphics.Vty.PictureToSpans where

1610

17−import Graphics.Vty.Prelude

18−

11+import Graphics.Vty.Attributes (Attr, currentAttr)

1912import Graphics.Vty.Image

2013import Graphics.Vty.Image.Internal

2114import Graphics.Vty.Picture

@@ -26,12 +19,7 @@ import Lens.Micro.Mtl

2619import Lens.Micro.TH

2720import Control.Monad.Reader

2821import Control.Monad.State.Strict hiding ( state )

29−

30−#if __GLASGOW_HASKELL__ < 708

31−import Control.Monad.ST.Strict hiding ( unsafeIOToST )

32−#else

3322import Control.Monad.ST.Strict

34−#endif

3523

3624import qualified Data.Vector as Vector hiding ( take, replicate )

3725import Data.Vector.Mutable ( MVector(..))

@@ -39,29 +27,27 @@ import qualified Data.Vector.Mutable as MVector

3927

4028import qualified Data.Text.Lazy as TL

4129

42−#if !(MIN_VERSION_base(4,8,0))

43−import Data.Monoid (mappend)

44−#endif

45−

4630type MRowOps s = MVector s SpanOps

4731

4832type MSpanOps s = MVector s SpanOp

4933

5034-- transform plus clip. More or less.

5135data BlitState = BlitState

52− -- we always snoc to the operation vectors. Thus the columnOffset = length of row at rowOffset

53− -- although, one possibility is to merge layers right in snocOp (naming it something else, of

54− -- course). In which case columnnOffset would be applicable.

55− -- Right now we need it to exist.

36+ -- we always snoc to the operation vectors. Thus the columnOffset =

37+ -- length of row at rowOffset although, one possibility is to merge

38+ -- layers right in snocOp (naming it something else, of course). In

39+ -- which case columnnOffset would be applicable. Right now we need

40+ -- it to exist.

5641 { _columnOffset :: Int

5742 , _rowOffset :: Int

58− -- clip coordinate space is in image space. Which means it's >= 0 and < imageWidth.

43+ -- clip coordinate space is in image space. Which means it's >= 0

44+ -- and < imageWidth.

5945 , _skipColumns :: Int

6046 -- >= 0 and < imageHeight

6147 , _skipRows :: Int

62− -- includes consideration of skipColumns. In display space.

63− -- The number of columns from the next column to be defined to the end of the display for the

64− -- row.

48+ -- includes consideration of skipColumns. In display space. The

49+ -- number of columns from the next column to be defined to the end

50+ -- of the display for the row.

6551 , _remainingColumns :: Int

6652 -- includes consideration of skipRows. In display space.

6753 , _remainingRows :: Int

@@ -78,31 +64,29 @@ makeLenses ''BlitEnv

7864

7965type BlitM s a = ReaderT (BlitEnv s) (StateT BlitState (ST s)) a

8066

81−-- | Produces the span ops that will render the given picture, possibly cropped or padded, into the

82−-- specified region.

67+-- | Produces the span ops that will render the given picture, possibly

68+-- cropped or padded, into the specified region.

8369displayOpsForPic :: Picture -> DisplayRegion -> DisplayOps

8470displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r)

8571

86−-- | Returns the DisplayOps for an image rendered to a window the size of the image.

72+-- | Returns the DisplayOps for an image rendered to a window the size

73+-- of the image.

8774--

88−-- largerly used only for debugging.

75+-- largely used only for debugging.

8976displayOpsForImage :: Image -> DisplayOps

9077displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeight i)

9178

9279-- | Produces the span ops for each layer then combines them.

93−--

94−-- TODO: a fold over a builder function. start with span ops that are a bg fill of the entire

95−-- region.

9680combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s)

9781combinedOpsForLayers pic r

9882 | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0

9983 | otherwise = do

100− layerOps <- mapM (\layer -> buildSpans layer r) (picLayers pic)

84+ layerOps <- mapM (`buildSpans` r) (picLayers pic)

10185 case layerOps of

10286 [] -> fail "empty picture"

10387 [ops] -> substituteSkips (picBackground pic) ops

104− -- instead of merging ops after generation the merging can be performed as part of

105− -- snocOp.

88+ -- instead of merging ops after generation the merging can

89+ -- be performed as part of snocOp.

10690 topOps : lowerOps -> do

10791 ops <- foldM mergeUnder topOps lowerOps

10892 substituteSkips (picBackground pic) ops

@@ -111,21 +95,23 @@ substituteSkips :: Background -> MRowOps s -> ST s (MRowOps s)

11195substituteSkips ClearBackground ops = do

11296 forM_ [0 .. MVector.length ops - 1] $ \row -> do

11397 rowOps <- MVector.read ops row

114− -- the image operations assure that background fills are combined.

115− -- clipping a background fill does not split the background fill.

116− -- merging of image layers can split a skip, but only by the insertion of a non skip.

117− -- all this combines to mean we can check the last operation and remove it if it's a skip

118− -- todo: or does it?

98+ -- the image operations assure that background fills are

99+ -- combined. clipping a background fill does not split the

100+ -- background fill. merging of image layers can split a skip,

101+ -- but only by the insertion of a non skip. all this combines to

102+ -- mean we can check the last operation and remove it if it's a

103+ -- skip

119104 let rowOps' = case Vector.last rowOps of

120105 Skip w -> Vector.init rowOps `Vector.snoc` RowEnd w

121106 _ -> rowOps

122− -- now all the skips can be replaced by replications of ' ' of the required width.

107+ -- now all the skips can be replaced by replications of ' ' of

108+ -- the required width.

123109 let rowOps'' = swapSkipsForSingleColumnCharSpan ' ' currentAttr rowOps'

124110 MVector.write ops row rowOps''

125111 return ops

126112substituteSkips (Background {backgroundChar, backgroundAttr}) ops = do

127− -- At this point we decide if the background character is single column or not.

128− -- obviously, single column is easier.

113+ -- At this point we decide if the background character is single

114+ -- column or not. obviously, single column is easier.

129115 case safeWcwidth backgroundChar of

130116 w | w == 0 -> fail $ "invalid background character " ++ show backgroundChar

131117 | w == 1 -> do

@@ -149,12 +135,12 @@ mergeUnder upper lower = do

149135 MVector.write upper row rowOps

150136 return upper

151137

152−-- fugly

153138mergeRowUnder :: SpanOps -> SpanOps -> SpanOps

154−mergeRowUnder upperRowOps lowerRowOps =

155− onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) lowerRowOps

139+mergeRowUnder upperRowOps =

140+ onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps)

156141 where

157− -- H: it will never be the case that we are out of upper ops before lower ops.

142+ -- H: it will never be the case that we are out of upper ops

143+ -- before lower ops.

158144 onUpperOp :: SpanOps -> SpanOp -> SpanOps -> SpanOps -> SpanOps

159145 onUpperOp outOps op@(TextSpan _ w _ _) upperOps lowerOps =

160146 let lowerOps' = dropOps w lowerOps

@@ -189,30 +175,32 @@ swapSkipsForCharSpan w c a = Vector.map f

189175 in TextSpan a ow cw txt

190176 f v = v

191177

192−-- | Builds a vector of row operations that will output the given picture to the terminal.

178+-- | Builds a vector of row operations that will output the given

179+-- picture to the terminal.

193180--

194181-- Crops to the given display region.

195−--

196−-- \todo I'm pretty sure there is an algorithm that does not require a mutable buffer.

197182buildSpans :: Image -> DisplayRegion -> ST s (MRowOps s)

198183buildSpans image outRegion = do

199184 -- First we create a mutable vector for each rows output operations.

200185 outOps <- MVector.replicate (regionHeight outRegion) Vector.empty

201− -- \todo I think building the span operations in display order would provide better performance.

202− -- However, I got stuck trying to implement an algorithm that did this. This will be considered

203− -- as a possible future optimization.

186+ -- It's possible that building the span operations in display order

187+ -- would provide better performance.

204188 --

205− -- A depth first traversal of the image is performed. ordered according to the column range

206− -- defined by the image from least to greatest. The output row ops will at least have the

207− -- region of the image specified. Iterate over all output rows and output background fills for

208− -- all unspecified columns.

189+ -- A depth first traversal of the image is performed. ordered

190+ -- according to the column range defined by the image from least

191+ -- to greatest. The output row ops will at least have the region

192+ -- of the image specified. Iterate over all output rows and output

193+ -- background fills for all unspecified columns.

209194 --

210− -- The images are made into span operations from left to right. It's possible that this could

211− -- easily be made to assure top to bottom output as well.

195+ -- The images are made into span operations from left to right. It's

196+ -- possible that this could easily be made to assure top to bottom

197+ -- output as well.

212198 when (regionHeight outRegion > 0 && regionWidth outRegion > 0) $ do

213− -- The ops builder recursively descends the image and outputs span ops that would

214− -- display that image. The number of columns remaining in this row before exceeding the

215− -- bounds is also provided. This is used to clip the span ops produced to the display.

199+ -- The ops builder recursively descends the image and outputs

200+ -- span ops that would display that image. The number of columns

201+ -- remaining in this row before exceeding the bounds is also

202+ -- provided. This is used to clip the span ops produced to the

203+ -- display.

216204 let fullBuild = do

217205 startImageBuild image

218206 -- Fill in any unspecified columns with a skip.

@@ -223,7 +211,8 @@ buildSpans image outRegion = do

223211 return ()

224212 return outOps

225213

226−-- | Add the operations required to build a given image to the current set of row operations.

214+-- | Add the operations required to build a given image to the current

215+-- set of row operations.

227216startImageBuild :: Image -> BlitM s ()

228217startImageBuild image = do

229218 outOfBounds <- isOutOfBounds image <$> get

@@ -237,17 +226,16 @@ isOutOfBounds i s

237226 | s ^. skipRows >= imageHeight i = True

238227 | otherwise = False

239228

240−-- | This adds an image that might be partially clipped to the output ops.

241−--

242−-- This is a very touchy algorithm. Too touchy. For instance, the CropRight and CropBottom

243−-- implementations are odd. They pass the current tests but something seems terribly wrong about all

244−-- this.

229+-- | This adds an image that might be partially clipped to the output

230+-- ops.

245231--

246−-- \todo prove this cannot be called in an out of bounds case.

232+-- This is a very touchy algorithm. Too touchy. For instance, the

233+-- CropRight and CropBottom implementations are odd. They pass the

234+-- current tests but something seems terribly wrong about all this.

247235addMaybeClipped :: forall s . Image -> BlitM s ()

248236addMaybeClipped EmptyImage = return ()

249237addMaybeClipped (HorizText a textStr ow _cw) = do

250− -- TODO: assumption that text spans are only 1 row high.

238+ -- This assumes that text spans are only 1 row high.

251239 s <- use skipRows

252240 when (s < 1) $ do

253241 leftClip <- use skipColumns

@@ -297,7 +285,7 @@ addMaybeClipped CropTop {croppedImage, topSkip} = do

297285 skipRows += topSkip

298286 addMaybeClipped croppedImage

299287

300−addMaybeClippedJoin :: forall s . String

288+addMaybeClippedJoin :: forall s . String

301289 -> Lens BlitState BlitState Int Int

302290 -> Lens BlitState BlitState Int Int

303291 -> Lens BlitState BlitState Int Int

@@ -310,12 +298,11 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do

310298 state <- get

311299 when (state^.remaining <= 0) $ fail $ name ++ " with remaining <= 0"

312300 case state^.skip of

313− s -- TODO: check if clipped in other dim. if not use addUnclipped

314− | s > size -> put $ state & skip -~ size

315− | s == 0 -> if state^.remaining > i0Dim

301+ s | s > size -> put $ state & skip %~ subtract size

302+ | s == 0 -> if state^.remaining > i0Dim

316303 then do

317304 addMaybeClipped i0

318− put $ state & offset +~ i0Dim & remaining -~ i0Dim

305+ put $ state & offset %~ (+ i0Dim) & remaining %~ subtract i0Dim

319306 addMaybeClipped i1

320307 else addMaybeClipped i0

321308 | s < i0Dim ->

@@ -324,10 +311,10 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do

324311 then addMaybeClipped i0

325312 else do

326313 addMaybeClipped i0

327− put $ state & offset +~ i0Dim' & remaining -~ i0Dim' & skip .~ 0

314+ put $ state & offset %~ (+ i0Dim') & remaining %~ subtract i0Dim' & skip .~ 0

328315 addMaybeClipped i1

329316 | s >= i0Dim -> do

330− put $ state & skip -~ i0Dim

317+ put $ state & skip %~ subtract i0Dim

331318 addMaybeClipped i1

332319 _ -> fail $ name ++ " has unhandled skip class"

333320

@@ -336,14 +323,14 @@ addUnclippedText a txt = do

336323 let op = TextSpan a usedDisplayColumns

337324 (fromIntegral $ TL.length txt)

338325 txt

339− usedDisplayColumns = wcswidth $ TL.unpack txt

326+ usedDisplayColumns = wctlwidth txt

340327 use rowOffset >>= snocOp op

341328

342329addRowCompletion :: DisplayRegion -> Int -> BlitM s ()

343330addRowCompletion displayRegion row = do

344331 allRowOps <- view mrowOps

345332 rowOps <- lift $ lift $ MVector.read allRowOps row

346− let endX = spanOpsEffectedColumns rowOps

333+ let endX = spanOpsAffectedColumns rowOps

347334 when (endX < regionWidth displayRegion) $ do

348335 let ow = regionWidth displayRegion - endX

349336 snocOp (Skip ow) row

@@ -356,12 +343,6 @@ snocOp !op !row = do

356343 lift $ lift $ do

357344 ops <- MVector.read theMrowOps row

358345 let ops' = Vector.snoc ops op

359− when (spanOpsEffectedColumns ops' > regionWidth theRegion)

346+ when (spanOpsAffectedColumns ops' > regionWidth theRegion)

360347 $ fail $ "row " ++ show row ++ " now exceeds region width"

361348 MVector.write theMrowOps row ops'

362−

363−(-~) :: Num a => ASetter s t a a -> a -> s -> t

364−l -~ n = over l (subtract n)

365−

366−(+~) :: Num a => ASetter s t a a -> a -> s -> t

367−l +~ n = over l (n +)

src/Graphics/Vty/Prelude.hsdeleted−18

@@ -1,18 +0,0 @@

1−-- | Prelude for Vty modules. Not particularly useful outside of Vty.

2−module Graphics.Vty.Prelude ( module Graphics.Vty.Prelude

3− , module Control.Applicative

4− , module Control.Monad

5− )

6−where

7−

8−import Control.Applicative hiding ((<|>))

9−import Control.Monad

10−

11−-- | Named alias for a Int pair

12−type DisplayRegion = (Int,Int)

13−

14−regionWidth :: DisplayRegion -> Int

15−regionWidth = fst

16−

17−regionHeight :: DisplayRegion -> Int

18−regionHeight = snd

src/Graphics/Vty/Span.hs+46−55

@@ -1,23 +1,15 @@

11-- Copyright Corey O'Connor

2−{-# LANGUAGE BangPatterns #-}

3−{-# LANGUAGE NamedFieldPuns #-}

42{-# LANGUAGE GADTs #-}

5−{- | A picture is translated into a sequences of state changes and character spans.

6− - State changes are currently limited to new attribute values. The attribute is applied to all

7− - following spans. Including spans of the next row. The nth element of the sequence represents the

8− - nth row (from top to bottom) of the picture to render.

9− -

10− - A span op sequence will be defined for all rows and columns (and no more) of the region provided

11− - with the picture to `spansForPic`.

12− -

13− - todo: Partition attribute changes into multiple categories according to the serialized

14− - representation of the various attributes.

15− -}

16−module Graphics.Vty.Span

17− where

18−

19−import Graphics.Vty.Prelude

3+-- | A picture is translated into a sequences of state changes and

4+-- character spans. The attribute is applied to all following spans,

5+-- including spans of the next row. The nth element of the sequence

6+-- represents the nth row (from top to bottom) of the picture to render.

7+--

8+-- A span op sequence will be defined for all rows and columns (and no

9+-- more) of the region provided with the picture to 'spansForPic'.

10+module Graphics.Vty.Span where

2011

12+import Graphics.Vty.Attributes (Attr)

2113import Graphics.Vty.Image

2214import Graphics.Vty.Image.Internal ( clipText )

2315

@@ -25,40 +17,40 @@ import qualified Data.Text.Lazy as TL

2517import Data.Vector (Vector)

2618import qualified Data.Vector as Vector

2719

28−-- | This represents an operation on the terminal. Either an attribute change or the output of a

29−-- text string.

20+-- | This represents an operation on the terminal: either an attribute

21+-- change or the output of a text string.

3022data SpanOp =

31− -- | a span of UTF-8 text occupies a specific number of screen space columns. A single UTF

32− -- character does not necessarially represent 1 colunm. See Codec.Binary.UTF8.Width

33− -- TextSpan [Attr] [output width in columns] [number of characters] [data]

34− TextSpan

23+ -- | A span of UTF-8 text occupies a specific number of screen space

24+ -- columns. A single UTF character does not necessarily represent 1

25+ -- colunm. See Codec.Binary.UTF8.Width TextSpan [Attr] [output width

26+ -- in columns] [number of characters] [data]

27+ TextSpan

3528 { textSpanAttr :: !Attr

3629 , textSpanOutputWidth :: !Int

3730 , textSpanCharWidth :: !Int

3831 , textSpanText :: DisplayText

3932 }

40− -- | Skips the given number of columns

41− -- A skip is transparent.... maybe? I am not sure how attribute changes interact.

42− -- todo: separate from this type.

33+ -- | Skips the given number of columns.

4334 | Skip !Int

44− -- | Marks the end of a row. specifies how many columns are remaining. These columns will not be

45− -- explicitly overwritten with the span ops. The terminal is require to assure the remaining

35+ -- | Marks the end of a row. Specifies how many columns are

36+ -- remaining. These columns will not be explicitly overwritten with

37+ -- the span ops. The terminal is require to assure the remaining

4638 -- columns are clear.

47− -- todo: separate from this type.

4839 | RowEnd !Int

4940 deriving Eq

5041

51−-- | vector of span operations. executed in succession. This represents the operations required to

52−-- render a row of the terminal. The operations in one row may effect subsequent rows.

53−-- EG: Setting the foreground color in one row will effect all subsequent rows until the foreground

54−-- color is changed.

42+-- | A vector of span operations executed in succession. This represents

43+-- the operations required to render a row of the terminal. The

44+-- operations in one row may affect subsequent rows. For example,

45+-- setting the foreground color in one row will affect all subsequent

46+-- rows until the foreground color is changed.

5547type SpanOps = Vector SpanOp

5648

5749dropOps :: Int -> SpanOps -> SpanOps

5850dropOps w = snd . splitOpsAt w

5951

6052splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)

61−splitOpsAt inW inOps = splitOpsAt' inW inOps

53+splitOpsAt = splitOpsAt'

6254 where

6355 splitOpsAt' 0 ops = (Vector.empty, ops)

6456 splitOpsAt' remainingColumns ops = case Vector.head ops of

@@ -89,9 +81,9 @@ splitOpsAt inW inOps = splitOpsAt' inW inOps

8981 , Vector.cons (Skip (w - remainingColumns)) (Vector.tail ops)

9082 )

9183 RowEnd _ -> error "cannot split ops containing a row end"

92−

9384

94−-- | vector of span operation vectors for display. One per row of the output region.

85+-- | A vector of span operation vectors for display, one per row of the

86+-- output region.

9587type DisplayOps = Vector SpanOps

9688

9789instance Show SpanOp where

@@ -99,40 +91,39 @@ instance Show SpanOp where

9991 show (Skip ow) = "Skip(" ++ show ow ++ ")"

10092 show (RowEnd ow) = "RowEnd(" ++ show ow ++ ")"

10193

102−-- | Number of columns the DisplayOps are defined for

94+-- | The number of columns the DisplayOps are defined for.

10395--

104−-- All spans are verified to define same number of columns. See: VerifySpanOps

96+-- All spans are verified to define same number of columns.

10597displayOpsColumns :: DisplayOps -> Int

106−displayOpsColumns ops

98+displayOpsColumns ops

10799 | Vector.length ops == 0 = 0

108100 | otherwise = Vector.length $ Vector.head ops

109101

110−-- | Number of rows the DisplayOps are defined for

102+-- | The number of rows the DisplayOps are defined for.

111103displayOpsRows :: DisplayOps -> Int

112−displayOpsRows ops = Vector.length ops

104+displayOpsRows = Vector.length

113105

114−effectedRegion :: DisplayOps -> DisplayRegion

115−effectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)

106+affectedRegion :: DisplayOps -> DisplayRegion

107+affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)

116108

117−-- | The number of columns a SpanOps effects.

118−spanOpsEffectedColumns :: SpanOps -> Int

119−spanOpsEffectedColumns inOps = Vector.foldl' spanOpsEffectedColumns' 0 inOps

120− where

121− spanOpsEffectedColumns' t (TextSpan _ w _ _ ) = t + w

122− spanOpsEffectedColumns' t (Skip w) = t + w

123− spanOpsEffectedColumns' t (RowEnd w) = t + w

109+-- | The number of columns a SpanOps affects.

110+spanOpsAffectedColumns :: SpanOps -> Int

111+spanOpsAffectedColumns inOps = Vector.foldl' spanOpsAffectedColumns' 0 inOps

112+ where

113+ spanOpsAffectedColumns' t (TextSpan _ w _ _ ) = t + w

114+ spanOpsAffectedColumns' t (Skip w) = t + w

115+ spanOpsAffectedColumns' t (RowEnd w) = t + w

124116

125−-- | The width of a single SpanOp in columns

117+-- | The width of a single SpanOp in columns.

126118spanOpHasWidth :: SpanOp -> Maybe (Int, Int)

127119spanOpHasWidth (TextSpan _ ow cw _) = Just (cw, ow)

128120spanOpHasWidth (Skip ow) = Just (ow,ow)

129121spanOpHasWidth (RowEnd ow) = Just (ow,ow)

130122

131−-- | returns the number of columns to the character at the given position in the span op

123+-- | The number of columns to the character at the given position in the

124+-- span op.

132125columnsToCharOffset :: Int -> SpanOp -> Int

133126columnsToCharOffset cx (TextSpan _ _ _ utf8Str) =

134− let str = TL.unpack utf8Str

135− in wcswidth (take cx str)

127+ wctlwidth (TL.take (fromIntegral cx) utf8Str)

136128columnsToCharOffset cx (Skip _) = cx

137129columnsToCharOffset cx (RowEnd _) = cx

138−

src/Graphics/Vty/UnicodeWidthTable/IO.hsnew file+105

@@ -0,0 +1,105 @@

1+{-# LANGUAGE CPP #-}

2+module Graphics.Vty.UnicodeWidthTable.IO

3+ ( readUnicodeWidthTable

4+ , parseUnicodeWidthTable

5+ , writeUnicodeWidthTable

6+ )

7+where

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.hsnew file+129

@@ -0,0 +1,129 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE ForeignFunctionInterface #-}

3+module Graphics.Vty.UnicodeWidthTable.Install

4+ ( TableInstallException(..)

5+ , installUnicodeWidthTable

6+ , isCustomTableReady

7+ )

8+where

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.hsnew file+79

@@ -0,0 +1,79 @@

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.hsnew file+29

@@ -0,0 +1,29 @@

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)

stack.yamldeleted−40

@@ -1,40 +0,0 @@

1−# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html

2−

3−# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)

4−resolver: lts-5.11

5−

6−# Local packages, usually specified by relative directory name

7−packages:

8−- '.'

9−- test/

10−

11−# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)

12−extra-deps: []

13−

14−# Override default flag values for local packages and extra-deps

15−flags: {}

16−

17−# Extra package databases containing global packages

18−extra-package-dbs: []

19−

20−nix:

21− enable: true

22− packages: [ncurses]

23−

24−# Control whether we use the GHC we find on the path

25−# system-ghc: true

26−

27−# Require a specific version of stack, using version ranges

28−# require-stack-version: -any # Default

29−# require-stack-version: >= 1.0.0

30−

31−# Override the architecture used by stack, especially useful on Windows

32−# arch: i386

33−# arch: x86_64

34−

35−# Extra directories used by stack for building

36−# extra-include-dirs: [/path/to/dir]

37−# extra-lib-dirs: [/path/to/dir]

38−

39−# Allow a newer minor version of GHC than the snapshot specifies

40−# compiler-check: newer-minor

test/BenchImageFuzz.hs+1−3

@@ -8,8 +8,6 @@ import Verify

88import Control.Applicative

99import Control.Monad

1010

11−import Data.Default (def)

12−

1311import System.Random

1412

1513rand :: Arbitrary a => IO a

@@ -21,7 +19,7 @@ randomImage = rand

2119randomPicture = picForImage <$> randomImage

2220

2321bench0 = do

24− vty <- mkVty def

22+ vty <- mkVty defaultConfig

2523 (w,h) <- displayBounds $ outputIface vty

2624 let pictures = replicateM 3000 randomPicture

2725 bench ps = do

test/BenchNoDiffOpt.hs+3−4

@@ -9,17 +9,16 @@ import Control.Concurrent( threadDelay )

99import Control.Monad( liftM2 )

1010

1111import qualified Data.ByteString.Char8 as B

12−import Data.Default (def)

1312import Data.List

1413

1514import System.Environment( getArgs )

1615import System.IO

1716import System.Random

1817

19−bench0 = do

18+bench0 = do

2019 let fixedGen = mkStdGen 0

2120 setStdGen fixedGen

22− vty <- mkVty def

21+ vty <- mkVty defaultConfig

2322 (w,h) <- displayBounds $ outputIface vty

2423 let images = return $ (image0, image1)

2524 image0 = charFill defAttr 'X' w h

@@ -29,7 +28,7 @@ bench0 = do

2928 shutdown vty

3029 return $ Bench images bench

3130

32−flipOut vty n image0 image1 =

31+flipOut vty n image0 image1 =

3332 let !pLeft = picForImage image0

3433 !pRight = picForImage image1

3534 wLeft 0 = return ()

test/BenchRenderChar.hs+7−9

@@ -1,7 +1,7 @@

1−{- benchmarks composing images using the renderChar operation.

2− - This is what Yi uses in Yi.UI.Vty.drawText. Ideally a sequence of renderChar images horizontally

3− - composed should provide no worse performance than a fill render op.

4− -}

1+-- benchmarks composing images using the renderChar operation. This is

2+-- what Yi uses in Yi.UI.Vty.drawText. Ideally a sequence of renderChar

3+-- images horizontally composed should provide no worse performance than

4+-- a fill render op.

55module BenchRenderChar where

66

77import Graphics.Vty

@@ -9,10 +9,8 @@ import Verify

99

1010import Control.Monad ( forM_ )

1111

12−import Data.Default (def)

13−

1412bench0 = do

15− vty <- mkVty def

13+ vty <- mkVty defaultConfig

1614 (w,h) <- displayBounds $ outputIface vty

1715 let testChars = return $ take 500 $ cycle $ [ c | c <- ['a'..'z']]

1816 bench d = do

@@ -23,12 +21,12 @@ bench0 = do

2321 shutdown vty

2422 return $ Bench testChars bench

2523

26−testImageUsingChar c w h

24+testImageUsingChar c w h

2725 = vertCat $ replicate (fromIntegral h)

2826 $ horizCat $ map (char defAttr) (replicate (fromIntegral w) c)

2927

3028bench1 = do

31− vty <- mkVty def

29+ vty <- mkVty defaultConfig

3230 (w,h) <- displayBounds $ outputIface vty

3331 let testChars = return $ take 500 $ cycle $ [ c | c <- ['a'..'z']]

3432 bench d = do

test/BenchVerticalScroll.hs+4−6

@@ -6,7 +6,6 @@ import Verify

66import Control.Concurrent( threadDelay )

77import Control.Monad( liftM2 )

88

9−import Data.Default (def)

109import Data.List

1110import Data.Word

1211

@@ -14,10 +13,10 @@ import System.Environment( getArgs )

1413import System.IO

1514import System.Random

1615

17−bench0 = do

16+bench0 = do

1817 let fixedGen = mkStdGen 0

1918 setStdGen fixedGen

20− return $ Bench (return ()) (\() -> mkVty def >>= liftM2 (>>) run shutdown)

19+ return $ Bench (return ()) (\() -> mkVty defaultConfig >>= liftM2 (>>) run shutdown)

2120

2221run vt = mapM_ (\p -> update vt p) . benchgen =<< displayBounds (outputIface vt)

2322

@@ -49,13 +48,12 @@ pad :: Int -> Image -> Image

4948pad ml img = img <|> charFill defAttr ' ' (ml - imageWidth img) 1

5049

5150clines :: StdGen -> Int -> [Image]

52−clines g maxll = map (pad maxll . horizCat . map (uncurry string))

51+clines g maxll = map (pad maxll . horizCat . map (uncurry string))

5352 $ fold (length . snd) (lengths maxll g1) (nums g2)

5453 where (g1,g2) = split g

5554

5655benchgen :: DisplayRegion -> [Picture]

57−benchgen (w,h)

56+benchgen (w,h)

5857 = take 2000 $ map ((\i -> picForImage i) . vertCat . take (fromEnum h))

5958 $ tails

6059 $ clines (mkStdGen 80) w

61−

test/ControlTable.hs+1−1

@@ -5,7 +5,7 @@ import Graphics.Vty.ControlStrings

55import System.Console.Terminfo

66

77main = do

8− terminal <- setupTermFromEnv

8+ terminal <- setupTermFromEnv

99 controlTable <- init_controlTable terminal

1010 putStrLn $ "ANSI terminal show cursor string: " ++ show cvis

1111 putStrLn $ "Current terminal show cursor string: " ++ show (showCursorStr controlTable)

test/EventEcho.hs+1−2

@@ -6,7 +6,6 @@ import Control.Applicative

66import Control.Arrow

77import Control.Monad.RWS

88

9−import Data.Default (def)

109import Data.Sequence (Seq, (<|) )

1110import qualified Data.Sequence as Seq

1211import Data.Foldable

@@ -16,7 +15,7 @@ eventBufferSize = 1000

1615type App = RWST Vty () (Seq String) IO

1716

1817main = do

19− vty <- mkVty def

18+ vty <- mkVty defaultConfig

2019 _ <- execRWST (vtyInteract False) vty Seq.empty

2120 shutdown vty

2221

test/HereDoc.hs+2−4

@@ -1,8 +1,7 @@

11{-# LANGUAGE QuasiQuotes #-}

22{-# LANGUAGE TemplateHaskell #-}

3−{- From http://www.reddit.com/r/haskell/comments/8ereh/a_here_document_syntax/

4− - copyright unknown?

5− -}

3+-- From http://www.reddit.com/r/haskell/comments/8ereh/a_here_document_syntax/

4+-- copyright unknown?

65module HereDoc (heredoc) where

76

87import Language.Haskell.TH.Quote

@@ -11,4 +10,3 @@ import Language.Haskell.TH.Lib

1110

1211heredoc :: QuasiQuoter

1312heredoc = QuasiQuoter (litE . stringL) (litP . stringL) undefined undefined

14−

test/Issue18.hs+4−6

@@ -1,5 +1,4 @@

1−module Main

2− where

1+module Main where

32

43import Graphics.Vty

54import Graphics.Vty.Debug

@@ -13,8 +12,8 @@ main = do

1312 play vty sx sy

1413

1514play :: Vty -> Int -> Int -> IO ()

16−play vty sx sy =

17− let

15+play vty sx sy =

16+ let

1817 testScreen = pic {

1918 pCursor = NoCursor

2019 , pImage = box 10 10 }

@@ -31,6 +30,5 @@ box w h =

3130 vertLine = renderFill attr '|' 1 (h - 2)

3231 horizLine = corner <|> renderHFill attr '-' (w - 2) <|> corner

3332 centerArea = vertLine <|> renderFill attr 'X' (w - 2) (h - 2) <|> vertLine

34− in

33+ in

3534 horizLine <-> centerArea <-> horizLine

36−

test/Makefile+2−2

@@ -45,7 +45,7 @@ all : $(VERIF_TESTS)

4545

4646.PHONY: $(TESTS)

4747.SECONDEXPANSION:

48−$(TESTS) :

48+$(TESTS) :

4949 @echo running test $@

5050 @mkdir -p results/$@

5151 ( ghc $(GHC_PROF_ARGS) $@ \

@@ -54,7 +54,7 @@ $(TESTS) :

5454 )

5555

5656.PHONY: interactive_terminal_test

57−interactive_terminal_test :

57+interactive_terminal_test :

5858 ghc $(GHC_ARGS) $@ && ./$@

5959

6060.PHONY: core

test/MinimalExample.hs+1−3

@@ -2,10 +2,8 @@ module Main where

22

33import Graphics.Vty

44

5−import Data.Default

6−

75main = do

8− vty <- mkVty def

6+ vty <- mkVty defaultConfig

97 let line0 = string (def `withForeColor` green) "first line"

108 line1 = string (def `withBackColor` blue) "second line"

119 img = line0 <-> line1

test/Rogue.hs+1−3

@@ -1,10 +1,8 @@

1−{-# LANGUAGE TemplateHaskell #-}

21module Main where

32

43import Graphics.Vty

54

65import Data.Array

7−import Data.Default (def)

86

97import Control.Applicative

108import Control.Monad

@@ -43,7 +41,7 @@ type Coord = (Int, Int)

4341

4442main :: IO ()

4543main = do

46− vty <- mkVty def

44+ vty <- mkVty defaultConfig

4745 level0 <- mkLevel 1

4846 let world0 = World (Player (levelStart level0)) level0

4947 (_finalWorld, ()) <- execRWST play vty world0

test/Test2.hs+1

@@ -1,4 +1,5 @@

11module Main where

2+

23import Graphics.Vty

34

45main = do

test/Verify.hs+20−31

@@ -1,29 +1,29 @@

11{-# LANGUAGE RankNTypes #-}

22{-# LANGUAGE GADTs #-}

33{-# LANGUAGE RecordWildCards #-}

4−{-# LANGUAGE CPP #-}

54{-# LANGUAGE TypeSynonymInstances #-}

65{-# LANGUAGE FlexibleInstances #-}

76{-# LANGUAGE StandaloneDeriving #-}

87{-# LANGUAGE DisambiguateRecordFields #-}

98{-# LANGUAGE NamedFieldPuns #-}

10−module Verify ( module Verify

11− , module Control.Applicative

12− , module Control.DeepSeq

13− , module Control.Exception

14− , module Control.Monad

15− , module Test.QuickCheck

16− , module Test.QuickCheck.Modifiers

17− , module Text.Printf

18− , succeeded

19− , failed

20− , monadicIO

21− , liftIO

22− , liftBool

23− , Test(..)

24− , Prop.Result(..)

25− )

26− where

9+module Verify

10+ ( module Verify

11+ , module Control.Applicative

12+ , module Control.DeepSeq

13+ , module Control.Exception

14+ , module Control.Monad

15+ , module Test.QuickCheck

16+ , module Test.QuickCheck.Modifiers

17+ , module Text.Printf

18+ , succeeded

19+ , failed

20+ , monadicIO

21+ , liftIO

22+ , liftBool

23+ , Test(..)

24+ , Prop.Result(..)

25+ )

26+where

2727

2828import Control.Exception ( bracket, try, SomeException(..) )

2929

@@ -35,7 +35,7 @@ import qualified Test.QuickCheck as QC

3535import Test.QuickCheck.Modifiers

3636import Test.QuickCheck.Property hiding ( Result(..) )

3737import qualified Test.QuickCheck.Property as Prop

38−import Test.QuickCheck.Monadic ( monadicIO )

38+import Test.QuickCheck.Monadic ( monadicIO )

3939

4040import Text.Printf

4141

@@ -56,7 +56,7 @@ verify testName p = Test $ TestInstance

5656 case qcResult of

5757 QC.Success {..} -> return $ Finished TS.Pass

5858 QC.Failure {numShrinks,reason} -> return $ Finished

59− $ TS.Fail $ "After "

59+ $ TS.Fail $ "After "

6060 ++ show numShrinks ++ " shrinks determined failure to be: "

6161 ++ show reason

6262 _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message"

@@ -85,16 +85,5 @@ instance Arbitrary DoubleColumnChar where

8585liftIOResult :: Testable prop => IO prop -> Property

8686liftIOResult = ioProperty

8787

88−#if __GLASGOW_HASKELL__ <= 701

89−instance Random Word where

90− random g =

91− let (i :: Int, g') = random g

92− in (toEnum i, g')

93− randomR (l,h) g =

94− let (i :: Int, g') = randomR (fromEnum l,fromEnum h) g

95− in (toEnum i, g')

96−#endif

97−

9888data Bench where

9989 Bench :: forall v . NFData v => IO v -> (v -> IO ()) -> Bench

100−

test/Verify/Data/Terminfo/Parse.hs+17−17

@@ -1,7 +1,8 @@

1−module Verify.Data.Terminfo.Parse ( module Verify.Data.Terminfo.Parse

2− , module Data.Terminfo.Parse

3− )

4− where

1+module Verify.Data.Terminfo.Parse

2+ ( module Verify.Data.Terminfo.Parse

3+ , module Data.Terminfo.Parse

4+ )

5+where

56

67import Data.Terminfo.Parse

78import Data.Terminfo.Eval

@@ -19,22 +20,22 @@ data NonParamCapString = NonParamCapString String

1920 deriving Show

2021

2122instance Arbitrary NonParamCapString where

22− arbitrary

23+ arbitrary

2324 = ( do

2425 s <- listOf1 $ (choose (0, 255) >>= return . toEnum) `suchThat` (/= '%')

2526 return $ NonParamCapString s

26− ) `suchThat` ( \(NonParamCapString str) -> length str < 255 )

27+ ) `suchThat` ( \(NonParamCapString str) -> length str < 255 )

2728

2829data LiteralPercentCap = LiteralPercentCap String [Word8]

2930 deriving ( Show )

3031

3132instance Arbitrary LiteralPercentCap where

32− arbitrary

33+ arbitrary

3334 = ( do

3435 NonParamCapString s <- arbitrary

3536 (s', bytes) <- insertEscapeOp "%" [toEnum $ fromEnum '%'] s

3637 return $ LiteralPercentCap s' bytes

37− ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 )

38+ ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 )

3839

3940data IncFirstTwoCap = IncFirstTwoCap String [Word8]

4041 deriving ( Show )

@@ -45,7 +46,7 @@ instance Arbitrary IncFirstTwoCap where

4546 NonParamCapString s <- arbitrary

4647 (s', bytes) <- insertEscapeOp "i" [] s

4748 return $ IncFirstTwoCap s' bytes

48− ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 )

49+ ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 )

4950

5051data PushParamCap = PushParamCap String Int [Word8]

5152 deriving ( Show )

@@ -57,7 +58,7 @@ instance Arbitrary PushParamCap where

5758 n <- choose (1,9)

5859 (s', bytes) <- insertEscapeOp ("p" ++ show n) [] s

5960 return $ PushParamCap s' n bytes

60− ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 )

61+ ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 )

6162

6263data DecPrintCap = DecPrintCap String Int [Word8]

6364 deriving ( Show )

@@ -69,7 +70,7 @@ instance Arbitrary DecPrintCap where

6970 n <- choose (1,9)

7071 (s', bytes) <- insertEscapeOp ("p" ++ show n ++ "%d") [] s

7172 return $ DecPrintCap s' n bytes

72− ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 )

73+ ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 )

7374

7475insertEscapeOp opStr replBytes s = do

7576 insertPoints <- listOf1 $ elements [0 .. length s - 1]

@@ -92,21 +93,20 @@ bytesForRange cap offset count

9293 = Vector.toList $ Vector.take count $ Vector.drop offset $ capBytes cap

9394

9495collectBytes :: CapExpression -> [Word8]

95−collectBytes e = concat [ bytes

96+collectBytes e = concat [ bytes

9697 | Bytes offset count <- capOps e

9798 , let bytes = bytesForRange e offset count

9899 ]

99−

100+

100101

101102verifyBytesEqual :: [Word8] -> [Word8] -> Result

102−verifyBytesEqual outBytes expectedBytes

103+verifyBytesEqual outBytes expectedBytes

103104 = if outBytes == expectedBytes

104105 then succeeded

105− else failed

106− { reason = "outBytes ["

106+ else failed

107+ { reason = "outBytes ["

107108 ++ hexDump outBytes

108109 ++ "] /= expectedBytes ["

109110 ++ hexDump expectedBytes

110111 ++ "]"

111112 }

112−

test/Verify/Graphics/Vty/Attributes.hs+7−7

@@ -1,7 +1,8 @@

1−module Verify.Graphics.Vty.Attributes ( module Verify.Graphics.Vty.Attributes

2− , module Graphics.Vty.Attributes

3− )

4− where

1+module Verify.Graphics.Vty.Attributes

2+ ( module Verify.Graphics.Vty.Attributes

3+ , module Graphics.Vty.Attributes

4+ )

5+where

56

67import Graphics.Vty.Attributes

78import Verify

@@ -40,8 +41,8 @@ allStyles =

4041

4142-- Limit the possible attributes to just a few for now.

4243possibleAttrMods :: [ AttrOp ]

43−possibleAttrMods =

44− [ idOp

44+possibleAttrMods =

45+ [ idOp

4546 ] ++ map setForeColorOp allColors

4647 ++ map setBackColorOp allColors

4748 ++ map setStyleOp allStyles

@@ -70,4 +71,3 @@ idOp = AttrOp "id" id

7071

7172applyOp :: AttrOp -> Attr -> Attr

7273applyOp (AttrOp _ f) a = f a

73−

test/Verify/Graphics/Vty/DisplayAttributes.hs+5−5

@@ -1,8 +1,8 @@

1−module Verify.Graphics.Vty.DisplayAttributes ( module Verify.Graphics.Vty.DisplayAttributes

2− , module Graphics.Vty.DisplayAttributes

3− )

4− where

1+module Verify.Graphics.Vty.DisplayAttributes

2+ ( module Verify.Graphics.Vty.DisplayAttributes

3+ , module Graphics.Vty.DisplayAttributes

4+ )

5+where

56

67import Graphics.Vty.DisplayAttributes

78import Verify

8−

test/Verify/Graphics/Vty/Image.hs+18−18

@@ -1,10 +1,11 @@

11{-# LANGUAGE BangPatterns #-}

22{-# LANGUAGE NamedFieldPuns #-}

33{-# LANGUAGE DisambiguateRecordFields #-}

4−module Verify.Graphics.Vty.Image ( module Verify.Graphics.Vty.Image

5− , module Graphics.Vty.Image

6− )

7− where

4+module Verify.Graphics.Vty.Image

5+ ( module Verify.Graphics.Vty.Image

6+ , module Graphics.Vty.Image

7+ )

8+where

89

910import Verify.Graphics.Vty.Attributes

1011import Graphics.Vty.Image

@@ -26,7 +27,7 @@ instance Show UnitImage where

2627data DefaultImage = DefaultImage Image

2728

2829instance Show DefaultImage where

29− show (DefaultImage i)

30+ show (DefaultImage i)

3031 = "DefaultImage (" ++ show i ++ ") " ++ show (imageWidth i, imageHeight i)

3132

3233instance Arbitrary DefaultImage where

@@ -34,15 +35,15 @@ instance Arbitrary DefaultImage where

3435 i <- return $ char defAttr 'X'

3536 return $ DefaultImage i

3637

37−data SingleRowSingleAttrImage

38− = SingleRowSingleAttrImage

38+data SingleRowSingleAttrImage

39+ = SingleRowSingleAttrImage

3940 { expectedAttr :: Attr

4041 , expectedColumns :: Int

4142 , rowImage :: Image

4243 }

4344

4445instance Show SingleRowSingleAttrImage where

45− show (SingleRowSingleAttrImage attr columns image)

46+ show (SingleRowSingleAttrImage attr columns image)

4647 = "SingleRowSingleAttrImage (" ++ show attr ++ ") " ++ show columns ++ " ( " ++ show image ++ " )"

4748

4849newtype WidthResize = WidthResize (Image -> (Image, Int))

@@ -84,14 +85,14 @@ instance Arbitrary ImageResize where

8485 , do

8586 ImageResize f <- arbitrary

8687 WidthResize g <- arbitrary

87− return $! ImageResize $! \i ->

88+ return $! ImageResize $! \i ->

8889 let (i0, (_, outHeight)) = f i

8990 gI = g i0

9091 in (fst gI, (snd gI, outHeight))

9192 , do

9293 ImageResize f <- arbitrary

9394 HeightResize g <- arbitrary

94− return $! ImageResize $! \i ->

95+ return $! ImageResize $! \i ->

9596 let (i0, (outWidth, _)) = f i

9697 gI = g i0

9798 in (fst gI, (outWidth, snd gI))

@@ -100,17 +101,17 @@ instance Arbitrary ImageResize where

100101

101102instance Arbitrary SingleRowSingleAttrImage where

102103 arbitrary = do

103− -- The text must contain at least one character. Otherwise the image simplifies to the

104− -- IdImage which has a height of 0. If this is to represent a single row then the height

105− -- must be 1

104+ -- The text must contain at least one character. Otherwise the

105+ -- image simplifies to the IdImage which has a height of 0. If

106+ -- this is to represent a single row then the height must be 1

106107 singleColumnRowText <- Verify.resize 16 (listOf1 arbitrary)

107108 a <- arbitrary

108109 let outImage = horizCat $ [char a c | SingleColumnChar c <- singleColumnRowText]

109110 outWidth = length singleColumnRowText

110111 return $ SingleRowSingleAttrImage a outWidth outImage

111112

112−data SingleRowTwoAttrImage

113− = SingleRowTwoAttrImage

113+data SingleRowTwoAttrImage

114+ = SingleRowTwoAttrImage

114115 { part0 :: SingleRowSingleAttrImage

115116 , part1 :: SingleRowSingleAttrImage

116117 , joinImage :: Image

@@ -122,8 +123,8 @@ instance Arbitrary SingleRowTwoAttrImage where

122123 p1 <- arbitrary

123124 return $ SingleRowTwoAttrImage p0 p1 (rowImage p0 <|> rowImage p1)

124125

125−data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack

126− { stackImage :: Image

126+data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack

127+ { stackImage :: Image

127128 , stackSourceImages :: [SingleRowSingleAttrImage]

128129 , stackWidth :: Int

129130 , stackHeight :: Int

@@ -215,4 +216,3 @@ instance Arbitrary Translation where

215216 y <- arbitrary `suchThat` (> 0)

216217 let i' = translate x y i

217218 return $ Translation i (x,y) i'

218−

test/Verify/Graphics/Vty/Output.hs+5−7

@@ -4,18 +4,17 @@ import Control.Applicative ((<$>))

44

55import Graphics.Vty.Output.Mock

66

7−import qualified Data.ByteString as BS

87import Data.IORef

98import qualified Data.String.UTF8 as UTF8

109

1110import Test.QuickCheck.Property

1211

13−-- A list of terminals that should be supported.

14−-- This started with a list of terminals ubuntu supported. Then those terminals that really could

15−-- not be supported were removed. Then a few more were pruned until a reasonable looking set was

16−-- made.

12+-- A list of terminals that should be supported. This started with a

13+-- list of terminals ubuntu supported. Then those terminals that really

14+-- could not be supported were removed. Then a few more were pruned

15+-- until a reasonable looking set was made.

1716terminalsOfInterest :: [String]

18−terminalsOfInterest =

17+terminalsOfInterest =

1918 [ "vt100"

2019 , "vt220"

2120 , "vt102"

@@ -58,4 +57,3 @@ compareMockOutput mockData expectedStr = do

5857 ++ expectedStr

5958 }

6059 else return succeeded

61−

test/Verify/Graphics/Vty/Picture.hs+13−13

@@ -1,8 +1,9 @@

11{-# LANGUAGE DisambiguateRecordFields #-}

2−module Verify.Graphics.Vty.Picture ( module Verify.Graphics.Vty.Picture

3− , module Graphics.Vty.Picture

4− )

5− where

2+module Verify.Graphics.Vty.Picture

3+ ( module Verify.Graphics.Vty.Picture

4+ , module Graphics.Vty.Picture

5+ )

6+where

67

78import Verify.Graphics.Vty.Prelude

89

@@ -14,9 +15,9 @@ import Verify.Graphics.Vty.Image

1415

1516import Verify

1617

17−data DefaultPic = DefaultPic

18+data DefaultPic = DefaultPic

1819 { defaultPic :: Picture

19− , defaultWin :: MockWindow

20+ , defaultWin :: MockWindow

2021 }

2122

2223instance Show DefaultPic where

@@ -27,10 +28,10 @@ instance Arbitrary DefaultPic where

2728 arbitrary = do

2829 DefaultImage image <- arbitrary

2930 let win = MockWindow (imageWidth image) (imageHeight image)

30− return $ DefaultPic (picForImage image)

31− win

31+ return $ DefaultPic (picForImage image)

32+ win

3233

33−data PicWithBGAttr = PicWithBGAttr

34+data PicWithBGAttr = PicWithBGAttr

3435 { withAttrPic :: Picture

3536 , withAttrWin :: MockWindow

3637 , withAttrSpecifiedAttr :: Attr

@@ -41,12 +42,11 @@ instance Arbitrary PicWithBGAttr where

4142 DefaultImage image <- arbitrary

4243 let win = MockWindow (imageWidth image) (imageHeight image)

4344 attr <- arbitrary

44− return $ PicWithBGAttr (picForImage image)

45− win

45+ return $ PicWithBGAttr (picForImage image)

46+ win

4647 attr

47−

48+

4849instance Arbitrary Picture where

4950 arbitrary = do

5051 layers <- Verify.resize 20 (listOf1 arbitrary)

5152 return $ picForLayers layers

52−

test/Verify/Graphics/Vty/Prelude.hs+5−7

@@ -1,10 +1,8 @@

1−module Verify.Graphics.Vty.Prelude ( module Verify.Graphics.Vty.Prelude

2− , module Graphics.Vty.Prelude

3− , MockWindow(..)

4− )

5− where

6−

7−import Graphics.Vty.Prelude

1+module Verify.Graphics.Vty.Prelude

2+ ( module Verify.Graphics.Vty.Prelude

3+ , MockWindow(..)

4+ )

5+where

86

97import Graphics.Vty.Debug

108

test/Verify/Graphics/Vty/Span.hs+7−7

@@ -1,8 +1,9 @@

11{-# LANGUAGE FlexibleInstances #-}

2−module Verify.Graphics.Vty.Span ( module Verify.Graphics.Vty.Span

3− , module Graphics.Vty.Span

4− )

5− where

2+module Verify.Graphics.Vty.Span

3+ ( module Verify.Graphics.Vty.Span

4+ , module Graphics.Vty.Span

5+ )

6+where

67

78import Graphics.Vty.Debug

89import Graphics.Vty.Span

@@ -19,10 +20,10 @@ isAttrSpanOp TextSpan {} = True

1920isAttrSpanOp _ = False

2021

2122verifyAllSpansHaveWidth i spans w

22− = let v = map (\s -> (spanOpsEffectedColumns s /= w, s)) (Vector.toList spans)

23+ = let v = map (\s -> (spanOpsAffectedColumns s /= w, s)) (Vector.toList spans)

2324 in case any ((== True) . fst) v of

2425 False -> succeeded

25− True -> failed { reason = "Not all spans contained operations defining exactly "

26+ True -> failed { reason = "Not all spans contained operations defining exactly "

2627 ++ show w

2728 ++ " columns of output - \n"

2829 ++ (concatMap ((++ "\n") . show)) v

@@ -34,4 +35,3 @@ verifyOpsEquality i_ops i_alt_ops =

3435 else failed { reason = "ops for alternate image " ++ show i_alt_ops

3536 ++ " are not the same as " ++ show i_ops

3637 }

37−

test/VerifyAttributeOps.hsdeleted−9

@@ -1,9 +0,0 @@

1−module VerifyAttributeOps where

2−

3−import Verify.Graphics.Vty.Attributes

4−

5−import Verify

6−

7−tests :: IO [Test]

8−tests = return []

9−

test/VerifyColor240.hsnew file+269

@@ -0,0 +1,269 @@

1+module VerifyColor240 where

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/VerifyConfig.hs+1−3

@@ -4,7 +4,6 @@ module Main where

44import Graphics.Vty.Config

55import Graphics.Vty.Input.Events

66

7−import Data.Default

87import Data.String.QQ

98import qualified Data.ByteString.Char8 as B

109

@@ -24,7 +23,7 @@ debugLog "/tmp/vty-debug.txt"

2423|]

2524

2625exampleConfigConfig :: Config

27−exampleConfigConfig = def

26+exampleConfigConfig = defaultConfig

2827 { debugLog = Just "/tmp/vty-debug.txt"

2928 , inputMap = [ (Nothing, "\ESC[B", EvKey KUp [])

3029 , (Nothing, "\ESC[1;3B", EvKey KDown [MAlt])

@@ -43,4 +42,3 @@ main :: IO ()

4342main = defaultMain

4443 [ testCase "example config parses" $ exampleConfigParses

4544 ]

46−

test/VerifyCropSpanGeneration.hs+2−3

@@ -13,7 +13,7 @@ import Graphics.Vty.PictureToSpans

1313

1414import Verify

1515

16−import qualified Data.Vector as Vector

16+import qualified Data.Vector as Vector

1717

1818cropOpDisplayOps :: (Int -> Image -> Image) ->

1919 Int -> Image -> (DisplayOps, Image)

@@ -75,7 +75,7 @@ cropTopAndBottomRejoinedEquivalence stack = imageHeight (stackImage stack) `mod`

7575 in displayOpsForImage i == displayOpsForImage iAlt

7676

7777tests :: IO [Test]

78−tests = return

78+tests = return

7979 [ verify "cropping from the bottom produces display operations covering the expected rows"

8080 cropBottomOutputRows

8181 , verify "cropping from the top produces display operations covering the expected rows"

@@ -90,4 +90,3 @@ tests = return

9090 , verify "the output of a stack is the same as that stack cropped top & bottom and joined together"

9191 cropTopAndBottomRejoinedEquivalence

9292 ]

93−

test/VerifyEmptyImageProps.hs+2−1

@@ -1,9 +1,10 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

12module VerifyEmptyImageProps where

23

34import Verify

45

56-- should be exported by Graphics.Vty.Picture

6−import Graphics.Vty.Picture ( Image, emptyImage )

7+import Graphics.Vty.Image ( Image, emptyImage )

78

89tests :: IO [Test]

910tests = do

test/VerifyEvalTerminfoCaps.hs+14−12

@@ -1,9 +1,10 @@

11{-# LANGUAGE BangPatterns #-}

22{-# LANGUAGE NamedFieldPuns #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

34module VerifyEvalTerminfoCaps where

45

56import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)

6−import Data.Terminfo.Eval

7+import Data.Terminfo.Eval

78import Data.Terminfo.Parse

89import Control.DeepSeq

910

@@ -24,8 +25,9 @@ import Foreign.Marshal.Alloc (mallocBytes)

2425import Foreign.Ptr (Ptr, minusPtr)

2526import Numeric

2627

27−-- If a terminal defines one of the caps then it's expected to be parsable.

28−capsOfInterest =

28+-- If a terminal defines one of the caps then it's expected to be

29+-- parsable.

30+capsOfInterest =

2931 [ "cup"

3032 , "sc"

3133 , "rc"

@@ -49,12 +51,13 @@ fromCapname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr na

4951

5052tests :: IO [Test]

5153tests = do

52− evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024) -- Should be big enough for any termcaps ;-)

54+ -- 1 MB should be big enough for any termcaps ;-)

55+ evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024)

5356 fmap concat $ forM terminalsOfInterest $ \termName -> do

5457 putStrLn $ "adding tests for terminal: " ++ termName

5558 mti <- try $ Terminfo.setupTerm termName

5659 case mti of

57− Left (_e :: SomeException)

60+ Left (_e :: SomeException)

5861 -> return []

5962 Right ti -> do

6063 fmap concat $ forM capsOfInterest $ \capName -> do

@@ -71,7 +74,7 @@ tests = do

7174{-# NOINLINE verifyEvalCap #-}

7275verifyEvalCap :: Ptr Word8 -> CapExpression -> Int -> Property

7376verifyEvalCap evalBuffer expr !junkInt = do

74− forAll (vector 9) $ \inputValues ->

77+ forAll (vector 9) $ \inputValues ->

7578 let write = writeCapExpr expr inputValues

7679 !byteCount = getBound write

7780 in liftIOResult $ do

@@ -79,12 +82,11 @@ verifyEvalCap evalBuffer expr !junkInt = do

7982 forM_ [0..100] $ \i -> runWrite write startPtr

8083 endPtr <- runWrite write startPtr

8184 case endPtr `minusPtr` startPtr of

82− count | count < 0 ->

85+ count | count < 0 ->

8386 return $ failed { reason = "End pointer before start pointer." }

84− | toEnum count > byteCount ->

85− return $ failed { reason = "End pointer past end of buffer by "

86− ++ show (toEnum count - byteCount)

87+ | toEnum count > byteCount ->

88+ return $ failed { reason = "End pointer past end of buffer by "

89+ ++ show (toEnum count - byteCount)

8790 }

88− | otherwise ->

91+ | otherwise ->

8992 return succeeded

90−

test/VerifyImageOps.hs+27−27

@@ -1,3 +1,4 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

12module VerifyImageOps where

23

34import Graphics.Vty.Attributes

@@ -9,43 +10,43 @@ import Verify

910import Control.DeepSeq

1011

1112twoSwHorizConcat :: SingleColumnChar -> SingleColumnChar -> Bool

12−twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) =

13+twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) =

1314 imageWidth (char defAttr c1 <|> char defAttr c2) == 2

1415

1516manySwHorizConcat :: [SingleColumnChar] -> Bool

16−manySwHorizConcat cs =

17+manySwHorizConcat cs =

1718 let chars = [ char | SingleColumnChar char <- cs ]

1819 l = fromIntegral $ length cs

1920 in imageWidth ( horizCat $ map (char defAttr) chars ) == l

2021

2122twoSwVertConcat :: SingleColumnChar -> SingleColumnChar -> Bool

22−twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) =

23+twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) =

2324 imageHeight (char defAttr c1 <-> char defAttr c2) == 2

2425

2526horizConcatSwAssoc :: SingleColumnChar -> SingleColumnChar -> SingleColumnChar -> Bool

26−horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =

27− (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

28− ==

27+horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =

28+ (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

29+ ==

2930 char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)

3031

3132twoDwHorizConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool

32−twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

33+twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

3334 imageWidth (char defAttr c1 <|> char defAttr c2) == 4

3435

3536manyDwHorizConcat :: [DoubleColumnChar] -> Bool

36−manyDwHorizConcat cs =

37+manyDwHorizConcat cs =

3738 let chars = [ char | DoubleColumnChar char <- cs ]

3839 l = fromIntegral $ length cs

3940 in imageWidth ( horizCat $ map (char defAttr) chars ) == l * 2

4041

4142twoDwVertConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool

42−twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

43+twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

4344 imageHeight (char defAttr c1 <-> char defAttr c2) == 2

4445

4546horizConcatDwAssoc :: DoubleColumnChar -> DoubleColumnChar -> DoubleColumnChar -> Bool

46−horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =

47− (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

48− ==

47+horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =

48+ (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

49+ ==

4950 char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)

5051

5152vertContatSingleRow :: NonEmptyList SingleRowSingleAttrImage -> Bool

@@ -54,9 +55,9 @@ vertContatSingleRow (NonEmpty stack) =

5455 stackImage = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack ]

5556 in imageHeight stackImage == expectedHeight

5657

57−disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage

58− -> NonEmptyList SingleRowSingleAttrImage

59− -> Bool

58+disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage

59+ -> NonEmptyList SingleRowSingleAttrImage

60+ -> Bool

6061disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) =

6162 let expectedHeight :: Int = max (length stack0) (length stack1)

6263 stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

@@ -64,9 +65,9 @@ disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) =

6465 in imageHeight (stackImage0 <|> stackImage1) == expectedHeight

6566

6667

67−disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

68− -> NonEmptyList SingleRowSingleAttrImage

69− -> Bool

68+disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

69+ -> NonEmptyList SingleRowSingleAttrImage

70+ -> Bool

7071disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =

7172 let stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

7273 stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]

@@ -74,31 +75,31 @@ disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =

7475 expectedHeight = imageHeight image

7576 in case image of

7677 HorizJoin {} -> ( expectedHeight == (imageHeight $ partLeft image) )

77− &&

78+ &&

7879 ( expectedHeight == (imageHeight $ partRight image) )

7980 _ -> True

8081

81−disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage

82+disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage

8283 -> NonEmptyList SingleRowSingleAttrImage

8384 -> Bool

8485disjointWidthVertJoin (NonEmpty stack0) (NonEmpty stack1) =

8586 let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)

8687 stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

8788 stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]

88− stack0Image = vertCat stack0Images

89− stack1Image = vertCat stack1Images

89+ stack0Image = vertCat stack0Images

90+ stack1Image = vertCat stack1Images

9091 image = stack0Image <-> stack1Image

9192 in imageWidth image == expectedWidth

9293

93−disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

94+disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

9495 -> NonEmptyList SingleRowSingleAttrImage

9596 -> Bool

9697disjointWidthVertJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =

9798 let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)

9899 stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

99100 stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]

100− stack0Image = vertCat stack0Images

101− stack1Image = vertCat stack1Images

101+ stack0Image = vertCat stack0Images

102+ stack1Image = vertCat stack1Images

102103 image = stack0Image <-> stack1Image

103104 in case image of

104105 VertJoin {} -> ( expectedWidth == (imageWidth $ partTop image) )

@@ -136,7 +137,7 @@ cropBottomLimitsHeight :: Image -> Int -> Property

136137cropBottomLimitsHeight i v = v >= 0 ==>

137138 v >= imageHeight (cropBottom v i)

138139

139−-- rediculous tests just to satisfy my desire for nice code coverage :-P

140+-- ridiculous tests just to satisfy my desire for nice code coverage :-P

140141canShowImage :: Image -> Bool

141142canShowImage i = length (show i) > 0

142143

@@ -171,4 +172,3 @@ tests = return

171172 , verify "can rnf image" canRnfImage

172173 , verify "can pp image" canPpImage

173174 ]

174−

test/VerifyImageTrans.hs+1−1

@@ -22,7 +22,7 @@ verifyHorizContatWAttrChangeSimplifies :: SingleRowTwoAttrImage -> Bool

2222verifyHorizContatWAttrChangeSimplifies ( SingleRowTwoAttrImage (SingleRowSingleAttrImage attr0 charCount0 _image0)

2323 (SingleRowSingleAttrImage attr1 charCount1 _image1)

2424 i

25− )

25+ )

2626 | charCount0 == 0 || charCount1 == 0 || attr0 == attr1 = isHorizTextOfColumns i (charCount0 + charCount1)

2727 | otherwise = False == isHorizTextOfColumns i (charCount0 + charCount1)

2828

test/VerifyLayersSpanGeneration.hs+9−7

@@ -4,6 +4,7 @@ module VerifyLayersSpanGeneration where

44

55import Verify.Graphics.Vty.Prelude

66

7+import Verify.Graphics.Vty.Attributes

78import Verify.Graphics.Vty.Image

89import Verify.Graphics.Vty.Picture

910import Verify.Graphics.Vty.Span

@@ -13,7 +14,7 @@ import Graphics.Vty.PictureToSpans

1314

1415import Verify

1516

16−import qualified Data.Vector as Vector

17+import qualified Data.Vector as Vector

1718

1819largerHorizSpanOcclusion :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result

1920largerHorizSpanOcclusion row0 row1 =

@@ -25,8 +26,9 @@ largerHorizSpanOcclusion row0 row1 =

2526 ops = displayOpsForPic p (imageWidth iLarger,imageHeight iLarger)

2627 in verifyOpsEquality expectedOps ops

2728

28−-- | Two rows stacked vertical is equivalent to the first row rendered as the top layer and the

29−-- second row rendered as a bottom layer with a background fill where the first row would be.

29+-- | Two rows stacked vertical is equivalent to the first row rendered

30+-- as the top layer and the second row rendered as a bottom layer with a

31+-- background fill where the first row would be.

3032vertStackLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result

3133vertStackLayerEquivalence0 row0 row1 =

3234 let i0 = rowImage row0

@@ -52,8 +54,9 @@ vertStackLayerEquivalence1 row0 row1 =

5254 opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)

5355 in verifyOpsEquality expectedOps opsLayered

5456

55−-- | Two rows horiz joined is equivalent to the first row rendered as the top layer and the

56−-- second row rendered as a bottom layer with a background fill where the first row would be.

57+-- | Two rows horiz joined is equivalent to the first row rendered as

58+-- the top layer and the second row rendered as a bottom layer with a

59+-- background fill where the first row would be.

5760horizJoinLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result

5861horizJoinLayerEquivalence0 row0 row1 =

5962 let i0 = rowImage row0

@@ -109,7 +112,7 @@ horizJoinAlternate1 =

109112 in verifyOpsEquality expectedOps opsLayered

110113

111114tests :: IO [Test]

112−tests = return

115+tests = return

113116 [ verify "a larger horiz span occludes a smaller span on a lower layer"

114117 largerHorizSpanOcclusion

115118 , verify "two rows stack vertical equiv to first image layered on top of second with padding (0)"

@@ -125,4 +128,3 @@ tests = return

125128 -- , verify "alternating images using joins is the same as alternating images using layers (1)"

126129 -- horizJoinAlternate1

127130 ]

128−

test/VerifyOutput.hs+12−9

@@ -1,8 +1,9 @@

1−{- We setup the environment to envoke certain terminals of interest.

2− - This assumes appropriate definitions exist in the current environment for the terminals of

3− - interest.

4− -}

1+-- We setup the environment to invoke certain terminals of interest.

2+-- This assumes appropriate definitions exist in the current environment

3+-- for the terminals of interest.

4+{-# LANGUAGE ScopedTypeVariables #-}

55module VerifyOutput where

6+

67import Verify

78

89import Graphics.Vty

@@ -12,10 +13,7 @@ import Verify.Graphics.Vty.Output

1213

1314import Control.Monad

1415

15−import Data.Default

16−

1716import qualified System.Console.Terminfo as Terminfo

18−import System.Posix.Env

1917import System.Posix.IO

2018

2119tests :: IO [Test]

@@ -37,11 +35,16 @@ smokeTestTermNonMac termName i = liftIOResult $ do

3735smokeTestTerm :: String -> Image -> IO Result

3836smokeTestTerm termName i = do

3937 nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags

40− t <- outputForConfig $ def { outputFd = Just nullOut, termName = Just termName }

38+ t <- outputForConfig $ defaultConfig

39+ { outputFd = Just nullOut

40+ , termName = Just termName

41+ , colorMode = Just NoColor

42+ }

4143 -- putStrLn $ "context color count: " ++ show (contextColorCount t)

4244 reserveDisplay t

4345 dc <- displayContext t (100,100)

44− -- always show the cursor to produce tests for terminals with no cursor support.

46+ -- always show the cursor to produce tests for terminals with no

47+ -- cursor support.

4548 let pic = (picForImage i) { picCursor = Cursor 0 0 }

4649 outputPicture dc pic

4750 setCursorPos t 0 0

test/VerifyParseTerminfoCaps.hs+4−4

@@ -1,4 +1,5 @@

11{-# LANGUAGE NamedFieldPuns #-}

2+{-# LANGUAGE ScopedTypeVariables #-}

23module VerifyParseTerminfoCaps where

34

45import Prelude hiding ( catch )

@@ -16,7 +17,7 @@ import Numeric

1617

1718-- If a terminal defines one of the caps then it's expected to be parsable.

1819-- TODO: reduce duplication with terminfo terminal implementation.

19−capsOfInterest =

20+capsOfInterest =

2021 [ "cup"

2122 , "sc"

2223 , "rc"

@@ -65,7 +66,7 @@ verifyParseCap capString onParse =

6566 Right e -> onParse e

6667

6768nonParamaterizedCaps (NonParamCapString cap) = do

68− verifyParseCap cap $ \e ->

69+ verifyParseCap cap $ \e ->

6970 let expectedBytes = map (toEnum . fromEnum) cap

7071 outBytes = bytesForRange e 0 (length cap)

7172 in verifyBytesEqual outBytes expectedBytes

@@ -75,7 +76,7 @@ literalPercentCaps (LiteralPercentCap capString expectedBytes) = do

7576

7677incFirstTwoCaps (IncFirstTwoCap capString expectedBytes) = do

7778 verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes

78−

79+

7980pushParamCaps (PushParamCap capString expectedParamCount expectedBytes) = do

8081 verifyParseCap capString $ \e ->

8182 let outBytes = collectBytes e

@@ -98,4 +99,3 @@ printCap ti capName = do

9899printExpression ti capName = do

99100 let parseResult = parseCapExpression $ fromCapname ti capName

100101 putStrLn $ capName ++ ": " ++ show parseResult

101−

test/VerifySimpleSpanGeneration.hs+16−16

@@ -13,31 +13,31 @@ import Graphics.Vty.PictureToSpans

1313

1414import Verify

1515

16−import qualified Data.Vector as Vector

16+import qualified Data.Vector as Vector

1717

1818unitImageAndZeroWindow0 :: UnitImage -> EmptyWindow -> Bool

19−unitImageAndZeroWindow0 (UnitImage _ i) (EmptyWindow w) =

19+unitImageAndZeroWindow0 (UnitImage _ i) (EmptyWindow w) =

2020 let p = picForImage i

2121 ops = displayOpsForPic p (regionForWindow w)

2222 in displayOpsColumns ops == 0 && displayOpsRows ops == 0

2323

2424unitImageAndZeroWindow1 :: UnitImage -> EmptyWindow -> Bool

25−unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =

25+unitImageAndZeroWindow1 (UnitImage _ i) (EmptyWindow w) =

2626 let p = picForImage i

2727 ops = displayOpsForPic p (regionForWindow w)

28− in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

28+ in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

2929

3030horizSpanImageAndZeroWindow0 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

31−horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

31+horizSpanImageAndZeroWindow0 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

3232 let p = picForImage i

3333 ops = displayOpsForPic p (regionForWindow w)

3434 in displayOpsColumns ops == 0 && displayOpsRows ops == 0

3535

3636horizSpanImageAndZeroWindow1 :: SingleRowSingleAttrImage -> EmptyWindow -> Bool

37−horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

37+horizSpanImageAndZeroWindow1 (SingleRowSingleAttrImage { rowImage = i }) (EmptyWindow w) =

3838 let p = picForImage i

3939 ops = displayOpsForPic p (regionForWindow w)

40− in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

40+ in ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

4141

4242horizSpanImageAndEqualWindow0 :: SingleRowSingleAttrImage -> Result

4343horizSpanImageAndEqualWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =

@@ -51,7 +51,7 @@ horizSpanImageAndEqualWindow1 (SingleRowSingleAttrImage { rowImage = i, expected

5151 let p = picForImage i

5252 w = MockWindow c 1

5353 ops = displayOpsForPic p (regionForWindow w)

54− in spanOpsEffectedRows ops == 1

54+ in spanOpsAffectedRows ops == 1

5555

5656horizSpanImageAndLesserWindow0 :: SingleRowSingleAttrImage -> Result

5757horizSpanImageAndLesserWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =

@@ -74,7 +74,7 @@ singleAttrSingleSpanStackCropped1 stack =

7474 expectedRowCount = stackHeight stack `div` 2

7575 w = MockWindow (stackWidth stack) expectedRowCount

7676 ops = displayOpsForPic p (regionForWindow w)

77− actualRowCount = spanOpsEffectedRows ops

77+ actualRowCount = spanOpsAffectedRows ops

7878 in expectedRowCount == actualRowCount

7979

8080singleAttrSingleSpanStackCropped2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

@@ -90,7 +90,7 @@ singleAttrSingleSpanStackCropped3 stack0 stack1 =

9090 w = MockWindow (imageWidth (picImage p)) expectedRowCount

9191 ops = displayOpsForPic p (regionForWindow w)

9292 expectedRowCount = imageHeight (picImage p) `div` 2

93− actualRowCount = spanOpsEffectedRows ops

93+ actualRowCount = spanOpsAffectedRows ops

9494 in expectedRowCount == actualRowCount

9595

9696singleAttrSingleSpanStackCropped4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

@@ -107,7 +107,7 @@ singleAttrSingleSpanStackCropped5 stack0 stack1 =

107107 w = MockWindow (imageWidth (picImage p)) (stackHeight stack0)

108108 ops = displayOpsForPic p (regionForWindow w)

109109 expectedRowCount = stackHeight stack0

110− actualRowCount = spanOpsEffectedRows ops

110+ actualRowCount = spanOpsAffectedRows ops

111111 in expectedRowCount == actualRowCount

112112

113113horizSpanImageAndGreaterWindow0 :: SingleRowSingleAttrImage -> Result

@@ -123,13 +123,13 @@ arbImageIsCropped :: DefaultImage -> MockWindow -> Bool

123123arbImageIsCropped (DefaultImage image) win@(MockWindow w h) =

124124 let pic = picForImage image

125125 ops = displayOpsForPic pic (regionForWindow win)

126− in ( spanOpsEffectedRows ops == h ) && ( allSpansHaveWidth ops w )

126+ in ( spanOpsAffectedRows ops == h ) && ( allSpansHaveWidth ops w )

127127

128128spanOpsActuallyFillRows :: DefaultPic -> Bool

129129spanOpsActuallyFillRows (DefaultPic pic win) =

130130 let ops = displayOpsForPic pic (regionForWindow win)

131131 expectedRowCount = regionHeight (regionForWindow win)

132− actualRowCount = spanOpsEffectedRows ops

132+ actualRowCount = spanOpsAffectedRows ops

133133 in expectedRowCount == actualRowCount

134134

135135spanOpsActuallyFillColumns :: DefaultPic -> Bool

@@ -139,7 +139,7 @@ spanOpsActuallyFillColumns (DefaultPic pic win) =

139139 in allSpansHaveWidth ops expectedColumnCount

140140

141141firstSpanOpSetsAttr :: DefaultPic -> Bool

142−firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } =

142+firstSpanOpSetsAttr DefaultPic { defaultPic = pic, defaultWin = win } =

143143 let ops = displayOpsForPic pic (regionForWindow win)

144144 in all ( isAttrSpanOp . Vector.head ) ( Vector.toList ops )

145145

@@ -158,7 +158,7 @@ imageCoverageMatchesBounds i =

158158 in verifyAllSpansHaveWidth i ops (imageWidth i)

159159

160160tests :: IO [Test]

161−tests = return

161+tests = return

162162 [ verify "unit image is cropped when window size == (0,0) [0]" unitImageAndZeroWindow0

163163 , verify "unit image is cropped when window size == (0,0) [1]" unitImageAndZeroWindow1

164164 , verify "horiz span image is cropped when window size == (0,0) [0]" horizSpanImageAndZeroWindow0

@@ -171,7 +171,7 @@ tests = return

171171 , verify "a stack of single attr text spans should define content for all the columns [output region == size of stack]"

172172 singleAttrSingleSpanStackOpCoverage

173173 , verify "a single attr text span is cropped when window size < size of stack image [width]"

174− singleAttrSingleSpanStackCropped0

174+ singleAttrSingleSpanStackCropped0

175175 , verify "a single attr text span is cropped when window size < size of stack image [height]"

176176 singleAttrSingleSpanStackCropped1

177177 , verify "single attr text span <|> single attr text span display cropped. [width]"

test/VerifyUsingMockInput.hs+26−22

@@ -1,8 +1,8 @@

11{-# LANGUAGE MultiParamTypeClasses #-}

22{-# LANGUAGE FlexibleInstances #-}

3−{- Generate some input bytes and delays between blocks of input bytes. Verify the events produced

4− - are as expected.

5− -}

3+{-# LANGUAGE ScopedTypeVariables #-}

4+-- Generate some input bytes and delays between blocks of input bytes.

5+-- Verify the events produced are as expected.

66module Main where

77

88import Verify.Graphics.Vty.Output

@@ -12,14 +12,12 @@ import Graphics.Vty.Input.Events

1212import Graphics.Vty.Input.Loop

1313import Graphics.Vty.Input.Terminfo

1414

15−import Control.Applicative

1615import Control.Concurrent

1716import Control.Concurrent.STM

1817import Control.Exception

1918import Lens.Micro ((^.))

2019import Control.Monad

2120

22−import Data.Default

2321import Data.IORef

2422import Data.List (intersperse, reverse, nubBy)

2523

@@ -36,7 +34,8 @@ import Test.SmallCheck.Series

3634

3735import Text.Printf

3836

39−-- processing a block of 16 chars is the largest I can do without taking too long to run the test.

37+-- processing a block of 16 chars is the largest I can do without taking

38+-- too long to run the test.

4039maxBlockSize :: Int

4140maxBlockSize = 16

4241

@@ -47,8 +46,11 @@ forEachOf :: (Show a, Testable m b) => [a] -> (a -> b) -> Property m

4746forEachOf l = over (generate (\n -> take n l))

4847

4948data InputEvent

50− = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.

51− | Delay Int -- | microsecond delay

49+ = Bytes String

50+ -- ^ Input sequence encoded as a string. Regardless, the input is

51+ -- read a byte at a time.

52+ | Delay Int

53+ -- ^ Microsecond delay

5254 deriving Show

5355

5456type InputSpec = [InputEvent]

@@ -111,11 +113,11 @@ assertEventsFromSynInput table inputSpec expectedEvents = do

111113 (writeFd, readFd) <- openPseudoTerminal

112114 (setTermAttr,_) <- attributeControl readFd

113115 setTermAttr

114− let testConfig = def { inputFd = Just readFd

115− , termName = Just "dummy"

116− , vmin = Just 1

117− , vtime = Just 100

118− }

116+ let testConfig = defaultConfig { inputFd = Just readFd

117+ , termName = Just "dummy"

118+ , vmin = Just 1

119+ , vtime = Just 100

120+ }

119121 input <- initInput testConfig table

120122 eventsRef <- newIORef []

121123 let writeWaitClose = do

@@ -130,7 +132,9 @@ assertEventsFromSynInput table inputSpec expectedEvents = do

130132 readLoop 0 = return ()

131133 readLoop n = do

132134 e <- atomically $ readTChan $ input^.eventChannel

133− modifyIORef eventsRef ((:) e)

135+ case e of

136+ InputEvent ev -> modifyIORef eventsRef ((:) ev)

137+ ResumeAfterSignal -> return ()

134138 readLoop (n - 1)

135139 genEventsUsingIoActions maxDuration writeWaitClose readEvents

136140 outEvents <- reverse <$> readIORef eventsRef

@@ -163,8 +167,8 @@ verifyVisibleSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic

163167

164168verifyCapsSynInputToEvent :: Property IO

165169verifyCapsSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->

166− forEachOf terminalsOfInterest $ \termName -> monadic $ do

167− term <- setupTerm termName

170+ forEachOf terminalsOfInterest $ \terminalName -> monadic $ do

171+ term <- setupTerm terminalName

168172 let table = capsClassifyMap term keysFromCapsTable

169173 inputSeq = gen table

170174 events = map snd inputSeq

@@ -183,9 +187,9 @@ verifySpecialSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic

183187

184188verifyFullSynInputToEvent :: Property IO

185189verifyFullSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->

186− forEachOf terminalsOfInterest $ \termName -> monadic $ do

187− term <- setupTerm termName

188− let table = classifyMapForTerm termName term

190+ forEachOf terminalsOfInterest $ \terminalName -> monadic $ do

191+ term <- setupTerm terminalName

192+ let table = classifyMapForTerm terminalName term

189193 inputSeq = gen table

190194 events = map snd inputSeq

191195 keydowns = map (Bytes . fst) inputSeq

@@ -194,9 +198,9 @@ verifyFullSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->

194198

195199verifyFullSynInputToEvent_2x :: Property IO

196200verifyFullSynInputToEvent_2x = forAll $ \(InputBlocksUsingTable gen) ->

197− forEachOf terminalsOfInterest $ \termName -> monadic $ do

198− term <- setupTerm termName

199− let table = classifyMapForTerm termName term

201+ forEachOf terminalsOfInterest $ \terminalName -> monadic $ do

202+ term <- setupTerm terminalName

203+ let table = classifyMapForTerm terminalName term

200204 inputSeq = gen table

201205 events = concatMap ((\s -> [s,s]) . snd) inputSeq

202206 keydowns = map (Bytes . (\s -> s ++ s) . fst) inputSeq

test/VerifyUsingMockTerminal.hs+23−15

@@ -4,9 +4,11 @@ import Verify.Graphics.Vty.Prelude

44

55import Verify.Graphics.Vty.Picture

66import Verify.Graphics.Vty.Image

7+import Verify.Graphics.Vty.Attributes

78import Verify.Graphics.Vty.Span

89import Verify.Graphics.Vty.Output

910import Graphics.Vty.Output

11+import Graphics.Vty.Output.Interface

1012import Graphics.Vty.Output.Mock

1113

1214import Graphics.Vty.Debug

@@ -39,27 +41,30 @@ singleTRow :: MockWindow -> Property

3941singleTRow (MockWindow w h) = liftIOResult $ do

4042 (mockData,t) <- mockTerminal (w,h)

4143 dc <- displayBounds t >>= displayContext t

42− -- create an image that contains just the character T repeated for a single row

44+ -- create an image that contains just the character T repeated for a

45+ -- single row

4346 let i = horizCat $ replicate (fromEnum w) (char defAttr 'T')

4447 pic = (picForImage i) { picBackground = Background 'B' defAttr }

4548 outputPicture dc pic

46− -- The mock output string that represents the output bytes a single line containing the T

47− -- string: Followed by h - 1 lines of a change to the background attribute and then the

48− -- background character

49+ -- The mock output string that represents the output bytes a single

50+ -- line containing the T string: Followed by h - 1 lines of a change

51+ -- to the background attribute and then the background character

4952 let expected = "H" ++ "MDA" ++ replicate (fromEnum w) 'T'

5053 ++ concat (replicate (fromEnum h - 1) $ "MDA" ++ replicate (fromEnum w) 'B')

5154 compareMockOutput mockData expected

52−

55+

5356manyTRows :: MockWindow -> Property

5457manyTRows (MockWindow w h) = liftIOResult $ do

5558 (mockData, t) <- mockTerminal (w,h)

5659 dc <- displayBounds t >>= displayContext t

57− -- create an image that contains the character 'T' repeated for all the rows

60+ -- create an image that contains the character 'T' repeated for all

61+ -- the rows

5862 let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w) (char defAttr 'T')

5963 pic = (picForImage i) { picBackground = Background 'B' defAttr }

6064 outputPicture dc pic

61− -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an

62− -- attribute change. 'A', followed by w 'T's

65+ -- The UTF8 string that represents the output bytes is h repeats of

66+ -- a move, 'M', followed by an attribute change. 'A', followed by w

67+ -- 'T's

6368 let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')

6469 compareMockOutput mockData expected

6570

@@ -67,12 +72,14 @@ manyTRowsCroppedWidth :: MockWindow -> Property

6772manyTRowsCroppedWidth (MockWindow w h) = liftIOResult $ do

6873 (mockData,t) <- mockTerminal (w,h)

6974 dc <- displayBounds t >>= displayContext t

70− -- create an image that contains the character 'T' repeated for all the rows

75+ -- create an image that contains the character 'T' repeated for all

76+ -- the rows

7177 let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w * 2) (char defAttr 'T')

7278 pic = (picForImage i) { picBackground = Background 'B' defAttr }

7379 outputPicture dc pic

74− -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an

75− -- attribute change. 'A', followed by w 'T's

80+ -- The UTF8 string that represents the output bytes is h repeats of

81+ -- a move, 'M', followed by an attribute change. 'A', followed by w

82+ -- 'T's

7683 let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')

7784 compareMockOutput mockData expected

7885

@@ -80,12 +87,14 @@ manyTRowsCroppedHeight :: MockWindow -> Property

8087manyTRowsCroppedHeight (MockWindow w h) = liftIOResult $ do

8188 (mockData,t) <- mockTerminal (w,h)

8289 dc <- displayBounds t >>= displayContext t

83− -- create an image that contains the character 'T' repeated for all the rows

90+ -- create an image that contains the character 'T' repeated for all

91+ -- the rows

8492 let i = vertCat $ replicate (fromEnum h * 2) $ horizCat $ replicate (fromEnum w) (char defAttr 'T')

8593 pic = (picForImage i) { picBackground = Background 'B' defAttr }

8694 outputPicture dc pic

87− -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an

88− -- attribute change. 'A', followed by w count 'T's

95+ -- The UTF8 string that represents the output bytes is h repeats of

96+ -- a move, 'M', followed by an attribute change. 'A', followed by w

97+ -- count 'T's

8998 let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')

9099 compareMockOutput mockData expected

91100

@@ -97,4 +106,3 @@ tests = return [ verify "unitImageUnitBounds" unitImageUnitBounds

97106 , verify "manyTRowsCroppedWidth" manyTRowsCroppedWidth

98107 , verify "manyTRowsCroppedHeight" manyTRowsCroppedHeight

99108 ]

100−

test/VerifyUtf8Width.hs+2

@@ -1,9 +1,11 @@

11module VerifyUtf8Width where

2+

23import Verify

34

45import Graphics.Text.Width

56import Graphics.Vty.Attributes

67import Graphics.Vty.Picture

8+import Graphics.Vty.Image

79

810swIs1Column :: SingleColumnChar -> Bool

911swIs1Column (SingleColumnChar c) = imageWidth (char defAttr c) == 1

test/YiIssue264.hs+1

@@ -1,4 +1,5 @@

11module Main where

2+

23import Graphics.Vty

34import Control.Exception

45

test/interactive_terminal_test.hs+51−52

@@ -12,14 +12,13 @@ import Control.Concurrent (threadDelay)

1212import Control.Exception

1313import Control.Monad

1414

15−import Data.Default (def)

1615import Data.List ( lookup )

1716import Data.Maybe ( isJust, fromJust )

1817import Data.Monoid

1918import Data.String.QQ

2019import Data.Word

2120

22−import Foreign.Marshal.Array

21+import Foreign.Marshal.Array

2322

2423import qualified System.Environment as Env

2524

@@ -74,12 +73,12 @@ with the test_results.list file pasted into the issue. A suitable summary is:

7473|]

7574 waitForReturn

7675 results <- doTestMenu 1

77− envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName )

78− ( \ (_ :: SomeException) -> return (envName, "") )

79− )

76+ envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName )

77+ ( \ (_ :: SomeException) -> return (envName, "") )

78+ )

8079 [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]

8180 t <- standardIOConfig >>= outputForConfig

82− let resultsTxt = show envAttributes ++ "\n"

81+ let resultsTxt = show envAttributes ++ "\n"

8382 ++ terminalID t ++ "\n"

8483 ++ show results ++ "\n"

8584 releaseTerminal t

@@ -94,7 +93,7 @@ testMenu :: [(String, Test)]

9493testMenu = zip (map show [1..]) allTests

9594

9695doTestMenu :: Int -> IO [(String, Bool)]

97−doTestMenu nextID

96+doTestMenu nextID

9897 | nextID > length allTests = do

9998 putStrLn $ "Done! Please email the " ++ outputFilePath ++ " file to coreyoconnor@gmail.com"

10099 return []

@@ -108,26 +107,26 @@ doTestMenu nextID

108107 s <- getLine >>= return . filter (/= '\n')

109108 case s of

110109 "q" -> return mempty

111− "" -> do

112− r <- runTest $ show nextID

110+ "" -> do

111+ r <- runTest $ show nextID

113112 rs <- doTestMenu ( nextID + 1 )

114113 return $ r : rs

115114 i | isJust ( lookup i testMenu ) -> do

116− r <- runTest i

115+ r <- runTest i

117116 rs <- doTestMenu ( read i + 1 )

118117 return $ r : rs

119118 where

120− displayTestMenu

119+ displayTestMenu

121120 = mapM_ displayTestMenu' testMenu

122− displayTestMenu' ( i, t )

123− = putStrLn $ ( if i == show nextID

124− then "> "

121+ displayTestMenu' ( i, t )

122+ = putStrLn $ ( if i == show nextID

123+ then "> "

125124 else " "

126125 ) ++ i ++ ". " ++ testName t

127126

128127runTest :: String -> IO (String, Bool)

129128runTest i = do

130− let t = fromJust $ lookup i testMenu

129+ let t = fromJust $ lookup i testMenu

131130 printSummary t

132131 waitForReturn

133132 testAction t

@@ -153,8 +152,8 @@ data Test = Test

153152 , confirmResults :: IO Bool

154153 }

155154

156−allTests

157− = [ reserveOutputTest

155+allTests

156+ = [ reserveOutputTest

158157 , displayBoundsTest0

159158 , displayBoundsTest1

160159 , displayBoundsTest2

@@ -185,7 +184,7 @@ allTests

185184 , layer1

186185 ]

187186

188−reserveOutputTest = Test

187+reserveOutputTest = Test

189188 { testName = "Initialize and reserve terminal output then restore previous state."

190189 , testID = "reserveOutputTest"

191190 , testAction = do

@@ -203,7 +202,7 @@ reserveOutputTest = Test

203202 , printSummary = do

204203 putStr $ [s|

205204Once return is pressed:

206− 0. The screen will be cleared.

205+ 0. The screen will be cleared.

207206 1. Four lines of text should be visible.

208207 1. The cursor should be visible and at the start of the fifth line.

209208

@@ -365,7 +364,7 @@ Did the test output match the description?

365364|]

366365 defaultSuccessConfirmResults

367366

368−-- Explicitely definethe bytes that encode each example text.

367+-- Explicitly define the bytes that encode each example text.

369368-- This avoids any issues with how the compiler represents string literals.

370369--

371370-- This document is UTF-8 encoded so the UTF-8 string is still included for

@@ -391,7 +390,7 @@ utf8Txt0 = [ [ 0xe2 , 0x86 , 0x91 ]

391390

392391iso10646Txt0 :: String

393392iso10646Txt0 = map toEnum

394− [ 8593

393+ [ 8593

395394 , 8593

396395 , 8595

397396 , 8595

@@ -554,11 +553,11 @@ After return is pressed for the second time:

554553allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]

555554 [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]

556555

557−allBrightColors

556+allBrightColors

558557 = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]

559558 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]

560559

561−attributesTest0 = Test

560+attributesTest0 = Test

562561 { testName = "Character attributes: foreground colors."

563562 , testID = "attributesTest0"

564563 , testAction = do

@@ -604,7 +603,7 @@ Did the test output match the description?

604603 defaultSuccessConfirmResults

605604 }

606605

607−attributesTest1 = Test

606+attributesTest1 = Test

608607 { testName = "Character attributes: background colors."

609608 , testID = "attributesTest1"

610609 , testAction = do

@@ -659,7 +658,7 @@ Did the test output match the description?

659658 defaultSuccessConfirmResults

660659 }

661660

662−attributesTest2 = Test

661+attributesTest2 = Test

663662 { testName = "Character attributes: Vivid foreground colors."

664663 , testID = "attributesTest2"

665664 , testAction = do

@@ -686,23 +685,23 @@ Once return is pressed:

686685 1. The cursor will be hidden.

687686 2. 9 lines of text in three columns will be drawn:

688687 a. The first column will be a name of a standard color (for an 8 color

689− terminal) rendered with that color as the foreground color.

688+ terminal) rendered with that color as the foreground color.

690689 b. The next column will be also be the name of a standard color rendered

691690 with that color as the foreground color but the shade used should be

692− more vivid than the shade used in the first column.

691+ more vivid than the shade used in the first column.

693692 c. The final column will be the name of a color rendered with the

694693 default attributes.

695694

696695For instance, one line will be the word "magenta" and that word should be

697−rendered in the magenta color.

696+rendered in the magenta color.

698697

699698I'm not actually sure exactly what "vivid" means in this context. For xterm the

700−vivid colors are brighter.

699+vivid colors are brighter.

701700

702−Verify:

701+Verify:

703702 * The first column: The foreground color matches the named color.

704703 * The second column: The foreground color matches the named color but is

705− more vivid than the color used in the first column.

704+ more vivid than the color used in the first column.

706705 * The third column: All text is rendered with the default attributes.

707706 * The vertical bars used in each line to mark the border of a column are

708707 lined up.

@@ -718,7 +717,7 @@ Did the test output match the description?

718717 defaultSuccessConfirmResults

719718 }

720719

721−attributesTest3 = Test

720+attributesTest3 = Test

722721 { testName = "Character attributes: Vivid background colors."

723722 , testID = "attributesTest3"

724723 , testAction = do

@@ -746,23 +745,23 @@ Once return is pressed:

746745 2. 9 lines of text in three columns will be drawn:

747746 a. The first column will contain be a name of a standard color for an 8

748747 color terminal rendered with the default foreground color with a

749− background the named color.

748+ background the named color.

750749 b. The first column will contain be a name of a standard color for an 8

751750 color terminal rendered with the default foreground color with the

752− background a vivid version of the named color.

751+ background a vivid version of the named color.

753752 c. The third column will be the name of a standard color rendered with

754753 the default attributes.

755−

754+

756755For instance, one line will contain be the word "magenta" and the word should

757−be rendered in the default foreground color over a magenta background.

756+be rendered in the default foreground color over a magenta background.

758757

759758I'm not actually sure exactly what "vivid" means in this context. For xterm the

760759vivid colors are brighter.

761760

762−Verify:

761+Verify:

763762 * The first column: The background color matches the named color.

764763 * The second column: The background color matches the named color and is

765− more vivid than the color used in the first column.

764+ more vivid than the color used in the first column.

766765 * The third column column: All text is rendered with the default attributes.

767766 * The vertical bars used in each line to mark the border of a column are

768767 lined up.

@@ -785,7 +784,7 @@ Did the test output match the description?

785784 defaultSuccessConfirmResults

786785 }

787786

788−attrCombos =

787+attrCombos =

789788 [ ( "default", id )

790789 , ( "bold", flip withStyle bold )

791790 , ( "blink", flip withStyle blink )

@@ -796,7 +795,7 @@ attrCombos =

796795 , ( "bold + blink + underline", flip withStyle (bold + blink + underline) )

797796 ]

798797

799−attributesTest4 = Test

798+attributesTest4 = Test

800799 { testName = "Character attributes: Bold; Blink; Underline."

801800 , testID = "attributesTest4"

802801 , testAction = do

@@ -819,10 +818,10 @@ attributesTest4 = Test

819818Once return is pressed:

820819 0. The screen will be cleared.

821820 1. The cursor will be hidden.

822− 2. 8 rows of text in two columns.

821+ 2. 8 rows of text in two columns.

823822 The rows will contain the following text:

824823 default

825− bold

824+ bold

826825 blink

827826 underline

828827 bold + blink

@@ -831,8 +830,8 @@ Once return is pressed:

831830 bold + blink + underline

832831 The first column will be rendered with the described attributes. The second

833832 column will be rendered with the default attributes.

834−

835−Verify:

833+

834+Verify:

836835 * The vertical bars used in each line to mark the border of a column are

837836 lined up.

838837 * The text in the first column is rendered as described.

@@ -848,7 +847,7 @@ Did the test output match the description?

848847 defaultSuccessConfirmResults

849848 }

850849

851−attributesTest5 = Test

850+attributesTest5 = Test

852851 { testName = "Character attributes: 240 color palette"

853852 , testID = "attributesTest5"

854853 , testAction = do

@@ -873,7 +872,7 @@ Once return is pressed:

873872 2. A 20 character wide and 12 row high block of color squares. This should look like a palette

874873 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...

875874

876−Verify:

875+Verify:

877876

878877After return is pressed for the second time:

879878 0. The screen containing the test summary should be restored.

@@ -938,7 +937,7 @@ cursorHideTest0 = Test

938937 { testName = "Verify the cursor is hid and re-shown. issue #7"

939938 , testID = "cursorHideTest0"

940939 , testAction = do

941− vty <- mkVty def

940+ vty <- mkVty defaultConfig

942941 showCursor $ outputIface vty

943942 setCursorPos (outputIface vty) 5 5

944943 nextEvent vty

@@ -971,7 +970,7 @@ outputPicAndWait pic = do

971970 releaseDisplay t

972971 releaseTerminal t

973972 return ()

974−

973+

975974vertCropTest0 :: Test

976975vertCropTest0 = Test

977976 { testName = "Verify bottom cropping works as expected with single column chars"

@@ -1046,7 +1045,7 @@ horizCropTest0 = Test

10461045 , testID = "cropTest0"

10471046 , testAction = do

10481047 let baseImage = vertCat $ map (string defAttr) lorumIpsum

1049− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

1048+ croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

10501049 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

10511050 outputImageAndWait image

10521051 , printSummary = putStr $ [s|

@@ -1063,7 +1062,7 @@ horizCropTest1 = Test

10631062 , testID = "cropTest0"

10641063 , testAction = do

10651064 let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese

1066− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

1065+ croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

10671066 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

10681067 outputImageAndWait image

10691068 , printSummary = putStr $ [s|

@@ -1080,7 +1079,7 @@ horizCropTest2 = Test

10801079 , testID = "cropTest0"

10811080 , testAction = do

10821081 let baseImage = vertCat $ map (string defAttr) lorumIpsum

1083− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

1082+ croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

10841083 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

10851084 outputImageAndWait image

10861085 , printSummary = putStr $ [s|

@@ -1097,7 +1096,7 @@ horizCropTest3 = Test

10971096 , testID = "cropTest0"

10981097 , testAction = do

10991098 let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese

1100− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

1099+ croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

11011100 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

11021101 outputImageAndWait image

11031102 , printSummary = putStr $ [s|

test/vty-examples.cabal+24−14

@@ -1,28 +1,38 @@

11name: vty-examples

2−version: 5.6

2+version: 5.7

33license: BSD3

44license-file: LICENSE

55author: AUTHORS

6−maintainer: Corey O'Connor (coreyoconnor@gmail.com)

7−homepage: https://github.com/coreyoconnor/vty

6+maintainer: Jonathan Daugherty (cygnus@foobox.com)

7+homepage: https://github.com/jtdaugherty/vty

88category: User Interfaces

99synopsis: Examples programs using the vty library.

1010description:

11− vty is terminal GUI library in the niche of ncurses. It is intended to be easy to use, have no

12− confusing corner cases, and good support for common terminal types.

11+ vty is terminal GUI library in the niche of ncurses. It is intended to

12+ be easy to use, have no confusing corner cases, and good support for

13+ common terminal types.

1314 .

14− vty-interactive-terminal-test - interactive test. Useful for building a bug report for vtys author.

15− vty-event-echo - view a input event log for vty. Example of interacting with user.

16− vty-rogue - A bad rogue-like game. Go from the entrance to exit. Example of layers

17− vty-benchmark - benchmarks vty. A series of tests that push random pictures to the terminal.

15+ vty-interactive-terminal-test - interactive test. Useful for building

16+ a bug report for vtys author.

17+ .

18+ vty-event-echo - view a input event log for vty. Example of

19+ interacting with user.

20+ .

21+ vty-rogue - A bad rogue-like game. Go from the entrance to exit.

22+ Example of layers

23+ .

24+ vty-benchmark - benchmarks vty. A series of tests that push random

25+ pictures to the terminal.

1826 .

28+ .

2030cabal-version: >= 1.18.0

2131build-type: Simple

2232

2333source-repository head

2434 type: git

25− location: https://github.com/coreyoconnor/vty.git

35+ location: https://github.com/jtdaugherty/vty.git

2636

2737executable vty-interactive-terminal-test

2838 main-is: interactive_terminal_test.hs

@@ -31,7 +41,7 @@ executable vty-interactive-terminal-test

3141 default-extensions: ScopedTypeVariables

3242 ghc-options: -threaded

3343

34− build-depends: vty >= 5.2.11,

44+ build-depends: vty >= 5.15,

3545 base >= 4 && < 5,

3646 bytestring,

3747 containers,

@@ -59,7 +69,7 @@ executable vty-event-echo

5969 FlexibleContexts

6070 ghc-options: -threaded

6171

62− build-depends: vty >= 5.2.11,

72+ build-depends: vty >= 5.15,

6373 base >= 4 && < 5,

6474 array,

6575 bytestring,

@@ -79,7 +89,7 @@ executable vty-rogue

7989 default-extensions: ScopedTypeVariables

8090 ghc-options: -threaded

8191

82− build-depends: vty >= 5.2.11,

92+ build-depends: vty >= 5.15,

8393 base >= 4 && < 5,

8494 array,

8595 bytestring,

@@ -100,7 +110,7 @@ executable vty-benchmark

100110 default-extensions: ScopedTypeVariables

101111 ghc-options: -threaded

102112

103− build-depends: vty >= 5.2.11,

113+ build-depends: vty >= 5.15,

104114 base >= 4 && < 5,

105115 bytestring,

106116 Cabal,

tools/BuildWidthTable.hsnew file+144

@@ -0,0 +1,144 @@

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

view-benchmark-coredeleted−4

@@ -1,4 +0,0 @@

1−#!/bin/sh

2−ghc-core --no-asm --no-cast -- \

3− -hide-package vty-5.0.0 -i../src -XScopedTypeVariables ../dist/build/cbits/*.o \

4− benchmark

vty.cabal+107−113

@@ -1,10 +1,10 @@

11name: vty

2−version: 5.14

2+version: 5.35.1

33license: BSD3

44license-file: LICENSE

55author: AUTHORS

66maintainer: Jonathan Daugherty (cygnus@foobox.com)

7−homepage: https://github.com/coreyoconnor/vty

7+homepage: https://github.com/jtdaugherty/vty

88category: User Interfaces

99synopsis: A simple terminal UI library

1010description:

@@ -12,55 +12,42 @@ description:

1212 be easy to use, have no confusing corner cases, and good support for

1313 common terminal types.

1414 .

15− Included in the source distribution is a program

16− test/interactive_terminal_test.hs that demonstrates the various

17− features.

15+ See the @vty-examples@ package as well as the program

16+ @test/interactive_terminal_test.hs@ included in the @vty@ package for

17+ examples on how to use the library.

1818 .

19− Developers: See the "Graphics.Vty" module.

20− .

21− Users: See the "Graphics.Vty.Config" module.

22− .

23− If your terminal is not behaving as expected the results of the

24− vty-interactive-terminal-test executable should be sent to the Vty

25− maintainter to aid in debugging the issue.

26− .

27− Notable infelicities: Assumes UTF-8 character encoding support by the

28− terminal; Poor signal handling; Requires terminfo.

29− .

30− This project is hosted on github.com: <https://github.com/coreyoconnor/vty>

31− .

32− > git clone git://github.com/coreyoconnor/vty.git

19+ Import the "Graphics.Vty" convenience module to get access to the core

20+ parts of the library.

3321 .

3523 .

37−cabal-version: >= 1.18

25+ .

27+cabal-version: 1.18

3828build-type: Simple

39−data-files: README.md,

40− TODO,

29+extra-doc-files: README.md,

4130 AUTHORS,

42− CHANGELOG,

31+ CHANGELOG.md,

4332 LICENSE

44−tested-with: GHC >= 7.6.2

33+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.5

4534

4635source-repository head

4736 type: git

48− location: https://github.com/coreyoconnor/vty.git

37+ location: https://github.com/jtdaugherty/vty.git

4938

5039library

5140 default-language: Haskell2010

52− build-depends: base >= 4 && < 5,

41+ build-depends: base >= 4.8 && < 5,

5342 blaze-builder >= 0.3.3.2 && < 0.5,

5443 bytestring,

5544 containers,

56− data-default >= 0.5.3,

5745 deepseq >= 1.1 && < 1.5,

5846 directory,

5947 filepath >= 1.0 && < 2.0,

60− microlens,

48+ microlens < 0.4.13,

6149 microlens-mtl,

6250 microlens-th,

63− -- required for nice installation with yi

6451 hashable >= 1.2,

6552 mtl >= 1.1.1.0 && < 2.3,

6653 parallel >= 2.2 && < 3.3,

@@ -71,10 +58,18 @@ library

7158 text >= 0.11.3,

7259 unix,

7360 utf8-string >= 0.3 && < 1.1,

74− vector >= 0.7

61+ vector >= 0.7,

62+ binary,

63+ ansi-terminal >= 0.10.3

64+

65+ if !impl(ghc >= 8.0)

66+ build-depends: semigroups >= 0.16,

67+ fail

7568

7669 exposed-modules: Graphics.Vty

7770 Graphics.Vty.Attributes

71+ Graphics.Vty.Attributes.Color

72+ Graphics.Vty.Attributes.Color240

7873 Graphics.Vty.Config

7974 Graphics.Vty.Error

8075 Graphics.Vty.Image

@@ -83,10 +78,8 @@ library

8378 Graphics.Vty.Input

8479 Graphics.Vty.Input.Events

8580 Graphics.Vty.Picture

86− Graphics.Vty.Prelude

8781 Graphics.Vty.Output

8882 Graphics.Text.Width

89− -- the modules below are only meant to be used by the tests.

9083 Codec.Binary.UTF8.Debug

9184 Data.Terminfo.Parse

9285 Data.Terminfo.Eval

@@ -98,6 +91,7 @@ library

9891 Graphics.Vty.Input.Classify.Parse

9992 Graphics.Vty.Input.Loop

10093 Graphics.Vty.Input.Mouse

94+ Graphics.Vty.Input.Focus

10195 Graphics.Vty.Input.Paste

10296 Graphics.Vty.Input.Terminfo

10397 Graphics.Vty.PictureToSpans

@@ -106,82 +100,72 @@ library

106100 Graphics.Vty.Output.Interface

107101 Graphics.Vty.Output.XTermColor

108102 Graphics.Vty.Output.TerminfoBased

103+ Graphics.Vty.UnicodeWidthTable.Types

104+ Graphics.Vty.UnicodeWidthTable.IO

105+ Graphics.Vty.UnicodeWidthTable.Query

106+ Graphics.Vty.UnicodeWidthTable.Install

109107

110− other-modules: Graphics.Vty.Attributes.Color

111− Graphics.Vty.Attributes.Color240

112− Graphics.Vty.Debug.Image

108+ other-modules: Graphics.Vty.Debug.Image

113109 Graphics.Vty.Input.Terminfo.ANSIVT

114110

115111 c-sources: cbits/gwinsz.c

116112 cbits/set_term_timing.c

113+ cbits/get_tty_erase.c

117114 cbits/mk_wcwidth.c

118115

119116 include-dirs: cbits

120117

121118 hs-source-dirs: src

122119

123− default-extensions: ScopedTypeVariables

124− ForeignFunctionInterface

125−

126120 ghc-options: -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10

127121

128122 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10

129123

130− cc-options: -O2

124+executable vty-build-width-table

125+ main-is: BuildWidthTable.hs

126+ hs-source-dirs: tools

127+

128+ default-language: Haskell2010

129+ ghc-options: -threaded -Wall

130+

131+ if !impl(ghc >= 8.0)

132+ build-depends: semigroups >= 0.16

133+

134+ build-depends: vty,

135+ directory,

136+ filepath,

137+ base >= 4.8 && < 5

131138

132139executable vty-mode-demo

133140 main-is: ModeDemo.hs

141+ hs-source-dirs: demos

134142

135143 default-language: Haskell2010

136− default-extensions: ScopedTypeVariables

137144 ghc-options: -threaded

138145

139146 build-depends: vty,

140− base >= 4 && < 5,

147+ base >= 4.8 && < 5,

141148 containers,

142− data-default >= 0.5.3,

143149 microlens,

144150 microlens-mtl,

145151 mtl >= 1.1.1.0 && < 2.3

146152

147153executable vty-demo

148154 main-is: Demo.hs

155+ hs-source-dirs: demos

149156

150157 default-language: Haskell2010

151− default-extensions: ScopedTypeVariables

152158 ghc-options: -threaded

153159

154160 build-depends: vty,

155− base >= 4 && < 5,

161+ base >= 4.8 && < 5,

156162 containers,

157− data-default >= 0.5.3,

158163 microlens,

159164 microlens-mtl,

160165 mtl >= 1.1.1.0 && < 2.3

161166

162−test-suite verify-attribute-ops

163− default-language: Haskell2010

164− default-extensions: ScopedTypeVariables

165− type: detailed-0.9

166− hs-source-dirs: test

167− test-module: VerifyAttributeOps

168− build-depends: vty,

169− Cabal >= 1.20,

170− QuickCheck >= 2.7,

171− random >= 1.0 && < 1.2,

172− base >= 4 && < 5,

173− bytestring,

174− containers,

175− deepseq >= 1.1 && < 1.5,

176− mtl >= 1.1.1.0 && < 2.3,

177− text >= 0.11.3,

178− unix,

179− utf8-string >= 0.3 && < 1.1,

180− vector >= 0.7

181−

182167test-suite verify-using-mock-terminal

183168 default-language: Haskell2010

184− default-extensions: ScopedTypeVariables

185169

186170 type: detailed-0.9

187171

@@ -200,8 +184,8 @@ test-suite verify-using-mock-terminal

200184 build-depends: vty,

201185 Cabal >= 1.20,

202186 QuickCheck >= 2.7,

203− random >= 1.0 && < 1.2,

204− base >= 4 && < 5,

187+ random >= 1.0 && < 1.3,

188+ base >= 4.8 && < 5,

205189 bytestring,

206190 containers,

207191 deepseq >= 1.1 && < 1.5,

@@ -214,7 +198,6 @@ test-suite verify-using-mock-terminal

214198

215199test-suite verify-terminal

216200 default-language: Haskell2010

217− default-extensions: ScopedTypeVariables

218201

219202 type: detailed-0.9

220203

@@ -233,11 +216,10 @@ test-suite verify-terminal

233216 build-depends: vty,

234217 Cabal >= 1.20,

235218 QuickCheck >= 2.7,

236− random >= 1.0 && < 1.2,

237− base >= 4 && < 5,

219+ random >= 1.0 && < 1.3,

220+ base >= 4.8 && < 5,

238221 bytestring,

239222 containers,

240− data-default >= 0.5.3,

241223 deepseq >= 1.1 && < 1.5,

242224 mtl >= 1.1.1.0 && < 2.3,

243225 terminfo >= 0.3 && < 0.5,

@@ -248,7 +230,6 @@ test-suite verify-terminal

248230

249231test-suite verify-display-attributes

250232 default-language: Haskell2010

251− default-extensions: ScopedTypeVariables

252233

253234 type: detailed-0.9

254235

@@ -267,8 +248,8 @@ test-suite verify-display-attributes

267248 build-depends: vty,

268249 Cabal >= 1.20,

269250 QuickCheck >= 2.7,

270− random >= 1.0 && < 1.2,

271− base >= 4 && < 5,

251+ random >= 1.0 && < 1.3,

252+ base >= 4.8 && < 5,

272253 bytestring,

273254 containers,

274255 deepseq >= 1.1 && < 1.5,

@@ -280,7 +261,6 @@ test-suite verify-display-attributes

280261

281262test-suite verify-empty-image-props

282263 default-language: Haskell2010

283− default-extensions: ScopedTypeVariables

284264

285265 type: detailed-0.9

286266

@@ -293,8 +273,8 @@ test-suite verify-empty-image-props

293273 build-depends: vty,

294274 Cabal >= 1.20,

295275 QuickCheck >= 2.7,

296− random >= 1.0 && < 1.2,

297− base >= 4 && < 5,

276+ random >= 1.0 && < 1.3,

277+ base >= 4.8 && < 5,

298278 bytestring,

299279 containers,

300280 deepseq >= 1.1 && < 1.5,

@@ -306,7 +286,6 @@ test-suite verify-empty-image-props

306286

307287test-suite verify-eval-terminfo-caps

308288 default-language: Haskell2010

309− default-extensions: ScopedTypeVariables

310289

311290 type: detailed-0.9

312291

@@ -320,8 +299,8 @@ test-suite verify-eval-terminfo-caps

320299 build-depends: vty,

321300 Cabal >= 1.20,

322301 QuickCheck >= 2.7,

323− random >= 1.0 && < 1.2,

324− base >= 4 && < 5,

302+ random >= 1.0 && < 1.3,

303+ base >= 4.8 && < 5,

325304 blaze-builder >= 0.3.3.2 && < 0.5,

326305 bytestring,

327306 containers,

@@ -335,7 +314,6 @@ test-suite verify-eval-terminfo-caps

335314

336315test-suite verify-image-ops

337316 default-language: Haskell2010

338− default-extensions: ScopedTypeVariables

339317

340318 type: detailed-0.9

341319

@@ -350,8 +328,8 @@ test-suite verify-image-ops

350328 build-depends: vty,

351329 Cabal >= 1.20,

352330 QuickCheck >= 2.7,

353− random >= 1.0 && < 1.2,

354− base >= 4 && < 5,

331+ random >= 1.0 && < 1.3,

332+ base >= 4.8 && < 5,

355333 bytestring,

356334 containers,

357335 deepseq >= 1.1 && < 1.5,

@@ -363,7 +341,6 @@ test-suite verify-image-ops

363341

364342test-suite verify-image-trans

365343 default-language: Haskell2010

366− default-extensions: ScopedTypeVariables

367344

368345 type: detailed-0.9

369346

@@ -378,8 +355,8 @@ test-suite verify-image-trans

378355 build-depends: vty,

379356 Cabal >= 1.20,

380357 QuickCheck >= 2.7,

381− random >= 1.0 && < 1.2,

382− base >= 4 && < 5,

358+ random >= 1.0 && < 1.3,

359+ base >= 4.8 && < 5,

383360 bytestring,

384361 containers,

385362 deepseq >= 1.1 && < 1.5,

@@ -391,7 +368,6 @@ test-suite verify-image-trans

391368

392369test-suite verify-inline

393370 default-language: Haskell2010

394− default-extensions: ScopedTypeVariables

395371

396372 type: detailed-0.9

397373

@@ -405,8 +381,8 @@ test-suite verify-inline

405381 build-depends: vty,

406382 Cabal >= 1.20,

407383 QuickCheck >= 2.7,

408− random >= 1.0 && < 1.2,

409− base >= 4 && < 5,

384+ random >= 1.0 && < 1.3,

385+ base >= 4.8 && < 5,

410386 bytestring,

411387 containers,

412388 deepseq >= 1.1 && < 1.5,

@@ -418,7 +394,6 @@ test-suite verify-inline

418394

419395test-suite verify-parse-terminfo-caps

420396 default-language: Haskell2010

421− default-extensions: ScopedTypeVariables

422397

423398 type: detailed-0.9

424399

@@ -433,8 +408,8 @@ test-suite verify-parse-terminfo-caps

433408 build-depends: vty,

434409 Cabal >= 1.20,

435410 QuickCheck >= 2.7,

436− random >= 1.0 && < 1.2,

437− base >= 4 && < 5,

411+ random >= 1.0 && < 1.3,

412+ base >= 4.8 && < 5,

438413 bytestring,

439414 containers,

440415 deepseq >= 1.1 && < 1.5,

@@ -447,7 +422,6 @@ test-suite verify-parse-terminfo-caps

447422

448423test-suite verify-simple-span-generation

449424 default-language: Haskell2010

450− default-extensions: ScopedTypeVariables

451425

452426 type: detailed-0.9

453427

@@ -465,8 +439,8 @@ test-suite verify-simple-span-generation

465439 build-depends: vty,

466440 Cabal >= 1.20,

467441 QuickCheck >= 2.7,

468− random >= 1.0 && < 1.2,

469− base >= 4 && < 5,

442+ random >= 1.0 && < 1.3,

443+ base >= 4.8 && < 5,

470444 bytestring,

471445 containers,

472446 deepseq >= 1.1 && < 1.5,

@@ -479,7 +453,6 @@ test-suite verify-simple-span-generation

479453

480454test-suite verify-crop-span-generation

481455 default-language: Haskell2010

482− default-extensions: ScopedTypeVariables

483456

484457 type: detailed-0.9

485458

@@ -497,8 +470,8 @@ test-suite verify-crop-span-generation

497470 build-depends: vty,

498471 Cabal >= 1.20,

499472 QuickCheck >= 2.7,

500− random >= 1.0 && < 1.2,

501− base >= 4 && < 5,

473+ random >= 1.0 && < 1.3,

474+ base >= 4.8 && < 5,

502475 bytestring,

503476 containers,

504477 deepseq >= 1.1 && < 1.5,

@@ -511,7 +484,6 @@ test-suite verify-crop-span-generation

511484

512485test-suite verify-layers-span-generation

513486 default-language: Haskell2010

514− default-extensions: ScopedTypeVariables

515487

516488 type: detailed-0.9

517489

@@ -529,8 +501,33 @@ test-suite verify-layers-span-generation

529501 build-depends: vty,

530502 Cabal >= 1.20,

531503 QuickCheck >= 2.7,

532− random >= 1.0 && < 1.2,

533− base >= 4 && < 5,

504+ random >= 1.0 && < 1.3,

505+ base >= 4.8 && < 5,

506+ bytestring,

507+ containers,

508+ deepseq >= 1.1 && < 1.5,

509+ mtl >= 1.1.1.0 && < 2.3,

510+ text >= 0.11.3,

511+ unix,

512+ utf8-string >= 0.3 && < 1.1,

513+ vector >= 0.7

514+

515+test-suite verify-color-mapping

516+ default-language: Haskell2010

517+

518+ type: detailed-0.9

519+

520+ hs-source-dirs: test

521+

522+ test-module: VerifyColor240

523+

524+ other-modules: Verify

525+

526+ build-depends: vty,

527+ Cabal >= 1.20,

528+ QuickCheck >= 2.7,

529+ random >= 1.0 && < 1.3,

530+ base >= 4.8 && < 5,

534531 bytestring,

535532 containers,

536533 deepseq >= 1.1 && < 1.5,

@@ -542,7 +539,6 @@ test-suite verify-layers-span-generation

542539

543540test-suite verify-utf8-width

544541 default-language: Haskell2010

545− default-extensions: ScopedTypeVariables

546542

547543 type: detailed-0.9

548544

@@ -555,8 +551,8 @@ test-suite verify-utf8-width

555551 build-depends: vty,

556552 Cabal >= 1.20,

557553 QuickCheck >= 2.7,

558− random >= 1.0 && < 1.2,

559− base >= 4 && < 5,

554+ random >= 1.0 && < 1.3,

555+ base >= 4.8 && < 5,

560556 bytestring,

561557 containers,

562558 deepseq >= 1.1 && < 1.5,

@@ -568,7 +564,6 @@ test-suite verify-utf8-width

568564

569565test-suite verify-using-mock-input

570566 default-language: Haskell2010

571− default-extensions: ScopedTypeVariables

572567

573568 type: exitcode-stdio-1.0

574569

@@ -576,16 +571,17 @@ test-suite verify-using-mock-input

576571

577572 main-is: VerifyUsingMockInput.hs

578573

574+ other-modules: Verify.Graphics.Vty.Output

575+

579576 build-depends: vty,

580577 Cabal >= 1.20,

581− data-default >= 0.5.3,

582578 QuickCheck >= 2.7,

583579 smallcheck == 1.*,

584580 quickcheck-assertions >= 0.1.1,

585581 test-framework == 0.8.*,

586582 test-framework-smallcheck == 0.2.*,

587− random >= 1.0 && < 1.2,

588− base >= 4 && < 5,

583+ random >= 1.0 && < 1.3,

584+ base >= 4.8 && < 5,

589585 bytestring,

590586 containers,

591587 deepseq >= 1.1 && < 1.5,

@@ -603,7 +599,6 @@ test-suite verify-using-mock-input

603599

604600test-suite verify-config

605601 default-language: Haskell2010

606− default-extensions: ScopedTypeVariables

607602

608603 type: exitcode-stdio-1.0

609604

@@ -613,7 +608,6 @@ test-suite verify-config

613608

614609 build-depends: vty,

615610 Cabal >= 1.20,

616− data-default >= 0.5.3,

617611 HUnit,

618612 QuickCheck >= 2.7,

619613 smallcheck == 1.*,

@@ -621,8 +615,8 @@ test-suite verify-config

621615 test-framework == 0.8.*,

622616 test-framework-smallcheck == 0.2.*,

623617 test-framework-hunit,

624− random >= 1.0 && < 1.2,

625− base >= 4 && < 5,

618+ random >= 1.0 && < 1.3,

619+ base >= 4.8 && < 5,

626620 bytestring,

627621 containers,

628622 deepseq >= 1.1 && < 1.5,