@@ -1,5 +1,4 @@
11{-# LANGUAGE QuasiQuotes #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
32module Main where
43
54import Graphics.Vty
@@ -18,18 +17,18 @@ import Data.Monoid
1817import Data.String.QQ
1918import Data.Word
2019
21−import Foreign.Marshal.Array
20+import Foreign.Marshal.Array
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
31+print_intro = do
3332 putStr $ [s|
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
@@ -37,7 +36,7 @@ see 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 ++ [s|
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.
@@ -66,40 +65,41 @@ All the tests assume the following about the terminal display:
6665Thanks for the help! :-D
6766To exit the test early enter "q" anytime at the following menu screen.
6867
69−If any test fails then please post an issue to
68+If any test failed then please post an issue to
7069 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".
70+with the test_results.list file pasted into the issue. The issue summary can
71+mention the specific tests that failed or just say "interactive terminal test
72+failure".
7373|]
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
74+ wait_for_return
75+ results <- do_test_menu 1
76+ env_attributes <- mapM ( \env_name -> Control.Exception.catch ( Env.getEnv env_name >>= return . (,) env_name )
77+ ( \ (_ :: SomeException) -> return (env_name, "") )
78+ )
79+ [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
80+ t <- output_for_current_terminal
81+ let results_txt = show env_attributes ++ "\n"
82+ ++ terminal_ID t ++ "\n"
83+ ++ show results ++ "\n"
84+ release_terminal t
85+ writeFile output_file_path results_txt
86+
87+wait_for_return = do
8888 putStr "\n(press return to continue)"
8989 hFlush stdout
9090 getLine
9191
92−testMenu :: [(String, Test)]
93−testMenu = zip (map show [1..]) allTests
92+test_menu :: [(String, Test)]
93+test_menu = zip (map show [1..]) all_tests
9494
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"
95+do_test_menu :: Int -> IO [(String, Bool)]
96+do_test_menu next_ID
97+ | next_ID > length all_tests = do
98+ putStrLn $ "Done! Please email the " ++ output_file_path ++ " file to coreyoconnor@gmail.com"
9999 return []
100100 | otherwise = do
101− displayTestMenu
102− putStrLn $ "Press return to start with #" ++ show nextID ++ "."
101+ display_test_menu
102+ putStrLn $ "Press return to start with #" ++ show next_ID ++ "."
103103 putStrLn "Enter a test number to perform only that test."
104104 putStrLn "q (or control-C) to quit."
105105 putStr "> "
@@ -107,102 +107,102 @@ doTestMenu nextID
107107 s <- getLine >>= return . filter (/= '\n')
108108 case s of
109109 "q" -> return mempty
110− "" -> do
111− r <- runTest $ show nextID
112− rs <- doTestMenu ( nextID + 1 )
110+ "" -> do
111+ r <- run_test $ show next_ID
112+ rs <- do_test_menu ( next_ID + 1 )
113113 return $ r : rs
114− i | isJust ( lookup i testMenu ) -> do
115− r <- runTest i
116− rs <- doTestMenu ( read i + 1 )
114+ i | isJust ( lookup i test_menu ) -> do
115+ r <- run_test i
116+ rs <- do_test_menu ( read i + 1 )
117117 return $ r : rs
118118 where
119− displayTestMenu
120− = mapM_ displayTestMenu' testMenu
121− displayTestMenu' ( i, t )
122− = putStrLn $ ( if i == show nextID
123− then "> "
119+ display_test_menu
120+ = mapM_ display_test_menu' test_menu
121+ display_test_menu' ( i, t )
122+ = putStrLn $ ( if i == show next_ID
123+ then "> "
124124 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
125+ ) ++ i ++ ". " ++ test_name t
126+
127+run_test :: String -> IO (String, Bool)
128+run_test i = do
129+ let t = fromJust $ lookup i test_menu
130+ print_summary t
131+ wait_for_return
132+ test_action t
133+ r <- confirm_results t
134+ return (test_ID t, r)
135+
136+default_success_confirm_results = do
137137 putStr "\n"
138138 putStr "[Y/n] "
139139 hFlush stdout
140140 r <- getLine
141141 case r of
142− "" -> return True
142+ "" -> return True
143143 "y" -> return True
144144 "Y" -> return True
145145 "n" -> return False
146146
147147data Test = Test
148− { testName :: String
149− , testID :: String
150− , testAction :: IO ()
151− , printSummary :: IO ()
152− , confirmResults :: IO Bool
148+ { test_name :: String
149+ , test_ID :: String
150+ , test_action :: IO ()
151+ , print_summary :: IO ()
152+ , confirm_results :: IO Bool
153153 }
154154
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
155+all_tests
156+ = [ reserve_output_test
157+ , display_bounds_test_0
158+ , display_bounds_test_1
159+ , display_bounds_test_2
160+ , display_bounds_test_3
161+ , unicode_single_width_0
162+ , unicode_single_width_1
163+ , unicode_double_width_0
164+ , unicode_double_width_1
165+ , attributes_test_0
166+ , attributes_test_1
167+ , attributes_test_2
168+ , attributes_test_3
169+ , attributes_test_4
170+ , attributes_test_5
171+ , inline_test_0
172+ , inline_test_1
173+ , inline_test_2
174+ , cursor_hide_test_0
175+ , vert_crop_test_0
176+ , vert_crop_test_1
177+ , vert_crop_test_2
178+ , vert_crop_test_3
179+ , horiz_crop_test_0
180+ , horiz_crop_test_1
181+ , horiz_crop_test_2
182+ , horiz_crop_test_3
183+ , layer_0
184+ , layer_1
185185 ]
186186
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
187+reserve_output_test = Test
188+ { test_name = "Initialize and reserve terminal output then restore previous state."
189+ , test_ID = "reserve_output_test"
190+ , test_action = do
191+ t <- output_for_current_terminal
192+ reserve_display t
193193 putStrLn "Line 1"
194194 putStrLn "Line 2"
195195 putStrLn "Line 3"
196196 putStrLn "Line 4 (press return)"
197197 hFlush stdout
198198 getLine
199− releaseDisplay t
200− releaseTerminal t
199+ release_display t
200+ release_terminal t
201201 return ()
202− , printSummary = do
202+ , print_summary = do
203203 putStr $ [s|
204204Once return is pressed:
205− 0. The screen will be cleared.
205+ 0. The screen will be cleared.
206206 1. Four lines of text should be visible.
207207 1. The cursor should be visible and at the start of the fifth line.
208208
@@ -210,123 +210,123 @@ After return is pressed for the second time this test then:
210210 * The screen containing the test summary should be restored;
211211 * The cursor is visible.
212212|]
213− , confirmResults = do
213+ , confirm_results = do
214214 putStr $ [s|
215215Did the test output match the description?
216216|]
217− defaultSuccessConfirmResults
217+ default_success_confirm_results
218218 }
219219
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
220+display_bounds_test_0 = Test
221+ { test_name = "Verify display bounds are correct test 0: Using spaces."
222+ , test_ID = "display_bounds_test_0"
223+ , test_action = do
224+ t <- output_for_current_terminal
225+ reserve_display t
226+ (w,h) <- display_bounds t
227+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
228+ row_h = replicate (fromEnum w - 1) 'X'
229+ row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
230+ image = row_0 ++ (concat $ replicate (fromEnum h - 2) row_n) ++ row_h
231231 putStr image
232232 hFlush stdout
233233 getLine
234− releaseDisplay t
235− releaseTerminal t
234+ release_display t
235+ release_terminal t
236236 return ()
237− , printSummary = displayBoundsTestSummary True
238− , confirmResults = genericOutputMatchConfirm
237+ , print_summary = display_bounds_test_summary True
238+ , confirm_results = generic_output_match_confirm
239239 }
240240
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
241+display_bounds_test_1 = Test
242+ { test_name = "Verify display bounds are correct test 0: Using cursor movement."
243+ , test_ID = "display_bounds_test_1"
244+ , test_action = do
245+ t <- output_for_current_terminal
246+ reserve_display t
247+ (w,h) <- display_bounds t
248+ set_cursor_pos t 0 0
249+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
250+ putStr row_0
251251 forM_ [1 .. h - 2] $ \y -> do
252− setCursorPos t 0 y
252+ set_cursor_pos t 0 y
253253 putStr "X"
254254 hFlush stdout
255− setCursorPos t (w - 1) y
255+ set_cursor_pos t (w - 1) y
256256 putStr "X"
257257 hFlush stdout
258− setCursorPos t 0 (h - 1)
259− let rowH = replicate (fromEnum w - 1) 'X'
260− putStr rowH
258+ set_cursor_pos t 0 (h - 1)
259+ let row_h = replicate (fromEnum w - 1) 'X'
260+ putStr row_h
261261 hFlush stdout
262262 getLine
263− releaseDisplay t
264− releaseTerminal t
263+ release_display t
264+ release_terminal t
265265 return ()
266− , printSummary = displayBoundsTestSummary True
267− , confirmResults = genericOutputMatchConfirm
266+ , print_summary = display_bounds_test_summary True
267+ , confirm_results = generic_output_match_confirm
268268 }
269269
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
270+display_bounds_test_2 = Test
271+ { test_name = "Verify display bounds are correct test 0: Using Image ops."
272+ , test_ID = "display_bounds_test_2"
273+ , test_action = do
274+ t <- output_for_current_terminal
275+ reserve_display t
276+ bounds@(w,h) <- display_bounds t
277+ let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')
278+ middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row
279+ middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')
280+ end_row = first_row
281+ image = first_row <-> middle_rows <-> end_row
282+ pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) }
283+ d <- display_context t bounds
284+ output_picture d pic
285285 getLine
286− releaseDisplay t
287− releaseTerminal t
286+ release_display t
287+ release_terminal t
288288 return ()
289− , printSummary = displayBoundsTestSummary True
290− , confirmResults = genericOutputMatchConfirm
289+ , print_summary = display_bounds_test_summary True
290+ , confirm_results = generic_output_match_confirm
291291 }
292292
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
293+display_bounds_test_3 = Test
294+ { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
295+ , test_ID = "display_bounds_test_3"
296+ , test_action = do
297+ t <- output_for_current_terminal
298+ reserve_display t
299+ (w,h) <- display_bounds t
300+ hide_cursor t
301+ set_cursor_pos t 0 0
302+ let row_0 = replicate (fromEnum w) 'X'
303+ putStrLn row_0
304304 forM_ [1 .. h - 2] $ \y -> do
305− setCursorPos t 0 y
305+ set_cursor_pos t 0 y
306306 putStr "X"
307307 hFlush stdout
308− setCursorPos t (w - 1) y
308+ set_cursor_pos t (w - 1) y
309309 putStr "X"
310310 hFlush stdout
311− setCursorPos t 0 (h - 1)
312− let rowH = row0
313− putStr rowH
311+ set_cursor_pos t 0 (h - 1)
312+ let row_h = row_0
313+ putStr row_h
314314 hFlush stdout
315315 getLine
316− showCursor t
317− releaseDisplay t
318− releaseTerminal t
316+ show_cursor t
317+ release_display t
318+ release_terminal t
319319 return ()
320− , printSummary = displayBoundsTestSummary False
321− , confirmResults = genericOutputMatchConfirm
320+ , print_summary = display_bounds_test_summary False
321+ , confirm_results = generic_output_match_confirm
322322 }
323323
324−displayBoundsTestSummary hasCursor = do
324+display_bounds_test_summary has_cursor = do
325325 putStr $ [s|
326326Once return is pressed:
327327 0. The screen will be cleared.
328328|]
329− if hasCursor
329+ if has_cursor
330330 then putStr " 1. The cursor will be visible."
331331 else putStr " 1. The cursor will NOT be visible."
332332 putStr [s|
@@ -337,7 +337,7 @@ Once return is pressed:
337337 |XXXXXXXXXXXXX|
338338 |X X||]
339339
340− if hasCursor
340+ if has_cursor
341341 then putStr $ [s|
342342
343343 |XXXXXXXXXXXXC| |]
@@ -358,13 +358,13 @@ After return is pressed for the second time:
358358 1. The cursor should be visible.
359359|]
360360
361−genericOutputMatchConfirm = do
361+generic_output_match_confirm = do
362362 putStr $ [s|
363363Did the test output match the description?
364364|]
365− defaultSuccessConfirmResults
365+ default_success_confirm_results
366366
367−-- Explicitly define the bytes that encode each example text.
367+-- Explicitely definethe bytes that encode each example text.
368368-- This avoids any issues with how the compiler represents string literals.
369369--
370370-- This document is UTF-8 encoded so the UTF-8 string is still included for
@@ -373,24 +373,24 @@ Did the test output match the description?
373373-- It's assumed the compiler will at least not barf on UTF-8 encoded text in
374374-- comments ;-)
375375--
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
376+-- txt_0 = ↑↑↓↓←→←→BA
377+
378+utf8_txt_0 :: [[Word8]]
379+utf8_txt_0 = [ [ 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+iso_10646_txt_0 :: String
392+iso_10646_txt_0 = map toEnum
393+ [ 8593
394394 , 8593
395395 , 8595
396396 , 8595
@@ -402,46 +402,46 @@ iso10646Txt0 = map toEnum
402402 , 65
403403 ]
404404
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)
405+unicode_single_width_0 = Test
406+ { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
407+ , test_ID = "unicode_single_width_0"
408+ , test_action = do
409+ t <- output_for_current_terminal
410+ reserve_display t
411+ hide_cursor t
412+ withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout)
413413 hPutStr stdout "\n"
414414 hPutStr stdout "0123456789\n"
415415 hFlush stdout
416416 getLine
417− releaseDisplay t
418− releaseTerminal t
417+ release_display t
418+ release_terminal t
419419 return ()
420− , printSummary = unicodeSingleWidthSummary
421− , confirmResults = genericOutputMatchConfirm
420+ , print_summary = unicode_single_width_summary
421+ , confirm_results = generic_output_match_confirm
422422 }
423423
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
424+unicode_single_width_1 = Test
425+ { test_name = "Verify terminal can display unicode single-width characters. (Image ops)"
426+ , test_ID = "unicode_single_width_1"
427+ , test_action = do
428+ t <- output_for_current_terminal
429+ reserve_display t
430+ let pic = pic_for_image image
431+ image = line_0 <-> line_1
432+ line_0 = iso_10646_string def_attr iso_10646_txt_0
433+ line_1 = string def_attr "0123456789"
434+ d <- display_bounds t >>= display_context t
435+ output_picture d pic
436436 getLine
437− releaseDisplay t
438− releaseTerminal t
437+ release_display t
438+ release_terminal t
439439 return ()
440− , printSummary = unicodeSingleWidthSummary
441− , confirmResults = genericOutputMatchConfirm
440+ , print_summary = unicode_single_width_summary
441+ , confirm_results = generic_output_match_confirm
442442 }
443443
444−unicodeSingleWidthSummary = putStr [s|
444+unicode_single_width_summary = putStr [s|
445445Once return is pressed:
446446 0. The screen will be cleared.
447447 1. The cursor will be hidden.
@@ -475,55 +475,55 @@ After return is pressed for the second time:
475475
476476-- The second example is a unicode string containing double-width glyphs
477477-- 你好吗
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)
478+utf8_txt_1 :: [[Word8]]
479+utf8_txt_1 = [ [0xe4,0xbd,0xa0]
480+ , [0xe5,0xa5,0xbd]
481+ , [0xe5,0x90,0x97]
482+ ]
483+
484+iso_10646_txt_1 :: String
485+iso_10646_txt_1 = map toEnum [20320,22909,21527]
486+
487+unicode_double_width_0 = Test
488+ { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
489+ , test_ID = "unicode_double_width_0"
490+ , test_action = do
491+ t <- output_for_current_terminal
492+ reserve_display t
493+ hide_cursor t
494+ withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout)
495495 hPutStr stdout "\n"
496496 hPutStr stdout "012345\n"
497497 hFlush stdout
498498 getLine
499− releaseDisplay t
500− releaseTerminal t
499+ release_display t
500+ release_terminal t
501501 return ()
502− , printSummary = unicodeDoubleWidthSummary
503− , confirmResults = genericOutputMatchConfirm
502+ , print_summary = unicode_double_width_summary
503+ , confirm_results = generic_output_match_confirm
504504 }
505505
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
506+unicode_double_width_1 = Test
507+ { test_name = "Verify terminal can display unicode double-width characters. (Image ops)"
508+ , test_ID = "unicode_double_width_1"
509+ , test_action = do
510+ t <- output_for_current_terminal
511+ reserve_display t
512+ let pic = pic_for_image image
513+ image = line_0 <-> line_1
514+ line_0 = iso_10646_string def_attr iso_10646_txt_1
515+ line_1 = string def_attr "012345"
516+ d <- display_bounds t >>= display_context t
517+ output_picture d pic
518518 getLine
519− releaseDisplay t
520− releaseTerminal t
519+ release_display t
520+ release_terminal t
521521 return ()
522− , printSummary = unicodeDoubleWidthSummary
523− , confirmResults = genericOutputMatchConfirm
522+ , print_summary = unicode_double_width_summary
523+ , confirm_results = generic_output_match_confirm
524524 }
525525
526−unicodeDoubleWidthSummary = putStr [s|
526+unicode_double_width_summary = putStr [s|
527527Once return is pressed:
528528 0. The screen will be cleared.
529529 1. The cursor will be hidden.
@@ -550,32 +550,32 @@ After return is pressed for the second time:
550550 1. The cursor should be visible.
551551|]
552552
553−allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
554− [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
553+all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
554+ [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
555555
556−allBrightColors
557− = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]
556+all_bright_colors
557+ = zip [ bright_black, bright_red, bright_green, bright_yellow, bright_blue, bright_magenta, bright_cyan, bright_white ]
558558 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]
559559
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
560+attributes_test_0 = Test
561+ { test_name = "Character attributes: foreground colors."
562+ , test_ID = "attributes_test_0"
563+ , test_action = do
564+ t <- output_for_current_terminal
565+ reserve_display t
566+ let pic = pic_for_image image
567+ image = border <|> column_0 <|> border <|> column_1 <|> border
568+ column_0 = vert_cat $ map line_with_color all_colors
569+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
570+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
571+ line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name
572+ d <- display_bounds t >>= display_context t
573+ output_picture d pic
574574 getLine
575− releaseDisplay t
576− releaseTerminal t
575+ release_display t
576+ release_terminal t
577577 return ()
578− , printSummary = do
578+ , print_summary = do
579579 putStr $ [s|
580580Once return is pressed:
581581 0. The screen will be cleared.
@@ -596,32 +596,32 @@ After return is pressed for the second time:
596596 0. The screen containing the test summary should be restored.
597597 1. The cursor should be visible.
598598|]
599− , confirmResults = do
599+ , confirm_results = do
600600 putStr $ [s|
601601Did the test output match the description?
602602|]
603− defaultSuccessConfirmResults
603+ default_success_confirm_results
604604 }
605605
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
606+attributes_test_1 = Test
607+ { test_name = "Character attributes: background colors."
608+ , test_ID = "attributes_test_1"
609+ , test_action = do
610+ t <- output_for_current_terminal
611+ reserve_display t
612+ let pic = pic_for_image image
613+ image = border <|> column_0 <|> border <|> column_1 <|> border
614+ column_0 = vert_cat $ map line_with_color all_colors
615+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
616+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
617+ line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name
618+ d <- display_bounds t >>= display_context t
619+ output_picture d pic
620620 getLine
621− releaseDisplay t
622− releaseTerminal t
621+ release_display t
622+ release_terminal t
623623 return ()
624− , printSummary = do
624+ , print_summary = do
625625 putStr $ [s|
626626Once return is pressed:
627627 0. The screen will be cleared.
@@ -651,57 +651,57 @@ After return is pressed for the second time:
651651 0. The screen containing the test summary should be restored.
652652 1. The cursor should be visible.
653653|]
654− , confirmResults = do
654+ , confirm_results = do
655655 putStr $ [s|
656656Did the test output match the description?
657657|]
658− defaultSuccessConfirmResults
658+ default_success_confirm_results
659659 }
660660
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
661+attributes_test_2 = Test
662+ { test_name = "Character attributes: Vivid foreground colors."
663+ , test_ID = "attributes_test_2"
664+ , test_action = do
665+ t <- output_for_current_terminal
666+ reserve_display t
667+ let pic = pic_for_image image
668+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
669+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
670+ column_0 = vert_cat $ map line_with_color_0 all_colors
671+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
672+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
673+ line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name
674+ line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name
675+ d <- display_bounds t >>= display_context t
676+ output_picture d pic
677677 getLine
678− releaseDisplay t
679− releaseTerminal t
678+ release_display t
679+ release_terminal t
680680 return ()
681− , printSummary = do
681+ , print_summary = do
682682 putStr $ [s|
683683Once return is pressed:
684684 0. The screen will be cleared.
685685 1. The cursor will be hidden.
686686 2. 9 lines of text in three columns will be drawn:
687687 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.
688+ terminal) rendered with that color as the foreground color.
689689 b. The next column will be also be the name of a standard color rendered
690690 with that color as the foreground color but the shade used should be
691− more vivid than the shade used in the first column.
691+ more vivid than the shade used in the first column.
692692 c. The final column will be the name of a color rendered with the
693693 default attributes.
694694
695695For instance, one line will be the word "magenta" and that word should be
696−rendered in the magenta color.
696+rendered in the magenta color.
697697
698698I'm not actually sure exactly what "vivid" means in this context. For xterm the
699−vivid colors are brighter.
699+vivid colors are brighter.
700700
701−Verify:
701+Verify:
702702 * The first column: The foreground color matches the named color.
703703 * The second column: The foreground color matches the named color but is
704− more vivid than the color used in the first column.
704+ more vivid than the color used in the first column.
705705 * The third column: All text is rendered with the default attributes.
706706 * The vertical bars used in each line to mark the border of a column are
707707 lined up.
@@ -710,34 +710,34 @@ After return is pressed for the second time:
710710 0. The screen containing the test summary should be restored.
711711 1. The cursor should be visible.
712712|]
713− , confirmResults = do
713+ , confirm_results = do
714714 putStr $ [s|
715715Did the test output match the description?
716716|]
717− defaultSuccessConfirmResults
717+ default_success_confirm_results
718718 }
719719
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
720+attributes_test_3 = Test
721+ { test_name = "Character attributes: Vivid background colors."
722+ , test_ID = "attributes_test_3"
723+ , test_action = do
724+ t <- output_for_current_terminal
725+ reserve_display t
726+ let pic = pic_for_image image
727+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
728+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
729+ column_0 = vert_cat $ map line_with_color_0 all_colors
730+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
731+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
732+ line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name
733+ line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name
734+ d <- display_bounds t >>= display_context t
735+ output_picture d pic
736736 getLine
737− releaseDisplay t
738− releaseTerminal t
737+ release_display t
738+ release_terminal t
739739 return ()
740− , printSummary = do
740+ , print_summary = do
741741 putStr $ [s|
742742Once return is pressed:
743743 0. The screen will be cleared.
@@ -745,23 +745,23 @@ Once return is pressed:
745745 2. 9 lines of text in three columns will be drawn:
746746 a. The first column will contain be a name of a standard color for an 8
747747 color terminal rendered with the default foreground color with a
748− background the named color.
748+ background the named color.
749749 b. The first column will contain be a name of a standard color for an 8
750750 color terminal rendered with the default foreground color with the
751− background a vivid version of the named color.
751+ background a vivid version of the named color.
752752 c. The third column will be the name of a standard color rendered with
753753 the default attributes.
754−
754+
755755For 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.
756+be rendered in the default foreground color over a magenta background.
757757
758758I'm not actually sure exactly what "vivid" means in this context. For xterm the
759759vivid colors are brighter.
760760
761−Verify:
761+Verify:
762762 * The first column: The background color matches the named color.
763763 * The second column: The background color matches the named color and is
764− more vivid than the color used in the first column.
764+ more vivid than the color used in the first column.
765765 * The third column column: All text is rendered with the default attributes.
766766 * The vertical bars used in each line to mark the border of a column are
767767 lined up.
@@ -777,51 +777,51 @@ After return is pressed for the second time:
777777 0. The screen containing the test summary should be restored.
778778 1. The cursor should be visible.
779779|]
780− , confirmResults = do
780+ , confirm_results = do
781781 putStr $ [s|
782782Did the test output match the description?
783783|]
784− defaultSuccessConfirmResults
784+ default_success_confirm_results
785785 }
786786
787−attrCombos =
787+attr_combos =
788788 [ ( "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) )
789+ , ( "bold", flip with_style bold )
790+ , ( "blink", flip with_style blink )
791+ , ( "underline", flip with_style underline )
792+ , ( "bold + blink", flip with_style (bold + blink) )
793+ , ( "bold + underline", flip with_style (bold + underline) )
794+ , ( "underline + blink", flip with_style (underline + blink) )
795+ , ( "bold + blink + underline", flip with_style (bold + blink + underline) )
796796 ]
797797
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
798+attributes_test_4 = Test
799+ { test_name = "Character attributes: Bold; Blink; Underline."
800+ , test_ID = "attributes_test_4"
801+ , test_action = do
802+ t <- output_for_current_terminal
803+ reserve_display t
804+ let pic = pic_for_image image
805+ image = horiz_cat [border, column_0, border, column_1, border]
806+ border = vert_cat $ replicate (length attr_combos) $ string def_attr " | "
807+ column_0 = vert_cat $ map line_with_attrs attr_combos
808+ column_1 = vert_cat $ map (string def_attr . fst) attr_combos
809+ line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc
810+ d <- display_bounds t >>= display_context t
811+ output_picture d pic
812812 getLine
813− releaseDisplay t
814− releaseTerminal t
813+ release_display t
814+ release_terminal t
815815 return ()
816− , printSummary = do
816+ , print_summary = do
817817 putStr $ [s|
818818Once return is pressed:
819819 0. The screen will be cleared.
820820 1. The cursor will be hidden.
821− 2. 8 rows of text in two columns.
821+ 2. 8 rows of text in two columns.
822822 The rows will contain the following text:
823823 default
824− bold
824+ bold
825825 blink
826826 underline
827827 bold + blink
@@ -830,8 +830,8 @@ Once return is pressed:
830830 bold + blink + underline
831831 The first column will be rendered with the described attributes. The second
832832 column will be rendered with the default attributes.
833−
834−Verify:
833+
834+Verify:
835835 * The vertical bars used in each line to mark the border of a column are
836836 lined up.
837837 * The text in the first column is rendered as described.
@@ -840,31 +840,31 @@ After return is pressed for the second time:
840840 0. The screen containing the test summary should be restored.
841841 1. The cursor should be visible.
842842|]
843− , confirmResults = do
843+ , confirm_results = do
844844 putStr $ [s|
845845Did the test output match the description?
846846|]
847− defaultSuccessConfirmResults
847+ default_success_confirm_results
848848 }
849849
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
850+attributes_test_5 = Test
851+ { test_name = "Character attributes: 240 color palette"
852+ , test_ID = "attributes_test_5"
853+ , test_action = do
854+ t <- output_for_current_terminal
855+ reserve_display t
856+ let pic = pic_for_image image
857+ image = vert_cat $ map horiz_cat $ split_color_images color_images
858+ color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239]
859+ split_color_images [] = []
860+ split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is))
861+ d <- display_bounds t >>= display_context t
862+ output_picture d pic
863863 getLine
864− releaseDisplay t
865− releaseTerminal t
864+ release_display t
865+ release_terminal t
866866 return ()
867− , printSummary = do
867+ , print_summary = do
868868 putStr $ [s|
869869Once return is pressed:
870870 0. The screen will be cleared.
@@ -872,304 +872,296 @@ Once return is pressed:
872872 2. A 20 character wide and 12 row high block of color squares. This should look like a palette
873873 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...
874874
875−Verify:
875+Verify:
876876
877877After return is pressed for the second time:
878878 0. The screen containing the test summary should be restored.
879879 1. The cursor should be visible.
880880|]
881− , confirmResults = do
881+ , confirm_results = do
882882 putStr $ [s|
883883Did the test output match the description?
884884|]
885− defaultSuccessConfirmResults
885+ default_success_confirm_results
886886 }
887887
888−inlineTest0 = Test
889− { testName = "Verify styled output can be performed without clearing the screen."
890− , testID = "inlineTest0"
891− , testAction = do
888+inline_test_0 = Test
889+ { test_name = "Verify styled output can be performed without clearing the screen."
890+ , test_ID = "inline_test_0"
891+ , test_action = do
892892 putStrLn "line 1."
893− putAttrChange_ $ backColor red >> applyStyle underline
893+ put_attr_change_ $ back_color red >> apply_style underline
894894 putStrLn "line 2."
895− putAttrChange_ $ defaultAll
895+ put_attr_change_ $ default_all
896896 putStrLn "line 3."
897− , printSummary = putStr $ [s|
897+ , print_summary = putStr $ [s|
898898lines are in order.
899899The second line "line 2" should have a red background and the text underline.
900900The third line "line 3" should be drawn in the same style as the first line.
901901|]
902902
903− , confirmResults = genericOutputMatchConfirm
903+ , confirm_results = generic_output_match_confirm
904904 }
905905
906−inlineTest1 = Test
907− { testName = "Verify styled output can be performed without clearing the screen."
908− , testID = "inlineTest1"
909− , testAction = do
906+inline_test_1 = Test
907+ { test_name = "Verify styled output can be performed without clearing the screen."
908+ , test_ID = "inline_test_1"
909+ , test_action = do
910910 putStr "Not styled. "
911− putAttrChange_ $ backColor red >> applyStyle underline
911+ put_attr_change_ $ back_color red >> apply_style underline
912912 putStr " Styled! "
913− putAttrChange_ $ defaultAll
913+ put_attr_change_ $ default_all
914914 putStrLn "Not styled."
915− , printSummary = putStr $ [s|
915+ , print_summary = putStr $ [s|
916916|]
917917
918− , confirmResults = genericOutputMatchConfirm
918+ , confirm_results = generic_output_match_confirm
919919 }
920920
921−inlineTest2 = Test
922− { testName = "Verify styled output can be performed without clearing the screen."
923− , testID = "inlineTest1"
924− , testAction = do
921+inline_test_2 = Test
922+ { test_name = "Verify styled output can be performed without clearing the screen."
923+ , test_ID = "inline_test_1"
924+ , test_action = do
925925 putStr "Not styled. "
926− putAttrChange_ $ backColor red >> applyStyle underline
926+ put_attr_change_ $ back_color red >> apply_style underline
927927 putStr " Styled! "
928− putAttrChange_ $ defaultAll
928+ put_attr_change_ $ default_all
929929 putStr "Not styled.\n"
930− , printSummary = putStr $ [s|
930+ , print_summary = putStr $ [s|
931931|]
932− , confirmResults = genericOutputMatchConfirm
932+ , confirm_results = generic_output_match_confirm
933933 }
934934
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
935+cursor_hide_test_0 :: Test
936+cursor_hide_test_0 = Test
937+ { test_name = "Verify the cursor is hid and re-shown. issue #7"
938+ , test_ID = "cursor_hide_test_0"
939+ , test_action = do
940+ vty <- mkVty
941+ show_cursor $ output_iface vty
942+ set_cursor_pos (output_iface vty) 5 5
943+ next_event vty
944+ hide_cursor $ output_iface vty
945+ next_event vty
946946 shutdown vty
947947 return ()
948− , printSummary = putStr $ [s|
948+ , print_summary = putStr $ [s|
949949 1. verify the cursor is displayed.
950950 2. press enter
951951 3. verify the cursor is hid.
952952 4. press enter.
953953 5. the display should return to the state before the test.
954954|]
955− , confirmResults = genericOutputMatchConfirm
955+ , confirm_results = generic_output_match_confirm
956956 }
957957
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
958+output_image_and_wait :: Image -> IO ()
959+output_image_and_wait image = do
960+ let pic = pic_for_image image
961+ output_pic_and_wait pic
962+
963+output_pic_and_wait :: Picture -> IO ()
964+output_pic_and_wait pic = do
965+ t <- output_for_current_terminal
966+ reserve_display t
967+ d <- display_bounds t >>= display_context t
968+ output_picture d pic
969969 getLine
970− releaseDisplay t
971− releaseTerminal t
970+ release_display t
971+ release_terminal t
972972 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|
973+
974+vert_crop_test_0 :: Test
975+vert_crop_test_0 = Test
976+ { test_name = "Verify bottom cropping works as expected with single column chars"
977+ , test_ID = "crop_test_0"
978+ , test_action = do
979+ let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum
980+ block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum
981+ image = block_0 <-> background_fill 10 2 <-> block_1
982+ output_image_and_wait image
983+ , print_summary = putStr $ [s|
984984 1. Verify the two text blocks are identical.
985985 2. press enter.
986986 3. the display should return to the state before the test.
987987|]
988− , confirmResults = genericOutputMatchConfirm
988+ , confirm_results = generic_output_match_confirm
989989 }
990990
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|
991+vert_crop_test_1 :: Test
992+vert_crop_test_1 = Test
993+ { test_name = "Verify bottom cropping works as expected with double column chars"
994+ , test_ID = "crop_test_0"
995+ , test_action = do
996+ let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
997+ block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum_chinese
998+ image = block_0 <-> background_fill 10 2 <-> block_1
999+ output_image_and_wait image
1000+ , print_summary = putStr $ [s|
10011001 1. Verify the two text blocks are identical.
10021002 2. press enter.
10031003 3. the display should return to the state before the test.
10041004|]
1005− , confirmResults = genericOutputMatchConfirm
1005+ , confirm_results = generic_output_match_confirm
10061006 }
10071007
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|
1008+vert_crop_test_2 :: Test
1009+vert_crop_test_2 = Test
1010+ { test_name = "Verify top cropping works as expected with single column chars"
1011+ , test_ID = "crop_test_0"
1012+ , test_action = do
1013+ let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum
1014+ block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum - 2) lorum_ipsum
1015+ image = block_0 <-> background_fill 10 2 <-> block_1
1016+ output_image_and_wait image
1017+ , print_summary = putStr $ [s|
10181018 1. Verify the two text blocks are identical.
10191019 2. press enter.
10201020 3. the display should return to the state before the test.
10211021|]
1022− , confirmResults = genericOutputMatchConfirm
1022+ , confirm_results = generic_output_match_confirm
10231023 }
10241024
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|
1025+vert_crop_test_3 :: Test
1026+vert_crop_test_3 = Test
1027+ { test_name = "Verify top cropping works as expected with double column chars"
1028+ , test_ID = "crop_test_0"
1029+ , test_action = do
1030+ let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
1031+ block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum_chinese - 2 ) lorum_ipsum_chinese
1032+ image = block_0 <-> background_fill 10 2 <-> block_1
1033+ output_image_and_wait image
1034+ , print_summary = putStr $ [s|
10351035 1. Verify the two text blocks are identical.
10361036 2. press enter.
10371037 3. the display should return to the state before the test.
10381038|]
1039− , confirmResults = genericOutputMatchConfirm
1039+ , confirm_results = generic_output_match_confirm
10401040 }
10411041
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|
1042+horiz_crop_test_0 :: Test
1043+horiz_crop_test_0 = Test
1044+ { test_name = "Verify right cropping works as expected with single column chars"
1045+ , test_ID = "crop_test_0"
1046+ , test_action = do
1047+ let base_image = vert_cat $ map (string def_attr) lorum_ipsum
1048+ cropped_image = crop_right (image_width base_image `div` 2) base_image
1049+ image = base_image <-> background_fill 10 2 <-> cropped_image
1050+ output_image_and_wait image
1051+ , print_summary = putStr $ [s|
10521052 1. Verify the bottom text block is about half the width of the top text block.
10531053 2. press enter.
10541054 3. the display should return to the state before the test.
10551055|]
1056− , confirmResults = genericOutputMatchConfirm
1056+ , confirm_results = generic_output_match_confirm
10571057 }
10581058
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|
1059+horiz_crop_test_1 :: Test
1060+horiz_crop_test_1 = Test
1061+ { test_name = "Verify right cropping works as expected with double column chars"
1062+ , test_ID = "crop_test_0"
1063+ , test_action = do
1064+ let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1065+ cropped_image = crop_right (image_width base_image `div` 2) base_image
1066+ image = base_image <-> background_fill 10 2 <-> cropped_image
1067+ output_image_and_wait image
1068+ , print_summary = putStr $ [s|
10691069 1. Verify the bottom text block is the left half of the top block. Ellipses on the right edge are OK.
10701070 2. press enter.
10711071 3. the display should return to the state before the test.
10721072|]
1073− , confirmResults = genericOutputMatchConfirm
1073+ , confirm_results = generic_output_match_confirm
10741074 }
10751075
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|
1076+horiz_crop_test_2 :: Test
1077+horiz_crop_test_2 = Test
1078+ { test_name = "Verify left cropping works as expected with single column chars"
1079+ , test_ID = "crop_test_0"
1080+ , test_action = do
1081+ let base_image = vert_cat $ map (string def_attr) lorum_ipsum
1082+ cropped_image = crop_left (image_width base_image `div` 2) base_image
1083+ image = base_image <-> background_fill 10 2 <-> cropped_image
1084+ output_image_and_wait image
1085+ , print_summary = putStr $ [s|
10861086 1. Verify the bottom text block is the right half of the top text block.
10871087 2. press enter.
10881088 3. the display should return to the state before the test.
10891089|]
1090− , confirmResults = genericOutputMatchConfirm
1090+ , confirm_results = generic_output_match_confirm
10911091 }
10921092
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|
1093+horiz_crop_test_3 :: Test
1094+horiz_crop_test_3 = Test
1095+ { test_name = "Verify right cropping works as expected with double column chars"
1096+ , test_ID = "crop_test_0"
1097+ , test_action = do
1098+ let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1099+ cropped_image = crop_left (image_width base_image `div` 2) base_image
1100+ image = base_image <-> background_fill 10 2 <-> cropped_image
1101+ output_image_and_wait image
1102+ , print_summary = putStr $ [s|
11031103 1. Verify the bottom text block is the right half of the top block. Ellipses on the left edge are OK.
11041104 2. press enter.
11051105 3. the display should return to the state before the test.
11061106|]
1107− , confirmResults = genericOutputMatchConfirm
1107+ , confirm_results = generic_output_match_confirm
11081108 }
11091109
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|
1110+layer_0 :: Test
1111+layer_0 = Test
1112+ { test_name = "verify layer 0"
1113+ , test_ID = "layer_0"
1114+ , test_action = do
1115+ let upper_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1116+ lower_image = vert_cat $ map (string def_attr) lorum_ipsum
1117+ p = pic_for_layers [upper_image, lower_image]
1118+ output_pic_and_wait p
1119+ , print_summary = putStr $ [s|
11201120 1. Verify the text block appears to be Chinese text placed on top Latin text.
11211121 2. press enter.
11221122 3. the display should return to the state before the test.
11231123|]
1124− , confirmResults = genericOutputMatchConfirm
1124+ , confirm_results = generic_output_match_confirm
11251125 }
11261126
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|
1127+layer_1 :: Test
1128+layer_1 = Test
1129+ { test_name = "verify layer 1"
1130+ , test_ID = "layer_1"
1131+ , test_action = do
1132+ let upper_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1133+ block = resize 10 10 upper_image
1134+ layer_0 = vert_cat $ map (string def_attr) lorum_ipsum
1135+ layer_1 = char_fill (def_attr `with_back_color` blue) '#' 1000 1000
1136+ cheesy_anim_0 block [layer_0, layer_1]
1137+ , print_summary = putStr $ [s|
11381138 1. Verify the text block appears to be Chinese text moving on top a Latin text.
11391139 Which is all on a background of '#' characters over blue.
11401140 2. press enter.
11411141 3. the display should return to the state before the test.
11421142|]
1143− , confirmResults = genericOutputMatchConfirm
1143+ , confirm_results = generic_output_match_confirm
11441144 }
11451145
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
1146+cheesy_anim_0 :: Image -> [Image] -> IO ()
1147+cheesy_anim_0 i background = do
1148+ t <- output_for_current_terminal
1149+ reserve_display t
1150+ bounds <- display_bounds t
1151+ d <- display_context t bounds
1152+ forM_ [0..100] $ \t -> do
11541153 let i_offset = translate (t `mod` fst bounds)
11551154 (t `div` 2 `mod` snd bounds)
11561155 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
1156+ let pic = pic_for_layers $ i_offset : background
1157+ output_picture d pic
11661158 threadDelay 50000
1167− releaseDisplay t
1168− releaseTerminal t
1159+ release_display t
1160+ release_terminal t
11691161 return ()
11701162
1171−lorumIpsum :: [String]
1172−lorumIpsum = lines [s|
1163+lorum_ipsum :: [String]
1164+lorum_ipsum = lines [s|
11731165Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium,
11741166totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae
11751167dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit,
@@ -1181,8 +1173,8 @@ commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate v
11811173molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
11821174|]
11831175
1184−lorumIpsumChinese :: [String]
1185−lorumIpsumChinese = lines [s|
1176+lorum_ipsum_chinese :: [String]
1177+lorum_ipsum_chinese = lines [s|
11861178輐銛 螷蟞覮 裌覅詵 暕 鴅噮 槶 惝掭掝 婸媥媕 耏胠臿, 汫汭沎 忕汌卣 蚡袀 僣 蒮 瀁瀎瀊 渮湸湤 緌翢,
11871179腠腶舝 糲蘥蠩 樏殣氀 蒮 蹢鎒 滍 鸄齴 櫧櫋瀩 鬄鵊鵙 莃荶衒, 毸溠 橀 簎艜薤 莃荶衒 翣聜蒢
11881180斔櫅檷 晛桼桾 拻敁柧 犿玒 膣, 墐 笓粊紒 bacon 鼀齕, 蔝蓶蓨 顊顃餭 姴怤 骱 暕 蹢鎒鎛 藒襓謥 鄻鎟霣