1dac87e · vty · git.iko.soy

git.iko.soy/vty

Library-wide long haddock line cleanup

commit1dac87efb70a7b25ccd593ba0410d2818269dba1 authorJonathan Daugherty <cygnus@foobox.com> dateSat 21 Jan 2017, 22:54 (10 years ago) parentba2b635

35 files changed+854−634

compare with master

unifiedsplit

src/Codec/Binary/UTF8/Debug.hs+2−2 src/Data/Terminfo/Eval.hs+6−4 src/Data/Terminfo/Parse.hs+8−6 src/Graphics/Text/Width.hs+9−6 src/Graphics/Vty.hs+33−22 src/Graphics/Vty/Attributes.hs+40−31 src/Graphics/Vty/Attributes/Color.hs+23−16 src/Graphics/Vty/Config.hs+33−25 src/Graphics/Vty/DisplayAttributes.hs+16−14 src/Graphics/Vty/Error.hs+2−1 src/Graphics/Vty/Image.hs+56−47 src/Graphics/Vty/Image/Internal.hs+61−41 src/Graphics/Vty/Inline.hs+25−18 src/Graphics/Vty/Inline/Unsafe.hs+3−2 src/Graphics/Vty/Input.hs+101−76 src/Graphics/Vty/Input/Classify.hs+15−15 src/Graphics/Vty/Input/Events.hs+9−7 src/Graphics/Vty/Input/Loop.hs+24−17 src/Graphics/Vty/Input/Terminfo.hs+13−10 src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+19−12 src/Graphics/Vty/Output.hs+33−24 src/Graphics/Vty/Output/Interface.hs+41−29 src/Graphics/Vty/Output/Mock.hs+27−18 src/Graphics/Vty/Output/TerminfoBased.hs+81−62 src/Graphics/Vty/Output/XTermColor.hs+5−5 src/Graphics/Vty/Picture.hs+31−22 src/Graphics/Vty/PictureToSpans.hs+58−43 src/Graphics/Vty/Span.hs+30−22 test/Verify/Graphics/Vty/Image.hs+3−3 test/Verify/Graphics/Vty/Output.hs+4−4 test/VerifyEvalTerminfoCaps.hs+4−3 test/VerifyLayersSpanGeneration.hs+6−5 test/VerifyOutput.hs+4−3 test/VerifyUsingMockInput.hs+9−5 test/VerifyUsingMockTerminal.hs+20−14

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

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

1010import Numeric

1111

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

13−-- corresponding UTF8 byte sequence

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

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

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

1515utf8FromIso = encode . map toEnum

1616

src/Data/Terminfo/Eval.hs+6−4

@@ -8,7 +8,8 @@

88#defined MIN_VERSION_base(x,y,z) 1

99#endif

1010

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

11+{- Evaluates the paramaterized terminfo string capability with the given

12+ - parameters.

1213 -

1314 -}

1415module Data.Terminfo.Eval (writeCapExpr)

@@ -95,9 +96,10 @@ writeCapOp (Conditional expr parts) = do

9596 writeContitionalParts [] = return ()

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

9798 -- (man 5 terminfo)

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

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

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

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

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

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

102+ -- (else) part.

101103 v <- pop

102104 if v /= 0

103105 then writeCapOps trueOps

src/Data/Terminfo/Parse.hs+8−6

@@ -55,11 +55,11 @@ type CapOps = [CapOp]

5555data CapOp =

5656 Bytes !Int !Int -- offset count

5757 | DecOut | CharOut

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

59− -- 1-based

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

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

6060 | PushParam !Word | PushValue !Word

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

62− -- The %e expression may be NOP

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

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

6363 | Conditional

