@@ -6,8 +6,7 @@ import Graphics.Vty
66import Graphics.Vty.Attributes
77import Graphics.Vty.Inline
88import Graphics.Vty.Picture
9−import Graphics.Vty.Terminal
10−import Graphics.Vty.DisplayRegion
9+import Graphics.Vty.Output
1110
1211import Control.Concurrent (threadDelay)
1312import Control.Exception
@@ -19,18 +18,18 @@ import Data.Monoid
1918import Data.String.QQ
2019import Data.Word
2120
22−import Foreign.Marshal.Array
21+import Foreign.Marshal.Array
2322
2423import qualified System.Environment as Env
2524
2625import System.IO ( hFlush, hPutStr, hPutBuf, stdout )
2726
2827main = do
29− print_intro
28+ printIntro
3029
31−output_file_path = "test_results.list"
30+outputFilePath = "test_results.list"
3231
33−print_intro = do
32+printIntro = do
3433 putStr $ [s|
3534This is an interactive verification program for the terminal input and output
3635support of the VTY library. This will ask a series of questions about what you
@@ -38,7 +37,7 @@ see on screen. The goal is to verify that VTY's output and input support
3837performs as expected with your terminal.
3938
4039This program produces a file named
41− |] ++ output_file_path ++ [s|
40+ |] ++ outputFilePath ++ [s|
4241in the current directory that contains the results for each test assertion. This
4342can be emailed to coreyoconnor@gmail.com and used by the VTY authors to improve
4443support for your terminal. No personal information is contained in the report.
@@ -67,41 +66,40 @@ All the tests assume the following about the terminal display:
6766Thanks for the help! :-D
6867To exit the test early enter "q" anytime at the following menu screen.
6968
70−If any test failed then please post an issue to
69+If any test fails then please post an issue to
7170 https://github.com/coreyoconnor/vty/issues
72−with the test_results.list file pasted into the issue. The issue summary can
73−mention the specific tests that failed or just say "interactive terminal test
74−failure".
71+with the test_results.list file pasted into the issue. A suitable summary is:
72+"interactive terminal test failure".
7573|]
76− wait_for_return
77− results <- do_test_menu 1
78− env_attributes <- mapM ( \env_name -> Control.Exception.catch ( Env.getEnv env_name >>= return . (,) env_name )
79− ( \ (_ :: SomeException) -> return (env_name, "") )
80− )
81− [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
82− t <- current_terminal
83− let results_txt = show env_attributes ++ "\n"
84− ++ terminal_ID t ++ "\n"
85− ++ show results ++ "\n"
86− release_terminal t
87− writeFile output_file_path results_txt
88−
89−wait_for_return = do
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
9088 putStr "\n(press return to continue)"
9189 hFlush stdout
9290 getLine
9391
94−test_menu :: [(String, Test)]
95−test_menu = zip (map show [1..]) all_tests
92+testMenu :: [(String, Test)]
93+testMenu = zip (map show [1..]) allTests
9694
97−do_test_menu :: Int -> IO [(String, Bool)]
98−do_test_menu next_ID
99− | next_ID > length all_tests = do
100− putStrLn $ "Done! Please email the " ++ output_file_path ++ " file to coreyoconnor@gmail.com"
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"
10199 return []
102100 | otherwise = do
103− display_test_menu
104− putStrLn $ "Press return to start with #" ++ show next_ID ++ "."
101+ displayTestMenu
102+ putStrLn $ "Press return to start with #" ++ show nextID ++ "."
105103 putStrLn "Enter a test number to perform only that test."
106104 putStrLn "q (or control-C) to quit."
107105 putStr "> "
@@ -109,102 +107,102 @@ do_test_menu next_ID
109107 s <- getLine >>= return . filter (/= '\n')
110108 case s of
111109 "q" -> return mempty
112− "" -> do
113− r <- run_test $ show next_ID
114− rs <- do_test_menu ( next_ID + 1 )
110+ "" -> do
111+ r <- runTest $ show nextID
112+ rs <- doTestMenu ( nextID + 1 )
115113 return $ r : rs
116− i | isJust ( lookup i test_menu ) -> do
117− r <- run_test i
118− rs <- do_test_menu ( read i + 1 )
114+ i | isJust ( lookup i testMenu ) -> do
115+ r <- runTest i
116+ rs <- doTestMenu ( read i + 1 )
119117 return $ r : rs
120118 where
121− display_test_menu
122− = mapM_ display_test_menu' test_menu
123− display_test_menu' ( i, t )
124− = putStrLn $ ( if i == show next_ID
125− then "> "
119+ displayTestMenu
120+ = mapM_ displayTestMenu' testMenu
121+ displayTestMenu' ( i, t )
122+ = putStrLn $ ( if i == show nextID
123+ then "> "
126124 else " "
127− ) ++ i ++ ". " ++ test_name t
128−
129−run_test :: String -> IO (String, Bool)
130−run_test i = do
131− let t = fromJust $ lookup i test_menu
132− print_summary t
133− wait_for_return
134− test_action t
135− r <- confirm_results t
136− return (test_ID t, r)
137−
138−default_success_confirm_results = do
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
139137 putStr "\n"
140138 putStr "[Y/n] "
141139 hFlush stdout
142140 r <- getLine
143141 case r of
144− "" -> return True
142+ "" -> return True
145143 "y" -> return True
146144 "Y" -> return True
147145 "n" -> return False
148146
149147data Test = Test
150− { test_name :: String
151− , test_ID :: String
152− , test_action :: IO ()
153− , print_summary :: IO ()
154− , confirm_results :: IO Bool
148+ { testName :: String
149+ , testID :: String
150+ , testAction :: IO ()
151+ , printSummary :: IO ()
152+ , confirmResults :: IO Bool
155153 }
156154
157−all_tests
158− = [ reserve_output_test
159− , display_bounds_test_0
160− , display_bounds_test_1
161− , display_bounds_test_2
162− , display_bounds_test_3
163− , unicode_single_width_0
164− , unicode_single_width_1
165− , unicode_double_width_0
166− , unicode_double_width_1
167− , attributes_test_0
168− , attributes_test_1
169− , attributes_test_2
170− , attributes_test_3
171− , attributes_test_4
172− , attributes_test_5
173− , inline_test_0
174− , inline_test_1
175− , inline_test_2
176− , cursor_hide_test_0
177− , vert_crop_test_0
178− , vert_crop_test_1
179− , vert_crop_test_2
180− , vert_crop_test_3
181− , horiz_crop_test_0
182− , horiz_crop_test_1
183− , horiz_crop_test_2
184− , horiz_crop_test_3
185− , layer_0
186− , layer_1
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
187185 ]
188186
189−reserve_output_test = Test
190− { test_name = "Initialize and reserve terminal output then restore previous state."
191− , test_ID = "reserve_output_test"
192− , test_action = do
193− t <- current_terminal
194− reserve_display t
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
195193 putStrLn "Line 1"
196194 putStrLn "Line 2"
197195 putStrLn "Line 3"
198196 putStrLn "Line 4 (press return)"
199197 hFlush stdout
200198 getLine
201− release_display t
202− release_terminal t
199+ releaseDisplay t
200+ releaseTerminal t
203201 return ()
204− , print_summary = do
202+ , printSummary = do
205203 putStr $ [s|
206204Once return is pressed:
207− 0. The screen will be cleared.
205+ 0. The screen will be cleared.
208206 1. Four lines of text should be visible.
209207 1. The cursor should be visible and at the start of the fifth line.
210208
@@ -212,123 +210,123 @@ After return is pressed for the second time this test then:
212210 * The screen containing the test summary should be restored;
213211 * The cursor is visible.
214212|]
215− , confirm_results = do
213+ , confirmResults = do
216214 putStr $ [s|
217215Did the test output match the description?
218216|]
219− default_success_confirm_results
217+ defaultSuccessConfirmResults
220218 }
221219
222−display_bounds_test_0 = Test
223− { test_name = "Verify display bounds are correct test 0: Using spaces."
224− , test_ID = "display_bounds_test_0"
225− , test_action = do
226− t <- current_terminal
227− reserve_display t
228− DisplayRegion w h <- display_bounds t
229− let row_0 = replicate (fromEnum w) 'X' ++ "\n"
230− row_h = replicate (fromEnum w - 1) 'X'
231− row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
232− image = row_0 ++ (concat $ replicate (fromEnum h - 2) row_n) ++ row_h
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
233231 putStr image
234232 hFlush stdout
235233 getLine
236− release_display t
237− release_terminal t
234+ releaseDisplay t
235+ releaseTerminal t
238236 return ()
239− , print_summary = display_bounds_test_summary True
240− , confirm_results = generic_output_match_confirm
237+ , printSummary = displayBoundsTestSummary True
238+ , confirmResults = genericOutputMatchConfirm
241239 }
242240
243−display_bounds_test_1 = Test
244− { test_name = "Verify display bounds are correct test 0: Using cursor movement."
245− , test_ID = "display_bounds_test_1"
246− , test_action = do
247− t <- current_terminal
248− reserve_display t
249− DisplayRegion w h <- display_bounds t
250− set_cursor_pos t 0 0
251− let row_0 = replicate (fromEnum w) 'X' ++ "\n"
252− putStr row_0
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
253251 forM_ [1 .. h - 2] $ \y -> do
254− set_cursor_pos t 0 y
252+ setCursorPos t 0 y
255253 putStr "X"
256254 hFlush stdout
257− set_cursor_pos t (w - 1) y
255+ setCursorPos t (w - 1) y
258256 putStr "X"
259257 hFlush stdout
260− set_cursor_pos t 0 (h - 1)
261− let row_h = replicate (fromEnum w - 1) 'X'
262− putStr row_h
258+ setCursorPos t 0 (h - 1)
259+ let rowH = replicate (fromEnum w - 1) 'X'
260+ putStr rowH
263261 hFlush stdout
264262 getLine
265− release_display t
266− release_terminal t
263+ releaseDisplay t
264+ releaseTerminal t
267265 return ()
268− , print_summary = display_bounds_test_summary True
269− , confirm_results = generic_output_match_confirm
266+ , printSummary = displayBoundsTestSummary True
267+ , confirmResults = genericOutputMatchConfirm
270268 }
271269
272−display_bounds_test_2 = Test
273− { test_name = "Verify display bounds are correct test 0: Using Image ops."
274− , test_ID = "display_bounds_test_2"
275− , test_action = do
276− t <- current_terminal
277− reserve_display t
278− bounds@(DisplayRegion w h) <- display_bounds t
279− let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')
280− middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row
281− middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')
282− end_row = first_row
283− image = first_row <-> middle_rows <-> end_row
284− pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) }
285− d <- display_context t bounds
286− output_picture d pic
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
287285 getLine
288− release_display t
289− release_terminal t
286+ releaseDisplay t
287+ releaseTerminal t
290288 return ()
291− , print_summary = display_bounds_test_summary True
292− , confirm_results = generic_output_match_confirm
289+ , printSummary = displayBoundsTestSummary True
290+ , confirmResults = genericOutputMatchConfirm
293291 }
294292
295−display_bounds_test_3 = Test
296− { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
297− , test_ID = "display_bounds_test_3"
298− , test_action = do
299− t <- current_terminal
300− reserve_display t
301− DisplayRegion w h <- display_bounds t
302− hide_cursor t
303− set_cursor_pos t 0 0
304− let row_0 = replicate (fromEnum w) 'X'
305− putStrLn row_0
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
306304 forM_ [1 .. h - 2] $ \y -> do
307− set_cursor_pos t 0 y
305+ setCursorPos t 0 y
308306 putStr "X"
309307 hFlush stdout
310− set_cursor_pos t (w - 1) y
308+ setCursorPos t (w - 1) y
311309 putStr "X"
312310 hFlush stdout
313− set_cursor_pos t 0 (h - 1)
314− let row_h = row_0
315− putStr row_h
311+ setCursorPos t 0 (h - 1)
312+ let rowH = row0
313+ putStr rowH
316314 hFlush stdout
317315 getLine
318− show_cursor t
319− release_display t
320− release_terminal t
316+ showCursor t
317+ releaseDisplay t
318+ releaseTerminal t
321319 return ()
322− , print_summary = display_bounds_test_summary False
323− , confirm_results = generic_output_match_confirm
320+ , printSummary = displayBoundsTestSummary False
321+ , confirmResults = genericOutputMatchConfirm
324322 }
325323
326−display_bounds_test_summary has_cursor = do
324+displayBoundsTestSummary hasCursor = do
327325 putStr $ [s|
328326Once return is pressed:
329327 0. The screen will be cleared.
330328|]
331− if has_cursor
329+ if hasCursor
332330 then putStr " 1. The cursor will be visible."
333331 else putStr " 1. The cursor will NOT be visible."
334332 putStr [s|
@@ -339,7 +337,7 @@ Once return is pressed:
339337 |XXXXXXXXXXXXX|
340338 |X X||]
341339
342− if has_cursor
340+ if hasCursor
343341 then putStr $ [s|
344342
345343 |XXXXXXXXXXXXC| |]
@@ -360,13 +358,13 @@ After return is pressed for the second time:
360358 1. The cursor should be visible.
361359|]
362360
363−generic_output_match_confirm = do
361+genericOutputMatchConfirm = do
364362 putStr $ [s|
365363Did the test output match the description?
366364|]
367− default_success_confirm_results
365+ defaultSuccessConfirmResults
368366
369−-- Explicitely definethe bytes that encode each example text.
367+-- Explicitly define the bytes that encode each example text.
370368-- This avoids any issues with how the compiler represents string literals.
371369--
372370-- This document is UTF-8 encoded so the UTF-8 string is still included for
@@ -375,24 +373,24 @@ Did the test output match the description?
375373-- It's assumed the compiler will at least not barf on UTF-8 encoded text in
376374-- comments ;-)
377375--
378−-- txt_0 = ↑↑↓↓←→←→BA
379−
380−utf8_txt_0 :: [[Word8]]
381−utf8_txt_0 = [ [ 0xe2 , 0x86 , 0x91 ]
382− , [ 0xe2 , 0x86 , 0x91 ]
383− , [ 0xe2 , 0x86 , 0x93 ]
384− , [ 0xe2 , 0x86 , 0x93 ]
385− , [ 0xe2 , 0x86 , 0x90 ]
386− , [ 0xe2 , 0x86 , 0x92 ]
387− , [ 0xe2 , 0x86 , 0x90 ]
388− , [ 0xe2 , 0x86 , 0x92 ]
389− , [ 0x42 ]
390− , [ 0x41 ]
391− ]
392−
393−iso_10646_txt_0 :: String
394−iso_10646_txt_0 = map toEnum
395− [ 8593
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
396394 , 8593
397395 , 8595
398396 , 8595
@@ -404,46 +402,46 @@ iso_10646_txt_0 = map toEnum
404402 , 65
405403 ]
406404
407−unicode_single_width_0 = Test
408− { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
409− , test_ID = "unicode_single_width_0"
410− , test_action = do
411− t <- current_terminal
412− reserve_display t
413− hide_cursor t
414− withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout)
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)
415413 hPutStr stdout "\n"
416414 hPutStr stdout "0123456789\n"
417415 hFlush stdout
418416 getLine
419− release_display t
420− release_terminal t
417+ releaseDisplay t
418+ releaseTerminal t
421419 return ()
422− , print_summary = unicode_single_width_summary
423− , confirm_results = generic_output_match_confirm
420+ , printSummary = unicodeSingleWidthSummary
421+ , confirmResults = genericOutputMatchConfirm
424422 }
425423
426−unicode_single_width_1 = Test
427− { test_name = "Verify terminal can display unicode single-width characters. (Image ops)"
428− , test_ID = "unicode_single_width_1"
429− , test_action = do
430− t <- current_terminal
431− reserve_display t
432− let pic = pic_for_image image
433− image = line_0 <-> line_1
434− line_0 = iso_10646_string def_attr iso_10646_txt_0
435− line_1 = string def_attr "0123456789"
436− d <- display_bounds t >>= display_context t
437− output_picture d pic
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
438436 getLine
439− release_display t
440− release_terminal t
437+ releaseDisplay t
438+ releaseTerminal t
441439 return ()
442− , print_summary = unicode_single_width_summary
443− , confirm_results = generic_output_match_confirm
440+ , printSummary = unicodeSingleWidthSummary
441+ , confirmResults = genericOutputMatchConfirm
444442 }
445443
446−unicode_single_width_summary = putStr [s|
444+unicodeSingleWidthSummary = putStr [s|
447445Once return is pressed:
448446 0. The screen will be cleared.
449447 1. The cursor will be hidden.
@@ -477,55 +475,55 @@ After return is pressed for the second time:
477475
478476-- The second example is a unicode string containing double-width glyphs
479477-- 你好吗
480−utf8_txt_1 :: [[Word8]]
481−utf8_txt_1 = [ [0xe4,0xbd,0xa0]
482− , [0xe5,0xa5,0xbd]
483− , [0xe5,0x90,0x97]
484− ]
485−
486−iso_10646_txt_1 :: String
487−iso_10646_txt_1 = map toEnum [20320,22909,21527]
488−
489−unicode_double_width_0 = Test
490− { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
491− , test_ID = "unicode_double_width_0"
492− , test_action = do
493− t <- current_terminal
494− reserve_display t
495− hide_cursor t
496− withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout)
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)
497495 hPutStr stdout "\n"
498496 hPutStr stdout "012345\n"
499497 hFlush stdout
500498 getLine
501− release_display t
502− release_terminal t
499+ releaseDisplay t
500+ releaseTerminal t
503501 return ()
504− , print_summary = unicode_double_width_summary
505− , confirm_results = generic_output_match_confirm
502+ , printSummary = unicodeDoubleWidthSummary
503+ , confirmResults = genericOutputMatchConfirm
506504 }
507505
508−unicode_double_width_1 = Test
509− { test_name = "Verify terminal can display unicode double-width characters. (Image ops)"
510− , test_ID = "unicode_double_width_1"
511− , test_action = do
512− t <- current_terminal
513− reserve_display t
514− let pic = pic_for_image image
515− image = line_0 <-> line_1
516− line_0 = iso_10646_string def_attr iso_10646_txt_1
517− line_1 = string def_attr "012345"
518− d <- display_bounds t >>= display_context t
519− output_picture d pic
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
520518 getLine
521− release_display t
522− release_terminal t
519+ releaseDisplay t
520+ releaseTerminal t
523521 return ()
524− , print_summary = unicode_double_width_summary
525− , confirm_results = generic_output_match_confirm
522+ , printSummary = unicodeDoubleWidthSummary
523+ , confirmResults = genericOutputMatchConfirm
526524 }
527525
528−unicode_double_width_summary = putStr [s|
526+unicodeDoubleWidthSummary = putStr [s|
529527Once return is pressed:
530528 0. The screen will be cleared.
531529 1. The cursor will be hidden.
@@ -552,32 +550,32 @@ After return is pressed for the second time:
552550 1. The cursor should be visible.
553551|]
554552
555−all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
556− [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
553+allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
554+ [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
557555
558−all_bright_colors
559− = zip [ bright_black, bright_red, bright_green, bright_yellow, bright_blue, bright_magenta, bright_cyan, bright_white ]
556+allBrightColors
557+ = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]
560558 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]
561559
562−attributes_test_0 = Test
563− { test_name = "Character attributes: foreground colors."
564− , test_ID = "attributes_test_0"
565− , test_action = do
566− t <- current_terminal
567− reserve_display t
568− let pic = pic_for_image image
569− image = border <|> column_0 <|> border <|> column_1 <|> border
570− column_0 = vert_cat $ map line_with_color all_colors
571− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
572− column_1 = vert_cat $ map (string def_attr . snd) all_colors
573− line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name
574− d <- display_bounds t >>= display_context t
575− output_picture d pic
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
576574 getLine
577− release_display t
578− release_terminal t
575+ releaseDisplay t
576+ releaseTerminal t
579577 return ()
580− , print_summary = do
578+ , printSummary = do
581579 putStr $ [s|
582580Once return is pressed:
583581 0. The screen will be cleared.
@@ -598,32 +596,32 @@ After return is pressed for the second time:
598596 0. The screen containing the test summary should be restored.
599597 1. The cursor should be visible.
600598|]
601− , confirm_results = do
599+ , confirmResults = do
602600 putStr $ [s|
603601Did the test output match the description?
604602|]
605− default_success_confirm_results
603+ defaultSuccessConfirmResults
606604 }
607605
608−attributes_test_1 = Test
609− { test_name = "Character attributes: background colors."
610− , test_ID = "attributes_test_1"
611− , test_action = do
612− t <- current_terminal
613− reserve_display t
614− let pic = pic_for_image image
615− image = border <|> column_0 <|> border <|> column_1 <|> border
616− column_0 = vert_cat $ map line_with_color all_colors
617− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
618− column_1 = vert_cat $ map (string def_attr . snd) all_colors
619− line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name
620− d <- display_bounds t >>= display_context t
621− output_picture d pic
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
622620 getLine
623− release_display t
624− release_terminal t
621+ releaseDisplay t
622+ releaseTerminal t
625623 return ()
626− , print_summary = do
624+ , printSummary = do
627625 putStr $ [s|
628626Once return is pressed:
629627 0. The screen will be cleared.
@@ -653,57 +651,57 @@ After return is pressed for the second time:
653651 0. The screen containing the test summary should be restored.
654652 1. The cursor should be visible.
655653|]
656− , confirm_results = do
654+ , confirmResults = do
657655 putStr $ [s|
658656Did the test output match the description?
659657|]
660− default_success_confirm_results
658+ defaultSuccessConfirmResults
661659 }
662660
663−attributes_test_2 = Test
664− { test_name = "Character attributes: Vivid foreground colors."
665− , test_ID = "attributes_test_2"
666− , test_action = do
667− t <- current_terminal
668− reserve_display t
669− let pic = pic_for_image image
670− image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
671− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
672− column_0 = vert_cat $ map line_with_color_0 all_colors
673− column_1 = vert_cat $ map line_with_color_1 all_bright_colors
674− column_2 = vert_cat $ map (string def_attr . snd) all_colors
675− line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name
676− line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name
677− d <- display_bounds t >>= display_context t
678− output_picture d pic
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
679677 getLine
680− release_display t
681− release_terminal t
678+ releaseDisplay t
679+ releaseTerminal t
682680 return ()
683− , print_summary = do
681+ , printSummary = do
684682 putStr $ [s|
685683Once return is pressed:
686684 0. The screen will be cleared.
687685 1. The cursor will be hidden.
688686 2. 9 lines of text in three columns will be drawn:
689687 a. The first column will be a name of a standard color (for an 8 color
690− terminal) rendered with that color as the foreground color.
688+ terminal) rendered with that color as the foreground color.
691689 b. The next column will be also be the name of a standard color rendered
692690 with that color as the foreground color but the shade used should be
693− more vivid than the shade used in the first column.
691+ more vivid than the shade used in the first column.
694692 c. The final column will be the name of a color rendered with the
695693 default attributes.
696694
697695For instance, one line will be the word "magenta" and that word should be
698−rendered in the magenta color.
696+rendered in the magenta color.
699697
700698I'm not actually sure exactly what "vivid" means in this context. For xterm the
701−vivid colors are brighter.
699+vivid colors are brighter.
702700
703−Verify:
701+Verify:
704702 * The first column: The foreground color matches the named color.
705703 * The second column: The foreground color matches the named color but is
706− more vivid than the color used in the first column.
704+ more vivid than the color used in the first column.
707705 * The third column: All text is rendered with the default attributes.
708706 * The vertical bars used in each line to mark the border of a column are
709707 lined up.
@@ -712,34 +710,34 @@ After return is pressed for the second time:
712710 0. The screen containing the test summary should be restored.
713711 1. The cursor should be visible.
714712|]
715− , confirm_results = do
713+ , confirmResults = do
716714 putStr $ [s|
717715Did the test output match the description?
718716|]
719− default_success_confirm_results
717+ defaultSuccessConfirmResults
720718 }
721719
722−attributes_test_3 = Test
723− { test_name = "Character attributes: Vivid background colors."
724− , test_ID = "attributes_test_3"
725− , test_action = do
726− t <- current_terminal
727− reserve_display t
728− let pic = pic_for_image image
729− image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
730− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
731− column_0 = vert_cat $ map line_with_color_0 all_colors
732− column_1 = vert_cat $ map line_with_color_1 all_bright_colors
733− column_2 = vert_cat $ map (string def_attr . snd) all_colors
734− line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name
735− line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name
736− d <- display_bounds t >>= display_context t
737− output_picture d pic
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
738736 getLine
739− release_display t
740− release_terminal t
737+ releaseDisplay t
738+ releaseTerminal t
741739 return ()
742− , print_summary = do
740+ , printSummary = do
743741 putStr $ [s|
744742Once return is pressed:
745743 0. The screen will be cleared.
@@ -747,23 +745,23 @@ Once return is pressed:
747745 2. 9 lines of text in three columns will be drawn:
748746 a. The first column will contain be a name of a standard color for an 8
749747 color terminal rendered with the default foreground color with a
750− background the named color.
748+ background the named color.
751749 b. The first column will contain be a name of a standard color for an 8
752750 color terminal rendered with the default foreground color with the
753− background a vivid version of the named color.
751+ background a vivid version of the named color.
754752 c. The third column will be the name of a standard color rendered with
755753 the default attributes.
756−
754+
757755For instance, one line will contain be the word "magenta" and the word should
758−be rendered in the default foreground color over a magenta background.
756+be rendered in the default foreground color over a magenta background.
759757
760758I'm not actually sure exactly what "vivid" means in this context. For xterm the
761759vivid colors are brighter.
762760
763−Verify:
761+Verify:
764762 * The first column: The background color matches the named color.
765763 * The second column: The background color matches the named color and is
766− more vivid than the color used in the first column.
764+ more vivid than the color used in the first column.
767765 * The third column column: All text is rendered with the default attributes.
768766 * The vertical bars used in each line to mark the border of a column are
769767 lined up.
@@ -779,51 +777,51 @@ After return is pressed for the second time:
779777 0. The screen containing the test summary should be restored.
780778 1. The cursor should be visible.
781779|]
782− , confirm_results = do
780+ , confirmResults = do
783781 putStr $ [s|
784782Did the test output match the description?
785783|]
786− default_success_confirm_results
784+ defaultSuccessConfirmResults
787785 }
788786
789−attr_combos =
787+attrCombos =
790788 [ ( "default", id )
791− , ( "bold", flip with_style bold )
792− , ( "blink", flip with_style blink )
793− , ( "underline", flip with_style underline )
794− , ( "bold + blink", flip with_style (bold + blink) )
795− , ( "bold + underline", flip with_style (bold + underline) )
796− , ( "underline + blink", flip with_style (underline + blink) )
797− , ( "bold + blink + underline", flip with_style (bold + blink + underline) )
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) )
798796 ]
799797
800−attributes_test_4 = Test
801− { test_name = "Character attributes: Bold; Blink; Underline."
802− , test_ID = "attributes_test_4"
803− , test_action = do
804− t <- current_terminal
805− reserve_display t
806− let pic = pic_for_image image
807− image = horiz_cat [border, column_0, border, column_1, border]
808− border = vert_cat $ replicate (length attr_combos) $ string def_attr " | "
809− column_0 = vert_cat $ map line_with_attrs attr_combos
810− column_1 = vert_cat $ map (string def_attr . fst) attr_combos
811− line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc
812− d <- display_bounds t >>= display_context t
813− output_picture d pic
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
814812 getLine
815− release_display t
816− release_terminal t
813+ releaseDisplay t
814+ releaseTerminal t
817815 return ()
818− , print_summary = do
816+ , printSummary = do
819817 putStr $ [s|
820818Once return is pressed:
821819 0. The screen will be cleared.
822820 1. The cursor will be hidden.
823− 2. 8 rows of text in two columns.
821+ 2. 8 rows of text in two columns.
824822 The rows will contain the following text:
825823 default
826− bold
824+ bold
827825 blink
828826 underline
829827 bold + blink
@@ -832,8 +830,8 @@ Once return is pressed:
832830 bold + blink + underline
833831 The first column will be rendered with the described attributes. The second
834832 column will be rendered with the default attributes.
835−
836−Verify:
833+
834+Verify:
837835 * The vertical bars used in each line to mark the border of a column are
838836 lined up.
839837 * The text in the first column is rendered as described.
@@ -842,31 +840,31 @@ After return is pressed for the second time:
842840 0. The screen containing the test summary should be restored.
843841 1. The cursor should be visible.
844842|]
845− , confirm_results = do
843+ , confirmResults = do
846844 putStr $ [s|
847845Did the test output match the description?
848846|]
849− default_success_confirm_results
847+ defaultSuccessConfirmResults
850848 }
851849
852−attributes_test_5 = Test
853− { test_name = "Character attributes: 240 color palette"
854− , test_ID = "attributes_test_5"
855− , test_action = do
856− t <- current_terminal
857− reserve_display t
858− let pic = pic_for_image image
859− image = vert_cat $ map horiz_cat $ split_color_images color_images
860− color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239]
861− split_color_images [] = []
862− split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is))
863− d <- display_bounds t >>= display_context t
864− output_picture d pic
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
865863 getLine
866− release_display t
867− release_terminal t
864+ releaseDisplay t
865+ releaseTerminal t
868866 return ()
869− , print_summary = do
867+ , printSummary = do
870868 putStr $ [s|
871869Once return is pressed:
872870 0. The screen will be cleared.
@@ -874,296 +872,304 @@ Once return is pressed:
874872 2. A 20 character wide and 12 row high block of color squares. This should look like a palette
875873 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...
876874
877−Verify:
875+Verify:
878876
879877After return is pressed for the second time:
880878 0. The screen containing the test summary should be restored.
881879 1. The cursor should be visible.
882880|]
883− , confirm_results = do
881+ , confirmResults = do
884882 putStr $ [s|
885883Did the test output match the description?
886884|]
887− default_success_confirm_results
885+ defaultSuccessConfirmResults
888886 }
889887
890−inline_test_0 = Test
891− { test_name = "Verify styled output can be performed without clearing the screen."
892− , test_ID = "inline_test_0"
893− , test_action = do
888+inlineTest0 = Test
889+ { testName = "Verify styled output can be performed without clearing the screen."
890+ , testID = "inlineTest0"
891+ , testAction = do
894892 putStrLn "line 1."
895− put_attr_change_ $ back_color red >> apply_style underline
893+ putAttrChange_ $ backColor red >> applyStyle underline
896894 putStrLn "line 2."
897− put_attr_change_ $ default_all
895+ putAttrChange_ $ defaultAll
898896 putStrLn "line 3."
899− , print_summary = putStr $ [s|
897+ , printSummary = putStr $ [s|
900898lines are in order.
901899The second line "line 2" should have a red background and the text underline.
902900The third line "line 3" should be drawn in the same style as the first line.
903901|]
904902
905− , confirm_results = generic_output_match_confirm
903+ , confirmResults = genericOutputMatchConfirm
906904 }
907905
908−inline_test_1 = Test
909− { test_name = "Verify styled output can be performed without clearing the screen."
910− , test_ID = "inline_test_1"
911− , test_action = do
906+inlineTest1 = Test
907+ { testName = "Verify styled output can be performed without clearing the screen."
908+ , testID = "inlineTest1"
909+ , testAction = do
912910 putStr "Not styled. "
913− put_attr_change_ $ back_color red >> apply_style underline
911+ putAttrChange_ $ backColor red >> applyStyle underline
914912 putStr " Styled! "
915− put_attr_change_ $ default_all
913+ putAttrChange_ $ defaultAll
916914 putStrLn "Not styled."
917− , print_summary = putStr $ [s|
915+ , printSummary = putStr $ [s|
918916|]
919917
920− , confirm_results = generic_output_match_confirm
918+ , confirmResults = genericOutputMatchConfirm
921919 }
922920
923−inline_test_2 = Test
924− { test_name = "Verify styled output can be performed without clearing the screen."
925− , test_ID = "inline_test_1"
926− , test_action = do
921+inlineTest2 = Test
922+ { testName = "Verify styled output can be performed without clearing the screen."
923+ , testID = "inlineTest1"
924+ , testAction = do
927925 putStr "Not styled. "
928− put_attr_change_ $ back_color red >> apply_style underline
926+ putAttrChange_ $ backColor red >> applyStyle underline
929927 putStr " Styled! "
930− put_attr_change_ $ default_all
928+ putAttrChange_ $ defaultAll
931929 putStr "Not styled.\n"
932− , print_summary = putStr $ [s|
930+ , printSummary = putStr $ [s|
933931|]
934− , confirm_results = generic_output_match_confirm
932+ , confirmResults = genericOutputMatchConfirm
935933 }
936934
937−cursor_hide_test_0 :: Test
938−cursor_hide_test_0 = Test
939− { test_name = "Verify the cursor is hid and re-shown. issue #7"
940− , test_ID = "cursor_hide_test_0"
941− , test_action = do
942− vty <- mkVty
943− show_cursor $ terminal vty
944− set_cursor_pos (terminal vty) 5 5
945− next_event vty
946− hide_cursor $ terminal vty
947− next_event vty
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
948946 shutdown vty
949947 return ()
950− , print_summary = putStr $ [s|
948+ , printSummary = putStr $ [s|
951949 1. verify the cursor is displayed.
952950 2. press enter
953951 3. verify the cursor is hid.
954952 4. press enter.
955953 5. the display should return to the state before the test.
956954|]
957− , confirm_results = generic_output_match_confirm
955+ , confirmResults = genericOutputMatchConfirm
958956 }
959957
960−output_image_and_wait :: Image -> IO ()
961−output_image_and_wait image = do
962− let pic = pic_for_image image
963− output_pic_and_wait pic
964−
965−output_pic_and_wait :: Picture -> IO ()
966−output_pic_and_wait pic = do
967− t <- current_terminal
968− reserve_display t
969− d <- display_bounds t >>= display_context t
970− output_picture d pic
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
971969 getLine
972− release_display t
973− release_terminal t
970+ releaseDisplay t
971+ releaseTerminal t
974972 return ()
975−
976−vert_crop_test_0 :: Test
977−vert_crop_test_0 = Test
978− { test_name = "Verify bottom cropping works as expected with single column chars"
979− , test_ID = "crop_test_0"
980− , test_action = do
981− let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum
982− block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum
983− image = block_0 <-> background_fill 10 2 <-> block_1
984− output_image_and_wait image
985− , print_summary = putStr $ [s|
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|
986984 1. Verify the two text blocks are identical.
987985 2. press enter.
988986 3. the display should return to the state before the test.
989987|]
990− , confirm_results = generic_output_match_confirm
988+ , confirmResults = genericOutputMatchConfirm
991989 }
992990
993−vert_crop_test_1 :: Test
994−vert_crop_test_1 = Test
995− { test_name = "Verify bottom cropping works as expected with double column chars"
996− , test_ID = "crop_test_0"
997− , test_action = do
998− let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
999− block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum_chinese
1000− image = block_0 <-> background_fill 10 2 <-> block_1
1001− output_image_and_wait image
1002− , print_summary = putStr $ [s|
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|
10031001 1. Verify the two text blocks are identical.
10041002 2. press enter.
10051003 3. the display should return to the state before the test.
10061004|]
1007− , confirm_results = generic_output_match_confirm
1005+ , confirmResults = genericOutputMatchConfirm
10081006 }
10091007
1010−vert_crop_test_2 :: Test
1011−vert_crop_test_2 = Test
1012− { test_name = "Verify top cropping works as expected with single column chars"
1013− , test_ID = "crop_test_0"
1014− , test_action = do
1015− let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum
1016− block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum - 2) lorum_ipsum
1017− image = block_0 <-> background_fill 10 2 <-> block_1
1018− output_image_and_wait image
1019− , print_summary = putStr $ [s|
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|
10201018 1. Verify the two text blocks are identical.
10211019 2. press enter.
10221020 3. the display should return to the state before the test.
10231021|]
1024− , confirm_results = generic_output_match_confirm
1022+ , confirmResults = genericOutputMatchConfirm
10251023 }
10261024
1027−vert_crop_test_3 :: Test
1028−vert_crop_test_3 = Test
1029− { test_name = "Verify top cropping works as expected with double column chars"
1030− , test_ID = "crop_test_0"
1031− , test_action = do
1032− let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
1033− block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum_chinese - 2 ) lorum_ipsum_chinese
1034− image = block_0 <-> background_fill 10 2 <-> block_1
1035− output_image_and_wait image
1036− , print_summary = putStr $ [s|
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|
10371035 1. Verify the two text blocks are identical.
10381036 2. press enter.
10391037 3. the display should return to the state before the test.
10401038|]
1041− , confirm_results = generic_output_match_confirm
1039+ , confirmResults = genericOutputMatchConfirm
10421040 }
10431041
1044−horiz_crop_test_0 :: Test
1045−horiz_crop_test_0 = Test
1046− { test_name = "Verify right cropping works as expected with single column chars"
1047− , test_ID = "crop_test_0"
1048− , test_action = do
1049− let base_image = vert_cat $ map (string def_attr) lorum_ipsum
1050− cropped_image = crop_right (image_width base_image `div` 2) base_image
1051− image = base_image <-> background_fill 10 2 <-> cropped_image
1052− output_image_and_wait image
1053− , print_summary = putStr $ [s|
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|
10541052 1. Verify the bottom text block is about half the width of the top text block.
10551053 2. press enter.
10561054 3. the display should return to the state before the test.
10571055|]
1058− , confirm_results = generic_output_match_confirm
1056+ , confirmResults = genericOutputMatchConfirm
10591057 }
10601058
1061−horiz_crop_test_1 :: Test
1062−horiz_crop_test_1 = Test
1063− { test_name = "Verify right cropping works as expected with double column chars"
1064− , test_ID = "crop_test_0"
1065− , test_action = do
1066− let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1067− cropped_image = crop_right (image_width base_image `div` 2) base_image
1068− image = base_image <-> background_fill 10 2 <-> cropped_image
1069− output_image_and_wait image
1070− , print_summary = putStr $ [s|
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|
10711069 1. Verify the bottom text block is the left half of the top block. Ellipses on the right edge are OK.
10721070 2. press enter.
10731071 3. the display should return to the state before the test.
10741072|]
1075− , confirm_results = generic_output_match_confirm
1073+ , confirmResults = genericOutputMatchConfirm
10761074 }
10771075
1078−horiz_crop_test_2 :: Test
1079−horiz_crop_test_2 = Test
1080− { test_name = "Verify left cropping works as expected with single column chars"
1081− , test_ID = "crop_test_0"
1082− , test_action = do
1083− let base_image = vert_cat $ map (string def_attr) lorum_ipsum
1084− cropped_image = crop_left (image_width base_image `div` 2) base_image
1085− image = base_image <-> background_fill 10 2 <-> cropped_image
1086− output_image_and_wait image
1087− , print_summary = putStr $ [s|
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|
10881086 1. Verify the bottom text block is the right half of the top text block.
10891087 2. press enter.
10901088 3. the display should return to the state before the test.
10911089|]
1092− , confirm_results = generic_output_match_confirm
1090+ , confirmResults = genericOutputMatchConfirm
10931091 }
10941092
1095−horiz_crop_test_3 :: Test
1096−horiz_crop_test_3 = Test
1097− { test_name = "Verify right cropping works as expected with double column chars"
1098− , test_ID = "crop_test_0"
1099− , test_action = do
1100− let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1101− cropped_image = crop_left (image_width base_image `div` 2) base_image
1102− image = base_image <-> background_fill 10 2 <-> cropped_image
1103− output_image_and_wait image
1104− , print_summary = putStr $ [s|
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|
11051103 1. Verify the bottom text block is the right half of the top block. Ellipses on the left edge are OK.
11061104 2. press enter.
11071105 3. the display should return to the state before the test.
11081106|]
1109− , confirm_results = generic_output_match_confirm
1107+ , confirmResults = genericOutputMatchConfirm
11101108 }
11111109
1112−layer_0 :: Test
1113−layer_0 = Test
1114− { test_name = "verify layer 0"
1115− , test_ID = "layer_0"
1116− , test_action = do
1117− let upper_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1118− lower_image = vert_cat $ map (string def_attr) lorum_ipsum
1119− p = pic_for_layers [upper_image, lower_image]
1120− output_pic_and_wait p
1121− , print_summary = putStr $ [s|
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|
11221120 1. Verify the text block appears to be Chinese text placed on top Latin text.
11231121 2. press enter.
11241122 3. the display should return to the state before the test.
11251123|]
1126− , confirm_results = generic_output_match_confirm
1124+ , confirmResults = genericOutputMatchConfirm
11271125 }
11281126
1129−layer_1 :: Test
1130−layer_1 = Test
1131− { test_name = "verify layer 1"
1132− , test_ID = "layer_1"
1133− , test_action = do
1134− let upper_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1135− block = resize 10 10 upper_image
1136− layer_0 = vert_cat $ map (string def_attr) lorum_ipsum
1137− layer_1 = char_fill (def_attr `with_back_color` blue) '#' 1000 1000
1138− cheesy_anim_0 block [layer_0, layer_1]
1139− , print_summary = putStr $ [s|
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|
11401138 1. Verify the text block appears to be Chinese text moving on top a Latin text.
11411139 Which is all on a background of '#' characters over blue.
11421140 2. press enter.
11431141 3. the display should return to the state before the test.
11441142|]
1145− , confirm_results = generic_output_match_confirm
1143+ , confirmResults = genericOutputMatchConfirm
11461144 }
11471145
1148−cheesy_anim_0 :: Image -> [Image] -> IO ()
1149−cheesy_anim_0 i background = do
1150− t <- current_terminal
1151− reserve_display t
1152− bounds <- display_bounds t
1153− d <- display_context t bounds
1154− forM_ [0..100] $ \t -> do
1155− let i_offset = translate (t `mod` region_width bounds)
1156− (t `div` 2 `mod` region_height bounds)
1146+cheesyAnim0 :: Image -> [Image] -> IO ()
1147+cheesyAnim0 i background = do
1148+ t <- standardIOConfig >>= outputForConfig
1149+ reserveDisplay t
1150+ bounds <- displayBounds t
1151+ d <- displayContext t bounds
1152+ forM_ [0..2] $ \t -> do
1153+ forM_ [0..100] $ \t -> do
1154+ let i_offset = translate (t `mod` fst bounds)
1155+ (t `div` 2 `mod` snd bounds)
1156+ i
1157+ let pic = picForLayers $ i_offset : background
1158+ outputPicture d pic
1159+ threadDelay 50000
1160+ forM_ [0..100] $ \t -> do
1161+ let i_offset = translate (t * (-1) `mod` fst bounds)
1162+ (t * (-1) `div` 2 `mod` snd bounds)
11571163 i
1158− let pic = pic_for_layers $ i_offset : background
1159− output_picture d pic
1164+ let pic = picForLayers $ i_offset : background
1165+ outputPicture d pic
11601166 threadDelay 50000
1161− release_display t
1162− release_terminal t
1167+ releaseDisplay t
1168+ releaseTerminal t
11631169 return ()
11641170
1165−lorum_ipsum :: [String]
1166−lorum_ipsum = lines [s|
1171+lorumIpsum :: [String]
1172+lorumIpsum = lines [s|
11671173Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium,
11681174totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae
11691175dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit,
@@ -1175,8 +1181,8 @@ commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate v
11751181molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
11761182|]
11771183
1178−lorum_ipsum_chinese :: [String]
1179−lorum_ipsum_chinese = lines [s|
1184+lorumIpsumChinese :: [String]
1185+lorumIpsumChinese = lines [s|
11801186輐銛 螷蟞覮 裌覅詵 暕 鴅噮 槶 惝掭掝 婸媥媕 耏胠臿, 汫汭沎 忕汌卣 蚡袀 僣 蒮 瀁瀎瀊 渮湸湤 緌翢,
11811187腠腶舝 糲蘥蠩 樏殣氀 蒮 蹢鎒 滍 鸄齴 櫧櫋瀩 鬄鵊鵙 莃荶衒, 毸溠 橀 簎艜薤 莃荶衒 翣聜蒢
11821188斔櫅檷 晛桼桾 拻敁柧 犿玒 膣, 墐 笓粊紒 bacon 鼀齕, 蔝蓶蓨 顊顃餭 姴怤 骱 暕 蹢鎒鎛 藒襓謥 鄻鎟霣