@@ -2,42 +2,41 @@
22{-# LANGUAGE ScopedTypeVariables #-}
33module Main where
44
5−import Graphics.Vty
65import Graphics.Vty.Attributes
6+import Graphics.Vty.Image
77import Graphics.Vty.Inline
88import Graphics.Vty.Picture
9−import Graphics.Vty.Output
9+import Graphics.Vty.Terminal
10+import Graphics.Vty.DisplayRegion
1011
11−import Control.Concurrent (threadDelay)
12−import Control.Exception
1312import Control.Monad
1413
1514import Data.List ( lookup )
1615import Data.Maybe ( isJust, fromJust )
1716import Data.Monoid
18−import Data.String.QQ
1917import Data.Word
2018
21−import Foreign.Marshal.Array
19+import Foreign.Marshal.Array
20+import HereDoc
2221
2322import qualified System.Environment as Env
2423
2524import System.IO ( hFlush, hPutStr, hPutBuf, stdout )
2625
2726main = do
28− printIntro
27+ print_intro
2928
30−outputFilePath = "test_results.list"
29+output_file_path = "test_results.list"
3130
32−printIntro = do
33− putStr $ [s|
31+print_intro = do
32+ putStr $ [$heredoc|
3433This is an interactive verification program for the terminal input and output
3534support of the VTY library. This will ask a series of questions about what you
3635see on screen. The goal is to verify that VTY's output and input support
3736performs as expected with your terminal.
3837
3938This program produces a file named
40− |] ++ outputFilePath ++ [s|
39+ |] ++ output_file_path ++ [$heredoc|
4140in the current directory that contains the results for each test assertion. This
4241can be emailed to coreyoconnor@gmail.com and used by the VTY authors to improve
4342support for your terminal. No personal information is contained in the report.
@@ -63,43 +62,42 @@ All the tests assume the following about the terminal display:
6362 a good range of the unicode characters. Each test involving unicode display
6463 describes the expected appearance of each glyph.
6564
66−Thanks for the help! :-D
67−To exit the test early enter "q" anytime at the following menu screen.
68−
69−If any test fails then please post an issue to
70− https://github.com/coreyoconnor/vty/issues
71−with the test_results.list file pasted into the issue. A suitable summary is:
72−"interactive terminal test failure".
73−|]
74− waitForReturn
75− results <- doTestMenu 1
76− envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName )
77− ( \ (_ :: SomeException) -> return (envName, "") )
78− )
79− [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
80− t <- standardIOConfig >>= outputForConfig
81− let resultsTxt = show envAttributes ++ "\n"
82− ++ terminalID t ++ "\n"
83− ++ show results ++ "\n"
84− releaseTerminal t
85− writeFile outputFilePath resultsTxt
86−
87−waitForReturn = do
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+
71+|]
72+ wait_for_return
73+ results <- do_test_menu 1
74+ env_attributes <- mapM ( \env_name -> catch ( Env.getEnv env_name >>= return . (,) env_name )
75+ ( const $ return (env_name, "") )
76+ )
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
83+ writeFile output_file_path results_txt
84+
85+wait_for_return = do
8886 putStr "\n(press return to continue)"
8987 hFlush stdout
9088 getLine
9189
92−testMenu :: [(String, Test)]
93−testMenu = zip (map show [1..]) allTests
90+test_menu :: [(String, Test)]
91+test_menu = zip (map show [1..]) all_tests
9492
95−doTestMenu :: Int -> IO [(String, Bool)]
96−doTestMenu nextID
97− | nextID > length allTests = do
98− putStrLn $ "Done! Please email the " ++ outputFilePath ++ " file to coreyoconnor@gmail.com"
93+do_test_menu :: Int -> IO [(String, Bool)]
94+do_test_menu next_ID
95+ | next_ID > length all_tests = do
96+ putStrLn $ "Done! Please email the " ++ output_file_path ++ " file to coreyoconnor@gmail.com"
9997 return []
10098 | otherwise = do
101− displayTestMenu
102− putStrLn $ "Press return to start with #" ++ show nextID ++ "."
99+ display_test_menu
100+ putStrLn $ "Press return to start with #" ++ show next_ID ++ "."
103101 putStrLn "Enter a test number to perform only that test."
104102 putStrLn "q (or control-C) to quit."
105103 putStr "> "
@@ -107,102 +105,91 @@ doTestMenu nextID
107105 s <- getLine >>= return . filter (/= '\n')
108106 case s of
109107 "q" -> return mempty
110− "" -> do
111− r <- runTest $ show nextID
112− rs <- doTestMenu ( nextID + 1 )
108+ "" -> do
109+ r <- run_test $ show next_ID
110+ rs <- do_test_menu ( next_ID + 1 )
113111 return $ r : rs
114− i | isJust ( lookup i testMenu ) -> do
115− r <- runTest i
116− rs <- doTestMenu ( read i + 1 )
112+ i | isJust ( lookup i test_menu ) -> do
113+ r <- run_test i
114+ rs <- do_test_menu ( read i + 1 )
117115 return $ r : rs
118116 where
119− displayTestMenu
120− = mapM_ displayTestMenu' testMenu
121− displayTestMenu' ( i, t )
122− = putStrLn $ ( if i == show nextID
123− then "> "
117+ display_test_menu
118+ = mapM_ display_test_menu' test_menu
119+ display_test_menu' ( i, t )
120+ = putStrLn $ ( if i == show next_ID
121+ then "> "
124122 else " "
125− ) ++ i ++ ". " ++ testName t
126−
127−runTest :: String -> IO (String, Bool)
128−runTest i = do
129− let t = fromJust $ lookup i testMenu
130− printSummary t
131− waitForReturn
132− testAction t
133− r <- confirmResults t
134− return (testID t, r)
135−
136−defaultSuccessConfirmResults = do
123+ ) ++ i ++ ". " ++ test_name t
124+
125+run_test :: String -> IO (String, Bool)
126+run_test i = do
127+ let t = fromJust $ lookup i test_menu
128+ print_summary t
129+ wait_for_return
130+ test_action t
131+ r <- confirm_results t
132+ return (test_ID t, r)
133+
134+default_success_confirm_results = do
137135 putStr "\n"
138136 putStr "[Y/n] "
139137 hFlush stdout
140138 r <- getLine
141139 case r of
142− "" -> return True
140+ "" -> return True
143141 "y" -> return True
144142 "Y" -> return True
145143 "n" -> return False
146144
147145data Test = Test
148− { testName :: String
149− , testID :: String
150− , testAction :: IO ()
151− , printSummary :: IO ()
152− , confirmResults :: IO Bool
146+ { test_name :: String
147+ , test_ID :: String
148+ , test_action :: IO ()
149+ , print_summary :: IO ()
150+ , confirm_results :: IO Bool
153151 }
154152
155−allTests
156− = [ reserveOutputTest
157− , displayBoundsTest0
158− , displayBoundsTest1
159− , displayBoundsTest2
160− , displayBoundsTest3
161− , unicodeSingleWidth0
162− , unicodeSingleWidth1
163− , unicodeDoubleWidth0
164− , unicodeDoubleWidth1
165− , attributesTest0
166− , attributesTest1
167− , attributesTest2
168− , attributesTest3
169− , attributesTest4
170− , attributesTest5
171− , inlineTest0
172− , inlineTest1
173− , inlineTest2
174− , cursorHideTest0
175− , vertCropTest0
176− , vertCropTest1
177− , vertCropTest2
178− , vertCropTest3
179− , horizCropTest0
180− , horizCropTest1
181− , horizCropTest2
182− , horizCropTest3
183− , layer0
184− , layer1
153+all_tests
154+ = [ reserve_output_test
155+ , display_bounds_test_0
156+ , display_bounds_test_1
157+ , display_bounds_test_2
158+ , display_bounds_test_3
159+ , unicode_single_width_0
160+ , unicode_single_width_1
161+ , unicode_double_width_0
162+ , unicode_double_width_1
163+ , attributes_test_0
164+ , attributes_test_1
165+ , attributes_test_2
166+ , attributes_test_3
167+ , attributes_test_4
168+ , attributes_test_5
169+ , inline_test_0
170+ , inline_test_1
171+ , inline_test_2
185172 ]
186173
187−reserveOutputTest = Test
188− { testName = "Initialize and reserve terminal output then restore previous state."
189− , testID = "reserveOutputTest"
190− , testAction = do
191− t <- standardIOConfig >>= outputForConfig
192− reserveDisplay t
174+reserve_output_test = Test
175+ { test_name = "Initialize and reserve terminal output then restore previous state."
176+ , test_ID = "reserve_output_test"
177+ , test_action = do
178+ t <- terminal_handle
179+ reserve_display t
193180 putStrLn "Line 1"
194181 putStrLn "Line 2"
195182 putStrLn "Line 3"
196183 putStrLn "Line 4 (press return)"
197184 hFlush stdout
198185 getLine
199− releaseDisplay t
200− releaseTerminal t
186+ release_display t
187+ release_terminal t
201188 return ()
202− , printSummary = do
203− putStr $ [s|
189+ , print_summary = do
190+ putStr $ [$heredoc|
204191Once return is pressed:
205− 0. The screen will be cleared.
192+ 0. The screen will be cleared.
206193 1. Four lines of text should be visible.
207194 1. The cursor should be visible and at the start of the fifth line.
208195
@@ -210,143 +197,135 @@ After return is pressed for the second time this test then:
210197 * The screen containing the test summary should be restored;
211198 * The cursor is visible.
212199|]
213− , confirmResults = do
214− putStr $ [s|
200+ , confirm_results = do
201+ putStr $ [$heredoc|
215202Did the test output match the description?
216203|]
217− defaultSuccessConfirmResults
204+ default_success_confirm_results
218205 }
219206
220−displayBoundsTest0 = Test
221− { testName = "Verify display bounds are correct test 0: Using spaces."
222− , testID = "displayBoundsTest0"
223− , testAction = do
224− t <- standardIOConfig >>= outputForConfig
225− reserveDisplay t
226− (w,h) <- displayBounds t
227− let row0 = replicate (fromEnum w) 'X' ++ "\n"
228− rowH = replicate (fromEnum w - 1) 'X'
229− rowN = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
230− image = row0 ++ (concat $ replicate (fromEnum h - 2) rowN) ++ rowH
207+display_bounds_test_0 = Test
208+ { test_name = "Verify display bounds are correct test 0: Using spaces."
209+ , test_ID = "display_bounds_test_0"
210+ , test_action = do
211+ t <- terminal_handle
212+ reserve_display t
213+ DisplayRegion w h <- display_bounds t
214+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
215+ row_h = replicate (fromEnum w - 1) 'X'
216+ row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
217+ image = row_0 ++ (concat $ replicate (fromEnum h - 2) row_n) ++ row_h
231218 putStr image
232219 hFlush stdout
233220 getLine
234− releaseDisplay t
235− releaseTerminal t
221+ release_display t
222+ release_terminal t
236223 return ()
237− , printSummary = displayBoundsTestSummary True
238− , confirmResults = genericOutputMatchConfirm
224+ , print_summary = display_bounds_test_summary True
225+ , confirm_results = generic_output_match_confirm
239226 }
240227
241−displayBoundsTest1 = Test
242− { testName = "Verify display bounds are correct test 0: Using cursor movement."
243− , testID = "displayBoundsTest1"
244− , testAction = do
245− t <- standardIOConfig >>= outputForConfig
246− reserveDisplay t
247− (w,h) <- displayBounds t
248− setCursorPos t 0 0
249− let row0 = replicate (fromEnum w) 'X' ++ "\n"
250− putStr row0
228+display_bounds_test_1 = Test
229+ { test_name = "Verify display bounds are correct test 0: Using cursor movement."
230+ , test_ID = "display_bounds_test_1"
231+ , test_action = do
232+ t <- terminal_handle
233+ reserve_display t
234+ DisplayRegion w h <- display_bounds t
235+ set_cursor_pos t 0 0
236+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
237+ putStr row_0
251238 forM_ [1 .. h - 2] $ \y -> do
252− setCursorPos t 0 y
239+ set_cursor_pos t 0 y
253240 putStr "X"
254− hFlush stdout
255− setCursorPos t (w - 1) y
241+ set_cursor_pos t (w - 1) y
256242 putStr "X"
257− hFlush stdout
258− setCursorPos t 0 (h - 1)
259− let rowH = replicate (fromEnum w - 1) 'X'
260− putStr rowH
243+ set_cursor_pos t 0 (h - 1)
244+ let row_h = replicate (fromEnum w - 1) 'X'
245+ putStr row_h
261246 hFlush stdout
262247 getLine
263− releaseDisplay t
264− releaseTerminal t
248+ release_display t
249+ release_terminal t
265250 return ()
266− , printSummary = displayBoundsTestSummary True
267− , confirmResults = genericOutputMatchConfirm
251+ , print_summary = display_bounds_test_summary True
252+ , confirm_results = generic_output_match_confirm
268253 }
269254
270−displayBoundsTest2 = Test
271− { testName = "Verify display bounds are correct test 0: Using Image ops."
272− , testID = "displayBoundsTest2"
273− , testAction = do
274− t <- standardIOConfig >>= outputForConfig
275− reserveDisplay t
276− bounds@(w,h) <- displayBounds t
277− let firstRow = horizCat $ replicate (fromEnum w) (char defAttr 'X')
278− middleRows = vertCat $ replicate (fromEnum h - 2) middleRow
279− middleRow = (char defAttr 'X') <|> backgroundFill (w - 2) 1 <|> (char defAttr 'X')
280− endRow = firstRow
281− image = firstRow <-> middleRows <-> endRow
282− pic = (picForImage image) { picCursor = Cursor (w - 1) (h - 1) }
283− d <- displayContext t bounds
284− outputPicture d pic
255+display_bounds_test_2 = Test
256+ { test_name = "Verify display bounds are correct test 0: Using Image ops."
257+ , test_ID = "display_bounds_test_2"
258+ , test_action = do
259+ t <- terminal_handle
260+ reserve_display t
261+ bounds@(DisplayRegion w h) <- display_bounds t
262+ let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')
263+ middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row
264+ middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')
265+ end_row = first_row
266+ image = first_row <-> middle_rows <-> end_row
267+ pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) }
268+ d <- display_context t bounds
269+ output_picture d pic
285270 getLine
286− releaseDisplay t
287− releaseTerminal t
271+ release_display t
272+ release_terminal t
288273 return ()
289− , printSummary = displayBoundsTestSummary True
290− , confirmResults = genericOutputMatchConfirm
274+ , print_summary = display_bounds_test_summary True
275+ , confirm_results = generic_output_match_confirm
291276 }
292277
293−displayBoundsTest3 = Test
294− { testName = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
295− , testID = "displayBoundsTest3"
296− , testAction = do
297− t <- standardIOConfig >>= outputForConfig
298− reserveDisplay t
299− (w,h) <- displayBounds t
300− hideCursor t
301− setCursorPos t 0 0
302− let row0 = replicate (fromEnum w) 'X'
303− putStrLn row0
278+display_bounds_test_3 = Test
279+ { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
280+ , test_ID = "display_bounds_test_3"
281+ , test_action = do
282+ t <- terminal_handle
283+ reserve_display t
284+ DisplayRegion w h <- display_bounds t
285+ hide_cursor t
286+ set_cursor_pos t 0 0
287+ let row_0 = replicate (fromEnum w) 'X'
288+ putStrLn row_0
304289 forM_ [1 .. h - 2] $ \y -> do
305− setCursorPos t 0 y
290+ set_cursor_pos t 0 y
306291 putStr "X"
307− hFlush stdout
308− setCursorPos t (w - 1) y
292+ set_cursor_pos t (w - 1) y
309293 putStr "X"
310− hFlush stdout
311− setCursorPos t 0 (h - 1)
312− let rowH = row0
313− putStr rowH
294+ set_cursor_pos t 0 (h - 1)
295+ let row_h = row_0
296+ putStr row_h
314297 hFlush stdout
315298 getLine
316− showCursor t
317− releaseDisplay t
318− releaseTerminal t
299+ show_cursor t
300+ release_display t
301+ release_terminal t
319302 return ()
320− , printSummary = displayBoundsTestSummary False
321− , confirmResults = genericOutputMatchConfirm
303+ , print_summary = display_bounds_test_summary False
304+ , confirm_results = generic_output_match_confirm
322305 }
323306
324−displayBoundsTestSummary hasCursor = do
325− putStr $ [s|
307+display_bounds_test_summary has_cursor = do
308+ putStr $ [$heredoc|
326309Once return is pressed:
327310 0. The screen will be cleared.
328311|]
329− if hasCursor
312+ if has_cursor
330313 then putStr " 1. The cursor will be visible."
331314 else putStr " 1. The cursor will NOT be visible."
332− putStr [s|
333−
315+ putStr [$heredoc|
334316 2. The border of the display will be outlined in Xs.
335317 So if - and | represented the edge of the terminal window:
336318 |-------------|
337319 |XXXXXXXXXXXXX|
338320 |X X||]
339321
340− if hasCursor
341− then putStr $ [s|
342−
322+ if has_cursor
323+ then putStr $ [$heredoc|
343324 |XXXXXXXXXXXXC| |]
344− else putStr $ [s|
345−
325+ else putStr $ [$heredoc|
346326 |XXXXXXXXXXXXX| |]
347327
348− putStr $ [s|
349−
328+ putStr $ [$heredoc|
350329 |-------------|
351330
352331 ( Where C is the final position of the cursor. There may be an X drawn
@@ -358,13 +337,13 @@ After return is pressed for the second time:
358337 1. The cursor should be visible.
359338|]
360339
361−genericOutputMatchConfirm = do
362− putStr $ [s|
340+generic_output_match_confirm = do
341+ putStr $ [$heredoc|
363342Did the test output match the description?
364343|]
365− defaultSuccessConfirmResults
344+ default_success_confirm_results
366345
367−-- Explicitly define the bytes that encode each example text.
346+-- Explicitely definethe bytes that encode each example text.
368347-- This avoids any issues with how the compiler represents string literals.
369348--
370349-- This document is UTF-8 encoded so the UTF-8 string is still included for
@@ -373,24 +352,24 @@ Did the test output match the description?
373352-- It's assumed the compiler will at least not barf on UTF-8 encoded text in
374353-- comments ;-)
375354--
376−-- txt0 = ↑↑↓↓←→←→BA
377−
378−utf8Txt0 :: [[Word8]]
379−utf8Txt0 = [ [ 0xe2 , 0x86 , 0x91 ]
380− , [ 0xe2 , 0x86 , 0x91 ]
381− , [ 0xe2 , 0x86 , 0x93 ]
382− , [ 0xe2 , 0x86 , 0x93 ]
383− , [ 0xe2 , 0x86 , 0x90 ]
384− , [ 0xe2 , 0x86 , 0x92 ]
385− , [ 0xe2 , 0x86 , 0x90 ]
386− , [ 0xe2 , 0x86 , 0x92 ]
387− , [ 0x42 ]
388− , [ 0x41 ]
389− ]
390−
391−iso10646Txt0 :: String
392−iso10646Txt0 = map toEnum
393− [ 8593
355+-- txt_0 = ↑↑↓↓←→←→BA
356+
357+utf8_txt_0 :: [[Word8]]
358+utf8_txt_0 = [ [ 0xe2 , 0x86 , 0x91 ]
359+ , [ 0xe2 , 0x86 , 0x91 ]
360+ , [ 0xe2 , 0x86 , 0x93 ]
361+ , [ 0xe2 , 0x86 , 0x93 ]
362+ , [ 0xe2 , 0x86 , 0x90 ]
363+ , [ 0xe2 , 0x86 , 0x92 ]
364+ , [ 0xe2 , 0x86 , 0x90 ]
365+ , [ 0xe2 , 0x86 , 0x92 ]
366+ , [ 0x42 ]
367+ , [ 0x41 ]
368+ ]
369+
370+iso_10646_txt_0 :: String
371+iso_10646_txt_0 = map toEnum
372+ [ 8593
394373 , 8593
395374 , 8595
396375 , 8595
@@ -402,46 +381,46 @@ iso10646Txt0 = map toEnum
402381 , 65
403382 ]
404383
405−unicodeSingleWidth0 = Test
406− { testName = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
407− , testID = "unicodeSingleWidth0"
408− , testAction = do
409− t <- standardIOConfig >>= outputForConfig
410− reserveDisplay t
411− hideCursor t
412− withArrayLen (concat utf8Txt0) (flip $ hPutBuf stdout)
384+unicode_single_width_0 = Test
385+ { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
386+ , test_ID = "unicode_single_width_0"
387+ , test_action = do
388+ t <- terminal_handle
389+ reserve_display t
390+ hide_cursor t
391+ withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout)
413392 hPutStr stdout "\n"
414393 hPutStr stdout "0123456789\n"
415394 hFlush stdout
416395 getLine
417− releaseDisplay t
418− releaseTerminal t
396+ release_display t
397+ release_terminal t
419398 return ()
420− , printSummary = unicodeSingleWidthSummary
421− , confirmResults = genericOutputMatchConfirm
399+ , print_summary = unicode_single_width_summary
400+ , confirm_results = generic_output_match_confirm
422401 }
423402
424−unicodeSingleWidth1 = Test
425− { testName = "Verify terminal can display unicode single-width characters. (Image ops)"
426− , testID = "unicodeSingleWidth1"
427− , testAction = do
428− t <- standardIOConfig >>= outputForConfig
429− reserveDisplay t
430− let pic = picForImage image
431− image = line0 <-> line1
432− line0 = iso10646String defAttr iso10646Txt0
433− line1 = string defAttr "0123456789"
434− d <- displayBounds t >>= displayContext t
435− outputPicture d pic
403+unicode_single_width_1 = Test
404+ { test_name = "Verify terminal can display unicode single-width characters. (Image ops)"
405+ , test_ID = "unicode_single_width_1"
406+ , test_action = do
407+ t <- terminal_handle
408+ reserve_display t
409+ let pic = pic_for_image image
410+ image = line_0 <-> line_1
411+ line_0 = iso_10646_string def_attr iso_10646_txt_0
412+ line_1 = string def_attr "0123456789"
413+ d <- display_bounds t >>= display_context t
414+ output_picture d pic
436415 getLine
437− releaseDisplay t
438− releaseTerminal t
416+ release_display t
417+ release_terminal t
439418 return ()
440− , printSummary = unicodeSingleWidthSummary
441− , confirmResults = genericOutputMatchConfirm
419+ , print_summary = unicode_single_width_summary
420+ , confirm_results = generic_output_match_confirm
442421 }
443422
444−unicodeSingleWidthSummary = putStr [s|
423+unicode_single_width_summary = putStr [$heredoc|
445424Once return is pressed:
446425 0. The screen will be cleared.
447426 1. The cursor will be hidden.
@@ -475,55 +454,55 @@ After return is pressed for the second time:
475454
476455-- The second example is a unicode string containing double-width glyphs
477456-- 你好吗
478−utf8Txt1 :: [[Word8]]
479−utf8Txt1 = [ [0xe4,0xbd,0xa0]
480− , [0xe5,0xa5,0xbd]
481− , [0xe5,0x90,0x97]
482− ]
483−
484−iso10646Txt1 :: String
485−iso10646Txt1 = map toEnum [20320,22909,21527]
486−
487−unicodeDoubleWidth0 = Test
488− { testName = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
489− , testID = "unicodeDoubleWidth0"
490− , testAction = do
491− t <- standardIOConfig >>= outputForConfig
492− reserveDisplay t
493− hideCursor t
494− withArrayLen (concat utf8Txt1) (flip $ hPutBuf stdout)
457+utf8_txt_1 :: [[Word8]]
458+utf8_txt_1 = [ [0xe4,0xbd,0xa0]
459+ , [0xe5,0xa5,0xbd]
460+ , [0xe5,0x90,0x97]
461+ ]
462+
463+iso_10646_txt_1 :: String
464+iso_10646_txt_1 = map toEnum [20320,22909,21527]
465+
466+unicode_double_width_0 = Test
467+ { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
468+ , test_ID = "unicode_double_width_0"
469+ , test_action = do
470+ t <- terminal_handle
471+ reserve_display t
472+ hide_cursor t
473+ withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout)
495474 hPutStr stdout "\n"
496475 hPutStr stdout "012345\n"
497476 hFlush stdout
498477 getLine
499− releaseDisplay t
500− releaseTerminal t
478+ release_display t
479+ release_terminal t
501480 return ()
502− , printSummary = unicodeDoubleWidthSummary
503− , confirmResults = genericOutputMatchConfirm
481+ , print_summary = unicode_double_width_summary
482+ , confirm_results = generic_output_match_confirm
504483 }
505484
506−unicodeDoubleWidth1 = Test
507− { testName = "Verify terminal can display unicode double-width characters. (Image ops)"
508− , testID = "unicodeDoubleWidth1"
509− , testAction = do
510− t <- standardIOConfig >>= outputForConfig
511− reserveDisplay t
512− let pic = picForImage image
513− image = line0 <-> line1
514− line0 = iso10646String defAttr iso10646Txt1
515− line1 = string defAttr "012345"
516− d <- displayBounds t >>= displayContext t
517− outputPicture d pic
485+unicode_double_width_1 = Test
486+ { test_name = "Verify terminal can display unicode double-width characters. (Image ops)"
487+ , test_ID = "unicode_double_width_1"
488+ , test_action = do
489+ t <- terminal_handle
490+ reserve_display t
491+ let pic = pic_for_image image
492+ image = line_0 <-> line_1
493+ line_0 = iso_10646_string def_attr iso_10646_txt_1
494+ line_1 = string def_attr "012345"
495+ d <- display_bounds t >>= display_context t
496+ output_picture d pic
518497 getLine
519− releaseDisplay t
520− releaseTerminal t
498+ release_display t
499+ release_terminal t
521500 return ()
522− , printSummary = unicodeDoubleWidthSummary
523− , confirmResults = genericOutputMatchConfirm
501+ , print_summary = unicode_double_width_summary
502+ , confirm_results = generic_output_match_confirm
524503 }
525504
526−unicodeDoubleWidthSummary = putStr [s|
505+unicode_double_width_summary = putStr [$heredoc|
527506Once return is pressed:
528507 0. The screen will be cleared.
529508 1. The cursor will be hidden.
@@ -550,33 +529,33 @@ After return is pressed for the second time:
550529 1. The cursor should be visible.
551530|]
552531
553−allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
554− [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
532+all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
533+ [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
555534
556−allBrightColors
557− = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]
535+all_bright_colors
536+ = zip [ bright_black, bright_red, bright_green, bright_yellow, bright_blue, bright_magenta, bright_cyan, bright_white ]
558537 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]
559538
560−attributesTest0 = Test
561− { testName = "Character attributes: foreground colors."
562− , testID = "attributesTest0"
563− , testAction = do
564− t <- standardIOConfig >>= outputForConfig
565− reserveDisplay t
566− let pic = picForImage image
567− image = border <|> column0 <|> border <|> column1 <|> border
568− column0 = vertCat $ map lineWithColor allColors
569− border = vertCat $ replicate (length allColors) $ string defAttr " | "
570− column1 = vertCat $ map (string defAttr . snd) allColors
571− lineWithColor (c, cName) = string (defAttr `withForeColor` c) cName
572− d <- displayBounds t >>= displayContext t
573− outputPicture d pic
539+attributes_test_0 = Test
540+ { test_name = "Character attributes: foreground colors."
541+ , test_ID = "attributes_test_0"
542+ , test_action = do
543+ t <- terminal_handle
544+ reserve_display t
545+ let pic = pic_for_image image
546+ image = border <|> column_0 <|> border <|> column_1 <|> border
547+ column_0 = vert_cat $ map line_with_color all_colors
548+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
549+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
550+ line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name
551+ d <- display_bounds t >>= display_context t
552+ output_picture d pic
574553 getLine
575− releaseDisplay t
576− releaseTerminal t
554+ release_display t
555+ release_terminal t
577556 return ()
578− , printSummary = do
579− putStr $ [s|
557+ , print_summary = do
558+ putStr $ [$heredoc|
580559Once return is pressed:
581560 0. The screen will be cleared.
582561 1. The cursor will be hidden.
@@ -596,33 +575,33 @@ After return is pressed for the second time:
596575 0. The screen containing the test summary should be restored.
597576 1. The cursor should be visible.
598577|]
599− , confirmResults = do
600− putStr $ [s|
578+ , confirm_results = do
579+ putStr $ [$heredoc|
601580Did the test output match the description?
602581|]
603− defaultSuccessConfirmResults
582+ default_success_confirm_results
604583 }
605584
606−attributesTest1 = Test
607− { testName = "Character attributes: background colors."
608− , testID = "attributesTest1"
609− , testAction = do
610− t <- standardIOConfig >>= outputForConfig
611− reserveDisplay t
612− let pic = picForImage image
613− image = border <|> column0 <|> border <|> column1 <|> border
614− column0 = vertCat $ map lineWithColor allColors
615− border = vertCat $ replicate (length allColors) $ string defAttr " | "
616− column1 = vertCat $ map (string defAttr . snd) allColors
617− lineWithColor (c, cName) = string (defAttr `withBackColor` c) cName
618− d <- displayBounds t >>= displayContext t
619− outputPicture d pic
585+attributes_test_1 = Test
586+ { test_name = "Character attributes: background colors."
587+ , test_ID = "attributes_test_1"
588+ , test_action = do
589+ t <- terminal_handle
590+ reserve_display t
591+ let pic = pic_for_image image
592+ image = border <|> column_0 <|> border <|> column_1 <|> border
593+ column_0 = vert_cat $ map line_with_color all_colors
594+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
595+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
596+ line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name
597+ d <- display_bounds t >>= display_context t
598+ output_picture d pic
620599 getLine
621− releaseDisplay t
622− releaseTerminal t
600+ release_display t
601+ release_terminal t
623602 return ()
624− , printSummary = do
625− putStr $ [s|
603+ , print_summary = do
604+ putStr $ [$heredoc|
626605Once return is pressed:
627606 0. The screen will be cleared.
628607 1. The cursor will be hidden.
@@ -651,57 +630,57 @@ After return is pressed for the second time:
651630 0. The screen containing the test summary should be restored.
652631 1. The cursor should be visible.
653632|]
654− , confirmResults = do
655− putStr $ [s|
633+ , confirm_results = do
634+ putStr $ [$heredoc|
656635Did the test output match the description?
657636|]
658− defaultSuccessConfirmResults
637+ default_success_confirm_results
659638 }
660639
661−attributesTest2 = Test
662− { testName = "Character attributes: Vivid foreground colors."
663− , testID = "attributesTest2"
664− , testAction = do
665− t <- standardIOConfig >>= outputForConfig
666− reserveDisplay t
667− let pic = picForImage image
668− image = horizCat [border, column0, border, column1, border, column2, border]
669− border = vertCat $ replicate (length allColors) $ string defAttr " | "
670− column0 = vertCat $ map lineWithColor0 allColors
671− column1 = vertCat $ map lineWithColor1 allBrightColors
672− column2 = vertCat $ map (string defAttr . snd) allColors
673− lineWithColor0 (c, cName) = string (defAttr `withForeColor` c) cName
674− lineWithColor1 (c, cName) = string (defAttr `withForeColor` c) cName
675− d <- displayBounds t >>= displayContext t
676− outputPicture d pic
640+attributes_test_2 = Test
641+ { test_name = "Character attributes: Vivid foreground colors."
642+ , test_ID = "attributes_test_2"
643+ , test_action = do
644+ t <- terminal_handle
645+ reserve_display t
646+ let pic = pic_for_image image
647+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
648+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
649+ column_0 = vert_cat $ map line_with_color_0 all_colors
650+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
651+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
652+ line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name
653+ line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name
654+ d <- display_bounds t >>= display_context t
655+ output_picture d pic
677656 getLine
678− releaseDisplay t
679− releaseTerminal t
657+ release_display t
658+ release_terminal t
680659 return ()
681− , printSummary = do
682− putStr $ [s|
660+ , print_summary = do
661+ putStr $ [$heredoc|
683662Once return is pressed:
684663 0. The screen will be cleared.
685664 1. The cursor will be hidden.
686665 2. 9 lines of text in three columns will be drawn:
687666 a. The first column will be a name of a standard color (for an 8 color
688− terminal) rendered with that color as the foreground color.
667+ terminal) rendered with that color as the foreground color.
689668 b. The next column will be also be the name of a standard color rendered
690669 with that color as the foreground color but the shade used should be
691− more vivid than the shade used in the first column.
670+ more vivid than the shade used in the first column.
692671 c. The final column will be the name of a color rendered with the
693672 default attributes.
694673
695674For instance, one line will be the word "magenta" and that word should be
696−rendered in the magenta color.
675+rendered in the magenta color.
697676
698677I'm not actually sure exactly what "vivid" means in this context. For xterm the
699−vivid colors are brighter.
678+vivid colors are brighter.
700679
701−Verify:
680+Verify:
702681 * The first column: The foreground color matches the named color.
703682 * The second column: The foreground color matches the named color but is
704− more vivid than the color used in the first column.
683+ more vivid than the color used in the first column.
705684 * The third column: All text is rendered with the default attributes.
706685 * The vertical bars used in each line to mark the border of a column are
707686 lined up.
@@ -710,58 +689,58 @@ After return is pressed for the second time:
710689 0. The screen containing the test summary should be restored.
711690 1. The cursor should be visible.
712691|]
713− , confirmResults = do
714− putStr $ [s|
692+ , confirm_results = do
693+ putStr $ [$heredoc|
715694Did the test output match the description?
716695|]
717− defaultSuccessConfirmResults
696+ default_success_confirm_results
718697 }
719698
720−attributesTest3 = Test
721− { testName = "Character attributes: Vivid background colors."
722− , testID = "attributesTest3"
723− , testAction = do
724− t <- standardIOConfig >>= outputForConfig
725− reserveDisplay t
726− let pic = picForImage image
727− image = horizCat [border, column0, border, column1, border, column2, border]
728− border = vertCat $ replicate (length allColors) $ string defAttr " | "
729− column0 = vertCat $ map lineWithColor0 allColors
730− column1 = vertCat $ map lineWithColor1 allBrightColors
731− column2 = vertCat $ map (string defAttr . snd) allColors
732− lineWithColor0 (c, cName) = string (defAttr `withBackColor` c) cName
733− lineWithColor1 (c, cName) = string (defAttr `withBackColor` c) cName
734− d <- displayBounds t >>= displayContext t
735− outputPicture d pic
699+attributes_test_3 = Test
700+ { test_name = "Character attributes: Vivid background colors."
701+ , test_ID = "attributes_test_3"
702+ , test_action = do
703+ t <- terminal_handle
704+ reserve_display t
705+ let pic = pic_for_image image
706+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
707+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
708+ column_0 = vert_cat $ map line_with_color_0 all_colors
709+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
710+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
711+ line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name
712+ line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name
713+ d <- display_bounds t >>= display_context t
714+ output_picture d pic
736715 getLine
737− releaseDisplay t
738− releaseTerminal t
716+ release_display t
717+ release_terminal t
739718 return ()
740− , printSummary = do
741− putStr $ [s|
719+ , print_summary = do
720+ putStr $ [$heredoc|
742721Once return is pressed:
743722 0. The screen will be cleared.
744723 1. The cursor will be hidden.
745724 2. 9 lines of text in three columns will be drawn:
746725 a. The first column will contain be a name of a standard color for an 8
747726 color terminal rendered with the default foreground color with a
748− background the named color.
727+ background the named color.
749728 b. The first column will contain be a name of a standard color for an 8
750729 color terminal rendered with the default foreground color with the
751− background a vivid version of the named color.
730+ background a vivid version of the named color.
752731 c. The third column will be the name of a standard color rendered with
753732 the default attributes.
754−
733+
755734For instance, one line will contain be the word "magenta" and the word should
756−be rendered in the default foreground color over a magenta background.
735+be rendered in the default foreground color over a magenta background.
757736
758737I'm not actually sure exactly what "vivid" means in this context. For xterm the
759738vivid colors are brighter.
760739
761−Verify:
740+Verify:
762741 * The first column: The background color matches the named color.
763742 * The second column: The background color matches the named color and is
764− more vivid than the color used in the first column.
743+ more vivid than the color used in the first column.
765744 * The third column column: All text is rendered with the default attributes.
766745 * The vertical bars used in each line to mark the border of a column are
767746 lined up.
@@ -777,51 +756,51 @@ After return is pressed for the second time:
777756 0. The screen containing the test summary should be restored.
778757 1. The cursor should be visible.
779758|]
780− , confirmResults = do
781− putStr $ [s|
759+ , confirm_results = do
760+ putStr $ [$heredoc|
782761Did the test output match the description?
783762|]
784− defaultSuccessConfirmResults
763+ default_success_confirm_results
785764 }
786765
787−attrCombos =
766+attr_combos =
788767 [ ( "default", id )
789− , ( "bold", flip withStyle bold )
790− , ( "blink", flip withStyle blink )
791− , ( "underline", flip withStyle underline )
792− , ( "bold + blink", flip withStyle (bold + blink) )
793− , ( "bold + underline", flip withStyle (bold + underline) )
794− , ( "underline + blink", flip withStyle (underline + blink) )
795− , ( "bold + blink + underline", flip withStyle (bold + blink + underline) )
768+ , ( "bold", flip with_style bold )
769+ , ( "blink", flip with_style blink )
770+ , ( "underline", flip with_style underline )
771+ , ( "bold + blink", flip with_style (bold + blink) )
772+ , ( "bold + underline", flip with_style (bold + underline) )
773+ , ( "underline + blink", flip with_style (underline + blink) )
774+ , ( "bold + blink + underline", flip with_style (bold + blink + underline) )
796775 ]
797776
798−attributesTest4 = Test
799− { testName = "Character attributes: Bold; Blink; Underline."
800− , testID = "attributesTest4"
801− , testAction = do
802− t <- standardIOConfig >>= outputForConfig
803− reserveDisplay t
804− let pic = picForImage image
805− image = horizCat [border, column0, border, column1, border]
806− border = vertCat $ replicate (length attrCombos) $ string defAttr " | "
807− column0 = vertCat $ map lineWithAttrs attrCombos
808− column1 = vertCat $ map (string defAttr . fst) attrCombos
809− lineWithAttrs (desc, attrF) = string (attrF defAttr) desc
810− d <- displayBounds t >>= displayContext t
811− outputPicture d pic
777+attributes_test_4 = Test
778+ { test_name = "Character attributes: Bold; Blink; Underline."
779+ , test_ID = "attributes_test_4"
780+ , test_action = do
781+ t <- terminal_handle
782+ reserve_display t
783+ let pic = pic_for_image image
784+ image = horiz_cat [border, column_0, border, column_1, border]
785+ border = vert_cat $ replicate (length attr_combos) $ string def_attr " | "
786+ column_0 = vert_cat $ map line_with_attrs attr_combos
787+ column_1 = vert_cat $ map (string def_attr . fst) attr_combos
788+ line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc
789+ d <- display_bounds t >>= display_context t
790+ output_picture d pic
812791 getLine
813− releaseDisplay t
814− releaseTerminal t
792+ release_display t
793+ release_terminal t
815794 return ()
816− , printSummary = do
817− putStr $ [s|
795+ , print_summary = do
796+ putStr $ [$heredoc|
818797Once return is pressed:
819798 0. The screen will be cleared.
820799 1. The cursor will be hidden.
821− 2. 8 rows of text in two columns.
800+ 2. 8 rows of text in two columns.
822801 The rows will contain the following text:
823802 default
824− bold
803+ bold
825804 blink
826805 underline
827806 bold + blink
@@ -830,8 +809,8 @@ Once return is pressed:
830809 bold + blink + underline
831810 The first column will be rendered with the described attributes. The second
832811 column will be rendered with the default attributes.
833−
834−Verify:
812+
813+Verify:
835814 * The vertical bars used in each line to mark the border of a column are
836815 lined up.
837816 * The text in the first column is rendered as described.
@@ -840,353 +819,104 @@ After return is pressed for the second time:
840819 0. The screen containing the test summary should be restored.
841820 1. The cursor should be visible.
842821|]
843− , confirmResults = do
844− putStr $ [s|
822+ , confirm_results = do
823+ putStr $ [$heredoc|
845824Did the test output match the description?
846825|]
847− defaultSuccessConfirmResults
826+ default_success_confirm_results
848827 }
849828
850−attributesTest5 = Test
851− { testName = "Character attributes: 240 color palette"
852− , testID = "attributesTest5"
853− , testAction = do
854− t <- standardIOConfig >>= outputForConfig
855− reserveDisplay t
856− let pic = picForImage image
857− image = vertCat $ map horizCat $ splitColorImages colorImages
858− colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]
859− splitColorImages [] = []
860− splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))
861− d <- displayBounds t >>= displayContext t
862− outputPicture d pic
829+attributes_test_5 = Test
830+ { test_name = "Character attributes: 240 color palette"
831+ , test_ID = "attributes_test_5"
832+ , test_action = do
833+ t <- terminal_handle
834+ reserve_display t
835+ let pic = pic_for_image image
836+ image = vert_cat $ map horiz_cat $ split_color_images color_images
837+ color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239]
838+ split_color_images [] = []
839+ split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is))
840+ d <- display_bounds t >>= display_context t
841+ output_picture d pic
863842 getLine
864− releaseDisplay t
865− releaseTerminal t
843+ release_display t
844+ release_terminal t
866845 return ()
867− , printSummary = do
868− putStr $ [s|
846+ , print_summary = do
847+ putStr $ [$heredoc|
869848Once return is pressed:
870849 0. The screen will be cleared.
871850 1. The cursor will be hidden.
872851 2. A 20 character wide and 12 row high block of color squares. This should look like a palette
873852 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...
874853
875−Verify:
854+Verify:
876855
877856After return is pressed for the second time:
878857 0. The screen containing the test summary should be restored.
879858 1. The cursor should be visible.
880859|]
881− , confirmResults = do
882− putStr $ [s|
860+ , confirm_results = do
861+ putStr $ [$heredoc|
883862Did the test output match the description?
884863|]
885− defaultSuccessConfirmResults
864+ default_success_confirm_results
886865 }
887866
888−inlineTest0 = Test
889− { testName = "Verify styled output can be performed without clearing the screen."
890− , testID = "inlineTest0"
891− , testAction = do
867+inline_test_0 = Test
868+ { test_name = "Verify styled output can be performed without clearing the screen."
869+ , test_ID = "inline_test_0"
870+ , test_action = do
871+ t <- terminal_handle
892872 putStrLn "line 1."
893− putAttrChange_ $ backColor red >> applyStyle underline
873+ put_attr_change t $ back_color red >> apply_style underline
894874 putStrLn "line 2."
895− putAttrChange_ $ defaultAll
875+ put_attr_change t $ default_all
896876 putStrLn "line 3."
897− , printSummary = putStr $ [s|
877+ release_terminal t
878+ return ()
879+ , print_summary = putStr $ [$heredoc|
898880lines are in order.
899881The second line "line 2" should have a red background and the text underline.
900882The third line "line 3" should be drawn in the same style as the first line.
901883|]
902884
903− , confirmResults = genericOutputMatchConfirm
885+ , confirm_results = generic_output_match_confirm
904886 }
905887
906−inlineTest1 = Test
907− { testName = "Verify styled output can be performed without clearing the screen."
908− , testID = "inlineTest1"
909− , testAction = do
888+inline_test_1 = Test
889+ { test_name = "Verify styled output can be performed without clearing the screen."
890+ , test_ID = "inline_test_1"
891+ , test_action = do
892+ t <- terminal_handle
910893 putStr "Not styled. "
911− putAttrChange_ $ backColor red >> applyStyle underline
894+ put_attr_change t $ back_color red >> apply_style underline
912895 putStr " Styled! "
913− putAttrChange_ $ defaultAll
896+ put_attr_change t $ default_all
914897 putStrLn "Not styled."
915− , printSummary = putStr $ [s|
916−|]
917−
918− , confirmResults = genericOutputMatchConfirm
919− }
920−
921−inlineTest2 = Test
922− { testName = "Verify styled output can be performed without clearing the screen."
923− , testID = "inlineTest1"
924− , testAction = do
925− putStr "Not styled. "
926− putAttrChange_ $ backColor red >> applyStyle underline
927− putStr " Styled! "
928− putAttrChange_ $ defaultAll
929− putStr "Not styled.\n"
930− , printSummary = putStr $ [s|
931−|]
932− , confirmResults = genericOutputMatchConfirm
933− }
934−
935−cursorHideTest0 :: Test
936−cursorHideTest0 = Test
937− { testName = "Verify the cursor is hid and re-shown. issue #7"
938− , testID = "cursorHideTest0"
939− , testAction = do
940− vty <- mkVty defaultConfig
941− showCursor $ outputIface vty
942− setCursorPos (outputIface vty) 5 5
943− nextEvent vty
944− hideCursor $ outputIface vty
945− nextEvent vty
946− shutdown vty
898+ release_terminal t
947899 return ()
948− , printSummary = putStr $ [s|
949− 1. verify the cursor is displayed.
950− 2. press enter
951− 3. verify the cursor is hid.
952− 4. press enter.
953− 5. the display should return to the state before the test.
954−|]
955− , confirmResults = genericOutputMatchConfirm
956− }
957−
958−outputImageAndWait :: Image -> IO ()
959−outputImageAndWait image = do
960− let pic = picForImage image
961− outputPicAndWait pic
962−
963−outputPicAndWait :: Picture -> IO ()
964−outputPicAndWait pic = do
965− t <- standardIOConfig >>= outputForConfig
966− reserveDisplay t
967− d <- displayBounds t >>= displayContext t
968− outputPicture d pic
969− getLine
970− releaseDisplay t
971− releaseTerminal t
972− return ()
973−
974−vertCropTest0 :: Test
975−vertCropTest0 = Test
976− { testName = "Verify bottom cropping works as expected with single column chars"
977− , testID = "cropTest0"
978− , testAction = do
979− let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsum
980− block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsum
981− image = block0 <-> backgroundFill 10 2 <-> block1
982− outputImageAndWait image
983− , printSummary = putStr $ [s|
984− 1. Verify the two text blocks are identical.
985− 2. press enter.
986− 3. the display should return to the state before the test.
900+ , print_summary = putStr $ [$heredoc|
987901|]
988− , confirmResults = genericOutputMatchConfirm
989− }
990−
991−vertCropTest1 :: Test
992−vertCropTest1 = Test
993− { testName = "Verify bottom cropping works as expected with double column chars"
994− , testID = "cropTest0"
995− , testAction = do
996− let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
997− block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsumChinese
998− image = block0 <-> backgroundFill 10 2 <-> block1
999− outputImageAndWait image
1000− , printSummary = putStr $ [s|
1001− 1. Verify the two text blocks are identical.
1002− 2. press enter.
1003− 3. the display should return to the state before the test.
1004−|]
1005− , confirmResults = genericOutputMatchConfirm
1006− }
1007−
1008−vertCropTest2 :: Test
1009−vertCropTest2 = Test
1010− { testName = "Verify top cropping works as expected with single column chars"
1011− , testID = "cropTest2"
1012− , testAction = do
1013− let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsum
1014− block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsum - 2) lorumIpsum
1015− image = block0 <-> backgroundFill 10 2 <-> block1
1016− outputImageAndWait image
1017− , printSummary = putStr $ [s|
1018− 1. Verify the two text blocks are identical.
1019− 2. press enter.
1020− 3. the display should return to the state before the test.
1021−|]
1022− , confirmResults = genericOutputMatchConfirm
1023− }
1024−
1025−vertCropTest3 :: Test
1026−vertCropTest3 = Test
1027− { testName = "Verify top cropping works as expected with double column chars"
1028− , testID = "cropTest0"
1029− , testAction = do
1030− let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
1031− block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsumChinese - 2 ) lorumIpsumChinese
1032− image = block0 <-> backgroundFill 10 2 <-> block1
1033− outputImageAndWait image
1034− , printSummary = putStr $ [s|
1035− 1. Verify the two text blocks are identical.
1036− 2. press enter.
1037− 3. the display should return to the state before the test.
1038−|]
1039− , confirmResults = genericOutputMatchConfirm
1040− }
1041−
1042−horizCropTest0 :: Test
1043−horizCropTest0 = Test
1044− { testName = "Verify right cropping works as expected with single column chars"
1045− , testID = "cropTest0"
1046− , testAction = do
1047− let baseImage = vertCat $ map (string defAttr) lorumIpsum
1048− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1049− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1050− outputImageAndWait image
1051− , printSummary = putStr $ [s|
1052− 1. Verify the bottom text block is about half the width of the top text block.
1053− 2. press enter.
1054− 3. the display should return to the state before the test.
1055−|]
1056− , confirmResults = genericOutputMatchConfirm
1057− }
1058−
1059−horizCropTest1 :: Test
1060−horizCropTest1 = Test
1061− { testName = "Verify right cropping works as expected with double column chars"
1062− , testID = "cropTest0"
1063− , testAction = do
1064− let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1065− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1066− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1067− outputImageAndWait image
1068− , printSummary = putStr $ [s|
1069− 1. Verify the bottom text block is the left half of the top block. Ellipses on the right edge are OK.
1070− 2. press enter.
1071− 3. the display should return to the state before the test.
1072−|]
1073− , confirmResults = genericOutputMatchConfirm
1074− }
1075902
1076−horizCropTest2 :: Test
1077−horizCropTest2 = Test
1078− { testName = "Verify left cropping works as expected with single column chars"
1079− , testID = "cropTest0"
1080− , testAction = do
1081− let baseImage = vertCat $ map (string defAttr) lorumIpsum
1082− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1083− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1084− outputImageAndWait image
1085− , printSummary = putStr $ [s|
1086− 1. Verify the bottom text block is the right half of the top text block.
1087− 2. press enter.
1088− 3. the display should return to the state before the test.
1089−|]
1090− , confirmResults = genericOutputMatchConfirm
903+ , confirm_results = generic_output_match_confirm
1091904 }
1092905
1093−horizCropTest3 :: Test
1094−horizCropTest3 = Test
1095− { testName = "Verify right cropping works as expected with double column chars"
1096− , testID = "cropTest0"
1097− , testAction = do
1098− let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1099− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1100− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1101− outputImageAndWait image
1102− , printSummary = putStr $ [s|
1103− 1. Verify the bottom text block is the right half of the top block. Ellipses on the left edge are OK.
1104− 2. press enter.
1105− 3. the display should return to the state before the test.
1106−|]
1107− , confirmResults = genericOutputMatchConfirm
1108− }
1109−
1110−layer0 :: Test
1111−layer0 = Test
1112− { testName = "verify layer 0"
1113− , testID = "layer0"
1114− , testAction = do
1115− let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1116− lowerImage = vertCat $ map (string defAttr) lorumIpsum
1117− p = picForLayers [upperImage, lowerImage]
1118− outputPicAndWait p
1119− , printSummary = putStr $ [s|
1120− 1. Verify the text block appears to be Chinese text placed on top Latin text.
1121− 2. press enter.
1122− 3. the display should return to the state before the test.
906+inline_test_2 = Test
907+ { test_name = "Verify styled output can be performed without clearing the screen."
908+ , test_ID = "inline_test_1"
909+ , test_action = do
910+ t <- terminal_handle
911+ put_string t "Not styled. "
912+ put_attr_change t $ back_color red >> apply_style underline
913+ put_string t " Styled! "
914+ put_attr_change t $ default_all
915+ put_string t "Not styled.\n"
916+ release_terminal t
917+ return ()
918+ , print_summary = putStr $ [$heredoc|
1123919|]
1124− , confirmResults = genericOutputMatchConfirm
1125− }
1126920
1127−layer1 :: Test
1128−layer1 = Test
1129− { testName = "verify layer 1"
1130− , testID = "layer1"
1131− , testAction = do
1132− let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1133− block = resize 10 10 upperImage
1134− layer0 = vertCat $ map (string defAttr) lorumIpsum
1135− layer1 = charFill (defAttr `withBackColor` blue) '#' 1000 1000
1136− cheesyAnim0 block [layer0, layer1]
1137− , printSummary = putStr $ [s|
1138− 1. Verify the text block appears to be Chinese text moving on top a Latin text.
1139− Which is all on a background of '#' characters over blue.
1140− 2. press enter.
1141− 3. the display should return to the state before the test.
1142−|]
1143− , confirmResults = genericOutputMatchConfirm
921+ , confirm_results = generic_output_match_confirm
1144922 }
1145−
1146−cheesyAnim0 :: Image -> [Image] -> IO ()
1147−cheesyAnim0 i background = do
1148− t <- standardIOConfig >>= outputForConfig
1149− reserveDisplay t
1150− bounds <- displayBounds t
1151− d <- displayContext t bounds
1152− forM_ [0..2] $ \t -> do
1153− forM_ [0..100] $ \t -> do
1154− let i_offset = translate (t `mod` fst bounds)
1155− (t `div` 2 `mod` snd bounds)
1156− i
1157− let pic = picForLayers $ i_offset : background
1158− outputPicture d pic
1159− threadDelay 50000
1160− forM_ [0..100] $ \t -> do
1161− let i_offset = translate (t * (-1) `mod` fst bounds)
1162− (t * (-1) `div` 2 `mod` snd bounds)
1163− i
1164− let pic = picForLayers $ i_offset : background
1165− outputPicture d pic
1166− threadDelay 50000
1167− releaseDisplay t
1168− releaseTerminal t
1169− return ()
1170−
1171−lorumIpsum :: [String]
1172−lorumIpsum = lines [s|
1173−Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium,
1174−totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae
1175−dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit,
1176−sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam
1177−est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius
1178−modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima
1179−veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea
1180−commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil
1181−molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
1182−|]
1183−
1184−lorumIpsumChinese :: [String]
1185−lorumIpsumChinese = lines [s|
1186−輐銛 螷蟞覮 裌覅詵 暕 鴅噮 槶 惝掭掝 婸媥媕 耏胠臿, 汫汭沎 忕汌卣 蚡袀 僣 蒮 瀁瀎瀊 渮湸湤 緌翢,
1187−腠腶舝 糲蘥蠩 樏殣氀 蒮 蹢鎒 滍 鸄齴 櫧櫋瀩 鬄鵊鵙 莃荶衒, 毸溠 橀 簎艜薤 莃荶衒 翣聜蒢
1188−斔櫅檷 晛桼桾 拻敁柧 犿玒 膣, 墐 笓粊紒 bacon 鼀齕, 蔝蓶蓨 顊顃餭 姴怤 骱 暕 蹢鎒鎛 藒襓謥 鄻鎟霣
1189−鬎鯪, 鐩闤 硻禂稢 谾踘遳 撱 赲 迡 箷 蛃袚觙 萇雊蜩 壿嫷 鋡 縢羱聬 跐鉠鉣 蔝蓶蓨 匢奾灱 溮煡煟 雥齆犪
1190−蔰 虈觿, 腷腯葹 鍹餳駷 蛚袲褁蜸 皯竻 瀁瀎 蜭蜸覟 梪涫湴 揗斝湁 毼
1191−|]
1192−