6464 { conditionalExpr :: !CapOps

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

@@ -107,8 +107,10 @@ constructCapExpression :: [Char] -> BuildResults -> CapExpression

107107constructCapExpression capString buildResults =

108108 let expr = CapExpression

109109 { capOps = outCapOps buildResults

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

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

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

111+ -- string's characters.

112+ -- \todo Verify the input string actually contains an

113+ -- 8bit byte per character.

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

113115 , sourceString = capString

114116 , paramCount = outParamCount buildResults

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

@@ -15,15 +15,18 @@ wcswidth = sum . map wcwidth

1515

1616-- XXX: Characters with unknown widths occupy 1 column?

1717--

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.

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

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

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

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

22+-- width needs to be implemented.

2223

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

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

25+-- with unknown widths are 0 width

2426safeWcwidth :: Char -> Int

2527safeWcwidth = max 0 . wcwidth

2628

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

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

30+-- unknown widths are 0 width

2831safeWcswidth :: String -> Int

2932safeWcswidth = sum . map safeWcwidth

src/Graphics/Vty.hs+33−22

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

11-- | Vty supports input and output to terminal devices.

22--

3−-- - Input to the terminal is provided to the app as a sequence of 'Event's.

3+-- - Input to the terminal is provided to the app as a sequence of

4+-- 'Event's.

45--

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

6+-- - The output is defined by a 'Picture'. Which is one or more layers

7+-- of 'Image's.

68--

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

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

9+-- - The module "Graphics.Vty.Image" provides a number of

10+-- constructor equations that will build correct 'Image' values.

11+-- See 'string', '<|>', and '<->' for starters.

912--

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

13+-- - The constructors in "Graphics.Vty.Image.Internal" should not

14+-- be used.

1115--

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

1317--

@@ -19,8 +23,10 @@

1923-- main = do

2024-- cfg <- 'standardIOConfig'

2125-- vty <- 'mkVty' cfg

22−-- let line0 = 'string' ('defAttr' ` 'withForeColor' ` 'green') \"first line\"

23−-- line1 = 'string' ('defAttr' ` 'withBackColor' ` 'blue') \"second line\"

26+-- let line0 = 'string' ('defAttr' ` 'withForeColor' ` 'green')

27+-- \"first line\"

28+-- line1 = 'string' ('defAttr' ` 'withBackColor' ` 'blue')

29+-- \"second line\"

2430-- img = line0 '<->' line1

2531-- pic = 'picForImage' img

2632-- 'update' vty pic

@@ -78,37 +84,42 @@ import Data.Monoid

7884--

7985-- 3. shutdown vty.

8086--

81−-- An alternative to tracking the Vty instance is to use 'withVty' in "Graphics.Vty.Inline.Unsafe".

87+-- An alternative to tracking the Vty instance is to use 'withVty' in

88+-- "Graphics.Vty.Inline.Unsafe".

8289--

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.

90+-- This does not assure any thread safety. In theory, as long as an

91+-- update action is not executed when another update action is already

92+-- then it's safe to call this on multiple threads.

8593--

8694-- \todo Remove explicit `shutdown` requirement.

8795data 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.

96+ { -- | Outputs the given Picture. Equivalent to 'outputPicture'

97+ -- applied to a display context implicitly managed by Vty. The

98+ -- managed display context is reset on resize.

9099 update :: Picture -> IO ()

91− -- | Get one Event object, blocking if necessary. This will refresh the terminal if the event

92− -- is a 'EvResize'.

100+ -- | Get one Event object, blocking if necessary. This will

101+ -- refresh the terminal if the event is a 'EvResize'.

93102 , nextEvent :: IO Event

94103 -- | The input interface. See 'Input'

95104 , inputIface :: Input

96105 -- | The output interface. See 'Output'

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

107+ -- | Refresh the display. 'nextEvent' will refresh the display if

108+ -- a resize occurs. If other programs output to the terminal and

109+ -- mess up the display then the application might want to force a

110+ -- refresh.

101111 , refresh :: IO ()

102112 -- | Clean up after vty.

103− -- The above methods will throw an exception if executed after this is executed.

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

114+ -- this is executed.

104115 , shutdown :: IO ()

105116 }

106117

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.

118+-- | Set up the state object for using vty. At most one state object

119+-- should be created at a time for a given terminal device.

109120--

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

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

121+-- The specified config is added to the 'userConfig'. With the

122+-- 'userConfig' taking precedence. See "Graphics.Vty.Config"

112123--

113124-- For most applications @mkVty def@ is sufficient.

114125mkVty :: Config -> IO Vty

src/Graphics/Vty/Attributes.hs+40−31

@@ -9,26 +9,30 @@

1010-- | Display attributes

1111--

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

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

13+-- attributes:

1314--

1415-- @

1516-- defAttr `withForeColor` red

1617-- @

1718--

18−-- Is the attribute that will set the foreground color to red and the background color to the

19−-- default.

19+-- Is the attribute that will set the foreground color to red and the

20+-- background color to the default.

2021--

21−-- This can then be used to build an image with a red foreground like so:

22+-- This can then be used to build an image with a red foreground like

23+-- so:

2224--

2325-- @

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

2527-- @

2628--

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.

29+-- The default attributes set by 'defAttr' have a presentation

30+-- determined by the terminal. This is not something VTY can control.

31+-- The user is free to define the color scheme of the terminal as they

32+-- see fit. Up to the limits of the terminal anyways.

3033--

31−-- The value 'currentAttr' will keep the attributes of whatever was output previously.

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

35+-- output previously.

3236--

3337-- \todo This API is very verbose IMO. I'd like something more succinct.

3438module Graphics.Vty.Attributes ( module Graphics.Vty.Attributes

@@ -48,21 +52,22 @@ import Graphics.Vty.Attributes.Color240

4852import Data.Monoid

4953#endif

5054

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

52−-- attribute is applied.

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

56+-- characters rendered after the attribute is applied.

5357--

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.

58+-- At most 256 colors, picked from a 240 and 16 color palette, are

59+-- possible for the background and foreground. The 240 colors and

60+-- 16 colors are points in different palettes. See Color for more

61+-- information.

5762data Attr = Attr

5863 { attrStyle :: !(MaybeDefault Style)

5964 , attrForeColor :: !(MaybeDefault Color)

6065 , attrBackColor :: !(MaybeDefault Color)

6166 } deriving ( Eq, Show, Read )

6267

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.

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

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

70+-- what action should be taken with regards to the other groups.

6671-- XXYYZZ__

6772-- XX - style action

6873-- 00 => reset to default

@@ -98,17 +103,19 @@ instance Monoid Attr where

98103 ( attrForeColor attr0 `mappend` attrForeColor attr1 )

99104 ( attrBackColor attr0 `mappend` attrBackColor attr1 )

100105

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

106+-- | Specifies the display attributes such that the final style and

107+-- color values do not depend on the previously applied display

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

109+-- default colors (unfortunately).

104110data FixedAttr = FixedAttr

105111 { fixedStyle :: !Style

106112 , fixedForeColor :: !(Maybe Color)

107113 , fixedBackColor :: !(Maybe Color)

108114 } deriving ( Eq, Show )

109115

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.

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

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

118+-- value.

112119data MaybeDefault v where

113120 Default :: MaybeDefault v

114121 KeepCurrent :: MaybeDefault v

@@ -153,8 +160,9 @@ brightMagenta= ISOColor 13

153160brightCyan = ISOColor 14

154161brightWhite = ISOColor 15

155162

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.

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

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

165+-- if the style attribute should not be applied.

158166type Style = Word8

159167

160168-- | The 6 possible style attributes:

@@ -171,8 +179,8 @@ type Style = Word8

171179--

172180-- * bold/bright

173181--

174−-- ( The invisible, protect, and altcharset display attributes some terminals support are not

175−-- supported via VTY.)

182+-- (The invisible, protect, and altcharset display attributes some

183+-- terminals support are not supported via VTY.)

176184standout, underline, reverseVideo, blink, dim, bold :: Style

177185standout = 0x01

178186underline = 0x02

@@ -207,20 +215,21 @@ withBackColor attr c = attr { attrBackColor = SetTo c }

207215withStyle :: Attr -> Style -> Attr

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

209217

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.

218+-- | Sets the style, background color and foreground color to the

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

220+-- what the default background and foreground colors are.

212221defAttr :: Attr

213222defAttr = Attr Default Default Default

214223

215224instance Default Attr where

216225 def = defAttr

217226

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

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

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

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

220229--

221230-- EG: current_style `withForeColor` brightMagenta

222231--

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

224−-- set to brightMagenta.

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

233+-- with the foreground color set to brightMagenta.

225234currentAttr :: Attr

226235currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent

src/Graphics/Vty/Attributes/Color.hs+23−16

@@ -3,13 +3,16 @@ import Data.Word

44-- | Abstract data type representing a color.

55--

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

6+-- Currently the foreground and background color are specified as points

7+-- in either a:

78--

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.

9+-- * 16 color palette. Where the first 8 colors are equal to the 8

10+-- colors of the ISO 6429 (ANSI) 8 color palette and the second 8

11+-- colors are bright/vivid versions of the first 8 colors.

1012--

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+-- * 240 color palette. This palette is a regular sampling of the full

14+-- RGB colorspace for the first 224 colors. The remaining 16 colors is

15+-- a greyscale palette.

1316--

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

1518--

@@ -29,21 +32,25 @@ import Data.Word

2932--

3033-- 7. white

3134--

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.

35+-- The mapping from points in the 240 color palette to colors actually

36+-- displayable by the terminal depends on the number of colors the

37+-- terminal claims to support. Which is usually determined by the

38+-- terminfo "colors" property. If this property is not being accurately

39+-- reported then the color reproduction will be incorrect.

3640--

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

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

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

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

3944-- addressable via the 240 color palette.

4045--

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.

46+-- If the terminal reports > 16 colors then the 240 color palette

47+-- points are mapped to the nearest points in a ("color count" - 16)

48+-- subsampling of the 240 color palette.

4349--

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.

50+-- All of this assumes the terminals are behaving similarly to xterm and

51+-- rxvt when handling colors. And that the individual colors have not

52+-- been remapped by the user. There may be a way to verify this through

53+-- terminfo but I don't know it.

4754--

4855-- Seriously, terminal color support is INSANE.

4956data Color = ISOColor !Word8 | Color240 !Word8

src/Graphics/Vty/Config.hs+33−25

@@ -3,15 +3,17 @@

33{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

44{-# LANGUAGE TypeOperators #-}

55{-# LANGUAGE ScopedTypeVariables #-}

6−-- | A 'Config' can be provided to mkVty to customize the applications use of vty. A config file can

7−-- be used to customize vty for a user's system.

6+-- | A 'Config' can be provided to mkVty to customize the applications

7+-- use of vty. A config file can be used to customize vty for a user's

8+-- system.

89--

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

10+-- The 'Config' provided is mappend'd to 'Config's loaded from

11+-- @'getAppUserDataDirectory'/config@ and @$VTY_CONFIG_FILE@. The

12+-- @$VTY_CONFIG_FILE@ takes precedence over the @config@ file or the

1113-- application provided 'Config'.

1214--

13−-- Lines in config files that fail to parse are ignored. Later entries take precedence over

14−-- earlier.

15+-- Lines in config files that fail to parse are ignored. Later entries

16+-- take precedence over earlier.

1517--

1618-- For all directives:

1719--

@@ -29,8 +31,8 @@

2931-- \"debugLog\" string

3032-- @

3133--

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.

34+-- The value of the environment variable @VTY_DEBUG_LOG@ is equivalent

35+-- to a debugLog entry at the end of the last config file.

3436--

3537-- = Input Processing

3638--

@@ -55,15 +57,16 @@

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

5658-- @

5759--

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

60+-- Then the bytes @\"\\ESC[B\"@ will result in the KUp event on all

61+-- terminals. The bytes @\"\\ESC[1;3B\"@ will result in the event KDown

62+-- with the MAlt modifier on all terminals. The bytes @\"\\ESC[D\"@ will

63+-- result in the KLeft event when @TERM@ is @xterm@.

6164--

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

63−-- format.

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

66+-- table to the log in the above format.

6467--

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

66−-- .vty/config

68+-- Set VTY_DEBUG_LOG. Run vty. Check debug log for incorrect mappings.

69+-- Add corrected mappings to .vty/config

6770--

6871module Graphics.Vty.Config

6972 ( InputMap

@@ -115,8 +118,9 @@ instance Exception VtyConfigurationError where

115118 displayException VtyMissingTermEnvVar = "TERM environment variable not set"

116119#endif

117120

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.

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

122+-- entries take precedence over earlier in the case multiple entries

123+-- have the same byte string.

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

121125

122126data Config = Config

@@ -131,14 +135,17 @@ data Config = Config

131135 , bracketedPasteMode :: Maybe Bool

132136 -- | Debug information is appended to this file if not Nothing.

133137 , debugLog :: Maybe FilePath

134− -- | The (input byte, output event) pairs extend the internal input table of VTY and the table

135− -- from terminfo.

138+ -- | The (input byte, output event) pairs extend the internal input

139+ -- table of VTY and the table from terminfo.

136140 --

137− -- See "Graphics.Vty.Config" module documentation for documentation of the @map@ directive.

141+ -- See "Graphics.Vty.Config" module documentation for documentation

142+ -- of the @map@ directive.

138143 , inputMap :: InputMap

139− -- | The input file descriptor to use. The default is 'System.Posix.IO.stdInput'

144+ -- | The input file descriptor to use. The default is

145+ -- 'System.Posix.IO.stdInput'

140146 , inputFd :: Maybe Fd

141− -- | The output file descriptor to use. The default is 'System.Posix.IO.stdOutput'

147+ -- | The output file descriptor to use. The default is

148+ -- 'System.Posix.IO.stdOutput'

142149 , outputFd :: Maybe Fd

143150 -- | The terminal name used to look up terminfo capabilities.

144151 -- The default is the value of the TERM environment variable.

@@ -173,7 +180,8 @@ instance Monoid Config where

173180 , termName = termName c1 <|> termName c0

174181 }

175182

176−-- | Config from @'getAppUserDataDirectory'/config@ and @$VTY_CONFIG_FILE@

183+-- | Config from @'getAppUserDataDirectory'/config@ and

184+-- @$VTY_CONFIG_FILE@

177185userConfig :: IO Config

178186userConfig = do

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

@@ -219,8 +227,8 @@ runParseConfig name cfgTxt =

219227

220228type Parser = Parsec BS.ByteString ()

221229

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

223−-- String stream type.

230+-- I tried to use the haskellStyle here but that was specialized

231+-- (without requirement?) to the String stream type.

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

225233configLanguage = LanguageDef

226234 { commentStart = "{-"

src/Graphics/Vty/DisplayAttributes.hs+16−14

@@ -17,9 +17,10 @@ import Data.Bits ((.&.))

1717import Data.Monoid (Monoid(..), mconcat)

1818#endif

1919

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"

20+-- | Given the previously applied display attributes as a FixedAttr and

21+-- the current display attributes as an Attr produces a FixedAttr that

22+-- represents the current display attributes. This is done by using the

23+-- previously applied display attributes to remove the "KeepCurrent"

2324-- abstraction.

2425fixDisplayAttr :: FixedAttr -> Attr -> FixedAttr

2526fixDisplayAttr fattr attr

@@ -34,12 +35,13 @@ fixDisplayAttr fattr attr

3435 fixColor c KeepCurrent = c

3536 fixColor _c (SetTo c) = Just c

3637

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

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

38+-- | difference between two display attributes. Used in the calculation

39+-- of the operations required to go from one display attribute to the

40+-- next.

3941--

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.

42+-- Previously, vty would reset display attributes to default then apply

43+-- the new display attributes. This turned out to be very expensive: A

44+-- *lot* more data would be sent to the terminal than required.

4345data DisplayAttrDiff = DisplayAttrDiff

4446 { styleDiffs :: [StyleStateChange]

4547 , foreColorDiff :: DisplayColorDiff

@@ -61,8 +63,8 @@ instance Monoid DisplayAttrDiff where

6163simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]

6264simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1

6365

64−-- | Consider two display color attributes diffs. What display color attribute diff are these

65−-- equivalent to?

66+-- | Consider two display color attributes diffs. What display color

67+-- attribute diff are these equivalent to?

6668--

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

6870simplifyColorDiffs :: DisplayColorDiff -> DisplayColorDiff -> DisplayColorDiff

@@ -77,8 +79,8 @@ data DisplayColorDiff

7779 | SetColor !Color

7880 deriving (Show, Eq)

7981

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

81−-- attributes.

82+-- | Style attribute changes are transformed into a sequence of

83+-- apply/removes of the individual attributes.

8284data StyleStateChange

8385 = ApplyStandout

8486 | RemoveStandout

@@ -94,8 +96,8 @@ data StyleStateChange

9496 | RemoveBold

9597 deriving (Show, Eq)

9698

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

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

99+-- | Determines the diff between two display&color attributes. This diff

100+-- determines the operations that actually get output to the terminal.

99101displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff

100102displayAttrDiffs attr attr' = DisplayAttrDiff

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

src/Graphics/Vty/Error.hs+2−1

@@ -3,6 +3,7 @@ module Graphics.Vty.Error

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

55--

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

6+-- These have fully qualified names by default since, IMO, exception

7+-- handling requires this.

78data VtyException

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

src/Graphics/Vty/Image.hs+56−47

@@ -39,7 +39,8 @@ module Graphics.Vty.Image ( DisplayText

3939 , translate

4040 , translateX

4141 , translateY

42− -- | The possible display attributes used in constructing an `Image`.

42+ -- | The possible display attributes used in

43+ -- constructing an `Image`.

4344 , module Graphics.Vty.Attributes

4445 )

4546 where

@@ -59,7 +60,8 @@ import Data.Word

5960infixr 5 <|>

6061infixr 4 <->

6162

62−-- | An area of the picture's bacground (See Background) of w columns and h rows.

63+-- | An area of the picture's bacground (See Background) of w columns

64+-- and h rows.

6365backgroundFill :: Int -> Int -> Image

6466backgroundFill w h

6567 | w == 0 = EmptyImage

@@ -96,38 +98,40 @@ text' :: Attr -> T.Text -> Image

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

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

98100

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

100−-- the ISO-10646 encoding.

101+-- | An image of a single character. This is a standard Haskell 31-bit

102+-- character assumed to be in the ISO-10646 encoding.

101103char :: Attr -> Char -> Image

102104char a c =

103105 let displayWidth = safeWcwidth c

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

105107

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

107−-- assumed to be a sequence of ISO-10646 characters.

108−--

109−-- Note: depending on how the Haskell compiler represents string literals a string literal in a

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

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

112−-- about the encoding format when outputting string literals. Just provide the string literal

113−-- directly to iso10646String or string.

108+-- | A string of characters layed out on a single row with the same

109+-- display attribute. The string is assumed to be a sequence of

110+-- ISO-10646 characters.

114111--

112+-- Note: depending on how the Haskell compiler represents string

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

114+-- example, may be represented as a ISO-10646 string. That is, I think,

115+-- the case with GHC 6.10. This means, for the most part, you don't need

116+-- to worry about the encoding format when outputting string literals.

117+-- Just provide the string literal directly to iso10646String or string.

115118iso10646String :: Attr -> String -> Image

116119iso10646String a str =

117120 let displayWidth = safeWcswidth str

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

119122

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

121−-- represented internally as a list of ISO 10646 31 bit characters.

123+-- | Alias for iso10646String. Since the usual case is that a literal

124+-- string like "foo" is represented internally as a list of ISO 10646 31

125+-- bit characters.

122126--

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

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

125−-- representation.

127+-- Note: Keep in mind that GHC will compile source encoded as UTF-8

128+-- but the literal strings, while UTF-8 encoded in the source, will be

129+-- transcoded to a ISO 10646 31 bit characters runtime representation.

126130string :: Attr -> String -> Image

127131string = iso10646String

128132

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

130−-- UTF-8 encoded text.

133+-- | A string of characters layed out on a single row. The input is

134+-- assumed to be the bytes for UTF-8 encoded text.

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

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

133137

@@ -139,8 +143,8 @@ utf8Bytestring a bs = text a (TL.decodeUtf8 bs)

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

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

141145

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

143−-- number of rows high.

146+-- | Creates a fill of the specified character. The dimensions are in

147+-- number of characters wide and number of rows high.

144148charFill :: Integral d => Attr -> Char -> d -> d -> Image

145149charFill _a _c 0 _h = EmptyImage

146150charFill _a _c _w 0 = EmptyImage

@@ -151,13 +155,14 @@ charFill a c w h =

151155 displayWidth = safeWcwidth c * (fromIntegral w)

152156 charWidth = fromIntegral w

153157

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

155−-- attributes.

158+-- | The empty image. Useful for fold combinators. These occupy no space

159+-- nor define any display attributes.

156160emptyImage :: Image

157161emptyImage = EmptyImage

158162

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

160−-- The pad values are how many display columns or rows to add.

163+-- | Pad the given image. This adds background character fills to the

164+-- left, top, right, bottom. The pad values are how many display columns

165+-- or rows to add.

161166pad :: Int -> Int -> Int -> Int -> Image -> Image

162167pad 0 0 0 0 i = i

163168pad inL inT inR inB inImage

@@ -179,11 +184,12 @@ pad inL inT inR inB inImage

179184 where w = imageWidth i + l

180185 h = imageHeight i

181186

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

183−-- left. Second param is amount to translate top.

187+-- | Translates an image by padding or cropping the left and top.

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

189+-- translate top.

184190--

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

186−-- (0,0) will crop the image.

191+-- This can have an unexpected effect: Translating an image to less than

192+-- (0,0) then to greater than (0,0) will crop the image.

187193translate :: Int -> Int -> Image -> Image

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

189195

@@ -201,18 +207,19 @@ translateY y i

201207 | y == 0 = i

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

203209

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

205−-- or bottom.

210+-- | Ensure an image is no larger than the provided size. If the image

211+-- is larger then crop the right or bottom.

206212--

207−-- This is transformed to a vertical crop from the bottom followed by horizontal crop from the

208−-- right.

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

214+-- horizontal crop from the right.

209215crop :: Int -> Int -> Image -> Image

210216crop 0 _ _ = EmptyImage

211217crop _ 0 _ = EmptyImage

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

213219

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

215−-- no effect. Otherwise the image is cropped from the bottom.

220+-- | crop the display height. If the image is less than or equal in

221+-- height then this operation has no effect. Otherwise the image is

222+-- cropped from the bottom.

216223cropBottom :: Int -> Image -> Image

217224cropBottom 0 _ = EmptyImage

218225cropBottom h inI

@@ -227,8 +234,8 @@ cropBottom h inI

227234 | h >= imageHeight i = i

228235 | otherwise = CropBottom i (imageWidth i) h

229236

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

231−-- side.

237+-- | ensure the image is no wider than the given width. If the image is

238+-- wider then crop the right side.

232239cropRight :: Int -> Image -> Image

233240cropRight 0 _ = EmptyImage

234241cropRight w inI

@@ -243,8 +250,8 @@ cropRight w inI

243250 | w >= imageWidth i = i

244251 | otherwise = CropRight i w (imageHeight i)

245252

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

247−-- side.

253+-- | ensure the image is no wider than the given width. If the image is

254+-- wider then crop the left side.

248255cropLeft :: Int -> Image -> Image

249256cropLeft 0 _ = EmptyImage

250257cropLeft w inI

@@ -261,8 +268,9 @@ cropLeft w inI

261268 | imageWidth i <= w = i

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

263270

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

265−-- no effect. Otherwise the image is cropped from the top.

271+-- | crop the display height. If the image is less than or equal in

272+-- height then this operation has no effect. Otherwise the image is

273+-- cropped from the top.

266274cropTop :: Int -> Image -> Image

267275cropTop 0 _ = EmptyImage

268276cropTop h inI

@@ -279,21 +287,22 @@ cropTop h inI

279287 | imageHeight i <= h = i

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

281289

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

283−-- This is biased to pad/crop the right and bottom.

290+-- | Generic resize. Pads and crops as required to assure the given

291+-- display width and height. This is biased to pad/crop the right and

292+-- bottom.

284293resize :: Int -> Int -> Image -> Image

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

286295

287−-- | Resize the width. Pads and crops as required to assure the given display width.

288−-- This is biased to pad/crop the right.

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

297+-- display width. This is biased to pad/crop the right.

289298resizeWidth :: Int -> Image -> Image

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

291300 LT -> cropRight w i

292301 EQ -> i

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

294303

295−-- | Resize the height. Pads and crops as required to assure the given display height.

296−-- This is biased to pad/crop the bottom.

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

305+-- display height. This is biased to pad/crop the bottom.

297306resizeHeight :: Int -> Image -> Image

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

299308 LT -> cropBottom h i

src/Graphics/Vty/Image/Internal.hs+61−41

@@ -24,16 +24,17 @@ import Data.Monoid

2424

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

2626--

27−-- TODO(corey): hm. there is an explicit equation for each type which goes to a lazy text. Each

28−-- application probably uses a single type. Perhaps parameterize the entire vty interface by the

29−-- input text type?

30−-- TODO: Try using a builder instead of a TL.Text instance directly. That might improve performance

31−-- for the usual case of appending a bunch of characters with the same attribute together.

27+-- TODO(corey): hm. there is an explicit equation for each type which

28+-- goes to a lazy text. Each application probably uses a single type.

29+-- Perhaps parameterize the entire vty interface by the input text type?

30+-- TODO: Try using a builder instead of a TL.Text instance directly.

31+-- That might improve performance for the usual case of appending a

32+-- bunch of characters with the same attribute together.

3233type DisplayText = TL.Text

3334

3435-- TODO: store a skip list in HorizText(?)

35−-- TODO: represent display strings containing chars that are not 1 column chars as a separate

36−-- display string value?

36+-- TODO: represent display strings containing chars that are not 1

37+-- column chars as a separate display string value?

3738clipText :: DisplayText -> Int -> Int -> DisplayText

3839clipText txt leftSkip rightClip =

3940 -- CPS would clarify this I think

@@ -42,8 +43,8 @@ clipText txt leftSkip rightClip =

4243 (toTake,padSuffix) = clipForCharWidth rightClip txt' 0

4344 txt'' = TL.append (TL.take toTake txt') (if padSuffix then TL.singleton '…' else TL.empty)

4445 -- Note: some characters and zero-width and combining characters

45− -- combine to the left, so keep taking characters even if the width

46− -- is zero.

46+ -- combine to the left, so keep taking characters even if the

47+ -- width is zero.

4748 clipForCharWidth w t n

4849 | TL.null t = (n, False)

4950 | w < cw = (n, w /= 0)

@@ -51,8 +52,8 @@ clipText txt leftSkip rightClip =

5152 where cw = safeWcwidth (TL.head t)

5253 in txt''

5354

54−-- | This is the internal representation of Images. Use the constructors in "Graphics.Vty.Image" to

55−-- create instances.

55+-- | This is the internal representation of Images. Use the constructors

56+-- in "Graphics.Vty.Image" to create instances.

5657--

5758-- Images are:

5859--

@@ -69,45 +70,57 @@ data Image =

6970 -- | A horizontal text span has a row height of 1.

7071 HorizText

7172 { attr :: Attr

72− -- | The text to display. The display width of the text is always outputWidth.

73+ -- | The text to display. The display width of the text is always

74+ -- outputWidth.

7375 , displayText :: DisplayText

7476 -- | The number of display columns for the text.

7577 , outputWidth :: Int

7678 -- | the number of characters in the text.

7779 , charWidth :: Int

7880 }

79− -- | A horizontal join can be constructed between any two images. However a HorizJoin instance is

80− -- required to be between two images of equal height. The horizJoin constructor adds background

81− -- fills to the provided images that assure this is true for the HorizJoin value produced.

81+ -- | A horizontal join can be constructed between any two images.

82+ -- However a HorizJoin instance is required to be between two images

83+ -- of equal height. The horizJoin constructor adds background fills

84+ -- to the provided images that assure this is true for the HorizJoin

85+ -- value produced.

8286 | HorizJoin

8387 { partLeft :: Image

8488 , partRight :: Image

85− , outputWidth :: Int -- ^ imageWidth partLeft == imageWidth partRight. Always > 0

86− , outputHeight :: Int -- ^ imageHeight partLeft == imageHeight partRight. Always > 0

89+ , outputWidth :: Int

90+ -- ^ imageWidth partLeft == imageWidth partRight. Always > 0

91+ , outputHeight :: Int

92+ -- ^ imageHeight partLeft == imageHeight partRight. Always > 0

8793 }

88− -- | A veritical join can be constructed between any two images. However a VertJoin instance is

89− -- required to be between two images of equal width. The vertJoin constructor adds background

90− -- fills to the provides images that assure this is true for the VertJoin value produced.

94+ -- | A veritical join can be constructed between any two images.

95+ -- However a VertJoin instance is required to be between two images

96+ -- of equal width. The vertJoin constructor adds background fills

97+ -- to the provides images that assure this is true for the VertJoin

98+ -- value produced.

9199 | VertJoin

92100 { partTop :: Image

93101 , partBottom :: Image

94− , outputWidth :: Int -- ^ imageWidth partTop == imageWidth partBottom. always > 0

95− , outputHeight :: Int -- ^ imageHeight partTop == imageHeight partBottom. always > 1

102+ , outputWidth :: Int

103+ -- ^ imageWidth partTop == imageWidth partBottom. always > 0

104+ , outputHeight :: Int

105+ -- ^ imageHeight partTop == imageHeight partBottom. always > 1

96106 }

97− -- | A background fill will be filled with the background char. The background char is

98− -- defined as a property of the Picture this Image is used to form.

107+ -- | A background fill will be filled with the background char. The

108+ -- background char is defined as a property of the Picture this

109+ -- Image is used to form.

99110 | BGFill

100111 { outputWidth :: Int -- ^ always > 0

101112 , outputHeight :: Int -- ^ always > 0

102113 }

103− -- | Crop an image horizontally to a size by reducing the size from the right.

114+ -- | Crop an image horizontally to a size by reducing the size from

115+ -- the right.

104116 | CropRight

105117 { croppedImage :: Image

106118 -- | Always < imageWidth croppedImage > 0

107119 , outputWidth :: Int

108120 , outputHeight :: Int -- ^ imageHeight croppedImage

109121 }

110− -- | Crop an image horizontally to a size by reducing the size from the left.

122+ -- | Crop an image horizontally to a size by reducing the size from

123+ -- the left.

111124 | CropLeft

112125 { croppedImage :: Image

113126 -- | Always < imageWidth croppedImage > 0

@@ -116,7 +129,8 @@ data Image =

116129 , outputWidth :: Int

117130 , outputHeight :: Int

118131 }

119− -- | Crop an image vertically to a size by reducing the size from the bottom

132+ -- | Crop an image vertically to a size by reducing the size from

133+ -- the bottom

120134 | CropBottom

121135 { croppedImage :: Image

122136 -- | imageWidth croppedImage

@@ -124,7 +138,8 @@ data Image =

124138 -- | height image is cropped to. Always < imageHeight croppedImage > 0

125139 , outputHeight :: Int

126140 }

127− -- | Crop an image vertically to a size by reducing the size from the top

141+ -- | Crop an image vertically to a size by reducing the size from

142+ -- the top

128143 | CropTop

129144 { croppedImage :: Image

130145 -- | Always < imageHeight croppedImage > 0

@@ -210,7 +225,8 @@ instance NFData Image where

210225 rnf (HorizJoin l r w h) = l `deepseq` r `deepseq` w `seq` h `seq` ()

211226 rnf (HorizText a s w cw) = a `seq` s `deepseq` w `seq` cw `seq` ()

212227

213−-- | The width of an Image. This is the number display columns the image will occupy.

228+-- | The width of an Image. This is the number display columns the image

229+-- will occupy.

214230imageWidth :: Image -> Int

215231imageWidth HorizText { outputWidth = w } = w

216232imageWidth HorizJoin { outputWidth = w } = w

@@ -222,7 +238,8 @@ imageWidth CropBottom { outputWidth = w } = w

222238imageWidth CropTop { outputWidth = w } = w

223239imageWidth EmptyImage = 0

224240

225−-- | The height of an Image. This is the number of display rows the image will occupy.

241+-- | The height of an Image. This is the number of display rows the

242+-- image will occupy.

226243imageHeight :: Image -> Int

227244imageHeight HorizText {} = 1

228245imageHeight HorizJoin { outputHeight = h } = h

@@ -241,12 +258,13 @@ instance Monoid Image where

241258

242259-- | combines two images side by side

243260--

244−-- Combines text chunks where possible. Assures outputWidth and outputHeight properties are not

245−-- violated.

261+-- Combines text chunks where possible. Assures outputWidth and

262+-- outputHeight properties are not violated.

246263--

247−-- The result image will have a width equal to the sum of the two images width. And the height will

248−-- equal the largest height of the two images. The area not defined in one image due to a height

249−-- missmatch will be filled with the background pattern.

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

265+-- width. And the height will equal the largest height of the two

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

267+-- will be filled with the background pattern.

250268--

251269-- TODO: the bg fill is biased towards top to bottom languages(?)

252270horizJoin :: Image -> Image -> Image

@@ -276,19 +294,21 @@ horizJoin _ _ = error "horizJoin applied to undefined values."

276294

277295-- | combines two images vertically

278296--

279−-- The result image will have a height equal to the sum of the heights of both images.

280−-- The width will equal the largest width of the two images.

281−-- The area not defined in one image due to a width missmatch will be filled with the background

282−-- pattern.

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

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

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

300+-- will be filled with the background pattern.

283301--

284302-- TODO: the bg fill is biased towards right to left languages(?)

285303vertJoin :: Image -> Image -> Image

286304vertJoin EmptyImage i = i

287305vertJoin i EmptyImage = i

288306vertJoin i0 i1

289− -- If the images are of the same width then no background padding is required

307+ -- If the images are of the same width then no background padding is

308+ -- required

290309 | w0 == w1 = VertJoin i0 i1 w0 h

291− -- Otherwise one of the images needs to be padded to the size of the other image.

310+ -- Otherwise one of the images needs to be padded to the size of the

311+ -- other image.

292312 | w0 < w1

293313 = let padAmount = w1 - w0

294314 in VertJoin (HorizJoin i0 (BGFill padAmount h0) w1 h0) i1 w1 h

src/Graphics/Vty/Inline.hs+25−18

@@ -1,12 +1,14 @@

1−-- | The inline module provides a limited interface to changing the style of terminal output. The

2−-- intention is for this interface to be used inline with other output systems.

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

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

3+-- used inline with other output systems.

34--

4−-- The changes specified by the InlineM monad are applied to the terminals display attributes. These

5−-- display attributes effect the display of all following text output to the terminal file

6−-- descriptor.

5+-- The changes specified by the InlineM monad are applied to the

6+-- terminals display attributes. These display attributes effect the

7+-- display of all following text output to the terminal file descriptor.

78--

8−-- For example, in an IO monad the following code with print the text \"Not styled. \" Followed by the

9−-- text \" Styled! \" drawn over a red background and underlined.

9+-- For example, in an IO monad the following code with print the text

10+-- \"Not styled. \" Followed by the text \" Styled! \" drawn over a red

11+-- background and underlined.

1012--

1113-- @

1214-- putStr \"Not styled. \"

@@ -18,10 +20,11 @@

1820-- putStrLn \"Not styled.\"

1921-- @

2022--

21−-- 'putAttrChange' outputs the control codes to the terminal device 'Handle'. This is a duplicate

22−-- of the 'stdout' handle when the 'terminalHandle' was (first) acquired. If 'stdout' has since been

23−-- changed then 'putStr', 'putStrLn', 'print' etc.. will output to a different 'Handle' than

24−-- 'putAttrChange'

23+-- 'putAttrChange' outputs the control codes to the terminal device

24+-- 'Handle'. This is a duplicate of the 'stdout' handle when the

25+-- 'terminalHandle' was (first) acquired. If 'stdout' has since been

26+-- changed then 'putStr', 'putStrLn', 'print' etc.. will output to a

27+-- different 'Handle' than 'putAttrChange'

2528--

2730{-# LANGUAGE CPP #-}

@@ -67,14 +70,16 @@ foreColor c = modify $ flip mappend ( currentAttr `withForeColor` c )

6770

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

6972--

70−-- If the terminal does not support the style change no error is produced. The style can still be

71−-- removed.

73+-- If the terminal does not support the style change no error is

74+-- produced. The style can still be removed.

7275applyStyle :: Style -> InlineM ()

7376applyStyle s = modify $ flip mappend ( currentAttr `withStyle` s )

7477

75−-- | Attempt to remove the specified 'Style' from the display of the following text.

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

79+-- following text.

7680--

77−-- This will fail if applyStyle for the given style has not been previously called.

81+-- This will fail if applyStyle for the given style has not been

82+-- previously called.

7883removeStyle :: Style -> InlineM ()

7984removeStyle sMask = modify $ \attr ->

8085 let style' = case attrStyle attr of

@@ -87,7 +92,8 @@ removeStyle sMask = modify $ \attr ->

8792defaultAll :: InlineM ()

8893defaultAll = put defAttr

8994

90−-- | Apply the provided display attribute changes to the given terminal output device.

95+-- | Apply the provided display attribute changes to the given terminal

96+-- output device.

9197--

9298-- This does not flush the terminal.

9399putAttrChange :: ( Applicative m, MonadIO m ) => Output -> InlineM () -> m ()

@@ -108,8 +114,9 @@ putAttrChange out c = liftIO $ do

108114 modifyIORef (assumedStateRef out) $ \s -> s { prevFattr = Just fattr' }

109115 inlineHack dc

110116

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.

117+-- | Apply the provided display attributes changes to the terminal

118+-- output device that was current at the time this was first used.

119+-- Which, for most use cases, is the current terminal.

113120--

114121-- This will flush the terminal output.

115122putAttrChange_ :: ( Applicative m, MonadIO m ) => InlineM () -> m ()

src/Graphics/Vty/Inline/Unsafe.hs+3−2

@@ -41,8 +41,9 @@ mkDupeConfig = do

4141 stdoutDupe <- hDuplicate stdout >>= handleToFd

4242 return $ def { inputFd = Just stdinDupe, outputFd = Just stdoutDupe }

4343

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

44+-- | This will create a Vty instance using 'mkVty' and execute an IO

45+-- action provided that instance. The created Vty instance will be

46+-- stored to the unsafe 'IORef' 'globalVty'.

4647--

4748-- This instance will use duplicates of the stdin and stdout Handles.

4849withVty :: (Vty -> IO b) -> IO b

src/Graphics/Vty/Input.hs+101−76

@@ -5,123 +5,143 @@

55#defined MIN_VERSION_base(x,y,z) 1

66#endif

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.

8+-- | The input layer for VTY. This provides methods for initializing an

9+-- 'Input' structure which can then be used to read 'Event's from the

10+-- terminal.

1011--

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.

12+-- The history of terminals has resulted in a broken input process. Some

13+-- keys and combinations will not reliably map to the expected events

14+-- by any terminal program. Even those not using vty. There is no 1:1

15+-- mapping from key events to bytes read from the terminal input device.

16+-- In very limited cases the terminal and vty's input process can be

17+-- customized to resolve these issues.

1518--

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.

19+-- See "Graphics.Vty.Config" for how to configure vty's input

20+-- processing. Customizing terminfo and the terminal is beyond the scope

21+-- of this documentation.

1822--

1923-- = VTY's Implementation

2024--

21−-- One can get the brain rot trying to understand all this. So, as far as I can care...

22−--

2325-- There are two input modes:

2426--

2527-- 1. 7 bit

2628--

2729-- 2. 8 bit

2830--

29−-- 7 bit input is the default and the expected in most use cases. This is what vty uses.

31+-- 7 bit input is the default and the expected in most use cases. This

32+-- is what vty uses.

3033--

3134-- == 7 bit input encoding

3235--

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:

36+-- Control key combinations are represented by masking the two high bits

37+-- of the 7bit input. Back in the day the control key actually grounded

38+-- the two high bit wires: 6 and 7. This is why control key combos map

39+-- to single character events: The input bytes are identical. The input

40+-- byte is the bit encoding of the character with bits 6 and 7 masked.

41+-- Bit 6 is set by shift. Bit 6 and 7 are masked by control. EG:

3842--

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.

43+-- * Control-I is 'i', `01101001`, has bit 6 and 7 masked to become

44+-- `00001001`. Which is the ASCII and UTF-8 encoding of the tab key.

4145--

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.

46+-- * Control+Shift-C is 'C', `01000011`, with bit 6 and 7 set to zero

47+-- which makes `0000011` and is the "End of Text" code.

4448--

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.

49+-- * Hypothesis: This is why capital-A, 'A', has value 65 in ASCII: This

50+-- is the value 1 with bit 7 set and 6 unset.

4751--

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.

52+-- * Hypothesis: Bit 6 is unset by upper case letters because,

53+-- initially, there were only upper case letters used and a 5 bit

54+-- encoding.

5055--

5156-- == 8 bit encoding

5257--

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.

58+-- The 8th bit was originally used for parity checking. Useless for

59+-- emulators. Some terminal emulators support a 8 bit input encoding.

60+-- While this provides some advantages the actual usage is low. Most

61+-- systems use 7bit mode but recognize 8bit control characters when

62+-- escaped. This is what vty does.

5763--

5864-- == Escaped Control Keys

5965--

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.

66+-- Using 7 bit input encoding the @ESC@ byte can signal the start of

67+-- an encoded control key. To differentiate a single @ESC@ eventfrom a

68+-- control key the timing of the input is used.

6269--

6370-- 1. @ESC@ individually: @ESC@ byte; no bytes for 'singleEscPeriod'.

6471--

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.

72+-- 2. control keys that contain @ESC@ in their encoding: The @ESC byte;

73+-- followed by more bytes read within 'singleEscPeriod'. All bytes up

74+-- until the next valid input block are passed to the classifier.

6875--

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.

76+-- If the current runtime is the threaded runtime then the terminal's

77+-- @VMIN@ and @VTIME@ behavior reliably implement the above rules. If

78+-- the current runtime does not support forkOS then there is currently

79+-- no implementation.

7280--

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

81+-- Vty used to emulate @VMIN@ and @VTIME@. This was a input loop

82+-- which did tricky things with non-blocking reads and timers. The

83+-- implementation was not reliable. A reliable implementation is

7584-- possible, but there are no plans to implement this.

7685--

7786-- == Unicode Input and Escaped Control Key Sequences

7887--

79−-- The input encoding determines how UTF-8 encoded characters are recognize.

88+-- The input encoding determines how UTF-8 encoded characters are

89+-- recognize.

8090--

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

91+-- * 7 bit mode: UTF-8 can be input unambiguiously. UTF-8 input is

92+-- a superset of ASCII. UTF-8 does not overlap escaped control key

93+-- sequences. However, the escape key must be differentiated from

8394-- escaped control key sequences by the timing of the input bytes.

8495--

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.

96+-- * 8 bit mode: UTF-8 cannot be input unambiguously. This does not

97+-- require using the timing of input bytes to differentiate the escape

98+-- key. Many terminals do not support 8 bit mode.

8799--

88100-- == Terminfo

89101--

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

102+-- The terminfo system is used to determine how some keys are encoded.

103+-- Terminfo is incomplete. In some cases terminfo is incorrect. Vty

104+-- assumes terminfo is correct but provides a mechanism to override

105+-- terminfo. See "Graphics.Vty.Config" specifically 'inputOverrides'.

93106--

94107-- == Terminal Input is Broken

95108--

96−-- Clearly terminal input has fundemental issues. There is no easy way to reliably resolve these

97−-- issues.

109+-- Clearly terminal input has fundemental issues. There is no easy way

110+-- to reliably resolve these issues.

98111--

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.

112+-- One resolution would be to ditch standard terminal interfaces

113+-- entirely and just go directly to scancodes. A reasonable option for

114+-- vty if everybody used the linux kernel console. I hear GUIs are

115+-- popular these days. Sadly, GUI terminal emulators don't provide

116+-- access to scancodes AFAIK.

102117--

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.

118+-- All is lost? Not really. "Graphics.Vty.Config" supports customizing

119+-- the input byte to event mapping and xterm supports customizing the

120+-- scancode to input byte mapping. With a lot of work a user's system

121+-- can be set up to encode all the key combos in an almost-sane manner.

106122--

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.

123+-- There are other tricky work arounds that can be done. I have no

124+-- interest in implementing most of these. They are not really worth the

125+-- time.

109126--

110127-- == Terminal Output is Also Broken

111128--

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.

129+-- This isn't the only odd aspect of terminals due to historical

130+-- aspects that no longer apply. EG: Some terminfo capabilities specify

131+-- millisecond delays. (Capabilities are how terminfo describes the

132+-- control sequence to output red, for instance) This is to account for

133+-- the slow speed of hardcopy teletype interfaces. Cause, uh, we totally

134+-- still use those.

116135--

117−-- The output encoding of colors and attributes are also rife with issues.

136+-- The output encoding of colors and attributes are also rife with

137+-- issues.

118138--

119139-- == See also

120140--

121141-- * http://www.leonerd.org.uk/hacks/fixterms/

122142--

123−-- In my experience this cannot resolve the issues without changes to the terminal emulator and

124−-- device.

143+-- In my experience this cannot resolve the issues without changes to

144+-- the terminal emulator and device.

125145module Graphics.Vty.Input ( Key(..)

126146 , Modifier(..)

127147 , Button(..)

@@ -149,34 +169,39 @@ import Data.Monoid

149169import Data.Monoid ((<>))

150170#endif

151171

152−-- | Set up the terminal with file descriptor `inputFd` for input. Returns a 'Input'.

172+-- | Set up the terminal with file descriptor `inputFd` for input.

173+-- Returns a 'Input'.

153174--

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

175+-- The table used to determine the 'Events' to produce for the input

176+-- bytes comes from 'classifyMapForTerm'. Which is then overridden by

177+-- the the applicable entries from 'inputMap'.

157178--

158179-- The terminal device is configured with the attributes:

159180--

160181-- * 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?

182+-- - disables software flow control on outgoing data. This stops

183+-- the process from being suspended if the output terminal cannot

184+-- keep up. I presume this has little effect these days. I hope

185+-- this means that output will be buffered if the terminal cannot

186+-- keep up. In the old days the output might of been dropped?

165187--

166188-- "raw" mode is used for input.

167189--

168190-- * ISIG disabled

169−-- - enables keyboard combinations that result in signals. TODO: should probably be a dynamic

170−-- option.

191+-- - enables keyboard combinations that result in signals. TODO:

192+-- should probably be a dynamic option.

171193--

172194-- * ECHO disabled

173−-- - input is not echod to the output. TODO: should be a dynamic option.

195+-- - input is not echod to the output. TODO: should be a

196+-- dynamic option.

174197--

175198-- * ICANON disabled

176−-- - canonical mode (line mode) input is not used. TODO: should be a dynamic option.

199+-- - canonical mode (line mode) input is not used. TODO: should

200+-- be a dynamic option.

177201--

178202-- * IEXTEN disabled

179−-- - extended functions are disabled. TODO: I don't know what those are.

203+-- - extended functions are disabled. TODO: I don't know what

204+-- those are.

180205--

181206inputForConfig :: Config -> IO Input

182207inputForConfig config@Config{ termName = Just termName

src/Graphics/Vty/Input/Classify.hs+15−15

@@ -1,11 +1,9 @@

11{-# OPTIONS_HADDOCK hide #-}

2−-- This makes a kind of tri. Has space efficiency issues with large input blocks.

3−-- Likely building a parser and just applying that would be better.

4−-- I did not write this so I might just rewrite it for better understanding. Which is not the best

5−-- of reasons.

6−-- TODO: measure and rewrite if required.

7−-- TODO: The ClassifyMap interface requires this code to always assure later entries override

8−-- earlier.

2+-- This makes a kind of tri. Has space efficiency issues with large

3+-- input blocks. Likely building a parser and just applying that would

4+-- be better.

5+-- TODO: The ClassifyMap interface requires this code to always assure

6+-- later entries override earlier.

97module Graphics.Vty.Input.Classify

108 ( classify

119 , KClass(..)

@@ -34,17 +32,18 @@ compile table = cl' where

3432 eventForInput = M.fromList table

3533 cl' [] = Prefix

3634 cl' inputBlock = case M.lookup inputBlock eventForInput of

37− -- if the inputBlock is exactly what is expected for an event then consume the whole

38− -- block and return the event

35+ -- if the inputBlock is exactly what is expected for an

36+ -- event then consume the whole block and return the event

3937 Just e -> Valid e []

4038 Nothing -> case S.member inputBlock prefixSet of

4139 True -> Prefix

42− -- look up progressively smaller tails of the input block until an event is found

43− -- The assumption is that the event that consumes the most input bytes should be

44− -- produced.

40+ -- look up progressively smaller tails of the input

41+ -- block until an event is found The assumption is that

42+ -- the event that consumes the most input bytes should

43+ -- be produced.

4544 -- The test verifyFullSynInputToEvent2x verifies this.

46− -- H: There will always be one match. The prefixSet contains, by definition, all

47− -- prefixes of an event.

45+ -- H: There will always be one match. The prefixSet

46+ -- contains, by definition, all prefixes of an event.

4847 False ->

4948 let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock

5049 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of

@@ -76,7 +75,8 @@ classifyUtf8 c cs =

7675 in case decode codepoint8 of

7776 _ | n < length codepoint -> Prefix

7877 Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest

79− Nothing -> Invalid -- something bad happened; just ignore and continue.

78+ -- something bad happened; just ignore and continue.

79+ Nothing -> Invalid

8080

8181utf8Length :: (Num t, Ord a, Num a) => a -> t

8282utf8Length c

src/Graphics/Vty/Input/Events.hs+9−7

@@ -6,12 +6,14 @@ import GHC.Generics

77-- | Representations of non-modifier keys.

88--

9−-- * KFun is indexed from 0 to 63. Range of supported FKeys varies by terminal and keyboard.

9+-- * KFun is indexed from 0 to 63. Range of supported FKeys varies by

10+-- terminal and keyboard.

1011--

11−-- * KUpLeft, KUpRight, KDownLeft, KDownRight, KCenter support varies by terminal and keyboard.

12+-- * KUpLeft, KUpRight, KDownLeft, KDownRight, KCenter support varies by

13+-- terminal and keyboard.

1214--

13−-- * Actually, support for most of these but KEsc, KChar, KBS, and KEnter vary by terminal and

14−-- keyboard.

15+-- * Actually, support for most of these but KEsc, KChar, KBS, and

16+-- KEnter vary by terminal and keyboard.

1517data Key = KEsc | KChar Char | KBS | KEnter

1618 | KLeft | KRight | KUp | KDown

@@ -19,9 +21,9 @@ data Key = KEsc | KChar Char | KBS | KEnter

2022 deriving (Eq,Show,Read,Ord,Generic)

2123

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.

24+-- | Modifier keys. Key codes are interpreted such that users are more

25+-- likely to have Meta than Alt; for instance on the PC Linux console,

26+-- 'MMeta' will generally correspond to the physical Alt key.

2527data Modifier = MShift | MCtrl | MMeta | MAlt

2628 deriving (Eq,Show,Read,Ord,Generic)

2729

src/Graphics/Vty/Input/Loop.hs+24−17

@@ -3,12 +3,15 @@

33{-# LANGUAGE NoMonomorphismRestriction #-}

44{-# LANGUAGE TemplateHaskell #-}

55{-# LANGUAGE CPP #-}

6−-- | The input layer used to be a single function that correctly accounted for the non-threaded

7−-- runtime by emulating the terminal VMIN adn VTIME handling. This has been removed and replace with

8−-- a more straightforward parser. The non-threaded runtime is no longer supported.

6+-- | The input layer used to be a single function that correctly

7+-- accounted for the non-threaded runtime by emulating the terminal

8+-- VMIN adn VTIME handling. This has been removed and replace with a

9+-- more straightforward parser. The non-threaded runtime is no longer

10+-- supported.

911--

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

12+-- This is an example of an algorithm where code coverage could be high,

13+-- even 100%, but the behavior is still under tested. I should collect

14+-- more of these examples...

1215--

1316-- reference: http://www.unixwiz.net/techtips/termios-vmin-vtime.html

1417module Graphics.Vty.Input.Loop where

@@ -46,11 +49,12 @@ import System.Posix.Types (Fd(..))

4649import Text.Printf (hPrintf)

4750

4851data Input = Input

49− { -- | Channel of events direct from input processing. Unlike 'nextEvent' this will not refresh

50− -- the display if the next event is an 'EvResize'.

52+ { -- | Channel of events direct from input processing. Unlike

53+ -- 'nextEvent' this will not refresh the display if the next event

54+ -- is an 'EvResize'.

5155 _eventChannel :: TChan Event

52− -- | Shuts down the input processing. This should return the terminal input state to before

53− -- the input initialized.

56+ -- | Shuts down the input processing. This should return the

57+ -- terminal input state to before he input initialized.

5458 , shutdownInput :: IO ()

5559 -- | Changes to this value are reflected after the next event.

5660 , _configRef :: IORef Config

@@ -86,7 +90,8 @@ logMsg msg = do

8690 Just h -> liftIO $ hPutStrLn h msg >> hFlush h

8791

8892-- this must be run on an OS thread dedicated to this input handling.

89−-- otherwise the terminal timing read behavior will block the execution of the lightweight threads.

93+-- otherwise the terminal timing read behavior will block the execution

94+-- of the lightweight threads.

9095loopInputProcessor :: InputM ()

9196loopInputProcessor = do

9297 readFromDevice >>= addBytesToProcess

@@ -103,10 +108,11 @@ emit event = do

103108 logMsg $ "parsed event: " ++ show event

104109 view eventChannel >>= liftIO . atomically . flip writeTChan event

105110

106−-- The timing requirements are assured by the VMIN and VTIME set for the device.

111+-- The timing requirements are assured by the VMIN and VTIME set for the

112+-- device.

107113--

108−-- Precondition: Under the threaded runtime. Only current use is from a forkOS thread. That case

109−-- satisfies precondition.

114+-- Precondition: Under the threaded runtime. Only current use is from a

115+-- forkOS thread. That case satisfies precondition.

110116-- TODO: When under the non-threaded runtime emulate VMIN and VTIME

111117readFromDevice :: InputM String

112118readFromDevice = do

@@ -120,10 +126,11 @@ readFromDevice = do

120126 bufferPtr <- use $ inputBuffer.ptr

121127 maxBytes <- use $ inputBuffer.size

122128 stringRep <- liftIO $ do

123− -- The killThread used in shutdownInput will not interrupt the foreign call fdReadBuf uses

124− -- this provides a location to be interrupted prior to the foreign call. If there is input

125− -- on the FD then the fdReadBuf will return in a finite amount of time due to the vtime

126− -- terminal setting.

129+ -- The killThread used in shutdownInput will not interrupt the

130+ -- foreign call fdReadBuf uses this provides a location to be

131+ -- interrupted prior to the foreign call. If there is input on

132+ -- the FD then the fdReadBuf will return in a finite amount of

133+ -- time due to the vtime terminal setting.

127134 threadWaitRead fd

128135 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)

129136 if bytesRead > 0

src/Graphics/Vty/Input/Terminfo.hs+13−10

@@ -7,8 +7,8 @@ import qualified Graphics.Vty.Input.Terminfo.ANSIVT as ANSIVT

77import Control.Arrow

88import System.Console.Terminfo

10−-- | queries the terminal for all capability based input sequences then adds on a terminal dependent

11−-- input sequence mapping.

10+-- | Queries the terminal for all capability based input sequences then

11+-- adds on a terminal dependent input sequence mapping.

1212--

1313-- For reference see:

1414--

@@ -20,9 +20,9 @@ import System.Console.Terminfo

2020--

2121-- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html

2222--

23−-- This is painful. Terminfo is incomplete. The vim source implies that terminfo is also incorrect.

24−-- Vty assumes that the an internal terminfo table added to the system provided terminfo table is

25−-- correct.

23+-- This is painful. Terminfo is incomplete. The vim source implies that

24+-- terminfo is also incorrect. Vty assumes that the an internal terminfo

25+-- table added to the system provided terminfo table is correct.

2626--

2727-- 1. build terminfo table for all caps. Missing caps are not added.

2828--

@@ -30,7 +30,8 @@ import System.Console.Terminfo

3030--

3131-- 3. add internally defined table for given terminal type.

3232--

33−-- Precedence is currently implicit in the 'compile' algorithm. Which is a bit odd.

33+-- Precedence is currently implicit in the 'compile' algorithm. Which is

34+-- a bit odd.

3435--

3536-- \todo terminfo meta is not supported.

3637-- \todo no 8bit

@@ -50,7 +51,8 @@ capsClassifyMap :: Terminal -> [(String,Event)] -> ClassifyMap

5051capsClassifyMap terminal table = [(x,y) | (Just x,y) <- map extractCap table]

5152 where extractCap = first (getCapability terminal . tiGetStr)

5253

53−-- | tables specific to a given terminal that are not derivable from terminfo.

54+-- | Tables specific to a given terminal that are not derivable from

55+-- terminfo.

5456--

5557-- TODO: Adds the ANSI/VT100/VT50 tables regardless of term identifier.

5658termSpecificTables :: String -> [ClassifyMap]

@@ -58,8 +60,8 @@ termSpecificTables _termName = ANSIVT.classifyTable

5860

5961-- | Visible characters in the ISO-8859-1 and UTF-8 common set.

6062--

61−-- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this

62−-- classify table is reached.

63+-- We limit to < 0xC1. The UTF8 sequence detector will catch all values

64+-- 0xC2 and above before this classify table is reached.

6365--

6466-- TODO: resolve

6567-- 1. start at ' '. The earlier characters are all 'ctrlChar'

@@ -68,7 +70,8 @@ visibleChars = [ ([x], EvKey (KChar x) [])

6870 | x <- [' ' .. toEnum 0xC1]

6971 ]

7072

71−-- | Non visible characters in the ISO-8859-1 and UTF-8 common set translated to ctrl + char.

73+-- | Non visible characters in the ISO-8859-1 and UTF-8 common set

74+-- translated to ctrl + char.

7275--

7376-- \todo resolve CTRL-i is the same as tab

7477ctrlChars :: ClassifyMap

src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+19−12

@@ -1,15 +1,18 @@

1−-- | Input mappings for ANSI/VT100/VT50 terminals that is missing from terminfo.

1+-- | Input mappings for ANSI/VT100/VT50 terminals that is missing from

2+-- terminfo.

23--

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.

4+-- Or that are sent regardless of terminfo by terminal emulators. EG:

5+-- Terminal emulators will often use VT50 input bytes regardless of

6+-- declared terminal type. This provides compatibility with programs

7+-- that don't follow terminfo.

68module Graphics.Vty.Input.Terminfo.ANSIVT where

810import Graphics.Vty.Input.Events

911

1012-- | Encoding for navigation keys.

1113--

12−-- TODO: This is not the same as the input bytes pulled from teh caps table.

14+-- TODO: This is not the same as the input bytes pulled from teh caps

15+-- table.

1316navKeys0 :: ClassifyMap

1417navKeys0 =

1518 [ k "G" KCenter

@@ -30,8 +33,10 @@ navKeys1 =

3033 [("\ESC[" ++ charCnt ++ show mc++c,EvKey s m)

3134 | charCnt <- ["1;", ""], -- we can have a count or not

3235 (m,mc) <- [([MShift],2::Int), ([MCtrl],5), ([MMeta],3),

33− ([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes

34− (c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft), ("H", KHome), ("F", KEnd)] -- directions and their codes

36+ -- modifiers and their codes

37+ ([MShift, MCtrl],6), ([MShift, MMeta],4)],

38+ -- directions and their codes

39+ (c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft), ("H", KHome), ("F", KEnd)]

3540 ]

3641

3742-- | encoding for ins, del, pageup, pagedown, home, end

@@ -64,11 +69,13 @@ functionKeys1 =

6469--

6570-- TODO: resolve -

6671--

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.

72+-- 1. removed 'ESC' from second list due to duplication with

73+-- "special_support_keys".

74+-- 2. removed '[' from second list due to conflict with 7-bit encoding

75+-- for ESC. Whether meta+[ is the same as ESC should examine km and

76+-- current encoding.

77+-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped

78+-- to KBS by special_support_keys.

7279functionKeys2 :: ClassifyMap

7380functionKeys2 = [ ('\ESC':[x],EvKey (KChar x) [MMeta])

7481 | x <- '\t':[' ' .. '~']

src/Graphics/Vty/Output.hs+33−24

@@ -1,23 +1,27 @@

11{-# LANGUAGE RecordWildCards #-}

22{-# LANGUAGE NamedFieldPuns #-}

3−-- | Output interface.

3+-- | Output interface.

44--

5−-- Access to the current terminal or a specific terminal device.

5+-- Access to the current terminal or a specific terminal device.

66--

7−-- See also:

7+-- See also:

88--

9−-- 1. "Graphics.Vty.Output": This instantiates an abtract interface to the terminal interface based

10−-- on the TERM and COLORTERM environment variables.

9+-- 1. "Graphics.Vty.Output": This instantiates an abtract interface to

10+-- the terminal interface based on the TERM and COLORTERM environment

11+-- variables.

1112--

12−-- 2. "Graphics.Vty.Output.Interface": Defines the generic interface all terminals need to implement.

13+-- 2. "Graphics.Vty.Output.Interface": Defines the generic interface all

14+-- terminals need to implement.

1315--

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.

16+-- 3. "Graphics.Vty.Output.TerminfoBased": Defines a terminal instance

17+-- that uses terminfo for all control strings. No attempt is made to

18+-- change the character set to UTF-8 for these terminals. I don't know a

19+-- way to reliably determine if that is required or how to do so.

1720--

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+-- 4. "Graphics.Vty.Output.XTermColor": This module contains an

22+-- interface suitable for xterm-like terminals. These are the terminals

23+-- where TERM == xterm. This does use terminfo for as many control codes

24+-- as possible.

2125module Graphics.Vty.Output ( module Graphics.Vty.Output

2226 , Output(..) -- \todo hide constructors

2327 , AssumedState(..)

@@ -44,21 +48,24 @@ import Data.Monoid ((<>))

4448

4549-- | Returns a `Output` for the terminal specified in `Config`

4650--

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.

51+-- The specific Output implementation used is hidden from the API user.

52+-- All terminal implementations are assumed to perform more, or less,

53+-- the same. Currently, all implementations use terminfo for at least

54+-- some terminal specific information.

5055--

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.

56+-- Specifics about it being based on terminfo are hidden from the API

57+-- user. If a terminal implementation is developed for a terminal

58+-- without terminfo support then Vty should work as expected on that

59+-- terminal.

5460--

5561-- Selection of a terminal is done as follows:

5662--

5763-- * If TERM contains "xterm" or "screen", use XTermColor.

5864-- * otherwise use the TerminfoBased driver.

5965--

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

66+-- \todo add an implementation for windows that does not depend on

67+-- terminfo. Should be installable with only what is provided in the

68+-- haskell platform. Use ansi-terminal

6269outputForConfig :: Config -> IO Output

6370outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do

6471 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName

@@ -79,11 +86,13 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig

7986

8087-- | Sets the cursor position to the given output column and row.

8188--

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.

89+-- This is not necessarially the same as the character position with the

90+-- same coordinates. Characters can be a variable number of columns in

91+-- width.

8492--

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.

93+-- Currently, the only way to set the cursor position to a given

94+-- character coordinate is to specify the coordinate in the Picture

95+-- instance provided to outputPicture or refresh.

8796setCursorPos :: MonadIO m => Output -> Int -> Int -> m ()

8897setCursorPos t x y = do

8998 bounds <- displayBounds t

src/Graphics/Vty/Output/Interface.hs+41−29

@@ -46,23 +46,26 @@ data Output = Output

4646 { -- | Text identifier for the output device. Used for debugging.

4747 terminalID :: String

4848 , releaseTerminal :: forall m. MonadIO m => m ()

49− -- | Clear the display and initialize the terminal to some initial display state.

49+ -- | Clear the display and initialize the terminal to some initial

50+ -- display state.

5051 --

51− -- The expectation of a program is that the display starts in some initial state.

52− -- The initial state would consist of fixed values:

52+ -- The expectation of a program is that the display starts in some

53+ -- The initial state. initial state would consist of fixed values:

5354 --

5455 -- - cursor at top left

5556 -- - UTF-8 character encoding

5657 -- - drawing characteristics are the default

5758 --

58− -- The abstract operation I think all these behaviors are instances of is reserving exclusive

59− -- access to a display such that:

59+ -- The abstract operation I think all these behaviors are instances

60+ -- of is reserving exclusive access to a display such that:

6061 --

6162 -- - The previous state cannot be determined

62− -- - When exclusive access to a display is released the display returns to the previous state.

63+ -- - When exclusive access to a display is released the display

64+ -- returns to the previous state.

6365 , reserveDisplay :: forall m. MonadIO m => m ()

6466 -- | Return the display to the state before `reserveDisplay`

65− -- If no previous state then set the display state to the initial state.

67+ -- If no previous state then set the display state to the initial

68+ -- state.

6669 , releaseDisplay :: forall m. MonadIO m => m ()

6770 -- | Returns the current display bounds.

6871 , displayBounds :: forall m. MonadIO m => m DisplayRegion

@@ -74,14 +77,16 @@ data Output = Output

7477 , supportsCursorVisibility :: Bool

7578 -- | Indicates support for terminal modes for this output device

7679 , supportsMode :: Mode -> Bool

77− -- | Enables or disables a mode (does nothing if the mode is unsupported)

80+ -- | Enables or disables a mode (does nothing if the mode is

81+ -- unsupported)

7882 , setMode :: forall m. MonadIO m => Mode -> Bool -> m ()

7983 -- | Returns whether a mode is enabled

8084 , getModeStatus :: forall m. MonadIO m => Mode -> m Bool

8185 , assumedStateRef :: IORef AssumedState

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

87+ -- Currently all regions have the upper left corner of (0,0) and

88+ -- the lower right corner at (max displayWidth providedWidth, max

89+ -- displayHeight providedHeight)

8590 , mkDisplayContext :: forall m. MonadIO m => Output -> DisplayRegion -> m DisplayContext

8691 -- | Ring the terminal bell if supported.

8792 , ringTerminalBell :: forall m. MonadIO m => m ()

@@ -104,22 +109,27 @@ data DisplayContext = DisplayContext

104109 { contextDevice :: Output

105110 -- | Provide the bounds of the display context.

106111 , contextRegion :: DisplayRegion

107− -- | sets the output position to the specified row and column. Where the number of bytes

108− -- required for the control codes can be specified seperate from the actual byte sequence.

112+ -- | sets the output position to the specified row and column.

113+ -- Where the number of bytes required for the control codes can be

114+ -- specified seperate from the actual byte sequence.

109115 , writeMoveCursor :: Int -> Int -> Write

110116 , writeShowCursor :: Write

111117 , writeHideCursor :: Write

112− -- | Assure the specified output attributes will be applied to all the following text until the

113− -- next output attribute change. Where the number of bytes required for the control codes can

114− -- be specified seperate from the actual byte sequence. The required number of bytes must be

115− -- at least the maximum number of bytes required by any attribute changes. The serialization

116− -- equations must provide the ptr to the next byte to be specified in the output buffer.

118+ -- | Assure the specified output attributes will be applied to

119+ -- all the following text until the next output attribute change.

120+ -- Where the number of bytes required for the control codes can be

121+ -- specified seperate from the actual byte sequence. The required

122+ -- number of bytes must be at least the maximum number of bytes

123+ -- required by any attribute changes. The serialization equations

124+ -- must provide the ptr to the next byte to be specified in the

125+ -- output buffer.

117126 --

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.

127+ -- The currently applied display attributes are provided as well.

128+ -- The Attr data type can specify the style or color should not be

129+ -- changed from the currently applied display attributes. In order

130+ -- to support this the currently applied display attributes are

131+ -- required. In addition it may be possible to optimize the state

132+ -- changes based off the currently applied display attributes.

123133 , writeSetAttr :: FixedAttr -> Attr -> DisplayAttrDiff -> Write

124134 -- | Reset the display attributes to the default display attributes

125135 , writeDefaultAttr :: Write

@@ -128,7 +138,8 @@ data DisplayContext = DisplayContext

128138 , inlineHack :: IO ()

129139 }

130140

131−-- | All terminals serialize UTF8 text to the terminal device exactly as serialized in memory.

141+-- | All terminals serialize UTF8 text to the terminal device exactly as

142+-- serialized in memory.

132143writeUtf8Text :: BS.ByteString -> Write

133144writeUtf8Text = writeByteString

134145

@@ -153,8 +164,8 @@ outputPicture dc pic = liftIO $ do

153164 r = contextRegion dc

154165 ops = displayOpsForPic pic r

155166 initialAttr = FixedAttr defaultStyleMask Nothing Nothing

156− -- Diff the previous output against the requested output. Differences are currently on a per-row

157− -- basis.

167+ -- Diff the previous output against the requested output.

168+ -- Differences are currently on a per-row basis.

158169 -- \todo handle resizes that crop the dominate directions better.

159170 diffs :: [Bool] = case prevOutputOps as of

160171 Nothing -> replicate (fromEnum $ regionHeight $ effectedRegion ops) True

@@ -225,8 +236,9 @@ writeSpanOp dc (TextSpan attr _ _ str) fattr =

225236writeSpanOp _dc (Skip _) _fattr = error "writeSpanOp for Skip"

226237writeSpanOp dc (RowEnd _) fattr = (writeDefaultAttr dc `mappend` writeRowEnd dc, fattr)

227238

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.

239+-- | The cursor position is given in X,Y character offsets. Due to

240+-- multi-column characters this needs to be translated to column, row

241+-- positions.

230242data CursorOutputMap = CursorOutputMap

231243 { charToOutputPos :: (Int, Int) -> (Int, Int)

232244 }

@@ -261,8 +273,8 @@ cursorColumnOffset ops cx cy =

261273 cursorRowOps

262274 in outOffset

263275

264−-- | Not all terminals support all display attributes. This filters a display attribute to what the

265−-- given terminal can display.

276+-- | Not all terminals support all display attributes. This filters a

277+-- display attribute to what the given terminal can display.

266278limitAttrForDisplay :: Output -> Attr -> Attr

267279limitAttrForDisplay t attr

268280 = attr { attrForeColor = clampColor $ attrForeColor attr

src/Graphics/Vty/Output/Mock.hs+27−18

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

11-- Copyright Corey O'Connor

22{-# LANGUAGE FlexibleInstances #-}

33{-# LANGUAGE TypeFamilies #-}

4−-- | This provides a mock terminal implementation that is nice for testing. This transforms the

5−-- output operations to visible characters. Which is nice for some tests.

4+-- | This provides a mock terminal implementation that is nice for

5+-- testing. This transforms the output operations to visible characters.

6+-- Which is nice for some tests.

67module Graphics.Vty.Output.Mock ( MockData, mockTerminal )

78 where

@@ -20,18 +21,20 @@ import qualified Data.String.UTF8 as UTF8

2021

2122type MockData = IORef (UTF8.UTF8 BS.ByteString)

2223

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.

24+-- | The mock display terminal produces a string representation of

25+-- the requested picture. There is *not* an isomorphism between the

26+-- string representation and the picture. The string representation is

27+-- a simplification of the picture that is only useful in debugging VTY

28+-- without considering terminal specific issues.

2729--

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.

30+-- The mock implementation is useful in manually determining if the

31+-- sequence of terminal operations matches the expected sequence. So

32+-- requirement of the produced representation is simplicity in parsing

33+-- the text representation and determining how the picture was mapped to

34+-- terminal operations.

3235--

33−-- The string representation is a sequence of identifiers where each identifier is the name of an

34−-- operation in the algebra.

36+-- The string representation is a sequence of identifiers where each

37+-- identifier is the name of an operation in the algebra.

3538mockTerminal :: (Applicative m, MonadIO m) => DisplayRegion -> m (MockData, Output)

3639mockTerminal r = liftIO $ do

3740 outRef <- newIORef undefined

@@ -56,17 +59,23 @@ mockTerminal r = liftIO $ do

5659 , mkDisplayContext = \tActual rActual -> return $ DisplayContext

5760 { contextRegion = rActual

5861 , contextDevice = tActual

59− -- A cursor move is always visualized as the single character 'M'

62+ -- A cursor move is always visualized as the single

63+ -- character 'M'

6064 , writeMoveCursor = \_x _y -> writeWord8 $ toEnum $ fromEnum 'M'

61− -- Show cursor is always visualized as the single character 'S'

65+ -- Show cursor is always visualized as the single

66+ -- character 'S'

6267 , writeShowCursor = writeWord8 $ toEnum $ fromEnum 'S'

63− -- Hide cursor is always visualized as the single character 'H'

68+ -- Hide cursor is always visualized as the single

69+ -- character 'H'

6470 , writeHideCursor = writeWord8 $ toEnum $ fromEnum 'H'

65− -- An attr change is always visualized as the single character 'A'

71+ -- An attr change is always visualized as the single

72+ -- character 'A'

6673 , writeSetAttr = \_fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'

67− -- default attr is always visualized as the single character 'D'

74+ -- default attr is always visualized as the single

75+ -- character 'D'

6876 , writeDefaultAttr = writeWord8 $ toEnum $ fromEnum 'D'

69− -- row end is always visualized as the single character 'E'

77+ -- row end is always visualized as the single character

78+ -- 'E'

7079 , writeRowEnd = writeWord8 $ toEnum $ fromEnum 'E'

7180 , inlineHack = return ()

7281 }

src/Graphics/Vty/Output/TerminfoBased.hs+81−62

@@ -8,11 +8,11 @@

88#defined MIN_VERSION_base(x,y,z) 1

99#endif

1010

11−-- | Terminfo based terminal handling.

11+-- | Terminfo based terminal handling.

1212--

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.

13+-- The color handling assumes tektronix like. No HP support provided. If

14+-- the terminal is not one I have easy access to then color support is

15+-- entirely based of the docs. Probably with some assumptions mixed in.

1616--

1717-- Copyright Corey O'Connor (coreyoconnor@gmail.com)

1818module Graphics.Vty.Output.TerminfoBased ( reserveTerminal )

@@ -78,8 +78,10 @@ data DisplayAttrCaps = DisplayAttrCaps

7878 , enterBoldMode :: Maybe CapExpression

7979 }

8080

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.

81+-- kinda like:

82+-- https://code.google.com/p/vim/source/browse/src/fileio.c#10422

83+-- fdWriteBuf will throw on error. Unless the error is EINTR. On EINTR

84+-- the write will be retried.

8385fdWriteAll :: Fd -> Ptr Word8 -> Int -> Int -> IO Int

8486fdWriteAll outFd ptr len count

8587 | len < 0 = fail "fdWriteAll: len is less than 0"

@@ -95,22 +97,25 @@ sendCapToTerminal :: Output -> CapExpression -> [CapParam] -> IO ()

9597sendCapToTerminal t cap capParams = do

9698 outputByteBuffer t $ writeToByteString $ writeCapExpr cap capParams

9799

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+{- | Uses terminfo for all control codes. While this should provide the

101+ - most compatible terminal terminfo does not support some features that

102+ - would increase efficiency and improve compatibility:

100103 -

101− - * determine the character encoding supported by the terminal. Should this be taken from the LANG

102− - environment variable?

104+ - * determine the character encoding supported by the terminal. Should

105+ - this be taken from the LANG environment variable?

103106 -

104107 - * Provide independent string capabilities for all display attributes.

105108 -

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.

109+ - todo: Some display attributes like underline and bold have

110+ - independent string capabilities that should be used instead of the

111+ - generic "sgr" string capability.

108112 -}

109113reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

110114reserveTerminal termName outFd = liftIO $ do

111115 ti <- Terminfo.setupTerm termName

112116 -- assumes set foreground always implies set background exists.

113− -- if set foreground is not set then all color changing style attributes are filtered.

117+ -- if set foreground is not set then all color changing style

118+ -- attributes are filtered.

114119 msetaf <- probeCap ti "setaf"

115120 msetf <- probeCap ti "setf"

116121 let (noColors, useAlt, setForeCap)

@@ -151,8 +156,9 @@ reserveTerminal termName outFd = liftIO $ do

151156 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps

152157 , ringTerminalBell = liftIO $ maybeSendCap ringBellAudio []

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

159+ -- If there is no support for smcup: Clear the screen

160+ -- and then move the mouse to the home position to

161+ -- approximate the behavior.

156162 maybeSendCap smcup []

157163 sendCap clearScreen []

158164 , releaseDisplay = liftIO $ do

@@ -181,8 +187,8 @@ reserveTerminal termName outFd = liftIO $ do

181187 , setMode = const $ const $ return ()

182188 , getModeStatus = const $ return False

183189 , assumedStateRef = newAssumedStateRef

184− -- I think fix would help assure tActual is the only reference. I was having issues

185− -- tho.

190+ -- I think fix would help assure tActual is the only

191+ -- reference. I was having issues tho.

186192 , mkDisplayContext = \tActual -> liftIO . terminfoDisplayContext tActual terminfoCaps

187193 }

188194 sendCap s = sendCapToTerminal t (s terminfoCaps)

@@ -248,8 +254,9 @@ terminfoDisplayContext tActual terminfoCaps r = return dc

248254

249255-- | Portably setting the display attributes is a giant pain in the ass.

250256--

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:

257+-- If the terminal supports the sgr capability (which sets the on/off

258+-- state of each style directly ; and, for no good reason, resets the

259+-- colors to the default) this procedure is used:

253260--

254261-- 0. set the style attributes. This resets the fore and back color.

255262--

@@ -257,33 +264,37 @@ terminfoDisplayContext tActual terminfoCaps r = return dc

257264--

258265-- 2. likewise with the background color

259266--

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:

267+-- If the terminal does not support the sgr cap then: if there is a

268+-- change from an applied color to the default (in either the fore or

269+-- back color) then:

263270--

264−-- 0. reset all display attributes (sgr0)

271+-- 0. reset all display attributes (sgr0)

265272--

266−-- 1. enter required style modes

273+-- 1. enter required style modes

267274--

268−-- 2. set the fore color if required

275+-- 2. set the fore color if required

269276--

270−-- 3. set the back color if required

277+-- 3. set the back color if required

271278--

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.

279+-- Entering the required style modes could require a reset of the

280+-- display attributes. If this is the case then the back and fore colors

281+-- always need to be set if not default.

274282--

275283-- This equation implements the above logic.

276284--

277−-- \todo This assumes the removal of color changes in the display attributes is done as expected

278−-- with noColors == True. See `limitAttrForDisplay`

285+-- \todo This assumes the removal of color changes in the display

286+-- attributes is done as expected with noColors == True. See

287+-- `limitAttrForDisplay`

279288--

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*

289+-- \todo This assumes that fewer state changes, followed by fewer

290+-- bytes, is what to optimize. I haven't measured this or even examined

291+-- terminal implementations. *shrug*

282292terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> FixedAttr -> Attr -> DisplayAttrDiff -> Write

283293terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do

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

295+ -- The only way to reset either color, portably, to the default

296+ -- is to use either the set state capability or the set default

297+ -- capability.

287298 True -> do

288299 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

289300 (fixedStyle attr )

@@ -302,18 +313,21 @@ terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do

302313 (sgrArgsForState state)

303314 `mappend`

304315 setColors

305− -- Otherwise the display colors are not changing or changing between two non-default

306− -- points.

316+ -- Otherwise the display colors are not changing or changing

317+ -- between two non-default points.

307318 False -> do

308− -- Still, it could be the case that the change in display attributes requires the

309− -- colors to be reset because the required capability was not available.

319+ -- Still, it could be the case that the change in display

320+ -- attributes requires the colors to be reset because the

321+ -- required capability was not available.

310322 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

311323 (fixedStyle attr)

312324 (styleDiffs diffs) of

313− -- Really, if terminals were re-implemented with modern concepts instead of bowing

314− -- down to 40 yr old dumb terminal requirements this would be the only case ever

315− -- reached! Changes the style and color states according to the differences with

316− -- the currently applied states.

325+ -- Really, if terminals were re-implemented with modern

326+ -- concepts instead of bowing down to 40 yr old dumb

327+ -- terminal requirements this would be the only case

328+ -- ever reached! Changes the style and color states

329+ -- according to the differences with the currently

330+ -- applied states.

317331 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps

318332 `mappend`

319333 writeColorDiff setForeColor (foreColorDiff diffs)

@@ -347,11 +361,11 @@ terminfoWriteSetAttr dc terminfoCaps prevAttr reqAttr diffs = do

347361 writeColorDiff f (SetColor c)

348362 = writeCapExpr (f terminfoCaps) [toEnum $ colorMap c]

349363

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.

364+-- | The color table used by a terminal is a 16 color set followed by a

365+-- 240 color set that might not be supported by the terminal.

352366--

353−-- This takes a Color which clearly identifies which pallete to use and computes the index

354−-- into the full 256 color pallete.

367+-- This takes a Color which clearly identifies which pallete to use and

368+-- computes the index into the full 256 color pallete.

355369ansiColorIndex :: Color -> Int

356370ansiColorIndex (ISOColor v) = fromEnum v

357371ansiColorIndex (Color240 v) = 16 + fromEnum v

@@ -372,20 +386,23 @@ altColorIndex (ISOColor 7) = 7

372386altColorIndex (ISOColor v) = fromEnum v

373387altColorIndex (Color240 v) = 16 + fromEnum v

374388

375−{- | The sequence of terminfo caps to apply a given style are determined according to these rules.

389+{- | The sequence of terminfo caps to apply a given style are determined

390+ - according to these rules.

376391 -

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.

392+ - 1. The assumption is that it's preferable to use the simpler

393+ - enter/exit mode capabilities than the full set display attribute

394+ - state capability.

379395 -

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.

396+ - 2. If a mode is supposed to be removed but there is not an exit

397+ - capability defined then the display attributes are reset to defaults

398+ - then the display attribute state is set.

382399 -

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.

385− -

386− - 4. If the display attribute state is being set then just update the arguments to that for any

387− - apply/remove.

400+ - 3. If a mode is supposed to be applied but there is not an enter

401+ - capability defined then then display attribute state is set if

402+ - possible. Otherwise the mode is not applied.

388403 -

404+ - 4. If the display attribute state is being set then just update the

405+ - arguments to that for any apply/remove.

389406 -}

390407data DisplayAttrSeq

391408 = EnterExitSeq [CapExpression]

@@ -415,17 +432,19 @@ sgrArgsForState attrState = map (\b -> if b then 1 else 0)

415432

416433reqDisplayCapSeqFor :: DisplayAttrCaps -> Style -> [StyleStateChange] -> DisplayAttrSeq

417434reqDisplayCapSeqFor caps s diffs

418− -- if the state transition implied by any diff cannot be supported with an enter/exit mode cap

419− -- then either the state needs to be set or the attribute change ignored.

435+ -- if the state transition implied by any diff cannot be supported

436+ -- with an enter/exit mode cap then either the state needs to be set

437+ -- or the attribute change ignored.

420438 = case (any noEnterExitCap diffs, isJust $ setAttrStates caps) of

421439 -- If all the diffs have an enter-exit cap then just use those

422440 ( False, _ ) -> EnterExitSeq $ map enterExitCap diffs

423− -- If not all the diffs have an enter-exit cap and there is no set state cap then filter out

424− -- all unsupported diffs and just apply the rest

441+ -- If not all the diffs have an enter-exit cap and there is no

442+ -- set state cap then filter out all unsupported diffs and just

443+ -- apply the rest

425444 ( True, False ) -> EnterExitSeq $ map enterExitCap

426445 $ filter (not . noEnterExitCap) diffs

427− -- if not all the diffs have an enter-exit can and there is a set state cap then just use

428− -- the set state cap.

446+ -- if not all the diffs have an enter-exit can and there is a

447+ -- set state cap then just use the set state cap.

429448 ( True, True ) -> SetState $ stateForStyle s

430449 where

431450 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps

src/Graphics/Vty/Output/XTermColor.hs+5−5

@@ -36,8 +36,8 @@ import Data.Monoid ((<>))

3636reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

3737reserveTerminal variant outFd = liftIO $ do

3838 let flushedPut = void . fdWrite outFd

39− -- If the terminal variant is xterm-color use xterm instead since, more often than not,

40− -- xterm-color is broken.

39+ -- If the terminal variant is xterm-color use xterm instead since,

40+ -- more often than not, xterm-color is broken.

4141 let variant' = if variant == "xterm-color" then "xterm" else variant

4242

4343 utf8a <- utf8Active

@@ -105,9 +105,9 @@ setUtf8CharSet, setDefaultCharSet :: String

105105setUtf8CharSet = "\ESC%G"

106106setDefaultCharSet = "\ESC%@"

107107

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.

108+-- | I think xterm is broken: Reseting the background color as the first

109+-- bytes serialized on a new line does not effect the background color

110+-- xterm uses to clear the line. Which is used *after* the next newline.

111111xtermInlineHack :: Output -> IO ()

112112xtermInlineHack t = do

113113 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"

src/Graphics/Vty/Picture.hs+31−22

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

11{-# LANGUAGE BangPatterns #-}

2−-- | The 'Picture' data structure is representative of the final terminal view.

2+-- | The 'Picture' data structure is representative of the final

3+-- terminal view.

34--

45-- A 'Picture' is a background paired with a layer of 'Image's.

56module Graphics.Vty.Picture ( module Graphics.Vty.Picture

@@ -13,8 +14,9 @@ import Control.DeepSeq

1314

1415-- | The type of images to be displayed using 'update'.

1516--

16−-- Can be constructed directly or using `picForImage`. Which provides an initial instance with

17−-- reasonable defaults for picCursor and picBackground.

17+-- Can be constructed directly or using `picForImage`. Which provides

18+-- an initial instance with reasonable defaults for picCursor and

19+-- picBackground.

1820data Picture = Picture

1921 { picCursor :: Cursor

2022 , picLayers :: [Image]

@@ -39,8 +41,9 @@ addToTop p i = p {picLayers = i : picLayers p}

3941addToBottom :: Picture -> Image -> Picture

4042addToBottom p i = p {picLayers = picLayers p ++ [i]}

4143

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.

44+-- | Create a picture for display for the given image. The picture

45+-- will not have a displayed cursor and no background pattern

46+-- (ClearBackground) will be used.

4447picForImage :: Image -> Picture

4548picForImage i = Picture

4649 { picCursor = NoCursor

@@ -48,10 +51,11 @@ picForImage i = Picture

4851 , picBackground = ClearBackground

4952 }

5053

51−-- | Create a picture for display with the given layers. Ordered top to bottom.

54+-- | Create a picture for display with the given layers. Ordered top to

55+-- bottom.

5256--

53−-- The picture will not have a displayed cursor and no background apttern (ClearBackgroun) will be

54−-- used.

57+-- The picture will not have a displayed cursor and no background

58+-- apttern (ClearBackgroun) will be used.

5559--

5660-- The first 'Image' is the top layer.

5761picForLayers :: [Image] -> Picture

@@ -61,18 +65,20 @@ picForLayers is = Picture

6165 , picBackground = ClearBackground

6266 }

6367

64−-- | A picture can be configured either to not show the cursor or show the cursor at the specified

65−-- character position.

68+-- | A picture can be configured either to not show the cursor or show

69+-- the cursor at the specified character position.

6670--

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.

71+-- There is not a 1 to 1 map from character positions to a row and

72+-- column on the screen due to characters that take more than 1 column.

6973--

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.

74+-- todo: The Cursor can be given a (character,row) offset outside of the

75+-- visible bounds of the output region. In this case the cursor will not

76+-- be shown.

7277data Cursor =

7378 -- | Hide the cursor

7479 NoCursor

75− -- | Show the cursor at the given logical column accounting for char width and row

80+ -- | Show the cursor at the given logical column accounting for

81+ -- char width and row

7682 | Cursor !Int !Int

7783 -- | Show the cursor at the given absolute terminal column and row

7884 | AbsoluteCursor !Int !Int

@@ -80,13 +86,15 @@ data Cursor =

8086instance NFData Cursor where

8187 rnf c = c `seq` ()

8288

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.

89+-- | A 'Picture' has a background pattern. The background is either

90+-- ClearBackground. Which shows the layer below or is blank if the

91+-- bottom layer. Or the background pattern is a character and a display

92+-- attribute. If the display attribute used previously should be used

93+-- for a background fill then use `currentAttr` for the background

94+-- attribute.

8795--

88−-- \todo The current attribute is always set to the default attributes at the start of updating the

89−-- screen to a picture.

96+-- \todo The current attribute is always set to the default attributes

97+-- at the start of updating the screen to a picture.

9098data Background

9199 = Background

92100 { backgroundChar :: Char

@@ -103,6 +111,7 @@ instance NFData Background where

103111 rnf (Background c a) = c `seq` a `seq` ()

104112 rnf ClearBackground = ()

105113

106−-- | Compatibility with applications that do not use more than a single layer.

114+-- | Compatibility with applications that do not use more than a single

115+-- layer.

107116picImage :: Picture -> Image

108117picImage = head . picLayers

src/Graphics/Vty/PictureToSpans.hs+58−43

@@ -49,19 +49,21 @@ type MSpanOps s = MVector s SpanOp

4949

5050-- transform plus clip. More or less.

5151data BlitState = BlitState

52− -- we always snoc to the operation vectors. Thus the columnOffset = length of row at rowOffset

53− -- although, one possibility is to merge layers right in snocOp (naming it something else, of

54− -- course). In which case columnnOffset would be applicable.

55− -- Right now we need it to exist.

52+ -- we always snoc to the operation vectors. Thus the columnOffset =

53+ -- length of row at rowOffset although, one possibility is to merge

54+ -- layers right in snocOp (naming it something else, of course). In

55+ -- which case columnnOffset would be applicable. Right now we need

56+ -- it to exist.

5657 { _columnOffset :: Int

5758 , _rowOffset :: Int

58− -- clip coordinate space is in image space. Which means it's >= 0 and < imageWidth.

59+ -- clip coordinate space is in image space. Which means it's >= 0

60+ -- and < imageWidth.

5961 , _skipColumns :: Int

6062 -- >= 0 and < imageHeight

6163 , _skipRows :: Int

62− -- includes consideration of skipColumns. In display space.

63− -- The number of columns from the next column to be defined to the end of the display for the

64− -- row.

64+ -- includes consideration of skipColumns. In display space. The

65+ -- number of columns from the next column to be defined to the end

66+ -- of the display for the row.

6567 , _remainingColumns :: Int

6668 -- includes consideration of skipRows. In display space.

6769 , _remainingRows :: Int

@@ -78,12 +80,13 @@ makeLenses ''BlitEnv

7880

7981type BlitM s a = ReaderT (BlitEnv s) (StateT BlitState (ST s)) a

8082

81−-- | Produces the span ops that will render the given picture, possibly cropped or padded, into the

82−-- specified region.

83+-- | Produces the span ops that will render the given picture, possibly

84+-- cropped or padded, into the specified region.

8385displayOpsForPic :: Picture -> DisplayRegion -> DisplayOps

8486displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r)

8587

86−-- | Returns the DisplayOps for an image rendered to a window the size of the image.

88+-- | Returns the DisplayOps for an image rendered to a window the size

89+-- of the image.

8790--

8891-- largerly used only for debugging.

8992displayOpsForImage :: Image -> DisplayOps

@@ -91,8 +94,8 @@ displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeig

9194

9295-- | Produces the span ops for each layer then combines them.

9396--

94−-- TODO: a fold over a builder function. start with span ops that are a bg fill of the entire

95−-- region.

97+-- TODO: a fold over a builder function. start with span ops that are a

98+-- bg fill of the entire region.

9699combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s)

97100combinedOpsForLayers pic r

98101 | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0

@@ -101,8 +104,8 @@ combinedOpsForLayers pic r

101104 case layerOps of

102105 [] -> fail "empty picture"

103106 [ops] -> substituteSkips (picBackground pic) ops

104− -- instead of merging ops after generation the merging can be performed as part of

105− -- snocOp.

107+ -- instead of merging ops after generation the merging can

108+ -- be performed as part of snocOp.

106109 topOps : lowerOps -> do

107110 ops <- foldM mergeUnder topOps lowerOps

108111 substituteSkips (picBackground pic) ops

@@ -111,21 +114,24 @@ substituteSkips :: Background -> MRowOps s -> ST s (MRowOps s)

111114substituteSkips ClearBackground ops = do

112115 forM_ [0 .. MVector.length ops - 1] $ \row -> do

113116 rowOps <- MVector.read ops row

114− -- the image operations assure that background fills are combined.

115− -- clipping a background fill does not split the background fill.

116− -- merging of image layers can split a skip, but only by the insertion of a non skip.

117− -- all this combines to mean we can check the last operation and remove it if it's a skip

117+ -- the image operations assure that background fills are

118+ -- combined. clipping a background fill does not split the

119+ -- background fill. merging of image layers can split a skip,

120+ -- but only by the insertion of a non skip. all this combines to

121+ -- mean we can check the last operation and remove it if it's a

122+ -- skip

118123 -- todo: or does it?

119124 let rowOps' = case Vector.last rowOps of

120125 Skip w -> Vector.init rowOps `Vector.snoc` RowEnd w

121126 _ -> rowOps

122− -- now all the skips can be replaced by replications of ' ' of the required width.

127+ -- now all the skips can be replaced by replications of ' ' of

128+ -- the required width.

123129 let rowOps'' = swapSkipsForSingleColumnCharSpan ' ' currentAttr rowOps'

124130 MVector.write ops row rowOps''

125131 return ops

126132substituteSkips (Background {backgroundChar, backgroundAttr}) ops = do

127− -- At this point we decide if the background character is single column or not.

128− -- obviously, single column is easier.

133+ -- At this point we decide if the background character is single

134+ -- column or not. obviously, single column is easier.

129135 case safeWcwidth backgroundChar of

130136 w | w == 0 -> fail $ "invalid background character " ++ show backgroundChar

131137 | w == 1 -> do

@@ -149,12 +155,12 @@ mergeUnder upper lower = do

149155 MVector.write upper row rowOps

150156 return upper

151157

152−-- fugly

153158mergeRowUnder :: SpanOps -> SpanOps -> SpanOps

154159mergeRowUnder upperRowOps lowerRowOps =

155160 onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) lowerRowOps

156161 where

157− -- H: it will never be the case that we are out of upper ops before lower ops.

162+ -- H: it will never be the case that we are out of upper ops

163+ -- before lower ops.

158164 onUpperOp :: SpanOps -> SpanOp -> SpanOps -> SpanOps -> SpanOps

159165 onUpperOp outOps op@(TextSpan _ w _ _) upperOps lowerOps =

160166 let lowerOps' = dropOps w lowerOps

@@ -189,30 +195,37 @@ swapSkipsForCharSpan w c a = Vector.map f

189195 in TextSpan a ow cw txt

190196 f v = v

191197

192−-- | Builds a vector of row operations that will output the given picture to the terminal.

198+-- | Builds a vector of row operations that will output the given

199+-- picture to the terminal.

193200--

194201-- Crops to the given display region.

195202--

196−-- \todo I'm pretty sure there is an algorithm that does not require a mutable buffer.

203+-- \todo I'm pretty sure there is an algorithm that does not require a

204+-- mutable buffer.

197205buildSpans :: Image -> DisplayRegion -> ST s (MRowOps s)

198206buildSpans image outRegion = do

199207 -- First we create a mutable vector for each rows output operations.

200208 outOps <- MVector.replicate (regionHeight outRegion) Vector.empty

201− -- \todo I think building the span operations in display order would provide better performance.

202− -- However, I got stuck trying to implement an algorithm that did this. This will be considered

203− -- as a possible future optimization.

209+ -- \todo I think building the span operations in display order

210+ -- would provide better performance. However, I got stuck trying to

211+ -- implement an algorithm that did this. This will be considered as

212+ -- a possible future optimization.

204213 --

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.

214+ -- A depth first traversal of the image is performed. ordered

215+ -- according to the column range defined by the image from least

216+ -- to greatest. The output row ops will at least have the region

217+ -- of the image specified. Iterate over all output rows and output

218+ -- background fills for all unspecified columns.

209219 --

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.

220+ -- The images are made into span operations from left to right. It's

221+ -- possible that this could easily be made to assure top to bottom

222+ -- output as well.

212223 when (regionHeight outRegion > 0 && regionWidth outRegion > 0) $ do

213− -- The ops builder recursively descends the image and outputs span ops that would

214− -- display that image. The number of columns remaining in this row before exceeding the

215− -- bounds is also provided. This is used to clip the span ops produced to the display.

224+ -- The ops builder recursively descends the image and outputs

225+ -- span ops that would display that image. The number of columns

226+ -- remaining in this row before exceeding the bounds is also

227+ -- provided. This is used to clip the span ops produced to the

228+ -- display.

216229 let fullBuild = do

217230 startImageBuild image

218231 -- Fill in any unspecified columns with a skip.

@@ -223,7 +236,8 @@ buildSpans image outRegion = do

223236 return ()

224237 return outOps

225238

226−-- | Add the operations required to build a given image to the current set of row operations.

239+-- | Add the operations required to build a given image to the current

240+-- set of row operations.

227241startImageBuild :: Image -> BlitM s ()

228242startImageBuild image = do

229243 outOfBounds <- isOutOfBounds image <$> get

@@ -237,11 +251,12 @@ isOutOfBounds i s

237251 | s ^. skipRows >= imageHeight i = True

238252 | otherwise = False

239253

240−-- | This adds an image that might be partially clipped to the output ops.

254+-- | This adds an image that might be partially clipped to the output

255+-- ops.

241256--

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.

257+-- This is a very touchy algorithm. Too touchy. For instance, the

258+-- CropRight and CropBottom implementations are odd. They pass the

259+-- current tests but something seems terribly wrong about all this.

245260--

246261-- \todo prove this cannot be called in an out of bounds case.

247262addMaybeClipped :: forall s . Image -> BlitM s ()

src/Graphics/Vty/Span.hs+30−22

@@ -2,16 +2,17 @@

22{-# LANGUAGE BangPatterns #-}

33{-# LANGUAGE NamedFieldPuns #-}

44{-# LANGUAGE GADTs #-}

5−{- | A picture is translated into a sequences of state changes and character spans.

6− - State changes are currently limited to new attribute values. The attribute is applied to all

7− - following spans. Including spans of the next row. The nth element of the sequence represents the

5+{- | A picture is translated into a sequences of state changes and

6+ - character spans. State changes are currently limited to new attribute

7+ - values. The attribute is applied to all following spans. Including

8+ - spans of the next row. The nth element of the sequence represents the

89 - nth row (from top to bottom) of the picture to render.

910 -

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

11+ - A span op sequence will be defined for all rows and columns (and no

12+ - more) of the region provided with the picture to `spansForPic`.

1213 -

13− - todo: Partition attribute changes into multiple categories according to the serialized

14− - representation of the various attributes.

14+ - todo: Partition attribute changes into multiple categories according

15+ - to the serialized representation of the various attributes.

1516 -}

1617module Graphics.Vty.Span

1718 where

@@ -25,12 +26,13 @@ import qualified Data.Text.Lazy as TL

2526import Data.Vector (Vector)

2627import qualified Data.Vector as Vector

2728

28−-- | This represents an operation on the terminal. Either an attribute change or the output of a

29−-- text string.

29+-- | This represents an operation on the terminal. Either an attribute

30+-- change or the output of a text string.

3031data SpanOp =

31− -- | a span of UTF-8 text occupies a specific number of screen space columns. A single UTF

32− -- character does not necessarially represent 1 colunm. See Codec.Binary.UTF8.Width

33− -- TextSpan [Attr] [output width in columns] [number of characters] [data]

32+ -- | a span of UTF-8 text occupies a specific number of screen space

33+ -- columns. A single UTF character does not necessarially represent

34+ -- 1 colunm. See Codec.Binary.UTF8.Width TextSpan [Attr] [output

35+ -- width in columns] [number of characters] [data]

3436 TextSpan

3537 { textSpanAttr :: !Attr

3638 , textSpanOutputWidth :: !Int

@@ -38,20 +40,23 @@ data SpanOp =

3840 , textSpanText :: DisplayText

3941 }

4042 -- | Skips the given number of columns

41− -- A skip is transparent.... maybe? I am not sure how attribute changes interact.

43+ -- A skip is transparent.... maybe? I am not sure how attribute

44+ -- changes interact.

4245 -- todo: separate from this type.

4346 | Skip !Int

44− -- | Marks the end of a row. specifies how many columns are remaining. These columns will not be

45− -- explicitly overwritten with the span ops. The terminal is require to assure the remaining

47+ -- | Marks the end of a row. specifies how many columns are

48+ -- remaining. These columns will not be explicitly overwritten with

49+ -- the span ops. The terminal is require to assure the remaining

4650 -- columns are clear.

4751 -- todo: separate from this type.

4852 | RowEnd !Int

4953 deriving Eq

5054

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.

55+-- | vector of span operations. executed in succession. This represents

56+-- the operations required to render a row of the terminal. The

57+-- operations in one row may effect subsequent rows.

58+-- EG: Setting the foreground color in one row will effect all

59+-- subsequent rows until the foreground color is changed.

5560type SpanOps = Vector SpanOp

5661

5762dropOps :: Int -> SpanOps -> SpanOps

@@ -90,7 +95,8 @@ splitOpsAt inW inOps = splitOpsAt' inW inOps

9095 )

9196 RowEnd _ -> error "cannot split ops containing a row end"

9297

93−-- | vector of span operation vectors for display. One per row of the output region.

98+-- | vector of span operation vectors for display. One per row of the

99+-- output region.

94100type DisplayOps = Vector SpanOps

95101

96102instance Show SpanOp where

@@ -100,7 +106,8 @@ instance Show SpanOp where

100106

101107-- | Number of columns the DisplayOps are defined for

102108--

103−-- All spans are verified to define same number of columns. See: VerifySpanOps

109+-- All spans are verified to define same number of columns. See:

110+-- VerifySpanOps

104111displayOpsColumns :: DisplayOps -> Int

105112displayOpsColumns ops

106113 | Vector.length ops == 0 = 0

@@ -127,7 +134,8 @@ spanOpHasWidth (TextSpan _ ow cw _) = Just (cw, ow)

127134spanOpHasWidth (Skip ow) = Just (ow,ow)

128135spanOpHasWidth (RowEnd ow) = Just (ow,ow)

129136

130−-- | returns the number of columns to the character at the given position in the span op

137+-- | returns the number of columns to the character at the given

138+-- position in the span op

131139columnsToCharOffset :: Int -> SpanOp -> Int

132140columnsToCharOffset cx (TextSpan _ _ _ utf8Str) =

133141 let str = TL.unpack utf8Str

test/Verify/Graphics/Vty/Image.hs+3−3

@@ -100,9 +100,9 @@ instance Arbitrary ImageResize where

100100

101101instance Arbitrary SingleRowSingleAttrImage where

102102 arbitrary = do

103− -- The text must contain at least one character. Otherwise the image simplifies to the

104− -- IdImage which has a height of 0. If this is to represent a single row then the height

105− -- must be 1

103+ -- The text must contain at least one character. Otherwise the

104+ -- image simplifies to the IdImage which has a height of 0. If

105+ -- this is to represent a single row then the height must be 1

106106 singleColumnRowText <- Verify.resize 16 (listOf1 arbitrary)

107107 a <- arbitrary

108108 let outImage = horizCat $ [char a c | SingleColumnChar c <- singleColumnRowText]

test/Verify/Graphics/Vty/Output.hs+4−4

@@ -10,10 +10,10 @@ import qualified Data.String.UTF8 as UTF8

1010

1111import Test.QuickCheck.Property

1212

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.

13+-- A list of terminals that should be supported. This started with a

14+-- list of terminals ubuntu supported. Then those terminals that really

15+-- could not be supported were removed. Then a few more were pruned

16+-- until a reasonable looking set was made.

1717terminalsOfInterest :: [String]

1818terminalsOfInterest =

1919 [ "vt100"

test/VerifyEvalTerminfoCaps.hs+4−3

@@ -24,7 +24,8 @@ import Foreign.Marshal.Alloc (mallocBytes)

2424import Foreign.Ptr (Ptr, minusPtr)

2525import Numeric

2626

27−-- If a terminal defines one of the caps then it's expected to be parsable.

27+-- If a terminal defines one of the caps then it's expected to be

28+-- parsable.

2829capsOfInterest =

2930 [ "cup"

3031 , "sc"

@@ -49,7 +50,8 @@ fromCapname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr na

4950

5051tests :: IO [Test]

5152tests = do

52− evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024) -- Should be big enough for any termcaps ;-)

53+ -- 1 MB should be big enough for any termcaps ;-)

54+ evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024)

5355 fmap concat $ forM terminalsOfInterest $ \termName -> do

5456 putStrLn $ "adding tests for terminal: " ++ termName

5557 mti <- try $ Terminfo.setupTerm termName

@@ -87,4 +89,3 @@ verifyEvalCap evalBuffer expr !junkInt = do

8789 }

8890 | otherwise ->

8991 return succeeded

90−

test/VerifyLayersSpanGeneration.hs+6−5

@@ -25,8 +25,9 @@ largerHorizSpanOcclusion row0 row1 =

2525 ops = displayOpsForPic p (imageWidth iLarger,imageHeight iLarger)

2626 in verifyOpsEquality expectedOps ops

2727

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.

28+-- | Two rows stacked vertical is equivalent to the first row rendered

29+-- as the top layer and the second row rendered as a bottom layer with a

30+-- background fill where the first row would be.

3031vertStackLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result

3132vertStackLayerEquivalence0 row0 row1 =

3233 let i0 = rowImage row0

@@ -52,8 +53,9 @@ vertStackLayerEquivalence1 row0 row1 =

5253 opsLayered = displayOpsForPic pLayered (imageWidth iLower,imageHeight iLower)

5354 in verifyOpsEquality expectedOps opsLayered

5455

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.

56+-- | Two rows horiz joined is equivalent to the first row rendered as

57+-- the top layer and the second row rendered as a bottom layer with a

58+-- background fill where the first row would be.

5759horizJoinLayerEquivalence0 :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Result

5860horizJoinLayerEquivalence0 row0 row1 =

5961 let i0 = rowImage row0

@@ -125,4 +127,3 @@ tests = return

125127 -- , verify "alternating images using joins is the same as alternating images using layers (1)"

126128 -- horizJoinAlternate1

127129 ]

128−

test/VerifyOutput.hs+4−3

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

11{- 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.

2+ - This assumes appropriate definitions exist in the current environment

3+ - for the terminals of interest.

44 -}

55module VerifyOutput where

66import Verify

@@ -41,7 +41,8 @@ smokeTestTerm termName i = do

4141 -- putStrLn $ "context color count: " ++ show (contextColorCount t)

4242 reserveDisplay t

4343 dc <- displayContext t (100,100)

44− -- always show the cursor to produce tests for terminals with no cursor support.

44+ -- always show the cursor to produce tests for terminals with no

45+ -- cursor support.

4546 let pic = (picForImage i) { picCursor = Cursor 0 0 }

4647 outputPicture dc pic

4748 setCursorPos t 0 0

test/VerifyUsingMockInput.hs+9−5

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

11{-# LANGUAGE MultiParamTypeClasses #-}

22{-# LANGUAGE FlexibleInstances #-}

3−{- Generate some input bytes and delays between blocks of input bytes. Verify the events produced

4− - are as expected.

3+{- Generate some input bytes and delays between blocks of input bytes.

4+ - Verify the events produced are as expected.

55 -}

66module Main where

@@ -36,7 +36,8 @@ import Test.SmallCheck.Series

3636

3737import Text.Printf

3838

39−-- processing a block of 16 chars is the largest I can do without taking too long to run the test.

39+-- processing a block of 16 chars is the largest I can do without taking

40+-- too long to run the test.

4041maxBlockSize :: Int

4142maxBlockSize = 16

4243

@@ -47,8 +48,11 @@ forEachOf :: (Show a, Testable m b) => [a] -> (a -> b) -> Property m

4748forEachOf l = over (generate (\n -> take n l))

4849

4950data InputEvent

50− = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.

51− | Delay Int -- | microsecond delay

51+ = Bytes String

52+ -- ^ Input sequence encoded as a string. Regardless, the input is

53+ -- read a byte at a time.

54+ | Delay Int

55+ -- ^ Microsecond delay

5256 deriving Show

5357

5458type InputSpec = [InputEvent]

test/VerifyUsingMockTerminal.hs+20−14

@@ -39,13 +39,14 @@ singleTRow :: MockWindow -> Property

3939singleTRow (MockWindow w h) = liftIOResult $ do

4040 (mockData,t) <- mockTerminal (w,h)

4141 dc <- displayBounds t >>= displayContext t

42− -- create an image that contains just the character T repeated for a single row

42+ -- create an image that contains just the character T repeated for a

43+ -- single row

4344 let i = horizCat $ replicate (fromEnum w) (char defAttr 'T')

4445 pic = (picForImage i) { picBackground = Background 'B' defAttr }

4546 outputPicture dc pic

46− -- The mock output string that represents the output bytes a single line containing the T

47− -- string: Followed by h - 1 lines of a change to the background attribute and then the

48− -- background character

47+ -- The mock output string that represents the output bytes a single

48+ -- line containing the T string: Followed by h - 1 lines of a change

49+ -- to the background attribute and then the background character

4950 let expected = "H" ++ "MDA" ++ replicate (fromEnum w) 'T'

5051 ++ concat (replicate (fromEnum h - 1) $ "MDA" ++ replicate (fromEnum w) 'B')

5152 compareMockOutput mockData expected

@@ -54,12 +55,14 @@ manyTRows :: MockWindow -> Property

5455manyTRows (MockWindow w h) = liftIOResult $ do

5556 (mockData, t) <- mockTerminal (w,h)

5657 dc <- displayBounds t >>= displayContext t

57− -- create an image that contains the character 'T' repeated for all the rows

58+ -- create an image that contains the character 'T' repeated for all

59+ -- the rows

5860 let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w) (char defAttr 'T')

5961 pic = (picForImage i) { picBackground = Background 'B' defAttr }

6062 outputPicture dc pic

61− -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an

62− -- attribute change. 'A', followed by w 'T's

63+ -- The UTF8 string that represents the output bytes is h repeats of

64+ -- a move, 'M', followed by an attribute change. 'A', followed by w

65+ -- 'T's

6366 let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')

6467 compareMockOutput mockData expected

6568

@@ -67,12 +70,14 @@ manyTRowsCroppedWidth :: MockWindow -> Property

6770manyTRowsCroppedWidth (MockWindow w h) = liftIOResult $ do

6871 (mockData,t) <- mockTerminal (w,h)

6972 dc <- displayBounds t >>= displayContext t

70− -- create an image that contains the character 'T' repeated for all the rows

73+ -- create an image that contains the character 'T' repeated for all

74+ -- the rows

7175 let i = vertCat $ replicate (fromEnum h) $ horizCat $ replicate (fromEnum w * 2) (char defAttr 'T')

7276 pic = (picForImage i) { picBackground = Background 'B' defAttr }

7377 outputPicture dc pic

74− -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an

75− -- attribute change. 'A', followed by w 'T's

78+ -- The UTF8 string that represents the output bytes is h repeats of

79+ -- a move, 'M', followed by an attribute change. 'A', followed by w

80+ -- 'T's

7681 let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')

7782 compareMockOutput mockData expected

7883

@@ -80,12 +85,14 @@ manyTRowsCroppedHeight :: MockWindow -> Property

8085manyTRowsCroppedHeight (MockWindow w h) = liftIOResult $ do

8186 (mockData,t) <- mockTerminal (w,h)

8287 dc <- displayBounds t >>= displayContext t

83− -- create an image that contains the character 'T' repeated for all the rows

88+ -- create an image that contains the character 'T' repeated for all

89+ -- the rows

8490 let i = vertCat $ replicate (fromEnum h * 2) $ horizCat $ replicate (fromEnum w) (char defAttr 'T')

8591 pic = (picForImage i) { picBackground = Background 'B' defAttr }

8692 outputPicture dc pic

87− -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an

88− -- attribute change. 'A', followed by w count 'T's

93+ -- The UTF8 string that represents the output bytes is h repeats of

94+ -- a move, 'M', followed by an attribute change. 'A', followed by w

95+ -- count 'T's

8996 let expected = "H" ++ concat (replicate (fromEnum h) $ "MDA" ++ replicate (fromEnum w) 'T')

9097 compareMockOutput mockData expected

9198

@@ -97,4 +104,3 @@ tests = return [ verify "unitImageUnitBounds" unitImageUnitBounds

97104 , verify "manyTRowsCroppedWidth" manyTRowsCroppedWidth

98105 , verify "manyTRowsCroppedHeight" manyTRowsCroppedHeight

99106 ]

100−