@@ -25,11 +25,11 @@ import qualified System.Environment as Env
2525import System.IO ( hFlush, hPutStr, hPutBuf, stdout )
2626
2727main = do
28− print_intro
28+ printIntro
2929
30−output_file_path = "test_results.list"
30+outputFilePath = "test_results.list"
3131
32−print_intro = do
32+printIntro = do
3333 putStr $ [s|
3434This is an interactive verification program for the terminal input and output
3535support of the VTY library. This will ask a series of questions about what you
@@ -37,7 +37,7 @@ see on screen. The goal is to verify that VTY's output and input support
3737performs as expected with your terminal.
3838
3939This program produces a file named
40− |] ++ output_file_path ++ [s|
40+ |] ++ outputFilePath ++ [s|
4141in the current directory that contains the results for each test assertion. This
4242can be emailed to coreyoconnor@gmail.com and used by the VTY authors to improve
4343support for your terminal. No personal information is contained in the report.
@@ -72,35 +72,35 @@ with the test_results.list file pasted into the issue. The issue summary can
7272mention the specific tests that failed or just say "interactive terminal test
7373failure".
7474|]
75− wait_for_return
76− results <- do_test_menu 1
77− env_attributes <- mapM ( \env_name -> Control.Exception.catch ( Env.getEnv env_name >>= return . (,) env_name )
75+ waitForReturn
76+ results <- doTestMenu 1
77+ envAttributes <- mapM ( \env_name -> Control.Exception.catch ( Env.getEnv env_name >>= return . (,) env_name )
7878 ( \ (_ :: SomeException) -> return (env_name, "") )
79− )
80− [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
81− t <- output_for_current_terminal
82− let results_txt = show env_attributes ++ "\n"
83− ++ terminal_ID t ++ "\n"
84− ++ show results ++ "\n"
85− release_terminal t
86− writeFile output_file_path results_txt
87−
88−wait_for_return = do
79+ )
80+ [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
81+ t <- outputForCurrentTerminal
82+ let resultsTxt = show envAttributes ++ "\n"
83+ ++ terminalID t ++ "\n"
84+ ++ show results ++ "\n"
85+ releaseTerminal t
86+ writeFile outputFilePath resultsTxt
87+
88+waitForReturn = do
8989 putStr "\n(press return to continue)"
9090 hFlush stdout
9191 getLine
9292
93−test_menu :: [(String, Test)]
94−test_menu = zip (map show [1..]) all_tests
93+testMenu :: [(String, Test)]
94+testMenu = zip (map show [1..]) allTests
9595
96−do_test_menu :: Int -> IO [(String, Bool)]
97−do_test_menu next_ID
98− | next_ID > length all_tests = do
99− putStrLn $ "Done! Please email the " ++ output_file_path ++ " file to coreyoconnor@gmail.com"
96+doTestMenu :: Int -> IO [(String, Bool)]
97+doTestMenu nextID
98+ | nextID > length allTests = do
99+ putStrLn $ "Done! Please email the " ++ outputFilePath ++ " file to coreyoconnor@gmail.com"
100100 return []
101101 | otherwise = do
102− display_test_menu
103− putStrLn $ "Press return to start with #" ++ show next_ID ++ "."
102+ displayTestMenu
103+ putStrLn $ "Press return to start with #" ++ show nextID ++ "."
104104 putStrLn "Enter a test number to perform only that test."
105105 putStrLn "q (or control-C) to quit."
106106 putStr "> "
@@ -109,98 +109,98 @@ do_test_menu next_ID
109109 case s of
110110 "q" -> return mempty
111111 "" -> do
112− r <- run_test $ show next_ID
113− rs <- do_test_menu ( next_ID + 1 )
112+ r <- runTest $ show nextID
113+ rs <- doTestMenu ( nextID + 1 )
114114 return $ r : rs
115− i | isJust ( lookup i test_menu ) -> do
116− r <- run_test i
117− rs <- do_test_menu ( read i + 1 )
115+ i | isJust ( lookup i testMenu ) -> do
116+ r <- runTest i
117+ rs <- doTestMenu ( read i + 1 )
118118 return $ r : rs
119119 where
120− display_test_menu
121− = mapM_ display_test_menu' test_menu
122− display_test_menu' ( i, t )
123− = putStrLn $ ( if i == show next_ID
120+ displayTestMenu
121+ = mapM_ displayTestMenu' testMenu
122+ displayTestMenu' ( i, t )
123+ = putStrLn $ ( if i == show nextID
124124 then "> "
125125 else " "
126− ) ++ i ++ ". " ++ test_name t
127−
128−run_test :: String -> IO (String, Bool)
129−run_test i = do
130− let t = fromJust $ lookup i test_menu
131− print_summary t
132− wait_for_return
133− test_action t
134− r <- confirm_results t
135− return (test_ID t, r)
136−
137−default_success_confirm_results = do
126+ ) ++ i ++ ". " ++ testName t
127+
128+runTest :: String -> IO (String, Bool)
129+runTest i = do
130+ let t = fromJust $ lookup i testMenu
131+ printSummary t
132+ waitForReturn
133+ testAction t
134+ r <- confirmResults t
135+ return (testID t, r)
136+
137+defaultSuccessConfirmResults = do
138138 putStr "\n"
139139 putStr "[Y/n] "
140140 hFlush stdout
141141 r <- getLine
142142 case r of
143− "" -> return True
143+ "" -> return True
144144 "y" -> return True
145145 "Y" -> return True
146146 "n" -> return False
147147
148148data Test = Test
149− { test_name :: String
150− , test_ID :: String
151− , test_action :: IO ()
152− , print_summary :: IO ()
153− , confirm_results :: IO Bool
149+ { testName :: String
150+ , testID :: String
151+ , testAction :: IO ()
152+ , printSummary :: IO ()
153+ , confirmResults :: IO Bool
154154 }
155155
156−all_tests
157− = [ reserve_output_test
158− , display_bounds_test_0
159− , display_bounds_test_1
160− , display_bounds_test_2
161− , display_bounds_test_3
162− , unicode_single_width_0
163− , unicode_single_width_1
164− , unicode_double_width_0
165− , unicode_double_width_1
166− , attributes_test_0
167− , attributes_test_1
168− , attributes_test_2
169− , attributes_test_3
170− , attributes_test_4
171− , attributes_test_5
172− , inline_test_0
173− , inline_test_1
174− , inline_test_2
175− , cursor_hide_test_0
176− , vert_crop_test_0
177− , vert_crop_test_1
178− , vert_crop_test_2
179− , vert_crop_test_3
180− , horiz_crop_test_0
181− , horiz_crop_test_1
182− , horiz_crop_test_2
183− , horiz_crop_test_3
184− , layer_0
185− , layer_1
156+allTests
157+ = [ reserveOutputTest
158+ , displayBoundsTest0
159+ , displayBoundsTest1
160+ , displayBoundsTest2
161+ , displayBoundsTest3
162+ , unicodeSingleWidth0
163+ , unicodeSingleWidth1
164+ , unicodeDoubleWidth0
165+ , unicodeDoubleWidth1
166+ , attributesTest0
167+ , attributesTest1
168+ , attributesTest2
169+ , attributesTest3
170+ , attributesTest4
171+ , attributesTest5
172+ , inlineTest0
173+ , inlineTest1
174+ , inlineTest2
175+ , cursorHideTest0
176+ , vertCropTest0
177+ , vertCropTest1
178+ , vertCropTest2
179+ , vertCropTest3
180+ , horizCropTest0
181+ , horizCropTest1
182+ , horizCropTest2
183+ , horizCropTest3
184+ , layer0
185+ , layer1
186186 ]
187187
188−reserve_output_test = Test
189− { test_name = "Initialize and reserve terminal output then restore previous state."
190− , test_ID = "reserve_output_test"
191− , test_action = do
192− t <- output_for_current_terminal
193− reserve_display t
188+reserveOutputTest = Test
189+ { testName = "Initialize and reserve terminal output then restore previous state."
190+ , testID = "reserveOutputTest"
191+ , testAction = do
192+ t <- outputForCurrentTerminal
193+ reserveDisplay t
194194 putStrLn "Line 1"
195195 putStrLn "Line 2"
196196 putStrLn "Line 3"
197197 putStrLn "Line 4 (press return)"
198198 hFlush stdout
199199 getLine
200− release_display t
201− release_terminal t
200+ releaseDisplay t
201+ releaseTerminal t
202202 return ()
203− , print_summary = do
203+ , printSummary = do
204204 putStr $ [s|
205205Once return is pressed:
206206 0. The screen will be cleared.
@@ -211,123 +211,123 @@ After return is pressed for the second time this test then:
211211 * The screen containing the test summary should be restored;
212212 * The cursor is visible.
213213|]
214− , confirm_results = do
214+ , confirmResults = do
215215 putStr $ [s|
216216Did the test output match the description?
217217|]
218− default_success_confirm_results
218+ defaultSuccessConfirmResults
219219 }
220220
221−display_bounds_test_0 = Test
222− { test_name = "Verify display bounds are correct test 0: Using spaces."
223− , test_ID = "display_bounds_test_0"
224− , test_action = do
225− t <- output_for_current_terminal
226− reserve_display t
227− (w,h) <- display_bounds t
228− let row_0 = replicate (fromEnum w) 'X' ++ "\n"
229− row_h = replicate (fromEnum w - 1) 'X'
230− row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
231− image = row_0 ++ (concat $ replicate (fromEnum h - 2) row_n) ++ row_h
221+displayBoundsTest0 = Test
222+ { testName = "Verify display bounds are correct test 0: Using spaces."
223+ , testID = "displayBoundsTest0"
224+ , testAction = do
225+ t <- outputForCurrentTerminal
226+ reserveDisplay t
227+ (w,h) <- displayBounds t
228+ let row0 = replicate (fromEnum w) 'X' ++ "\n"
229+ rowH = replicate (fromEnum w - 1) 'X'
230+ rowN = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
231+ image = row0 ++ (concat $ replicate (fromEnum h - 2) rowN) ++ rowH
232232 putStr image
233233 hFlush stdout
234234 getLine
235− release_display t
236− release_terminal t
235+ releaseDisplay t
236+ releaseTerminal t
237237 return ()
238− , print_summary = display_bounds_test_summary True
239− , confirm_results = generic_output_match_confirm
238+ , printSummary = displayBoundsTestSummary True
239+ , confirmResults = genericOutputMatchConfirm
240240 }
241241
242−display_bounds_test_1 = Test
243− { test_name = "Verify display bounds are correct test 0: Using cursor movement."
244− , test_ID = "display_bounds_test_1"
245− , test_action = do
246− t <- output_for_current_terminal
247− reserve_display t
248− (w,h) <- display_bounds t
249− set_cursor_pos t 0 0
250− let row_0 = replicate (fromEnum w) 'X' ++ "\n"
251− putStr row_0
242+displayBoundsTest1 = Test
243+ { testName = "Verify display bounds are correct test 0: Using cursor movement."
244+ , testID = "displayBoundsTest1"
245+ , testAction = do
246+ t <- outputForCurrentTerminal
247+ reserveDisplay t
248+ (w,h) <- displayBounds t
249+ setCursorPos t 0 0
250+ let row0 = replicate (fromEnum w) 'X' ++ "\n"
251+ putStr row0
252252 forM_ [1 .. h - 2] $ \y -> do
253− set_cursor_pos t 0 y
253+ setCursorPos t 0 y
254254 putStr "X"
255255 hFlush stdout
256− set_cursor_pos t (w - 1) y
256+ setCursorPos t (w - 1) y
257257 putStr "X"
258258 hFlush stdout
259− set_cursor_pos t 0 (h - 1)
260− let row_h = replicate (fromEnum w - 1) 'X'
261− putStr row_h
259+ setCursorPos t 0 (h - 1)
260+ let rowH = replicate (fromEnum w - 1) 'X'
261+ putStr rowH
262262 hFlush stdout
263263 getLine
264− release_display t
265− release_terminal t
264+ releaseDisplay t
265+ releaseTerminal t
266266 return ()
267− , print_summary = display_bounds_test_summary True
268− , confirm_results = generic_output_match_confirm
267+ , printSummary = displayBoundsTestSummary True
268+ , confirmResults = genericOutputMatchConfirm
269269 }
270270
271−display_bounds_test_2 = Test
272− { test_name = "Verify display bounds are correct test 0: Using Image ops."
273− , test_ID = "display_bounds_test_2"
274− , test_action = do
275− t <- output_for_current_terminal
276− reserve_display t
277− bounds@(w,h) <- display_bounds t
278− let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')
279− middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row
280− middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')
281− end_row = first_row
282− image = first_row <-> middle_rows <-> end_row
283− pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) }
284− d <- display_context t bounds
285− output_picture d pic
271+displayBoundsTest2 = Test
272+ { testName = "Verify display bounds are correct test 0: Using Image ops."
273+ , testID = "displayBoundsTest2"
274+ , testAction = do
275+ t <- outputForCurrentTerminal
276+ reserveDisplay t
277+ bounds@(w,h) <- displayBounds t
278+ let firstRow = horizCat $ replicate (fromEnum w) (char defAttr 'X')
279+ middleRows = vertCat $ replicate (fromEnum h - 2) middleRow
280+ middleRow = (char defAttr 'X') <|> backgroundFill (w - 2) 1 <|> (char defAttr 'X')
281+ endRow = firstRow
282+ image = firstRow <-> middleRows <-> endRow
283+ pic = (picForImage image) { picCursor = Cursor (w - 1) (h - 1) }
284+ d <- displayContext t bounds
285+ outputPicture d pic
286286 getLine
287− release_display t
288− release_terminal t
287+ releaseDisplay t
288+ releaseTerminal t
289289 return ()
290− , print_summary = display_bounds_test_summary True
291− , confirm_results = generic_output_match_confirm
290+ , printSummary = displayBoundsTestSummary True
291+ , confirmResults = genericOutputMatchConfirm
292292 }
293293
294−display_bounds_test_3 = Test
295− { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
296− , test_ID = "display_bounds_test_3"
297− , test_action = do
298− t <- output_for_current_terminal
299− reserve_display t
300− (w,h) <- display_bounds t
301− hide_cursor t
302− set_cursor_pos t 0 0
303− let row_0 = replicate (fromEnum w) 'X'
304− putStrLn row_0
294+displayBoundsTest3 = Test
295+ { testName = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
296+ , testID = "displayBoundsTest3"
297+ , testAction = do
298+ t <- outputForCurrentTerminal
299+ reserveDisplay t
300+ (w,h) <- displayBounds t
301+ hideCursor t
302+ setCursorPos t 0 0
303+ let row0 = replicate (fromEnum w) 'X'
304+ putStrLn row0
305305 forM_ [1 .. h - 2] $ \y -> do
306− set_cursor_pos t 0 y
306+ setCursorPos t 0 y
307307 putStr "X"
308308 hFlush stdout
309− set_cursor_pos t (w - 1) y
309+ setCursorPos t (w - 1) y
310310 putStr "X"
311311 hFlush stdout
312− set_cursor_pos t 0 (h - 1)
313− let row_h = row_0
314− putStr row_h
312+ setCursorPos t 0 (h - 1)
313+ let rowH = row0
314+ putStr rowH
315315 hFlush stdout
316316 getLine
317− show_cursor t
318− release_display t
319− release_terminal t
317+ showCursor t
318+ releaseDisplay t
319+ releaseTerminal t
320320 return ()
321− , print_summary = display_bounds_test_summary False
322− , confirm_results = generic_output_match_confirm
321+ , printSummary = displayBoundsTestSummary False
322+ , confirmResults = genericOutputMatchConfirm
323323 }
324324
325−display_bounds_test_summary has_cursor = do
325+displayBoundsTestSummary hasCursor = do
326326 putStr $ [s|
327327Once return is pressed:
328328 0. The screen will be cleared.
329329|]
330− if has_cursor
330+ if hasCursor
331331 then putStr " 1. The cursor will be visible."
332332 else putStr " 1. The cursor will NOT be visible."
333333 putStr [s|
@@ -338,7 +338,7 @@ Once return is pressed:
338338 |XXXXXXXXXXXXX|
339339 |X X||]
340340
341− if has_cursor
341+ if hasCursor
342342 then putStr $ [s|
343343
344344 |XXXXXXXXXXXXC| |]
@@ -359,11 +359,11 @@ After return is pressed for the second time:
359359 1. The cursor should be visible.
360360|]
361361
362−generic_output_match_confirm = do
362+genericOutputMatchConfirm = do
363363 putStr $ [s|
364364Did the test output match the description?
365365|]
366− default_success_confirm_results
366+ defaultSuccessConfirmResults
367367
368368-- Explicitely definethe bytes that encode each example text.
369369-- This avoids any issues with how the compiler represents string literals.
@@ -376,21 +376,21 @@ Did the test output match the description?
376376--
377377-- txt_0 = ↑↑↓↓←→←→BA
378378
379−utf8_txt_0 :: [[Word8]]
380−utf8_txt_0 = [ [ 0xe2 , 0x86 , 0x91 ]
381− , [ 0xe2 , 0x86 , 0x91 ]
382− , [ 0xe2 , 0x86 , 0x93 ]
383− , [ 0xe2 , 0x86 , 0x93 ]
384− , [ 0xe2 , 0x86 , 0x90 ]
385− , [ 0xe2 , 0x86 , 0x92 ]
386− , [ 0xe2 , 0x86 , 0x90 ]
387− , [ 0xe2 , 0x86 , 0x92 ]
388− , [ 0x42 ]
389− , [ 0x41 ]
390− ]
391−
392−iso_10646_txt_0 :: String
393−iso_10646_txt_0 = map toEnum
379+utf8Txt0 :: [[Word8]]
380+utf8Txt0 = [ [ 0xe2 , 0x86 , 0x91 ]
381+ , [ 0xe2 , 0x86 , 0x91 ]
382+ , [ 0xe2 , 0x86 , 0x93 ]
383+ , [ 0xe2 , 0x86 , 0x93 ]
384+ , [ 0xe2 , 0x86 , 0x90 ]
385+ , [ 0xe2 , 0x86 , 0x92 ]
386+ , [ 0xe2 , 0x86 , 0x90 ]
387+ , [ 0xe2 , 0x86 , 0x92 ]
388+ , [ 0x42 ]
389+ , [ 0x41 ]
390+ ]
391+
392+iso10646Txt0 :: String
393+iso10646Txt0 = map toEnum
394394 [ 8593
395395 , 8593
396396 , 8595
@@ -403,46 +403,46 @@ iso_10646_txt_0 = map toEnum
403403 , 65
404404 ]
405405
406−unicode_single_width_0 = Test
407− { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
408− , test_ID = "unicode_single_width_0"
409− , test_action = do
410− t <- output_for_current_terminal
411− reserve_display t
412− hide_cursor t
413− withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout)
406+unicodeSingleWidth0 = Test
407+ { testName = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
408+ , testID = "unicodeSingleWidth0"
409+ , testAction = do
410+ t <- outputForCurrentTerminal
411+ reserveDisplay t
412+ hideCursor t
413+ withArrayLen (concat utf8Txt0) (flip $ hPutBuf stdout)
414414 hPutStr stdout "\n"
415415 hPutStr stdout "0123456789\n"
416416 hFlush stdout
417417 getLine
418− release_display t
419− release_terminal t
418+ releaseDisplay t
419+ releaseTerminal t
420420 return ()
421− , print_summary = unicode_single_width_summary
422− , confirm_results = generic_output_match_confirm
421+ , printSummary = unicodeSingleWidthSummary
422+ , confirmResults = genericOutputMatchConfirm
423423 }
424424
425−unicode_single_width_1 = Test
426− { test_name = "Verify terminal can display unicode single-width characters. (Image ops)"
427− , test_ID = "unicode_single_width_1"
428− , test_action = do
429− t <- output_for_current_terminal
430− reserve_display t
431− let pic = pic_for_image image
432− image = line_0 <-> line_1
433− line_0 = iso_10646_string def_attr iso_10646_txt_0
434− line_1 = string def_attr "0123456789"
435− d <- display_bounds t >>= display_context t
436− output_picture d pic
425+unicodeSingleWidth1 = Test
426+ { testName = "Verify terminal can display unicode single-width characters. (Image ops)"
427+ , testID = "unicodeSingleWidth1"
428+ , testAction = do
429+ t <- outputForCurrentTerminal
430+ reserveDisplay t
431+ let pic = picForImage image
432+ image = line0 <-> line1
433+ line0 = iso10646String defAttr iso10646Txt0
434+ line1 = string defAttr "0123456789"
435+ d <- displayBounds t >>= displayContext t
436+ outputPicture d pic
437437 getLine
438− release_display t
439− release_terminal t
438+ releaseDisplay t
439+ releaseTerminal t
440440 return ()
441− , print_summary = unicode_single_width_summary
442− , confirm_results = generic_output_match_confirm
441+ , printSummary = unicodeSingleWidthSummary
442+ , confirmResults = genericOutputMatchConfirm
443443 }
444444
445−unicode_single_width_summary = putStr [s|
445+unicodeSingleWidthSummary = putStr [s|
446446Once return is pressed:
447447 0. The screen will be cleared.
448448 1. The cursor will be hidden.
@@ -476,55 +476,55 @@ After return is pressed for the second time:
476476
477477-- The second example is a unicode string containing double-width glyphs
478478-- 你好吗
479−utf8_txt_1 :: [[Word8]]
480−utf8_txt_1 = [ [0xe4,0xbd,0xa0]
481− , [0xe5,0xa5,0xbd]
482− , [0xe5,0x90,0x97]
483− ]
484−
485−iso_10646_txt_1 :: String
486−iso_10646_txt_1 = map toEnum [20320,22909,21527]
487−
488−unicode_double_width_0 = Test
489− { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
490− , test_ID = "unicode_double_width_0"
491− , test_action = do
492− t <- output_for_current_terminal
493− reserve_display t
494− hide_cursor t
495− withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout)
479+utf8Txt1 :: [[Word8]]
480+utf8Txt1 = [ [0xe4,0xbd,0xa0]
481+ , [0xe5,0xa5,0xbd]
482+ , [0xe5,0x90,0x97]
483+ ]
484+
485+iso10646Txt1 :: String
486+iso10646Txt1 = map toEnum [20320,22909,21527]
487+
488+unicodeDoubleWidth0 = Test
489+ { testName = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
490+ , testID = "unicodeDoubleWidth0"
491+ , testAction = do
492+ t <- outputForCurrentTerminal
493+ reserveDisplay t
494+ hideCursor t
495+ withArrayLen (concat utf8Txt1) (flip $ hPutBuf stdout)
496496 hPutStr stdout "\n"
497497 hPutStr stdout "012345\n"
498498 hFlush stdout
499499 getLine
500− release_display t
501− release_terminal t
500+ releaseDisplay t
501+ releaseTerminal t
502502 return ()
503− , print_summary = unicode_double_width_summary
504− , confirm_results = generic_output_match_confirm
503+ , printSummary = unicodeDoubleWidthSummary
504+ , confirmResults = genericOutputMatchConfirm
505505 }
506506
507−unicode_double_width_1 = Test
508− { test_name = "Verify terminal can display unicode double-width characters. (Image ops)"
509− , test_ID = "unicode_double_width_1"
510− , test_action = do
511− t <- output_for_current_terminal
512− reserve_display t
513− let pic = pic_for_image image
514− image = line_0 <-> line_1
515− line_0 = iso_10646_string def_attr iso_10646_txt_1
516− line_1 = string def_attr "012345"
517− d <- display_bounds t >>= display_context t
518− output_picture d pic
507+unicodeDoubleWidth1 = Test
508+ { testName = "Verify terminal can display unicode double-width characters. (Image ops)"
509+ , testID = "unicodeDoubleWidth1"
510+ , testAction = do
511+ t <- outputForCurrentTerminal
512+ reserveDisplay t
513+ let pic = picForImage image
514+ image = line0 <-> line1
515+ line0 = iso10646String defAttr iso10646Txt1
516+ line1 = string defAttr "012345"
517+ d <- displayBounds t >>= displayContext t
518+ outputPicture d pic
519519 getLine
520− release_display t
521− release_terminal t
520+ releaseDisplay t
521+ releaseTerminal t
522522 return ()
523− , print_summary = unicode_double_width_summary
524− , confirm_results = generic_output_match_confirm
523+ , printSummary = unicodeDoubleWidthSummary
524+ , confirmResults = genericOutputMatchConfirm
525525 }
526526
527−unicode_double_width_summary = putStr [s|
527+unicodeDoubleWidthSummary = putStr [s|
528528Once return is pressed:
529529 0. The screen will be cleared.
530530 1. The cursor will be hidden.
@@ -551,32 +551,32 @@ After return is pressed for the second time:
551551 1. The cursor should be visible.
552552|]
553553
554−all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
555− [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
554+allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
555+ [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
556556
557−all_bright_colors
558− = zip [ bright_black, bright_red, bright_green, bright_yellow, bright_blue, bright_magenta, bright_cyan, bright_white ]
557+allBrightColors
558+ = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]
559559 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]
560560
561−attributes_test_0 = Test
562− { test_name = "Character attributes: foreground colors."
563− , test_ID = "attributes_test_0"
564− , test_action = do
565− t <- output_for_current_terminal
566− reserve_display t
567− let pic = pic_for_image image
568− image = border <|> column_0 <|> border <|> column_1 <|> border
569− column_0 = vert_cat $ map line_with_color all_colors
570− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
571− column_1 = vert_cat $ map (string def_attr . snd) all_colors
572− line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name
573− d <- display_bounds t >>= display_context t
574− output_picture d pic
561+attributesTest0 = Test
562+ { testName = "Character attributes: foreground colors."
563+ , testID = "attributesTest0"
564+ , testAction = do
565+ t <- outputForCurrentTerminal
566+ reserveDisplay t
567+ let pic = picForImage image
568+ image = border <|> column0 <|> border <|> column1 <|> border
569+ column0 = vertCat $ map lineWithColor allColors
570+ border = vertCat $ replicate (length allColors) $ string defAttr " | "
571+ column1 = vertCat $ map (string defAttr . snd) allColors
572+ lineWithColor (c, cName) = string (defAttr `withForeColor` c) cName
573+ d <- displayBounds t >>= displayContext t
574+ outputPicture d pic
575575 getLine
576− release_display t
577− release_terminal t
576+ releaseDisplay t
577+ releaseTerminal t
578578 return ()
579− , print_summary = do
579+ , printSummary = do
580580 putStr $ [s|
581581Once return is pressed:
582582 0. The screen will be cleared.
@@ -597,32 +597,32 @@ After return is pressed for the second time:
597597 0. The screen containing the test summary should be restored.
598598 1. The cursor should be visible.
599599|]
600− , confirm_results = do
600+ , confirmResults = do
601601 putStr $ [s|
602602Did the test output match the description?
603603|]
604− default_success_confirm_results
604+ defaultSuccessConfirmResults
605605 }
606606
607−attributes_test_1 = Test
608− { test_name = "Character attributes: background colors."
609− , test_ID = "attributes_test_1"
610− , test_action = do
611− t <- output_for_current_terminal
612− reserve_display t
613− let pic = pic_for_image image
614− image = border <|> column_0 <|> border <|> column_1 <|> border
615− column_0 = vert_cat $ map line_with_color all_colors
616− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
617− column_1 = vert_cat $ map (string def_attr . snd) all_colors
618− line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name
619− d <- display_bounds t >>= display_context t
620− output_picture d pic
607+attributesTest1 = Test
608+ { testName = "Character attributes: background colors."
609+ , testID = "attributesTest1"
610+ , testAction = do
611+ t <- outputForCurrentTerminal
612+ reserveDisplay t
613+ let pic = picForImage image
614+ image = border <|> column0 <|> border <|> column1 <|> border
615+ column0 = vertCat $ map lineWithColor allColors
616+ border = vertCat $ replicate (length allColors) $ string defAttr " | "
617+ column1 = vertCat $ map (string defAttr . snd) allColors
618+ lineWithColor (c, cName) = string (defAttr `withBackColor` c) cName
619+ d <- displayBounds t >>= displayContext t
620+ outputPicture d pic
621621 getLine
622− release_display t
623− release_terminal t
622+ releaseDisplay t
623+ releaseTerminal t
624624 return ()
625− , print_summary = do
625+ , printSummary = do
626626 putStr $ [s|
627627Once return is pressed:
628628 0. The screen will be cleared.
@@ -652,34 +652,34 @@ After return is pressed for the second time:
652652 0. The screen containing the test summary should be restored.
653653 1. The cursor should be visible.
654654|]
655− , confirm_results = do
655+ , confirmResults = do
656656 putStr $ [s|
657657Did the test output match the description?
658658|]
659− default_success_confirm_results
659+ defaultSuccessConfirmResults
660660 }
661661
662−attributes_test_2 = Test
663− { test_name = "Character attributes: Vivid foreground colors."
664− , test_ID = "attributes_test_2"
665− , test_action = do
666− t <- output_for_current_terminal
667− reserve_display t
668− let pic = pic_for_image image
669− image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
670− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
671− column_0 = vert_cat $ map line_with_color_0 all_colors
672− column_1 = vert_cat $ map line_with_color_1 all_bright_colors
673− column_2 = vert_cat $ map (string def_attr . snd) all_colors
674− line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name
675− line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name
676− d <- display_bounds t >>= display_context t
677− output_picture d pic
662+attributesTest2 = Test
663+ { testName = "Character attributes: Vivid foreground colors."
664+ , testID = "attributesTest2"
665+ , testAction = do
666+ t <- outputForCurrentTerminal
667+ reserveDisplay t
668+ let pic = picForImage image
669+ image = horizCat [border, column0, border, column1, border, column2, border]
670+ border = vertCat $ replicate (length allColors) $ string defAttr " | "
671+ column0 = vertCat $ map lineWithColor0 allColors
672+ column1 = vertCat $ map lineWithColor1 allBrightColors
673+ column2 = vertCat $ map (string defAttr . snd) allColors
674+ lineWithColor0 (c, cName) = string (defAttr `withForeColor` c) cName
675+ lineWithColor1 (c, cName) = string (defAttr `withForeColor` c) cName
676+ d <- displayBounds t >>= displayContext t
677+ outputPicture d pic
678678 getLine
679− release_display t
680− release_terminal t
679+ releaseDisplay t
680+ releaseTerminal t
681681 return ()
682− , print_summary = do
682+ , printSummary = do
683683 putStr $ [s|
684684Once return is pressed:
685685 0. The screen will be cleared.
@@ -711,34 +711,34 @@ After return is pressed for the second time:
711711 0. The screen containing the test summary should be restored.
712712 1. The cursor should be visible.
713713|]
714− , confirm_results = do
714+ , confirmResults = do
715715 putStr $ [s|
716716Did the test output match the description?
717717|]
718− default_success_confirm_results
718+ defaultSuccessConfirmResults
719719 }
720720
721−attributes_test_3 = Test
722− { test_name = "Character attributes: Vivid background colors."
723− , test_ID = "attributes_test_3"
724− , test_action = do
725− t <- output_for_current_terminal
726− reserve_display t
727− let pic = pic_for_image image
728− image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
729− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
730− column_0 = vert_cat $ map line_with_color_0 all_colors
731− column_1 = vert_cat $ map line_with_color_1 all_bright_colors
732− column_2 = vert_cat $ map (string def_attr . snd) all_colors
733− line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name
734− line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name
735− d <- display_bounds t >>= display_context t
736− output_picture d pic
721+attributesTest3 = Test
722+ { testName = "Character attributes: Vivid background colors."
723+ , testID = "attributesTest3"
724+ , testAction = do
725+ t <- outputForCurrentTerminal
726+ reserveDisplay t
727+ let pic = picForImage image
728+ image = horizCat [border, column0, border, column1, border, column2, border]
729+ border = vertCat $ replicate (length allColors) $ string defAttr " | "
730+ column0 = vertCat $ map lineWithColor0 allColors
731+ column1 = vertCat $ map lineWithColor1 allBrightColors
732+ column2 = vertCat $ map (string defAttr . snd) allColors
733+ lineWithColor0 (c, cName) = string (defAttr `withBackColor` c) cName
734+ lineWithColor1 (c, cName) = string (defAttr `withBackColor` c) cName
735+ d <- displayBounds t >>= displayContext t
736+ outputPicture d pic
737737 getLine
738− release_display t
739− release_terminal t
738+ releaseDisplay t
739+ releaseTerminal t
740740 return ()
741− , print_summary = do
741+ , printSummary = do
742742 putStr $ [s|
743743Once return is pressed:
744744 0. The screen will be cleared.
@@ -778,43 +778,43 @@ After return is pressed for the second time:
778778 0. The screen containing the test summary should be restored.
779779 1. The cursor should be visible.
780780|]
781− , confirm_results = do
781+ , confirmResults = do
782782 putStr $ [s|
783783Did the test output match the description?
784784|]
785− default_success_confirm_results
785+ defaultSuccessConfirmResults
786786 }
787787
788−attr_combos =
788+attrCombos =
789789 [ ( "default", id )
790− , ( "bold", flip with_style bold )
791− , ( "blink", flip with_style blink )
792− , ( "underline", flip with_style underline )
793− , ( "bold + blink", flip with_style (bold + blink) )
794− , ( "bold + underline", flip with_style (bold + underline) )
795− , ( "underline + blink", flip with_style (underline + blink) )
796− , ( "bold + blink + underline", flip with_style (bold + blink + underline) )
790+ , ( "bold", flip withStyle bold )
791+ , ( "blink", flip withStyle blink )
792+ , ( "underline", flip withStyle underline )
793+ , ( "bold + blink", flip withStyle (bold + blink) )
794+ , ( "bold + underline", flip withStyle (bold + underline) )
795+ , ( "underline + blink", flip withStyle (underline + blink) )
796+ , ( "bold + blink + underline", flip withStyle (bold + blink + underline) )
797797 ]
798798
799−attributes_test_4 = Test
800− { test_name = "Character attributes: Bold; Blink; Underline."
801− , test_ID = "attributes_test_4"
802− , test_action = do
803− t <- output_for_current_terminal
804− reserve_display t
805− let pic = pic_for_image image
806− image = horiz_cat [border, column_0, border, column_1, border]
807− border = vert_cat $ replicate (length attr_combos) $ string def_attr " | "
808− column_0 = vert_cat $ map line_with_attrs attr_combos
809− column_1 = vert_cat $ map (string def_attr . fst) attr_combos
810− line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc
811− d <- display_bounds t >>= display_context t
812− output_picture d pic
799+attributesTest4 = Test
800+ { testName = "Character attributes: Bold; Blink; Underline."
801+ , testID = "attributesTest4"
802+ , testAction = do
803+ t <- outputForCurrentTerminal
804+ reserveDisplay t
805+ let pic = picForImage image
806+ image = horizCat [border, column0, border, column1, border]
807+ border = vertCat $ replicate (length attrCombos) $ string defAttr " | "
808+ column0 = vertCat $ map lineWithAttrs attrCombos
809+ column1 = vertCat $ map (string defAttr . fst) attrCombos
810+ lineWithAttrs (desc, attrF) = string (attrF defAttr) desc
811+ d <- displayBounds t >>= displayContext t
812+ outputPicture d pic
813813 getLine
814− release_display t
815− release_terminal t
814+ releaseDisplay t
815+ releaseTerminal t
816816 return ()
817− , print_summary = do
817+ , printSummary = do
818818 putStr $ [s|
819819Once return is pressed:
820820 0. The screen will be cleared.
@@ -841,31 +841,31 @@ After return is pressed for the second time:
841841 0. The screen containing the test summary should be restored.
842842 1. The cursor should be visible.
843843|]
844− , confirm_results = do
844+ , confirmResults = do
845845 putStr $ [s|
846846Did the test output match the description?
847847|]
848− default_success_confirm_results
848+ defaultSuccessConfirmResults
849849 }
850850
851−attributes_test_5 = Test
852− { test_name = "Character attributes: 240 color palette"
853− , test_ID = "attributes_test_5"
854− , test_action = do
855− t <- output_for_current_terminal
856− reserve_display t
857− let pic = pic_for_image image
858− image = vert_cat $ map horiz_cat $ split_color_images color_images
859− color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239]
860− split_color_images [] = []
861− split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is))
862− d <- display_bounds t >>= display_context t
863− output_picture d pic
851+attributesTest5 = Test
852+ { testName = "Character attributes: 240 color palette"
853+ , testID = "attributesTest5"
854+ , testAction = do
855+ t <- outputForCurrentTerminal
856+ reserveDisplay t
857+ let pic = picForImage image
858+ image = vertCat $ map horizCat $ splitColorImages colorImages
859+ colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]
860+ splitColorImages [] = []
861+ splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))
862+ d <- displayBounds t >>= displayContext t
863+ outputPicture d pic
864864 getLine
865− release_display t
866− release_terminal t
865+ releaseDisplay t
866+ releaseTerminal t
867867 return ()
868− , print_summary = do
868+ , printSummary = do
869869 putStr $ [s|
870870Once return is pressed:
871871 0. The screen will be cleared.
@@ -879,290 +879,290 @@ After return is pressed for the second time:
879879 0. The screen containing the test summary should be restored.
880880 1. The cursor should be visible.
881881|]
882− , confirm_results = do
882+ , confirmResults = do
883883 putStr $ [s|
884884Did the test output match the description?
885885|]
886− default_success_confirm_results
886+ defaultSuccessConfirmResults
887887 }
888888
889−inline_test_0 = Test
890− { test_name = "Verify styled output can be performed without clearing the screen."
891− , test_ID = "inline_test_0"
892− , test_action = do
889+inlineTest0 = Test
890+ { testName = "Verify styled output can be performed without clearing the screen."
891+ , testID = "inlineTest0"
892+ , testAction = do
893893 putStrLn "line 1."
894− put_attr_change_ $ back_color red >> apply_style underline
894+ putAttrChange_ $ backColor red >> applyStyle underline
895895 putStrLn "line 2."
896− put_attr_change_ $ default_all
896+ putAttrChange_ $ defaultAll
897897 putStrLn "line 3."
898− , print_summary = putStr $ [s|
898+ , printSummary = putStr $ [s|
899899lines are in order.
900900The second line "line 2" should have a red background and the text underline.
901901The third line "line 3" should be drawn in the same style as the first line.
902902|]
903903
904− , confirm_results = generic_output_match_confirm
904+ , confirmResults = genericOutputMatchConfirm
905905 }
906906
907−inline_test_1 = Test
908− { test_name = "Verify styled output can be performed without clearing the screen."
909− , test_ID = "inline_test_1"
910− , test_action = do
907+inlineTest1 = Test
908+ { testName = "Verify styled output can be performed without clearing the screen."
909+ , testID = "inlineTest1"
910+ , testAction = do
911911 putStr "Not styled. "
912− put_attr_change_ $ back_color red >> apply_style underline
912+ putAttrChange_ $ backColor red >> applyStyle underline
913913 putStr " Styled! "
914− put_attr_change_ $ default_all
914+ putAttrChange_ $ defaultAll
915915 putStrLn "Not styled."
916− , print_summary = putStr $ [s|
916+ , printSummary = putStr $ [s|
917917|]
918918
919− , confirm_results = generic_output_match_confirm
919+ , confirmResults = genericOutputMatchConfirm
920920 }
921921
922−inline_test_2 = Test
923− { test_name = "Verify styled output can be performed without clearing the screen."
924− , test_ID = "inline_test_1"
925− , test_action = do
922+inlineTest2 = Test
923+ { testName = "Verify styled output can be performed without clearing the screen."
924+ , testID = "inlineTest1"
925+ , testAction = do
926926 putStr "Not styled. "
927− put_attr_change_ $ back_color red >> apply_style underline
927+ putAttrChange_ $ backColor red >> applyStyle underline
928928 putStr " Styled! "
929− put_attr_change_ $ default_all
929+ putAttrChange_ $ defaultAll
930930 putStr "Not styled.\n"
931− , print_summary = putStr $ [s|
931+ , printSummary = putStr $ [s|
932932|]
933− , confirm_results = generic_output_match_confirm
933+ , confirmResults = genericOutputMatchConfirm
934934 }
935935
936−cursor_hide_test_0 :: Test
937−cursor_hide_test_0 = Test
938− { test_name = "Verify the cursor is hid and re-shown. issue #7"
939− , test_ID = "cursor_hide_test_0"
940− , test_action = do
936+cursorHideTest0 :: Test
937+cursorHideTest0 = Test
938+ { testName = "Verify the cursor is hid and re-shown. issue #7"
939+ , testID = "cursorHideTest0"
940+ , testAction = do
941941 vty <- mkVty def
942− show_cursor $ output_iface vty
943− set_cursor_pos (output_iface vty) 5 5
944− next_event vty
945− hide_cursor $ output_iface vty
946− next_event vty
942+ showCursor $ outputIface vty
943+ setCursorPos (outputIface vty) 5 5
944+ nextEvent vty
945+ hideCursor $ outputIface vty
946+ nextEvent vty
947947 shutdown vty
948948 return ()
949− , print_summary = putStr $ [s|
949+ , printSummary = putStr $ [s|
950950 1. verify the cursor is displayed.
951951 2. press enter
952952 3. verify the cursor is hid.
953953 4. press enter.
954954 5. the display should return to the state before the test.
955955|]
956− , confirm_results = generic_output_match_confirm
956+ , confirmResults = genericOutputMatchConfirm
957957 }
958958
959−output_image_and_wait :: Image -> IO ()
960−output_image_and_wait image = do
961− let pic = pic_for_image image
962− output_pic_and_wait pic
963−
964−output_pic_and_wait :: Picture -> IO ()
965−output_pic_and_wait pic = do
966− t <- output_for_current_terminal
967− reserve_display t
968− d <- display_bounds t >>= display_context t
969− output_picture d pic
959+outputImageAndWait :: Image -> IO ()
960+outputImageAndWait image = do
961+ let pic = picForImage image
962+ outputPicAndWait pic
963+
964+outputPicAndWait :: Picture -> IO ()
965+outputPicAndWait pic = do
966+ t <- outputForCurrentTerminal
967+ reserveDisplay t
968+ d <- displayBounds t >>= displayContext t
969+ outputPicture d pic
970970 getLine
971− release_display t
972− release_terminal t
971+ releaseDisplay t
972+ releaseTerminal t
973973 return ()
974974
975−vert_crop_test_0 :: Test
976−vert_crop_test_0 = Test
977− { test_name = "Verify bottom cropping works as expected with single column chars"
978− , test_ID = "crop_test_0"
979− , test_action = do
980− let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum
981− block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum
982− image = block_0 <-> background_fill 10 2 <-> block_1
983− output_image_and_wait image
984− , print_summary = putStr $ [s|
975+vertCropTest0 :: Test
976+vertCropTest0 = Test
977+ { testName = "Verify bottom cropping works as expected with single column chars"
978+ , testID = "crop_test_0"
979+ , testAction = do
980+ let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsum
981+ block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsum
982+ image = block0 <-> backgroundFill 10 2 <-> block1
983+ outputImageAndWait image
984+ , printSummary = putStr $ [s|
985985 1. Verify the two text blocks are identical.
986986 2. press enter.
987987 3. the display should return to the state before the test.
988988|]
989− , confirm_results = generic_output_match_confirm
989+ , confirmResults = genericOutputMatchConfirm
990990 }
991991
992−vert_crop_test_1 :: Test
993−vert_crop_test_1 = Test
994− { test_name = "Verify bottom cropping works as expected with double column chars"
995− , test_ID = "crop_test_0"
996− , test_action = do
997− let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
998− block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum_chinese
999− image = block_0 <-> background_fill 10 2 <-> block_1
1000− output_image_and_wait image
1001− , print_summary = putStr $ [s|
992+vertCropTest1 :: Test
993+vertCropTest1 = Test
994+ { testName = "Verify bottom cropping works as expected with double column chars"
995+ , testID = "crop_test_0"
996+ , testAction = do
997+ let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
998+ block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsumChinese
999+ image = block0 <-> backgroundFill 10 2 <-> block1
1000+ outputImageAndWait image
1001+ , printSummary = putStr $ [s|
10021002 1. Verify the two text blocks are identical.
10031003 2. press enter.
10041004 3. the display should return to the state before the test.
10051005|]
1006− , confirm_results = generic_output_match_confirm
1006+ , confirmResults = genericOutputMatchConfirm
10071007 }
10081008
1009−vert_crop_test_2 :: Test
1010−vert_crop_test_2 = Test
1011− { test_name = "Verify top cropping works as expected with single column chars"
1012− , test_ID = "crop_test_0"
1013− , test_action = do
1014− let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum
1015− block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum - 2) lorum_ipsum
1016− image = block_0 <-> background_fill 10 2 <-> block_1
1017− output_image_and_wait image
1018− , print_summary = putStr $ [s|
1009+vertCropTest2 :: Test
1010+vertCropTest2 = Test
1011+ { testName = "Verify top cropping works as expected with single column chars"
1012+ , testID = "crop_test_2"
1013+ , testAction = do
1014+ let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsum
1015+ block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsum - 2) lorumIpsum
1016+ image = block0 <-> backgroundFill 10 2 <-> block1
1017+ outputImageAndWait image
1018+ , printSummary = putStr $ [s|
10191019 1. Verify the two text blocks are identical.
10201020 2. press enter.
10211021 3. the display should return to the state before the test.
10221022|]
1023− , confirm_results = generic_output_match_confirm
1023+ , confirmResults = genericOutputMatchConfirm
10241024 }
10251025
1026−vert_crop_test_3 :: Test
1027−vert_crop_test_3 = Test
1028− { test_name = "Verify top cropping works as expected with double column chars"
1029− , test_ID = "crop_test_0"
1030− , test_action = do
1031− let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
1032− block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum_chinese - 2 ) lorum_ipsum_chinese
1033− image = block_0 <-> background_fill 10 2 <-> block_1
1034− output_image_and_wait image
1035− , print_summary = putStr $ [s|
1026+vertCropTest3 :: Test
1027+vertCropTest3 = Test
1028+ { testName = "Verify top cropping works as expected with double column chars"
1029+ , testID = "crop_test_0"
1030+ , testAction = do
1031+ let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
1032+ block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsumChinese - 2 ) lorumIpsumChinese
1033+ image = block0 <-> backgroundFill 10 2 <-> block1
1034+ outputImageAndWait image
1035+ , printSummary = putStr $ [s|
10361036 1. Verify the two text blocks are identical.
10371037 2. press enter.
10381038 3. the display should return to the state before the test.
10391039|]
1040− , confirm_results = generic_output_match_confirm
1040+ , confirmResults = genericOutputMatchConfirm
10411041 }
10421042
1043−horiz_crop_test_0 :: Test
1044−horiz_crop_test_0 = Test
1045− { test_name = "Verify right cropping works as expected with single column chars"
1046− , test_ID = "crop_test_0"
1047− , test_action = do
1048− let base_image = vert_cat $ map (string def_attr) lorum_ipsum
1049− cropped_image = crop_right (image_width base_image `div` 2) base_image
1050− image = base_image <-> background_fill 10 2 <-> cropped_image
1051− output_image_and_wait image
1052− , print_summary = putStr $ [s|
1043+horizCropTest0 :: Test
1044+horizCropTest0 = Test
1045+ { testName = "Verify right cropping works as expected with single column chars"
1046+ , testID = "crop_test_0"
1047+ , testAction = do
1048+ let baseImage = vertCat $ map (string defAttr) lorumIpsum
1049+ croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1050+ image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1051+ outputImageAndWait image
1052+ , printSummary = putStr $ [s|
10531053 1. Verify the bottom text block is about half the width of the top text block.
10541054 2. press enter.
10551055 3. the display should return to the state before the test.
10561056|]
1057− , confirm_results = generic_output_match_confirm
1057+ , confirmResults = genericOutputMatchConfirm
10581058 }
10591059
1060−horiz_crop_test_1 :: Test
1061−horiz_crop_test_1 = Test
1062− { test_name = "Verify right cropping works as expected with double column chars"
1063− , test_ID = "crop_test_0"
1064− , test_action = do
1065− let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1066− cropped_image = crop_right (image_width base_image `div` 2) base_image
1067− image = base_image <-> background_fill 10 2 <-> cropped_image
1068− output_image_and_wait image
1069− , print_summary = putStr $ [s|
1060+horizCropTest1 :: Test
1061+horizCropTest1 = Test
1062+ { testName = "Verify right cropping works as expected with double column chars"
1063+ , testID = "crop_test_0"
1064+ , testAction = do
1065+ let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1066+ croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1067+ image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1068+ outputImageAndWait image
1069+ , printSummary = putStr $ [s|
10701070 1. Verify the bottom text block is the left half of the top block. Ellipses on the right edge are OK.
10711071 2. press enter.
10721072 3. the display should return to the state before the test.
10731073|]
1074− , confirm_results = generic_output_match_confirm
1074+ , confirmResults = genericOutputMatchConfirm
10751075 }
10761076
1077−horiz_crop_test_2 :: Test
1078−horiz_crop_test_2 = Test
1079− { test_name = "Verify left cropping works as expected with single column chars"
1080− , test_ID = "crop_test_0"
1081− , test_action = do
1082− let base_image = vert_cat $ map (string def_attr) lorum_ipsum
1083− cropped_image = crop_left (image_width base_image `div` 2) base_image
1084− image = base_image <-> background_fill 10 2 <-> cropped_image
1085− output_image_and_wait image
1086− , print_summary = putStr $ [s|
1077+horizCropTest2 :: Test
1078+horizCropTest2 = Test
1079+ { testName = "Verify left cropping works as expected with single column chars"
1080+ , testID = "crop_test_0"
1081+ , testAction = do
1082+ let baseImage = vertCat $ map (string defAttr) lorumIpsum
1083+ croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1084+ image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1085+ outputImageAndWait image
1086+ , printSummary = putStr $ [s|
10871087 1. Verify the bottom text block is the right half of the top text block.
10881088 2. press enter.
10891089 3. the display should return to the state before the test.
10901090|]
1091− , confirm_results = generic_output_match_confirm
1091+ , confirmResults = genericOutputMatchConfirm
10921092 }
10931093
1094−horiz_crop_test_3 :: Test
1095−horiz_crop_test_3 = Test
1096− { test_name = "Verify right cropping works as expected with double column chars"
1097− , test_ID = "crop_test_0"
1098− , test_action = do
1099− let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1100− cropped_image = crop_left (image_width base_image `div` 2) base_image
1101− image = base_image <-> background_fill 10 2 <-> cropped_image
1102− output_image_and_wait image
1103− , print_summary = putStr $ [s|
1094+horizCropTest3 :: Test
1095+horizCropTest3 = Test
1096+ { testName = "Verify right cropping works as expected with double column chars"
1097+ , testID = "crop_test_0"
1098+ , testAction = do
1099+ let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1100+ croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1101+ image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1102+ outputImageAndWait image
1103+ , printSummary = putStr $ [s|
11041104 1. Verify the bottom text block is the right half of the top block. Ellipses on the left edge are OK.
11051105 2. press enter.
11061106 3. the display should return to the state before the test.
11071107|]
1108− , confirm_results = generic_output_match_confirm
1108+ , confirmResults = genericOutputMatchConfirm
11091109 }
11101110
1111−layer_0 :: Test
1112−layer_0 = Test
1113− { test_name = "verify layer 0"
1114− , test_ID = "layer_0"
1115− , test_action = do
1116− let upper_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1117− lower_image = vert_cat $ map (string def_attr) lorum_ipsum
1118− p = pic_for_layers [upper_image, lower_image]
1119− output_pic_and_wait p
1120− , print_summary = putStr $ [s|
1111+layer0 :: Test
1112+layer0 = Test
1113+ { testName = "verify layer 0"
1114+ , testID = "layer0"
1115+ , testAction = do
1116+ let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1117+ lowerImage = vertCat $ map (string defAttr) lorumIpsum
1118+ p = picForLayers [upperImage, lowerImage]
1119+ outputPicAndWait p
1120+ , printSummary = putStr $ [s|
11211121 1. Verify the text block appears to be Chinese text placed on top Latin text.
11221122 2. press enter.
11231123 3. the display should return to the state before the test.
11241124|]
1125− , confirm_results = generic_output_match_confirm
1125+ , confirmResults = genericOutputMatchConfirm
11261126 }
11271127
1128−layer_1 :: Test
1129−layer_1 = Test
1130− { test_name = "verify layer 1"
1131− , test_ID = "layer_1"
1132− , test_action = do
1133− let upper_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1134− block = resize 10 10 upper_image
1135− layer_0 = vert_cat $ map (string def_attr) lorum_ipsum
1136− layer_1 = char_fill (def_attr `with_back_color` blue) '#' 1000 1000
1137− cheesy_anim_0 block [layer_0, layer_1]
1138− , print_summary = putStr $ [s|
1128+layer1 :: Test
1129+layer1 = Test
1130+ { testName = "verify layer 1"
1131+ , testID = "layer1"
1132+ , testAction = do
1133+ let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1134+ block = resize 10 10 upperImage
1135+ layer0 = vertCat $ map (string defAttr) lorumIpsum
1136+ layer1 = charFill (defAttr `withBackColor` blue) '#' 1000 1000
1137+ cheesyAnim0 block [layer0, layer1]
1138+ , printSummary = putStr $ [s|
11391139 1. Verify the text block appears to be Chinese text moving on top a Latin text.
11401140 Which is all on a background of '#' characters over blue.
11411141 2. press enter.
11421142 3. the display should return to the state before the test.
11431143|]
1144− , confirm_results = generic_output_match_confirm
1144+ , confirmResults = genericOutputMatchConfirm
11451145 }
11461146
1147−cheesy_anim_0 :: Image -> [Image] -> IO ()
1148−cheesy_anim_0 i background = do
1149− t <- output_for_current_terminal
1150− reserve_display t
1151− bounds <- display_bounds t
1152− d <- display_context t bounds
1147+cheesyAnim0 :: Image -> [Image] -> IO ()
1148+cheesyAnim0 i background = do
1149+ t <- outputForCurrentTerminal
1150+ reserveDisplay t
1151+ bounds <- displayBounds t
1152+ d <- displayContext t bounds
11531153 forM_ [0..100] $ \t -> do
11541154 let i_offset = translate (t `mod` fst bounds)
11551155 (t `div` 2 `mod` snd bounds)
11561156 i
1157− let pic = pic_for_layers $ i_offset : background
1158− output_picture d pic
1157+ let pic = picForLayers $ i_offset : background
1158+ outputPicture d pic
11591159 threadDelay 50000
1160− release_display t
1161− release_terminal t
1160+ releaseDisplay t
1161+ releaseTerminal t
11621162 return ()
11631163
1164−lorum_ipsum :: [String]
1165−lorum_ipsum = lines [s|
1164+lorumIpsum :: [String]
1165+lorumIpsum = lines [s|
11661166Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium,
11671167totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae
11681168dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit,
@@ -1174,8 +1174,8 @@ commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate v
11741174molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
11751175|]
11761176
1177−lorum_ipsum_chinese :: [String]
1178−lorum_ipsum_chinese = lines [s|
1177+lorumIpsumChinese :: [String]
1178+lorumIpsumChinese = lines [s|
11791179輐銛 螷蟞覮 裌覅詵 暕 鴅噮 槶 惝掭掝 婸媥媕 耏胠臿, 汫汭沎 忕汌卣 蚡袀 僣 蒮 瀁瀎瀊 渮湸湤 緌翢,
11801180腠腶舝 糲蘥蠩 樏殣氀 蒮 蹢鎒 滍 鸄齴 櫧櫋瀩 鬄鵊鵙 莃荶衒, 毸溠 橀 簎艜薤 莃荶衒 翣聜蒢
11811181斔櫅檷 晛桼桾 拻敁柧 犿玒 膣, 墐 笓粊紒 bacon 鼀齕, 蔝蓶蓨 顊顃餭 姴怤 骱 暕 蹢鎒鎛 藒襓謥 鄻鎟霣