master..8629774 · vty · git.iko.soy

.gitignore−4

@@ -4,12 +4,8 @@

44*.prof

55Setup

66dist

7−dist-newstyle

8−cabal.project.local

9−.ghc.environment.*

107test/benchmark

118.hpc

129.cabal-sandbox

1310cabal.sandbox.config

1411test/cabal.sandbox.config

15−.stack-work

.travis.yml+21−101

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

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

2−#

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

4−#

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

6−#

7−language: c

8−sudo: false

1+language: haskell

92

10−git:

11− submodules: false # whether to recursively clone submodules

12−

13−cache:

14− directories:

15− - $HOME/.cabal/packages

16− - $HOME/.cabal/store

17−

18−before_cache:

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

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

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

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

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

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

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

26−

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

3+notifications:

4+ email: false

285

296matrix:

30− include:

31− - compiler: "ghc-8.4.3"

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

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

34− - compiler: "ghc-8.2.2"

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

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

37− - compiler: "ghc-8.0.2"

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

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

40− - compiler: "ghc-7.10.3"

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

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

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

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

5318

5419install:

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)

20+ - ./ci/travis_ci_install

8021

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.

8322script:

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

23+ - ./ci/travis_ci_script

9624

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

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

AUTHORS+2−4

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

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

2−library:

3−

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

42 * Andrea Vezzosi

53 * Corey O'Connor

64 * Emily Backes

@@ -19,4 +17,4 @@ library:

1917 * Yoshikuni Jujo

2018 * Dmitry Ivanov

2119

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

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

CHANGELOGnew file+332

@@ -0,0 +1,332 @@

1+5.11

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

3+ evironment variable is missing (thanks Eric Mertens)

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

5+ exporting internal types (thanks Eric Mertens)

6+

7+5.10

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

9+ mode provides greater control over cursor positioning by bypassing

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

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

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

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

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

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

16+ Mertens)

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

18+ behavior. Previously vty_mk_wcwidth was being imported with

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

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

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

22+ non-negative. (thanks Eric Mertens)

23+

24+5.9.1

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

26+ preexisting UTF8 declaration to avoid emitting garbage sequences

27+ (fixes #89)

28+

29+5.9

30+ - Added new Output methods supportsBell and ringTerminalBell to find out

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

32+

33+5.8.1

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

35+

36+5.8

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

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

39+ how best to decode it

40+

41+5.7.1

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

43+

44+5.7

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

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

47+ determine whether these modes are enabled initially (for terminals

48+ that support them).

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

50+ paste mode) that is used with new Output interface functions:

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

52+ mode

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

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

55+ off

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

57+

58+5.6

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

60+ terminals via the MouseDown and MouseUp Event constructors

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

62+ the EvPaste event constructor

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

64+ Hirn)

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

66+ XtermColor driver rather than just TerminfoBased

67+

68+5.5.0

69+ - Replaced lens dependency with microlens, microlens-mtl, microlens-th dependencies. Issue #90

70+ - Thanks Jonathan Daugherty

71+ - Cabal corrections.

72+ - Thanks Lennart Spitzner

73+

74+5.4.0

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

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

77+ eventChannel directly will require updating.

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

79+5.3.1

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

81+ to possibly breaking this on reasonable GHC versions

82+

83+5.3

84+ - Upgraded QuickCheck dependency to 2.7

85+ - The standard IO Config (standardIOConfig) was overriding any provided application config.

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

87+ Fixed.

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

89+ at the end of content for the line and at the start of a new line. Previously the current

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

91+ cause of https://github.com/coreyoconnor/vty/issues/76

92+ IIRC Yi requires the old behavior to display the selection region correctly.

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

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

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

96+ the uninterruptable read. An alternative would be to re-import the read foreign call as

97+ interruptable.

98+

99+5.2.11

100+ - deepseq bounds increased for tests.

101+ - Clean up warnings when compiling on 7.10

102+ - Thanks Eric Mertens

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

104+ - Thanks Eric Mertens

105+

106+5.2.10

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

108+ - Thanks Jonathan Daugherty

109+

110+5.2.9

111+ - dependency version bumps

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

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

114+ - Correct/Simplify the example code

115+ - Thanks glguy

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

117+

118+5.2.8

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

120+ - Thanks glguy

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

122+ - Do not differentiate based on TERM_PROGRAM

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

124+

125+5.2.7

126+ - lens and deepseq constraint bump + misc

127+ - Thanks ethercrow

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

129+

130+5.2.6

131+ - lens constraint bump

132+ - Thanks alexander-b!

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

134+

135+5.2.5

136+ - lens and random version constraint bump.

137+ - Thanks RyanGlScott!

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

139+

140+5.2.4

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

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

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

144+ - Thanks Fuuzetsu!

145+

146+5.2.3

147+ - evaluate/compile the input parsing table once instead of each keystroke.

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

149+ - Thanks ethercrow!

150+

151+5.2.2

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

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

154+ - Thanks ethercrow!

155+

156+5.2.1

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

158+

159+5.2.0

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

161+ file descriptors. Previously Vty used stdInput for input and the follow code for output:

162+ - hDuplicate stdout >>= handleToFd >>= (`hSetBuffering` NoBuffering)

163+ - the difference was required by Vty.Inline. Now, Vty.Inline uses the Config structure options

164+ to acheive the same effect.

165+ - removed: derivedVtime, derivedVmin, inputForCurrentTerminal, inputForNameAndIO,

166+ outputForCurrentTerminal, outputForNameAndIO

167+ - added: inputForConfig, outputForConfig

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

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

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

171+

172+5.1.4

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

174+

175+5.1.1

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

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

178+

179+5.1.0

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

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

182+

183+5.0.0

184+ - The naming convention now matches:

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

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

187+ this is not acceptable.

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

189+ configuration.

190+ - input handling changes

191+ - KASCII is now KChar

192+ - KPN5 is now KCenter

193+ - tests exist.

194+ - Applications can add to the input tables by setting inputMap of the Config.

195+ See Graphics.Vty.Config

196+ - Users can define input table extensions that will apply to all vty applications.

197+ See Graphics.Vty.Config

198+ - terminal timing is now handled by selecting an appropriate VTIME. Previously this was

199+ implemented within Vty itself. This reduced complexity in vty but provides a different meta

200+ key behavior and implies a requirement on -threaded.

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

202+ singleEscPeriod of the Input Config structure.

203+ - removed the typeclass based terminal and display context interface in favor of a data

204+ structure of properties interface.

205+ - renamed the Terminal interface to Output

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

207+ background spans with spaces or just ends the line.

208+ - Previously the background defaulted to the space character. This causes issues copying

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

210+ - Layer support

211+ - Each layer is an image.

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

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

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

215+ added to pad images when images of different sizes are joined.

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

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

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

219+ - addToTop and addToBottom add a layer to the top and bottom of the given Picture.

220+ - compatibility improvements:

221+ - terminfo based terminals with no cursor support are silently accepted. The cursor

222+ visibility changes in the Picture will have no effect.

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

224+ guess.

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

226+ - Both applications and users can add to the mapping used to translate from input bytes to

227+ events.

228+ - Additional information about input and output process can be appended to a debug log

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

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

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

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

233+ - vty-interactive-terminal-test

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

235+ - test/interactive_terminal_test.hs

236+ - vty-event-echo

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

238+ - test/EventEcho.hs

239+ - vty-rogue

240+ - The start of a rogue-like game. Example of layers and image build operations.

241+ - test/Rogue.hs

242+ - vty-benchmark

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

244+ random pictures are generated using QuickCheck. The same generators used in the

245+ automated tests.

246+ - test/benchmark.hs

247+

248+4.7.0.0

249+ - API changes:

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

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

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

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

254+

255+4.3.0.0

256+

257+4.2.1.0

258+ - API changes:

259+ - Attr record accessor fore_color changed to attr_fore_color

260+ - Attr record accessor back_color changed to attr_back_color

261+ - Attr record accessor style changed to attr_style

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

263+ - put_attr_change applies a display attribute change immediately to a terminal

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

265+ and putStr. EX: "put_attr_change $ back_color red" will set the

266+ background color to red.

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

268+ - See Graphics.Vty.Inline

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

270+

271+4.0.0.1

272+ - binding for mk_wcswidth was incorrect. Most platforms just magically worked due to

273+ coincidence.

274+

275+4.0.0

276+ - API changes:

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

278+ instance of the Vty data structure.

279+ - added a "terminal" field to the Vty data structure. Accesses the TerminalHandle associated

280+ with the Vty instance.

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

282+ - Partitioned into Graphics.Vty.Attributes for display attributes. Graphics.Vty.Image for

283+ image combinators. Graphics.Vty.Picture for final picture construction.

284+ - Graphics.Vty.Attributes:

285+ - "setFG" and "setBG" are now "with_fore_color" and "with_back_color"

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

287+ - "attr" is now "def_attr", short for "default display attributes" Also added a

288+ "current_attr" for "currently applied display attributes"

289+ - Graphics.Vty.Image:

290+ - "horzcat" is now "horiz_cat"

291+ - "vertcat" is now "vert_cat"

292+ - "renderBS" is now "utf8_bytestring"

293+ - "renderChar" is now "char"

294+ - "renderFill" is now "char_fill"

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

296+ and ISO-10464 encoded Strings. String literals in GHC have an ISO-10464 runtime

297+ representation.

298+ - Graphics.Vty.Picture:

299+ - exports Graphics.Vty.Image

300+ - "pic" is now "pic_for_image"

301+ - added API for setting background fill pattern.

302+ - Completely rewritten output backend.

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

304+ enough.

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

306+ - Terminfo based display terminal implementation. With specialized derivitives for xterm,

307+ Terminal.app, and iTerm.app.

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

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

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

311+ as successfull.

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

313+ - 256 color support. See Graphics.Vty.Attributes.Color240. The actual output color is adjusted

314+ according to the number of colors the terminal supports.

315+ - The Graphics.Vty.Image combinators no longer require matching dimensions to arguments.

316+ Unspecified areas are filled in with a user-customizable background pattern. See

317+ Graphics.Vty.Picture.

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

319+ - Significant code coverage by QuickCheck tests. An interactive test for those final properties

320+ that couldn't be automatically verified.

321+

322+ issues resolved:

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

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

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

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

327+ - "Redraw does not handle rendering a line that extends beyond screen width characters"

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

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

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

331+ - "256-color support"

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

CHANGELOG.mddeleted−861

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

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

docs/DESIGN → DESIGNrenamed

The content is the same.

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

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

11{-# LANGUAGE FlexibleContexts #-}

2+

23module Main where

34

45import Graphics.Vty

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

78import Control.Arrow

89import Control.Monad.RWS

910

11+import Data.Default (def)

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

1113import qualified Data.Sequence as Seq

1214import Data.Foldable

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

1719

1820main = do

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

20− then mkVty defaultConfig

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

22+ then mkVty def

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

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

2325 shutdown vty

2426

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

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

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

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

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

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

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

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

3738 , "claims 240 colors are not supported."

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

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

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

4445 ]

4546

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−

5547colorbox_240 :: Image

5648colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages

5749 where

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

51+ splitColorImages [] = []

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

5953

6054colorbox_16 :: Image

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

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

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

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

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

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

8276 vty <- ask

8377 liftIO $ update vty pic

8478

LICENSE−2

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

1−BSD 3-Clause License

2−

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

42

53All rights reserved.

demos/ModeDemo.hs → ModeDemo.hsrenamed−2

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

22

33import Control.Applicative

44import Data.Monoid

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

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

75

86import Graphics.Vty

97

README.md+73−146

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

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

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

22

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.

3+`vty` is a terminal interface library.

4+

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

66

77Install via `git` with:

88

99```

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

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

1111```

1212

1313Install via `cabal` with:

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

1818

1919# Features

2020

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

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

21+* 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.

2325

24−* Automatically handles window resizes.

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

2527

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

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

2729

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

29− state changes are minimized.

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

3031

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

32− problems that plague ncurses programs.

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

33+ plagues ncurses programs.

3334

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

35− display images.

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

3636

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

3838

3939* Automatically supports refresh on Ctrl-L.

4040

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

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

4242 customizable.

4343

44−* Provides extensible input and output interfaces.

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.

4560

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.

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

62+ unicode is used.

4963

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

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.

5167

52−* Provides a comprehensive test suite.

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

69+ limited to Linux and BSD.

5370

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

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

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

5774* Supports bracketed paste mode as described at

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

5976

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−

7177# Platform Support

7278

7379## Posix Terminals

7480

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

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

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

82+some omissions from terminfo.

7783

7884## Windows

7985

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

86+cygwin only.

12487

125−```

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

127−```

88+# Development Notes

12889

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.

90+## Under NixOS

17291

173−# Known Issues

92+### Using cabal

17493

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.

94+After installing ncurses to user env.

17895

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

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

180101

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

182− unicode is used.

102+### Using stack

103+

104+~~~

105+stack build

106+stack test

107+stack install

108+~~~

109+

110+## Coverage

183111

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.

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

113+evaluate coverage configure as follows:

188114

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

190− appears to be limited to Linux and BSD.

115+~~~

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

117+ --disable-library-profiling \

118+ --disable-executable-profiling

119+~~~

191120

192−# Further Reading

121+## Profiling

193122

194−Good sources of documentation for terminal programming are:

195123

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

124+~~~

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

126+ --enable-library-profiling \

127+ --enable-executable-profiling

128+~~~

TODOnew file+15

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

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_examplesnew file+2

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

1+#!/bin/bash

2+(cd test && cabal build)

cbits/get_tty_erase.cdeleted−18

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

1−#include <termios.h>

2−#include <stdio.h>

3−#include <unistd.h>

4−#include <stdlib.h>

5−

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

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

8−// zero.

9−char vty_get_tty_erase(int fd)

10−{

11− struct termios trm;

12−

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

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

15− } else {

16− return (char) 0;

17− }

18−}

cbits/gwinsz.c+5−14

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

11#include <sys/ioctl.h>

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;

9−}

10−

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

12− struct winsize w;

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

14− w.ws_row = val >> 16;

15− w.ws_col = val & 0xFFFF;

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

17− }

4+ struct winsize w;

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

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

7+ else

8+ return 0x190050;

189}

cbits/gwinsz.h+1−2

@@ -1,2 +1 @@

1−unsigned long vty_c_get_window_size(int fd);

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

1+unsigned long vty_c_get_window_size(void);

cbits/mk_wcwidth.c+2−136

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

6060 */

6161

6262#include <HsFFI.h>

63−#include <stdlib.h>

64−#include <string.h>

65−

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

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

68−#define MAX_CUSTOM_TABLE_SIZE (HS_CHAR_MAX + 1)

69−

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

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

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

73−static uint8_t* custom_table = NULL;

74−

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

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

77−// custom_table array.

78−static uint32_t custom_table_size = 0;

79−

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

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

82−// allocated with vty_init_custom_table and initialized with

83−// vty_set_custom_table_range.

84−static uint8_t custom_table_ready = 0;

8563

8664struct interval {

8765 int first;

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

141119 * in ISO 10646.

142120 */

143121

144−static HsInt builtin_wcwidth(HsChar ucs)

122+HsInt vty_mk_wcwidth(HsChar ucs)

145123{

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

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

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

204182

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

206184 if (vty_bisearch(ucs, combining,

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

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

208186 return 0;

209187

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

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

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

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

226204}

227−

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

229−//

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

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

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

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

234−HsInt vty_mk_wcwidth(HsChar ch)

235−{

236− if (custom_table_ready) {

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

238− return custom_table[ch];

239− } else {

240− return -1;

241− }

242− } else {

243− return builtin_wcwidth(ch);

244− }

245−}

246−

247−// Initialize a custom character width table.

248−//

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

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

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

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

253−//

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

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

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

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

258−int vty_init_custom_table(int size)

259−{

260− if (custom_table == NULL) {

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

262− custom_table_ready = 0;

263− custom_table = malloc(size);

264− memset(custom_table, 1, size);

265− custom_table_size = size;

266− return 0;

267− } else {

268− return 1;

269− }

270− } else {

271− return 1;

272− }

273−}

274−

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

276−// specified width.

277−//

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

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

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

281−//

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

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

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

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

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

287−{

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

289− (size >= custom_table_size) ||

290− (start >= custom_table_size) ||

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

292− custom_table_ready) {

293− return 1;

294− } else {

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

296− return 0;

297− }

298−}

299−

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

301−//

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

303−// fail.

304−//

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

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

307−// allocated.

308−int vty_activate_custom_table()

309−{

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

311− return 1;

312− } else {

313− custom_table_ready = 1;

314− return 0;

315− }

316−}

317−

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

319−int vty_custom_table_ready()

320−{

321− return custom_table_ready;

322−}

323−

324−// Deallocate the custom width table.

325−//

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

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

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

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

330−// leaving it in an intermediate state.

331−void vty_deallocate_custom_table()

332−{

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

334− free(custom_table);

335− custom_table = NULL;

336− custom_table_size = 0;

337− }

338−}

install_examplesnew file+4

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

1+#!/bin/bash

2+set -ex

3+cabal install

4+(cd test && cabal install)

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

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

