f6c3cbf · vty · git.iko.soy

CHANGELOG+26

@@ -17,6 +17,32 @@

1717 coincidence.

1818

19194.0.0

20+ * API changes:

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

22+ instance of the Vty data structure.

23+ * added a "terminal" field to the Vty data structure. Accesses the TerminalHandle associated

24+ with the Vty instance.

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

26+ * Partitioned into Graphics.Vty.Attributes for display attributes. Graphics.Vty.Image for

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

28+ * Graphics.Vty.Attributes:

29+ * "setFG" and "setBG" are now "with_fore_color" and "with_back_color"

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

31+ * "attr" is now "def_attr", short for "default display attributes" Also added a

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

33+ * Graphics.Vty.Image:

34+ * "horzcat" is now "horiz_cat"

35+ * "vertcat" is now "vert_cat"

36+ * "renderBS" is now "utf8_bytestring"

37+ * "renderChar" is now "char"

38+ * "renderFill" is now "char_fill"

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

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

41+ representation.

42+ * Graphics.Vty.Picture:

43+ * exports Graphics.Vty.Image

44+ * "pic" is now "pic_for_image"

45+ * added API for setting background fill pattern.

2046 * Completely rewritten output backend.

2147 * Efficient, scanline style output span generator. Has not been fully optimized, but good

2248 enough.

DESIGNnew file+32

@@ -0,0 +1,32 @@

1+On the design of vty

2+

3+ It appears to me that there are two kinds of graphical

4+applications, regardless of the output form; the synchronous and the

5+asynchronous. Synchronous displays update as changes occur; a good

6+example of this type is nethack, with its many newsym() calls embedded

7+in the logic. Synchronous applications use very little abstractable

8+code, and in practice all use low level interfaces such as terminfo.

9+

10+ Asynchronous screen programs, OTOH, do not have update code within

11+the main logic. Instead, they perform output "lazily", only computing

12+it at periodic refresh points. Because "backtracking" is not

13+rendered, asynchronous screen programs use less bandwidth, and can