11{-# OPTIONS_HADDOCK hide #-}

3−module Codec.Binary.UTF8.Debug where

3+module Codec.Binary.UTF8.Debug

4+ where

45

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

67

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

89

910import Numeric

1011

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

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

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

13+-- corresponding UTF8 byte sequence

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

1415utf8FromIso = encode . map toEnum

1516

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

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

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

19+

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 = rnf' . viewl

11− where

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

11+ where

1212 rnf' EmptyL = ()

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

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

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

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE BangPatterns #-}

23{-# LANGUAGE NoMonomorphismRestriction #-}

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

45{-# OPTIONS_HADDOCK hide #-}

56

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

7−-- given parameters.

8−module Data.Terminfo.Eval

9− ( writeCapExpr

10− )

11−where

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

1216

1317import Blaze.ByteString.Builder.Word

1418import Blaze.ByteString.Builder

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

2327

2428import qualified Data.Vector.Unboxed as Vector

2529

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

31+import Data.Word

32+#endif

33+

2634-- | capability evaluator state

2735data EvalState = EvalState

2836 { evalStack :: ![CapParam]

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

4250

4351readParam :: Word -> Eval CapParam

4452readParam pn = do

45− !params <- evalParams <$> get

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

4654 return $! genericIndex params pn

4755

4856push :: CapParam -> Eval ()

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

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

6573

6674writeCapOps :: CapOps -> Eval ()

67−writeCapOps = mapM_ writeCapOp

75+writeCapOps ops = mapM_ writeCapOp ops

6876

6977writeCapOp :: CapOp -> Eval ()

7078writeCapOp (Bytes !offset !count) = do

71− !cap <- evalExpression <$> get

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

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

7381 Vector.forM_ bytes $ tell.writeWord8

7482writeCapOp DecOut = do

7583 p <- pop

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

7785writeCapOp CharOut = do

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

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

7987writeCapOp (PushParam pn) = do

8088 readParam pn >>= push

8189writeCapOp (PushValue v) = do

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

8391writeCapOp (Conditional expr parts) = do

8492 writeCapOps expr

8593 writeContitionalParts parts

86− where

94+ where

8795 writeContitionalParts [] = return ()

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

8997 -- (man 5 terminfo)

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.

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.

94101 v <- pop

95102 if v /= 0

96103 then writeCapOps trueOps

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

130137 v1 <- pop

131138 v0 <- pop

132139 push $ if v0 > v1 then 1 else 0

140+

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

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

1−{-# LANGUAGE BangPatterns #-}

21{-# LANGUAGE CPP #-}

2+{-# LANGUAGE BangPatterns #-}

3+{-# OPTIONS_HADDOCK hide #-}

34{-# LANGUAGE NoMonomorphismRestriction #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

5+{-# LANGUAGE NamedFieldPuns #-}

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

6−{-# OPTIONS_HADDOCK hide #-}

77

8−module Data.Terminfo.Parse

9− ( module Data.Terminfo.Parse

10− , Text.Parsec.ParseError

11− )

12−where

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

1316

1417import Control.Monad ( liftM )

1518import Control.DeepSeq

1619

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,6 +24,10 @@ import Numeric (showHex)

2424

2525import Text.Parsec

2626

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

28+import Data.Monoid

29+#endif

30+

2731data CapExpression = CapExpression

2832 { capOps :: !CapOps

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

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

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

4044 where

4145 hexDump :: [Word8] -> String

42− hexDump = foldr showHex ""

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

4347

4448instance NFData CapExpression where

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

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

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

4751

4852type CapParam = Word

4953

5054type CapOps = [CapOp]

51−data CapOp =

55+data CapOp =

5256 Bytes !Int !Int -- offset count

5357 | DecOut | CharOut

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

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

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

59+ -- 1-based

5660 | PushParam !Word | PushValue !Word

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

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

59− | Conditional

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

62+ -- The %e expression may be NOP

63+ | Conditional

6064 { conditionalExpr :: !CapOps

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

6266 }

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

6872instance NFData CapOp where

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

7074 rnf (PushParam pn) = rnf pn

71− rnf (PushValue v) = rnf v

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

75+ rnf (PushValue v) = rnf v

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

7377 rnf BitwiseOr = ()

7478 rnf BitwiseXOr = ()

7579 rnf BitwiseAnd = ()

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

9094 rnf IncFirstTwo = ()

9195

9296parseCapExpression :: String -> Either ParseError CapExpression

93−parseCapExpression capString =

97+parseCapExpression capString =

9498 let v = runParser capExpressionParser

9599 initialBuildState

96− "terminfo cap"

97− capString

100+ "terminfo cap"

101+ capString

98102 in case v of

99103 Left e -> Left e

100104 Right buildResults -> Right $ constructCapExpression capString buildResults

101105

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

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

103107constructCapExpression capString buildResults =

104108 let expr = CapExpression

105109 { capOps = outCapOps buildResults

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

107− -- string's characters.

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.

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

109113 , sourceString = capString

110114 , paramCount = outParamCount buildResults

111115 , paramOps = outParamOps buildResults

112− }

116+ }

113117 in rnf expr `seq` expr

114118

115−type CapParser a = Parsec String BuildState a

119+type CapParser a = Parsec String BuildState a

116120

117121capExpressionParser :: CapParser BuildResults

118122capExpressionParser = do

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

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

120124 return $ mconcat rs

121125

122126paramEscapeParser :: CapParser BuildResults

123127paramEscapeParser = do

124128 _ <- char '%'

125129 incOffset 1

126− literalPercentParser <|> paramOpParser

130+ literalPercentParser <|> paramOpParser

127131

128132literalPercentParser :: CapParser BuildResults

129133literalPercentParser = do

130134 _ <- char '%'

131− startOffset <- nextOffset <$> getState

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

132136 incOffset 1

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

134138

135139paramOpParser :: CapParser BuildResults

136140paramOpParser

137− = incrementOpParser

141+ = incrementOpParser

138142 <|> pushOpParser

139143 <|> decOutParser

140144 <|> charOutParser

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

154158pushOpParser :: CapParser BuildResults

155159pushOpParser = do

156160 _ <- char 'p'

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

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

158162 incOffset 2

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

160164

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

175179 _ <- char '?'

176180 incOffset 1

177181 condPart <- manyExpr conditionalTrueParser

178− parts <- manyP

182+ parts <- manyP

179183 ( do

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

181− , conditionalFalseParser

185+ , conditionalFalseParser

182186 ]

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

184188 , conditionalTrueParser

185189 ]

186190 return ( truePart, falsePart )

187− )

191+ )

188192 conditionalEndParser

189193

190194 let trueParts = map fst parts

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

204208

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

206210

207− where

208− manyP !p !end = choice

211+ where

212+ manyP !p !end = choice

209213 [ try end >> return []

210− , do !v <- p

214+ , do !v <- p

211215 !vs <- manyP p end

212216 return $! v : vs

213217 ]

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

229233 incOffset 2

230234

231235bitwiseOpParser :: CapParser BuildResults

232−bitwiseOpParser

236+bitwiseOpParser

233237 = bitwiseOrParser

234238 <|> bitwiseAndParser

235239 <|> bitwiseXorParser

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

253257 return $ BuildResults 0 [ BitwiseXOr ] [ ]

254258

255259arithOpParser :: CapParser BuildResults

256−arithOpParser

257− = plusOp

258− <|> minusOp

260+arithOpParser

261+ = plusOp

262+ <|> minusOp

259263 where

260264 plusOp = do

261265 _ <- char '+'

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

278282 return $ BuildResults 0 [ PushValue n ] [ ]

279283

280284compareOpParser :: CapParser BuildResults

281−compareOpParser

285+compareOpParser

282286 = compareEqOp

283− <|> compareLtOp

284− <|> compareGtOp

287+ <|> compareLtOp

288+ <|> compareGtOp

285289 where

286290 compareEqOp = do

287291 _ <- char '='

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

299303bytesOpParser :: CapParser BuildResults

300304bytesOpParser = do

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

302− startOffset <- nextOffset <$> getState

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

303307 let !c = length bytes

304308 !s <- getState

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

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

309313charConstParser :: CapParser BuildResults

310314charConstParser = do

311315 _ <- char '\''

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

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

313317 _ <- char '\''

314318 incOffset 3

315319 return $ BuildResults 0 [ PushValue charValue ] [ ]

316320

317−data BuildState = BuildState

321+data BuildState = BuildState

318322 { nextOffset :: Int

319− }

323+ }

320324

321325incOffset :: Int -> CapParser ()

322326incOffset n = do

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

333337 , outParamOps :: !ParamOps

334338 }

335339

336−instance Semigroup BuildResults where

337− v0 <> v1

340+instance Monoid BuildResults where

341+ mempty = BuildResults 0 [] []

342+ v0 `mappend` v1

338343 = BuildResults

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

340− , outCapOps = outCapOps v0 <> outCapOps v1

341− , outParamOps = outParamOps v0 <> outParamOps v1

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

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

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

342347 }

343348

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+16−51

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

22{-# OPTIONS_GHC -D_XOPEN_SOURCE #-}

33{-# LANGUAGE ForeignFunctionInterface #-}

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

5−-- of characters and strings.

6−--

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

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

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

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

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

12−-- @README@.

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

4+module Graphics.Text.Width ( wcwidth

5+ , wcswidth

6+ , safeWcwidth

7+ , safeWcswidth

8+ )

9+ where

2810

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

3012

3113wcswidth :: String -> Int

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

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

34−

35−wctwidth :: T.Text -> Int

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

37−

38−wctlwidth :: TL.Text -> Int

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

14+wcswidth = sum . map wcwidth

4015

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

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.

4522

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

47−-- with unknown widths are 0 width.

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

4824safeWcwidth :: Char -> Int

4925safeWcwidth = max 0 . wcwidth

5026

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

52−-- unknown widths are 0 width.

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

5328safeWcswidth :: String -> Int

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

55−

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

57−-- unknown widths are 0 width.

58−safeWctwidth :: T.Text -> Int

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

60−

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

62−-- with unknown widths are 0 width.

63−safeWctlwidth :: TL.Text -> Int

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

29+safeWcswidth = sum . map safeWcwidth

src/Graphics/Vty.hs+91−173

@@ -1,20 +1,17 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE ScopedTypeVariables #-}

3−

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

5−-- output.

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.

64--

7−-- - Input to the terminal is provided to the Vty application as a

8−-- sequence of 'Event's.

5+-- - The output is defined by a 'Picture'. Which is one or more layers of 'Image's.

96--

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.

7+-- - The module "Graphics.Vty.Image" provides a number of constructor equations that will build

8+-- correct 'Image' values. See 'string', '<|>', and '<->' for starters.

159--

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

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

10+-- - The constructors in "Graphics.Vty.Image.Internal" should not be used.

11+--

12+-- - 'Image's can be styled using 'Attr'. See "Graphics.Vty.Attributes".

13+--

14+-- See the vty-examples package for a number of examples.

1815--

1916-- @

2017-- import "Graphics.Vty"

@@ -31,153 +28,103 @@

3128-- 'shutdown' vty

3229-- 'print' (\"Last event was: \" '++' 'show' e)

3330-- @

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

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

4857

4958import Graphics.Vty.Config

5059import Graphics.Vty.Input

51−import Graphics.Vty.Input.Events

5260import Graphics.Vty.Output

5361import Graphics.Vty.Output.Interface

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

5963

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)

6564import Control.Concurrent.STM

6665

6766import Data.IORef

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

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

70−#endif

67+import Data.Monoid

7168

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

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

69+-- | The main object. At most one should be created.

7470--

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

7672--

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

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

112106

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

114−-- for a given terminal device.

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.

115109--

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

110+-- The specified config is added to the 'userConfig'. With the 'userConfig' taking precedence.

111+-- See "Graphics.Vty.Config"

119112--

120−-- For most applications @mkVty defaultConfig@ is sufficient.

113+-- For most applications @mkVty def@ is sufficient.

121114mkVty :: Config -> IO Vty

122115mkVty appConfig = do

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

117+ input <- inputForConfig config

118+ out <- outputForConfig config

119+ intMkVty input out

124120

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

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

122+intMkVty input out = do

169123 reserveDisplay out

170−

171− shutdownVar <- newTVarIO False

172124 let shutdownIo = do

173− alreadyShutdown <- atomically $ swapTVar shutdownVar True

174− when (not alreadyShutdown) $ do

175− shutdownInput input

176− releaseDisplay out

177− releaseTerminal out

178−

179− let shutdownStatus = readTVarIO shutdownVar

180−

125+ shutdownInput input

126+ releaseDisplay out

127+ releaseTerminal out

181128 lastPicRef <- newIORef Nothing

182129 lastUpdateRef <- newIORef Nothing

183130

@@ -209,47 +156,18 @@ internalMkVty input out = do

209156 mPic <- readIORef lastPicRef

210157 maybe (return ()) innerUpdate mPic

211158

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

159+ let gkey = do k <- atomically $ readTChan $ _eventChannel input

160+ case k of

161+ (EvResize _ _) -> innerRefresh

162+ >> displayBounds out

163+ >>= return . (\(w,h)-> EvResize w h)

164+ _ -> return k

225165

226166 return $ Vty { update = innerUpdate

227167 , nextEvent = gkey

228− , nextEventNonblocking = gkey'

229168 , inputIface = input

230169 , outputIface = out

231170 , refresh = innerRefresh

232171 , shutdown = shutdownIo

233− , isShutdown = shutdownStatus

234172 }

235173

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+120−121

@@ -1,89 +1,68 @@

11{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveGeneric #-}

3−{-# LANGUAGE DeriveAnyClass #-}

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

49

510-- | Display attributes

611--

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

12+-- Typically the values 'defAttr' or 'currentAttr' are modified to form attributes:

1113--

1214-- @

13−-- defAttr \`withForeColor\` red

15+-- defAttr `withForeColor` red

1416-- @

1517--

16−-- 'Image' constructors often require an 'Attr' to indicate the

17−-- attributes used in the image, e.g.,

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:

1822--

1923-- @

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

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

2125-- @

2226--

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

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+

6340import Data.Bits

64−import Data.Text (Text)

41+import Data.Default

6542import Data.Word

66−import GHC.Generics

6743

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

6950

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

71−-- characters rendered after the attribute is applied.

51+-- | A display attribute defines the Color and Style of all the characters rendered after the

52+-- attribute is applied.

7253--

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.

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.

7757data Attr = Attr

7858 { attrStyle :: !(MaybeDefault Style)

7959 , attrForeColor :: !(MaybeDefault Color)

8060 , attrBackColor :: !(MaybeDefault Color)

81− , attrURL :: !(MaybeDefault Text)

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

61+ } deriving ( Eq, Show, Read )

8362

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.

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.

8766-- XXYYZZ__

8867-- XX - style action

8968-- 00 => reset to default

@@ -100,47 +79,85 @@ data Attr = Attr

10079-- __ - unused

10180--

10281-- Next is the style flags

103−-- SURBDOI_

82+-- SURBDO__

10483-- S - standout

10584-- U - underline

10685-- R - reverse video

10786-- B - blink

10887-- D - dim

10988-- O - bold

110−-- I - italic

111−-- _ - unused

89+-- __ - unused

11290--

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

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

11593

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

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

120104data FixedAttr = FixedAttr

121105 { fixedStyle :: !Style

122106 , fixedForeColor :: !(Maybe Color)

123107 , fixedBackColor :: !(Maybe Color)

124− , fixedURL :: !(Maybe Text)

125108 } deriving ( Eq, Show )

126109

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.

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.

141158type Style = Word8

142159

143−-- | Valid style attributes include:

160+-- | The 6 possible style attributes:

144161--

145162-- * standout

146163--

@@ -154,27 +171,21 @@ type Style = Word8

154171--

155172-- * bold/bright

156173--

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

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

164177standout = 0x01

165178underline = 0x02

166−reverseVideo = 0x04

179+reverseVideo = 0x04

167180blink = 0x08

168181dim = 0x10

169182bold = 0x20

170−italic = 0x40

171−strikethrough = 0x80

172183

173184defaultStyleMask :: Style

174185defaultStyleMask = 0x00

175186

176187styleMask :: Attr -> Word8

177−styleMask attr

188+styleMask attr

178189 = case attrStyle attr of

179190 Default -> 0

180191 KeepCurrent -> 0

@@ -194,35 +205,23 @@ withBackColor attr c = attr { attrBackColor = SetTo c }

194205

195206-- | Add the given style attribute

196207withStyle :: Attr -> Style -> Attr

197−withStyle attr 0 = attr

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

199209

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.

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.

217212defAttr :: Attr

218−defAttr = Attr Default Default Default Default

213+defAttr = Attr Default Default Default

214+

215+instance Default Attr where

216+ def = defAttr

219217

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

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

218+-- | Keeps the style, background color and foreground color that was previously set. Used to

219+-- override some part of the previous style.

222220--

223221-- EG: current_style `withForeColor` brightMagenta

224222--

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

226−-- with the foreground color set to brightMagenta.

223+-- Would be the currently applied style (be it underline, bold, etc) but with the foreground color

224+-- set to brightMagenta.

227225currentAttr :: Attr

228−currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent KeepCurrent

226+currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent

227+

src/Graphics/Vty/Attributes/Color.hs+22−162

@@ -1,75 +1,16 @@

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−

1+module Graphics.Vty.Attributes.Color where

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

593

604-- | Abstract data type representing a color.

5+--

6+-- Currently the foreground and background color are specified as points in either a:

617--

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.

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.

7210--

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

7314-- The 8 ISO 6429 (ANSI) colors are as follows:

7415--

7516-- 0. black

@@ -88,104 +29,23 @@ import Graphics.Vty.Attributes.Color240

8829--

8930-- 7. white

9031--

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.

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.

9636--

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.

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.

10140--

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.

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.

10543--

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.

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.

11047--

11148-- Seriously, terminal color support is INSANE.

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

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

114−

115−data ColorMode

116− = NoColor

117− | ColorMode8

118− | ColorMode16

119− | ColorMode240 !Word8

120− | FullColor

121− deriving ( Eq, Show )

122−

123−detectColorMode :: String -> IO ColorMode

124−detectColorMode termName' = do

125− term <- catch (Just <$> Terminfo.setupTerm termName')

126− (\(_ :: Terminfo.SetupTermError) -> return Nothing)

127− let getCap cap = term >>= \t -> Terminfo.getCapability t cap

128− termColors = fromMaybe 0 $ getCap (Terminfo.tiGetNum "colors")

129− colorterm <- lookupEnv "COLORTERM"

130− return $ if

131− | termColors < 8 -> NoColor

132− | termColors < 16 -> ColorMode8

133− | termColors == 16 -> ColorMode16

134− | termColors < 256 -> ColorMode240 (fromIntegral termColors - 16)

135− | colorterm == Just "truecolor" -> FullColor

136− | colorterm == Just "24bit" -> FullColor

137− | otherwise -> ColorMode240 240

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)

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

50+ deriving ( Eq, Show, Read )

18651

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+254−291

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

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

2−module Graphics.Vty.Attributes.Color240

3− ( rgbColorToColor240

4− , color240CodeToRGB

5− )

6−where

1+{-

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

3+ -}

4+module Graphics.Vty.Attributes.Color240 where

75

8−import Data.Word (Word8)

9−import Text.Printf

6+import Graphics.Vty.Attributes.Color

107

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

12−-- 256colres.pl which is forked from xterm 256colres.pl.

8+import Text.Printf

139

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

44258 (fromIntegral r :: Int)

45259 (fromIntegral g :: Int)

46− (fromIntegral b :: Int)))

47−

48−simpleColor_ :: Integral i => Word8 -> i -> Word8

49−simpleColor_ e c

50− | c <= 0 = 0

51− | c <= 95 = 1

52− | c <= 255 = fromIntegral ((c-16) `div` 40)

53− | otherwise = e

260+ (fromIntegral b :: Int))

54261

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+111−290

@@ -3,13 +3,21 @@

33{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

44{-# LANGUAGE TypeOperators #-}

55{-# LANGUAGE ScopedTypeVariables #-}

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.

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.

108--

11−-- Lines in config files that fail to parse are ignored. Later entries

12−-- take precedence over earlier ones.

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

1321--

1422-- = Debug

1523--

@@ -21,8 +29,8 @@

2129-- \"debugLog\" string

2230-- @

2331--

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.

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.

2634--

2735-- = Input Processing

2836--

@@ -32,14 +40,14 @@

3240--

3341-- @

3442-- \"map\" term string key modifier_list

35−-- where

43+-- where

3644-- key := KEsc | KChar Char | KBS ... (same as 'Key')

3745-- modifier_list := \"[\" modifier+ \"]\"

3846-- modifier := MShift | MCtrl | MMeta | MAlt

3947-- term := "_" | string

4048-- @

4149--

42−-- E.g., if the contents are

50+-- EG: If the contents are

4351--

4452-- @

4553-- map _ \"\\ESC[B\" KUp []

@@ -47,41 +55,16 @@

4755-- map \"xterm\" \"\\ESC[D\" KLeft []

4856-- @

4957--

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

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

6961--

70−-- E.g.,

62+-- If a debug log is requested then vty will output the current input table to the log in the above

63+-- format.

7164--

72−-- @

73−-- widthMap \"xterm\" \"\/home\/user\/.vty\/xterm\_map.dat\"

74−-- @

65+-- Set VTY_DEBUG_LOG. Run vty. Check debug log for incorrect mappings. Add corrected mappings to

66+-- .vty/config

7567--

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.

8568module Graphics.Vty.Config

8669 ( InputMap

8770 , Config(..)

@@ -91,22 +74,13 @@ module Graphics.Vty.Config

9174 , standardIOConfig

9275 , runParseConfig

9376 , parseConfigFile

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

77+ ) where

10878

79+#if __GLASGOW_HASKELL__ > 704

10980import Prelude

81+#else

82+import Prelude hiding (catch)

83+#endif

11084

11185import Control.Applicative hiding (many)

11286

@@ -114,186 +88,113 @@ import Control.Exception (catch, IOException, Exception(..), throwIO)

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

11589

11690import qualified Data.ByteString as BS

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

118−import Data.Monoid (Monoid(..))

119−#endif

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

121−import Data.Semigroup (Semigroup(..))

122−#endif

91+import Data.Default

92+import Data.Monoid

12393import Data.Typeable (Typeable)

12494

12595import Graphics.Vty.Input.Events

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

12796

12897import GHC.Generics

12998

130−import System.Directory ( getAppUserDataDirectory, doesFileExist

131− , createDirectoryIfMissing

132− )

133−import System.Environment (lookupEnv)

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

99+import System.Directory (getAppUserDataDirectory)

100+import System.Posix.Env (getEnv)

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

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

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

138103

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

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

141106import qualified Text.Parsec.Token as P

142107

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

144−data VtyConfigurationError =

145− VtyMissingTermEnvVar

146− -- ^ TERM environment variable not set

147− deriving (Show, Eq, Typeable)

109+data VtyConfigurationError

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

111+ deriving (Show, Eq, Typeable)

148112

149113instance Exception VtyConfigurationError where

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

114+#if MIN_VERSION_base(4,8,0)

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

116+#endif

151117

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.

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.

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

156121

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

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

224150

225151instance Monoid Config where

226− mempty =

227− Config { vmin = Nothing

228− , vtime = Nothing

229− , mouseMode = Nothing

230− , bracketedPasteMode = Nothing

231− , debugLog = mempty

232− , inputMap = mempty

233− , inputFd = Nothing

234− , outputFd = Nothing

235− , termName = Nothing

236− , termWidthMaps = []

237− , allowCustomUnicodeWidthTables = Nothing

238− , colorMode = Nothing

239− }

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

241− mappend = (<>)

242−#endif

243−

244−vtyDataDirectory :: IO FilePath

245−vtyDataDirectory = getAppUserDataDirectory "vty"

246−

247−vtyConfigPath :: IO FilePath

248−vtyConfigPath = do

249− dir <- vtyDataDirectory

250− return $ dir </> "config"

251−

252−vtyConfigFileEnvName :: String

253−vtyConfigFileEnvName = "VTY_CONFIG_FILE"

254−

255−-- | Load a configuration from 'vtyConfigPath' and @$VTY_CONFIG_FILE@.

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@

256177userConfig :: IO Config

257178userConfig = do

258− configFile <- vtyConfigPath >>= parseConfigFile

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

260− lookupEnv vtyConfigFileEnvName

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

180+ overrideConfig <- maybe (return def) parseConfigFile =<< getEnv "VTY_CONFIG_FILE"

261181 let base = configFile <> overrideConfig

262182 mappend base <$> overrideEnvConfig

263183

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−

282184overrideEnvConfig :: IO Config

283185overrideEnvConfig = do

284− d <- lookupEnv "VTY_DEBUG_LOG"

285− return $ defaultConfig { debugLog = d }

186+ d <- getEnv "VTY_DEBUG_LOG"

187+ return $ def { debugLog = d }

286188

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

189+-- | Configures VTY using defaults suitable for terminals. This action

288190-- can raise 'VtyConfigurationError'.

289191standardIOConfig :: IO Config

290192standardIOConfig = do

291− mb <- lookupEnv termVariable

193+ mb <- getEnv "TERM"

292194 case mb of

293195 Nothing -> throwIO VtyMissingTermEnvVar

294− Just t -> do

295− mcolorMode <- detectColorMode t

296− return defaultConfig

196+ Just t ->

197+ return def

297198 { vmin = Just 1

298199 , mouseMode = Just False

299200 , bracketedPasteMode = Just False

@@ -301,24 +202,25 @@ standardIOConfig = do

301202 , inputFd = Just stdInput

302203 , outputFd = Just stdOutput

303204 , termName = Just t

304− , colorMode = Just mcolorMode

305205 }

306206

307207parseConfigFile :: FilePath -> IO Config

308208parseConfigFile path = do

309209 catch (runParseConfig path <$> BS.readFile path)

310− (\(_ :: IOException) -> return defaultConfig)

210+ (\(_ :: IOException) -> return def)

311211

312212runParseConfig :: String -> BS.ByteString -> Config

313213runParseConfig name cfgTxt =

314214 case runParser parseConfig () name cfgTxt of

315215 Right cfg -> cfg

316− Left{} -> defaultConfig

216+ Left{} -> def

317217

318218------------------------------------------------------------------------

319219

320220type Parser = Parsec BS.ByteString ()

321221

222+-- I tried to use the haskellStyle here but that was specialized (without requirement?) to the

223+-- String stream type.

322224configLanguage :: Monad m => P.GenLanguageDef BS.ByteString () m

323225configLanguage = LanguageDef

324226 { commentStart = "{-"

@@ -345,20 +247,13 @@ mapDecl = do

345247 bytes <- P.stringLiteral configLexer

346248 key <- parseValue

347249 modifiers <- parseValue

348− return defaultConfig { inputMap = [(termIdent, bytes, EvKey key modifiers)] }

250+ return def { inputMap = [(termIdent, bytes, EvKey key modifiers)] }

349251

350252debugLogDecl :: Parser Config

351253debugLogDecl = do

352254 "debugLog" <- P.identifier configLexer

353255 path <- P.stringLiteral configLexer

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

256+ return def { debugLog = Just path }

362257

363258ignoreLine :: Parser ()

364259ignoreLine = void $ manyTill anyChar newline

@@ -366,8 +261,8 @@ ignoreLine = void $ manyTill anyChar newline

366261parseConfig :: Parser Config

367262parseConfig = liftM mconcat $ many $ do

368263 P.whiteSpace configLexer

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

370− choice directives <|> (ignoreLine >> return defaultConfig)

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

265+ choice directives <|> (ignoreLine >> return def)

371266

372267class Parse a where parseValue :: Parser a

373268instance Parse Char where parseValue = P.charLiteral configLexer

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

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

413308

414309instance 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+14−13

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

2−module Graphics.Vty.Debug

3− ( module Graphics.Vty.Debug

4− , module Graphics.Vty.Debug.Image

5− )

2+module Graphics.Vty.Debug ( module Graphics.Vty.Debug

3+ , module Graphics.Vty.Debug.Image

4+ )

65where

76

7+import Graphics.Vty.Prelude

8+

89import 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−rowOpsAffectedColumns :: DisplayOps -> [Int]

16−rowOpsAffectedColumns ops

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

15+rowOpsEffectedColumns :: DisplayOps -> [Int]

16+rowOpsEffectedColumns ops

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

1818

1919allSpansHaveWidth :: DisplayOps -> Int -> Bool

2020allSpansHaveWidth ops expected

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

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

2222

23−spanOpsAffectedRows :: DisplayOps -> Int

24−spanOpsAffectedRows ops

23+spanOpsEffectedRows :: DisplayOps -> Int

24+spanOpsEffectedRows ops

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

26−

26+

2727type SpanConstructLog = [SpanConstructEvent]

2828data SpanConstructEvent = SpanSetAttr Attr

2929

@@ -37,3 +37,4 @@ 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+33−64

@@ -1,30 +1,31 @@

2−{-# LANGUAGE BangPatterns #-}

32{-# LANGUAGE CPP #-}

3+{-# LANGUAGE BangPatterns #-}

4+

5+#ifndef MIN_VERSION_base

6+#defined MIN_VERSION_base(x,y,z) 1

7+#endif

48

5−module Graphics.Vty.DisplayAttributes where

9+module Graphics.Vty.DisplayAttributes

10+ where

611

712import Graphics.Vty.Attributes

813

914import Data.Bits ((.&.))

10−import Data.ByteString (ByteString)

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

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

15+

16+#if !(MIN_VERSION_base(4,8,0))

17+import Data.Monoid (Monoid(..), mconcat)

1318#endif

14−import Data.Text (Text)

15−import Data.Text.Encoding (encodeUtf8)

1619

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"

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"

2123-- abstraction.

2224fixDisplayAttr :: FixedAttr -> Attr -> FixedAttr

2325fixDisplayAttr fattr attr

2426 = FixedAttr (fixStyle (fixedStyle fattr) (attrStyle attr))

2527 (fixColor (fixedForeColor fattr) (attrForeColor attr))

2628 (fixColor (fixedBackColor fattr) (attrBackColor attr))

27− (fixURL (fixedURL fattr) (attrURL attr))

2829 where

2930 fixStyle _s Default = defaultStyleMask

3031 fixStyle s KeepCurrent = s

@@ -32,56 +33,43 @@ fixDisplayAttr fattr attr

3233 fixColor _c Default = Nothing

3334 fixColor c KeepCurrent = c

3435 fixColor _c (SetTo c) = Just c

35− fixURL c KeepCurrent = c

36− fixURL _c (SetTo n) = Just n

37− fixURL _c Default = Nothing

3836

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.

37+-- | difference between two display attributes. Used in the calculation of the operations required

38+-- to go from one display attribute to the next.

4239--

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.

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.

4643data DisplayAttrDiff = DisplayAttrDiff

4744 { styleDiffs :: [StyleStateChange]

4845 , foreColorDiff :: DisplayColorDiff

4946 , backColorDiff :: DisplayColorDiff

50− , urlDiff :: URLDiff

5147 }

5248 deriving (Show)

5349

54−instance Semigroup DisplayAttrDiff where

55− d0 <> d1 =

50+instance Monoid DisplayAttrDiff where

51+ mempty = DisplayAttrDiff [] NoColorChange NoColorChange

52+ mappend d0 d1 =

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

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

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

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

56+ in DisplayAttrDiff ds fcd bcd

6757

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

59+--

60+-- TODO(corey): not really a simplify but a monoid instance.

6961simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]

7062simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1

7163

72−-- | Consider two display color attributes diffs. What display color

73−-- attribute diff are these equivalent to?

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.

7468simplifyColorDiffs :: DisplayColorDiff -> DisplayColorDiff -> DisplayColorDiff

7569simplifyColorDiffs _cd ColorToDefault = ColorToDefault

7670simplifyColorDiffs cd NoColorChange = cd

7771simplifyColorDiffs _cd (SetColor !c) = SetColor c

7872

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−

8573-- | Difference between two display color attribute changes.

8674data DisplayColorDiff

8775 = ColorToDefault

@@ -89,15 +77,11 @@ data DisplayColorDiff

8977 | SetColor !Color

9078 deriving (Show, Eq)

9179

92−-- | Style attribute changes are transformed into a sequence of

93−-- apply/removes of the individual attributes.

94−data StyleStateChange

80+-- | Style attribute changes are transformed into a sequence of apply/removes of the individual

81+-- attributes.

82+data StyleStateChange

9583 = ApplyStandout

9684 | RemoveStandout

97− | ApplyItalic

98− | RemoveItalic

99− | ApplyStrikethrough

100− | RemoveStrikethrough

10185 | ApplyUnderline

10286 | RemoveUnderline

10387 | ApplyReverseVideo

@@ -110,28 +94,15 @@ data StyleStateChange

11094 | RemoveBold

11195 deriving (Show, Eq)

11296

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.

97+-- | Determines the diff between two display&color attributes. This diff determines the operations

98+-- that actually get output to the terminal.

12299displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff

123100displayAttrDiffs attr attr' = DisplayAttrDiff

124101 { styleDiffs = diffStyles (fixedStyle attr) (fixedStyle attr')

125102 , foreColorDiff = diffColor (fixedForeColor attr) (fixedForeColor attr')

126103 , backColorDiff = diffColor (fixedBackColor attr) (fixedBackColor attr')

127− , urlDiff = diffURL (fixedURL attr) (fixedURL attr')

128104 }

129105

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−

135106diffColor :: Maybe Color -> Maybe Color -> DisplayColorDiff

136107diffColor Nothing (Just c') = SetColor c'

137108diffColor (Just c) (Just c')

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

145116 = mconcat

146117 [ styleDiff standout ApplyStandout RemoveStandout

147118 , styleDiff underline ApplyUnderline RemoveUnderline

148− , styleDiff italic ApplyItalic RemoveItalic

149− , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough

150119 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo

151120 , styleDiff blink ApplyBlink RemoveBlink

152121 , styleDiff dim ApplyDim RemoveDim

src/Graphics/Vty/Error.hs+3−3

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

1−module Graphics.Vty.Error where

1+module Graphics.Vty.Error

2+ where

23

34-- | The type of exceptions specific to vty.

45--

5−-- These have fully qualified names by default since, IMO, exception

6−-- handling requires this.

6+-- These have fully qualified names by default since, IMO, exception handling requires this.

77data VtyException

88 = VtyFailure String -- ^ Uncategorized failure specific to vty.

src/Graphics/Vty/Image.hs+126−200

@@ -1,63 +1,48 @@

2+{-# LANGUAGE BangPatterns #-}

23{-# LANGUAGE NamedFieldPuns #-}

34{-# LANGUAGE DisambiguateRecordFields #-}

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

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

6146

6247import Graphics.Vty.Attributes

6348import Graphics.Vty.Image.Internal

@@ -71,163 +56,120 @@ import qualified Data.Text.Lazy as TL

7156import qualified Data.Text.Lazy.Encoding as TL

7257import Data.Word

7358

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−

8359infixr 5 <|>

8460infixr 4 <->

8561

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

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

9365 | w == 0 = EmptyImage

9466 | h == 0 = EmptyImage

9567 | otherwise = BGFill w h

9668

97−-- | Combines two images horizontally. This is an alias for 'horizJoin'.

69+-- | Combines two images horizontally. Alias for horizJoin

9870--

9971-- infixr 5

10072(<|>) :: Image -> Image -> Image

10173(<|>) = horizJoin

10274

103−-- | Combines two images vertically. This is an alias for 'vertJoin'.

75+-- | Combines two images vertically. Alias for vertJoin

10476--

10577-- infixr 4

10678(<->) :: Image -> Image -> Image

10779(<->) = vertJoin

10880

109−-- | Compose any number of images together horizontally, with the first

110−-- in the list being leftmost.

81+-- | Compose any number of images horizontally.

11182horizCat :: [Image] -> Image

11283horizCat = foldr horizJoin EmptyImage

11384

114−-- | Compose any number of images vertically, with the first in the list

115−-- being topmost.

85+-- | Compose any number of images vertically.

11686vertCat :: [Image] -> Image

11787vertCat = foldr vertJoin EmptyImage

11888

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.

89+-- | A Data.Text.Lazy value

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

123−text a txt = let displayWidth = safeWctlwidth txt

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

91+text a txt

92+ | TL.length txt == 0 = EmptyImage

93+ | otherwise = let displayWidth = safeWcswidth (TL.unpack txt)

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

12595

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.

96+-- | A Data.Text value

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

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

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

98+text' a txt

99+ | T.length txt == 0 = EmptyImage

100+ | otherwise = let displayWidth = safeWcswidth (T.unpack txt)

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

132102

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.

103+-- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in

104+-- the ISO-10646 encoding.

135105char :: Attr -> Char -> Image

136106char a c =

137107 let displayWidth = safeWcwidth c

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

139109

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.

110+-- | A string of characters layed out on a single row with the same display attribute. The string is

111+-- assumed to be a sequence of ISO-10646 characters.

145112--

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.

113+-- Note: depending on how the Haskell compiler represents string literals a string literal in a

114+-- UTF-8 encoded source file, for example, may be represented as a ISO-10646 string.

115+-- That is, I think, the case with GHC 6.10. This means, for the most part, you don't need to worry

116+-- about the encoding format when outputting string literals. Just provide the string literal

117+-- directly to iso10646String or string.

118+--

152119iso10646String :: Attr -> String -> Image

120+iso10646String _ [] = EmptyImage

153121iso10646String a str =

154122 let displayWidth = safeWcswidth str

155123 in HorizText a (TL.pack str) displayWidth (length str)

156124

157−-- | Make an 'Image' from a 'String'.

125+-- | Alias for iso10646String. Since the usual case is that a literal string like "foo" is

126+-- represented internally as a list of ISO 10646 31 bit characters.

158127--

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.

128+-- Note: Keep in mind that GHC will compile source encoded as UTF-8 but the literal strings, while

129+-- UTF-8 encoded in the source, will be transcoded to a ISO 10646 31 bit characters runtime

130+-- representation.

166131string :: Attr -> String -> Image

167132string = iso10646String

168133

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.

134+-- | A string of characters layed out on a single row. The input is assumed to be the bytes for

135+-- UTF-8 encoded text.

171136utf8String :: Attr -> [Word8] -> Image

172137utf8String a bytes = utf8Bytestring a (BL.pack bytes)

173138

174−-- | Make an 'Image' from a UTF-8 encoded lazy bytestring.

139+-- | Renders a UTF-8 encoded lazy bytestring.

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

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

177142

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

143+-- | Renders a UTF-8 encoded strict bytestring.

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

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

181146

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

147+-- | creates a fill of the specified character. The dimensions are in number of characters wide and

148+-- number of rows high.

149+charFill :: Integral d => Attr -> Char -> d -> d -> Image

150+charFill _a _c 0 _h = EmptyImage

151+charFill _a _c _w 0 = EmptyImage

152+charFill a c w h =

153+ vertCat $ replicate (fromIntegral h) $ HorizText a txt displayWidth charWidth

154+ where

155+ txt = TL.replicate (fromIntegral w) (TL.singleton c)

156+ displayWidth = safeWcwidth c * (fromIntegral w)

157+ charWidth = fromIntegral w

158+

159+-- | The empty image. Useful for fold combinators. These occupy no space nor define any display

160+-- attributes.

161+emptyImage :: Image

211162emptyImage = EmptyImage

212163

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

164+-- | pad the given image. This adds background character fills to the left, top, right, bottom.

165+-- The pad values are how many display columns or rows to add.

166+pad :: Int -> Int -> Int -> Int -> Image -> Image

226167pad 0 0 0 0 i = i

227168pad inL inT inR inB inImage

228169 | inL < 0 || inT < 0 || inR < 0 || inB < 0 = error "cannot pad by negative amount"

229170 | otherwise = go inL inT inR inB inImage

230− where

171+ where

172+ -- TODO: uh.

231173 go 0 0 0 0 i = i

232174 go 0 0 0 b i = VertJoin i (BGFill w b) w h

233175 where w = imageWidth i

@@ -242,53 +184,40 @@ pad inL inT inR inB inImage

242184 where w = imageWidth i + l

243185 h = imageHeight i

244186

245−-- | Translates an image by padding or cropping the left and top.

187+-- | translates an image by padding or cropping the left and top. First param is amount to translate

188+-- left. Second param is amount to translate top.

246189--

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

190+-- This can have an unexpected effect: Translating an image to less than (0,0) then to greater than

191+-- (0,0) will crop the image.

192+translate :: Int -> Int -> Image -> Image

255193translate x y i = translateX x (translateY y i)

256194

257−-- | Translates an image by padding or cropping its left side.

195+-- | translates an image by padding or cropping the left

258196translateX :: Int -> Image -> Image

259197translateX x i

260− | x < 0 && (abs x > imageWidth i) = emptyImage

261198 | x < 0 = let s = abs x in CropLeft i s (imageWidth i - s) (imageHeight i)

262199 | x == 0 = i

263200 | otherwise = let h = imageHeight i in HorizJoin (BGFill x h) i (imageWidth i + x) h

264201

265−-- | Translates an image by padding or cropping its top.

202+-- | translates an image by padding or cropping the top

266203translateY :: Int -> Image -> Image

267204translateY y i

268− | y < 0 && (abs y > imageHeight i) = emptyImage

269205 | y < 0 = let s = abs y in CropTop i s (imageWidth i) (imageHeight i - s)

270206 | y == 0 = i

271207 | otherwise = let w = imageWidth i in VertJoin (BGFill w y) i w (imageHeight i + y)

272208

273−-- | Ensure an image is no larger than the provided size. If the image

274−-- is larger then crop the right or bottom.

209+-- | Ensure an image is no larger than the provided size. If the image is larger then crop the right

210+-- or bottom.

275211--

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

212+-- This is transformed to a vertical crop from the bottom followed by horizontal crop from the

213+-- right.

214+crop :: Int -> Int -> Image -> Image

285215crop 0 _ _ = EmptyImage

286216crop _ 0 _ = EmptyImage

287217crop w h i = cropBottom h (cropRight w i)

288218

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.

219+-- | crop the display height. If the image is less than or equal in height then this operation has

220+-- no effect. Otherwise the image is cropped from the bottom.

292221cropBottom :: Int -> Image -> Image

293222cropBottom 0 _ = EmptyImage

294223cropBottom h inI

@@ -303,9 +232,8 @@ cropBottom h inI

303232 | h >= imageHeight i = i

304233 | otherwise = CropBottom i (imageWidth i) h

305234

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.

235+-- | ensure the image is no wider than the given width. If the image is wider then crop the right

236+-- side.

309237cropRight :: Int -> Image -> Image

310238cropRight 0 _ = EmptyImage

311239cropRight w inI

@@ -320,9 +248,8 @@ cropRight w inI

320248 | w >= imageWidth i = i

321249 | otherwise = CropRight i w (imageHeight i)

322250

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.

251+-- | ensure the image is no wider than the given width. If the image is wider then crop the left

252+-- side.

326253cropLeft :: Int -> Image -> Image

327254cropLeft 0 _ = EmptyImage

328255cropLeft w inI

@@ -339,9 +266,8 @@ cropLeft w inI

339266 | imageWidth i <= w = i

340267 | otherwise = CropLeft i (imageWidth i - w) w (imageHeight i)

341268

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.

269+-- | crop the display height. If the image is less than or equal in height then this operation has

270+-- no effect. Otherwise the image is cropped from the top.

345271cropTop :: Int -> Image -> Image

346272cropTop 0 _ = EmptyImage

347273cropTop h inI

@@ -358,24 +284,24 @@ cropTop h inI

358284 | imageHeight i <= h = i

359285 | otherwise = CropTop i (imageHeight i - h) (imageWidth i) h

360286

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.

287+-- | Generic resize. Pads and crops as required to assure the given display width and height.

288+-- This is biased to pad/crop the right and bottom.

364289resize :: Int -> Int -> Image -> Image

365290resize w h i = resizeHeight h (resizeWidth w i)

366291

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.

292+-- | Resize the width. Pads and crops as required to assure the given display width.

293+-- This is biased to pad/crop the right.

369294resizeWidth :: Int -> Image -> Image

370295resizeWidth w i = case w `compare` imageWidth i of

371296 LT -> cropRight w i

372297 EQ -> i

373298 GT -> i <|> BGFill (w - imageWidth i) (imageHeight i)

374299

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.

300+-- | Resize the height. Pads and crops as required to assure the given display height.

301+-- This is biased to pad/crop the bottom.

377302resizeHeight :: Int -> Image -> Image

378303resizeHeight h i = case h `compare` imageHeight i of

379304 LT -> cropBottom h i

380305 EQ -> i

381306 GT -> i <-> BGFill (imageWidth i) (h - imageHeight i)

307+

src/Graphics/Vty/Image/Internal.hs+96−78

@@ -1,25 +1,36 @@

11{-# LANGUAGE CPP #-}

22{-# LANGUAGE NamedFieldPuns #-}

3−{-# LANGUAGE DeriveGeneric #-}

43{-# OPTIONS_HADDOCK hide #-}

54

5+#ifndef MIN_VERSION_base

6+#defined MIN_VERSION_base(x,y,z) 1

7+#endif

8+

69module Graphics.Vty.Image.Internal where

710

811import Graphics.Vty.Attributes

912import Graphics.Text.Width

1013

11−import GHC.Generics

12−

1314import Control.DeepSeq

1415

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

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

17−#endif

1816import qualified Data.Text.Lazy as TL

1917

18+#if !(MIN_VERSION_base(4,8,0))

19+import Data.Monoid

20+#endif

21+

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

23+--

24+-- TODO(corey): hm. there is an explicit equation for each type which goes to a lazy text. Each

25+-- application probably uses a single type. Perhaps parameterize the entire vty interface by the

26+-- input text type?

27+-- TODO: Try using a builder instead of a TL.Text instance directly. That might improve performance

28+-- for the usual case of appending a bunch of characters with the same attribute together.

2129type DisplayText = TL.Text

2230

31+-- TODO: store a skip list in HorizText(?)

32+-- TODO: represent display strings containing chars that are not 1 column chars as a separate

33+-- display string value?

2334clipText :: DisplayText -> Int -> Int -> DisplayText

2435clipText txt leftSkip rightClip =

2536 -- CPS would clarify this I think

@@ -28,17 +39,18 @@ clipText txt leftSkip rightClip =

2839 (toTake,padSuffix) = clipForCharWidth rightClip txt' 0

2940 txt'' = TL.append (TL.take toTake txt') (if padSuffix then TL.singleton '…' else TL.empty)

3041 -- Note: some characters and zero-width and combining characters

31− -- combine to the left, so keep taking characters even if the

32− -- width is zero.

42+ -- combine to the left, so keep taking characters even if the width

43+ -- is zero.

3344 clipForCharWidth w t n

3445 | TL.null t = (n, False)

3546 | w < cw = (n, w /= 0)

3647 | otherwise = clipForCharWidth (w - cw) (TL.tail t) (n + 1)

3748 where cw = safeWcwidth (TL.head t)

49+ clipForCharWidth _ _ _ = error "clipForCharWidth applied to undefined"

3850 in txt''

3951

40−-- | This is the internal representation of Images. Use the constructors

41−-- in "Graphics.Vty.Image" to create instances.

52+-- | This is the internal representation of Images. Use the constructors in "Graphics.Vty.Image" to

53+-- create instances.

4254--

4355-- Images are:

4456--

@@ -51,61 +63,49 @@ clipText txt leftSkip rightClip =

5163-- * a cropped image

5264--

5365-- * an empty image of no size or content.

54−data Image =

55− -- | A horizontal text span has a row height of 1.

66+data Image =

67+ -- | A horizontal text span is always >= 1 column and has a row height of 1.

5668 HorizText

5769 { attr :: Attr

58− -- | The text to display. The display width of the text is always

59− -- outputWidth.

70+ -- | The text to display. The display width of the text is always outputWidth.

6071 , displayText :: DisplayText

61− -- | The number of display columns for the text.

72+ -- | The number of display columns for the text. Always > 0.

6273 , outputWidth :: Int

63− -- | the number of characters in the text.

74+ -- | the number of characters in the text. Always > 0.

6475 , charWidth :: Int

6576 }

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.

77+ -- | A horizontal join can be constructed between any two images. However a HorizJoin instance is

78+ -- required to be between two images of equal height. The horizJoin constructor adds background

79+ -- fills to the provided images that assure this is true for the HorizJoin value produced.

7180 | HorizJoin

72− { partLeft :: Image

81+ { partLeft :: Image

7382 , partRight :: Image

74− , outputWidth :: Int

75− -- ^ imageWidth partLeft == imageWidth partRight. Always > 0

76− , outputHeight :: Int

77− -- ^ imageHeight partLeft == imageHeight partRight. Always > 0

83+ , outputWidth :: Int -- ^ imageWidth partLeft == imageWidth partRight. Always > 1

84+ , outputHeight :: Int -- ^ imageHeight partLeft == imageHeight partRight. Always > 0

7885 }

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.

86+ -- | A veritical join can be constructed between any two images. However a VertJoin instance is

87+ -- required to be between two images of equal width. The vertJoin constructor adds background

88+ -- fills to the provides images that assure this is true for the VertJoin value produced.

8489 | VertJoin

8590 { partTop :: Image

8691 , partBottom :: Image

87− , outputWidth :: Int

88− -- ^ imageWidth partTop == imageWidth partBottom. always > 0

89− , outputHeight :: Int

90− -- ^ imageHeight partTop == imageHeight partBottom. always > 1

92+ , outputWidth :: Int -- ^ imageWidth partTop == imageWidth partBottom. always > 0

93+ , outputHeight :: Int -- ^ imageHeight partTop == imageHeight partBottom. always > 1

9194 }

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.

95+ -- | A background fill will be filled with the background char. The background char is

96+ -- defined as a property of the Picture this Image is used to form.

9597 | BGFill

9698 { outputWidth :: Int -- ^ always > 0

9799 , outputHeight :: Int -- ^ always > 0

98100 }

99− -- | Crop an image horizontally to a size by reducing the size from

100− -- the right.

101+ -- | Crop an image horizontally to a size by reducing the size from the right.

101102 | CropRight

102103 { croppedImage :: Image

103104 -- | Always < imageWidth croppedImage > 0

104105 , outputWidth :: Int

105106 , outputHeight :: Int -- ^ imageHeight croppedImage

106107 }

107− -- | Crop an image horizontally to a size by reducing the size from

108− -- the left.

108+ -- | Crop an image horizontally to a size by reducing the size from the left.

109109 | CropLeft

110110 { croppedImage :: Image

111111 -- | Always < imageWidth croppedImage > 0

@@ -114,8 +114,7 @@ data Image =

114114 , outputWidth :: Int

115115 , outputHeight :: Int

116116 }

117− -- | Crop an image vertically to a size by reducing the size from

118− -- the bottom

117+ -- | Crop an image vertically to a size by reducing the size from the bottom

119118 | CropBottom

120119 { croppedImage :: Image

121120 -- | imageWidth croppedImage

@@ -123,8 +122,7 @@ data Image =

123122 -- | height image is cropped to. Always < imageHeight croppedImage > 0

124123 , outputHeight :: Int

125124 }

126− -- | Crop an image vertically to a size by reducing the size from

127− -- the top

125+ -- | Crop an image vertically to a size by reducing the size from the top

128126 | CropTop

129127 { croppedImage :: Image

130128 -- | Always < imageHeight croppedImage > 0

@@ -136,17 +134,43 @@ data Image =

136134 }

137135 -- | The empty image

138136 --

139− -- The combining operators identity constant.

137+ -- The combining operators identity constant.

140138 -- EmptyImage <|> a = a

141139 -- EmptyImage <-> a = a

142− --

140+ --

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

144142 | EmptyImage

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

143+ deriving Eq

144+

145+instance Show Image where

146+ show ( HorizText { attr, displayText, outputWidth, charWidth } )

147+ = "HorizText " ++ show displayText

148+ ++ "@(" ++ show attr ++ ","

149+ ++ show outputWidth ++ ","

150+ ++ show charWidth ++ ")"

151+ show ( BGFill { outputWidth, outputHeight } )

152+ = "BGFill (" ++ show outputWidth ++ "," ++ show outputHeight ++ ")"

153+ show ( HorizJoin { partLeft = l, partRight = r, outputWidth = c } )

154+ = "HorizJoin " ++ show c ++ " (" ++ show l ++ " <|> " ++ show r ++ ")"

155+ show ( VertJoin { partTop = t, partBottom = b, outputWidth = c, outputHeight = r } )

156+ = "VertJoin [" ++ show c ++ ", " ++ show r ++ "] (" ++ show t ++ ") <-> (" ++ show b ++ ")"

157+ show ( CropRight { croppedImage, outputWidth, outputHeight } )

158+ = "CropRight [" ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

159+ ++ " (" ++ show croppedImage ++ ")"

160+ show ( CropLeft { croppedImage, leftSkip, outputWidth, outputHeight } )

161+ = "CropLeft [" ++ show leftSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

162+ ++ " (" ++ show croppedImage ++ ")"

163+ show ( CropBottom { croppedImage, outputWidth, outputHeight } )

164+ = "CropBottom [" ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

165+ ++ " (" ++ show croppedImage ++ ")"

166+ show ( CropTop { croppedImage, topSkip, outputWidth, outputHeight } )

167+ = "CropTop [" ++ show topSkip ++ "," ++ show outputWidth ++ "," ++ show outputHeight ++ "]"

168+ ++ " (" ++ show croppedImage ++ ")"

169+ show ( EmptyImage ) = "EmptyImage"

146170

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

148172ppImageStructure :: Image -> String

149−ppImageStructure = go 0

173+ppImageStructure inImg = go 0 inImg

150174 where

151175 go indent img = tab indent ++ pp indent img

152176 tab indent = concat $ replicate indent " "

@@ -172,7 +196,7 @@ ppImageStructure = go 0

172196 = "CropTop("++ show outputWidth ++ "," ++ show topSkip ++ "->" ++ show outputHeight ++ ")\n"

173197 ++ go (i+1) croppedImage

174198 pp _ EmptyImage = "EmptyImage"

175−

199+

176200instance NFData Image where

177201 rnf EmptyImage = ()

178202 rnf (CropRight i w h) = i `deepseq` w `seq` h `seq` ()

@@ -184,8 +208,7 @@ instance NFData Image where

184208 rnf (HorizJoin l r w h) = l `deepseq` r `deepseq` w `seq` h `seq` ()

185209 rnf (HorizText a s w cw) = a `seq` s `deepseq` w `seq` cw `seq` ()

186210

187−-- | The width of an Image. This is the number display columns the image

188−-- will occupy.

211+-- | The width of an Image. This is the number display columns the image will occupy.

189212imageWidth :: Image -> Int

190213imageWidth HorizText { outputWidth = w } = w

191214imageWidth HorizJoin { outputWidth = w } = w

@@ -197,8 +220,7 @@ imageWidth CropBottom { outputWidth = w } = w

197220imageWidth CropTop { outputWidth = w } = w

198221imageWidth EmptyImage = 0

199222

200−-- | The height of an Image. This is the number of display rows the

201−-- image will occupy.

223+-- | The height of an Image. This is the number of display rows the image will occupy.

202224imageHeight :: Image -> Int

203225imageHeight HorizText {} = 1

204226imageHeight HorizJoin { outputHeight = h } = h

@@ -210,32 +232,27 @@ imageHeight CropBottom { outputHeight = h } = h

210232imageHeight CropTop { outputHeight = h } = h

211233imageHeight EmptyImage = 0

212234

213−-- | Append in the 'Semigroup' instance is equivalent to '<->'.

214−instance Semigroup Image where

215− (<>) = vertJoin

216−

217−-- | Append in the 'Monoid' instance is equivalent to '<->'.

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

218236instance Monoid Image where

219237 mempty = EmptyImage

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

221− mappend = (<>)

222−#endif

238+ mappend = vertJoin

223239

224240-- | combines two images side by side

225241--

226−-- Combines text chunks where possible. Assures outputWidth and

227−-- outputHeight properties are not violated.

242+-- Combines text chunks where possible. Assures outputWidth and outputHeight properties are not

243+-- violated.

244+--

245+-- The result image will have a width equal to the sum of the two images width. And the height will

246+-- equal the largest height of the two images. The area not defined in one image due to a height

247+-- missmatch will be filled with the background pattern.

228248--

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.

249+-- TODO: the bg fill is biased towards top to bottom languages(?)

233250horizJoin :: Image -> Image -> Image

234251horizJoin EmptyImage i = i

235252horizJoin i EmptyImage = i

236253horizJoin i0@(HorizText a0 t0 w0 cw0) i1@(HorizText a1 t1 w1 cw1)

237254 | a0 == a1 = HorizText a0 (TL.append t0 t1) (w0 + w1) (cw0 + cw1)

238− -- assumes horiz text height is always 1

255+ -- TODO: assumes horiz text height is always 1

239256 | otherwise = HorizJoin i0 i1 (w0 + w1) 1

240257horizJoin i0 i1

241258 -- If the images are of the same height then no padding is required

@@ -257,19 +274,19 @@ horizJoin _ _ = error "horizJoin applied to undefined values."

257274

258275-- | combines two images vertically

259276--

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.

277+-- The result image will have a height equal to the sum of the heights of both images.

278+-- The width will equal the largest width of the two images.

279+-- The area not defined in one image due to a width missmatch will be filled with the background

280+-- pattern.

281+--

282+-- TODO: the bg fill is biased towards right to left languages(?)

264283vertJoin :: Image -> Image -> Image

265284vertJoin EmptyImage i = i

266285vertJoin i EmptyImage = i

267286vertJoin i0 i1

268− -- If the images are of the same width then no background padding is

269− -- required

287+ -- If the images are of the same width then no background padding is required

270288 | w0 == w1 = VertJoin i0 i1 w0 h

271− -- Otherwise one of the images needs to be padded to the size of the

272− -- other image.

289+ -- Otherwise one of the images needs to be padded to the size of the other image.

273290 | w0 < w1

274291 = let padAmount = w1 - w0

275292 in VertJoin (HorizJoin i0 (BGFill padAmount h0) w1 h0) i1 w1 h

@@ -283,3 +300,4 @@ vertJoin i0 i1

283300 h1 = imageHeight i1

284301 h = h0 + h1

285302vertJoin _ _ = error "vertJoin applied to undefined values."

303+

src/Graphics/Vty/Inline.hs+55−62

@@ -1,41 +1,45 @@

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.

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.

43--

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.

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.

87--

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.

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.

1210--

1311-- @

1412-- putStr \"Not styled. \"

1513-- putAttrChange_ $ do

16−-- backColor red

14+-- backColor red

1715-- applyStyle underline

1816-- putStr \" Styled! \"

1917-- putAttrChange_ $ defaultAll

2018-- putStrLn \"Not styled.\"

2119-- @

2220--

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

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'

2825--

30−module Graphics.Vty.Inline

31− ( module Graphics.Vty.Inline

32− , withVty

33− )

34−where

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

3538

3639import Graphics.Vty

3740import Graphics.Vty.DisplayAttributes

3841import Graphics.Vty.Inline.Unsafe

42+import Graphics.Vty.Output.Interface

3943

4044import Blaze.ByteString.Builder (writeToByteString)

4145

@@ -46,55 +50,44 @@ import Data.IORef

4650

4751import System.IO

4852

49−type InlineM v = State InlineState v

53+#if !(MIN_VERSION_base(4,8,0))

54+import Control.Applicative

55+import Data.Monoid ( mappend )

56+#endif

5057

51−data InlineState =

52− InlineState { inlineAttr :: Attr

53− , inlineUrlsEnabled :: Bool

54− }

58+type InlineM v = State Attr v

5559

56−-- | Set the background color to the provided 'Color'.

60+-- | Set the background color to the provided 'Color'

5761backColor :: Color -> InlineM ()

58−backColor c = modify $ \s ->

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

60− }

62+backColor c = modify $ flip mappend ( currentAttr `withBackColor` c )

6163

62−-- | Set the foreground color to the provided 'Color'.

64+-- | Set the foreground color to the provided 'Color'

6365foreColor :: Color -> InlineM ()

64−foreColor c = modify $ \s ->

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

66− }

66+foreColor c = modify $ flip mappend ( currentAttr `withForeColor` c )

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 then no error is

71−-- produced. The style can still be removed.

70+-- If the terminal does not support the style change no error is produced. The style can still be

71+-- removed.

7272applyStyle :: Style -> InlineM ()

73−applyStyle st = modify $ \s ->

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

75− }

73+applyStyle s = modify $ flip mappend ( currentAttr `withStyle` s )

7674

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

78−-- following text.

75+-- | Attempt to remove the specified 'Style' from the display of the following text.

7976--

80−-- This will fail if 'applyStyle' for the given style has not been

81−-- previously called.

77+-- This will fail if applyStyle for the given style has not been previously called.

8278removeStyle :: Style -> InlineM ()

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.

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

9387defaultAll :: InlineM ()

94−defaultAll = modify $ \s -> s { inlineAttr = defAttr }

88+defaultAll = put defAttr

9589

96−-- | Apply the provided display attribute changes to the given terminal

97−-- output device.

90+-- | Apply the provided display attribute changes to the given terminal output device.

9891--

9992-- This does not flush the terminal.

10093putAttrChange :: ( Applicative m, MonadIO m ) => Output -> InlineM () -> m ()

@@ -104,19 +97,19 @@ putAttrChange out c = liftIO $ do

10497 mfattr <- prevFattr <$> readIORef (assumedStateRef out)

10598 fattr <- case mfattr of

10699 Nothing -> do

107− liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc False

108− return $ FixedAttr defaultStyleMask Nothing Nothing Nothing

100+ liftIO $ outputByteBuffer out $ writeToByteString $ writeDefaultAttr dc

101+ return $ FixedAttr defaultStyleMask Nothing Nothing

109102 Just v -> return v

110− let InlineState attr urlsEnabled = execState c (InlineState currentAttr False)

103+ let attr = execState c currentAttr

111104 attr' = limitAttrForDisplay out attr

112105 fattr' = fixDisplayAttr fattr attr'

113106 diffs = displayAttrDiffs fattr fattr'

114− outputByteBuffer out $ writeToByteString $ writeSetAttr dc urlsEnabled fattr attr' diffs

107+ outputByteBuffer out $ writeToByteString $ writeSetAttr dc fattr attr' diffs

115108 modifyIORef (assumedStateRef out) $ \s -> s { prevFattr = Just fattr' }

116109 inlineHack dc

117110

118−-- | Apply the provided display attributes changes to the terminal

119−-- output device.

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.

120113--

121114-- This will flush the terminal output.

122115putAttrChange_ :: ( Applicative m, MonadIO m ) => InlineM () -> m ()

src/Graphics/Vty/Inline/Unsafe.hs+14−4

@@ -1,9 +1,16 @@

1+{-# LANGUAGE CPP #-}

12{-# OPTIONS_HADDOCK hide #-}

23

4+#ifndef MIN_VERSION_base

5+#defined MIN_VERSION_base(x,y,z) 1

6+#endif

7+

38module Graphics.Vty.Inline.Unsafe where

49

510import Graphics.Vty

611

12+import Data.Default

13+import Data.Monoid

714import Data.IORef

815

916import GHC.IO.Handle (hDuplicate)

@@ -14,6 +21,10 @@ import System.IO.Unsafe

1421

1522import System.Posix.IO (handleToFd)

1623

24+#if !(MIN_VERSION_base(4,8,0))

25+import Control.Applicative

26+#endif

27+

1728globalVty :: IORef (Maybe Vty)

1829{-# NOINLINE globalVty #-}

1930globalVty = unsafePerformIO $ newIORef Nothing

@@ -28,11 +39,10 @@ mkDupeConfig = do

2839 hSetBuffering stdin NoBuffering

2940 stdinDupe <- hDuplicate stdin >>= handleToFd

3041 stdoutDupe <- hDuplicate stdout >>= handleToFd

31− return $ defaultConfig { inputFd = Just stdinDupe, outputFd = Just stdoutDupe }

42+ return $ def { inputFd = Just stdinDupe, outputFd = Just stdoutDupe }

3243

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

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

3646--

3747-- This instance will use duplicates of the stdin and stdout Handles.

3848withVty :: (Vty -> IO b) -> IO b

src/Graphics/Vty/Input.hs+127−97

@@ -1,125 +1,135 @@

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

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE RecordWildCards #-}

23

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.

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.

1418--

1519-- = VTY's Implementation

1620--

21+-- One can get the brain rot trying to understand all this. So, as far as I can care...

22+--

1723-- There are two input modes:

1824--

19−-- 1. 7-bit

25+-- 1. 7 bit

2026--

21−-- 2. 8-bit

27+-- 2. 8 bit

2228--

23−-- The 7-bit input mode is the default and the expected mode in most use

24−-- cases. This is what Vty uses.

29+-- 7 bit input is the default and the expected in most use cases. This is what vty uses.

2530--

26−-- == 7-bit input encoding

31+-- == 7 bit input encoding

2732--

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,

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:

3538--

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.

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.

3841--

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.

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.

4144--

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.

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.

4447--

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.

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.

4850--

49−-- == 8-bit encoding

51+-- == 8 bit encoding

5052--

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.

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.

5657--

5758-- == Escaped Control Keys

5859--

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.

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.

6262--

63−-- 1. @ESC@ individually: @ESC@ byte; no bytes following for a period of

64−-- 'VMIN' milliseconds.

63+-- 1. @ESC@ individually: @ESC@ byte; no bytes for 'singleEscPeriod'.

6564--

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.

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.

6968--

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.

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.

7476--

7577-- == Unicode Input and Escaped Control Key Sequences

7678--

77−-- The input encoding determines how UTF-8 encoded characters are

78−-- recognized.

79+-- The input encoding determines how UTF-8 encoded characters are recognize.

7980--

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

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

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

86−-- require using the timing of input bytes to differentiate the escape

87−-- key. Many terminals do not support 8-bit mode.

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.

8887--

8988-- == Terminfo

9089--

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

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

9593--

9694-- == Terminal Input is Broken

9795--

98−-- Clearly terminal input has fundamental issues. There is no easy way

99−-- to reliably resolve these issues.

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.

100109--

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.

110+-- == Terminal Output is Also Broken

105111--

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.

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.

110118--

111119-- == See also

112120--

113121-- * http://www.leonerd.org.uk/hacks/fixterms/

114−module Graphics.Vty.Input

115− ( Key(..)

116− , Modifier(..)

117− , Button(..)

118− , Event(..)

119− , Input(..)

120− , inputForConfig

121− )

122−where

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

123133

124134import Graphics.Vty.Config

125135import Graphics.Vty.Input.Events

@@ -132,19 +142,42 @@ import Lens.Micro

132142import qualified System.Console.Terminfo as Terminfo

133143import System.Posix.Signals.Exts

134144

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

145+#if !(MIN_VERSION_base(4,8,0))

146+import Data.Functor ((<$>))

147+import Data.Monoid

148+#else

136149import Data.Monoid ((<>))

137150#endif

138151

139−-- | Set up the terminal with file descriptor `inputFd` for input.

140−-- Returns an 'Input'.

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.

141171--

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

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.

145180--

146−-- The terminal device's mode flags are configured by the

147−-- 'attributeControl' function.

148181inputForConfig :: Config -> IO Input

149182inputForConfig config@Config{ termName = Just termName

150183 , inputFd = Just termFd

@@ -154,23 +187,20 @@ inputForConfig config@Config{ termName = Just termName

154187 terminal <- Terminfo.setupTerm termName

155188 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]

156189 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides

157− (setAttrs, unsetAttrs) <- attributeControl termFd

190+ (setAttrs,unsetAttrs) <- attributeControl termFd

158191 setAttrs

159192 input <- initInput config activeInputMap

160193 let pokeIO = Catch $ do

194+ let e = error "vty internal failure: this value should not propagate to users"

161195 setAttrs

162− atomically $ writeTChan (input^.eventChannel) ResumeAfterSignal

196+ atomically $ writeTChan (input^.eventChannel) (EvResize e e)

163197 _ <- installHandler windowChange pokeIO Nothing

164198 _ <- installHandler continueProcess pokeIO Nothing

165−

166− let restore = unsetAttrs

167−

168199 return $ input

169200 { shutdownInput = do

170201 shutdownInput input

171202 _ <- installHandler windowChange Ignore Nothing

172203 _ <- installHandler continueProcess Ignore Nothing

173− restore

174− , restoreInputState = restoreInputState input >> restore

204+ unsetAttrs

175205 }

176206inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig

src/Graphics/Vty/Input/Classify.hs+45−69

@@ -1,108 +1,84 @@

11{-# OPTIONS_HADDOCK hide #-}

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.

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.

59module Graphics.Vty.Input.Classify

6− ( classify

7− , KClass(..)

8− , ClassifierState(..)

9− )

10−where

10+ ( classify

11+ , KClass(..)

12+ ) where

1113

1214import Graphics.Vty.Input.Events

1315import Graphics.Vty.Input.Mouse

14−import Graphics.Vty.Input.Focus

1516import Graphics.Vty.Input.Paste

1617import Graphics.Vty.Input.Classify.Types

1718

1819import Codec.Binary.UTF8.Generic (decode)

1920

20−import Control.Arrow (first)

21+import Data.List (inits)

2122import qualified Data.Map as M( fromList, lookup )

2223import Data.Maybe ( mapMaybe )

2324import qualified Data.Set as S( fromList, member )

2425

26+import Data.Char

2527import Data.Word

2628

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

29+compile :: ClassifyMap -> [Char] -> KClass

4330compile table = cl' where

4431 -- take all prefixes and create a set of these

45− prefixSet = S.fromList $ concatMap (init . BS.inits . BS8.pack . fst) table

32+ prefixSet = S.fromList $ concatMap (init . inits . fst) $ table

4633 maxValidInputLength = maximum (map (length . fst) table)

47− eventForInput = M.fromList $ map (first BS8.pack) table

48− cl' inputBlock | BS8.null inputBlock = Prefix

34+ eventForInput = M.fromList table

35+ cl' [] = Prefix

4936 cl' inputBlock = case M.lookup inputBlock eventForInput of

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

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

5340 Nothing -> case S.member inputBlock prefixSet of

5441 True -> Prefix

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.

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.

5945 -- The test verifyFullSynInputToEvent2x verifies this.

60− -- H: There will always be one match. The prefixSet

61− -- contains, by definition, all prefixes of an event.

46+ -- H: There will always be one match. The prefixSet contains, by definition, all

47+ -- prefixes of an event.

6248 False ->

63− let inputPrefixes = reverse . take maxValidInputLength . tail . BS8.inits $ inputBlock

49+ let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock

6450 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of

65− (s,e) : _ -> Valid e (BS8.drop (BS8.length s) inputBlock)

51+ (s,e) : _ -> Valid e (drop (length s) inputBlock)

6652 -- neither a prefix or a full event.

53+ -- TODO: debug log

6754 [] -> Invalid

6855

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 =

56+classify :: ClassifyMap -> [Char] -> KClass

57+classify table =

58+ let standardClassifier = compile table

59+ in \s -> case s of

60+ _ | bracketedPasteStarted s ->

8661 if bracketedPasteFinished s

87− then parseBracketedPaste $ BS.concat $ p:reverse (s:ps)

88− else Chunk

89− process ClassifierInChunk{} _ = Invalid

62+ then parseBracketedPaste s

63+ else Prefix

64+ _ | isMouseEvent s -> classifyMouseEvent s

65+ c:cs | ord c >= 0xC2 -> classifyUtf8 c cs

66+ _ -> standardClassifier s

9067

91−classifyUtf8 :: Word8 -> ByteString -> KClass

68+classifyUtf8 :: Char -> [Char] -> KClass

9269classifyUtf8 c cs =

93− let n = utf8Length c

94− (codepoint,rest) = BS8.splitAt (n - 1) cs

70+ let n = utf8Length (ord c)

71+ (codepoint,rest) = splitAt n (c:cs)

9572

9673 codepoint8 :: [Word8]

97− codepoint8 = c:BS.unpack codepoint

74+ codepoint8 = map (fromIntegral . ord) codepoint

9875

9976 in case decode codepoint8 of

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

77+ _ | n < length codepoint -> Prefix

78+ Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest

79+ Nothing -> Invalid -- something bad happened; just ignore and continue.

10480

105−utf8Length :: Word8 -> Int

81+utf8Length :: (Num t, Ord a, Num a) => a -> t

10682utf8Length c

10783 | c < 0x80 = 1

10884 | c < 0xE0 = 2

src/Graphics/Vty/Input/Classify/Parse.hs+14−18

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

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

11−where

4+ ( Parser

5+ , runParser

6+ , failParse

7+ , readInt

8+ , readChar

9+ , expectChar

10+ ) where

1211

1312import Graphics.Vty.Input.Events

1413import Graphics.Vty.Input.Classify.Types

@@ -16,15 +15,12 @@ import Graphics.Vty.Input.Classify.Types

1615import Control.Monad.Trans.Maybe

1716import Control.Monad.State

1817

19−import qualified Data.ByteString.Char8 as BS8

20−import Data.ByteString.Char8 (ByteString)

21−

22−type Parser a = MaybeT (State ByteString) a

18+type Parser a = MaybeT (State String) a

2319

2420-- | Run a parser on a given input string. If the parser fails, return

2521-- 'Invalid'. Otherwise return the valid event ('Valid') and the

2622-- remaining unparsed characters.

27−runParser :: ByteString -> Parser Event -> KClass

23+runParser :: String -> Parser Event -> KClass

2824runParser s parser =

2925 case runState (runMaybeT parser) s of

3026 (Nothing, _) -> Invalid

@@ -39,9 +35,9 @@ failParse = fail "invalid parse"

3935-- return '123' and consume those characters.

4036readInt :: Parser Int

4137readInt = do

42− s <- BS8.unpack <$> get

38+ s <- get

4339 case (reads :: ReadS Int) s of

44− [(i, rest)] -> put (BS8.pack rest) >> return i

40+ [(i, rest)] -> put rest >> return i

4541 _ -> failParse

4642

4743-- | Read a character from the input stream. If one cannot be read (e.g.

@@ -49,9 +45,9 @@ readInt = do

4945readChar :: Parser Char

5046readChar = do

5147 s <- get

52− case BS8.uncons s of

53− Just (c,rest) -> put rest >> return c

54− Nothing -> failParse

48+ case s of

49+ c:rest -> put rest >> return c

50+ _ -> failParse

5551

5652-- | Read a character from the input stream and fail parsing if it is

5753-- not the specified character.

src/Graphics/Vty/Input/Classify/Types.hs+3−10

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

11-- | This module exports the input classification type to avoid import

22-- cycles between other modules that need this.

3−{-# LANGUAGE StrictData #-}

43module Graphics.Vty.Input.Classify.Types

5− ( KClass(..)

6− )

7−where

4+ ( KClass(..)

5+ ) where

86

97import Graphics.Vty.Input.Events

108

11−import Data.ByteString.Char8 (ByteString)

12−

139data KClass

14− = Valid Event ByteString

10+ = Valid Event [Char]

1511 -- ^ A valid event was parsed. Any unused characters from the input

1612 -- stream are also provided.

1713 | Invalid

@@ -19,7 +15,4 @@ data KClass

1915 | Prefix

2016 -- ^ The input characters form the prefix of a valid event character

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

2518 deriving(Show, Eq)

src/Graphics/Vty/Input/Events.hs+14−38

@@ -1,44 +1,34 @@

11{-# Language DeriveGeneric #-}

2−{-# Language StrictData #-}

32module Graphics.Vty.Input.Events where

43

5−import Control.DeepSeq

64import Data.ByteString

75import GHC.Generics

86

97-- | Representations of non-modifier keys.

108--

11−-- * KFun is indexed from 0 to 63. Range of supported FKeys varies by

12−-- terminal and keyboard.

9+-- * KFun is indexed from 0 to 63. Range of supported FKeys varies by terminal and keyboard.

1310--

14−-- * KUpLeft, KUpRight, KDownLeft, KDownRight, KCenter support varies by

15−-- terminal and keyboard.

11+-- * KUpLeft, KUpRight, KDownLeft, KDownRight, KCenter support varies by terminal and keyboard.

1612--

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

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

2016 | KLeft | KRight | KUp | KDown

22− | KFun {-# UNPACK #-} Int | KBackTab | KPrtScr | KPause | KIns

2420 deriving (Eq,Show,Read,Ord,Generic)

2521

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.

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.

3125data Modifier = MShift | MCtrl | MMeta | MAlt

3226 deriving (Eq,Show,Read,Ord,Generic)

3327

34−instance NFData Modifier

35−

3628-- | Mouse buttons.

37−data Button = BLeft | BMiddle | BRight | BScrollUp | BScrollDown

29+data Button = BLeft | BMiddle | BRight

3830 deriving (Eq,Show,Read,Ord,Generic)

3931

40−instance NFData Button

41−

4232-- | Events.

4333data Event

4434 = EvKey Key [Modifier]

@@ -52,8 +42,10 @@ data Event

5242 -- without specifying which one; in that case, Nothing is provided.

5343 -- Otherwise Just the button released is included in the event.

5444 | EvResize Int Int

55− -- The terminal window was resized and the size is provided in the

56− -- integer fields (width, height).

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.

5749 | EvPaste ByteString

5850 -- ^ A paste event occurs when a bracketed paste input sequence is

5951 -- received. For terminals that support bracketed paste mode, these

@@ -62,22 +54,6 @@ data Event

6254 -- input (which is probably bad, so beware!) Note that the data is

6355 -- provided in raw form and you'll have to decode (e.g. as UTF-8) if

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

6957 deriving (Eq,Show,Read,Ord,Generic)

7058

71−instance NFData Event

72−

7359type 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.hsdeleted−49

@@ -1,49 +0,0 @@

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+47−109

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

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE NoMonomorphismRestriction #-}

31{-# LANGUAGE RecordWildCards #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

5−{-# LANGUAGE TemplateHaskell #-}

62{-# 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.

3+{-# LANGUAGE NoMonomorphismRestriction #-}

4+{-# 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.

129--

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

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

1612--

1713-- reference: http://www.unixwiz.net/techtips/termios-vmin-vtime.html

1814module Graphics.Vty.Input.Loop where

@@ -25,7 +21,8 @@ import Control.Applicative

2521import Control.Concurrent

2622import Control.Concurrent.STM

2723import Control.Exception (mask, try, SomeException)

28−import Lens.Micro hiding ((<>~))

24+import Data.Monoid

25+import Lens.Micro

2926import Lens.Micro.Mtl

3027import Lens.Micro.TH

3128import Control.Monad (when, mzero, forM_)

@@ -34,15 +31,12 @@ import Control.Monad.Trans.State (StateT(..), evalStateT)

3431import Control.Monad.State.Class (MonadState, modify)

3532import Control.Monad.Trans.Reader (ReaderT(..))

3633

37−import qualified Data.ByteString.Char8 as BS8

38−import qualified Data.ByteString as BS

39−import Data.ByteString.Char8 (ByteString)

34+import Data.Char

4035import Data.IORef

4136import Data.Word (Word8)

4237

43−import Foreign (allocaArray)

38+import Foreign ( allocaArray, peekArray, Ptr )

4439import Foreign.C.Types (CInt(..))

45−import Foreign.Ptr (Ptr, castPtr)

4640

4741import System.IO

4842import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))

@@ -52,18 +46,12 @@ import System.Posix.Types (Fd(..))

5246import Text.Printf (hPrintf)

5347

5448data Input = Input

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.

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.

6154 , 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 ()

6755 -- | Changes to this value are reflected after the next event.

6856 , _configRef :: IORef Config

6957 -- | input debug log

@@ -80,11 +68,10 @@ data InputBuffer = InputBuffer

8068makeLenses ''InputBuffer

8169

8270data InputState = InputState

83− { _unprocessedBytes :: ByteString

84− , _classifierState :: ClassifierState

71+ { _unprocessedBytes :: String

8572 , _appliedConfig :: Config

8673 , _inputBuffer :: InputBuffer

87− , _classifier :: ClassifierState -> ByteString -> KClass

74+ , _classifier :: String -> KClass

8875 }

8976

9077makeLenses ''InputState

@@ -99,8 +86,7 @@ logMsg msg = do

9986 Just h -> liftIO $ hPutStrLn h msg >> hFlush h

10087

10188-- this must be run on an OS thread dedicated to this input handling.

102−-- otherwise the terminal timing read behavior will block the execution

103−-- of the lightweight threads.

89+-- otherwise the terminal timing read behavior will block the execution of the lightweight threads.

10490loopInputProcessor :: InputM ()

10591loopInputProcessor = do

10692 readFromDevice >>= addBytesToProcess

@@ -109,20 +95,20 @@ loopInputProcessor = do

10995 dropInvalid

11096 loopInputProcessor

11197

112−addBytesToProcess :: ByteString -> InputM ()

98+addBytesToProcess :: String -> InputM ()

11399addBytesToProcess block = unprocessedBytes <>= block

114100

115101emit :: Event -> InputM ()

116102emit event = do

117103 logMsg $ "parsed event: " ++ show event

118− view eventChannel >>= liftIO . atomically . flip writeTChan (InputEvent event)

104+ view eventChannel >>= liftIO . atomically . flip writeTChan event

119105

120−-- The timing requirements are assured by the VMIN and VTIME set for the

121−-- device.

106+-- The timing requirements are assured by the VMIN and VTIME set for the device.

122107--

123−-- Precondition: Under the threaded runtime. Only current use is from a

124−-- forkOS thread. That case satisfies precondition.

125−readFromDevice :: InputM ByteString

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

126112readFromDevice = do

127113 newConfig <- view configRef >>= liftIO . readIORef

128114 oldConfig <- use appliedConfig

@@ -134,18 +120,16 @@ readFromDevice = do

134120 bufferPtr <- use $ inputBuffer.ptr

135121 maxBytes <- use $ inputBuffer.size

136122 stringRep <- liftIO $ do

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.

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.

142127 threadWaitRead fd

143128 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)

144129 if bytesRead > 0

145− then BS.packCStringLen (castPtr bufferPtr, fromIntegral bytesRead)

146− else return BS.empty

147− when (not $ BS.null stringRep) $

148− logMsg $ "input bytes: " ++ show (BS8.unpack stringRep)

130+ then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr

131+ else return []

132+ when (not $ null stringRep) $ logMsg $ "input bytes: " ++ show stringRep

149133 return stringRep

150134

151135applyConfig :: Fd -> Config -> IO ()

@@ -156,86 +140,41 @@ applyConfig _ _ = fail "(vty) applyConfig was not provided a complete configurat

156140parseEvent :: InputM Event

157141parseEvent = do

158142 c <- use classifier

159− s <- use classifierState

160143 b <- use unprocessedBytes

161− case c s b of

144+ case c b of

162145 Valid e remaining -> do

163146 logMsg $ "valid parse: " ++ show e

164147 logMsg $ "remaining: " ++ show remaining

165− classifierState .= ClassifierStart

166148 unprocessedBytes .= remaining

167149 return e

168− _ -> mzero

150+ _ -> mzero

169151

170152dropInvalid :: InputM ()

171153dropInvalid = do

172154 c <- use classifier

173− s <- use classifierState

174155 b <- use unprocessedBytes

175− case c s b of

176− Chunk -> do

177− classifierState .=

178− case s of

179− ClassifierStart -> ClassifierInChunk b []

180− ClassifierInChunk p bs -> ClassifierInChunk p (b:bs)

181− unprocessedBytes .= BS8.empty

182− Invalid -> do

183− logMsg "dropping input bytes"

184− classifierState .= ClassifierStart

185− unprocessedBytes .= BS8.empty

186− _ -> return ()

156+ when (c b == Invalid) $ do

157+ logMsg "dropping input bytes"

158+ unprocessedBytes .= []

187159

188160runInputProcessorLoop :: ClassifyMap -> Input -> IO ()

189161runInputProcessorLoop classifyTable input = do

190162 let bufferSize = 1024

191163 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do

192− s0 <- InputState BS8.empty ClassifierStart

193− <$> readIORef (_configRef input)

194− <*> pure (InputBuffer bufferPtr bufferSize)

195− <*> pure (classify classifyTable)

164+ s0 <- InputState [] <$> readIORef (_configRef input)

165+ <*> pure (InputBuffer bufferPtr bufferSize)

166+ <*> pure (classify classifyTable)

196167 runReaderT (evalStateT loopInputProcessor s0) input

197168

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)

223169attributeControl :: Fd -> IO (IO (), IO ())

224170attributeControl fd = do

225171 original <- getTerminalAttributes fd

226− let vtyMode = foldl withMode clearedFlags flagsToSet

227− clearedFlags = foldl withoutMode original flagsToUnset

228− flagsToSet = [ MapCRtoLF -- ICRNL

229− ]

230− flagsToUnset = [ StartStopOutput -- IXON

231− , KeyboardInterrupts -- ISIG

232− , EnableEcho -- ECHO

233− , ProcessInput -- ICANON

234− , ExtendedFunctions -- IEXTEN

235− ]

172+ let vtyMode = foldl withoutMode original [ StartStopOutput, KeyboardInterrupts

173+ , EnableEcho, ProcessInput, ExtendedFunctions

174+ ]

236175 let setAttrs = setTerminalAttributes fd vtyMode Immediately

237176 unsetAttrs = setTerminalAttributes fd original Immediately

238− return (setAttrs, unsetAttrs)

177+ return (setAttrs,unsetAttrs)

239178

240179logInitialInputState :: Input -> ClassifyMap -> IO()

241180logInitialInputState input classifyTable = case _inputDebug input of

@@ -243,7 +182,7 @@ logInitialInputState input classifyTable = case _inputDebug input of

243182 Just h -> do

244183 Config{ vmin = Just theVmin

245184 , vtime = Just theVtime

246− , termName = Just theTerm } <- readIORef $ _configRef input

185+ , termName = Just theTerm, .. } <- readIORef $ _configRef input

247186 _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))

248187 forM_ classifyTable $ \i -> case i of

249188 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)

@@ -259,7 +198,6 @@ initInput config classifyTable = do

259198 applyConfig fd config

260199 stopSync <- newEmptyMVar

261200 input <- Input <$> atomically newTChan

262− <*> pure (return ())

263201 <*> pure (return ())

264202 <*> newIORef config

265203 <*> maybe (return Nothing)

src/Graphics/Vty/Input/Mouse.hs+27−38

@@ -3,24 +3,21 @@

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

11−where

6+ ( requestMouseEvents

7+ , disableMouseEvents

8+ , isMouseEvent

9+ , classifyMouseEvent

10+ ) where

1211

1312import Graphics.Vty.Input.Events

1413import Graphics.Vty.Input.Classify.Types

1514import Graphics.Vty.Input.Classify.Parse

1615

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

2421-- A mouse event in SGR extended mode is

2522--

2623-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')

@@ -34,28 +31,28 @@ import Data.ByteString.Char8 (ByteString)

3431

3532-- | These sequences set xterm-based terminals to send mouse event

3633-- sequences.

37−requestMouseEvents :: ByteString

38−requestMouseEvents = BS8.pack "\ESC[?1000h\ESC[?1002h\ESC[?1006h"

34+requestMouseEvents :: String

35+requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h\ESC[?1005h"

3936

4037-- | These sequences disable mouse events.

41−disableMouseEvents :: ByteString

42−disableMouseEvents = BS8.pack "\ESC[?1000l\ESC[?1002l\ESC[?1006l"

38+disableMouseEvents :: String

39+disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l\ESC[?1005l"

4340

4441-- | Does the specified string begin with a mouse event?

45−isMouseEvent :: ByteString -> Bool

42+isMouseEvent :: String -> Bool

4643isMouseEvent s = isSGREvent s || isNormalEvent s

4744

48−isSGREvent :: ByteString -> Bool

49−isSGREvent = BS8.isPrefixOf sgrPrefix

45+isSGREvent :: String -> Bool

46+isSGREvent = isPrefixOf sgrPrefix

5047

51−sgrPrefix :: ByteString

52−sgrPrefix = BS8.pack "\ESC[M"

48+sgrPrefix :: String

49+sgrPrefix = "\ESC[M"

5350

54−isNormalEvent :: ByteString -> Bool

55−isNormalEvent = BS8.isPrefixOf normalPrefix

51+isNormalEvent :: String -> Bool

52+isNormalEvent = isPrefixOf normalPrefix

5653

57−normalPrefix :: ByteString

58−normalPrefix = BS8.pack "\ESC[<"

54+normalPrefix :: String

55+normalPrefix = "\ESC[<"

5956

6057-- Modifier bits:

6158shiftBit :: Int

@@ -69,7 +66,7 @@ ctrlBit = 16

6966

7067-- These bits indicate the buttons involved:

7168buttonMask :: Int

72−buttonMask = 67

69+buttonMask = 3

7370

7471leftButton :: Int

7572leftButton = 0

@@ -80,17 +77,11 @@ middleButton = 1

8077rightButton :: Int

8178rightButton = 2

8279

83−scrollUp :: Int

84−scrollUp = 64

85−

86−scrollDown :: Int

87−scrollDown = 65

88−

8980hasBitSet :: Int -> Int -> Bool

9081hasBitSet val bit = val .&. bit > 0

9182

92−-- | Attempt to classify an input string as a mouse event.

93−classifyMouseEvent :: ByteString -> KClass

83+-- | Attempt to lassify an input string as a mouse event.

84+classifyMouseEvent :: String -> KClass

9485classifyMouseEvent s = runParser s $ do

9586 when (not $ isMouseEvent s) failParse

9687

@@ -102,14 +93,12 @@ classifyMouseEvent s = runParser s $ do

10293 'M' -> classifyNormalMouseEvent

10394 _ -> failParse

10495

105−-- Given a modifier/button value, determine which button was indicated

96+-- Given a modifer/button value, determine which button was indicated

10697getSGRButton :: Int -> Parser Button

10798getSGRButton mods =

10899 let buttonMap = [ (leftButton, BLeft)

109100 , (middleButton, BMiddle)

110101 , (rightButton, BRight)

111− , (scrollUp, BScrollUp)

112− , (scrollDown, BScrollDown)

113102 ]

114103 in case lookup (mods .&. buttonMask) buttonMap of

115104 Nothing -> failParse

@@ -140,8 +129,8 @@ classifyNormalMouseEvent = do

140129 case press of

141130 True -> do

142131 button <- getSGRButton status

143− return $ EvMouseDown (xCoord-1) (yCoord-1) button modifiers

144− False -> return $ EvMouseUp (xCoord-1) (yCoord-1) Nothing

132+ return $ EvMouseDown xCoord yCoord button modifiers

133+ False -> return $ EvMouseUp xCoord yCoord Nothing

145134

146135-- Attempt to classify a control sequence as an SGR mouse event. To

147136-- get here we should have already read "\ESC[<" so that will not be

@@ -158,6 +147,6 @@ classifySGRMouseEvent = do

158147 let modifiers = getModifiers mods

159148 button <- getSGRButton mods

160149 case final of

161− 'M' -> return $ EvMouseDown (xCoord-1) (yCoord-1) button modifiers

162− 'm' -> return $ EvMouseUp (xCoord-1) (yCoord-1) (Just button)

150+ 'M' -> return $ EvMouseDown xCoord yCoord button modifiers

151+ 'm' -> return $ EvMouseUp xCoord yCoord (Just button)

163152 _ -> failParse

src/Graphics/Vty/Input/Paste.hs+28−21

@@ -2,40 +2,47 @@

22--

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

44module Graphics.Vty.Input.Paste

5− ( parseBracketedPaste

6− , bracketedPasteStarted

7− , bracketedPasteFinished

8− )

9−where

5+ ( parseBracketedPaste

6+ , bracketedPasteStarted

7+ , bracketedPasteFinished

8+ ) where

109

1110import qualified Data.ByteString.Char8 as BS8

12−import Data.ByteString.Char8 (ByteString)

1311

1412import Graphics.Vty.Input.Events

1513import Graphics.Vty.Input.Classify.Types

1614

17−bracketedPasteStart :: ByteString

18−bracketedPasteStart = BS8.pack "\ESC[200~"

15+import Data.List (isPrefixOf, isInfixOf)

1916

20−bracketedPasteEnd :: ByteString

21−bracketedPasteEnd = BS8.pack "\ESC[201~"

17+bracketedPasteStart :: String

18+bracketedPasteStart = "\ESC[200~"

19+

20+bracketedPasteEnd :: String

21+bracketedPasteEnd = "\ESC[201~"

2222

2323-- | Does the input start a bracketed paste?

24−bracketedPasteStarted :: ByteString -> Bool

25−bracketedPasteStarted = BS8.isPrefixOf bracketedPasteStart

24+bracketedPasteStarted :: String -> Bool

25+bracketedPasteStarted = isPrefixOf bracketedPasteStart

2626

2727-- | Does the input contain a complete bracketed paste?

28−bracketedPasteFinished :: ByteString -> Bool

29−bracketedPasteFinished = BS8.isInfixOf bracketedPasteEnd

28+bracketedPasteFinished :: String -> Bool

29+bracketedPasteFinished = 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 :: ByteString -> KClass

34+parseBracketedPaste :: String -> KClass

3535parseBracketedPaste s =

36− Valid (EvPaste p) (BS8.drop endLen rest')

37− where

38− startLen = BS8.length bracketedPasteStart

39− endLen = BS8.length bracketedPasteEnd

40− (_, rest ) = BS8.breakSubstring bracketedPasteStart s

41− (p, rest') = BS8.breakSubstring bracketedPasteEnd . BS8.drop startLen $ rest

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)

src/Graphics/Vty/Input/Terminfo.hs+33−34

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

11−-- then adds on a terminal-dependent input sequence mapping.

10+-- | queries the terminal for all capability based input sequences then adds on a terminal dependent

11+-- 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−-- 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.

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.

2626--

27−-- The procedure used here is:

27+-- 1. build terminfo table for all caps. Missing caps are not added.

2828--

29−-- 1. Build terminfo table for all caps. Missing caps are not added.

29+-- 2. add tables for visible chars, esc, del plus ctrl and meta

3030--

31−-- 2. Add tables for visible chars, esc, del, ctrl, and meta.

31+-- 3. add internally defined table for given terminal type.

3232--

33−-- 3. Add internally-defined table for given terminal type.

33+-- Precedence is currently implicit in the 'compile' algorithm. Which is a bit odd.

3434--

35−-- Precedence is currently implicit in the 'compile' algorithm.

35+-- \todo terminfo meta is not supported.

36+-- \todo no 8bit

3637classifyMapForTerm :: String -> Terminal -> ClassifyMap

3738classifyMapForTerm termName term =

3839 concat $ capsClassifyMap term keysFromCapsTable

3940 : universalTable

4041 : termSpecificTables termName

4142

42−-- | The key table applicable to all terminals.

43+-- | key table applicable to all terminals.

4344--

44−-- Note that some of these entries are probably only applicable to

45−-- ANSI/VT100 terminals.

45+-- TODO: some probably only applicable to 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

54−-- terminfo.

53+-- | tables specific to a given terminal that are not derivable from terminfo.

5554--

56−-- Note that this adds the ANSI/VT100/VT50 tables regardless of term

57−-- identifier.

55+-- TODO: Adds the ANSI/VT100/VT50 tables regardless of term identifier.

5856termSpecificTables :: String -> [ClassifyMap]

5957termSpecificTables _termName = ANSIVT.classifyTable

6058

6159-- | Visible characters in the ISO-8859-1 and UTF-8 common set.

6260--

63−-- We limit to < 0xC1. The UTF8 sequence detector will catch all values

64−-- 0xC2 and above before this classify table is reached.

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'

6566visibleChars :: ClassifyMap

6667visibleChars = [ ([x], EvKey (KChar x) [])

6768 | x <- [' ' .. toEnum 0xC1]

6869 ]

6970

70−-- | Non-printable characters in the ISO-8859-1 and UTF-8 common set

71−-- translated to ctrl + char.

71+-- | Non visible characters in the ISO-8859-1 and UTF-8 common set translated to ctrl + char.

7272--

73−-- This treats CTRL-i the same as tab.

73+-- \todo resolve CTRL-i is 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,23 +83,22 @@ 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− [ ("\ESC\ESC[5~",EvKey KPageUp [MMeta])

90− , ("\ESC\ESC[6~",EvKey KPageDown [MMeta])

91− -- special support for ESC

92− , ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

89+ [ -- special support for ESC

90+ ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])

9391 -- Special support for backspace

94− , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta]), ("\b",EvKey KBS [])

92+ , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])

9593 -- Special support for Enter

9694 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])

9795 -- explicit support for tab

9896 , ("\t", EvKey (KChar '\t') [])

9997 ]

10098

101−-- | A classification table directly generated from terminfo cap

102−-- strings. These are:

99+-- | classify table directly generated from terminfo cap strings

100+--

101+-- these are:

103102--

104103-- * ka1 - keypad up-left

105104--

@@ -114,7 +113,7 @@ specialSupportKeys =

114113-- * kcbt - back tab

115114--

116115-- * kc1 - keypad left-down

117−--

116+--

118117-- * kc3 - keypad right-down

119118--

120119-- * kdch1 - delete

@@ -122,7 +121,7 @@ specialSupportKeys =

122121-- * kcud1 - down

123122--

124123-- * kend - end

125−--

124+--

126125-- * kent - enter

127126--

128127-- * kf0 - kf63 - function keys

@@ -181,6 +180,6 @@ keysFromCapsTable =

181180 , ("kcuu1", EvKey KUp [])

182181 ] ++ functionKeyCapsTable

183182

184−-- | Cap names for function keys.

183+-- | cap names for function keys

185184functionKeyCapsTable :: ClassifyMap

186185functionKeyCapsTable = flip map [0..63] $ \n -> ("kf" ++ show n, EvKey (KFun n) [])

src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+20−21

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

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.

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.

86module Graphics.Vty.Input.Terminfo.ANSIVT where

97

108import Graphics.Vty.Input.Events

119

1210-- | 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,10 +30,8 @@ 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− -- 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)]

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

3735 ]

3836

3937-- | encoding for ins, del, pageup, pagedown, home, end

@@ -51,26 +49,26 @@ navKeys3 =

5149 [KIns,KDel,KPageUp,KPageDown,KHome,KEnd]

5250

5351-- | encoding for shift plus function keys

54−--

55−-- According to

52+--

53+-- According to

5654--

5755-- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html

5856--

5957-- This encoding depends on the terminal.

6058functionKeys1 :: ClassifyMap

6159functionKeys1 =

62− let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-head nrs+ff) m) | n <- nrs ] in

60+ let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in

6361 concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]

6462

6563-- | encoding for meta plus char

6664--

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.

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.

7472functionKeys2 :: ClassifyMap

7573functionKeys2 = [ ('\ESC':[x],EvKey (KChar x) [MMeta])

7674 | x <- '\t':[' ' .. '~']

@@ -86,3 +84,4 @@ classifyTable =

8684 , functionKeys1

8785 , functionKeys2

8886 ]

87+

src/Graphics/Vty/Output.hs+52−53

@@ -1,69 +1,70 @@

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

2−-- | This module provides functions for accessing the current terminal

3−-- or a specific terminal device.

1+{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE NamedFieldPuns #-}

3+-- | Output interface.

44--

5−-- See also:

5+-- Access to the current terminal or a specific terminal device.

66--

7−-- 1. "Graphics.Vty.Output": This instantiates an abtract interface

8−-- to the terminal based on the @TERM@ and @COLORTERM@ environment

9−-- variables.

7+-- See also:

108--

11−-- 2. "Graphics.Vty.Output.Interface": Defines the generic interface all

12−-- terminal modules need to implement.

9+-- 1. "Graphics.Vty.Output": This instantiates an abtract interface to the terminal interface based

10+-- on the TERM and COLORTERM environment variables.

1311--

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.

12+-- 2. "Graphics.Vty.Output.Interface": Defines the generic interface all terminals need to implement.

1713--

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

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

2929

30−import Control.Monad (when)

30+import Graphics.Vty.Prelude

3131

3232import Graphics.Vty.Config

33−import Graphics.Vty.Image (regionWidth, regionHeight)

33+

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 Data.List (isPrefixOf)

40+import Control.Monad.Trans

4141

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

42+import Data.List (isPrefixOf)

4343import Data.Monoid ((<>))

44−#endif

4544

46−-- | Returns an `Output` for the terminal specified in `Config`.

45+-- | Returns a `Output` for the terminal specified in `Config`

4746--

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.

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.

5250--

53−-- If a terminal implementation is developed for a terminal without

54−-- terminfo support then Vty should work as expected on that terminal.

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.

5554--

5655-- Selection of a terminal is done as follows:

5756--

5857-- * If TERM contains "xterm" or "screen", use XTermColor.

5958-- * 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

6062outputForConfig :: Config -> IO Output

61−outputForConfig Config{ outputFd = Just fd, termName = Just termName

62− , colorMode = Just colorMode, .. } = do

63+outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do

6364 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName

64− then XTermColor.reserveTerminal termName fd colorMode

65+ then XTermColor.reserveTerminal termName fd

6566 -- Not an xterm-like terminal. try for generic terminfo.

66− else TerminfoBased.reserveTerminal termName fd colorMode

67+ else TerminfoBased.reserveTerminal termName fd

6768

6869 case mouseMode of

6970 Just s -> setMode t Mouse s

@@ -78,30 +79,28 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig

7879

7980-- | Sets the cursor position to the given output column and row.

8081--

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.

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.

8484--

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

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

8988setCursorPos t x y = do

9089 bounds <- displayBounds t

9190 when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do

9291 dc <- displayContext t bounds

93− outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

92+ liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y

9493

95−-- | Hides the cursor.

96−hideCursor :: Output -> IO ()

94+-- | Hides the cursor

95+hideCursor :: MonadIO m => Output -> m ()

9796hideCursor t = do

9897 bounds <- displayBounds t

9998 dc <- displayContext t bounds

100− outputByteBuffer t $ writeToByteString $ writeHideCursor dc

99+ liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc

101100

102−-- | Shows the cursor.

103−showCursor :: Output -> IO ()

101+-- | Shows the cursor

102+showCursor :: MonadIO m => Output -> m ()

104103showCursor t = do

105104 bounds <- displayBounds t

106105 dc <- displayContext t bounds

107− outputByteBuffer t $ writeToByteString $ writeShowCursor dc

106+ liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc

src/Graphics/Vty/Output/Interface.hs+132−176

@@ -1,25 +1,21 @@

11-- Copyright Corey O'Connor

2+-- General philosophy is: MonadIO is for equations exposed to clients.

3+{-# LANGUAGE CPP #-}

4+{-# LANGUAGE BangPatterns #-}

25{-# LANGUAGE RankNTypes #-}

36{-# LANGUAGE ExistentialQuantification #-}

47{-# LANGUAGE GADTs #-}

58{-# LANGUAGE FlexibleContexts #-}

6−{-# LANGUAGE ScopedTypeVariables #-}

7−-- | This module provides an abstract interface for performing terminal

8−-- output. The only user-facing part of this API is 'Output'.

9+

10+#ifndef MIN_VERSION_base

11+#defined MIN_VERSION_base(x,y,z) 1

12+#endif

13+

914module Graphics.Vty.Output.Interface

10− ( Output(..)

11− , AssumedState(..)

12− , DisplayContext(..)

13− , Mode(..)

14− , displayContext

15− , outputPicture

16− , initialAssumedState

17− , limitAttrForDisplay

18− )

1915where

2016

21−import Graphics.Vty.Attributes

22−import Graphics.Vty.Image (DisplayRegion, regionHeight)

17+import Graphics.Vty.Prelude

18+

2319import Graphics.Vty.Picture

2420import Graphics.Vty.PictureToSpans

2521import Graphics.Vty.Span

@@ -29,97 +25,72 @@ import Graphics.Vty.DisplayAttributes

2925import Blaze.ByteString.Builder (Write, writeToByteString)

3026import Blaze.ByteString.Builder.ByteString (writeByteString)

3127

28+import Control.Monad.Trans

29+

3230import qualified Data.ByteString as BS

3331import Data.IORef

3432import qualified Data.Text.Encoding as T

3533import qualified Data.Text.Lazy as TL

3634import qualified Data.Vector as Vector

3735

36+#if !(MIN_VERSION_base(4,8,0))

37+import Data.Monoid (mempty, mappend)

38+#endif

39+

3840-- | Modal terminal features that can be enabled and disabled.

3941data 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.

5443 deriving (Eq, Read, Show)

5544

56−-- | The Vty terminal output interface.

5745data Output = Output

58− { -- | Text identifier for the output device. Used for debugging.

46+ { -- | Text identifier for the output device. Used for debugging.

5947 terminalID :: String

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.

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.

8170 , outputByteBuffer :: BS.ByteString -> IO ()

82− -- | Specifies whether the cursor can be shown / hidden.

71+ -- | Maximum number of colors supported by the context.

72+ , contextColorCount :: Int

73+ -- | if the cursor can be shown / hidden

8374 , supportsCursorVisibility :: Bool

84− -- | Indicates support for terminal modes for this output device.

75+ -- | Indicates support for terminal modes for this output device

8576 , supportsMode :: Mode -> 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

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

9181 , assumedStateRef :: IORef AssumedState

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

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

11990 }

12091

121−displayContext :: Output -> DisplayRegion -> IO DisplayContext

122−displayContext t = mkDisplayContext t t

92+displayContext :: MonadIO m => Output -> DisplayRegion -> m DisplayContext

93+displayContext t = liftIO . mkDisplayContext t t

12394

12495data AssumedState = AssumedState

12596 { prevFattr :: Maybe FixedAttr

@@ -131,71 +102,69 @@ initialAssumedState = AssumedState Nothing Nothing

131102

132103data DisplayContext = DisplayContext

133104 { contextDevice :: Output

134− -- | Provide the bounds of the display context.

105+ -- | Provide the bounds of the display context.

135106 , contextRegion :: DisplayRegion

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.

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.

139109 , writeMoveCursor :: Int -> Int -> Write

140110 , writeShowCursor :: Write

141111 , writeHideCursor :: Write

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.

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.

150117 --

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

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

160126 , writeRowEnd :: Write

161127 -- | See `Graphics.Vty.Output.XTermColor.inlineHack`

162128 , inlineHack :: IO ()

163129 }

164130

165−-- | All terminals serialize UTF8 text to the terminal device exactly as

166−-- serialized in memory.

131+-- | All terminals serialize UTF8 text to the terminal device exactly as serialized in memory.

167132writeUtf8Text :: BS.ByteString -> Write

168133writeUtf8Text = writeByteString

169134

170135-- | Displays the given `Picture`.

171136--

172−-- 1. The image is cropped to the display size.

137+-- 0. The image is cropped to the display size.

173138--

174−-- 2. Converted into a sequence of attribute changes and text spans.

139+-- 1. Converted into a sequence of attribute changes and text spans.

140+--

141+-- 2. The cursor is hidden.

175142--

176−-- 3. The cursor is hidden.

143+-- 3. Serialized to the display.

177144--

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

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

184151 as <- readIORef (assumedStateRef $ contextDevice dc)

185152 let manipCursor = supportsCursorVisibility (contextDevice dc)

186153 r = contextRegion dc

187154 ops = displayOpsForPic pic r

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.

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.

191159 diffs :: [Bool] = case prevOutputOps as of

192− Nothing -> replicate (fromEnum $ regionHeight $ affectedRegion ops) True

193− Just previousOps -> if affectedRegion previousOps /= affectedRegion ops

160+ Nothing -> replicate (fromEnum $ regionHeight $ effectedRegion ops) True

161+ Just previousOps -> if effectedRegion previousOps /= effectedRegion ops

194162 then replicate (displayOpsRows ops) True

195− else Vector.toList $ Vector.zipWith (/=) previousOps ops

163+ else zipWith (/=) (Vector.toList previousOps)

164+ (Vector.toList ops)

196165 -- build the Write corresponding to the output image

197166 out = (if manipCursor then writeHideCursor dc else mempty)

198− `mappend` writeOutputOps urlsEnabled dc initialAttr diffs ops

167+ `mappend` writeOutputOps dc initialAttr diffs ops

199168 `mappend`

200169 (let (w,h) = contextRegion dc

201170 clampX = max 0 . min (w-1)

@@ -206,15 +175,9 @@ outputPicture dc pic = do

206175 AbsoluteCursor x y ->

207176 writeShowCursor dc `mappend`

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

215178 Cursor x y ->

216179 let m = cursorOutputMap ops $ picCursor pic

217− (ox, oy) = charToOutputPos m (clampX x, clampY y)

180+ (ox, oy) = charToOutputPos m (x,y)

218181 in writeShowCursor dc `mappend`

219182 writeMoveCursor dc (clampX ox) (clampY oy)

220183 )

@@ -224,15 +187,15 @@ outputPicture dc pic = do

224187 let as' = as { prevOutputOps = Just ops }

225188 writeIORef (assumedStateRef $ contextDevice dc) as'

226189

227−writeOutputOps :: Bool -> DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write

228−writeOutputOps urlsEnabled dc initialAttr diffs ops =

190+writeOutputOps :: DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write

191+writeOutputOps dc initialAttr diffs ops =

229192 let (_, out, _) = Vector.foldl' writeOutputOps'

230193 (0, mempty, diffs)

231194 ops

232195 in out

233− where

196+ where

234197 writeOutputOps' (y, out, True : diffs') spanOps

235− = let spanOut = writeSpanOps urlsEnabled dc y initialAttr spanOps

198+ = let spanOut = writeSpanOps dc y initialAttr spanOps

236199 out' = out `mappend` spanOut

237200 in (y+1, out', diffs')

238201 writeOutputOps' (y, out, False : diffs') _spanOps

@@ -240,34 +203,33 @@ writeOutputOps urlsEnabled dc initialAttr diffs ops =

240203 writeOutputOps' (_y, _out, []) _spanOps

241204 = error "vty - output spans without a corresponding diff."

242205

243−writeSpanOps :: Bool -> DisplayContext -> Int -> FixedAttr -> SpanOps -> Write

244−writeSpanOps urlsEnabled dc y initialAttr spanOps =

206+writeSpanOps :: DisplayContext -> Int -> FixedAttr -> SpanOps -> Write

207+writeSpanOps dc y initialAttr spanOps =

245208 -- The first operation is to set the cursor to the start of the row

246− let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc urlsEnabled

209+ let start = writeMoveCursor dc 0 y `mappend` writeDefaultAttr dc

247210 -- then the span ops are serialized in the order specified

248− in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp urlsEnabled dc op fattr of

211+ in fst $ Vector.foldl' (\(out, fattr) op -> case writeSpanOp dc op fattr of

249212 (opOut, fattr') -> (out `mappend` opOut, fattr')

250213 )

251214 (start, initialAttr)

252215 spanOps

253216

254−writeSpanOp :: Bool -> DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)

255−writeSpanOp urlsEnabled dc (TextSpan attr _ _ str) fattr =

217+writeSpanOp :: DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)

218+writeSpanOp dc (TextSpan attr _ _ str) fattr =

256219 let attr' = limitAttrForDisplay (contextDevice dc) attr

257220 fattr' = fixDisplayAttr fattr attr'

258221 diffs = displayAttrDiffs fattr fattr'

259− out = writeSetAttr dc urlsEnabled fattr attr' diffs

222+ out = writeSetAttr dc fattr attr' diffs

260223 `mappend` writeUtf8Text (T.encodeUtf8 $ TL.toStrict str)

261224 in (out, fattr')

262−writeSpanOp _ _ (Skip _) _fattr = error "writeSpanOp for Skip"

263−writeSpanOp urlsEnabled dc (RowEnd _) fattr = (writeDefaultAttr dc urlsEnabled `mappend` writeRowEnd dc, fattr)

225+writeSpanOp _dc (Skip _) _fattr = error "writeSpanOp for Skip"

226+writeSpanOp dc (RowEnd _) fattr = (writeDefaultAttr dc `mappend` writeRowEnd dc, fattr)

264227

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.

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.

268230data CursorOutputMap = CursorOutputMap

269231 { charToOutputPos :: (Int, Int) -> (Int, Int)

270− }

232+ }

271233

272234cursorOutputMap :: DisplayOps -> Cursor -> CursorOutputMap

273235cursorOutputMap spanOps _cursor = CursorOutputMap

@@ -277,18 +239,18 @@ cursorOutputMap spanOps _cursor = CursorOutputMap

277239cursorColumnOffset :: DisplayOps -> Int -> Int -> Int

278240cursorColumnOffset ops cx cy =

279241 let cursorRowOps = Vector.unsafeIndex ops (fromEnum cy)

280− (outOffset, _, _)

281− = Vector.foldl' ( \(d, currentCx, done) op ->

242+ (outOffset, _, _)

243+ = Vector.foldl' ( \(d, currentCx, done) op ->

282244 if done then (d, currentCx, done) else case spanOpHasWidth op of

283245 Nothing -> (d, currentCx, False)

284246 Just (cw, ow) -> case compare cx (currentCx + cw) of

285247 GT -> ( d + ow

286248 , currentCx + cw

287− , False

249+ , False

288250 )

289251 EQ -> ( d + ow

290252 , currentCx + cw

291− , True

253+ , True

292254 )

293255 LT -> ( d + columnsToCharOffset (cx - currentCx) op

294256 , currentCx + cw

@@ -299,33 +261,27 @@ cursorColumnOffset ops cx cy =

299261 cursorRowOps

300262 in outOffset

301263

302−-- | Not all terminals support all display attributes. This filters a

303−-- display attribute to what the given terminal can display.

264+-- | Not all terminals support all display attributes. This filters a display attribute to what the

265+-- given terminal can display.

304266limitAttrForDisplay :: Output -> Attr -> Attr

305−limitAttrForDisplay t attr

267+limitAttrForDisplay t attr

306268 = attr { attrForeColor = clampColor $ attrForeColor attr

307269 , attrBackColor = clampColor $ attrBackColor attr

308270 }

309271 where

310272 clampColor Default = Default

311273 clampColor KeepCurrent = KeepCurrent

312− clampColor (SetTo c) = clampColor' (outputColorMode t) c

313−

314− clampColor' NoColor _ = Default

315−

316− clampColor' ColorMode8 (ISOColor v)

317− | v >= 8 = SetTo $ ISOColor (v - 8)

318− | otherwise = SetTo $ ISOColor v

319− clampColor' ColorMode8 _ = Default

320−

321− clampColor' ColorMode16 c@(ISOColor _) = SetTo c

322− clampColor' ColorMode16 _ = Default

323−

324− clampColor' (ColorMode240 _) c@(ISOColor _) = SetTo c

325− clampColor' (ColorMode240 colorCount) c@(Color240 n)

326− | n <= colorCount = SetTo c

327− | otherwise = Default

328− clampColor' colorMode@(ColorMode240 _) (RGBColor r g b) =

329− clampColor' colorMode (color240 r g b)

330−

331− clampColor' FullColor c = SetTo c

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'

src/Graphics/Vty/Output/Mock.hs+25−40

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

11-- Copyright Corey O'Connor

22{-# LANGUAGE FlexibleInstances #-}

33{-# LANGUAGE TypeFamilies #-}

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

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

1210

13−import Graphics.Vty.Image (DisplayRegion)

14−import Graphics.Vty.Attributes.Color (ColorMode(ColorMode16))

1511import Graphics.Vty.Output.Interface

1612

1713import Blaze.ByteString.Builder.Word (writeWord8)

@@ -24,20 +20,18 @@ import qualified Data.String.UTF8 as UTF8

2420

2521type MockData = IORef (UTF8.UTF8 BS.ByteString)

2622

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.

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.

3227--

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.

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.

3832--

39−-- The string representation is a sequence of identifiers where each

40−-- identifier is the name of an operation in the algebra.

33+-- The string representation is a sequence of identifiers where each identifier is the name of an

34+-- operation in the algebra.

4135mockTerminal :: (Applicative m, MonadIO m) => DisplayRegion -> m (MockData, Output)

4236mockTerminal r = liftIO $ do

4337 outRef <- newIORef undefined

@@ -49,39 +43,30 @@ mockTerminal r = liftIO $ do

4943 , releaseDisplay = return ()

5044 , ringTerminalBell = return ()

5145 , supportsBell = return False

52− , supportsItalics = return False

53− , supportsStrikethrough = return False

54− , setDisplayBounds = const $ return ()

5546 , displayBounds = return r

5647 , outputByteBuffer = \bytes -> do

5748 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"

5849 writeIORef outRef $ UTF8.fromRep bytes

50+ , contextColorCount = 16

5951 , supportsCursorVisibility = True

6052 , supportsMode = const False

6153 , setMode = const $ const $ return ()

6254 , getModeStatus = const $ return False

6355 , assumedStateRef = newAssumedStateRef

64− , outputColorMode = ColorMode16

6556 , mkDisplayContext = \tActual rActual -> return $ DisplayContext

6657 { contextRegion = rActual

6758 , contextDevice = tActual

68− -- A cursor move is always visualized as the single

69− -- character 'M'

59+ -- A cursor move is always visualized as the single character 'M'

7060 , writeMoveCursor = \_x _y -> writeWord8 $ toEnum $ fromEnum 'M'

71− -- Show cursor is always visualized as the single

72− -- character 'S'

61+ -- Show cursor is always visualized as the single character 'S'

7362 , writeShowCursor = writeWord8 $ toEnum $ fromEnum 'S'

74− -- Hide cursor is always visualized as the single

75− -- character 'H'

63+ -- Hide cursor is always visualized as the single character 'H'

7664 , writeHideCursor = writeWord8 $ toEnum $ fromEnum 'H'

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'

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'

8570 , writeRowEnd = writeWord8 $ toEnum $ fromEnum 'E'

8671 , inlineHack = return ()

8772 }

src/Graphics/Vty/Output/TerminfoBased.hs+161−290

@@ -1,40 +1,42 @@

1−{-# LANGUAGE FlexibleInstances #-}

2−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE RecordWildCards #-}

32{-# LANGUAGE CPP #-}

3+{-# LANGUAGE FlexibleInstances #-}

44{-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-}

55{-# CFILES gwinsz.c #-}

66

7−-- | Terminfo-based terminal output driver.

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.

816--

917-- Copyright Corey O'Connor (coreyoconnor@gmail.com)

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

18+module Graphics.Vty.Output.TerminfoBased ( reserveTerminal )

19+ where

20+

21+import Graphics.Vty.Prelude

22+

1923import Data.ByteString.Internal (toForeignPtr)

2024import Data.Terminfo.Parse

2125import Data.Terminfo.Eval

2226

2327import Graphics.Vty.Attributes

24−import Graphics.Vty.Image (DisplayRegion)

2528import Graphics.Vty.DisplayAttributes

2629import Graphics.Vty.Output.Interface

2730

28−import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable, writeWord8)

31+import Blaze.ByteString.Builder (Write, writeToByteString)

32+

33+import Control.Monad.Trans

2934

35+import Data.Bits ((.&.))

3036import Data.IORef

3137import Data.Maybe (isJust, isNothing, fromJust)

3238import Data.Word

3339

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

35−import Data.Foldable (foldMap)

36−#endif

37−

3840import Foreign.C.Types ( CInt(..), CLong(..) )

3941import Foreign.ForeignPtr (withForeignPtr)

4042import Foreign.Ptr (Ptr, plusPtr)

@@ -43,12 +45,18 @@ import qualified System.Console.Terminfo as Terminfo

4345import System.Posix.IO (fdWriteBuf)

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

4547

46−data TerminfoCaps = TerminfoCaps

48+#if !(MIN_VERSION_base(4,8,0))

49+import Data.Foldable (foldMap)

50+import Data.Monoid

51+#endif

52+

53+data TerminfoCaps = TerminfoCaps

4754 { smcup :: Maybe CapExpression

4855 , rmcup :: Maybe CapExpression

4956 , cup :: CapExpression

5057 , cnorm :: Maybe CapExpression

5158 , civis :: Maybe CapExpression

59+ , supportsNoColors :: Bool

5260 , useAltColorMap :: Bool

5361 , setForeColor :: CapExpression

5462 , setBackColor :: CapExpression

@@ -63,21 +71,15 @@ data DisplayAttrCaps = DisplayAttrCaps

6371 { setAttrStates :: Maybe CapExpression

6472 , enterStandout :: Maybe CapExpression

6573 , exitStandout :: Maybe CapExpression

66− , enterItalic :: Maybe CapExpression

67− , exitItalic :: Maybe CapExpression

68− , enterStrikethrough :: Maybe CapExpression

69− , exitStrikethrough :: Maybe CapExpression

7074 , enterUnderline :: Maybe CapExpression

7175 , exitUnderline :: Maybe CapExpression

7276 , enterReverseVideo :: Maybe CapExpression

7377 , enterDimMode :: Maybe CapExpression

7478 , enterBoldMode :: Maybe CapExpression

7579 }

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.

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.

8183fdWriteAll :: Fd -> Ptr Word8 -> Int -> Int -> IO Int

8284fdWriteAll outFd ptr len count

8385 | len < 0 = fail "fdWriteAll: len is less than 0"

@@ -93,95 +95,71 @@ sendCapToTerminal :: Output -> CapExpression -> [CapParam] -> IO ()

9395sendCapToTerminal t cap capParams = do

9496 outputByteBuffer t $ writeToByteString $ writeCapExpr cap capParams

9597

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

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

108111 ti <- Terminfo.setupTerm termName

109112 -- assumes set foreground always implies set background exists.

110− -- if set foreground is not set then all color changing style

111− -- attributes are filtered.

113+ -- if set foreground is not set then all color changing style attributes are filtered.

112114 msetaf <- probeCap ti "setaf"

113115 msetf <- probeCap ti "setf"

114− let (useAlt, setForeCap)

116+ let (noColors, useAlt, setForeCap)

115117 = case msetaf of

116− Just setaf -> (False, setaf)

118+ Just setaf -> (False, False, setaf)

117119 Nothing -> case msetf of

118− Just setf -> (True, setf)

119− Nothing -> (True, error $ "no fore color support for terminal " ++ termName)

120+ Just setf -> (False, True, setf)

121+ Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName)

120122 msetab <- probeCap ti "setab"

121123 msetb <- probeCap ti "setb"

122− let setBackCap

124+ let set_back_cap

123125 = case msetab of

124− Just setab -> setab

125126 Nothing -> case msetb of

126127 Just setb -> setb

127128 Nothing -> error $ "no back color support for terminal " ++ termName

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−

129+ Just setab -> setab

147130 terminfoCaps <- pure TerminfoCaps

148131 <*> probeCap ti "smcup"

149132 <*> probeCap ti "rmcup"

150133 <*> requireCap ti "cup"

151134 <*> probeCap ti "cnorm"

152135 <*> probeCap ti "civis"

136+ <*> pure noColors

153137 <*> pure useAlt

154138 <*> pure setForeCap

155− <*> pure setBackCap

139+ <*> pure set_back_cap

156140 <*> requireCap ti "sgr0"

157141 <*> requireCap ti "clear"

158142 <*> requireCap ti "el"

159143 <*> currentDisplayAttrCaps ti

160144 <*> probeCap ti "bel"

145+ newAssumedStateRef <- newIORef initialAssumedState

161146 let t = Output

162147 { terminalID = termName

163− , releaseTerminal = do

148+ , releaseTerminal = liftIO $ do

164149 sendCap setDefaultAttr []

165150 maybeSendCap cnorm []

166151 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps

167− , supportsItalics = return $ (isJust $ enterItalic (displayAttrCaps terminfoCaps)) &&

168− (isJust $ exitItalic (displayAttrCaps terminfoCaps))

169− , supportsStrikethrough = return $ (isJust $ enterStrikethrough (displayAttrCaps terminfoCaps)) &&

170− (isJust $ exitStrikethrough (displayAttrCaps terminfoCaps))

171− , ringTerminalBell = maybeSendCap ringBellAudio []

172− , reserveDisplay = do

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.

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.

176156 maybeSendCap smcup []

177157 sendCap clearScreen []

178− , releaseDisplay = do

158+ , releaseDisplay = liftIO $ do

179159 maybeSendCap rmcup []

180160 maybeSendCap cnorm []

181− , setDisplayBounds = \(w, h) ->

182− setWindowSize outFd (w, h)

183161 , displayBounds = do

184− rawSize <- getWindowSize outFd

162+ rawSize <- liftIO $ getWindowSize outFd

185163 case rawSize of

186164 (w, h) | w < 0 || h < 0 -> fail $ "getwinsize returned < 0 : " ++ show rawSize

187165 | otherwise -> return (w,h)

@@ -192,48 +170,51 @@ reserveTerminal termName outFd colorMode = do

192170 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "

193171 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen

194172 ++ " 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

195179 , supportsCursorVisibility = isJust $ civis terminfoCaps

196− , supportsMode = terminfoModeSupported

197− , setMode = terminfoSetMode

198− , getModeStatus = terminfoModeStatus

180+ , supportsMode = const False

181+ , setMode = const $ const $ return ()

182+ , getModeStatus = const $ return False

199183 , assumedStateRef = newAssumedStateRef

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)

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

204187 }

205188 sendCap s = sendCapToTerminal t (s terminfoCaps)

206189 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)

207190 return t

208191

209−requireCap :: Terminfo.Terminal -> String -> IO CapExpression

210−requireCap ti capName

192+requireCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m CapExpression

193+requireCap ti capName

211194 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

212195 Nothing -> fail $ "Terminal does not define required capability \"" ++ capName ++ "\""

213196 Just capStr -> parseCap capStr

214197

215−probeCap :: Terminfo.Terminal -> String -> IO (Maybe CapExpression)

216−probeCap ti capName

198+probeCap :: (Applicative m, MonadIO m) => Terminfo.Terminal -> String -> m (Maybe CapExpression)

199+probeCap ti capName

217200 = case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of

218201 Nothing -> return Nothing

219202 Just capStr -> Just <$> parseCap capStr

220203

221−parseCap :: String -> IO CapExpression

204+parseCap :: (Applicative m, MonadIO m) => String -> m CapExpression

222205parseCap capStr = do

223206 case parseCapExpression capStr of

224207 Left e -> fail $ show e

225208 Right cap -> return cap

226209

227−currentDisplayAttrCaps :: Terminfo.Terminal -> IO DisplayAttrCaps

228−currentDisplayAttrCaps ti

229− = pure DisplayAttrCaps

210+currentDisplayAttrCaps :: ( Applicative m, MonadIO m )

211+ => Terminfo.Terminal

212+ -> m DisplayAttrCaps

213+currentDisplayAttrCaps ti

214+ = pure DisplayAttrCaps

230215 <*> probeCap ti "sgr"

231216 <*> probeCap ti "smso"

232217 <*> probeCap ti "rmso"

233− <*> probeCap ti "sitm"

234− <*> probeCap ti "ritm"

235− <*> probeCap ti "smxx"

236− <*> probeCap ti "rmxx"

237218 <*> probeCap ti "smul"

238219 <*> probeCap ti "rmul"

239220 <*> probeCap ti "rev"

@@ -243,17 +224,10 @@ currentDisplayAttrCaps ti

243224foreign import ccall "gwinsz.h vty_c_get_window_size" c_getWindowSize :: Fd -> IO CLong

244225

245226getWindowSize :: Fd -> IO (Int,Int)

246−getWindowSize fd = do

227+getWindowSize fd = do

247228 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd

248229 return (fromIntegral b, fromIntegral a)

249230

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−

257231terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext

258232terminfoDisplayContext tActual terminfoCaps r = return dc

259233 where dc = DisplayContext

@@ -267,204 +241,123 @@ terminfoDisplayContext tActual terminfoCaps r = return dc

267241 Nothing -> error "this terminal does not support hide cursor"

268242 Just c -> writeCapExpr c []

269243 , writeSetAttr = terminfoWriteSetAttr dc 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− )

244+ , writeDefaultAttr = writeCapExpr (setDefaultAttr terminfoCaps) []

277245 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []

278246 , inlineHack = return ()

279247 }

280248

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−

295249-- | Portably setting the display attributes is a giant pain in the ass.

296250--

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:

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:

300253--

301254-- 0. set the style attributes. This resets the fore and back color.

302255--

303256-- 1, If a foreground color is to be set then set the foreground color

304257--

305258-- 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:

306263--

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:

264+-- 0. reset all display attributes (sgr0)

310265--

311−-- 0. reset all display attributes (sgr0)

266+-- 1. enter required style modes

312267--

313−-- 1. enter required style modes

268+-- 2. set the fore color if required

314269--

315−-- 2. set the fore color if required

270+-- 3. set the back color if required

316271--

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.

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.

322274--

323275-- This equation implements the above logic.

324276--

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

277+-- \todo This assumes the removal of color changes in the display attributes is done as expected

278+-- with noColors == True. See `limitAttrForDisplay`

328279--

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

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

338288 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

339− (fixedStyle attr)

289+ (fixedStyle attr )

340290 (styleToApplySeq $ fixedStyle attr) of

341291 -- only way to reset a color to the defaults

342− EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled

343− `mappend`

292+ EnterExitSeq caps -> writeDefaultAttr dc

293+ `mappend`

344294 foldMap (\cap -> writeCapExpr cap []) caps

345295 `mappend`

346296 setColors

347297 -- implicitly resets the colors to the defaults

348− SetState state -> writeCapExpr (fromJust $ setAttrStates

349− $ displayAttrCaps terminfoCaps

298+ SetState state -> writeCapExpr (fromJust $ setAttrStates

299+ $ displayAttrCaps

300+ $ terminfoCaps

350301 )

351302 (sgrArgsForState state)

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.

303+ `mappend`

304+ setColors

305+ -- Otherwise the display colors are not changing or changing between two non-default

306+ -- points.

357307 False -> do

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.

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.

361310 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

362311 (fixedStyle attr)

363312 (styleDiffs diffs) of

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.

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.

370317 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps

371318 `mappend`

372− writeColorDiff Foreground (foreColorDiff diffs)

319+ writeColorDiff setForeColor (foreColorDiff diffs)

373320 `mappend`

374− writeColorDiff Background (backColorDiff diffs)

321+ writeColorDiff setBackColor (backColorDiff diffs)

375322 -- implicitly resets the colors to the defaults

376− SetState state -> writeCapExpr (fromJust $ setAttrStates

323+ SetState state -> writeCapExpr (fromJust $ setAttrStates

377324 $ displayAttrCaps terminfoCaps

378325 )

379326 (sgrArgsForState state)

380− `mappend` setItalics

381− `mappend` setStrikethrough

382327 `mappend` setColors

383− where

384− urlAttrs True = writeURLEscapes (urlDiff diffs)

385− urlAttrs False = mempty

328+ where

386329 colorMap = case useAltColorMap terminfoCaps of

387330 False -> ansiColorIndex

388331 True -> altColorIndex

389332 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

404333 setColors =

405334 (case fixedForeColor attr of

406− Just c -> writeColor Foreground c

335+ Just c -> writeCapExpr (setForeColor terminfoCaps)

336+ [toEnum $ colorMap c]

407337 Nothing -> mempty)

408338 `mappend`

409339 (case fixedBackColor attr of

410− Just c -> writeColor Background c

340+ Just c -> writeCapExpr (setBackColor terminfoCaps)

341+ [toEnum $ colorMap c]

411342 Nothing -> mempty)

412− writeColorDiff _side NoColorChange

343+ writeColorDiff _f NoColorChange

413344 = mempty

414− writeColorDiff _side ColorToDefault

345+ writeColorDiff _f ColorToDefault

415346 = error "ColorToDefault is not a possible case for applyColorDiffs"

416− writeColorDiff side (SetColor c)

417− = writeColor side c

418−

419− writeColor side (RGBColor r g b) =

420− case outputColorMode (contextDevice dc) of

421− FullColor ->

422− hardcodeColor side (r, g, b)

423− _ ->

424− error "clampColor should remove rgb colors in standard mode"

425− writeColor side c =

426− writeCapExpr (setSideColor side terminfoCaps) [toEnum $ colorMap c]

427−

428−-- a color can either be in the foreground or the background

429−data ColorSide = Foreground | Background

430−

431−-- get the capability for drawing a color on a specific side

432−setSideColor :: ColorSide -> TerminfoCaps -> CapExpression

433−setSideColor Foreground = setForeColor

434−setSideColor Background = setBackColor

435−

436−hardcodeColor :: ColorSide -> (Word8, Word8, Word8) -> Write

437−hardcodeColor side (r, g, b) =

438− -- hardcoded color codes are formatted as "\x1b[{side};2;{r};{g};{b}m"

439− mconcat [ writeStr "\x1b[", sideCode, delimiter, writeChar '2', delimiter

440− , writeColor r, delimiter, writeColor g, delimiter, writeColor b

441− , writeChar 'm']

442− where

443− writeChar = writeWord8 . fromIntegral . fromEnum

444− writeStr = mconcat . map writeChar

445− writeColor = writeStr . show

446− delimiter = writeChar ';'

447− -- 38/48 are used to set whether we should write to the

448− -- foreground/background. I really don't want to know why.

449− sideCode = case side of

450− Foreground -> writeStr "38"

451− Background -> writeStr "48"

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.

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.

455352--

456−-- This takes a Color which clearly identifies which palette to use and

457−-- computes the index into the full 256 color palette.

353+-- This takes a Color which clearly identifies which pallete to use and computes the index

354+-- into the full 256 color pallete.

458355ansiColorIndex :: Color -> Int

459356ansiColorIndex (ISOColor v) = fromEnum v

460357ansiColorIndex (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− ]

465358

466359-- | For terminals without setaf/setab

467−--

360+--

468361-- See table in `man terminfo`

469362-- Will error if not in table.

470363altColorIndex :: Color -> Int

@@ -478,28 +371,21 @@ altColorIndex (ISOColor 6) = 3

478371altColorIndex (ISOColor 7) = 7

479372altColorIndex (ISOColor v) = fromEnum v

480373altColorIndex (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− ]

485374

486−{- | The sequence of terminfo caps to apply a given style are determined

487− - according to these rules.

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.

488379 -

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.

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.

492382 -

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.

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.

496385 -

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.

386+ - 4. If the display attribute state is being set then just update the arguments to that for any

387+ - apply/remove.

500388 -

501− - 4. If the display attribute state is being set then just update the

502− - arguments to that for any apply/remove.

503389 -}

504390data DisplayAttrSeq

505391 = EnterExitSeq [CapExpression]

@@ -508,8 +394,6 @@ data DisplayAttrSeq

508394data DisplayAttrState = DisplayAttrState

509395 { applyStandout :: Bool

510396 , applyUnderline :: Bool

511− , applyItalic :: Bool

512− , applyStrikethrough :: Bool

513397 , applyReverseVideo :: Bool

514398 , applyBlink :: Bool

515399 , applyDim :: Bool

@@ -531,25 +415,19 @@ sgrArgsForState attrState = map (\b -> if b then 1 else 0)

531415

532416reqDisplayCapSeqFor :: DisplayAttrCaps -> Style -> [StyleStateChange] -> DisplayAttrSeq

533417reqDisplayCapSeqFor caps s diffs

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.

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.

537420 = case (any noEnterExitCap diffs, isJust $ setAttrStates caps) of

538421 -- If all the diffs have an enter-exit cap then just use those

539422 ( False, _ ) -> EnterExitSeq $ map enterExitCap diffs

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

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

544426 $ filter (not . noEnterExitCap) diffs

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.

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.

547429 ( True, True ) -> SetState $ stateForStyle s

548430 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

553431 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps

554432 noEnterExitCap RemoveStandout = isNothing $ exitStandout caps

555433 noEnterExitCap ApplyUnderline = isNothing $ enterUnderline caps

@@ -562,10 +440,6 @@ reqDisplayCapSeqFor caps s diffs

562440 noEnterExitCap RemoveDim = True

563441 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps

564442 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

569443 enterExitCap ApplyStandout = fromJust $ enterStandout caps

570444 enterExitCap RemoveStandout = fromJust $ exitStandout caps

571445 enterExitCap ApplyUnderline = fromJust $ enterUnderline caps

@@ -579,8 +453,6 @@ stateForStyle :: Style -> DisplayAttrState

579453stateForStyle s = DisplayAttrState

580454 { applyStandout = isStyleSet standout

581455 , applyUnderline = isStyleSet underline

582− , applyItalic = isStyleSet italic

583− , applyStrikethrough = isStyleSet strikethrough

584456 , applyReverseVideo = isStyleSet reverseVideo

585457 , applyBlink = isStyleSet blink

586458 , applyDim = isStyleSet dim

@@ -592,15 +464,14 @@ styleToApplySeq :: Style -> [StyleStateChange]

592464styleToApplySeq s = concat

593465 [ applyIfRequired ApplyStandout standout

594466 , applyIfRequired ApplyUnderline underline

595− , applyIfRequired ApplyItalic italic

596− , applyIfRequired ApplyStrikethrough strikethrough

597467 , applyIfRequired ApplyReverseVideo reverseVideo

598468 , applyIfRequired ApplyBlink blink

599469 , applyIfRequired ApplyDim dim

600− , applyIfRequired ApplyBold bold

470+ , applyIfRequired ApplyBlink bold

601471 ]

602− where

603− applyIfRequired op flag

472+ where

473+ applyIfRequired op flag

604474 = if 0 == (flag .&. s)

605475 then []

606476 else [op]

477+

src/Graphics/Vty/Output/XTermColor.hs+37−53

@@ -1,72 +1,56 @@

1−{-# Language CPP #-}

1+{-# LANGUAGE CPP #-}

2+

3+#ifndef MIN_VERSION_base

4+#defined MIN_VERSION_base(x,y,z) 1

5+#endif

6+

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

8+module Graphics.Vty.Output.XTermColor ( reserveTerminal )

9+ where

910

1011import Graphics.Vty.Output.Interface

1112import Graphics.Vty.Input.Mouse

12−import Graphics.Vty.Input.Focus

13−import Graphics.Vty.Attributes.Color (ColorMode)

1413import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased

1514

1615import Blaze.ByteString.Builder (writeToByteString)

1716import Blaze.ByteString.Builder.Word (writeWord8)

1817

19−import qualified Data.ByteString.Char8 as BS8

20−import Data.ByteString.Char8 (ByteString)

21−import Foreign.Ptr (castPtr)

22−

2318import Control.Monad (void, when)

2419import Control.Monad.Trans

25−import Data.Char (toLower)

2620import Data.IORef

2721

28−import System.Posix.IO (fdWriteBuf)

29−import System.Posix.Types (ByteCount, Fd)

22+import System.Posix.IO (fdWrite)

23+import System.Posix.Types (Fd)

3024import System.Posix.Env (getEnv)

3125

26+#if !(MIN_VERSION_base(4,8,0))

27+import Control.Applicative

28+import Data.Foldable (foldMap)

29+#endif

30+

3231import Data.List (isInfixOf)

3332import Data.Maybe (catMaybes)

34−

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

3633import 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)

4434

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

35+-- | Initialize the display to UTF-8.

36+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

37+reserveTerminal variant outFd = liftIO $ do

4838 let flushedPut = void . fdWrite outFd

49− -- If the terminal variant is xterm-color use xterm instead since,

50− -- more often than not, xterm-color is broken.

39+ -- If the terminal variant is xterm-color use xterm instead since, more often than not,

40+ -- xterm-color is broken.

5141 let variant' = if variant == "xterm-color" then "xterm" else variant

5242

5343 utf8a <- utf8Active

5444 when (not utf8a) $ flushedPut setUtf8CharSet

55− t <- TerminfoBased.reserveTerminal variant' outFd colorMode

45+ t <- TerminfoBased.reserveTerminal variant' outFd

5646

5747 mouseModeStatus <- newIORef False

58− focusModeStatus <- newIORef False

5948 pasteModeStatus <- newIORef False

6049

6150 let xtermSetMode t' m newStatus = do

6251 curStatus <- getModeStatus t' m

6352 when (newStatus /= curStatus) $

6453 case m of

65− Focus -> liftIO $ do

66− case newStatus of

67− True -> flushedPut requestFocusEvents

68− False -> flushedPut disableFocusEvents

69− writeIORef focusModeStatus newStatus

7054 Mouse -> liftIO $ do

7155 case newStatus of

7256 True -> flushedPut requestMouseEvents

@@ -77,12 +61,9 @@ reserveTerminal variant outFd colorMode = liftIO $ do

7761 True -> flushedPut enableBracketedPastes

7862 False -> flushedPut disableBracketedPastes

7963 writeIORef pasteModeStatus newStatus

80− Hyperlink -> setMode t Hyperlink newStatus

8164

8265 xtermGetMode Mouse = liftIO $ readIORef mouseModeStatus

83− xtermGetMode Focus = liftIO $ readIORef focusModeStatus

8466 xtermGetMode BracketedPaste = liftIO $ readIORef pasteModeStatus

85− xtermGetMode Hyperlink = getModeStatus t Hyperlink

8667

8768 let t' = t

8869 { terminalID = terminalID t ++ " (xterm-color)"

@@ -90,7 +71,6 @@ reserveTerminal variant outFd colorMode = liftIO $ do

9071 when (not utf8a) $ liftIO $ flushedPut setDefaultCharSet

9172 setMode t' BracketedPaste False

9273 setMode t' Mouse False

93− setMode t' Focus False

9474 releaseTerminal t

9575 , mkDisplayContext = \tActual r -> do

9676 dc <- mkDisplayContext t tActual r

@@ -104,28 +84,32 @@ reserveTerminal variant outFd colorMode = liftIO $ do

10484utf8Active :: IO Bool

10585utf8Active = do

10686 let vars = ["LC_ALL", "LANG", "LC_CTYPE"]

107− results <- map (toLower <$>) . catMaybes <$> mapM getEnv vars

108− let matches = filter ("utf8" `isInfixOf`) results <>

109− filter ("utf-8" `isInfixOf`) results

87+ results <- catMaybes <$> mapM getEnv vars

88+ let matches = filter ("UTF8" `isInfixOf`) results <>

89+ filter ("UTF-8" `isInfixOf`) results

11090 return $ not $ null matches

11191

11292-- | Enable bracketed paste mode:

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

114−enableBracketedPastes :: ByteString

115−enableBracketedPastes = BS8.pack "\ESC[?2004h"

94+enableBracketedPastes :: String

95+enableBracketedPastes = "\ESC[?2004h"

11696

11797-- | Disable bracketed paste mode:

118−disableBracketedPastes :: ByteString

119−disableBracketedPastes = BS8.pack "\ESC[?2004l"

98+disableBracketedPastes :: String

99+disableBracketedPastes = "\ESC[?2004l"

120100

121101-- | These sequences set xterm based terminals to UTF-8 output.

122102--

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−

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.

128111xtermInlineHack :: Output -> IO ()

129112xtermInlineHack t = do

130113 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"

131114 outputByteBuffer t $ writeToByteString writeReset

115+

src/Graphics/Vty/Picture.hs+42−65

@@ -1,36 +1,25 @@

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

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

169

1710import Graphics.Vty.Image

18−import Graphics.Vty.Attributes

1911

2012import Control.DeepSeq

2113

22−-- | A Vty picture.

14+-- | The type of images to be displayed using 'update'.

2315--

24−-- These can be constructed directly or using `picForImage`.

16+-- Can be constructed directly or using `picForImage`. Which provides an initial instance with

17+-- reasonable defaults for picCursor and picBackground.

2518data Picture = Picture

2619 { picCursor :: Cursor

27− -- ^ The picture's cursor.

2820 , picLayers :: [Image]

29− -- ^ The picture's image layers (top-most first).

3021 , picBackground :: Background

31− -- ^ The picture's background to be displayed in locations with no

32− -- Image data.

33− } deriving Eq

22+ }

3423

3524instance Show Picture where

3625 show (Picture _ layers _ ) = "Picture ?? " ++ show layers ++ " ??"

@@ -38,73 +27,66 @@ instance Show Picture where

3827instance NFData Picture where

3928 rnf (Picture c l b) = c `deepseq` l `deepseq` b `deepseq` ()

4029

41−-- | A picture with no cursor, background or image layers.

30+-- | a picture with no cursor, background or image layers

4231emptyPicture :: Picture

4332emptyPicture = Picture NoCursor [] ClearBackground

4433

45−-- | Add an 'Image' as the top-most layer of a 'Picture'.

34+-- | The given 'Image' is added as the top layer of the 'Picture'

4635addToTop :: Picture -> Image -> Picture

4736addToTop p i = p {picLayers = i : picLayers p}

4837

49−-- | Add an 'Image' as the bottom-most layer of a 'Picture'.

38+-- | The given 'Image' is added as the bottom layer of the 'Picture'

5039addToBottom :: Picture -> Image -> Picture

5140addToBottom p i = p {picLayers = picLayers p ++ [i]}

5241

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.

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.

5644picForImage :: Image -> Picture

57−picForImage i = Picture

45+picForImage i = Picture

5846 { picCursor = NoCursor

5947 , picLayers = [i]

6048 , picBackground = ClearBackground

6149 }

6250

63−-- | Create a picture with the given layers, top-most first.

51+-- | Create a picture for display with the given layers. Ordered top to bottom.

6452--

65−-- The picture will not have a displayed cursor and no background

66−-- pattern (ClearBackgroun) will be used.

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.

6757picForLayers :: [Image] -> Picture

68−picForLayers is = Picture

58+picForLayers is = Picture

6959 { picCursor = NoCursor

7060 , picLayers = is

7161 , picBackground = ClearBackground

7262 }

7363

74−-- | A picture can be configured to hide the cursor or to show the

75−-- cursor at the specified character position.

64+-- | A picture can be configured either to not show the cursor or show the cursor at the specified

65+-- character position.

7666--

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.

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.

7972data Cursor =

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.

73+ -- | Hide the cursor

74+ NoCursor

75+ -- | Show the cursor at the given logical column accounting for char width and row

9276 | Cursor !Int !Int

93− -- | Show the cursor at the given absolute terminal column and row

77+ -- | Show the cursor at the given absolute terminal column and row

9478 | AbsoluteCursor !Int !Int

95− deriving Eq

9679

9780instance NFData Cursor where

9881 rnf c = c `seq` ()

9982

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

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.

10587--

106−-- If the display attribute used previously should be used for a

107−-- background fill then use `currentAttr` for the background attribute.

88+-- \todo The current attribute is always set to the default attributes at the start of updating the

89+-- screen to a picture.

10890data Background

10991 = Background

11092 { backgroundChar :: Char

@@ -116,16 +98,11 @@ data Background

11698 --

11799 -- * End of line if there are no remaining non-skip ops.

118100 | ClearBackground

119− deriving Eq

120101

121102instance NFData Background where

122103 rnf (Background c a) = c `seq` a `seq` ()

123104 rnf ClearBackground = ()

124105

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.

106+-- | Compatibility with applications that do not use more than a single layer.

130107picImage :: Picture -> Image

131108picImage = head . picLayers

src/Graphics/Vty/PictureToSpans.hs+97−80

@@ -1,14 +1,21 @@

11-- Copyright Corey O'Connor<coreyoconnor@gmail.com>

22{-# LANGUAGE BangPatterns #-}

3+{-# LANGUAGE CPP #-}

34{-# LANGUAGE ExistentialQuantification #-}

45{-# LANGUAGE NamedFieldPuns #-}

56{-# LANGUAGE RankNTypes #-}

67{-# LANGUAGE TemplateHaskell #-}

78

8−-- | Transforms an image into rows of operations.

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

915module Graphics.Vty.PictureToSpans where

1016

11−import Graphics.Vty.Attributes (Attr, currentAttr)

17+import Graphics.Vty.Prelude

18+

1219import Graphics.Vty.Image

1320import Graphics.Vty.Image.Internal

1421import Graphics.Vty.Picture

@@ -19,7 +26,12 @@ import Lens.Micro.Mtl

1926import Lens.Micro.TH

2027import Control.Monad.Reader

2128import Control.Monad.State.Strict hiding ( state )

29+

30+#if __GLASGOW_HASKELL__ < 708

31+import Control.Monad.ST.Strict hiding ( unsafeIOToST )

32+#else

2233import Control.Monad.ST.Strict

34+#endif

2335

2436import qualified Data.Vector as Vector hiding ( take, replicate )

2537import Data.Vector.Mutable ( MVector(..))

@@ -27,27 +39,29 @@ import qualified Data.Vector.Mutable as MVector

2739

2840import qualified Data.Text.Lazy as TL

2941

42+#if !(MIN_VERSION_base(4,8,0))

43+import Data.Monoid (mappend)

44+#endif

45+

3046type MRowOps s = MVector s SpanOps

3147

3248type MSpanOps s = MVector s SpanOp

3349

3450-- transform plus clip. More or less.

3551data BlitState = BlitState

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.

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.

4156 { _columnOffset :: Int

4257 , _rowOffset :: Int

43− -- clip coordinate space is in image space. Which means it's >= 0

44− -- and < imageWidth.

58+ -- clip coordinate space is in image space. Which means it's >= 0 and < imageWidth.

4559 , _skipColumns :: Int

4660 -- >= 0 and < imageHeight

4761 , _skipRows :: Int

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.

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.

5165 , _remainingColumns :: Int

5266 -- includes consideration of skipRows. In display space.

5367 , _remainingRows :: Int

@@ -64,29 +78,31 @@ makeLenses ''BlitEnv

6478

6579type BlitM s a = ReaderT (BlitEnv s) (StateT BlitState (ST s)) a

6680

67−-- | Produces the span ops that will render the given picture, possibly

68−-- cropped or padded, into the specified region.

81+-- | Produces the span ops that will render the given picture, possibly cropped or padded, into the

82+-- specified region.

6983displayOpsForPic :: Picture -> DisplayRegion -> DisplayOps

7084displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r)

7185

72−-- | Returns the DisplayOps for an image rendered to a window the size

73−-- of the image.

86+-- | Returns the DisplayOps for an image rendered to a window the size of the image.

7487--

75−-- largely used only for debugging.

88+-- largerly used only for debugging.

7689displayOpsForImage :: Image -> DisplayOps

7790displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeight i)

7891

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

8096combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s)

8197combinedOpsForLayers pic r

8298 | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0

8399 | otherwise = do

84− layerOps <- mapM (`buildSpans` r) (picLayers pic)

100+ layerOps <- mapM (\layer -> buildSpans layer r) (picLayers pic)

85101 case layerOps of

86102 [] -> fail "empty picture"

87103 [ops] -> substituteSkips (picBackground pic) ops

88− -- instead of merging ops after generation the merging can

89− -- be performed as part of snocOp.

104+ -- instead of merging ops after generation the merging can be performed as part of

105+ -- snocOp.

90106 topOps : lowerOps -> do

91107 ops <- foldM mergeUnder topOps lowerOps

92108 substituteSkips (picBackground pic) ops

@@ -95,23 +111,21 @@ substituteSkips :: Background -> MRowOps s -> ST s (MRowOps s)

95111substituteSkips ClearBackground ops = do

96112 forM_ [0 .. MVector.length ops - 1] $ \row -> do

97113 rowOps <- MVector.read ops row

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

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?

104119 let rowOps' = case Vector.last rowOps of

105120 Skip w -> Vector.init rowOps `Vector.snoc` RowEnd w

106121 _ -> rowOps

107− -- now all the skips can be replaced by replications of ' ' of

108− -- the required width.

122+ -- now all the skips can be replaced by replications of ' ' of the required width.

109123 let rowOps'' = swapSkipsForSingleColumnCharSpan ' ' currentAttr rowOps'

110124 MVector.write ops row rowOps''

111125 return ops

112126substituteSkips (Background {backgroundChar, backgroundAttr}) ops = do

113− -- At this point we decide if the background character is single

114− -- column or not. obviously, single column is easier.

127+ -- At this point we decide if the background character is single column or not.

128+ -- obviously, single column is easier.

115129 case safeWcwidth backgroundChar of

116130 w | w == 0 -> fail $ "invalid background character " ++ show backgroundChar

117131 | w == 1 -> do

@@ -135,12 +149,12 @@ mergeUnder upper lower = do

135149 MVector.write upper row rowOps

136150 return upper

137151

152+-- fugly

138153mergeRowUnder :: SpanOps -> SpanOps -> SpanOps

139−mergeRowUnder upperRowOps =

140− onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps)

154+mergeRowUnder upperRowOps lowerRowOps =

155+ onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) lowerRowOps

141156 where

142− -- H: it will never be the case that we are out of upper ops

143− -- before lower ops.

157+ -- H: it will never be the case that we are out of upper ops before lower ops.

144158 onUpperOp :: SpanOps -> SpanOp -> SpanOps -> SpanOps -> SpanOps

145159 onUpperOp outOps op@(TextSpan _ w _ _) upperOps lowerOps =

146160 let lowerOps' = dropOps w lowerOps

@@ -175,32 +189,30 @@ swapSkipsForCharSpan w c a = Vector.map f

175189 in TextSpan a ow cw txt

176190 f v = v

177191

178−-- | Builds a vector of row operations that will output the given

179−-- picture to the terminal.

192+-- | Builds a vector of row operations that will output the given picture to the terminal.

180193--

181194-- Crops to the given display region.

195+--

196+-- \todo I'm pretty sure there is an algorithm that does not require a mutable buffer.

182197buildSpans :: Image -> DisplayRegion -> ST s (MRowOps s)

183198buildSpans image outRegion = do

184199 -- First we create a mutable vector for each rows output operations.

185200 outOps <- MVector.replicate (regionHeight outRegion) Vector.empty

186− -- It's possible that building the span operations in display order

187− -- would provide better performance.

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.

188204 --

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.

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.

194209 --

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.

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.

198212 when (regionHeight outRegion > 0 && regionWidth outRegion > 0) $ do

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.

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.

204216 let fullBuild = do

205217 startImageBuild image

206218 -- Fill in any unspecified columns with a skip.

@@ -211,8 +223,7 @@ buildSpans image outRegion = do

211223 return ()

212224 return outOps

213225

214−-- | Add the operations required to build a given image to the current

215−-- set of row operations.

226+-- | Add the operations required to build a given image to the current set of row operations.

216227startImageBuild :: Image -> BlitM s ()

217228startImageBuild image = do

218229 outOfBounds <- isOutOfBounds image <$> get

@@ -226,16 +237,17 @@ isOutOfBounds i s

226237 | s ^. skipRows >= imageHeight i = True

227238 | otherwise = False

228239

229−-- | This adds an image that might be partially clipped to the output

230−-- ops.

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.

231245--

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.

246+-- \todo prove this cannot be called in an out of bounds case.

235247addMaybeClipped :: forall s . Image -> BlitM s ()

236248addMaybeClipped EmptyImage = return ()

237249addMaybeClipped (HorizText a textStr ow _cw) = do

238− -- This assumes that text spans are only 1 row high.

250+ -- TODO: assumption that text spans are only 1 row high.

239251 s <- use skipRows

240252 when (s < 1) $ do

241253 leftClip <- use skipColumns

@@ -247,19 +259,17 @@ addMaybeClipped (HorizText a textStr ow _cw) = do

247259 in addUnclippedText a textStr'

248260 else addUnclippedText a textStr

249261addMaybeClipped (VertJoin topImage bottomImage _ow oh) = do

250− when (imageHeight topImage + imageHeight bottomImage > 0) $

251− addMaybeClippedJoin "vert_join" skipRows remainingRows rowOffset

252− (imageHeight topImage)

253− topImage

254− bottomImage

255− oh

262+ addMaybeClippedJoin "vert_join" skipRows remainingRows rowOffset

263+ (imageHeight topImage)

264+ topImage

265+ bottomImage

266+ oh

256267addMaybeClipped (HorizJoin leftImage rightImage ow _oh) = do

257− when (imageWidth leftImage + imageWidth rightImage > 0) $

258− addMaybeClippedJoin "horiz_join" skipColumns remainingColumns columnOffset

259− (imageWidth leftImage)

260− leftImage

261− rightImage

262− ow

268+ addMaybeClippedJoin "horiz_join" skipColumns remainingColumns columnOffset

269+ (imageWidth leftImage)

270+ leftImage

271+ rightImage

272+ ow

263273addMaybeClipped BGFill {outputWidth, outputHeight} = do

264274 s <- get

265275 let outputWidth' = min (outputWidth - s^.skipColumns) (s^.remainingColumns)

@@ -285,7 +295,7 @@ addMaybeClipped CropTop {croppedImage, topSkip} = do

285295 skipRows += topSkip

286296 addMaybeClipped croppedImage

287297

288−addMaybeClippedJoin :: forall s . String

298+addMaybeClippedJoin :: forall s . String

289299 -> Lens BlitState BlitState Int Int

290300 -> Lens BlitState BlitState Int Int

291301 -> Lens BlitState BlitState Int Int

@@ -298,11 +308,12 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do

298308 state <- get

299309 when (state^.remaining <= 0) $ fail $ name ++ " with remaining <= 0"

300310 case state^.skip of

301− s | s > size -> put $ state & skip %~ subtract size

302− | s == 0 -> if state^.remaining > i0Dim

311+ s -- TODO: check if clipped in other dim. if not use addUnclipped

312+ | s >= size -> fail $ name ++ " on fully clipped"

313+ | s == 0 -> if state^.remaining > i0Dim

303314 then do

304315 addMaybeClipped i0

305− put $ state & offset %~ (+ i0Dim) & remaining %~ subtract i0Dim

316+ put $ state & offset +~ i0Dim & remaining -~ i0Dim

306317 addMaybeClipped i1

307318 else addMaybeClipped i0

308319 | s < i0Dim ->

@@ -311,10 +322,10 @@ addMaybeClippedJoin name skip remaining offset i0Dim i0 i1 size = do

311322 then addMaybeClipped i0

312323 else do

313324 addMaybeClipped i0

314− put $ state & offset %~ (+ i0Dim') & remaining %~ subtract i0Dim' & skip .~ 0

325+ put $ state & offset +~ i0Dim' & remaining -~ i0Dim' & skip .~ 0

315326 addMaybeClipped i1

316327 | s >= i0Dim -> do

317− put $ state & skip %~ subtract i0Dim

328+ put $ state & skip -~ i0Dim

318329 addMaybeClipped i1

319330 _ -> fail $ name ++ " has unhandled skip class"

320331

@@ -323,14 +334,14 @@ addUnclippedText a txt = do

323334 let op = TextSpan a usedDisplayColumns

324335 (fromIntegral $ TL.length txt)

325336 txt

326− usedDisplayColumns = wctlwidth txt

337+ usedDisplayColumns = wcswidth $ TL.unpack txt

327338 use rowOffset >>= snocOp op

328339

329340addRowCompletion :: DisplayRegion -> Int -> BlitM s ()

330341addRowCompletion displayRegion row = do

331342 allRowOps <- view mrowOps

332343 rowOps <- lift $ lift $ MVector.read allRowOps row

333− let endX = spanOpsAffectedColumns rowOps

344+ let endX = spanOpsEffectedColumns rowOps

334345 when (endX < regionWidth displayRegion) $ do

335346 let ow = regionWidth displayRegion - endX

336347 snocOp (Skip ow) row

@@ -343,6 +354,12 @@ snocOp !op !row = do

343354 lift $ lift $ do

344355 ops <- MVector.read theMrowOps row

345356 let ops' = Vector.snoc ops op

346− when (spanOpsAffectedColumns ops' > regionWidth theRegion)

357+ when (spanOpsEffectedColumns ops' > regionWidth theRegion)

347358 $ fail $ "row " ++ show row ++ " now exceeds region width"

348359 MVector.write theMrowOps row ops'

360+

361+(-~) :: Num a => ASetter s t a a -> a -> s -> t

362+l -~ n = over l (subtract n)

363+

364+(+~) :: Num a => ASetter s t a a -> a -> s -> t

365+l +~ n = over l (n +)

src/Graphics/Vty/Prelude.hsnew file+18

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

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+55−46

@@ -1,15 +1,23 @@

11-- Copyright Corey O'Connor

2+{-# LANGUAGE BangPatterns #-}

3+{-# LANGUAGE NamedFieldPuns #-}

24{-# LANGUAGE GADTs #-}

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

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

1120

12−import Graphics.Vty.Attributes (Attr)

1321import Graphics.Vty.Image

1422import Graphics.Vty.Image.Internal ( clipText )

1523

@@ -17,40 +25,40 @@ import qualified Data.Text.Lazy as TL

1725import Data.Vector (Vector)

1826import qualified Data.Vector as Vector

1927

20−-- | This represents an operation on the terminal: either an attribute

21−-- change or the output of a text string.

28+-- | This represents an operation on the terminal. Either an attribute change or the output of a

29+-- text string.

2230data SpanOp =

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

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

2835 { textSpanAttr :: !Attr

2936 , textSpanOutputWidth :: !Int

3037 , textSpanCharWidth :: !Int

3138 , textSpanText :: DisplayText

3239 }

33− -- | Skips the given number of columns.

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.

3443 | Skip !Int

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

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

3846 -- columns are clear.

47+ -- todo: separate from this type.

3948 | RowEnd !Int

4049 deriving Eq

4150

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.

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.

4755type SpanOps = Vector SpanOp

4856

4957dropOps :: Int -> SpanOps -> SpanOps

5058dropOps w = snd . splitOpsAt w

5159

5260splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)

53−splitOpsAt = splitOpsAt'

61+splitOpsAt inW inOps = splitOpsAt' inW inOps

5462 where

5563 splitOpsAt' 0 ops = (Vector.empty, ops)

5664 splitOpsAt' remainingColumns ops = case Vector.head ops of

@@ -81,9 +89,9 @@ splitOpsAt = splitOpsAt'

8189 , Vector.cons (Skip (w - remainingColumns)) (Vector.tail ops)

8290 )

8391 RowEnd _ -> error "cannot split ops containing a row end"

92+

8493

85−-- | A vector of span operation vectors for display, one per row of the

86−-- output region.

94+-- | vector of span operation vectors for display. One per row of the output region.

8795type DisplayOps = Vector SpanOps

8896

8997instance Show SpanOp where

@@ -91,39 +99,40 @@ instance Show SpanOp where

9199 show (Skip ow) = "Skip(" ++ show ow ++ ")"

92100 show (RowEnd ow) = "RowEnd(" ++ show ow ++ ")"

93101

94−-- | The number of columns the DisplayOps are defined for.

102+-- | Number of columns the DisplayOps are defined for

95103--

96−-- All spans are verified to define same number of columns.

104+-- All spans are verified to define same number of columns. See: VerifySpanOps

97105displayOpsColumns :: DisplayOps -> Int

98−displayOpsColumns ops

106+displayOpsColumns ops

99107 | Vector.length ops == 0 = 0

100108 | otherwise = Vector.length $ Vector.head ops

101109

102−-- | The number of rows the DisplayOps are defined for.

110+-- | Number of rows the DisplayOps are defined for

103111displayOpsRows :: DisplayOps -> Int

104−displayOpsRows = Vector.length

112+displayOpsRows ops = Vector.length ops

105113

106−affectedRegion :: DisplayOps -> DisplayRegion

107−affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)

114+effectedRegion :: DisplayOps -> DisplayRegion

115+effectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)

108116

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

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

116124

117−-- | The width of a single SpanOp in columns.

125+-- | The width of a single SpanOp in columns

118126spanOpHasWidth :: SpanOp -> Maybe (Int, Int)

119127spanOpHasWidth (TextSpan _ ow cw _) = Just (cw, ow)

120128spanOpHasWidth (Skip ow) = Just (ow,ow)

121129spanOpHasWidth (RowEnd ow) = Just (ow,ow)

122130

123−-- | The number of columns to the character at the given position in the

124−-- span op.

131+-- | returns the number of columns to the character at the given position in the span op

125132columnsToCharOffset :: Int -> SpanOp -> Int

126133columnsToCharOffset cx (TextSpan _ _ _ utf8Str) =

127− wctlwidth (TL.take (fromIntegral cx) utf8Str)

134+ let str = TL.unpack utf8Str

135+ in wcswidth (take cx str)

128136columnsToCharOffset cx (Skip _) = cx

129137columnsToCharOffset cx (RowEnd _) = cx

138+

src/Graphics/Vty/UnicodeWidthTable/IO.hsdeleted−105

@@ -1,105 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−module Graphics.Vty.UnicodeWidthTable.IO

3− ( readUnicodeWidthTable

4− , parseUnicodeWidthTable

5− , writeUnicodeWidthTable

6− )

7−where

8−

9−import Control.Monad (when, forM)

10−import Data.Binary

11−import Data.Binary.Get

12−import Data.Binary.Put

13−import qualified Data.ByteString.Lazy as BSL

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

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

16−#endif

17−

18−import Graphics.Vty.UnicodeWidthTable.Types

19−

20−-- | Load a binary unicode width table from the specified file.

21−--

22−-- This either returns a successfully parsed table or a table parsing

23−-- error message. This does not handle I/O exceptions.

24−readUnicodeWidthTable :: FilePath -> IO (Either String UnicodeWidthTable)

25−readUnicodeWidthTable path = parseUnicodeWidthTable <$> BSL.readFile path

26−

27−-- | Parse a binary unicode width table.

28−parseUnicodeWidthTable :: BSL.ByteString -> Either String UnicodeWidthTable

29−parseUnicodeWidthTable bs =

30− case runGetOrFail tableParser bs of

31− Left (_, _, msg) ->

32− Left msg

33−

34− -- Even if we parsed a table, leftover bytes indicate something

35− -- could be wrong.

36− Right (remainingBytes, _, _) | not (BSL.null remainingBytes) ->

37− Left $ "Error: " <> show (BSL.length remainingBytes) <>

38− " byte(s) left unconsumed"

39−

40− Right (_, _, table) ->

41− Right table

42−

43−-- | Write the unicode width table to the specified path.

44−--

45−-- This does not handle I/O exceptions.

46−writeUnicodeWidthTable :: FilePath -> UnicodeWidthTable -> IO ()

47−writeUnicodeWidthTable path table = do

48− let body = runPut (tableV1Writer table)

49− BSL.writeFile path body

50−

51−-- | Width table magic bytes for use in the binary format.

52−widthTableMagic :: Word32

53−widthTableMagic = 0xc1a9f7e0

54−

55−tableParser :: Get UnicodeWidthTable

56−tableParser = do

57− magic <- getWord32le

58−

59− when (magic /= widthTableMagic) $

60− fail "Table magic number invalid"

61−

62− version <- getWord8

63−

64− case version of

65− 1 -> tableV1Parser

66− _ -> fail "Table version invalid"

67−

68−tableV1Parser :: Get UnicodeWidthTable

69−tableV1Parser = do

70− numRanges <- getWord32le

71−

72− let parseRange = do

73− start <- getWord32le

74− size <- getWord32le

75− cols <- getWord8

76− return WidthTableRange { rangeStart = start

77− , rangeSize = size

78− , rangeColumns = cols

79− }

80−

81− ranges <- forM [1..numRanges] $ const parseRange

82−

83− return UnicodeWidthTable { unicodeWidthTableRanges = ranges

84− }

85−

86−tableV1Writer :: UnicodeWidthTable -> Put

87−tableV1Writer table = do

88− -- Magic bytes

89− putWord32le widthTableMagic

90−

91− -- Version

92− putWord8 1

93−

94− -- Number of ranges

95− let ranges = unicodeWidthTableRanges table

96− let numRanges = length ranges

97− putWord32le (fromIntegral numRanges)

98−

99− -- Ranges

100− let putRange r = do

101− putWord32le $ rangeStart r

102− putWord32le $ rangeSize r

103− putWord8 $ rangeColumns r

104−

105− mapM_ putRange ranges

src/Graphics/Vty/UnicodeWidthTable/Install.hsdeleted−129

@@ -1,129 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE ForeignFunctionInterface #-}

3−module Graphics.Vty.UnicodeWidthTable.Install

4− ( TableInstallException(..)

5− , installUnicodeWidthTable

6− , isCustomTableReady

7− )

8−where

9−

10−import Control.Monad (when, forM_)

11−import qualified Control.Exception as E

12−import GHC.Conc.Sync (withMVar)

13−import Control.Concurrent.MVar (MVar, newMVar)

14−import Data.Word (Word8, Word32)

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

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

17−#endif

18−import System.IO.Unsafe (unsafePerformIO)

19−

20−import Graphics.Vty.UnicodeWidthTable.Types

21−

22−-- | The lock used to make functions in this module thread-safe.

23−installLock :: MVar ()

24−{-# NOINLINE installLock #-}

25−installLock = unsafePerformIO $ newMVar ()

26−

27−-- | Returns True if and only if a custom table has been allocated and

28−-- marked as ready for use.

29−--

30−-- This function is thread-safe.

31−isCustomTableReady :: IO Bool

32−isCustomTableReady = withInstallLock $ (== 1) <$> c_isCustomTableReady

33−

34−withInstallLock :: IO a -> IO a

35−withInstallLock act = withMVar installLock $ const act

36−

37−-- This is the size of the allocated custom character width table, in

38−-- character slots. It's important that this be large enough to hold all

39−-- possible Unicode character values. At the time of this writing, the

40−-- valid Unicode range is 0 - 0x10ffff, hence this value.

41−tableSize :: Int

42−tableSize = 0x110000

43−

44−-- | Exception type raised by 'installUnicodeWidthTable'.

45−data TableInstallException =

46− TableInitFailure Int Int

47− -- ^ The width table could not be initialized. Args: failure status,

48− -- requested table size.

49− | TableRangeFailure Int WidthTableRange

50− -- ^ A code point range could not be configured. Args: failure

51− -- status, offending range.

52− | TableActivationFailure Int

53− -- ^ The table could not be activated. Args: failure status.

54− deriving (Eq, Show)

55−

56−instance E.Exception TableInstallException

57−

58−-- | Install a custom unicode character width

59−-- table. Such tables are obtained with

60−-- 'Graphics.Vty.UnicodeWidthTable.Query.buildUnicodeWidthTable' and

61−-- 'Graphics.Vty.UnicodeWidthTable.IO.readUnicodeWidthTable'.

62−--

63−-- ALERT! This function is probably not what you want to use because

64−-- it is automatically called by 'Graphics.Vty.mkVty'. You will only

65−-- ever need to call this function if you want to use functions

66−-- in 'Graphics.Text.Width' without controlling the terminal with

67−-- 'Graphics.Vty.mkVty'.

68−--

69−-- This affects the behavior of the 'Graphics.Vty.Image.wcwidth'

70−-- function and functions that call it. It does so by

71−-- changing global state available to the C implementation

72−-- of 'Graphics.Vty.Image.wcwidth'. To ensure that your

73−-- program gets consistent results from evaluating calls to

74−-- 'Graphics.Vty.Image.wcwidth', the installation of a custom table

75−-- should be performed before you call 'Graphics.Vty.Image.wcwidth' in

76−-- your program.

77−--

78−-- This is best done at Vty startup, and if you use

79−-- 'Graphics.Vty.mkVty', that function calls this automatically based on

80−-- the Vty configuration's declared width tables. It is exposed as part

81−-- of the public API so that applications can call this as needed if

82−-- they don't want to control the terminal with 'mkVty' but do want to

83−-- make calls to 'Graphics.Vty.Image.wcwidth'.

84−--

85−-- It's also important to note that once a custom table has been

86−-- installed, it is permanent for the life of the process. No new table

87−-- can be installed, and the new custom table cannot be removed.

88−--

89−-- If this function fails for any reason -- if the table cannot be

90−-- installed or is invalid, or if a custom table already exists -- this

91−-- will raise a 'TableInstallException' exception.

92−--

93−-- This function is thread-safe.

94−installUnicodeWidthTable :: UnicodeWidthTable -> IO ()

95−installUnicodeWidthTable table = withInstallLock $ do

96− initResult <- initCustomTable tableSize

97− when (initResult /= 0) $

98− E.throwIO $ TableInitFailure initResult tableSize

99−

100− forM_ (unicodeWidthTableRanges table) $ \r -> do

101− result <- setCustomTableRange (rangeStart r)

102− (rangeSize r)

103− (rangeColumns r)

104−

105− when (result /= 0) $ do

106− deallocateCustomTable

107− E.throwIO $ TableRangeFailure result r

108−

109− actResult <- activateCustomTable

110− when (actResult /= 0) $

111− E.throwIO $ TableActivationFailure actResult

112−

113−------------------------------------------------------------------------

114−-- C imports

115−

116−foreign import ccall unsafe "vty_init_custom_table"

117− initCustomTable :: Int -> IO Int

118−

119−foreign import ccall unsafe "vty_set_custom_table_range"

120− setCustomTableRange :: Word32 -> Word32 -> Word8 -> IO Int

121−

122−foreign import ccall unsafe "vty_activate_custom_table"

123− activateCustomTable :: IO Int

124−

125−foreign import ccall unsafe "vty_custom_table_ready"

126− c_isCustomTableReady :: IO Int

127−

128−foreign import ccall unsafe "vty_deallocate_custom_table"

129− deallocateCustomTable :: IO ()

src/Graphics/Vty/UnicodeWidthTable/Query.hsdeleted−79

@@ -1,79 +0,0 @@

1−{-# LANGUAGE TupleSections #-}

2−module Graphics.Vty.UnicodeWidthTable.Query

3− ( buildUnicodeWidthTable

4− , defaultUnicodeTableUpperBound

5− )

6−where

7−

8−import Control.Monad (forM)

9−import Data.Char (generalCategory, GeneralCategory(..))

10−import System.Console.ANSI (getCursorPosition)

11−import Text.Printf (printf)

12−

13−import Graphics.Vty.UnicodeWidthTable.Types

14−

15−shouldConsider :: Char -> Bool

16−shouldConsider c =

17− case generalCategory c of

18− Control -> False

19− NotAssigned -> False

20− Surrogate -> False

21− _ -> True

22−

23−charWidth :: Char -> IO Int

24−charWidth c = do

25− printf "\r"

26− putChar c

27− Just (_, col) <- getCursorPosition

28− return col

29−

30−-- | Convert a sequence of character/width pairs into a list of

31−-- run-length encoded ranges. This function assumes the pairs come

32−-- sorted by character ordinal value. It does not require that the

33−-- character range is fully covered by the sequence.

34−--

35−-- The result of this function is a list of ranges in reverse order

36−-- relative to the input sequence.

37−mkRanges :: [(Char, Int)] -> [WidthTableRange]

38−mkRanges pairs =

39− let convertedPairs = convert <$> pairs

40− convert (c, i) = (fromIntegral $ fromEnum c, fromIntegral i)

41−

42− go Nothing finishedRanges [] = finishedRanges

43− go (Just r) finishedRanges [] = r:finishedRanges

44−

45− go Nothing finishedRanges ((c, width):rest) =

46− go (Just $ WidthTableRange c 1 width) finishedRanges rest

47−

48− go (Just r@(WidthTableRange prevCh sz prevWidth)) finishedRanges ((c, width):rest) =

49− if c == prevCh + sz && prevWidth == width

50− then go (Just (WidthTableRange prevCh (sz + 1) prevWidth)) finishedRanges rest

51− else go (Just (WidthTableRange c 1 width)) (r:finishedRanges) rest

52−

53− in go Nothing [] convertedPairs

54−

55−-- The uppermost code point to consider when building Unicode width

56−-- tables.

57−defaultUnicodeTableUpperBound :: Char

58−defaultUnicodeTableUpperBound = '\xe0000'

59−

60−-- | Construct a unicode character width table by querying the terminal

61−-- connected to stdout. This works by emitting characters to stdout

62−-- and then querying the terminal to determine the resulting cursor

63−-- position in order to measure character widths. Consequently this will

64−-- generate a lot of output and may take a while, depending on your

65−-- system performance. This should not be run in a terminal while it is

66−-- controlled by Vty.

67−--

68−-- The argument specifies the upper bound code point to test when

69−-- building the table. This allows callers to decide how much of the

70−-- Unicode code point space to scan when building the table.

71−--

72−-- This does not handle exceptions.

73−buildUnicodeWidthTable :: Char -> IO UnicodeWidthTable

74−buildUnicodeWidthTable tableUpperBound = do

75− pairs <- forM (filter shouldConsider ['\0'..tableUpperBound]) $ \i ->

76− (i,) <$> charWidth i

77−

78− return UnicodeWidthTable { unicodeWidthTableRanges = reverse $ mkRanges pairs

79− }

src/Graphics/Vty/UnicodeWidthTable/Types.hsdeleted−29

@@ -1,29 +0,0 @@

1−module Graphics.Vty.UnicodeWidthTable.Types

2− ( UnicodeWidthTable(..)

3− , WidthTableRange(..)

4− )

5−where

6−

7−import Data.Word (Word8, Word32)

8−

9−-- | A range of code points in a width table.

10−data WidthTableRange =

11− WidthTableRange { rangeStart :: Word32

12− -- ^ The range's starting code point.

13− , rangeSize :: Word32

14− -- ^ The number of code points in the contiguous

15− -- range, beginning with the starting code point

16− -- ('rangeStart').

17− , rangeColumns :: Word8

18− -- ^ The terminal width, in columns, of all of the

19− -- characters corresponding to the code points in

20− -- this range.

21− }

22− deriving (Eq, Show)

23−

24−-- | A run-length-encoded table of Unicode character widths.

25−data UnicodeWidthTable =

26− UnicodeWidthTable { unicodeWidthTableRanges :: [WidthTableRange]

27− -- ^ The ranges in the table.

28− }

29− deriving (Show)

stack.yamlnew file+40

@@ -0,0 +1,40 @@

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+3−1

@@ -8,6 +8,8 @@ import Verify

88import Control.Applicative

99import Control.Monad

1010

11+import Data.Default (def)

12+

1113import System.Random

1214

1315rand :: Arbitrary a => IO a

@@ -19,7 +21,7 @@ randomImage = rand

1921randomPicture = picForImage <$> randomImage

2022

2123bench0 = do

22− vty <- mkVty defaultConfig

24+ vty <- mkVty def

2325 (w,h) <- displayBounds $ outputIface vty

2426 let pictures = replicateM 3000 randomPicture

2527 bench ps = do

test/BenchNoDiffOpt.hs+4−3

@@ -9,16 +9,17 @@ import Control.Concurrent( threadDelay )

99import Control.Monad( liftM2 )

1010

1111import qualified Data.ByteString.Char8 as B

12+import Data.Default (def)

1213import Data.List

1314

1415import System.Environment( getArgs )

1516import System.IO

1617import System.Random

1718

18−bench0 = do

19+bench0 = do

1920 let fixedGen = mkStdGen 0

2021 setStdGen fixedGen

21− vty <- mkVty defaultConfig

22+ vty <- mkVty def

2223 (w,h) <- displayBounds $ outputIface vty

2324 let images = return $ (image0, image1)

2425 image0 = charFill defAttr 'X' w h

@@ -28,7 +29,7 @@ bench0 = do

2829 shutdown vty

2930 return $ Bench images bench

3031

31−flipOut vty n image0 image1 =

32+flipOut vty n image0 image1 =

3233 let !pLeft = picForImage image0

3334 !pRight = picForImage image1

3435 wLeft 0 = return ()

test/BenchRenderChar.hs+9−7

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

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.

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

55module BenchRenderChar where

66

77import Graphics.Vty

@@ -9,8 +9,10 @@ import Verify

99

1010import Control.Monad ( forM_ )

1111

12+import Data.Default (def)

13+

1214bench0 = do

13− vty <- mkVty defaultConfig

15+ vty <- mkVty def

1416 (w,h) <- displayBounds $ outputIface vty

1517 let testChars = return $ take 500 $ cycle $ [ c | c <- ['a'..'z']]

1618 bench d = do

@@ -21,12 +23,12 @@ bench0 = do

2123 shutdown vty

2224 return $ Bench testChars bench

2325

24−testImageUsingChar c w h

26+testImageUsingChar c w h

2527 = vertCat $ replicate (fromIntegral h)

2628 $ horizCat $ map (char defAttr) (replicate (fromIntegral w) c)

2729

2830bench1 = do

29− vty <- mkVty defaultConfig

31+ vty <- mkVty def

3032 (w,h) <- displayBounds $ outputIface vty

3133 let testChars = return $ take 500 $ cycle $ [ c | c <- ['a'..'z']]

3234 bench d = do

test/BenchVerticalScroll.hs+6−4

@@ -6,6 +6,7 @@ import Verify

66import Control.Concurrent( threadDelay )

77import Control.Monad( liftM2 )

88

9+import Data.Default (def)

910import Data.List

1011import Data.Word

1112

@@ -13,10 +14,10 @@ import System.Environment( getArgs )

1314import System.IO

1415import System.Random

1516

16−bench0 = do

17+bench0 = do

1718 let fixedGen = mkStdGen 0

1819 setStdGen fixedGen

19− return $ Bench (return ()) (\() -> mkVty defaultConfig >>= liftM2 (>>) run shutdown)

20+ return $ Bench (return ()) (\() -> mkVty def >>= liftM2 (>>) run shutdown)

2021

2122run vt = mapM_ (\p -> update vt p) . benchgen =<< displayBounds (outputIface vt)

2223

@@ -48,12 +49,13 @@ pad :: Int -> Image -> Image

4849pad ml img = img <|> charFill defAttr ' ' (ml - imageWidth img) 1

4950

5051clines :: StdGen -> Int -> [Image]

51−clines g maxll = map (pad maxll . horizCat . map (uncurry string))

52+clines g maxll = map (pad maxll . horizCat . map (uncurry string))

5253 $ fold (length . snd) (lengths maxll g1) (nums g2)

5354 where (g1,g2) = split g

5455

5556benchgen :: DisplayRegion -> [Picture]

56−benchgen (w,h)

57+benchgen (w,h)

5758 = take 2000 $ map ((\i -> picForImage i) . vertCat . take (fromEnum h))

5859 $ tails

5960 $ 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+2−1

@@ -6,6 +6,7 @@ import Control.Applicative

66import Control.Arrow

77import Control.Monad.RWS

88

9+import Data.Default (def)

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

1011import qualified Data.Sequence as Seq

1112import Data.Foldable

@@ -15,7 +16,7 @@ eventBufferSize = 1000

1516type App = RWST Vty () (Seq String) IO

1617

1718main = do

18− vty <- mkVty defaultConfig

19+ vty <- mkVty def

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

2021 shutdown vty

2122

test/HereDoc.hs+4−2

@@ -1,7 +1,8 @@

11{-# LANGUAGE QuasiQuotes #-}

22{-# LANGUAGE TemplateHaskell #-}

3−-- From http://www.reddit.com/r/haskell/comments/8ereh/a_here_document_syntax/

4−-- copyright unknown?

3+{- From http://www.reddit.com/r/haskell/comments/8ereh/a_here_document_syntax/

4+ - copyright unknown?

5+ -}

56module HereDoc (heredoc) where

67

78import Language.Haskell.TH.Quote

@@ -10,3 +11,4 @@ import Language.Haskell.TH.Lib

1011

1112heredoc :: QuasiQuoter

1213heredoc = QuasiQuoter (litE . stringL) (litP . stringL) undefined undefined

14+

test/Issue18.hs+6−4

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

1−module Main where

1+module Main

2+ where

23

34import Graphics.Vty

45import Graphics.Vty.Debug

@@ -12,8 +13,8 @@ main = do

1213 play vty sx sy

1314

1415play :: Vty -> Int -> Int -> IO ()

15−play vty sx sy =

16− let

16+play vty sx sy =

17+ let

1718 testScreen = pic {

1819 pCursor = NoCursor

1920 , pImage = box 10 10 }

@@ -30,5 +31,6 @@ box w h =

3031 vertLine = renderFill attr '|' 1 (h - 2)

3132 horizLine = corner <|> renderHFill attr '-' (w - 2) <|> corner

3233 centerArea = vertLine <|> renderFill attr 'X' (w - 2) (h - 2) <|> vertLine

33− in

34+ in

3435 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+3−1

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

22

33import Graphics.Vty

44

5+import Data.Default

6+

57main = do

6− vty <- mkVty defaultConfig

8+ vty <- mkVty def

79 let line0 = string (def `withForeColor` green) "first line"

810 line1 = string (def `withBackColor` blue) "second line"

911 img = line0 <-> line1

test/Rogue.hs+3−1

@@ -1,8 +1,10 @@

1+{-# LANGUAGE TemplateHaskell #-}

12module Main where

23

34import Graphics.Vty

45

56import Data.Array

7+import Data.Default (def)

68

79import Control.Applicative

810import Control.Monad

@@ -41,7 +43,7 @@ type Coord = (Int, Int)

4143

4244main :: IO ()

4345main = do

44− vty <- mkVty defaultConfig

46+ vty <- mkVty def

4547 level0 <- mkLevel 1

4648 let world0 = World (Player (levelStart level0)) level0

4749 (_finalWorld, ()) <- execRWST play vty world0

test/Test2.hs−1

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

11module Main where

2−

32import Graphics.Vty

43

54main = do

test/Verify.hs+31−20

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

11{-# LANGUAGE RankNTypes #-}

22{-# LANGUAGE GADTs #-}

33{-# LANGUAGE RecordWildCards #-}

4+{-# LANGUAGE CPP #-}

45{-# LANGUAGE TypeSynonymInstances #-}

56{-# LANGUAGE FlexibleInstances #-}

67{-# LANGUAGE StandaloneDeriving #-}

78{-# LANGUAGE DisambiguateRecordFields #-}

89{-# LANGUAGE NamedFieldPuns #-}

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

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

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,5 +85,16 @@ 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+

8898data Bench where

8999 Bench :: forall v . NFData v => IO v -> (v -> IO ()) -> Bench

100+

test/Verify/Data/Terminfo/Parse.hs+17−17

@@ -1,8 +1,7 @@

1−module Verify.Data.Terminfo.Parse

2− ( module Verify.Data.Terminfo.Parse

3− , module Data.Terminfo.Parse

4− )

5−where

1+module Verify.Data.Terminfo.Parse ( module Verify.Data.Terminfo.Parse

2+ , module Data.Terminfo.Parse

3+ )

4+ where

65

76import Data.Terminfo.Parse

87import Data.Terminfo.Eval

@@ -20,22 +19,22 @@ data NonParamCapString = NonParamCapString String

2019 deriving Show

2120

2221instance Arbitrary NonParamCapString where

23− arbitrary

22+ arbitrary

2423 = ( do

2524 s <- listOf1 $ (choose (0, 255) >>= return . toEnum) `suchThat` (/= '%')

2625 return $ NonParamCapString s

27− ) `suchThat` ( \(NonParamCapString str) -> length str < 255 )

26+ ) `suchThat` ( \(NonParamCapString str) -> length str < 255 )

2827

2928data LiteralPercentCap = LiteralPercentCap String [Word8]

3029 deriving ( Show )

3130

3231instance Arbitrary LiteralPercentCap where

33− arbitrary

32+ arbitrary

3433 = ( do

3534 NonParamCapString s <- arbitrary

3635 (s', bytes) <- insertEscapeOp "%" [toEnum $ fromEnum '%'] s

3736 return $ LiteralPercentCap s' bytes

38− ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 )

37+ ) `suchThat` ( \(LiteralPercentCap str _) -> length str < 255 )

3938

4039data IncFirstTwoCap = IncFirstTwoCap String [Word8]

4140 deriving ( Show )

@@ -46,7 +45,7 @@ instance Arbitrary IncFirstTwoCap where

4645 NonParamCapString s <- arbitrary

4746 (s', bytes) <- insertEscapeOp "i" [] s

4847 return $ IncFirstTwoCap s' bytes

49− ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 )

48+ ) `suchThat` ( \(IncFirstTwoCap str _) -> length str < 255 )

5049

5150data PushParamCap = PushParamCap String Int [Word8]

5251 deriving ( Show )

@@ -58,7 +57,7 @@ instance Arbitrary PushParamCap where

5857 n <- choose (1,9)

5958 (s', bytes) <- insertEscapeOp ("p" ++ show n) [] s

6059 return $ PushParamCap s' n bytes

61− ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 )

60+ ) `suchThat` ( \(PushParamCap str _ _) -> length str < 255 )

6261

6362data DecPrintCap = DecPrintCap String Int [Word8]

6463 deriving ( Show )

@@ -70,7 +69,7 @@ instance Arbitrary DecPrintCap where

7069 n <- choose (1,9)

7170 (s', bytes) <- insertEscapeOp ("p" ++ show n ++ "%d") [] s

7271 return $ DecPrintCap s' n bytes

73− ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 )

72+ ) `suchThat` ( \(DecPrintCap str _ _) -> length str < 255 )

7473

7574insertEscapeOp opStr replBytes s = do

7675 insertPoints <- listOf1 $ elements [0 .. length s - 1]

@@ -93,20 +92,21 @@ bytesForRange cap offset count

9392 = Vector.toList $ Vector.take count $ Vector.drop offset $ capBytes cap

9493

9594collectBytes :: CapExpression -> [Word8]

96−collectBytes e = concat [ bytes

95+collectBytes e = concat [ bytes

9796 | Bytes offset count <- capOps e

9897 , let bytes = bytesForRange e offset count

9998 ]

100−

99+

101100

102101verifyBytesEqual :: [Word8] -> [Word8] -> Result

103−verifyBytesEqual outBytes expectedBytes

102+verifyBytesEqual outBytes expectedBytes

104103 = if outBytes == expectedBytes

105104 then succeeded

106− else failed

107− { reason = "outBytes ["

105+ else failed

106+ { reason = "outBytes ["

108107 ++ hexDump outBytes

109108 ++ "] /= expectedBytes ["

110109 ++ hexDump expectedBytes

111110 ++ "]"

112111 }

112+

test/Verify/Graphics/Vty/Attributes.hs+7−7

@@ -1,8 +1,7 @@

1−module Verify.Graphics.Vty.Attributes

2− ( module Verify.Graphics.Vty.Attributes

3− , module Graphics.Vty.Attributes

4− )

5−where

1+module Verify.Graphics.Vty.Attributes ( module Verify.Graphics.Vty.Attributes

2+ , module Graphics.Vty.Attributes

3+ )

4+ where

65

76import Graphics.Vty.Attributes

87import Verify

@@ -41,8 +40,8 @@ allStyles =

4140

4241-- Limit the possible attributes to just a few for now.

4342possibleAttrMods :: [ AttrOp ]

44−possibleAttrMods =

45− [ idOp

43+possibleAttrMods =

44+ [ idOp

4645 ] ++ map setForeColorOp allColors

4746 ++ map setBackColorOp allColors

4847 ++ map setStyleOp allStyles

@@ -71,3 +70,4 @@ idOp = AttrOp "id" id

7170

7271applyOp :: AttrOp -> Attr -> Attr

7372applyOp (AttrOp _ f) a = f a

73+

test/Verify/Graphics/Vty/DisplayAttributes.hs+5−5

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

1−module Verify.Graphics.Vty.DisplayAttributes

2− ( module Verify.Graphics.Vty.DisplayAttributes

3− , module Graphics.Vty.DisplayAttributes

4− )

5−where

1+module Verify.Graphics.Vty.DisplayAttributes ( module Verify.Graphics.Vty.DisplayAttributes

2+ , module Graphics.Vty.DisplayAttributes

3+ )

4+ where

65

76import Graphics.Vty.DisplayAttributes

87import Verify

8+

test/Verify/Graphics/Vty/Image.hs+18−18

@@ -1,11 +1,10 @@

11{-# LANGUAGE BangPatterns #-}

22{-# LANGUAGE NamedFieldPuns #-}

33{-# LANGUAGE DisambiguateRecordFields #-}

4−module Verify.Graphics.Vty.Image

5− ( module Verify.Graphics.Vty.Image

6− , module Graphics.Vty.Image

7− )

8−where

4+module Verify.Graphics.Vty.Image ( module Verify.Graphics.Vty.Image

5+ , module Graphics.Vty.Image

6+ )

7+ where

98

109import Verify.Graphics.Vty.Attributes

1110import Graphics.Vty.Image

@@ -27,7 +26,7 @@ instance Show UnitImage where

2726data DefaultImage = DefaultImage Image

2827

2928instance Show DefaultImage where

30− show (DefaultImage i)

29+ show (DefaultImage i)

3130 = "DefaultImage (" ++ show i ++ ") " ++ show (imageWidth i, imageHeight i)

3231

3332instance Arbitrary DefaultImage where

@@ -35,15 +34,15 @@ instance Arbitrary DefaultImage where

3534 i <- return $ char defAttr 'X'

3635 return $ DefaultImage i

3736

38−data SingleRowSingleAttrImage

39− = SingleRowSingleAttrImage

37+data SingleRowSingleAttrImage

38+ = SingleRowSingleAttrImage

4039 { expectedAttr :: Attr

4140 , expectedColumns :: Int

4241 , rowImage :: Image

4342 }

4443

4544instance Show SingleRowSingleAttrImage where

46− show (SingleRowSingleAttrImage attr columns image)

45+ show (SingleRowSingleAttrImage attr columns image)

4746 = "SingleRowSingleAttrImage (" ++ show attr ++ ") " ++ show columns ++ " ( " ++ show image ++ " )"

4847

4948newtype WidthResize = WidthResize (Image -> (Image, Int))

@@ -85,14 +84,14 @@ instance Arbitrary ImageResize where

8584 , do

8685 ImageResize f <- arbitrary

8786 WidthResize g <- arbitrary

88− return $! ImageResize $! \i ->

87+ return $! ImageResize $! \i ->

8988 let (i0, (_, outHeight)) = f i

9089 gI = g i0

9190 in (fst gI, (snd gI, outHeight))

9291 , do

9392 ImageResize f <- arbitrary

9493 HeightResize g <- arbitrary

95− return $! ImageResize $! \i ->

94+ return $! ImageResize $! \i ->

9695 let (i0, (outWidth, _)) = f i

9796 gI = g i0

9897 in (fst gI, (outWidth, snd gI))

@@ -101,17 +100,17 @@ instance Arbitrary ImageResize where

101100

102101instance Arbitrary SingleRowSingleAttrImage where

103102 arbitrary = do

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

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

107106 singleColumnRowText <- Verify.resize 16 (listOf1 arbitrary)

108107 a <- arbitrary

109108 let outImage = horizCat $ [char a c | SingleColumnChar c <- singleColumnRowText]

110109 outWidth = length singleColumnRowText

111110 return $ SingleRowSingleAttrImage a outWidth outImage

112111

113−data SingleRowTwoAttrImage

114− = SingleRowTwoAttrImage

112+data SingleRowTwoAttrImage

113+ = SingleRowTwoAttrImage

115114 { part0 :: SingleRowSingleAttrImage

116115 , part1 :: SingleRowSingleAttrImage

117116 , joinImage :: Image

@@ -123,8 +122,8 @@ instance Arbitrary SingleRowTwoAttrImage where

123122 p1 <- arbitrary

124123 return $ SingleRowTwoAttrImage p0 p1 (rowImage p0 <|> rowImage p1)

125124

126−data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack

127− { stackImage :: Image

125+data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack

126+ { stackImage :: Image

128127 , stackSourceImages :: [SingleRowSingleAttrImage]

129128 , stackWidth :: Int

130129 , stackHeight :: Int

@@ -216,3 +215,4 @@ instance Arbitrary Translation where

216215 y <- arbitrary `suchThat` (> 0)

217216 let i' = translate x y i

218217 return $ Translation i (x,y) i'

218+

test/Verify/Graphics/Vty/Output.hs+7−5

@@ -4,17 +4,18 @@ import Control.Applicative ((<$>))

44

55import Graphics.Vty.Output.Mock

66

7+import qualified Data.ByteString as BS

78import Data.IORef

89import qualified Data.String.UTF8 as UTF8

910

1011import Test.QuickCheck.Property

1112

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.

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.

1617terminalsOfInterest :: [String]

17−terminalsOfInterest =

18+terminalsOfInterest =

1819 [ "vt100"

1920 , "vt220"

2021 , "vt102"

@@ -57,3 +58,4 @@ compareMockOutput mockData expectedStr = do

5758 ++ expectedStr

5859 }

5960 else return succeeded

61+

test/Verify/Graphics/Vty/Picture.hs+13−13

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

11{-# LANGUAGE DisambiguateRecordFields #-}

2−module Verify.Graphics.Vty.Picture

3− ( module Verify.Graphics.Vty.Picture

4− , module Graphics.Vty.Picture

5− )

6−where

2+module Verify.Graphics.Vty.Picture ( module Verify.Graphics.Vty.Picture

3+ , module Graphics.Vty.Picture

4+ )

5+ where

76

87import Verify.Graphics.Vty.Prelude

98

@@ -15,9 +14,9 @@ import Verify.Graphics.Vty.Image

1514

1615import Verify

1716

18−data DefaultPic = DefaultPic

17+data DefaultPic = DefaultPic

1918 { defaultPic :: Picture

20− , defaultWin :: MockWindow

19+ , defaultWin :: MockWindow

2120 }

2221

2322instance Show DefaultPic where

@@ -28,10 +27,10 @@ instance Arbitrary DefaultPic where

2827 arbitrary = do

2928 DefaultImage image <- arbitrary

3029 let win = MockWindow (imageWidth image) (imageHeight image)

31− return $ DefaultPic (picForImage image)

32− win

30+ return $ DefaultPic (picForImage image)

31+ win

3332

34−data PicWithBGAttr = PicWithBGAttr

33+data PicWithBGAttr = PicWithBGAttr

3534 { withAttrPic :: Picture

3635 , withAttrWin :: MockWindow

3736 , withAttrSpecifiedAttr :: Attr

@@ -42,11 +41,12 @@ instance Arbitrary PicWithBGAttr where

4241 DefaultImage image <- arbitrary

4342 let win = MockWindow (imageWidth image) (imageHeight image)

4443 attr <- arbitrary

45− return $ PicWithBGAttr (picForImage image)

46− win

44+ return $ PicWithBGAttr (picForImage image)

45+ win

4746 attr

48−

47+

4948instance Arbitrary Picture where

5049 arbitrary = do

5150 layers <- Verify.resize 20 (listOf1 arbitrary)

5251 return $ picForLayers layers

52+

test/Verify/Graphics/Vty/Prelude.hs+7−5

@@ -1,8 +1,10 @@

1−module Verify.Graphics.Vty.Prelude

2− ( module Verify.Graphics.Vty.Prelude

3− , MockWindow(..)

4− )

5−where

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

68

79import Graphics.Vty.Debug

810

test/Verify/Graphics/Vty/Span.hs+7−7

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

11{-# LANGUAGE FlexibleInstances #-}

2−module Verify.Graphics.Vty.Span

3− ( module Verify.Graphics.Vty.Span

4− , module Graphics.Vty.Span

5− )

6−where

2+module Verify.Graphics.Vty.Span ( module Verify.Graphics.Vty.Span

3+ , module Graphics.Vty.Span

4+ )

5+ where

76

87import Graphics.Vty.Debug

98import Graphics.Vty.Span

@@ -20,10 +19,10 @@ isAttrSpanOp TextSpan {} = True

2019isAttrSpanOp _ = False

2120

2221verifyAllSpansHaveWidth i spans w

23− = let v = map (\s -> (spanOpsAffectedColumns s /= w, s)) (Vector.toList spans)

22+ = let v = map (\s -> (spanOpsEffectedColumns s /= w, s)) (Vector.toList spans)

2423 in case any ((== True) . fst) v of

2524 False -> succeeded

26− True -> failed { reason = "Not all spans contained operations defining exactly "

25+ True -> failed { reason = "Not all spans contained operations defining exactly "

2726 ++ show w

2827 ++ " columns of output - \n"

2928 ++ (concatMap ((++ "\n") . show)) v

@@ -35,3 +34,4 @@ verifyOpsEquality i_ops i_alt_ops =

3534 else failed { reason = "ops for alternate image " ++ show i_alt_ops

3635 ++ " are not the same as " ++ show i_ops

3736 }

37+

test/VerifyAttributeOps.hsnew file+9

@@ -0,0 +1,9 @@

1+module VerifyAttributeOps where

2+

3+import Verify.Graphics.Vty.Attributes

4+

5+import Verify

6+

7+tests :: IO [Test]

8+tests = return []

9+

test/VerifyColor240.hsdeleted−269

@@ -1,269 +0,0 @@

1−module VerifyColor240 where

2−

3−import Data.Word(Word8)

4−import Verify

5−

6−import Graphics.Vty.Attributes.Color240(rgbColorToColor240)

7−

8−oldRgbColorToColor240 :: Integral i => i -> i -> i -> Word8

9−oldRgbColorToColor240 r g b

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

11− | r == 8 && g == 8 && b == 8 = 216

12− | r == 18 && g == 18 && b == 18 = 217

13− | r == 28 && g == 28 && b == 28 = 218

14− | r == 38 && g == 38 && b == 38 = 219

15− | r == 48 && g == 48 && b == 48 = 220

16− | r == 58 && g == 58 && b == 58 = 221

17− | r == 68 && g == 68 && b == 68 = 222

18− | r == 78 && g == 78 && b == 78 = 223

19− | r == 88 && g == 88 && b == 88 = 224

20− | r == 98 && g == 98 && b == 98 = 225

21− | r == 108 && g == 108 && b == 108 = 226

22− | r == 118 && g == 118 && b == 118 = 227

23− | r == 128 && g == 128 && b == 128 = 228

24− | r == 138 && g == 138 && b == 138 = 229

25− | r == 148 && g == 148 && b == 148 = 230

26− | r == 158 && g == 158 && b == 158 = 231

27− | r == 168 && g == 168 && b == 168 = 232

28− | r == 178 && g == 178 && b == 178 = 233

29− | r == 188 && g == 188 && b == 188 = 234

30− | r == 198 && g == 198 && b == 198 = 235

31− | r == 208 && g == 208 && b == 208 = 236

32− | r == 218 && g == 218 && b == 218 = 237

33− | r == 228 && g == 228 && b == 228 = 238

34− | r == 238 && g == 238 && b == 238 = 239

35− | r <= 0 && g <= 0 && b <= 0 = 0

36− | r <= 0 && g <= 0 && b <= 95 = 1

37− | r <= 0 && g <= 0 && b <= 135 = 2

38− | r <= 0 && g <= 0 && b <= 175 = 3

39− | r <= 0 && g <= 0 && b <= 215 = 4

40− | r <= 0 && g <= 0 && b <= 255 = 5

41− | r <= 0 && g <= 95 && b <= 0 = 6

42− | r <= 0 && g <= 95 && b <= 95 = 7

43− | r <= 0 && g <= 95 && b <= 135 = 8

44− | r <= 0 && g <= 95 && b <= 175 = 9

45− | r <= 0 && g <= 95 && b <= 215 = 10

46− | r <= 0 && g <= 95 && b <= 255 = 11

47− | r <= 0 && g <= 135 && b <= 0 = 12

48− | r <= 0 && g <= 135 && b <= 95 = 13

49− | r <= 0 && g <= 135 && b <= 135 = 14

50− | r <= 0 && g <= 135 && b <= 175 = 15

51− | r <= 0 && g <= 135 && b <= 215 = 16

52− | r <= 0 && g <= 135 && b <= 255 = 17

53− | r <= 0 && g <= 175 && b <= 0 = 18

54− | r <= 0 && g <= 175 && b <= 95 = 19

55− | r <= 0 && g <= 175 && b <= 135 = 20

56− | r <= 0 && g <= 175 && b <= 175 = 21

57− | r <= 0 && g <= 175 && b <= 215 = 22

58− | r <= 0 && g <= 175 && b <= 255 = 23

59− | r <= 0 && g <= 215 && b <= 0 = 24

60− | r <= 0 && g <= 215 && b <= 95 = 25

61− | r <= 0 && g <= 215 && b <= 135 = 26

62− | r <= 0 && g <= 215 && b <= 175 = 27

63− | r <= 0 && g <= 215 && b <= 215 = 28

64− | r <= 0 && g <= 215 && b <= 255 = 29

65− | r <= 0 && g <= 255 && b <= 0 = 30

66− | r <= 0 && g <= 255 && b <= 95 = 31

67− | r <= 0 && g <= 255 && b <= 135 = 32

68− | r <= 0 && g <= 255 && b <= 175 = 33

69− | r <= 0 && g <= 255 && b <= 215 = 34

70− | r <= 0 && g <= 255 && b <= 255 = 35

71− | r <= 95 && g <= 0 && b <= 0 = 36

72− | r <= 95 && g <= 0 && b <= 95 = 37

73− | r <= 95 && g <= 0 && b <= 135 = 38

74− | r <= 95 && g <= 0 && b <= 175 = 39

75− | r <= 95 && g <= 0 && b <= 215 = 40

76− | r <= 95 && g <= 0 && b <= 255 = 41

77− | r <= 95 && g <= 95 && b <= 0 = 42

78− | r <= 95 && g <= 95 && b <= 95 = 43

79− | r <= 95 && g <= 95 && b <= 135 = 44

80− | r <= 95 && g <= 95 && b <= 175 = 45

81− | r <= 95 && g <= 95 && b <= 215 = 46

82− | r <= 95 && g <= 95 && b <= 255 = 47

83− | r <= 95 && g <= 135 && b <= 0 = 48

84− | r <= 95 && g <= 135 && b <= 95 = 49

85− | r <= 95 && g <= 135 && b <= 135 = 50

86− | r <= 95 && g <= 135 && b <= 175 = 51

87− | r <= 95 && g <= 135 && b <= 215 = 52

88− | r <= 95 && g <= 135 && b <= 255 = 53

89− | r <= 95 && g <= 175 && b <= 0 = 54

90− | r <= 95 && g <= 175 && b <= 95 = 55

91− | r <= 95 && g <= 175 && b <= 135 = 56

92− | r <= 95 && g <= 175 && b <= 175 = 57

93− | r <= 95 && g <= 175 && b <= 215 = 58

94− | r <= 95 && g <= 175 && b <= 255 = 59

95− | r <= 95 && g <= 215 && b <= 0 = 60

96− | r <= 95 && g <= 215 && b <= 95 = 61

97− | r <= 95 && g <= 215 && b <= 135 = 62

98− | r <= 95 && g <= 215 && b <= 175 = 63

99− | r <= 95 && g <= 215 && b <= 215 = 64

100− | r <= 95 && g <= 215 && b <= 255 = 65

101− | r <= 95 && g <= 255 && b <= 0 = 66

102− | r <= 95 && g <= 255 && b <= 95 = 67

103− | r <= 95 && g <= 255 && b <= 135 = 68

104− | r <= 95 && g <= 255 && b <= 175 = 69

105− | r <= 95 && g <= 255 && b <= 215 = 70

106− | r <= 95 && g <= 255 && b <= 255 = 71

107− | r <= 135 && g <= 0 && b <= 0 = 72

108− | r <= 135 && g <= 0 && b <= 95 = 73

109− | r <= 135 && g <= 0 && b <= 135 = 74

110− | r <= 135 && g <= 0 && b <= 175 = 75

111− | r <= 135 && g <= 0 && b <= 215 = 76

112− | r <= 135 && g <= 0 && b <= 255 = 77

113− | r <= 135 && g <= 95 && b <= 0 = 78

114− | r <= 135 && g <= 95 && b <= 95 = 79

115− | r <= 135 && g <= 95 && b <= 135 = 80

116− | r <= 135 && g <= 95 && b <= 175 = 81

117− | r <= 135 && g <= 95 && b <= 215 = 82

118− | r <= 135 && g <= 95 && b <= 255 = 83

119− | r <= 135 && g <= 135 && b <= 0 = 84

120− | r <= 135 && g <= 135 && b <= 95 = 85

121− | r <= 135 && g <= 135 && b <= 135 = 86

122− | r <= 135 && g <= 135 && b <= 175 = 87

123− | r <= 135 && g <= 135 && b <= 215 = 88

124− | r <= 135 && g <= 135 && b <= 255 = 89

125− | r <= 135 && g <= 175 && b <= 0 = 90

126− | r <= 135 && g <= 175 && b <= 95 = 91

127− | r <= 135 && g <= 175 && b <= 135 = 92

128− | r <= 135 && g <= 175 && b <= 175 = 93

129− | r <= 135 && g <= 175 && b <= 215 = 94

130− | r <= 135 && g <= 175 && b <= 255 = 95

131− | r <= 135 && g <= 215 && b <= 0 = 96

132− | r <= 135 && g <= 215 && b <= 95 = 97

133− | r <= 135 && g <= 215 && b <= 135 = 98

134− | r <= 135 && g <= 215 && b <= 175 = 99

135− | r <= 135 && g <= 215 && b <= 215 = 100

136− | r <= 135 && g <= 215 && b <= 255 = 101

137− | r <= 135 && g <= 255 && b <= 0 = 102

138− | r <= 135 && g <= 255 && b <= 95 = 103

139− | r <= 135 && g <= 255 && b <= 135 = 104

140− | r <= 135 && g <= 255 && b <= 175 = 105

141− | r <= 135 && g <= 255 && b <= 215 = 106

142− | r <= 135 && g <= 255 && b <= 255 = 107

143− | r <= 175 && g <= 0 && b <= 0 = 108

144− | r <= 175 && g <= 0 && b <= 95 = 109

145− | r <= 175 && g <= 0 && b <= 135 = 110

146− | r <= 175 && g <= 0 && b <= 175 = 111

147− | r <= 175 && g <= 0 && b <= 215 = 112

148− | r <= 175 && g <= 0 && b <= 255 = 113

149− | r <= 175 && g <= 95 && b <= 0 = 114

150− | r <= 175 && g <= 95 && b <= 95 = 115

151− | r <= 175 && g <= 95 && b <= 135 = 116

152− | r <= 175 && g <= 95 && b <= 175 = 117

153− | r <= 175 && g <= 95 && b <= 215 = 118

154− | r <= 175 && g <= 95 && b <= 255 = 119

155− | r <= 175 && g <= 135 && b <= 0 = 120

156− | r <= 175 && g <= 135 && b <= 95 = 121

157− | r <= 175 && g <= 135 && b <= 135 = 122

158− | r <= 175 && g <= 135 && b <= 175 = 123

159− | r <= 175 && g <= 135 && b <= 215 = 124

160− | r <= 175 && g <= 135 && b <= 255 = 125

161− | r <= 175 && g <= 175 && b <= 0 = 126

162− | r <= 175 && g <= 175 && b <= 95 = 127

163− | r <= 175 && g <= 175 && b <= 135 = 128

164− | r <= 175 && g <= 175 && b <= 175 = 129

165− | r <= 175 && g <= 175 && b <= 215 = 130

166− | r <= 175 && g <= 175 && b <= 255 = 131

167− | r <= 175 && g <= 215 && b <= 0 = 132

168− | r <= 175 && g <= 215 && b <= 95 = 133

169− | r <= 175 && g <= 215 && b <= 135 = 134

170− | r <= 175 && g <= 215 && b <= 175 = 135

171− | r <= 175 && g <= 215 && b <= 215 = 136

172− | r <= 175 && g <= 215 && b <= 255 = 137

173− | r <= 175 && g <= 255 && b <= 0 = 138

174− | r <= 175 && g <= 255 && b <= 95 = 139

175− | r <= 175 && g <= 255 && b <= 135 = 140

176− | r <= 175 && g <= 255 && b <= 175 = 141

177− | r <= 175 && g <= 255 && b <= 215 = 142

178− | r <= 175 && g <= 255 && b <= 255 = 143

179− | r <= 215 && g <= 0 && b <= 0 = 144

180− | r <= 215 && g <= 0 && b <= 95 = 145

181− | r <= 215 && g <= 0 && b <= 135 = 146

182− | r <= 215 && g <= 0 && b <= 175 = 147

183− | r <= 215 && g <= 0 && b <= 215 = 148

184− | r <= 215 && g <= 0 && b <= 255 = 149

185− | r <= 215 && g <= 95 && b <= 0 = 150

186− | r <= 215 && g <= 95 && b <= 95 = 151

187− | r <= 215 && g <= 95 && b <= 135 = 152

188− | r <= 215 && g <= 95 && b <= 175 = 153

189− | r <= 215 && g <= 95 && b <= 215 = 154

190− | r <= 215 && g <= 95 && b <= 255 = 155

191− | r <= 215 && g <= 135 && b <= 0 = 156

192− | r <= 215 && g <= 135 && b <= 95 = 157

193− | r <= 215 && g <= 135 && b <= 135 = 158

194− | r <= 215 && g <= 135 && b <= 175 = 159

195− | r <= 215 && g <= 135 && b <= 215 = 160

196− | r <= 215 && g <= 135 && b <= 255 = 161

197− | r <= 215 && g <= 175 && b <= 0 = 162

198− | r <= 215 && g <= 175 && b <= 95 = 163

199− | r <= 215 && g <= 175 && b <= 135 = 164

200− | r <= 215 && g <= 175 && b <= 175 = 165

201− | r <= 215 && g <= 175 && b <= 215 = 166

202− | r <= 215 && g <= 175 && b <= 255 = 167

203− | r <= 215 && g <= 215 && b <= 0 = 168

204− | r <= 215 && g <= 215 && b <= 95 = 169

205− | r <= 215 && g <= 215 && b <= 135 = 170

206− | r <= 215 && g <= 215 && b <= 175 = 171

207− | r <= 215 && g <= 215 && b <= 215 = 172

208− | r <= 215 && g <= 215 && b <= 255 = 173

209− | r <= 215 && g <= 255 && b <= 0 = 174

210− | r <= 215 && g <= 255 && b <= 95 = 175

211− | r <= 215 && g <= 255 && b <= 135 = 176

212− | r <= 215 && g <= 255 && b <= 175 = 177

213− | r <= 215 && g <= 255 && b <= 215 = 178

214− | r <= 215 && g <= 255 && b <= 255 = 179

215− | r <= 255 && g <= 0 && b <= 0 = 180

216− | r <= 255 && g <= 0 && b <= 95 = 181

217− | r <= 255 && g <= 0 && b <= 135 = 182

218− | r <= 255 && g <= 0 && b <= 175 = 183

219− | r <= 255 && g <= 0 && b <= 215 = 184

220− | r <= 255 && g <= 0 && b <= 255 = 185

221− | r <= 255 && g <= 95 && b <= 0 = 186

222− | r <= 255 && g <= 95 && b <= 95 = 187

223− | r <= 255 && g <= 95 && b <= 135 = 188

224− | r <= 255 && g <= 95 && b <= 175 = 189

225− | r <= 255 && g <= 95 && b <= 215 = 190

226− | r <= 255 && g <= 95 && b <= 255 = 191

227− | r <= 255 && g <= 135 && b <= 0 = 192

228− | r <= 255 && g <= 135 && b <= 95 = 193

229− | r <= 255 && g <= 135 && b <= 135 = 194

230− | r <= 255 && g <= 135 && b <= 175 = 195

231− | r <= 255 && g <= 135 && b <= 215 = 196

232− | r <= 255 && g <= 135 && b <= 255 = 197

233− | r <= 255 && g <= 175 && b <= 0 = 198

234− | r <= 255 && g <= 175 && b <= 95 = 199

235− | r <= 255 && g <= 175 && b <= 135 = 200

236− | r <= 255 && g <= 175 && b <= 175 = 201

237− | r <= 255 && g <= 175 && b <= 215 = 202

238− | r <= 255 && g <= 175 && b <= 255 = 203

239− | r <= 255 && g <= 215 && b <= 0 = 204

240− | r <= 255 && g <= 215 && b <= 95 = 205

241− | r <= 255 && g <= 215 && b <= 135 = 206

242− | r <= 255 && g <= 215 && b <= 175 = 207

243− | r <= 255 && g <= 215 && b <= 215 = 208

244− | r <= 255 && g <= 215 && b <= 255 = 209

245− | r <= 255 && g <= 255 && b <= 0 = 210

246− | r <= 255 && g <= 255 && b <= 95 = 211

247− | r <= 255 && g <= 255 && b <= 135 = 212

248− | r <= 255 && g <= 255 && b <= 175 = 213

249− | r <= 255 && g <= 255 && b <= 215 = 214

250− | r <= 255 && g <= 255 && b <= 255 = 215

251− | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."

252− (fromIntegral r :: Int)

253− (fromIntegral g :: Int)

254− (fromIntegral b :: Int))

255−

256−sameColor :: Int -> Int -> Int -> Bool

257−sameColor r g b = oldRgbColorToColor240 r g b == rgbColorToColor240 r g b

258−

259−genVal :: Gen Int

260−genVal = chooseInt (0, 255)

261−

262−sameColorCheck :: Property

263−sameColorCheck = forAll genVal (\r -> forAll genVal (\g -> forAll genVal (sameColor r g)))

264−

265−tests :: IO [Test]

266−tests = return

267− [ verify "check rgbColorToColor240 optimization is correct" sameColorCheck

268− ]

269−

test/VerifyConfig.hs+3−1

@@ -4,6 +4,7 @@ module Main where

44import Graphics.Vty.Config

55import Graphics.Vty.Input.Events

66

7+import Data.Default

78import Data.String.QQ

89import qualified Data.ByteString.Char8 as B

910

@@ -23,7 +24,7 @@ debugLog "/tmp/vty-debug.txt"

2324|]

2425

2526exampleConfigConfig :: Config

26−exampleConfigConfig = defaultConfig

27+exampleConfigConfig = def

2728 { debugLog = Just "/tmp/vty-debug.txt"

2829 , inputMap = [ (Nothing, "\ESC[B", EvKey KUp [])

2930 , (Nothing, "\ESC[1;3B", EvKey KDown [MAlt])

@@ -42,3 +43,4 @@ main :: IO ()

4243main = defaultMain

4344 [ testCase "example config parses" $ exampleConfigParses

4445 ]

46+

test/VerifyCropSpanGeneration.hs+3−2

@@ -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,3 +90,4 @@ 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+1−2

@@ -1,10 +1,9 @@

1−{-# LANGUAGE ScopedTypeVariables #-}

21module VerifyEmptyImageProps where

32

43import Verify

54

65-- should be exported by Graphics.Vty.Picture

7−import Graphics.Vty.Image ( Image, emptyImage )

6+import Graphics.Vty.Picture ( Image, emptyImage )

87

98tests :: IO [Test]

109tests = do

test/VerifyEvalTerminfoCaps.hs+12−14

@@ -1,10 +1,9 @@

11{-# LANGUAGE BangPatterns #-}

22{-# LANGUAGE NamedFieldPuns #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

43module VerifyEvalTerminfoCaps where

54

65import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)

7−import Data.Terminfo.Eval

6+import Data.Terminfo.Eval

87import Data.Terminfo.Parse

98import Control.DeepSeq

109

@@ -25,9 +24,8 @@ import Foreign.Marshal.Alloc (mallocBytes)

2524import Foreign.Ptr (Ptr, minusPtr)

2625import Numeric

2726

28−-- If a terminal defines one of the caps then it's expected to be

29−-- parsable.

30−capsOfInterest =

27+-- If a terminal defines one of the caps then it's expected to be parsable.

28+capsOfInterest =

3129 [ "cup"

3230 , "sc"

3331 , "rc"

@@ -51,13 +49,12 @@ fromCapname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr na

5149

5250tests :: IO [Test]

5351tests = do

54− -- 1 MB should be big enough for any termcaps ;-)

55− evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024)

52+ evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024) -- Should be big enough for any termcaps ;-)

5653 fmap concat $ forM terminalsOfInterest $ \termName -> do

5754 putStrLn $ "adding tests for terminal: " ++ termName

5855 mti <- try $ Terminfo.setupTerm termName

5956 case mti of

60− Left (_e :: SomeException)

57+ Left (_e :: SomeException)

6158 -> return []

6259 Right ti -> do

6360 fmap concat $ forM capsOfInterest $ \capName -> do

@@ -74,7 +71,7 @@ tests = do

7471{-# NOINLINE verifyEvalCap #-}

7572verifyEvalCap :: Ptr Word8 -> CapExpression -> Int -> Property

7673verifyEvalCap evalBuffer expr !junkInt = do

77− forAll (vector 9) $ \inputValues ->

74+ forAll (vector 9) $ \inputValues ->

7875 let write = writeCapExpr expr inputValues

7976 !byteCount = getBound write

8077 in liftIOResult $ do

@@ -82,11 +79,12 @@ verifyEvalCap evalBuffer expr !junkInt = do

8279 forM_ [0..100] $ \i -> runWrite write startPtr

8380 endPtr <- runWrite write startPtr

8481 case endPtr `minusPtr` startPtr of

85− count | count < 0 ->

82+ count | count < 0 ->

8683 return $ failed { reason = "End pointer before start pointer." }

87− | toEnum count > byteCount ->

88− return $ failed { reason = "End pointer past end of buffer by "

89− ++ show (toEnum count - byteCount)

84+ | toEnum count > byteCount ->

85+ return $ failed { reason = "End pointer past end of buffer by "

86+ ++ show (toEnum count - byteCount)

9087 }

91− | otherwise ->

88+ | otherwise ->

9289 return succeeded

90+

test/VerifyImageOps.hs+27−27

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

1−{-# LANGUAGE ScopedTypeVariables #-}

21module VerifyImageOps where

32

43import Graphics.Vty.Attributes

@@ -10,43 +9,43 @@ import Verify

109import Control.DeepSeq

1110

1211twoSwHorizConcat :: SingleColumnChar -> SingleColumnChar -> Bool

13−twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) =

12+twoSwHorizConcat (SingleColumnChar c1) (SingleColumnChar c2) =

1413 imageWidth (char defAttr c1 <|> char defAttr c2) == 2

1514

1615manySwHorizConcat :: [SingleColumnChar] -> Bool

17−manySwHorizConcat cs =

16+manySwHorizConcat cs =

1817 let chars = [ char | SingleColumnChar char <- cs ]

1918 l = fromIntegral $ length cs

2019 in imageWidth ( horizCat $ map (char defAttr) chars ) == l

2120

2221twoSwVertConcat :: SingleColumnChar -> SingleColumnChar -> Bool

23−twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) =

22+twoSwVertConcat (SingleColumnChar c1) (SingleColumnChar c2) =

2423 imageHeight (char defAttr c1 <-> char defAttr c2) == 2

2524

2625horizConcatSwAssoc :: SingleColumnChar -> SingleColumnChar -> SingleColumnChar -> Bool

27−horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =

28− (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

29− ==

26+horizConcatSwAssoc (SingleColumnChar c0) (SingleColumnChar c1) (SingleColumnChar c2) =

27+ (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

28+ ==

3029 char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)

3130

3231twoDwHorizConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool

33−twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

32+twoDwHorizConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

3433 imageWidth (char defAttr c1 <|> char defAttr c2) == 4

3534

3635manyDwHorizConcat :: [DoubleColumnChar] -> Bool

37−manyDwHorizConcat cs =

36+manyDwHorizConcat cs =

3837 let chars = [ char | DoubleColumnChar char <- cs ]

3938 l = fromIntegral $ length cs

4039 in imageWidth ( horizCat $ map (char defAttr) chars ) == l * 2

4140

4241twoDwVertConcat :: DoubleColumnChar -> DoubleColumnChar -> Bool

43−twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

42+twoDwVertConcat (DoubleColumnChar c1) (DoubleColumnChar c2) =

4443 imageHeight (char defAttr c1 <-> char defAttr c2) == 2

4544

4645horizConcatDwAssoc :: DoubleColumnChar -> DoubleColumnChar -> DoubleColumnChar -> Bool

47−horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =

48− (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

49− ==

46+horizConcatDwAssoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnChar c2) =

47+ (char defAttr c0 <|> char defAttr c1) <|> char defAttr c2

48+ ==

5049 char defAttr c0 <|> (char defAttr c1 <|> char defAttr c2)

5150

5251vertContatSingleRow :: NonEmptyList SingleRowSingleAttrImage -> Bool

@@ -55,9 +54,9 @@ vertContatSingleRow (NonEmpty stack) =

5554 stackImage = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack ]

5655 in imageHeight stackImage == expectedHeight

5756

58−disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage

59− -> NonEmptyList SingleRowSingleAttrImage

60− -> Bool

57+disjointHeightHorizJoin :: NonEmptyList SingleRowSingleAttrImage

58+ -> NonEmptyList SingleRowSingleAttrImage

59+ -> Bool

6160disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) =

6261 let expectedHeight :: Int = max (length stack0) (length stack1)

6362 stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

@@ -65,9 +64,9 @@ disjointHeightHorizJoin (NonEmpty stack0) (NonEmpty stack1) =

6564 in imageHeight (stackImage0 <|> stackImage1) == expectedHeight

6665

6766

68−disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

69− -> NonEmptyList SingleRowSingleAttrImage

70− -> Bool

67+disjointHeightHorizJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

68+ -> NonEmptyList SingleRowSingleAttrImage

69+ -> Bool

7170disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =

7271 let stackImage0 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

7372 stackImage1 = vertCat [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]

@@ -75,31 +74,31 @@ disjointHeightHorizJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =

7574 expectedHeight = imageHeight image

7675 in case image of

7776 HorizJoin {} -> ( expectedHeight == (imageHeight $ partLeft image) )

78− &&

77+ &&

7978 ( expectedHeight == (imageHeight $ partRight image) )

8079 _ -> True

8180

82−disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage

81+disjointWidthVertJoin :: NonEmptyList SingleRowSingleAttrImage

8382 -> NonEmptyList SingleRowSingleAttrImage

8483 -> Bool

8584disjointWidthVertJoin (NonEmpty stack0) (NonEmpty stack1) =

8685 let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)

8786 stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

8887 stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]

89− stack0Image = vertCat stack0Images

90− stack1Image = vertCat stack1Images

88+ stack0Image = vertCat stack0Images

89+ stack1Image = vertCat stack1Images

9190 image = stack0Image <-> stack1Image

9291 in imageWidth image == expectedWidth

9392

94−disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

93+disjointWidthVertJoinBgFill :: NonEmptyList SingleRowSingleAttrImage

9594 -> NonEmptyList SingleRowSingleAttrImage

9695 -> Bool

9796disjointWidthVertJoinBgFill (NonEmpty stack0) (NonEmpty stack1) =

9897 let expectedWidth = maximum $ map imageWidth (stack0Images ++ stack1Images)

9998 stack0Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack0 ]

10099 stack1Images = [ i | SingleRowSingleAttrImage { rowImage = i } <- stack1 ]

101− stack0Image = vertCat stack0Images

102− stack1Image = vertCat stack1Images

100+ stack0Image = vertCat stack0Images

101+ stack1Image = vertCat stack1Images

103102 image = stack0Image <-> stack1Image

104103 in case image of

105104 VertJoin {} -> ( expectedWidth == (imageWidth $ partTop image) )

@@ -137,7 +136,7 @@ cropBottomLimitsHeight :: Image -> Int -> Property

137136cropBottomLimitsHeight i v = v >= 0 ==>

138137 v >= imageHeight (cropBottom v i)

139138

140−-- ridiculous tests just to satisfy my desire for nice code coverage :-P

139+-- rediculous tests just to satisfy my desire for nice code coverage :-P

141140canShowImage :: Image -> Bool

142141canShowImage i = length (show i) > 0

143142

@@ -172,3 +171,4 @@ tests = return

172171 , verify "can rnf image" canRnfImage

173172 , verify "can pp image" canPpImage

174173 ]

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

@@ -4,7 +4,6 @@ module VerifyLayersSpanGeneration where

44

55import Verify.Graphics.Vty.Prelude

66

7−import Verify.Graphics.Vty.Attributes

87import Verify.Graphics.Vty.Image

98import Verify.Graphics.Vty.Picture

109import Verify.Graphics.Vty.Span

@@ -14,7 +13,7 @@ import Graphics.Vty.PictureToSpans

1413

1514import Verify

1615

17−import qualified Data.Vector as Vector

16+import qualified Data.Vector as Vector

1817

1918largerHorizSpanOcclusion :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result

2019largerHorizSpanOcclusion row0 row1 =

@@ -26,9 +25,8 @@ largerHorizSpanOcclusion row0 row1 =

2625 ops = displayOpsForPic p (imageWidth iLarger,imageHeight iLarger)

2726 in verifyOpsEquality expectedOps ops

2827

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.

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.

3230vertStackLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result

3331vertStackLayerEquivalence0 row0 row1 =

3432 let i0 = rowImage row0

@@ -54,9 +52,8 @@ vertStackLayerEquivalence1 row0 row1 =

5452 opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)

5553 in verifyOpsEquality expectedOps opsLayered

5654

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.

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.

6057horizJoinLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result

6158horizJoinLayerEquivalence0 row0 row1 =

6259 let i0 = rowImage row0

@@ -112,7 +109,7 @@ horizJoinAlternate1 =

112109 in verifyOpsEquality expectedOps opsLayered

113110

114111tests :: IO [Test]

115−tests = return

112+tests = return

116113 [ verify "a larger horiz span occludes a smaller span on a lower layer"

117114 largerHorizSpanOcclusion

118115 , verify "two rows stack vertical equiv to first image layered on top of second with padding (0)"

@@ -128,3 +125,4 @@ tests = return

128125 -- , verify "alternating images using joins is the same as alternating images using layers (1)"

129126 -- horizJoinAlternate1

130127 ]

128+

test/VerifyOutput.hs+9−12

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

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

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

55module VerifyOutput where

6−

76import Verify

87

98import Graphics.Vty

@@ -13,7 +12,10 @@ import Verify.Graphics.Vty.Output

1312

1413import Control.Monad

1514

15+import Data.Default

16+

1617import qualified System.Console.Terminfo as Terminfo

18+import System.Posix.Env

1719import System.Posix.IO

1820

1921tests :: IO [Test]

@@ -35,16 +37,11 @@ smokeTestTermNonMac termName i = liftIOResult $ do

3537smokeTestTerm :: String -> Image -> IO Result

3638smokeTestTerm termName i = do

3739 nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags

38− t <- outputForConfig $ defaultConfig

39− { outputFd = Just nullOut

40− , termName = Just termName

41− , colorMode = Just NoColor

42− }

40+ t <- outputForConfig $ def { outputFd = Just nullOut, termName = Just termName }

4341 -- putStrLn $ "context color count: " ++ show (contextColorCount t)

4442 reserveDisplay t

4543 dc <- displayContext t (100,100)

46− -- always show the cursor to produce tests for terminals with no

47− -- cursor support.

44+ -- always show the cursor to produce tests for terminals with no cursor support.

4845 let pic = (picForImage i) { picCursor = Cursor 0 0 }

4946 outputPicture dc pic

5047 setCursorPos t 0 0

test/VerifyParseTerminfoCaps.hs+4−4

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

11{-# LANGUAGE NamedFieldPuns #-}

2−{-# LANGUAGE ScopedTypeVariables #-}

32module VerifyParseTerminfoCaps where

43

54import Prelude hiding ( catch )

@@ -17,7 +16,7 @@ import Numeric

1716

1817-- If a terminal defines one of the caps then it's expected to be parsable.

1918-- TODO: reduce duplication with terminfo terminal implementation.

20−capsOfInterest =

19+capsOfInterest =

2120 [ "cup"

2221 , "sc"

2322 , "rc"

@@ -66,7 +65,7 @@ verifyParseCap capString onParse =

6665 Right e -> onParse e

6766

6867nonParamaterizedCaps (NonParamCapString cap) = do

69− verifyParseCap cap $ \e ->

68+ verifyParseCap cap $ \e ->

7069 let expectedBytes = map (toEnum . fromEnum) cap

7170 outBytes = bytesForRange e 0 (length cap)

7271 in verifyBytesEqual outBytes expectedBytes

@@ -76,7 +75,7 @@ literalPercentCaps (LiteralPercentCap capString expectedBytes) = do

7675

7776incFirstTwoCaps (IncFirstTwoCap capString expectedBytes) = do

7877 verifyParseCap capString $ \e -> verifyBytesEqual (collectBytes e) expectedBytes

79−

78+

8079pushParamCaps (PushParamCap capString expectedParamCount expectedBytes) = do

8180 verifyParseCap capString $ \e ->

8281 let outBytes = collectBytes e

@@ -99,3 +98,4 @@ printCap ti capName = do

9998printExpression ti capName = do

10099 let parseResult = parseCapExpression $ fromCapname ti capName

101100 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 ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

28+ in ( spanOpsEffectedRows 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 ( spanOpsAffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

40+ in ( spanOpsEffectedRows ops == 0 ) && ( allSpansHaveWidth ops 0 )

4141

4242horizSpanImageAndEqualWindow0 :: SingleRowSingleAttrImage -> Result

4343horizSpanImageAndEqualWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =

@@ -51,7 +51,7 @@ horizSpanImageAndEqualWindow1 (SingleRowSingleAttrImage { rowImage = i, expected

5151 let p = picForImage i

5252 w = MockWindow c 1

5353 ops = displayOpsForPic p (regionForWindow w)

54− in spanOpsAffectedRows ops == 1

54+ in spanOpsEffectedRows ops == 1

5555

5656horizSpanImageAndLesserWindow0 :: SingleRowSingleAttrImage -> Result

5757horizSpanImageAndLesserWindow0 (SingleRowSingleAttrImage { rowImage = i, expectedColumns = c }) =

@@ -74,7 +74,7 @@ singleAttrSingleSpanStackCropped1 stack =

7474 expectedRowCount = stackHeight stack `div` 2

7575 w = MockWindow (stackWidth stack) expectedRowCount

7676 ops = displayOpsForPic p (regionForWindow w)

77− actualRowCount = spanOpsAffectedRows ops

77+ actualRowCount = spanOpsEffectedRows ops

7878 in expectedRowCount == actualRowCount

7979

8080singleAttrSingleSpanStackCropped2 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

@@ -90,7 +90,7 @@ singleAttrSingleSpanStackCropped3 stack0 stack1 =

9090 w = MockWindow (imageWidth (picImage p)) expectedRowCount

9191 ops = displayOpsForPic p (regionForWindow w)

9292 expectedRowCount = imageHeight (picImage p) `div` 2

93− actualRowCount = spanOpsAffectedRows ops

93+ actualRowCount = spanOpsEffectedRows ops

9494 in expectedRowCount == actualRowCount

9595

9696singleAttrSingleSpanStackCropped4 :: SingleAttrSingleSpanStack -> SingleAttrSingleSpanStack -> Result

@@ -107,7 +107,7 @@ singleAttrSingleSpanStackCropped5 stack0 stack1 =

107107 w = MockWindow (imageWidth (picImage p)) (stackHeight stack0)

108108 ops = displayOpsForPic p (regionForWindow w)

109109 expectedRowCount = stackHeight stack0

110− actualRowCount = spanOpsAffectedRows ops

110+ actualRowCount = spanOpsEffectedRows ops

111111 in expectedRowCount == actualRowCount

112112

113113horizSpanImageAndGreaterWindow0 :: SingleRowSingleAttrImage -> Result

@@ -123,13 +123,13 @@ arbImageIsCropped :: DefaultImage -> MockWindow -> Bool

123123arbImageIsCropped (DefaultImage image) win@(MockWindow w h) =

124124 let pic = picForImage image

125125 ops = displayOpsForPic pic (regionForWindow win)

126− in ( spanOpsAffectedRows ops == h ) && ( allSpansHaveWidth ops w )

126+ in ( spanOpsEffectedRows ops == h ) && ( allSpansHaveWidth ops w )

127127

128128spanOpsActuallyFillRows :: DefaultPic -> Bool

129129spanOpsActuallyFillRows (DefaultPic pic win) =

130130 let ops = displayOpsForPic pic (regionForWindow win)

131131 expectedRowCount = regionHeight (regionForWindow win)

132− actualRowCount = spanOpsAffectedRows ops

132+ actualRowCount = spanOpsEffectedRows ops

133133 in expectedRowCount == actualRowCount

134134

135135spanOpsActuallyFillColumns :: DefaultPic -> Bool

@@ -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+22−26

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

11{-# LANGUAGE MultiParamTypeClasses #-}

22{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4−-- Generate some input bytes and delays between blocks of input bytes.

5−-- Verify the events produced are as expected.

3+{- Generate some input bytes and delays between blocks of input bytes. Verify the events produced

4+ - are as expected.

5+ -}

66module Main where

77

88import Verify.Graphics.Vty.Output

@@ -12,12 +12,14 @@ import Graphics.Vty.Input.Events

1212import Graphics.Vty.Input.Loop

1313import Graphics.Vty.Input.Terminfo

1414

15+import Control.Applicative

1516import Control.Concurrent

1617import Control.Concurrent.STM

1718import Control.Exception

1819import Lens.Micro ((^.))

1920import Control.Monad

2021

22+import Data.Default

2123import Data.IORef

2224import Data.List (intersperse, reverse, nubBy)

2325

@@ -34,8 +36,7 @@ import Test.SmallCheck.Series

3436

3537import Text.Printf

3638

37−-- processing a block of 16 chars is the largest I can do without taking

38−-- too long to run the test.

39+-- processing a block of 16 chars is the largest I can do without taking too long to run the test.

3940maxBlockSize :: Int

4041maxBlockSize = 16

4142

@@ -46,11 +47,8 @@ forEachOf :: (Show a, Testable m b) => [a] -> (a -> b) -> Property m

4647forEachOf l = over (generate (\n -> take n l))

4748

4849data InputEvent

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

50+ = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.

51+ | Delay Int -- | microsecond delay

5452 deriving Show

5553

5654type InputSpec = [InputEvent]

@@ -113,11 +111,11 @@ assertEventsFromSynInput table inputSpec expectedEvents = do

113111 (writeFd, readFd) <- openPseudoTerminal

114112 (setTermAttr,_) <- attributeControl readFd

115113 setTermAttr

116− let testConfig = defaultConfig { inputFd = Just readFd

117− , termName = Just "dummy"

118− , vmin = Just 1

119− , vtime = Just 100

120− }

114+ let testConfig = def { inputFd = Just readFd

115+ , termName = Just "dummy"

116+ , vmin = Just 1

117+ , vtime = Just 100

118+ }

121119 input <- initInput testConfig table

122120 eventsRef <- newIORef []

123121 let writeWaitClose = do

@@ -132,9 +130,7 @@ assertEventsFromSynInput table inputSpec expectedEvents = do

132130 readLoop 0 = return ()

133131 readLoop n = do

134132 e <- atomically $ readTChan $ input^.eventChannel

135− case e of

136− InputEvent ev -> modifyIORef eventsRef ((:) ev)

137− ResumeAfterSignal -> return ()

133+ modifyIORef eventsRef ((:) e)

138134 readLoop (n - 1)

139135 genEventsUsingIoActions maxDuration writeWaitClose readEvents

140136 outEvents <- reverse <$> readIORef eventsRef

@@ -167,8 +163,8 @@ verifyVisibleSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic

167163

168164verifyCapsSynInputToEvent :: Property IO

169165verifyCapsSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->

170− forEachOf terminalsOfInterest $ \terminalName -> monadic $ do

171− term <- setupTerm terminalName

166+ forEachOf terminalsOfInterest $ \termName -> monadic $ do

167+ term <- setupTerm termName

172168 let table = capsClassifyMap term keysFromCapsTable

173169 inputSeq = gen table

174170 events = map snd inputSeq

@@ -187,9 +183,9 @@ verifySpecialSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic

187183

188184verifyFullSynInputToEvent :: Property IO

189185verifyFullSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->

190− forEachOf terminalsOfInterest $ \terminalName -> monadic $ do

191− term <- setupTerm terminalName

192− let table = classifyMapForTerm terminalName term

186+ forEachOf terminalsOfInterest $ \termName -> monadic $ do

187+ term <- setupTerm termName

188+ let table = classifyMapForTerm termName term

193189 inputSeq = gen table

194190 events = map snd inputSeq

195191 keydowns = map (Bytes . fst) inputSeq

@@ -198,9 +194,9 @@ verifyFullSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->

198194

199195verifyFullSynInputToEvent_2x :: Property IO

200196verifyFullSynInputToEvent_2x = forAll $ \(InputBlocksUsingTable gen) ->

201− forEachOf terminalsOfInterest $ \terminalName -> monadic $ do

202− term <- setupTerm terminalName

203− let table = classifyMapForTerm terminalName term

197+ forEachOf terminalsOfInterest $ \termName -> monadic $ do

198+ term <- setupTerm termName

199+ let table = classifyMapForTerm termName term

204200 inputSeq = gen table

205201 events = concatMap ((\s -> [s,s]) . snd) inputSeq

206202 keydowns = map (Bytes . (\s -> s ++ s) . fst) inputSeq

test/VerifyUsingMockTerminal.hs+15−23

@@ -4,11 +4,9 @@ import Verify.Graphics.Vty.Prelude

44

55import Verify.Graphics.Vty.Picture

66import Verify.Graphics.Vty.Image

7−import Verify.Graphics.Vty.Attributes

87import Verify.Graphics.Vty.Span

98import Verify.Graphics.Vty.Output

109import Graphics.Vty.Output

11−import Graphics.Vty.Output.Interface

1210import Graphics.Vty.Output.Mock

1311

1412import Graphics.Vty.Debug

@@ -41,30 +39,27 @@ singleTRow :: MockWindow -> Property

4139singleTRow (MockWindow w h) = liftIOResult $ do

4240 (mockData,t) <- mockTerminal (w,h)

4341 dc <- displayBounds t >>= displayContext t

44− -- create an image that contains just the character T repeated for a

45− -- single row

42+ -- create an image that contains just the character T repeated for a single row

4643 let i = horizCat $ replicate (fromEnum w) (char defAttr 'T')

4744 pic = (picForImage i) { picBackground = Background 'B' defAttr }

4845 outputPicture dc pic

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

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

5249 let expected = "H" ++ "MDA" ++ replicate (fromEnum w) 'T'

5350 ++ concat (replicate (fromEnum h - 1) $ "MDA" ++ replicate (fromEnum w) 'B')

5451 compareMockOutput mockData expected

55−

52+

5653manyTRows :: MockWindow -> Property

5754manyTRows (MockWindow w h) = liftIOResult $ do

5855 (mockData, t) <- mockTerminal (w,h)

5956 dc <- displayBounds t >>= displayContext t

60− -- create an image that contains the character 'T' repeated for all

61− -- the rows

57+ -- create an image that contains the character 'T' repeated for all the rows

6258 let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w) (char defAttr 'T')

6359 pic = (picForImage i) { picBackground = Background 'B' defAttr }

6460 outputPicture dc pic

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

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

6863 let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')

6964 compareMockOutput mockData expected

7065

@@ -72,14 +67,12 @@ manyTRowsCroppedWidth :: MockWindow -> Property

7267manyTRowsCroppedWidth (MockWindow w h) = liftIOResult $ do

7368 (mockData,t) <- mockTerminal (w,h)

7469 dc <- displayBounds t >>= displayContext t

75− -- create an image that contains the character 'T' repeated for all

76− -- the rows

70+ -- create an image that contains the character 'T' repeated for all the rows

7771 let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w * 2) (char defAttr 'T')

7872 pic = (picForImage i) { picBackground = Background 'B' defAttr }

7973 outputPicture dc pic

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

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

8376 let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')

8477 compareMockOutput mockData expected

8578

@@ -87,14 +80,12 @@ manyTRowsCroppedHeight :: MockWindow -> Property

8780manyTRowsCroppedHeight (MockWindow w h) = liftIOResult $ do

8881 (mockData,t) <- mockTerminal (w,h)

8982 dc <- displayBounds t >>= displayContext t

90− -- create an image that contains the character 'T' repeated for all

91− -- the rows

83+ -- create an image that contains the character 'T' repeated for all the rows

9284 let i = vertCat $ replicate (fromEnum h * 2) $ horizCat $ replicate (fromEnum w) (char defAttr 'T')

9385 pic = (picForImage i) { picBackground = Background 'B' defAttr }

9486 outputPicture dc pic

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

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

9889 let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')

9990 compareMockOutput mockData expected

10091

@@ -106,3 +97,4 @@ tests = return [ verify "unitImageUnitBounds" unitImageUnitBounds

10697 , verify "manyTRowsCroppedWidth" manyTRowsCroppedWidth

10798 , verify "manyTRowsCroppedHeight" manyTRowsCroppedHeight

10899 ]

100+

test/VerifyUtf8Width.hs−2

@@ -1,11 +1,9 @@

11module VerifyUtf8Width where

2−

32import Verify

43

54import Graphics.Text.Width

65import Graphics.Vty.Attributes

76import Graphics.Vty.Picture

8−import Graphics.Vty.Image

97

108swIs1Column :: SingleColumnChar -> Bool

119swIs1Column (SingleColumnChar c) = imageWidth (char defAttr c) == 1

test/YiIssue264.hs−1

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

11module Main where

2−

32import Graphics.Vty

43import Control.Exception

54

test/interactive_terminal_test.hs+52−51

@@ -12,13 +12,14 @@ import Control.Concurrent (threadDelay)

1212import Control.Exception

1313import Control.Monad

1414

15+import Data.Default (def)

1516import Data.List ( lookup )

1617import Data.Maybe ( isJust, fromJust )

1718import Data.Monoid

1819import Data.String.QQ

1920import Data.Word

2021

21−import Foreign.Marshal.Array

22+import Foreign.Marshal.Array

2223

2324import qualified System.Environment as Env

2425

@@ -73,12 +74,12 @@ with the test_results.list file pasted into the issue. A suitable summary is:

7374|]

7475 waitForReturn

7576 results <- doTestMenu 1

76− envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName )

77− ( \ (_ :: SomeException) -> return (envName, "") )

78− )

77+ envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName )

78+ ( \ (_ :: SomeException) -> return (envName, "") )

79+ )

7980 [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]

8081 t <- standardIOConfig >>= outputForConfig

81− let resultsTxt = show envAttributes ++ "\n"

82+ let resultsTxt = show envAttributes ++ "\n"

8283 ++ terminalID t ++ "\n"

8384 ++ show results ++ "\n"

8485 releaseTerminal t

@@ -93,7 +94,7 @@ testMenu :: [(String, Test)]

9394testMenu = zip (map show [1..]) allTests

9495

9596doTestMenu :: Int -> IO [(String, Bool)]

96−doTestMenu nextID

97+doTestMenu nextID

9798 | nextID > length allTests = do

9899 putStrLn $ "Done! Please email the " ++ outputFilePath ++ " file to coreyoconnor@gmail.com"

99100 return []

@@ -107,26 +108,26 @@ doTestMenu nextID

107108 s <- getLine >>= return . filter (/= '\n')

108109 case s of

109110 "q" -> return mempty

110− "" -> do

111− r <- runTest $ show nextID

111+ "" -> do

112+ r <- runTest $ show nextID

112113 rs <- doTestMenu ( nextID + 1 )

113114 return $ r : rs

114115 i | isJust ( lookup i testMenu ) -> do

115− r <- runTest i

116+ r <- runTest i

116117 rs <- doTestMenu ( read i + 1 )

117118 return $ r : rs

118119 where

119− displayTestMenu

120+ displayTestMenu

120121 = mapM_ displayTestMenu' testMenu

121− displayTestMenu' ( i, t )

122− = putStrLn $ ( if i == show nextID

123− then "> "

122+ displayTestMenu' ( i, t )

123+ = putStrLn $ ( if i == show nextID

124+ then "> "

124125 else " "

125126 ) ++ i ++ ". " ++ testName t

126127

127128runTest :: String -> IO (String, Bool)

128129runTest i = do

129− let t = fromJust $ lookup i testMenu

130+ let t = fromJust $ lookup i testMenu

130131 printSummary t

131132 waitForReturn

132133 testAction t

@@ -152,8 +153,8 @@ data Test = Test

152153 , confirmResults :: IO Bool

153154 }

154155

155−allTests

156− = [ reserveOutputTest

156+allTests

157+ = [ reserveOutputTest

157158 , displayBoundsTest0

158159 , displayBoundsTest1

159160 , displayBoundsTest2

@@ -184,7 +185,7 @@ allTests

184185 , layer1

185186 ]

186187

187−reserveOutputTest = Test

188+reserveOutputTest = Test

188189 { testName = "Initialize and reserve terminal output then restore previous state."

189190 , testID = "reserveOutputTest"

190191 , testAction = do

@@ -202,7 +203,7 @@ reserveOutputTest = Test

202203 , printSummary = do

203204 putStr $ [s|

204205Once return is pressed:

205− 0. The screen will be cleared.

206+ 0. The screen will be cleared.

206207 1. Four lines of text should be visible.

207208 1. The cursor should be visible and at the start of the fifth line.

208209

@@ -364,7 +365,7 @@ Did the test output match the description?

364365|]

365366 defaultSuccessConfirmResults

366367

367−-- Explicitly define the bytes that encode each example text.

368+-- Explicitely definethe bytes that encode each example text.

368369-- This avoids any issues with how the compiler represents string literals.

369370--

370371-- This document is UTF-8 encoded so the UTF-8 string is still included for

@@ -390,7 +391,7 @@ utf8Txt0 = [ [ 0xe2 , 0x86 , 0x91 ]

390391

391392iso10646Txt0 :: String

392393iso10646Txt0 = map toEnum

393− [ 8593

394+ [ 8593

394395 , 8593

395396 , 8595

396397 , 8595

@@ -553,11 +554,11 @@ After return is pressed for the second time:

553554allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]

554555 [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]

555556

556−allBrightColors

557+allBrightColors

557558 = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]

558559 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]

559560

560−attributesTest0 = Test

561+attributesTest0 = Test

561562 { testName = "Character attributes: foreground colors."

562563 , testID = "attributesTest0"

563564 , testAction = do

@@ -603,7 +604,7 @@ Did the test output match the description?

603604 defaultSuccessConfirmResults

604605 }

605606

606−attributesTest1 = Test

607+attributesTest1 = Test

607608 { testName = "Character attributes: background colors."

608609 , testID = "attributesTest1"

609610 , testAction = do

@@ -658,7 +659,7 @@ Did the test output match the description?

658659 defaultSuccessConfirmResults

659660 }

660661

661−attributesTest2 = Test

662+attributesTest2 = Test

662663 { testName = "Character attributes: Vivid foreground colors."

663664 , testID = "attributesTest2"

664665 , testAction = do

@@ -685,23 +686,23 @@ Once return is pressed:

685686 1. The cursor will be hidden.

686687 2. 9 lines of text in three columns will be drawn:

687688 a. The first column will be a name of a standard color (for an 8 color

688− terminal) rendered with that color as the foreground color.

689+ terminal) rendered with that color as the foreground color.

689690 b. The next column will be also be the name of a standard color rendered

690691 with that color as the foreground color but the shade used should be

691− more vivid than the shade used in the first column.

692+ more vivid than the shade used in the first column.

692693 c. The final column will be the name of a color rendered with the

693694 default attributes.

694695

695696For instance, one line will be the word "magenta" and that word should be

696−rendered in the magenta color.

697+rendered in the magenta color.

697698

698699I'm not actually sure exactly what "vivid" means in this context. For xterm the

699−vivid colors are brighter.

700+vivid colors are brighter.

700701

701−Verify:

702+Verify:

702703 * The first column: The foreground color matches the named color.

703704 * The second column: The foreground color matches the named color but is

704− more vivid than the color used in the first column.

705+ more vivid than the color used in the first column.

705706 * The third column: All text is rendered with the default attributes.

706707 * The vertical bars used in each line to mark the border of a column are

707708 lined up.

@@ -717,7 +718,7 @@ Did the test output match the description?

717718 defaultSuccessConfirmResults

718719 }

719720

720−attributesTest3 = Test

721+attributesTest3 = Test

721722 { testName = "Character attributes: Vivid background colors."

722723 , testID = "attributesTest3"

723724 , testAction = do

@@ -745,23 +746,23 @@ Once return is pressed:

745746 2. 9 lines of text in three columns will be drawn:

746747 a. The first column will contain be a name of a standard color for an 8

747748 color terminal rendered with the default foreground color with a

748− background the named color.

749+ background the named color.

749750 b. The first column will contain be a name of a standard color for an 8

750751 color terminal rendered with the default foreground color with the

751− background a vivid version of the named color.

752+ background a vivid version of the named color.

752753 c. The third column will be the name of a standard color rendered with

753754 the default attributes.

754−

755+

755756For instance, one line will contain be the word "magenta" and the word should

756−be rendered in the default foreground color over a magenta background.

757+be rendered in the default foreground color over a magenta background.

757758

758759I'm not actually sure exactly what "vivid" means in this context. For xterm the

759760vivid colors are brighter.

760761

761−Verify:

762+Verify:

762763 * The first column: The background color matches the named color.

763764 * The second column: The background color matches the named color and is

764− more vivid than the color used in the first column.

765+ more vivid than the color used in the first column.

765766 * The third column column: All text is rendered with the default attributes.

766767 * The vertical bars used in each line to mark the border of a column are

767768 lined up.

@@ -784,7 +785,7 @@ Did the test output match the description?

784785 defaultSuccessConfirmResults

785786 }

786787

787−attrCombos =

788+attrCombos =

788789 [ ( "default", id )

789790 , ( "bold", flip withStyle bold )

790791 , ( "blink", flip withStyle blink )

@@ -795,7 +796,7 @@ attrCombos =

795796 , ( "bold + blink + underline", flip withStyle (bold + blink + underline) )

796797 ]

797798

798−attributesTest4 = Test

799+attributesTest4 = Test

799800 { testName = "Character attributes: Bold; Blink; Underline."

800801 , testID = "attributesTest4"

801802 , testAction = do

@@ -818,10 +819,10 @@ attributesTest4 = Test

818819Once return is pressed:

819820 0. The screen will be cleared.

820821 1. The cursor will be hidden.

821− 2. 8 rows of text in two columns.

822+ 2. 8 rows of text in two columns.

822823 The rows will contain the following text:

823824 default

824− bold

825+ bold

825826 blink

826827 underline

827828 bold + blink

@@ -830,8 +831,8 @@ Once return is pressed:

830831 bold + blink + underline

831832 The first column will be rendered with the described attributes. The second

832833 column will be rendered with the default attributes.

833−

834−Verify:

834+

835+Verify:

835836 * The vertical bars used in each line to mark the border of a column are

836837 lined up.

837838 * The text in the first column is rendered as described.

@@ -847,7 +848,7 @@ Did the test output match the description?

847848 defaultSuccessConfirmResults

848849 }

849850

850−attributesTest5 = Test

851+attributesTest5 = Test

851852 { testName = "Character attributes: 240 color palette"

852853 , testID = "attributesTest5"

853854 , testAction = do

@@ -872,7 +873,7 @@ Once return is pressed:

872873 2. A 20 character wide and 12 row high block of color squares. This should look like a palette

873874 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...

874875

875−Verify:

876+Verify:

876877

877878After return is pressed for the second time:

878879 0. The screen containing the test summary should be restored.

@@ -937,7 +938,7 @@ cursorHideTest0 = Test

937938 { testName = "Verify the cursor is hid and re-shown. issue #7"

938939 , testID = "cursorHideTest0"

939940 , testAction = do

940− vty <- mkVty defaultConfig

941+ vty <- mkVty def

941942 showCursor $ outputIface vty

942943 setCursorPos (outputIface vty) 5 5

943944 nextEvent vty

@@ -970,7 +971,7 @@ outputPicAndWait pic = do

970971 releaseDisplay t

971972 releaseTerminal t

972973 return ()

973−

974+

974975vertCropTest0 :: Test

975976vertCropTest0 = Test

976977 { testName = "Verify bottom cropping works as expected with single column chars"

@@ -1045,7 +1046,7 @@ horizCropTest0 = Test

10451046 , testID = "cropTest0"

10461047 , testAction = do

10471048 let baseImage = vertCat $ map (string defAttr) lorumIpsum

1048− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

1049+ croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

10491050 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

10501051 outputImageAndWait image

10511052 , printSummary = putStr $ [s|

@@ -1062,7 +1063,7 @@ horizCropTest1 = Test

10621063 , testID = "cropTest0"

10631064 , testAction = do

10641065 let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese

1065− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

1066+ croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage

10661067 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

10671068 outputImageAndWait image

10681069 , printSummary = putStr $ [s|

@@ -1079,7 +1080,7 @@ horizCropTest2 = Test

10791080 , testID = "cropTest0"

10801081 , testAction = do

10811082 let baseImage = vertCat $ map (string defAttr) lorumIpsum

1082− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

1083+ croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

10831084 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

10841085 outputImageAndWait image

10851086 , printSummary = putStr $ [s|

@@ -1096,7 +1097,7 @@ horizCropTest3 = Test

10961097 , testID = "cropTest0"

10971098 , testAction = do

10981099 let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese

1099− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

1100+ croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage

11001101 image = baseImage <-> backgroundFill 10 2 <-> croppedImage

11011102 outputImageAndWait image

11021103 , printSummary = putStr $ [s|

test/vty-examples.cabal+14−24

@@ -1,38 +1,28 @@

11name: vty-examples

2−version: 5.7

2+version: 5.6

33license: BSD3

44license-file: LICENSE

55author: AUTHORS

6−maintainer: Jonathan Daugherty (cygnus@foobox.com)

7−homepage: https://github.com/jtdaugherty/vty

6+maintainer: Corey O'Connor (coreyoconnor@gmail.com)

7+homepage: https://github.com/coreyoconnor/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

12− be easy to use, have no confusing corner cases, and good support for

13− common terminal types.

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.

1413 .

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.

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.

2618 .

28− .

3020cabal-version: >= 1.18.0

3121build-type: Simple

3222

3323source-repository head

3424 type: git

35− location: https://github.com/jtdaugherty/vty.git

25+ location: https://github.com/coreyoconnor/vty.git

3626

3727executable vty-interactive-terminal-test

3828 main-is: interactive_terminal_test.hs

@@ -41,7 +31,7 @@ executable vty-interactive-terminal-test

4131 default-extensions: ScopedTypeVariables

4232 ghc-options: -threaded

4333

44− build-depends: vty >= 5.15,

34+ build-depends: vty >= 5.2.11,

4535 base >= 4 && < 5,

4636 bytestring,

4737 containers,

@@ -69,7 +59,7 @@ executable vty-event-echo

6959 FlexibleContexts

7060 ghc-options: -threaded

7161

72− build-depends: vty >= 5.15,

62+ build-depends: vty >= 5.2.11,

7363 base >= 4 && < 5,

7464 array,

7565 bytestring,

@@ -89,7 +79,7 @@ executable vty-rogue

8979 default-extensions: ScopedTypeVariables

9080 ghc-options: -threaded

9181

92− build-depends: vty >= 5.15,

82+ build-depends: vty >= 5.2.11,

9383 base >= 4 && < 5,

9484 array,

9585 bytestring,

@@ -110,7 +100,7 @@ executable vty-benchmark

110100 default-extensions: ScopedTypeVariables

111101 ghc-options: -threaded

112102

113− build-depends: vty >= 5.15,

103+ build-depends: vty >= 5.2.11,

114104 base >= 4 && < 5,

115105 bytestring,

116106 Cabal,

tools/BuildWidthTable.hsdeleted−144

@@ -1,144 +0,0 @@

1−{-# LANGUAGE ScopedTypeVariables #-}

2−{-# LANGUAGE CPP #-}

3−module Main where

4−

5−import qualified Control.Exception as E

6−import Control.Monad (when)

7−import Data.Maybe (fromMaybe)

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

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

10−#endif

11−import System.Directory (createDirectoryIfMissing)

12−import System.Environment (getArgs, getProgName)

13−import System.FilePath (takeDirectory)

14−import System.Exit (exitFailure)

15−import System.Console.GetOpt

16−import Text.Read (readMaybe)

17−

18−import Graphics.Vty.Config ( terminalWidthTablePath, currentTerminalName

19− , vtyConfigPath, addConfigWidthMap

20− , ConfigUpdateResult(..)

21− )

22−import Graphics.Vty.UnicodeWidthTable.IO

23−import Graphics.Vty.UnicodeWidthTable.Query

24−

25−data Arg = Help

26− | OutputPath String

27− | TableUpperBound String

28− | UpdateConfig

29− | VtyConfigPath String

30− deriving (Eq, Show)

31−

32−options :: Config -> [OptDescr Arg]

33−options config =

34− [ Option "h" ["help"] (NoArg Help)

35− "This help output"

36− , Option "b" ["bound"] (ReqArg TableUpperBound "MAX_CHAR")

37− ("The maximum Unicode code point to test when building the table " <>

38− "(default: " <> (show $ fromEnum $ configBound config) <> ")")

39− , Option "p" ["path"] (ReqArg OutputPath "PATH")

40− ("The output path to write to (default: " <>

41− fromMaybe "<none>" (configOutputPath config) <> ")")

42− , Option "u" ["update-config"] (NoArg UpdateConfig)

43− "Create or update the Vty configuration file to use the new table (default: no)"

44− , Option "c" ["config-path"] (ReqArg VtyConfigPath "PATH")

45− ("Update the specified Vty configuration file path when -u is set (default: " <>

46− configPath config <> ")")

47− ]

48−

49−data Config =

50− Config { configOutputPath :: Maybe FilePath

51− , configBound :: Char

52− , configUpdate :: Bool

53− , configPath :: FilePath

54− }

55− deriving (Show)

56−

57−mkDefaultConfig :: IO Config

58−mkDefaultConfig = do

59− Config <$> terminalWidthTablePath

60− <*> pure defaultUnicodeTableUpperBound

61− <*> pure False

62− <*> vtyConfigPath

63−

64−usage :: IO ()

65−usage = do

66− config <- mkDefaultConfig

67− pn <- getProgName

68− putStrLn $ "Usage: " <> pn <> " [options]"

69− putStrLn ""

70− putStrLn "This tool queries the terminal on stdout to determine the widths"

71− putStrLn "of Unicode characters rendered to the terminal. The resulting data"

72− putStrLn "is written to a table at the specified output path for later"

73− putStrLn "loading by Vty-based applications."

74− putStrLn ""

75−

76− putStrLn $ usageInfo pn (options config)

77−

78−updateConfigFromArg :: Arg -> Config -> Config

79−updateConfigFromArg Help c =

80− c

81−updateConfigFromArg UpdateConfig c =

82− c { configUpdate = True }

83−updateConfigFromArg (VtyConfigPath p) c =

84− c { configPath = p }

85−updateConfigFromArg (TableUpperBound s) c =

86− case readMaybe s of

87− Nothing -> error $ "Invalid table upper bound: " <> show s

88− Just v -> c { configBound = toEnum v }

89−updateConfigFromArg (OutputPath p) c =

90− c { configOutputPath = Just p }

91−

92−main :: IO ()

93−main = do

94− defConfig <- mkDefaultConfig

95− strArgs <- getArgs

96− let (args, unused, errors) = getOpt Permute (options defConfig) strArgs

97−

98− when (not $ null errors) $ do

99− mapM_ putStrLn errors

100− exitFailure

101−

102− when ((not $ null unused) || (Help `elem` args)) $ do

103− usage

104− exitFailure

105−

106− let config = foldr updateConfigFromArg defConfig args

107−

108− outputPath <- case configOutputPath config of

109− Nothing -> do

110− putStrLn "Error: could not obtain terminal width table path"

111− exitFailure

112− Just path -> return path

113−

114− putStrLn "Querying terminal:"

115− builtTable <- buildUnicodeWidthTable $ configBound config

116−

117− let dir = takeDirectory outputPath

118− createDirectoryIfMissing True dir

119− writeUnicodeWidthTable outputPath builtTable

120−

121− putStrLn $ "\nOutput table written to " <> outputPath

122−

123− when (configUpdate config) $ do

124− let cPath = configPath config

125− Just tName <- currentTerminalName

126−

127− result <- E.try $ addConfigWidthMap cPath tName outputPath

128−

129− case result of

130− Left (e::E.SomeException) -> do

131− putStrLn $ "Error updating Vty configuration at " <> cPath <> ": " <>

132− show e

133− exitFailure

134− Right ConfigurationCreated -> do

135− putStrLn $ "Configuration file created: " <> cPath

136− Right ConfigurationModified -> do

137− putStrLn $ "Configuration file updated: " <> cPath

138− Right (ConfigurationConflict other) -> do

139− putStrLn $ "Configuration file not updated: uses a different table " <>

140− "for TERM=" <> tName <> ": " <> other

141− Right ConfigurationRedundant -> do

142− putStrLn $ "Configuration file not updated: configuration " <>

143− cPath <> " already uses table " <> outputPath <>

144− " for TERM=" <> tName

view-benchmark-corenew file+4

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

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+114−108

@@ -1,10 +1,10 @@

11name: vty

2−version: 5.35.1

2+version: 5.11

33license: BSD3

44license-file: LICENSE

55author: AUTHORS

6−maintainer: Jonathan Daugherty (cygnus@foobox.com)

7−homepage: https://github.com/jtdaugherty/vty

6+maintainer: Corey O'Connor (coreyoconnor@gmail.com)

7+homepage: https://github.com/coreyoconnor/vty

88category: User Interfaces

99synopsis: A simple terminal UI library

1010description:

@@ -12,42 +12,55 @@ description:

1212 be easy to use, have no confusing corner cases, and good support for

1313 common terminal types.

1414 .

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.

15+ Included in the source distribution is a program

16+ test/interactive_terminal_test.hs that demonstrates the various

17+ features.

1818 .

19− Import the "Graphics.Vty" convenience module to get access to the core

20− parts of the library.

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

2133 .

2335 .

25− .

27−cabal-version: 1.18

37+cabal-version: >= 1.18

2838build-type: Simple

29−extra-doc-files: README.md,

39+data-files: README.md,

40+ TODO,

3041 AUTHORS,

31− CHANGELOG.md,

42+ CHANGELOG,

3243 LICENSE

33−tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.5

44+tested-with: GHC >= 7.6.2

3445

3546source-repository head

3647 type: git

37− location: https://github.com/jtdaugherty/vty.git

48+ location: https://github.com/coreyoconnor/vty.git

3849

3950library

4051 default-language: Haskell2010

41− build-depends: base >= 4.8 && < 5,

52+ build-depends: base >= 4 && < 5,

4253 blaze-builder >= 0.3.3.2 && < 0.5,

4354 bytestring,

4455 containers,

56+ data-default >= 0.5.3,

4557 deepseq >= 1.1 && < 1.5,

4658 directory,

4759 filepath >= 1.0 && < 2.0,

48− microlens < 0.4.13,

60+ microlens,

4961 microlens-mtl,

5062 microlens-th,

63+ -- required for nice installation with yi

5164 hashable >= 1.2,

5265 mtl >= 1.1.1.0 && < 2.3,

5366 parallel >= 2.2 && < 3.3,

@@ -58,18 +71,10 @@ library

5871 text >= 0.11.3,

5972 unix,

6073 utf8-string >= 0.3 && < 1.1,

61− vector >= 0.7,

62− binary,

63− ansi-terminal >= 0.10.3

64−

65− if !impl(ghc >= 8.0)

66− build-depends: semigroups >= 0.16,

67− fail

74+ vector >= 0.7

6875

6976 exposed-modules: Graphics.Vty

7077 Graphics.Vty.Attributes

71− Graphics.Vty.Attributes.Color

72− Graphics.Vty.Attributes.Color240

7378 Graphics.Vty.Config

7479 Graphics.Vty.Error

7580 Graphics.Vty.Image

@@ -78,8 +83,10 @@ library

7883 Graphics.Vty.Input

7984 Graphics.Vty.Input.Events

8085 Graphics.Vty.Picture

86+ Graphics.Vty.Prelude

8187 Graphics.Vty.Output

8288 Graphics.Text.Width

89+ -- the modules below are only meant to be used by the tests.

8390 Codec.Binary.UTF8.Debug

8491 Data.Terminfo.Parse

8592 Data.Terminfo.Eval

@@ -91,7 +98,6 @@ library

9198 Graphics.Vty.Input.Classify.Parse

9299 Graphics.Vty.Input.Loop

93100 Graphics.Vty.Input.Mouse

94− Graphics.Vty.Input.Focus

95101 Graphics.Vty.Input.Paste

96102 Graphics.Vty.Input.Terminfo

97103 Graphics.Vty.PictureToSpans

@@ -100,72 +106,82 @@ library

100106 Graphics.Vty.Output.Interface

101107 Graphics.Vty.Output.XTermColor

102108 Graphics.Vty.Output.TerminfoBased

103− Graphics.Vty.UnicodeWidthTable.Types

104− Graphics.Vty.UnicodeWidthTable.IO

105− Graphics.Vty.UnicodeWidthTable.Query

106− Graphics.Vty.UnicodeWidthTable.Install

107109

108− other-modules: Graphics.Vty.Debug.Image

110+ other-modules: Graphics.Vty.Attributes.Color

111+ Graphics.Vty.Attributes.Color240

112+ Graphics.Vty.Debug.Image

109113 Graphics.Vty.Input.Terminfo.ANSIVT

110114

111115 c-sources: cbits/gwinsz.c

112116 cbits/set_term_timing.c

113− cbits/get_tty_erase.c

114117 cbits/mk_wcwidth.c

115118

116119 include-dirs: cbits

117120

118121 hs-source-dirs: src

119122

123+ default-extensions: ScopedTypeVariables

124+ ForeignFunctionInterface

125+

120126 ghc-options: -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10

121127

122128 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10

123129

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

130+ cc-options: -O2

138131

139132executable vty-mode-demo

140133 main-is: ModeDemo.hs

141− hs-source-dirs: demos

142134

143135 default-language: Haskell2010

136+ default-extensions: ScopedTypeVariables

144137 ghc-options: -threaded

145138

146139 build-depends: vty,

147− base >= 4.8 && < 5,

140+ base >= 4 && < 5,

148141 containers,

142+ data-default >= 0.5.3,

149143 microlens,

150144 microlens-mtl,

151145 mtl >= 1.1.1.0 && < 2.3

152146

153147executable vty-demo

154148 main-is: Demo.hs

155− hs-source-dirs: demos

156149

157150 default-language: Haskell2010

151+ default-extensions: ScopedTypeVariables

158152 ghc-options: -threaded

159153

160154 build-depends: vty,

161− base >= 4.8 && < 5,

155+ base >= 4 && < 5,

162156 containers,

157+ data-default >= 0.5.3,

163158 microlens,

164159 microlens-mtl,

165160 mtl >= 1.1.1.0 && < 2.3

166161

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+

167182test-suite verify-using-mock-terminal

168183 default-language: Haskell2010

184+ default-extensions: ScopedTypeVariables

169185

170186 type: detailed-0.9

171187

@@ -184,8 +200,8 @@ test-suite verify-using-mock-terminal

184200 build-depends: vty,

185201 Cabal >= 1.20,

186202 QuickCheck >= 2.7,

187− random >= 1.0 && < 1.3,

188− base >= 4.8 && < 5,

203+ random >= 1.0 && < 1.2,

204+ base >= 4 && < 5,

189205 bytestring,

190206 containers,

191207 deepseq >= 1.1 && < 1.5,

@@ -198,6 +214,7 @@ test-suite verify-using-mock-terminal

198214

199215test-suite verify-terminal

200216 default-language: Haskell2010

217+ default-extensions: ScopedTypeVariables

201218

202219 type: detailed-0.9

203220

@@ -216,10 +233,11 @@ test-suite verify-terminal

216233 build-depends: vty,

217234 Cabal >= 1.20,

218235 QuickCheck >= 2.7,

219− random >= 1.0 && < 1.3,

220− base >= 4.8 && < 5,

236+ random >= 1.0 && < 1.2,

237+ base >= 4 && < 5,

221238 bytestring,

222239 containers,

240+ data-default >= 0.5.3,

223241 deepseq >= 1.1 && < 1.5,

224242 mtl >= 1.1.1.0 && < 2.3,

225243 terminfo >= 0.3 && < 0.5,

@@ -230,6 +248,7 @@ test-suite verify-terminal

230248

231249test-suite verify-display-attributes

232250 default-language: Haskell2010

251+ default-extensions: ScopedTypeVariables

233252

234253 type: detailed-0.9

235254

@@ -248,8 +267,8 @@ test-suite verify-display-attributes

248267 build-depends: vty,

249268 Cabal >= 1.20,

250269 QuickCheck >= 2.7,

251− random >= 1.0 && < 1.3,

252− base >= 4.8 && < 5,

270+ random >= 1.0 && < 1.2,

271+ base >= 4 && < 5,

253272 bytestring,

254273 containers,

255274 deepseq >= 1.1 && < 1.5,

@@ -261,6 +280,7 @@ test-suite verify-display-attributes

261280

262281test-suite verify-empty-image-props

263282 default-language: Haskell2010

283+ default-extensions: ScopedTypeVariables

264284

265285 type: detailed-0.9

266286

@@ -273,8 +293,8 @@ test-suite verify-empty-image-props

273293 build-depends: vty,

274294 Cabal >= 1.20,

275295 QuickCheck >= 2.7,

276− random >= 1.0 && < 1.3,

277− base >= 4.8 && < 5,

296+ random >= 1.0 && < 1.2,

297+ base >= 4 && < 5,

278298 bytestring,

279299 containers,

280300 deepseq >= 1.1 && < 1.5,

@@ -286,6 +306,7 @@ test-suite verify-empty-image-props

286306

287307test-suite verify-eval-terminfo-caps

288308 default-language: Haskell2010

309+ default-extensions: ScopedTypeVariables

289310

290311 type: detailed-0.9

291312

@@ -299,8 +320,8 @@ test-suite verify-eval-terminfo-caps

299320 build-depends: vty,

300321 Cabal >= 1.20,

301322 QuickCheck >= 2.7,

302− random >= 1.0 && < 1.3,

303− base >= 4.8 && < 5,

323+ random >= 1.0 && < 1.2,

324+ base >= 4 && < 5,

304325 blaze-builder >= 0.3.3.2 && < 0.5,

305326 bytestring,

306327 containers,

@@ -314,6 +335,7 @@ test-suite verify-eval-terminfo-caps

314335

315336test-suite verify-image-ops

316337 default-language: Haskell2010

338+ default-extensions: ScopedTypeVariables

317339

318340 type: detailed-0.9

319341

@@ -328,8 +350,8 @@ test-suite verify-image-ops

328350 build-depends: vty,

329351 Cabal >= 1.20,

330352 QuickCheck >= 2.7,

331− random >= 1.0 && < 1.3,

332− base >= 4.8 && < 5,

353+ random >= 1.0 && < 1.2,

354+ base >= 4 && < 5,

333355 bytestring,

334356 containers,

335357 deepseq >= 1.1 && < 1.5,

@@ -341,6 +363,7 @@ test-suite verify-image-ops

341363

342364test-suite verify-image-trans

343365 default-language: Haskell2010

366+ default-extensions: ScopedTypeVariables

344367

345368 type: detailed-0.9

346369

@@ -355,8 +378,8 @@ test-suite verify-image-trans

355378 build-depends: vty,

356379 Cabal >= 1.20,

357380 QuickCheck >= 2.7,

358− random >= 1.0 && < 1.3,

359− base >= 4.8 && < 5,

381+ random >= 1.0 && < 1.2,

382+ base >= 4 && < 5,

360383 bytestring,

361384 containers,

362385 deepseq >= 1.1 && < 1.5,

@@ -368,6 +391,7 @@ test-suite verify-image-trans

368391

369392test-suite verify-inline

370393 default-language: Haskell2010

394+ default-extensions: ScopedTypeVariables

371395

372396 type: detailed-0.9

373397

@@ -381,8 +405,8 @@ test-suite verify-inline

381405 build-depends: vty,

382406 Cabal >= 1.20,

383407 QuickCheck >= 2.7,

384− random >= 1.0 && < 1.3,

385− base >= 4.8 && < 5,

408+ random >= 1.0 && < 1.2,

409+ base >= 4 && < 5,

386410 bytestring,

387411 containers,

388412 deepseq >= 1.1 && < 1.5,

@@ -394,6 +418,7 @@ test-suite verify-inline

394418

395419test-suite verify-parse-terminfo-caps

396420 default-language: Haskell2010

421+ default-extensions: ScopedTypeVariables

397422

398423 type: detailed-0.9

399424

@@ -408,8 +433,8 @@ test-suite verify-parse-terminfo-caps

408433 build-depends: vty,

409434 Cabal >= 1.20,

410435 QuickCheck >= 2.7,

411− random >= 1.0 && < 1.3,

412− base >= 4.8 && < 5,

436+ random >= 1.0 && < 1.2,

437+ base >= 4 && < 5,

413438 bytestring,

414439 containers,

415440 deepseq >= 1.1 && < 1.5,

@@ -422,6 +447,7 @@ test-suite verify-parse-terminfo-caps

422447

423448test-suite verify-simple-span-generation

424449 default-language: Haskell2010

450+ default-extensions: ScopedTypeVariables

425451

426452 type: detailed-0.9

427453

@@ -439,8 +465,8 @@ test-suite verify-simple-span-generation

439465 build-depends: vty,

440466 Cabal >= 1.20,

441467 QuickCheck >= 2.7,

442− random >= 1.0 && < 1.3,

443− base >= 4.8 && < 5,

468+ random >= 1.0 && < 1.2,

469+ base >= 4 && < 5,

444470 bytestring,

445471 containers,

446472 deepseq >= 1.1 && < 1.5,

@@ -453,6 +479,7 @@ test-suite verify-simple-span-generation

453479

454480test-suite verify-crop-span-generation

455481 default-language: Haskell2010

482+ default-extensions: ScopedTypeVariables

456483

457484 type: detailed-0.9

458485

@@ -470,8 +497,8 @@ test-suite verify-crop-span-generation

470497 build-depends: vty,

471498 Cabal >= 1.20,

472499 QuickCheck >= 2.7,

473− random >= 1.0 && < 1.3,

474− base >= 4.8 && < 5,

500+ random >= 1.0 && < 1.2,

501+ base >= 4 && < 5,

475502 bytestring,

476503 containers,

477504 deepseq >= 1.1 && < 1.5,

@@ -484,6 +511,7 @@ test-suite verify-crop-span-generation

484511

485512test-suite verify-layers-span-generation

486513 default-language: Haskell2010

514+ default-extensions: ScopedTypeVariables

487515

488516 type: detailed-0.9

489517

@@ -501,33 +529,8 @@ test-suite verify-layers-span-generation

501529 build-depends: vty,

502530 Cabal >= 1.20,

503531 QuickCheck >= 2.7,

504− random >= 1.0 && < 1.3,

505− base >= 4.8 && < 5,

506− bytestring,

507− containers,

508− deepseq >= 1.1 && < 1.5,

509− mtl >= 1.1.1.0 && < 2.3,

510− text >= 0.11.3,

511− unix,

512− utf8-string >= 0.3 && < 1.1,

513− vector >= 0.7

514−

515−test-suite verify-color-mapping

516− default-language: Haskell2010

517−

518− type: detailed-0.9

519−

520− hs-source-dirs: test

521−

522− test-module: VerifyColor240

523−

524− other-modules: Verify

525−

526− build-depends: vty,

527− Cabal >= 1.20,

528− QuickCheck >= 2.7,

529− random >= 1.0 && < 1.3,

530− base >= 4.8 && < 5,

532+ random >= 1.0 && < 1.2,

533+ base >= 4 && < 5,

531534 bytestring,

532535 containers,

533536 deepseq >= 1.1 && < 1.5,

@@ -539,6 +542,7 @@ test-suite verify-color-mapping

539542

540543test-suite verify-utf8-width

541544 default-language: Haskell2010

545+ default-extensions: ScopedTypeVariables

542546

543547 type: detailed-0.9

544548

@@ -551,8 +555,8 @@ test-suite verify-utf8-width

551555 build-depends: vty,

552556 Cabal >= 1.20,

553557 QuickCheck >= 2.7,

554− random >= 1.0 && < 1.3,

555− base >= 4.8 && < 5,

558+ random >= 1.0 && < 1.2,

559+ base >= 4 && < 5,

556560 bytestring,

557561 containers,

558562 deepseq >= 1.1 && < 1.5,

@@ -564,6 +568,7 @@ test-suite verify-utf8-width

564568

565569test-suite verify-using-mock-input

566570 default-language: Haskell2010

571+ default-extensions: ScopedTypeVariables

567572

568573 type: exitcode-stdio-1.0

569574

@@ -571,17 +576,16 @@ test-suite verify-using-mock-input

571576

572577 main-is: VerifyUsingMockInput.hs

573578

574− other-modules: Verify.Graphics.Vty.Output

575−

576579 build-depends: vty,

577580 Cabal >= 1.20,

581+ data-default >= 0.5.3,

578582 QuickCheck >= 2.7,

579583 smallcheck == 1.*,

580584 quickcheck-assertions >= 0.1.1,

581585 test-framework == 0.8.*,

582586 test-framework-smallcheck == 0.2.*,

583− random >= 1.0 && < 1.3,

584− base >= 4.8 && < 5,

587+ random >= 1.0 && < 1.2,

588+ base >= 4 && < 5,

585589 bytestring,

586590 containers,

587591 deepseq >= 1.1 && < 1.5,

@@ -599,6 +603,7 @@ test-suite verify-using-mock-input

599603

600604test-suite verify-config

601605 default-language: Haskell2010

606+ default-extensions: ScopedTypeVariables

602607

603608 type: exitcode-stdio-1.0

604609

@@ -608,6 +613,7 @@ test-suite verify-config

608613

609614 build-depends: vty,

610615 Cabal >= 1.20,

616+ data-default >= 0.5.3,

611617 HUnit,

612618 QuickCheck >= 2.7,

613619 smallcheck == 1.*,

@@ -615,8 +621,8 @@ test-suite verify-config

615621 test-framework == 0.8.*,

616622 test-framework-smallcheck == 0.2.*,

617623 test-framework-hunit,

618− random >= 1.0 && < 1.3,

619− base >= 4.8 && < 5,

624+ random >= 1.0 && < 1.2,

625+ base >= 4 && < 5,

620626 bytestring,

621627 containers,

622628 deepseq >= 1.1 && < 1.5,