14+(but usually don't) use less CPU. Asynchronous programs have their

15+update logic centralized in such a way that it can be abstracted as a

16+library; this is what both vty and curses are.

17+

18+ In the past, vty has had considerable confusion and race

19+conditions due to the fact that screen resizes can occur

20+asynchronously with respect to output. Vty 3.0 handles this in an

21+very elegant (IMO) way, by treating resizes as just another input

22+event; the size of the picture being output at any time need have no

23+relation to the screen, though of course corruption will result if

24+they are different.

25+

26+ On a "real" terminal (termcap, not xcurses), output and input can

27+be completely separated; they can occur concurrently, and do not

28+effect each other. Because of this we simplify the internal structure

29+by using entirely different mechanisms for input and output. This is

30+also a great benefit because of the differing characteristics of input

31+code (complicated, best table driven, etc) versus output code

32+(performance critical).

TODO+14−12

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

1−Minor:

2−- input parser uses similar interface to DisplayHandle. Derive instance from terminfo

3−- Improve input handling performance.

4−- xterm cursor foreground handling.

5− - specific color

6− - reverse video

7− - auto

8−- position cursor correctly.

9−

10−

11−Major:

12−- Remove size fields in resize constr

1+- Improve input handling

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

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

4+ export the required modules. Either:

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

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

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

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

9+ haskeline.

10+- use compact-string for character encoding handling

11+- Custom cursor appearance handling?

12+ - specific color?

13+ - reverse video?

14+ - auto?

1315

src/Codec/Binary/UTF8/Width.hs+16−8

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

22{-# OPTIONS_GHC -D_XOPEN_SOURCE -fno-cse #-}

3−{-# LANGUAGE ForeignFunctionInterface #-}

3+{-# LANGUAGE ForeignFunctionInterface, BangPatterns #-}

44{-# INCLUDE <wchar.h> #-}

55module Codec.Binary.UTF8.Width ( wcwidth

66 , wcswidth

@@ -10,23 +10,31 @@ module Codec.Binary.UTF8.Width ( wcwidth

1010import Foreign.C.Types

1111import Foreign.C.String

1212import Foreign.Storable

13+import Foreign.Ptr

1314

14−import Numeric ( showHex )

15+-- import Numeric ( showHex )

1516

1617import System.IO.Unsafe

1718

1819wcwidth :: Char -> Int

19−wcwidth c = unsafePerformIO (withCWString [c] $ \ws -> do

20+wcwidth c = unsafePerformIO (withCWString [c] $! \ws -> do

2021 wc <- peek ws

21− putStr $ "wcwidth(0x" ++ showHex (fromEnum wc) "" ++ ")"

22− w <- wcwidth' wc >>= return . fromIntegral

23− putStrLn $ " -> " ++ show w

22+ -- putStr $ "wcwidth(0x" ++ showHex (fromEnum wc) "" ++ ")"

23+ let !w = fromIntegral $! wcwidth' wc

24+ -- putStrLn $ " -> " ++ show w

2425 return w

2526 )

2627{-# NOINLINE wcwidth #-}

2728

28−foreign import ccall "mk_wcwidth" wcwidth' :: CWchar -> IO CInt

29+foreign import ccall unsafe "mk_wcwidth" wcwidth' :: CWchar -> CInt

2930

3031wcswidth :: String -> Int

31−wcswidth str = sum $ map wcwidth str

32+wcswidth str = unsafePerformIO (withCWStringLen str $! \(ws, ws_len) -> do

33+ -- putStr $ "wcswidth(...)"

34+ let !w = fromIntegral $! wcswidth' ws (fromIntegral ws_len)

35+ -- putStrLn $ " -> " ++ show w

36+ return w

37+ )

38+{-# NOINLINE wcswidth #-}

3239

40+foreign import ccall unsafe "mk_wcswidth" wcswidth' :: Ptr CWchar -> CSize -> CInt

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

@@ -92,52 +92,61 @@ cap_op_required_bytes (PushValue v) = do

9292 return 0

9393cap_op_required_bytes (Conditional expr parts) = do

9494 c_expr <- cap_ops_required_bytes expr

95− c_parts <- foldM cond_parts_required_bytes 0 parts

95+ c_parts <- cond_parts_required_bytes parts

9696 return $ c_expr + c_parts

9797 where

98− cond_parts_required_bytes in_c (true_ops, false_ops) = do

98+ cond_parts_required_bytes [] = return 0

99+ cond_parts_required_bytes ( (true_ops, false_ops) : false_parts ) = do

99100 -- (man 5 terminfo)

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

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

102103 -- passes to the %e (else) part.

103104 v <- pop

104− c_branch <- if v /= 0

105− then cap_ops_required_bytes true_ops

106− else cap_ops_required_bytes false_ops

107− return $ in_c + c_branch

105+ c_total <- if v /= 0

106+ then cap_ops_required_bytes true_ops

107+ else do

108+ c_false <- cap_ops_required_bytes false_ops

109+ c_remain <- cond_parts_required_bytes false_parts

110+ return $ c_false + c_remain

111+ return c_total

108112cap_op_required_bytes BitwiseOr = do

109− v_0 <- pop

110113 v_1 <- pop

114+ v_0 <- pop

111115 push $ v_0 .|. v_1

112116 return 0

113117cap_op_required_bytes BitwiseAnd = do

114− v_0 <- pop

115118 v_1 <- pop

119+ v_0 <- pop

116120 push $ v_0 .&. v_1

117121 return 0

118122cap_op_required_bytes BitwiseXOr = do

119− v_0 <- pop

120123 v_1 <- pop

124+ v_0 <- pop

121125 push $ v_0 `xor` v_1

122126 return 0

123127cap_op_required_bytes ArithPlus = do

124− v_0 <- pop

125128 v_1 <- pop

129+ v_0 <- pop

126130 push $ v_0 + v_1

127131 return 0

128−cap_op_required_bytes CompareEq = do

132+cap_op_required_bytes ArithMinus = do

133+ v_1 <- pop

129134 v_0 <- pop

135+ push $ v_0 - v_1

136+ return 0

137+cap_op_required_bytes CompareEq = do

130138 v_1 <- pop

139+ v_0 <- pop

131140 push $ if v_0 == v_1 then 1 else 0

132141 return 0

133142cap_op_required_bytes CompareLt = do

134− v_0 <- pop

135143 v_1 <- pop

144+ v_0 <- pop

136145 push $ if v_0 < v_1 then 1 else 0

137146 return 0

138147cap_op_required_bytes CompareGt = do

139− v_0 <- pop

140148 v_1 <- pop

149+ v_0 <- pop

141150 push $ if v_0 > v_1 then 1 else 0

142151 return 0

143152

@@ -175,19 +184,23 @@ serialize_cap_op out_ptr (PushValue v) = do

175184 return out_ptr

176185serialize_cap_op out_ptr (Conditional expr parts) = do

177186 out_ptr' <- serialize_cap_ops out_ptr expr

178− out_ptr'' <- foldM serialize_cond_parts out_ptr' parts

187+ out_ptr'' <- serialize_cond_parts out_ptr' parts

179188 return out_ptr''

180189 where

181− serialize_cond_parts ptr (true_ops, false_ops) = do

190+ serialize_cond_parts ptr [] = return ptr

191+ serialize_cond_parts ptr ( (true_ops, false_ops) : false_parts ) = do

182192 -- (man 5 terminfo)

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

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

185195 -- passes to the %e (else) part.

186196 v <- pop

187− ptr' <- if v /= 0

197+ ptr'' <- if v /= 0

188198 then serialize_cap_ops ptr true_ops

189− else serialize_cap_ops ptr false_ops

190− return ptr'

199+ else do

200+ ptr' <- serialize_cap_ops ptr false_ops

201+ serialize_cond_parts ptr' false_parts

202+ return ptr''

203+

191204serialize_cap_op out_ptr BitwiseOr = do

192205 v_0 <- pop

193206 v_1 <- pop

@@ -199,28 +212,33 @@ serialize_cap_op out_ptr BitwiseAnd = do

199212 push $ v_0 .&. v_1

200213 return out_ptr

201214serialize_cap_op out_ptr BitwiseXOr = do

202− v_0 <- pop

203215 v_1 <- pop

216+ v_0 <- pop

204217 push $ v_0 `xor` v_1

205218 return out_ptr

206219serialize_cap_op out_ptr ArithPlus = do

207− v_0 <- pop

208220 v_1 <- pop

221+ v_0 <- pop

209222 push $ v_0 + v_1

210223 return out_ptr

211−serialize_cap_op out_ptr CompareEq = do

224+serialize_cap_op out_ptr ArithMinus = do

225+ v_1 <- pop

212226 v_0 <- pop

227+ push $ v_0 - v_1

228+ return out_ptr

229+serialize_cap_op out_ptr CompareEq = do

213230 v_1 <- pop

231+ v_0 <- pop

214232 push $ if v_0 == v_1 then 1 else 0

215233 return out_ptr

216234serialize_cap_op out_ptr CompareLt = do

217− v_0 <- pop

218235 v_1 <- pop

236+ v_0 <- pop

219237 push $ if v_0 < v_1 then 1 else 0

220238 return out_ptr

221239serialize_cap_op out_ptr CompareGt = do

222− v_0 <- pop

223240 v_1 <- pop

241+ v_0 <- pop

224242 push $ if v_0 > v_1 then 1 else 0

225243 return out_ptr

226244

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

@@ -50,7 +50,7 @@ data CapOp =

5050 , conditional_parts :: ![(CapOps, CapOps)]

5151 }

5252 | BitwiseOr | BitwiseXOr | BitwiseAnd

53− | ArithPlus

53+ | ArithPlus | ArithMinus

5454 | CompareEq | CompareLt | CompareGt

5555 deriving ( Show )

5656

@@ -229,10 +229,18 @@ bitwise_xor_parser = do

229229 return $ BuildResults 0 [ BitwiseXOr ] [ ]

230230

231231arith_op_parser :: CapParser BuildResults

232−arith_op_parser = do

233− char '+'

234− inc_offset 1

235− return $ BuildResults 0 [ ArithPlus ] [ ]

232+arith_op_parser

233+ = plus_op

234+ <|> minus_op

235+ where

236+ plus_op = do

237+ char '+'

238+ inc_offset 1

239+ return $ BuildResults 0 [ ArithPlus ] [ ]

240+ minus_op = do

241+ char '-'

242+ inc_offset 1

243+ return $ BuildResults 0 [ ArithMinus ] [ ]

236244

237245literal_int_op_parser :: CapParser BuildResults

238246literal_int_op_parser = do

src/Graphics/Vty.hs+12−12

@@ -26,11 +26,10 @@ import Graphics.Vty.DisplayRegion

2626import Graphics.Vty.LLInput

2727

2828import Data.IORef

29−import Control.Concurrent

3029

3130import Data.Maybe ( maybe )

3231

33−import System.Console.Terminfo

32+import qualified System.Console.Terminfo as Terminfo

3433import System.IO

3534

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

@@ -49,9 +48,6 @@ data Vty = Vty

4948 -- | Get one Event object, blocking if necessary.

5049 , next_event :: IO Event

5150 -- | Handle to the terminal interface. See `Terminal`

52− --

53− -- todo: provide a similar abstraction for input. Use haskeline's input backend for

54− -- implementation.

5551 --

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

5753 --

@@ -61,13 +57,16 @@ data Vty = Vty

6157 --

6258 -- 2. repeat

6359 --

64− -- 3. shutdown vty. todo: remove? Automate release of resources as much as possible.

60+ -- 3. shutdown vty.

61+ --

62+ -- todo: provide a similar abstraction to Graphics.Vty.Terminal for input. Use haskeline's

63+ -- input backend for implementation.

6564 --

66− -- This version currently supports the same interface.

65+ -- todo: remove explicit `shutdown` requirement.

6766 , terminal :: TerminalHandle

68− -- | Refresh the display. Normally the library takes care of refreshing.

69− -- Nonetheless, some other program might output to the terminal and mess the display.

70− -- In that case the user might want to force a refresh.

67+ -- | Refresh the display. Normally the library takes care of refreshing. Nonetheless, some

68+ -- other program might output to the terminal and mess the display. In that case the user

69+ -- might want to force a refresh.

7170 , refresh :: IO ()

7271 -- | Clean up after vty.

7372 , shutdown :: IO ()

@@ -80,7 +79,7 @@ mkVty = mkVtyEscDelay 0

8079

8180mkVtyEscDelay :: Int -> IO Vty

8281mkVtyEscDelay escDelay = do

83− term_info <- setupTermFromEnv

82+ term_info <- Terminfo.setupTermFromEnv

8483 t <- terminal_handle

8584 reserve_display t

8685 (kvar, endi) <- initTermInput escDelay term_info

@@ -112,7 +111,8 @@ intMkVty kvar fend t = do

112111 writeIORef last_pic_ref $ Just in_pic

113112

114113 let inner_refresh

115− = readIORef last_pic_ref

114+ = writeIORef last_update_ref Nothing

115+ >> readIORef last_pic_ref

116116 >>= maybe ( return () ) ( \pic -> inner_update pic )

117117

118118 let gkey = do k <- kvar

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

@@ -6,7 +6,6 @@ where

66

77import Graphics.Vty.Attributes

88import Graphics.Vty.Image

9−import Graphics.Vty.Image.Debug

109import Graphics.Vty.Picture

1110import Graphics.Vty.Span

1211import Graphics.Vty.DisplayRegion

@@ -21,7 +20,7 @@ instance Show SpanOpSequence where

2120

2221instance Show SpanOp where

2322 show (AttributeChange attr) = show attr

24− show (TextSpan width _) = "TextSpan " ++ show width

23+ show (TextSpan ow cw _) = "TextSpan " ++ show ow ++ " " ++ show cw

2524

2625row_ops_effected_columns :: SpanOpSequence -> [Word]

2726row_ops_effected_columns spans

src/Graphics/Vty/Image.hs+7−15

@@ -10,8 +10,6 @@ module Graphics.Vty.Image ( Image(..)

1010 , (<->)

1111 , horiz_cat

1212 , vert_cat

13− , horzcat

14− , vertcat

1513 , background_fill

1614 , char

1715 , string

@@ -72,8 +70,8 @@ data Image =

7270 , char_width :: !Word -- >= 1

7371 }

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

75− -- required to be between two images of equal height. The horiz_join constructor adds blanks to

76− -- the provided images that assure this is true for the HorizJoin value produced.

73+ -- required to be between two images of equal height. The horiz_join constructor adds background

74+ -- filles to the provided images that assure this is true for the HorizJoin value produced.

7775 | HorizJoin

7876 { part_left :: Image

7977 , part_right :: Image

@@ -81,8 +79,8 @@ data Image =

8179 , output_height :: !Word -- >= 1

8280 }

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

84− -- required to be between two images of equal width. The horiz_join constructor adds blanks to

85− -- the provides images that assure this is true for the HorizJoin value produced.

82+ -- required to be between two images of equal width. The vert_join constructor adds background

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

8684 | VertJoin

8785 { part_top :: Image

8886 , part_bottom :: Image

@@ -125,7 +123,7 @@ instance Monoid Image where

125123horiz_text :: Attr -> StringSeq -> Word -> Image

126124horiz_text a txt ow

127125 | ow == 0 = EmptyImage

128− | otherwise = HorizText a txt (toEnum $ Seq.length txt) ow

126+ | otherwise = HorizText a txt ow (toEnum $ Seq.length txt)

129127

130128horiz_join :: Image -> Image -> Word -> Word -> Image

131129horiz_join i_0 i_1 w h

@@ -264,16 +262,10 @@ im_t <-> im_b

264262horiz_cat :: [Image] -> Image

265263horiz_cat = foldr (<|>) EmptyImage

266264

267−horzcat :: [Image] -> Image

268−horzcat = horiz_cat

269−

270265-- | Compose any number of images vertically.

271266vert_cat :: [Image] -> Image

272267vert_cat = foldr (<->) EmptyImage

273268

274−vertcat :: [Image] -> Image

275−vertcat = vert_cat

276−

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

278270-- the ISO-10646 encoding.

279271char :: Attr -> Char -> Image

@@ -307,12 +299,12 @@ utf8_string !a !str = string a ( decode str )

307299

308300safe_wcwidth :: Char -> Word

309301safe_wcwidth c = case wcwidth c of

310− i | i < 0 -> error "negative wcwidth"

302+ i | i < 0 -> 0 -- error "negative wcwidth"

311303 | otherwise -> toEnum i

312304

313305safe_wcswidth :: String -> Word

314306safe_wcswidth str = case wcswidth str of

315− i | i < 0 -> error "negative wcswidth"

307+ i | i < 0 -> 0 -- error "negative wcswidth"

316308 | otherwise -> toEnum i

317309

318310-- | Renders a UTF-8 encoded bytestring.

src/Graphics/Vty/LLInput.hs+42−13

@@ -35,7 +35,7 @@ import System.Posix.IO ( stdInput

3535 )

3636

3737-- |Representations of non-modifier keys.

4040 | KLeft | KDown | KRight | KEnter

4141 deriving (Eq,Show,Ord)

@@ -67,7 +67,7 @@ initTermInput escDelay terminal = do

6767 hadInput <- newEmptyMVar

6868 oattr <- getTerminalAttributes stdInput

6969 let nattr = foldl withoutMode oattr [StartStopOutput, KeyboardInterrupts,

70− EnableEcho, ProcessInput]

70+ EnableEcho, ProcessInput, ExtendedFunctions]

7171 setTerminalAttributes stdInput nattr Immediately

7272 set_term_timing

7373 let inputToEventThread :: IO ()

@@ -88,7 +88,7 @@ initTermInput escDelay terminal = do

8888 setFdOption stdInput NonBlockingRead False

8989 threadWaitRead stdInput

9090 setFdOption stdInput NonBlockingRead True

91− try readAll

91+ try readAll :: IO (Either IOException ())

9292 when (escDelay == 0) finishAtomicInput

9393 loop

9494 readAll = do

@@ -141,32 +141,60 @@ initTermInput escDelay terminal = do

141141

142142 caps_tabls = [("khome", (KHome, [])),

143143 ("kend", (KEnd, [])),

144−

145− ("kcud1", (KDown, [])),

146− ("kcuu1", (KUp, [])),

147− ("kcuf1", (KRight, [])),

148− ("kcub1", (KLeft, []))

144+ ("cbt", (KBackTab, [])),

145+ ("kcud1", (KDown, [])),

146+ ("kcuu1", (KUp, [])),

147+ ("kcuf1", (KRight, [])),

148+ ("kcub1", (KLeft, [])),

149+

150+ ("kLFT", (KLeft, [MShift])),

151+ ("kRIT", (KRight, [MShift]))

149152 ]

150153

151154 caps_classify_table = [(x,y) | (Just x,y) <- map (first (getCapability terminal . tiGetStr)) $ caps_tabls]

152155

153156 ansi_classify_table :: [[([Char], (Key, [Modifier]))]]

154157 ansi_classify_table =

155− [ let k c s = ("\ESC["++c,(s,[])) in

156− [ k "G" KNP5, k "P" KPause ],

158+ [ let k c s = ("\ESC["++c,(s,[])) in [ k "G" KNP5, k "P" KPause, k "A" KUp, k "B" KDown, k "C" KRight, k "D" KLeft ],

159+

160+ -- Support for arrows

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

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

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

164+ ([MShift, MCtrl],6), ([MShift, MMeta],4)], -- modifiers and their codes

165+ (c,s) <- [("A", KUp), ("B", KDown), ("C", KRight), ("D", KLeft)] -- directions and their codes

166+ ],

167+

157168 let k n s = ("\ESC["++show n++"~",(s,[])) in zipWith k [2::Int,3,5,6] [KIns,KDel,KPageUp,KPageDown],

169+

170+ -- Support for simple characters.

158171 [ (x:[],(KASCII x,[])) | x <- map toEnum [0..255] ],

172+

173+ -- Support for function keys (should use terminfo)

159174 [ ("\ESC[["++[toEnum(64+i)],(KFun i,[])) | i <- [1..5] ],

160175 let f ff nrs m = [ ("\ESC["++show n++"~",(KFun (n-(nrs!!0)+ff), m)) | n <- nrs ] in

161176 concat [ f 6 [17..21] [], f 11 [23,24] [], f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ],

162177 [ ('\ESC':[x],(KASCII x,[MMeta])) | x <- '\ESC':'\t':[' ' .. '\DEL'] ],

178+

179+ -- Ctrl+Char

163180 [ ([toEnum x],(KASCII y,[MCtrl]))

164181 | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_']),

165182 y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.

166183 ],

184+

185+ -- Ctrl+Meta+Char

167186 [ ('\ESC':[toEnum x],(KASCII y,[MMeta,MCtrl])) | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_']) ],

168− [ ("\ESC",(KEsc,[])) , ("\ESC\ESC",(KEsc,[MMeta])) , ("\DEL",(KBS,[])), ("\ESC\DEL",(KBS,[MMeta])),

169− ("\ESC\^J",(KEnter,[MMeta])), ("\^J",(KEnter,[])) ] ]

187+

188+ -- Special support

189+ [ -- special support for ESC

190+ ("\ESC",(KEsc,[])) , ("\ESC\ESC",(KEsc,[MMeta])),

191+

192+ -- Special support for backspace

193+ ("\DEL",(KBS,[])), ("\ESC\DEL",(KBS,[MMeta])),

194+

195+ -- Special support for Enter

196+ ("\ESC\^J",(KEnter,[MMeta])), ("\^J",(KEnter,[])) ]

197+ ]

170198

171199 eventThreadId <- forkIO $ inputToEventThread

172200 inputThreadId <- forkIO $ inputThread

@@ -184,9 +212,10 @@ initTermInput escDelay terminal = do

184212 setTerminalAttributes stdInput oattr Immediately

185213 return (readChan eventChannel, uninit)

186214

215+first :: (a -> b) -> (a,c) -> (b,c)

187216first f (x,y) = (f x, y)

188217

189−

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

190219utf8Length c

191220 | c < 0x80 = 1

192221 | c < 0xE0 = 2

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

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

22module Graphics.Vty.Picture ( module Graphics.Vty.Picture

3+ , Image

34 , image_width

45 , image_height

56 , (<|>)

67 , (<->)

78 , horiz_cat

89 , vert_cat

9− , horzcat

10− , vertcat

1110 , background_fill

1211 , char

1312 , string

src/Graphics/Vty/Span.hs−23

@@ -221,26 +221,3 @@ snoc_op !mrow_ops !row !op = do

221221 writeSTArray mrow_ops row ops'

222222 return ()

223223

224−data StateTransition =

225− NextSpan BuildState

226− | NextRow BuildState

227− deriving Show

228−

229−data BuildState = BuildState

230− { current_column :: !Word

231− , current_row_build_ops :: [BuildOp]

232− , next_row_build_ops :: [BuildOp]

233− }

234− deriving Show

235−

236−-- A build op is a (column, row) offset into an image and the image.

237−data BuildOp = BuildOp !Word !Word Image

238− deriving Show

239−

240−initial_state :: Image -> BuildState

241−initial_state i = BuildState 0 [BuildOp 0 0 i] []

242−

243−-- The first op for each row is to the set the current attribute. Which will either be

244−-- 0. the background attribute if the span starts out with the background or is undefined.

245−-- 1. the attributes of the first text row.

246−

src/Graphics/Vty/Terminal.hs−1

@@ -13,7 +13,6 @@

1313--

1414--

1515{-# LANGUAGE ScopedTypeVariables #-}

16−{-# LANGUAGE GADTs #-}

1716module Graphics.Vty.Terminal ( module Graphics.Vty.Terminal

1817 , Terminal(..)

1918 , TerminalHandle(..)

src/Graphics/Vty/Terminal/Debug.hs+2−2

@@ -103,10 +103,10 @@ instance DisplayTerminal DebugDisplay where

103103 return $ ptr `plusPtr` 1

104104

105105 -- | An attr change is always visualized as the single character 'A'

106− attr_required_bytes _d _fattr _attr = 1

106+ attr_required_bytes _d _fattr _diffs _attr = 1

107107

108108 -- | An attr change is always visualized as the single character 'A'

109− serialize_set_attr _d _fattr _attr ptr = do

109+ serialize_set_attr _d _fattr _diffs _attr ptr = do

110110 liftIO $ poke ptr (toEnum $ fromEnum 'A')

111111 return $ ptr `plusPtr` 1

112112

src/Graphics/Vty/Terminal/Generic.hs+1−1

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

12{-# LANGUAGE ScopedTypeVariables #-}

23{-# LANGUAGE Rank2Types #-}

34{-# LANGUAGE ExistentialQuantification #-}

55{-# LANGUAGE GADTs #-}

66{-# LANGUAGE FlexibleContexts #-}

77module Graphics.Vty.Terminal.Generic ( module Graphics.Vty.Terminal.Generic

src/Graphics/Vty/Terminal/MacOSX.hs+11−4

@@ -24,6 +24,7 @@ import System.IO

2424

2525data Term = Term

2626 { super_term :: TerminalHandle

27+ , term_app :: String

2728 }

2829

2930-- for Terminal.app use "xterm". For iTerm.app use "xterm-256color"

@@ -32,7 +33,7 @@ terminal_instance v = do

3233 let base_term "iTerm.app" = "xterm-256color"

3334 base_term _ = "xterm"

3435 t <- TerminfoBased.terminal_instance (base_term v) >>= new_terminal_handle

35− return $ Term t

36+ return $ Term t v

3637

3738flushed_put :: MonadIO m => String -> m ()

3839flushed_put str = do

@@ -40,19 +41,25 @@ flushed_put str = do

4041 liftIO $ hFlush stdout

4142

4243-- Terminal.app really does want the xterm-color smcup and rmcup caps. Not the generic xterm ones.

44+smcup_str, rmcup_str :: String

4345smcup_str = "\ESC7\ESC[?47h"

4446rmcup_str = "\ESC[2J\ESC[?47l\ESC8"

4547

48+-- iTerm needs a clear screen after smcup as well?

49+clear_screen_str :: String

50+clear_screen_str = "\ESC[H\ESC[2J"

51+

4652instance Terminal Term where

47− terminal_ID t = "Terminal.app :: MacOSX"

53+ terminal_ID t = term_app t ++ " :: MacOSX"

4854

4955 release_terminal t = do

5056 release_terminal $ super_term t

5157

52− reserve_display t = do

58+ reserve_display _t = do

5359 flushed_put smcup_str

60+ flushed_put clear_screen_str

5461

55− release_display t = do

62+ release_display _t = do

5663 flushed_put rmcup_str

5764

5865 display_terminal_instance t b c = do

src/Graphics/Vty/Terminal/TerminfoBased.hs+44−79

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

22{-# LANGUAGE ForeignFunctionInterface #-}

33{-# LANGUAGE ScopedTypeVariables #-}

4−{-# LANGUAGE MagicHash #-}

54{-# LANGUAGE FlexibleInstances #-}

6−{-# LANGUAGE TypeFamilies #-}

75module Graphics.Vty.Terminal.TerminfoBased ( terminal_instance

86 )

97 where

@@ -21,8 +19,7 @@ import Control.Monad ( foldM )

2119import Control.Monad.Trans

2220

2321import Data.Bits ( (.&.) )

24−import Data.Maybe ( fromJust )

25−import Data.Monoid

22+import Data.Maybe ( isJust, isNothing, fromJust )

2623import Data.Word

2724

2825import Foreign.C.Types ( CLong )

@@ -124,7 +121,9 @@ current_display_attr_caps ti

124121instance Terminal Term where

125122 terminal_ID t = term_info_ID t ++ " :: TerminfoBased"

126123

127− release_terminal _t = do

124+ release_terminal t = do

125+ marshall_cap_to_terminal t set_default_attr []

126+ marshall_cap_to_terminal t cnorm []

128127 return ()

129128

130129 reserve_display t = do

@@ -132,6 +131,8 @@ instance Terminal Term where

132131 then marshall_cap_to_terminal t (fromJust . smcup) []

133132 else return ()

134133 -- Screen on OS X does not appear to support smcup?

134+ -- To approximate the expected behavior: clear the screen and then move the mouse to the

135+ -- home position.

135136 marshall_cap_to_terminal t clear_screen []

136137 return ()

137138

@@ -319,30 +320,12 @@ ansi_color_index (Color240 v) = 16 + ( toEnum $ fromEnum v )

319320 - 4. If the display attribute state is being set then just update the arguments to that for any

320321 - apply/remove.

321322 -

322− - The style diffs each imply either the enter/exit control code or a reset to defaults ; set state

323− - sequence. This mapping satisfies the communitive monoid properties:

324− - - no diff * diff == diff

325− - - diff * no diff == diff

326− - - (diff_0 * diff_1) * diff_2 == diff_0 * ( diff_1 * diff_2 )

327− - - diff_0 * diff_1 == diff_1 * diff_0

328− - so the mapping is a sequence of mappend's applied to mempty. Where the monoid points appended

329− - depend on the diff. The accumulated value is the monad point that represents the final sequence

330− - to apply. The application (*) operator assures all the rules are followed.

331− -

332− - The diff implies an enter/exit control code if:

333− - - The current

334323 -}

335324

336−data DisplayAttrSeq v

337− = EnterExitSeq [v]

325+data DisplayAttrSeq

326+ = EnterExitSeq [CapExpression]

338327 | SetState DisplayAttrState

339328

340−instance Monoid (DisplayAttrSeq v) where

341− mempty = EnterExitSeq []

342− SetState s `mappend` _ = SetState s

343− _ `mappend` SetState s = SetState s

344− (EnterExitSeq caps_0) `mappend` (EnterExitSeq caps_1) = EnterExitSeq (caps_0 `mappend` caps_1)

345−

346329data DisplayAttrState = DisplayAttrState

347330 { apply_standout :: Bool

348331 , apply_underline :: Bool

@@ -365,59 +348,41 @@ sgr_args_for_state attr_state = map (\b -> if b then 1 else 0)

365348 , False -- alt char set

366349 ]

367350

368−req_display_cap_seq_for :: DisplayAttrCaps -> Style -> [StyleStateChange] -> DisplayAttrSeq CapExpression

369−req_display_cap_seq_for caps s diffs =

370− -- First pass: concat the monoid points that are implied by the diffs

371− let base = mconcat $ map diff_point diffs

372− -- Second pass: Apply the capability restrictions.

373− in apply_caps base

374− where

375− set_state = SetState $ state_for_style s

376− diff_point ApplyStandout = EnterExitSeq [ApplyStandout]

377− diff_point ApplyUnderline = EnterExitSeq [ApplyUnderline]

378− diff_point ApplyReverseVideo = EnterExitSeq [ApplyReverseVideo]

379− diff_point ApplyBlink = set_state

380− diff_point ApplyDim = EnterExitSeq [ApplyDim]

381− diff_point ApplyBold = EnterExitSeq [ApplyBold]

382− diff_point RemoveStandout = EnterExitSeq [RemoveStandout]

383− diff_point RemoveUnderline = EnterExitSeq [RemoveUnderline]

384− diff_point RemoveReverseVideo = set_state

385− diff_point RemoveBlink = set_state

386− diff_point RemoveDim = set_state

387− diff_point RemoveBold = set_state

388− apply_caps ( SetState _ )

389− = case set_attr_states caps of

390− Nothing -> EnterExitSeq []

391− Just _ -> set_state

392− apply_caps (EnterExitSeq [])

393− = EnterExitSeq []

394− apply_caps (EnterExitSeq (diff : diffs'))

395− = case apply_caps' diff of

396− SetState _ -> set_state

397− p -> p `mappend` apply_caps (EnterExitSeq diffs')

398− apply_caps' ApplyStandout = m $ enter_standout caps

399− apply_caps' ApplyUnderline = m $ enter_underline caps

400− apply_caps' ApplyReverseVideo = m $ enter_reverse_video caps

401− apply_caps' ApplyBlink = set_state

402− apply_caps' ApplyDim = m $ enter_dim_mode caps

403− apply_caps' ApplyBold = m $ enter_bold_mode caps

404− apply_caps' RemoveStandout = m $ exit_standout caps

405− apply_caps' RemoveUnderline = m $ exit_underline caps

406− apply_caps' RemoveReverseVideo = set_state

407− apply_caps' RemoveBlink = set_state

408− apply_caps' RemoveDim = set_state

409− apply_caps' RemoveBold = set_state

410− m = maybe set_state (EnterExitSeq . return)

411−

412−{-

413−set_style_required_bytes caps style diffs reset_cap =

414− let state = state_for_style style

415− req_seq = req_seq_for caps style diffs

416− in case req_seq of

417− EnterExitSeq caps -> sum $ map (\cap -> cap_expression_required_bytes cap []) caps

418− SetState -> cap_expression_required_bytes ( fromJust $ set_attr_states $ caps )

419− ( sgr_args_for_state state )

420−-}

351+req_display_cap_seq_for :: DisplayAttrCaps -> Style -> [StyleStateChange] -> DisplayAttrSeq

352+req_display_cap_seq_for caps s diffs

353+ -- if the state transition implied by any diff cannot be supported with an enter/exit mode cap

354+ -- then either the state needs to be set or the attribute change ignored.

355+ = case (any no_enter_exit_cap diffs, isJust $ set_attr_states caps) of

356+ -- If all the diffs have an enter-exit cap then just use those

357+ ( False, _ ) -> EnterExitSeq $ map enter_exit_cap diffs

358+ -- If not all the diffs have an enter-exit cap and there is no set state cap then filter out

359+ -- all unsupported diffs and just apply the rest

360+ ( True, False ) -> EnterExitSeq $ map enter_exit_cap

361+ $ filter (not . no_enter_exit_cap) diffs

362+ -- if not all the diffs have an enter-exit can and there is a set state cap then just use

363+ -- the set state cap.

364+ ( True, True ) -> SetState $ state_for_style s

365+ where

366+ no_enter_exit_cap ApplyStandout = isNothing $ enter_standout caps

367+ no_enter_exit_cap RemoveStandout = isNothing $ exit_standout caps

368+ no_enter_exit_cap ApplyUnderline = isNothing $ enter_underline caps

369+ no_enter_exit_cap RemoveUnderline = isNothing $ exit_underline caps

370+ no_enter_exit_cap ApplyReverseVideo = isNothing $ enter_reverse_video caps

371+ no_enter_exit_cap RemoveReverseVideo = True

372+ no_enter_exit_cap ApplyBlink = True

373+ no_enter_exit_cap RemoveBlink = True

374+ no_enter_exit_cap ApplyDim = isNothing $ enter_dim_mode caps

375+ no_enter_exit_cap RemoveDim = True

376+ no_enter_exit_cap ApplyBold = isNothing $ enter_bold_mode caps

377+ no_enter_exit_cap RemoveBold = True

378+ enter_exit_cap ApplyStandout = fromJust $ enter_standout caps

379+ enter_exit_cap RemoveStandout = fromJust $ exit_standout caps

380+ enter_exit_cap ApplyUnderline = fromJust $ enter_underline caps

381+ enter_exit_cap RemoveUnderline = fromJust $ exit_underline caps

382+ enter_exit_cap ApplyReverseVideo = fromJust $ enter_reverse_video caps

383+ enter_exit_cap ApplyDim = fromJust $ enter_dim_mode caps

384+ enter_exit_cap ApplyBold = fromJust $ enter_bold_mode caps

385+ enter_exit_cap _ = error "enter_exit_cap applied to diff that was known not to have one."

421386

422387state_for_style :: Style -> DisplayAttrState

423388state_for_style s = DisplayAttrState

@@ -431,7 +396,7 @@ state_for_style s = DisplayAttrState

431396 where is_style_set = has_style s

432397

433398style_to_apply_seq :: Style -> [StyleStateChange]

434−style_to_apply_seq s = mconcat

399+style_to_apply_seq s = concat

435400 [ apply_if_required ApplyStandout standout

436401 , apply_if_required ApplyUnderline underline

437402 , apply_if_required ApplyReverseVideo reverse_video

test/Makefile+2

@@ -23,6 +23,8 @@ yi_issue_264 \

2323vty_issue_18 \

2424$(VERIF_TESTS)

2525

26+$(shell mkdir -p objects )

27+

2628# TODO: Tests should also be buildable referencing the currently installed vty

2729GHC_ARGS=--make -i../src -package parallel-1.1.0.1 -hide-package transformers -hide-package monads-fd -hide-package monads-tf -package QuickCheck-2.1.0.2 -ignore-package vty ../cbits/gwinsz.c ../cbits/set_term_timing.c ../cbits/mk_wcwidth.c -O -funbox-strict-fields -Wall -threaded -fno-full-laziness -fspec-constr -odir objects -hidir objects

2830

test/Test2.hs+1

@@ -6,6 +6,7 @@ main = do

66 (sx,sy) <- getSize vty

77 update vty (pic { pImage = renderFill (setBG red attr) 'X' sx sy })

88 refresh vty

9+ getEvent vty

910 shutdown vty

1011 putStrLn "Done!"

1112 return ()

test/Verify.hs+4−2

@@ -51,8 +51,10 @@ run_test t = do

5151 results <- readIORef $ results_ref s'

5252 let fail_results = [ fail_result | fail_result@(QC.Failure {}) <- results ]

5353 case fail_results of

54− [] -> putStrLn "PASS"

55− _ -> putStrLn "FAIL"

54+ [] -> putStrLn "state: PASS"

55+ rs -> do

56+ putStrLn "state: FAIL"

57+ putStrLn $ "fail_count: " ++ show (length rs)

5658

5759verify :: Testable prop => String -> prop -> Test QC.Result

5860verify prop_name prop = do

test/Verify/Graphics/Vty/DisplayRegion.hs+2−2

@@ -21,7 +21,7 @@ instance Show EmptyWindow where

2121

2222instance Arbitrary DebugWindow where

2323 arbitrary = do

24− w <- arbitrary

25− h <- arbitrary

24+ w <- suchThat arbitrary (/= 0)

25+ h <- suchThat arbitrary (/= 0)

2626 return $ DebugWindow w h

2727

test/Verify/Graphics/Vty/Image.hs+24−2

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

1+{-# LANGUAGE NamedFieldPuns #-}

2+{-# LANGUAGE DisambiguateRecordFields #-}

13module Verify.Graphics.Vty.Image ( module Verify.Graphics.Vty.Image

24 , module Graphics.Vty.Image

35 )

@@ -33,7 +35,12 @@ instance Arbitrary DefaultImage where

3335 i <- return $ char def_attr 'X' -- elements forward_image_ops >>= return . (\op -> op empty_image)

3436 return $ DefaultImage i []

3537

36−data SingleRowSingleAttrImage = SingleRowSingleAttrImage Attr Word Image

38+data SingleRowSingleAttrImage

39+ = SingleRowSingleAttrImage

40+ { expected_attr :: Attr

41+ , expected_columns :: Word

42+ , row_image :: Image

43+ }

3744

3845instance Show SingleRowSingleAttrImage where

3946 show (SingleRowSingleAttrImage attr columns image)

@@ -41,13 +48,28 @@ instance Show SingleRowSingleAttrImage where

4148

4249instance Arbitrary SingleRowSingleAttrImage where

4350 arbitrary = do

44− single_column_row_text <- arbitrary

51+ -- The text must contain at least one character. Otherwise the image simplifies to the

52+ -- IdImage which has a height of 0. If this is to represent a single row then the height

53+ -- must be 1

54+ single_column_row_text <- listOf1 arbitrary

4555 attr <- arbitrary

4656 return $ SingleRowSingleAttrImage

4757 attr

4858 ( fromIntegral $ length single_column_row_text )

4959 ( horiz_cat $ [ char attr c | SingleColumnChar c <- single_column_row_text ] )

5060

61+data SingleRowTwoAttrImage

62+ = SingleRowTwoAttrImage

63+ { part_0 :: SingleRowSingleAttrImage

64+ , part_1 :: SingleRowSingleAttrImage

65+ , join_image :: Image

66+ } deriving Show

67+

68+instance Arbitrary SingleRowTwoAttrImage where

69+ arbitrary = do

70+ p0 <- arbitrary

71+ p1 <- arbitrary

72+ return $ SingleRowTwoAttrImage p0 p1 (row_image p0 <|> row_image p1)

5173

5274data SingleAttrSingleSpanStack = SingleAttrSingleSpanStack

5375 { stack_image :: Image

test/interactive_terminal_test.hs+45−30

@@ -32,7 +32,7 @@ print_intro = do

3232 putStr $ [$heredoc|

3333This is an interactive verification program for the terminal input and output

3434support of the VTY library. This will ask a series of questions about what you

35−see onscreen. The goal is to verify that VTY's output and input support

35+see on screen. The goal is to verify that VTY's output and input support

3636performs as expected with your terminal.

3737

3838This program produces a file named

@@ -43,7 +43,7 @@ support for your terminal. No personal information is contained in the report.

4343

4444Each test follows, more or less, the following format:

4545 0. A description of the test is printed which will include a detailed

46− description of what VTY is going to try and what the expected results are.

46+ description of what VTY is going to try and what the expected results are.

4747 Press return to move on.

4848 1. The program will produce some output or ask for you to press a key.

4949 2. You will then be asked to confirm if the behavior matched the provided

@@ -62,15 +62,24 @@ All the tests assume the following about the terminal display:

6262 a good range of the unicode characters. Each test involving unicode display

6363 describes the expected appearance of each glyph.

6464

65−Thanks for the help! :-D

65+Thanks for the help! :-D

66+To exit the test early enter "q" anytime at the following menu screen. Even if

67+you exit the test early please email the test_results.list file to

68+coreyoconnor@gmail.com. The results file will still contain information useful

69+to debug terminal support.

70+

6671|]

6772 wait_for_return

6873 results <- do_test_menu 1

6974 env_attributes <- mapM ( \env_name -> catch ( Env.getEnv env_name >>= return . (,) env_name )

7075 ( const $ return (env_name, "") )

7176 )

72− [ "TERM", "COLORTERM", "LANG" ]

73− let results_txt = show env_attributes ++ "\n" ++ show results ++ "\n"

77+ [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]

78+ t <- terminal_handle

79+ let results_txt = show env_attributes ++ "\n"

80+ ++ terminal_ID t ++ "\n"

81+ ++ show results ++ "\n"

82+ release_terminal t

7483 writeFile output_file_path results_txt

7584

7685wait_for_return = do

@@ -179,11 +188,11 @@ reserve_output_test = Test

179188 , print_summary = do

180189 putStr $ [$heredoc|

181190Once return is pressed:

182−The screen will be cleared.

183−The cursor should be visible and at the top left corner.

184−Four lines of text should be visible.

191+ 0. The screen will be cleared.

192+ 1. Four lines of text should be visible.

193+ 1. The cursor should be visible and at the start of the fifth line.

185194

186−After enter is pressed for the second time this test then:

195+After return is pressed for the second time this test then:

187196 * The screen containing the test summary should be restored;

188197 * The cursor is visible.

189198|]

@@ -377,6 +386,7 @@ unicode_single_width_0 = Test

377386 , test_action = do

378387 t <- terminal_handle

379388 reserve_display t

389+ hide_cursor t

380390 withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout)

381391 hPutStr stdout "\n"

382392 hPutStr stdout "0123456789\n"

@@ -458,6 +468,7 @@ unicode_double_width_0 = Test

458468 , test_action = do

459469 t <- terminal_handle

460470 reserve_display t

471+ hide_cursor t

461472 withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout)

462473 hPutStr stdout "\n"

463474 hPutStr stdout "012345\n"

@@ -517,8 +528,12 @@ After return is pressed for the second time:

517528 1. The cursor should be visible.

518529|]

519530

520−all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white, def ]

521− [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white", "default" ]

531+all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]

532+ [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]

533+

534+all_bright_colors

535+ = zip [ bright_black, bright_red, bright_green, bright_yellow, bright_blue, bright_magenta, bright_cyan, bright_white ]

536+ [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]

522537

523538attributes_test_0 = Test

524539 { test_name = "Character attributes: foreground colors."

@@ -531,7 +546,7 @@ attributes_test_0 = Test

531546 column_0 = vert_cat $ map line_with_color all_colors

532547 border = vert_cat $ replicate (length all_colors) $ string def_attr " | "

533548 column_1 = vert_cat $ map (string def_attr . snd) all_colors

534− line_with_color (c_value, c_name) = string (setFG c_value def_attr) c_name

549+ line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name

535550 d <- display_bounds t >>= display_context t

536551 output_picture d pic

537552 getLine

@@ -577,7 +592,7 @@ attributes_test_1 = Test

577592 column_0 = vert_cat $ map line_with_color all_colors

578593 border = vert_cat $ replicate (length all_colors) $ string def_attr " | "

579594 column_1 = vert_cat $ map (string def_attr . snd) all_colors

580− line_with_color (c_value, c_name) = string (setBG c_value def_attr) c_name

595+ line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name

581596 d <- display_bounds t >>= display_context t

582597 output_picture d pic

583598 getLine

@@ -592,7 +607,7 @@ Once return is pressed:

592607 2. 9 lines of text in two columns will be drawn. The first column will

593608 contain be a name of a standard color for an 8 color terminal rendered with

594609 the default foreground color with a background the named color. For

595− instance, one line will contain be the word "magenta" and that words should

610+ instance, one line will contain be the word "magenta" and the word should

596611 be rendered in the default foreground color over a magenta background. The

597612 second column will be the name of a standard color rendered with the default

598613 attributes.

@@ -631,10 +646,10 @@ attributes_test_2 = Test

631646 image = horiz_cat [border, column_0, border, column_1, border, column_2, border]

632647 border = vert_cat $ replicate (length all_colors) $ string def_attr " | "

633648 column_0 = vert_cat $ map line_with_color_0 all_colors

634− column_1 = vert_cat $ map line_with_color_1 all_colors

649+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors

635650 column_2 = vert_cat $ map (string def_attr . snd) all_colors

636− line_with_color_0 (c_value, c_name) = string (setFG c_value def_attr) c_name

637− line_with_color_1 (c_value, c_name) = string (setFGVivid c_value def_attr) c_name

651+ line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name

652+ line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name

638653 d <- display_bounds t >>= display_context t

639654 output_picture d pic

640655 getLine

@@ -681,7 +696,7 @@ Did the test output match the description?

681696 }

682697

683698attributes_test_3 = Test

684− { test_name = "Character attributes: vivid background colors."

699+ { test_name = "Character attributes: Vivid background colors."

685700 , test_ID = "attributes_test_3"

686701 , test_action = do

687702 t <- terminal_handle

@@ -690,10 +705,10 @@ attributes_test_3 = Test

690705 image = horiz_cat [border, column_0, border, column_1, border, column_2, border]

691706 border = vert_cat $ replicate (length all_colors) $ string def_attr " | "

692707 column_0 = vert_cat $ map line_with_color_0 all_colors

693− column_1 = vert_cat $ map line_with_color_1 all_colors

708+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors

694709 column_2 = vert_cat $ map (string def_attr . snd) all_colors

695− line_with_color_0 (c_value, c_name) = string (setBG c_value def_attr) c_name

696− line_with_color_1 (c_value, c_name) = string (setBGVivid c_value def_attr) c_name

710+ line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name

711+ line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name

697712 d <- display_bounds t >>= display_context t

698713 output_picture d pic

699714 getLine

@@ -715,7 +730,7 @@ Once return is pressed:

715730 c. The third column will be the name of a standard color rendered with

716731 the default attributes.

717732

718−For instance, one line will contain be the word "magenta" and that words should

733+For instance, one line will contain be the word "magenta" and the word should

719734be rendered in the default foreground color over a magenta background.

720735

721736I'm not actually sure exactly what "vivid" means in this context. For xterm the

@@ -748,14 +763,14 @@ Did the test output match the description?

748763 }

749764

750765attr_combos =

751− [ ("default", id)

752− , ("bold", setBold)

753− , ("blink", setBlink)

754− , ("underline", setUnderline)

755− , ("bold + blink", setBlink . setBold)

756− , ("bold + underline", setUnderline . setBold)

757− , ("underline + blink", setBlink . setUnderline)

758− , ("bold + blink + underline", setUnderline . setBlink . setBold)

766+ [ ( "default", id )

767+ , ( "bold", flip with_style bold )

768+ , ( "blink", flip with_style blink )

769+ , ( "underline", flip with_style underline )

770+ , ( "bold + blink", flip with_style (bold + blink) )

771+ , ( "bold + underline", flip with_style (bold + underline) )

772+ , ( "underline + blink", flip with_style (underline + blink) )

773+ , ( "bold + blink + underline", flip with_style (bold + blink + underline) )

759774 ]

760775

761776attributes_test_4 = Test

test/make_tests.shdeleted−31

@@ -1,31 +0,0 @@

1−#!/bin/bash

2−set -e

3−GHC_ARGS='--make -i../src -ignore-package vty ../cbits/gwinsz.c ../cbits/set_term_timing.c -funbox-strict-fields -Wall -threaded -fno-full-laziness -fspec-constr'

4−

5−rm -f Bench.o Bench.hi Bench

6−ghc $GHC_ARGS '-prof' '-auto-all' Bench.hs

7−

8−rm -f Bench2.o Bench2.hi Bench2

9−ghc $GHC_ARGS '-prof' '-auto-all' Bench2.hs

10−

11−rm -f BenchRenderChar.o BenchRenderChar.hi BenchRenderChar

12−ghc $GHC_ARGS '-prof' '-auto-all' BenchRenderChar

13−

14−rm -f Test.o Test.hi Test

15−ghc $GHC_ARGS Test

16−

17−rm -f Test2.o Test2.hi Test2

18−ghc $GHC_ARGS Test2

19−

20−rm -f BenchmarkImageOps.hi BenchmarkImageOps.o BenchmarkImageOps

21−ghc $GHC_ARGS BenchmarkImageOps

22−

23−rm -f ControlTable.hi ControlTable.o ControlTable

24−ghc $GHC_ARGS ControlTable

25−

26−rm -f yi_issue_264.hi yi_issue_264.o yi_issue_264

27−ghc $GHC_ARGS yi_issue_264

28−

29−rm -f vty_issue_18.hi vty_issue_18.o vty_issue_18

30−ghc $GHC_ARGS vty_issue_18

31−

test/verify_image_ops.hs+68−1

@@ -1,9 +1,12 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

12module Main where

23import Graphics.Vty.Attributes

3−import Graphics.Vty.Image

4+import Verify.Graphics.Vty.Image

45

56import Verify

67

8+import Data.Word

9+

710two_sw_horiz_concat :: SingleColumnChar -> SingleColumnChar -> Bool

811two_sw_horiz_concat (SingleColumnChar c1) (SingleColumnChar c2) =

912 image_width (char def_attr c1 <|> char def_attr c2) == 2

@@ -44,6 +47,64 @@ horiz_concat_dw_assoc (DoubleColumnChar c0) (DoubleColumnChar c1) (DoubleColumnC

4447 ==

4548 char def_attr c0 <|> (char def_attr c1 <|> char def_attr c2)

4649

50+vert_contat_single_row :: NonEmptyList SingleRowSingleAttrImage -> Bool

51+vert_contat_single_row (NonEmpty stack) =

52+ let expected_height :: Word = fromIntegral $ length stack

53+ stack_image = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack ]

54+ in image_height stack_image == expected_height

55+

56+disjoint_height_horiz_join :: NonEmptyList SingleRowSingleAttrImage

57+ -> NonEmptyList SingleRowSingleAttrImage

58+ -> Bool

59+disjoint_height_horiz_join (NonEmpty stack_0) (NonEmpty stack_1) =

60+ let expected_height :: Word = fromIntegral $ max (length stack_0) (length stack_1)

61+ stack_image_0 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ]

62+ stack_image_1 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ]

63+ in image_height (stack_image_0 <|> stack_image_1) == expected_height

64+

65+

66+disjoint_height_horiz_join_bg_fill :: NonEmptyList SingleRowSingleAttrImage

67+ -> NonEmptyList SingleRowSingleAttrImage

68+ -> Bool

69+disjoint_height_horiz_join_bg_fill (NonEmpty stack_0) (NonEmpty stack_1) =

70+ let stack_image_0 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ]

71+ stack_image_1 = vert_cat [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ]

72+ image = stack_image_0 <|> stack_image_1

73+ expected_height = image_height image

74+ in case image of

75+ HorizJoin {} -> ( expected_height == (image_height $ part_left image) )

76+ &&

77+ ( expected_height == (image_height $ part_right image) )

78+ _ -> True

79+

80+disjoint_width_vert_join :: NonEmptyList SingleRowSingleAttrImage

81+ -> NonEmptyList SingleRowSingleAttrImage

82+ -> Bool

83+disjoint_width_vert_join (NonEmpty stack_0) (NonEmpty stack_1) =

84+ let expected_width = maximum $ map image_width (stack_0_images ++ stack_1_images)

85+ stack_0_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ]

86+ stack_1_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ]

87+ stack_0_image = vert_cat stack_0_images

88+ stack_1_image = vert_cat stack_1_images

89+ image = stack_0_image <-> stack_1_image

90+ in image_width image == expected_width

91+

92+disjoint_width_vert_join_bg_fill :: NonEmptyList SingleRowSingleAttrImage

93+ -> NonEmptyList SingleRowSingleAttrImage

94+ -> Bool

95+disjoint_width_vert_join_bg_fill (NonEmpty stack_0) (NonEmpty stack_1) =

96+ let expected_width = maximum $ map image_width (stack_0_images ++ stack_1_images)

97+ stack_0_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_0 ]

98+ stack_1_images = [ i | SingleRowSingleAttrImage { row_image = i } <- stack_1 ]

99+ stack_0_image = vert_cat stack_0_images

100+ stack_1_image = vert_cat stack_1_images

101+ image = stack_0_image <-> stack_1_image

102+ in case image of

103+ VertJoin {} -> ( expected_width == (image_width $ part_top image) )

104+ &&

105+ ( expected_width == (image_width $ part_bottom image) )

106+ _ -> True

107+

47108main = run_test $ do

48109 verify "two_sw_horiz_concat" two_sw_horiz_concat

49110 verify "many_sw_horiz_concat" many_sw_horiz_concat

@@ -53,5 +114,11 @@ main = run_test $ do

53114 verify "two_dw_horiz_concat" two_dw_horiz_concat

54115 verify "two_dw_vert_concat" two_dw_vert_concat

55116 verify "horiz_concat_dw_assoc" horiz_concat_dw_assoc

117+ liftIO $ putStrLn $ replicate 80 '-'

118+ verify "single row vert concats to correct height" vert_contat_single_row

119+ verify "disjoint_height_horiz_join" disjoint_height_horiz_join

120+ verify "disjoint_height_horiz_join BG fill" disjoint_height_horiz_join_bg_fill

121+ verify "disjoint_width_vert_join" disjoint_width_vert_join

122+ verify "disjoint_width_vert_join BG fill" disjoint_width_vert_join_bg_fill

56123 return ()

57124

test/verify_image_trans.hs+7−6

@@ -9,20 +9,21 @@ import Verify

99import Data.Word

1010

1111is_horiz_text_of_columns :: Image -> Word -> Bool

12−is_horiz_text_of_columns (HorizText { columns = in_w }) expected_w = in_w == expected_w

13−is_horiz_text_of_columns (HorizBlank { columns = in_w }) expected_w = in_w == expected_w

12+is_horiz_text_of_columns (HorizText { output_width = in_w }) expected_w = in_w == expected_w

13+is_horiz_text_of_columns (BGFill { output_width = in_w }) expected_w = in_w == expected_w

1414is_horiz_text_of_columns _image _expected_w = False

1515

1616verify_horiz_contat_wo_attr_change_simplifies :: SingleRowSingleAttrImage -> Bool

1717verify_horiz_contat_wo_attr_change_simplifies (SingleRowSingleAttrImage _attr char_count image) =

1818 is_horiz_text_of_columns image char_count

1919

20−verify_horiz_contat_w_attr_change_simplifies :: SingleRowSingleAttrImage -> SingleRowSingleAttrImage -> Bool

21−verify_horiz_contat_w_attr_change_simplifies (SingleRowSingleAttrImage attr0 char_count0 image0)

22− (SingleRowSingleAttrImage attr1 char_count1 image1)

20+verify_horiz_contat_w_attr_change_simplifies :: SingleRowTwoAttrImage -> Bool

21+verify_horiz_contat_w_attr_change_simplifies ( SingleRowTwoAttrImage (SingleRowSingleAttrImage attr0 char_count0 image0)

22+ (SingleRowSingleAttrImage attr1 char_count1 image1)

23+ i

24+ )

2325 | char_count0 == 0 || char_count1 == 0 || attr0 == attr1 = is_horiz_text_of_columns i (char_count0 + char_count1)

2426 | otherwise = False == is_horiz_text_of_columns i (char_count0 + char_count1)

25− where i = image0 <|> image1

2627

2728main = run_test $ do

2829 verify "verify_horiz_contat_wo_attr_change_simplifies" verify_horiz_contat_wo_attr_change_simplifies

test/vty_inline_example.hsnew file+12

@@ -0,0 +1,12 @@

1+import Graphics.Vty

2+import Graphics.Vty.Inline

3+

4+main = do

5+ t <- terminal_handle

6+ putStr "Not styled. "

7+ put_attr_change t $ back_color red >> apply_style underline

8+ putStr " Styled! "

9+ put_attr_change t $ default_all

10+ putStrLn "Not styled."

11+ release_terminal t

12+ return ()

test/vty_issue_18.hs−7

@@ -23,13 +23,6 @@ play vty sx sy =

2323 getEvent vty

2424 shutdown vty

2525 return ()

26− {-

27− k <- getEvent vty

28− case k of

29− EvKey KEsc [] -> shutdown vty >> return ()

30− EvResize nx ny -> play vty nx ny

31− _ -> shutdown vty

32− -}

3326

3427box :: Int -> Int -> Image

3528box w h =

test/yi_issue_264.hsnew file+12

@@ -0,0 +1,12 @@

1+module Main where

2+import Graphics.Vty

3+import Control.Exception

4+

5+catchLog = handle (\except -> do putStrLn $ show (except :: IOException))

6+

7+main = do

8+ vty <- mkVty

9+ catchLog $ update vty pic { pImage = empty, pCursor = NoCursor }

10+ catchLog $ update vty pic { pImage = empty, pCursor = NoCursor }

11+ shutdown vty

12+

vty.cabal+6−2

@@ -4,6 +4,7 @@ License: BSD3

44License-file: LICENSE

55Author: Stefan O'Rear, Corey O'Connor

66Maintainer: Corey O'Connor (coreyoconnor@gmail.com)

7+Homepage: http://trac.haskell.org/vty/

78Category: User Interfaces

89Synopsis: A simple terminal access library

910Description:

@@ -20,11 +21,13 @@ Description:

2021 terminal;

2122 .

2223 You can 'darcs get' it from <http://code.haskell.org/vty/>

24+ .

26+ .

2528

26−Build-Depends: base >= 4 && < 5, bytestring, containers, unix, uvector

27−Build-Depends: terminfo >= 0.2 && < 0.3

29+Build-Depends: base >= 4 && < 5, bytestring, containers, unix

30+Build-Depends: terminfo >= 0.3 && < 0.4

2831Build-Depends: utf8-string >= 0.3 && < 0.4

2932Build-Depends: mtl >= 1.1.0.0 && < 1.2

3033Build-Depends: ghc-prim, parallel < 2

@@ -49,6 +52,7 @@ other-modules: Codec.Binary.UTF8.Width

4952 Graphics.Vty.Image

5053 Graphics.Vty.Span

5154 Graphics.Vty.Terminal.Generic

55+ Graphics.Vty.Terminal.MacOSX

5256 Graphics.Vty.Terminal.XTermColor

5357 Graphics.Vty.Terminal.TerminfoBased

5458