@@ -6,9 +6,9 @@ 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
11+import Control.Concurrent (threadDelay)
1212import Control.Exception
1313import Control.Monad
1414
@@ -18,18 +18,18 @@ import Data.Monoid
1818import Data.String.QQ
1919import Data.Word
2020
21−import Foreign.Marshal.Array
21+import Foreign.Marshal.Array
2222
2323import qualified System.Environment as Env
2424
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.
@@ -66,41 +66,40 @@ All the tests assume the following about the terminal display:
6666Thanks for the help! :-D
6767To exit the test early enter "q" anytime at the following menu screen.
6868
69−If any test failed then please post an issue to
69+If any test fails then please post an issue to
7070 https://github.com/coreyoconnor/vty/issues
71−with the test_results.list file pasted into the issue. The issue summary can
72−mention the specific tests that failed or just say "interactive terminal test
73−failure".
71+with the test_results.list file pasted into the issue. A suitable summary is:
72+"interactive terminal test failure".
7473|]
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 )
78− ( \ (_ :: SomeException) -> return (env_name, "") )
79− )
80− [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
81− t <- 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
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
8988 putStr "\n(press return to continue)"
9089 hFlush stdout
9190 getLine
9291
93−test_menu :: [(String, Test)]
94−test_menu = zip (map show [1..]) all_tests
92+testMenu :: [(String, Test)]
93+testMenu = zip (map show [1..]) allTests
9594
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"
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"
10099 return []
101100 | otherwise = do
102− display_test_menu
103− putStrLn $ "Press return to start with #" ++ show next_ID ++ "."
101+ displayTestMenu
102+ putStrLn $ "Press return to start with #" ++ show nextID ++ "."
104103 putStrLn "Enter a test number to perform only that test."
105104 putStrLn "q (or control-C) to quit."
106105 putStr "> "
@@ -108,100 +107,102 @@ do_test_menu next_ID
108107 s <- getLine >>= return . filter (/= '\n')
109108 case s of
110109 "q" -> return mempty
111− "" -> do
112− r <- run_test $ show next_ID
113− rs <- do_test_menu ( next_ID + 1 )
110+ "" -> do
111+ r <- runTest $ show nextID
112+ rs <- doTestMenu ( nextID + 1 )
114113 return $ r : rs
115− i | isJust ( lookup i test_menu ) -> do
116− r <- run_test i
117− rs <- do_test_menu ( read i + 1 )
114+ i | isJust ( lookup i testMenu ) -> do
115+ r <- runTest i
116+ rs <- doTestMenu ( read i + 1 )
118117 return $ r : rs
119118 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
124− then "> "
119+ displayTestMenu
120+ = mapM_ displayTestMenu' testMenu
121+ displayTestMenu' ( i, t )
122+ = putStrLn $ ( if i == show nextID
123+ then "> "
125124 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
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
138137 putStr "\n"
139138 putStr "[Y/n] "
140139 hFlush stdout
141140 r <- getLine
142141 case r of
143− "" -> return True
142+ "" -> return True
144143 "y" -> return True
145144 "Y" -> return True
146145 "n" -> return False
147146
148147data Test = Test
149− { test_name :: String
150− , test_ID :: String
151− , test_action :: IO ()
152− , print_summary :: IO ()
153− , confirm_results :: IO Bool
148+ { testName :: String
149+ , testID :: String
150+ , testAction :: IO ()
151+ , printSummary :: IO ()
152+ , confirmResults :: IO Bool
154153 }
155154
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
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
184185 ]
185186
186−reserve_output_test = Test
187− { test_name = "Initialize and reserve terminal output then restore previous state."
188− , test_ID = "reserve_output_test"
189− , test_action = do
190− t <- current_terminal
191− 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
192193 putStrLn "Line 1"
193194 putStrLn "Line 2"
194195 putStrLn "Line 3"
195196 putStrLn "Line 4 (press return)"
196197 hFlush stdout
197198 getLine
198− release_display t
199− release_terminal t
199+ releaseDisplay t
200+ releaseTerminal t
200201 return ()
201− , print_summary = do
202+ , printSummary = do
202203 putStr $ [s|
203204Once return is pressed:
204− 0. The screen will be cleared.
205+ 0. The screen will be cleared.
205206 1. Four lines of text should be visible.
206207 1. The cursor should be visible and at the start of the fifth line.
207208
@@ -209,123 +210,123 @@ After return is pressed for the second time this test then:
209210 * The screen containing the test summary should be restored;
210211 * The cursor is visible.
211212|]
212− , confirm_results = do
213+ , confirmResults = do
213214 putStr $ [s|
214215Did the test output match the description?
215216|]
216− default_success_confirm_results
217+ defaultSuccessConfirmResults
217218 }
218219
219−display_bounds_test_0 = Test
220− { test_name = "Verify display bounds are correct test 0: Using spaces."
221− , test_ID = "display_bounds_test_0"
222− , test_action = do
223− t <- current_terminal
224− reserve_display t
225− DisplayRegion w h <- display_bounds t
226− let row_0 = replicate (fromEnum w) 'X' ++ "\n"
227− row_h = replicate (fromEnum w - 1) 'X'
228− row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
229− 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
230231 putStr image
231232 hFlush stdout
232233 getLine
233− release_display t
234− release_terminal t
234+ releaseDisplay t
235+ releaseTerminal t
235236 return ()
236− , print_summary = display_bounds_test_summary True
237− , confirm_results = generic_output_match_confirm
237+ , printSummary = displayBoundsTestSummary True
238+ , confirmResults = genericOutputMatchConfirm
238239 }
239240
240−display_bounds_test_1 = Test
241− { test_name = "Verify display bounds are correct test 0: Using cursor movement."
242− , test_ID = "display_bounds_test_1"
243− , test_action = do
244− t <- current_terminal
245− reserve_display t
246− DisplayRegion w h <- display_bounds t
247− set_cursor_pos t 0 0
248− let row_0 = replicate (fromEnum w) 'X' ++ "\n"
249− 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
250251 forM_ [1 .. h - 2] $ \y -> do
251− set_cursor_pos t 0 y
252+ setCursorPos t 0 y
252253 putStr "X"
253254 hFlush stdout
254− set_cursor_pos t (w - 1) y
255+ setCursorPos t (w - 1) y
255256 putStr "X"
256257 hFlush stdout
257− set_cursor_pos t 0 (h - 1)
258− let row_h = replicate (fromEnum w - 1) 'X'
259− putStr row_h
258+ setCursorPos t 0 (h - 1)
259+ let rowH = replicate (fromEnum w - 1) 'X'
260+ putStr rowH
260261 hFlush stdout
261262 getLine
262− release_display t
263− release_terminal t
263+ releaseDisplay t
264+ releaseTerminal t
264265 return ()
265− , print_summary = display_bounds_test_summary True
266− , confirm_results = generic_output_match_confirm
266+ , printSummary = displayBoundsTestSummary True
267+ , confirmResults = genericOutputMatchConfirm
267268 }
268269
269−display_bounds_test_2 = Test
270− { test_name = "Verify display bounds are correct test 0: Using Image ops."
271− , test_ID = "display_bounds_test_2"
272− , test_action = do
273− t <- current_terminal
274− reserve_display t
275− bounds@(DisplayRegion w h) <- display_bounds t
276− let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')
277− middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row
278− middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')
279− end_row = first_row
280− image = first_row <-> middle_rows <-> end_row
281− pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) }
282− d <- display_context t bounds
283− 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
284285 getLine
285− release_display t
286− release_terminal t
286+ releaseDisplay t
287+ releaseTerminal t
287288 return ()
288− , print_summary = display_bounds_test_summary True
289− , confirm_results = generic_output_match_confirm
289+ , printSummary = displayBoundsTestSummary True
290+ , confirmResults = genericOutputMatchConfirm
290291 }
291292
292−display_bounds_test_3 = Test
293− { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
294− , test_ID = "display_bounds_test_3"
295− , test_action = do
296− t <- current_terminal
297− reserve_display t
298− DisplayRegion w h <- display_bounds t
299− hide_cursor t
300− set_cursor_pos t 0 0
301− let row_0 = replicate (fromEnum w) 'X'
302− 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
303304 forM_ [1 .. h - 2] $ \y -> do
304− set_cursor_pos t 0 y
305+ setCursorPos t 0 y
305306 putStr "X"
306307 hFlush stdout
307− set_cursor_pos t (w - 1) y
308+ setCursorPos t (w - 1) y
308309 putStr "X"
309310 hFlush stdout
310− set_cursor_pos t 0 (h - 1)
311− let row_h = row_0
312− putStr row_h
311+ setCursorPos t 0 (h - 1)
312+ let rowH = row0
313+ putStr rowH
313314 hFlush stdout
314315 getLine
315− show_cursor t
316− release_display t
317− release_terminal t
316+ showCursor t
317+ releaseDisplay t
318+ releaseTerminal t
318319 return ()
319− , print_summary = display_bounds_test_summary False
320− , confirm_results = generic_output_match_confirm
320+ , printSummary = displayBoundsTestSummary False
321+ , confirmResults = genericOutputMatchConfirm
321322 }
322323
323−display_bounds_test_summary has_cursor = do
324+displayBoundsTestSummary hasCursor = do
324325 putStr $ [s|
325326Once return is pressed:
326327 0. The screen will be cleared.
327328|]
328− if has_cursor
329+ if hasCursor
329330 then putStr " 1. The cursor will be visible."
330331 else putStr " 1. The cursor will NOT be visible."
331332 putStr [s|
@@ -336,7 +337,7 @@ Once return is pressed:
336337 |XXXXXXXXXXXXX|
337338 |X X||]
338339
339− if has_cursor
340+ if hasCursor
340341 then putStr $ [s|
341342
342343 |XXXXXXXXXXXXC| |]
@@ -357,13 +358,13 @@ After return is pressed for the second time:
357358 1. The cursor should be visible.
358359|]
359360
360−generic_output_match_confirm = do
361+genericOutputMatchConfirm = do
361362 putStr $ [s|
362363Did the test output match the description?
363364|]
364− default_success_confirm_results
365+ defaultSuccessConfirmResults
365366
366−-- Explicitely definethe bytes that encode each example text.
367+-- Explicitly define the bytes that encode each example text.
367368-- This avoids any issues with how the compiler represents string literals.
368369--
369370-- This document is UTF-8 encoded so the UTF-8 string is still included for
@@ -372,24 +373,24 @@ Did the test output match the description?
372373-- It's assumed the compiler will at least not barf on UTF-8 encoded text in
373374-- comments ;-)
374375--
375−-- txt_0 = ↑↑↓↓←→←→BA
376−
377−utf8_txt_0 :: [[Word8]]
378−utf8_txt_0 = [ [ 0xe2 , 0x86 , 0x91 ]
379− , [ 0xe2 , 0x86 , 0x91 ]
380− , [ 0xe2 , 0x86 , 0x93 ]
381− , [ 0xe2 , 0x86 , 0x93 ]
382− , [ 0xe2 , 0x86 , 0x90 ]
383− , [ 0xe2 , 0x86 , 0x92 ]
384− , [ 0xe2 , 0x86 , 0x90 ]
385− , [ 0xe2 , 0x86 , 0x92 ]
386− , [ 0x42 ]
387− , [ 0x41 ]
388− ]
389−
390−iso_10646_txt_0 :: String
391−iso_10646_txt_0 = map toEnum
392− [ 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
393394 , 8593
394395 , 8595
395396 , 8595
@@ -401,46 +402,46 @@ iso_10646_txt_0 = map toEnum
401402 , 65
402403 ]
403404
404−unicode_single_width_0 = Test
405− { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
406− , test_ID = "unicode_single_width_0"
407− , test_action = do
408− t <- current_terminal
409− reserve_display t
410− hide_cursor t
411− 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)
412413 hPutStr stdout "\n"
413414 hPutStr stdout "0123456789\n"
414415 hFlush stdout
415416 getLine
416− release_display t
417− release_terminal t
417+ releaseDisplay t
418+ releaseTerminal t
418419 return ()
419− , print_summary = unicode_single_width_summary
420− , confirm_results = generic_output_match_confirm
420+ , printSummary = unicodeSingleWidthSummary
421+ , confirmResults = genericOutputMatchConfirm
421422 }
422423
423−unicode_single_width_1 = Test
424− { test_name = "Verify terminal can display unicode single-width characters. (Image ops)"
425− , test_ID = "unicode_single_width_1"
426− , test_action = do
427− t <- current_terminal
428− reserve_display t
429− let pic = pic_for_image image
430− image = line_0 <-> line_1
431− line_0 = iso_10646_string def_attr iso_10646_txt_0
432− line_1 = string def_attr "0123456789"
433− d <- display_bounds t >>= display_context t
434− 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
435436 getLine
436− release_display t
437− release_terminal t
437+ releaseDisplay t
438+ releaseTerminal t
438439 return ()
439− , print_summary = unicode_single_width_summary
440− , confirm_results = generic_output_match_confirm
440+ , printSummary = unicodeSingleWidthSummary
441+ , confirmResults = genericOutputMatchConfirm
441442 }
442443
443−unicode_single_width_summary = putStr [s|
444+unicodeSingleWidthSummary = putStr [s|
444445Once return is pressed:
445446 0. The screen will be cleared.
446447 1. The cursor will be hidden.
@@ -474,55 +475,55 @@ After return is pressed for the second time:
474475
475476-- The second example is a unicode string containing double-width glyphs
476477-- 你好吗
477−utf8_txt_1 :: [[Word8]]
478−utf8_txt_1 = [ [0xe4,0xbd,0xa0]
479− , [0xe5,0xa5,0xbd]
480− , [0xe5,0x90,0x97]
481− ]
482−
483−iso_10646_txt_1 :: String
484−iso_10646_txt_1 = map toEnum [20320,22909,21527]
485−
486−unicode_double_width_0 = Test
487− { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
488− , test_ID = "unicode_double_width_0"
489− , test_action = do
490− t <- current_terminal
491− reserve_display t
492− hide_cursor t
493− 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)
494495 hPutStr stdout "\n"
495496 hPutStr stdout "012345\n"
496497 hFlush stdout
497498 getLine
498− release_display t
499− release_terminal t
499+ releaseDisplay t
500+ releaseTerminal t
500501 return ()
501− , print_summary = unicode_double_width_summary
502− , confirm_results = generic_output_match_confirm
502+ , printSummary = unicodeDoubleWidthSummary
503+ , confirmResults = genericOutputMatchConfirm
503504 }
504505
505−unicode_double_width_1 = Test
506− { test_name = "Verify terminal can display unicode double-width characters. (Image ops)"
507− , test_ID = "unicode_double_width_1"
508− , test_action = do
509− t <- current_terminal
510− reserve_display t
511− let pic = pic_for_image image
512− image = line_0 <-> line_1
513− line_0 = iso_10646_string def_attr iso_10646_txt_1
514− line_1 = string def_attr "012345"
515− d <- display_bounds t >>= display_context t
516− 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
517518 getLine
518− release_display t
519− release_terminal t
519+ releaseDisplay t
520+ releaseTerminal t
520521 return ()
521− , print_summary = unicode_double_width_summary
522− , confirm_results = generic_output_match_confirm
522+ , printSummary = unicodeDoubleWidthSummary
523+ , confirmResults = genericOutputMatchConfirm
523524 }
524525
525−unicode_double_width_summary = putStr [s|
526+unicodeDoubleWidthSummary = putStr [s|
526527Once return is pressed:
527528 0. The screen will be cleared.
528529 1. The cursor will be hidden.
@@ -549,32 +550,32 @@ After return is pressed for the second time:
549550 1. The cursor should be visible.
550551|]
551552
552−all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
553− [ "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" ]
554555
555−all_bright_colors
556− = 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 ]
557558 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]
558559
559−attributes_test_0 = Test
560− { test_name = "Character attributes: foreground colors."
561− , test_ID = "attributes_test_0"
562− , test_action = do
563− t <- current_terminal
564− reserve_display t
565− let pic = pic_for_image image
566− image = border <|> column_0 <|> border <|> column_1 <|> border
567− column_0 = vert_cat $ map line_with_color all_colors
568− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
569− column_1 = vert_cat $ map (string def_attr . snd) all_colors
570− line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name
571− d <- display_bounds t >>= display_context t
572− 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
573574 getLine
574− release_display t
575− release_terminal t
575+ releaseDisplay t
576+ releaseTerminal t
576577 return ()
577− , print_summary = do
578+ , printSummary = do
578579 putStr $ [s|
579580Once return is pressed:
580581 0. The screen will be cleared.
@@ -595,32 +596,32 @@ After return is pressed for the second time:
595596 0. The screen containing the test summary should be restored.
596597 1. The cursor should be visible.
597598|]
598− , confirm_results = do
599+ , confirmResults = do
599600 putStr $ [s|
600601Did the test output match the description?
601602|]
602− default_success_confirm_results
603+ defaultSuccessConfirmResults
603604 }
604605
605−attributes_test_1 = Test
606− { test_name = "Character attributes: background colors."
607− , test_ID = "attributes_test_1"
608− , test_action = do
609− t <- current_terminal
610− reserve_display t
611− let pic = pic_for_image image
612− image = border <|> column_0 <|> border <|> column_1 <|> border
613− column_0 = vert_cat $ map line_with_color all_colors
614− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
615− column_1 = vert_cat $ map (string def_attr . snd) all_colors
616− line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name
617− d <- display_bounds t >>= display_context t
618− 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
619620 getLine
620− release_display t
621− release_terminal t
621+ releaseDisplay t
622+ releaseTerminal t
622623 return ()
623− , print_summary = do
624+ , printSummary = do
624625 putStr $ [s|
625626Once return is pressed:
626627 0. The screen will be cleared.
@@ -650,57 +651,57 @@ After return is pressed for the second time:
650651 0. The screen containing the test summary should be restored.
651652 1. The cursor should be visible.
652653|]
653− , confirm_results = do
654+ , confirmResults = do
654655 putStr $ [s|
655656Did the test output match the description?
656657|]
657− default_success_confirm_results
658+ defaultSuccessConfirmResults
658659 }
659660
660−attributes_test_2 = Test
661− { test_name = "Character attributes: Vivid foreground colors."
662− , test_ID = "attributes_test_2"
663− , test_action = do
664− t <- current_terminal
665− reserve_display t
666− let pic = pic_for_image image
667− image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
668− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
669− column_0 = vert_cat $ map line_with_color_0 all_colors
670− column_1 = vert_cat $ map line_with_color_1 all_bright_colors
671− column_2 = vert_cat $ map (string def_attr . snd) all_colors
672− line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name
673− line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name
674− d <- display_bounds t >>= display_context t
675− 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
676677 getLine
677− release_display t
678− release_terminal t
678+ releaseDisplay t
679+ releaseTerminal t
679680 return ()
680− , print_summary = do
681+ , printSummary = do
681682 putStr $ [s|
682683Once return is pressed:
683684 0. The screen will be cleared.
684685 1. The cursor will be hidden.
685686 2. 9 lines of text in three columns will be drawn:
686687 a. The first column will be a name of a standard color (for an 8 color
687− terminal) rendered with that color as the foreground color.
688+ terminal) rendered with that color as the foreground color.
688689 b. The next column will be also be the name of a standard color rendered
689690 with that color as the foreground color but the shade used should be
690− more vivid than the shade used in the first column.
691+ more vivid than the shade used in the first column.
691692 c. The final column will be the name of a color rendered with the
692693 default attributes.
693694
694695For instance, one line will be the word "magenta" and that word should be
695−rendered in the magenta color.
696+rendered in the magenta color.
696697
697698I'm not actually sure exactly what "vivid" means in this context. For xterm the
698−vivid colors are brighter.
699+vivid colors are brighter.
699700
700−Verify:
701+Verify:
701702 * The first column: The foreground color matches the named color.
702703 * The second column: The foreground color matches the named color but is
703− more vivid than the color used in the first column.
704+ more vivid than the color used in the first column.
704705 * The third column: All text is rendered with the default attributes.
705706 * The vertical bars used in each line to mark the border of a column are
706707 lined up.
@@ -709,34 +710,34 @@ After return is pressed for the second time:
709710 0. The screen containing the test summary should be restored.
710711 1. The cursor should be visible.
711712|]
712− , confirm_results = do
713+ , confirmResults = do
713714 putStr $ [s|
714715Did the test output match the description?
715716|]
716− default_success_confirm_results
717+ defaultSuccessConfirmResults
717718 }
718719
719−attributes_test_3 = Test
720− { test_name = "Character attributes: Vivid background colors."
721− , test_ID = "attributes_test_3"
722− , test_action = do
723− t <- current_terminal
724− reserve_display t
725− let pic = pic_for_image image
726− image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
727− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
728− column_0 = vert_cat $ map line_with_color_0 all_colors
729− column_1 = vert_cat $ map line_with_color_1 all_bright_colors
730− column_2 = vert_cat $ map (string def_attr . snd) all_colors
731− line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name
732− line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name
733− d <- display_bounds t >>= display_context t
734− 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
735736 getLine
736− release_display t
737− release_terminal t
737+ releaseDisplay t
738+ releaseTerminal t
738739 return ()
739− , print_summary = do
740+ , printSummary = do
740741 putStr $ [s|
741742Once return is pressed:
742743 0. The screen will be cleared.
@@ -744,23 +745,23 @@ Once return is pressed:
744745 2. 9 lines of text in three columns will be drawn:
745746 a. The first column will contain be a name of a standard color for an 8
746747 color terminal rendered with the default foreground color with a
747− background the named color.
748+ background the named color.
748749 b. The first column will contain be a name of a standard color for an 8
749750 color terminal rendered with the default foreground color with the
750− background a vivid version of the named color.
751+ background a vivid version of the named color.
751752 c. The third column will be the name of a standard color rendered with
752753 the default attributes.
753−
754+
754755For instance, one line will contain be the word "magenta" and the word should
755−be rendered in the default foreground color over a magenta background.
756+be rendered in the default foreground color over a magenta background.
756757
757758I'm not actually sure exactly what "vivid" means in this context. For xterm the
758759vivid colors are brighter.
759760
760−Verify:
761+Verify:
761762 * The first column: The background color matches the named color.
762763 * The second column: The background color matches the named color and is
763− more vivid than the color used in the first column.
764+ more vivid than the color used in the first column.
764765 * The third column column: All text is rendered with the default attributes.
765766 * The vertical bars used in each line to mark the border of a column are
766767 lined up.
@@ -776,51 +777,51 @@ After return is pressed for the second time:
776777 0. The screen containing the test summary should be restored.
777778 1. The cursor should be visible.
778779|]
779− , confirm_results = do
780+ , confirmResults = do
780781 putStr $ [s|
781782Did the test output match the description?
782783|]
783− default_success_confirm_results
784+ defaultSuccessConfirmResults
784785 }
785786
786−attr_combos =
787+attrCombos =
787788 [ ( "default", id )
788− , ( "bold", flip with_style bold )
789− , ( "blink", flip with_style blink )
790− , ( "underline", flip with_style underline )
791− , ( "bold + blink", flip with_style (bold + blink) )
792− , ( "bold + underline", flip with_style (bold + underline) )
793− , ( "underline + blink", flip with_style (underline + blink) )
794− , ( "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) )
795796 ]
796797
797−attributes_test_4 = Test
798− { test_name = "Character attributes: Bold; Blink; Underline."
799− , test_ID = "attributes_test_4"
800− , test_action = do
801− t <- current_terminal
802− reserve_display t
803− let pic = pic_for_image image
804− image = horiz_cat [border, column_0, border, column_1, border]
805− border = vert_cat $ replicate (length attr_combos) $ string def_attr " | "
806− column_0 = vert_cat $ map line_with_attrs attr_combos
807− column_1 = vert_cat $ map (string def_attr . fst) attr_combos
808− line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc
809− d <- display_bounds t >>= display_context t
810− 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
811812 getLine
812− release_display t
813− release_terminal t
813+ releaseDisplay t
814+ releaseTerminal t
814815 return ()
815− , print_summary = do
816+ , printSummary = do
816817 putStr $ [s|
817818Once return is pressed:
818819 0. The screen will be cleared.
819820 1. The cursor will be hidden.
820− 2. 8 rows of text in two columns.
821+ 2. 8 rows of text in two columns.
821822 The rows will contain the following text:
822823 default
823− bold
824+ bold
824825 blink
825826 underline
826827 bold + blink
@@ -829,8 +830,8 @@ Once return is pressed:
829830 bold + blink + underline
830831 The first column will be rendered with the described attributes. The second
831832 column will be rendered with the default attributes.
832−
833−Verify:
833+
834+Verify:
834835 * The vertical bars used in each line to mark the border of a column are
835836 lined up.
836837 * The text in the first column is rendered as described.
@@ -839,31 +840,31 @@ After return is pressed for the second time:
839840 0. The screen containing the test summary should be restored.
840841 1. The cursor should be visible.
841842|]
842− , confirm_results = do
843+ , confirmResults = do
843844 putStr $ [s|
844845Did the test output match the description?
845846|]
846− default_success_confirm_results
847+ defaultSuccessConfirmResults
847848 }
848849
849−attributes_test_5 = Test
850− { test_name = "Character attributes: 240 color palette"
851− , test_ID = "attributes_test_5"
852− , test_action = do
853− t <- current_terminal
854− reserve_display t
855− let pic = pic_for_image image
856− image = vert_cat $ map horiz_cat $ split_color_images color_images
857− color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239]
858− split_color_images [] = []
859− split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is))
860− d <- display_bounds t >>= display_context t
861− 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
862863 getLine
863− release_display t
864− release_terminal t
864+ releaseDisplay t
865+ releaseTerminal t
865866 return ()
866− , print_summary = do
867+ , printSummary = do
867868 putStr $ [s|
868869Once return is pressed:
869870 0. The screen will be cleared.
@@ -871,239 +872,304 @@ Once return is pressed:
871872 2. A 20 character wide and 12 row high block of color squares. This should look like a palette
872873 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...
873874
874−Verify:
875+Verify:
875876
876877After return is pressed for the second time:
877878 0. The screen containing the test summary should be restored.
878879 1. The cursor should be visible.
879880|]
880− , confirm_results = do
881+ , confirmResults = do
881882 putStr $ [s|
882883Did the test output match the description?
883884|]
884− default_success_confirm_results
885+ defaultSuccessConfirmResults
885886 }
886887
887−inline_test_0 = Test
888− { test_name = "Verify styled output can be performed without clearing the screen."
889− , test_ID = "inline_test_0"
890− , test_action = do
888+inlineTest0 = Test
889+ { testName = "Verify styled output can be performed without clearing the screen."
890+ , testID = "inlineTest0"
891+ , testAction = do
891892 putStrLn "line 1."
892− put_attr_change_ $ back_color red >> apply_style underline
893+ putAttrChange_ $ backColor red >> applyStyle underline
893894 putStrLn "line 2."
894− put_attr_change_ $ default_all
895+ putAttrChange_ $ defaultAll
895896 putStrLn "line 3."
896− , print_summary = putStr $ [s|
897+ , printSummary = putStr $ [s|
897898lines are in order.
898899The second line "line 2" should have a red background and the text underline.
899900The third line "line 3" should be drawn in the same style as the first line.
900901|]
901902
902− , confirm_results = generic_output_match_confirm
903+ , confirmResults = genericOutputMatchConfirm
903904 }
904905
905−inline_test_1 = Test
906− { test_name = "Verify styled output can be performed without clearing the screen."
907− , test_ID = "inline_test_1"
908− , test_action = do
906+inlineTest1 = Test
907+ { testName = "Verify styled output can be performed without clearing the screen."
908+ , testID = "inlineTest1"
909+ , testAction = do
909910 putStr "Not styled. "
910− put_attr_change_ $ back_color red >> apply_style underline
911+ putAttrChange_ $ backColor red >> applyStyle underline
911912 putStr " Styled! "
912− put_attr_change_ $ default_all
913+ putAttrChange_ $ defaultAll
913914 putStrLn "Not styled."
914− , print_summary = putStr $ [s|
915+ , printSummary = putStr $ [s|
915916|]
916917
917− , confirm_results = generic_output_match_confirm
918+ , confirmResults = genericOutputMatchConfirm
918919 }
919920
920−inline_test_2 = Test
921− { test_name = "Verify styled output can be performed without clearing the screen."
922− , test_ID = "inline_test_1"
923− , test_action = do
921+inlineTest2 = Test
922+ { testName = "Verify styled output can be performed without clearing the screen."
923+ , testID = "inlineTest1"
924+ , testAction = do
924925 putStr "Not styled. "
925− put_attr_change_ $ back_color red >> apply_style underline
926+ putAttrChange_ $ backColor red >> applyStyle underline
926927 putStr " Styled! "
927− put_attr_change_ $ default_all
928+ putAttrChange_ $ defaultAll
928929 putStr "Not styled.\n"
929− , print_summary = putStr $ [s|
930+ , printSummary = putStr $ [s|
930931|]
931− , confirm_results = generic_output_match_confirm
932+ , confirmResults = genericOutputMatchConfirm
932933 }
933934
934−cursor_hide_test_0 :: Test
935−cursor_hide_test_0 = Test
936− { test_name = "Verify the cursor is hid and re-shown. issue #7"
937− , test_ID = "cursor_hide_test_0"
938− , test_action = do
939− vty <- mkVty
940− show_cursor $ terminal vty
941− set_cursor_pos (terminal vty) 5 5
942− next_event vty
943− hide_cursor $ terminal vty
944− 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
945946 shutdown vty
946947 return ()
947− , print_summary = putStr $ [s|
948+ , printSummary = putStr $ [s|
948949 1. verify the cursor is displayed.
949950 2. press enter
950951 3. verify the cursor is hid.
951952 4. press enter.
952953 5. the display should return to the state before the test.
953954|]
954− , confirm_results = generic_output_match_confirm
955+ , confirmResults = genericOutputMatchConfirm
955956 }
956957
957−output_image_and_wait :: Image -> IO ()
958−output_image_and_wait image = do
959− t <- current_terminal
960− reserve_display t
961− let pic = pic_for_image image
962− d <- display_bounds t >>= display_context t
963− 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
964969 getLine
965− release_display t
966− release_terminal t
970+ releaseDisplay t
971+ releaseTerminal t
967972 return ()
968973
969−vert_crop_test_0 :: Test
970−vert_crop_test_0 = Test
971− { test_name = "Verify bottom cropping works as expected with single column chars"
972− , test_ID = "crop_test_0"
973− , test_action = do
974− let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum
975− block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum
976− image = block_0 <-> background_fill 10 2 <-> block_1
977− output_image_and_wait image
978− , print_summary = putStr $ [s|
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|
979984 1. Verify the two text blocks are identical.
980985 2. press enter.
981986 3. the display should return to the state before the test.
982987|]
983− , confirm_results = generic_output_match_confirm
988+ , confirmResults = genericOutputMatchConfirm
984989 }
985990
986−vert_crop_test_1 :: Test
987−vert_crop_test_1 = Test
988− { test_name = "Verify bottom cropping works as expected with double column chars"
989− , test_ID = "crop_test_0"
990− , test_action = do
991− let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
992− block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum_chinese
993− image = block_0 <-> background_fill 10 2 <-> block_1
994− output_image_and_wait image
995− , 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|
9961001 1. Verify the two text blocks are identical.
9971002 2. press enter.
9981003 3. the display should return to the state before the test.
9991004|]
1000− , confirm_results = generic_output_match_confirm
1005+ , confirmResults = genericOutputMatchConfirm
10011006 }
10021007
1003−vert_crop_test_2 :: Test
1004−vert_crop_test_2 = Test
1005− { test_name = "Verify top cropping works as expected with single column chars"
1006− , test_ID = "crop_test_0"
1007− , test_action = do
1008− let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum
1009− block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum - 2) lorum_ipsum
1010− image = block_0 <-> background_fill 10 2 <-> block_1
1011− output_image_and_wait image
1012− , 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|
10131018 1. Verify the two text blocks are identical.
10141019 2. press enter.
10151020 3. the display should return to the state before the test.
10161021|]
1017− , confirm_results = generic_output_match_confirm
1022+ , confirmResults = genericOutputMatchConfirm
10181023 }
10191024
1020−vert_crop_test_3 :: Test
1021−vert_crop_test_3 = Test
1022− { test_name = "Verify top cropping works as expected with double column chars"
1023− , test_ID = "crop_test_0"
1024− , test_action = do
1025− let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
1026− block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum_chinese - 2 ) lorum_ipsum_chinese
1027− image = block_0 <-> background_fill 10 2 <-> block_1
1028− output_image_and_wait image
1029− , 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|
10301035 1. Verify the two text blocks are identical.
10311036 2. press enter.
10321037 3. the display should return to the state before the test.
10331038|]
1034− , confirm_results = generic_output_match_confirm
1039+ , confirmResults = genericOutputMatchConfirm
10351040 }
10361041
1037−horiz_crop_test_0 :: Test
1038−horiz_crop_test_0 = Test
1039− { test_name = "Verify right cropping works as expected with single column chars"
1040− , test_ID = "crop_test_0"
1041− , test_action = do
1042− let base_image = vert_cat $ map (string def_attr) lorum_ipsum
1043− cropped_image = crop_right (image_width base_image `div` 2) base_image
1044− image = base_image <-> background_fill 10 2 <-> cropped_image
1045− output_image_and_wait image
1046− , 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|
10471052 1. Verify the bottom text block is about half the width of the top text block.
10481053 2. press enter.
10491054 3. the display should return to the state before the test.
10501055|]
1051− , confirm_results = generic_output_match_confirm
1056+ , confirmResults = genericOutputMatchConfirm
10521057 }
10531058
1054−horiz_crop_test_1 :: Test
1055−horiz_crop_test_1 = Test
1056− { test_name = "Verify right cropping works as expected with double column chars"
1057− , test_ID = "crop_test_0"
1058− , test_action = do
1059− let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1060− cropped_image = crop_right (image_width base_image `div` 2) base_image
1061− image = base_image <-> background_fill 10 2 <-> cropped_image
1062− output_image_and_wait image
1063− , 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|
10641069 1. Verify the bottom text block is the left half of the top block. Ellipses on the right edge are OK.
10651070 2. press enter.
10661071 3. the display should return to the state before the test.
10671072|]
1068− , confirm_results = generic_output_match_confirm
1073+ , confirmResults = genericOutputMatchConfirm
10691074 }
10701075
1071−horiz_crop_test_2 :: Test
1072−horiz_crop_test_2 = Test
1073− { test_name = "Verify left cropping works as expected with single column chars"
1074− , test_ID = "crop_test_0"
1075− , test_action = do
1076− let base_image = vert_cat $ map (string def_attr) lorum_ipsum
1077− cropped_image = crop_left (image_width base_image `div` 2) base_image
1078− image = base_image <-> background_fill 10 2 <-> cropped_image
1079− output_image_and_wait image
1080− , 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|
10811086 1. Verify the bottom text block is the right half of the top text block.
10821087 2. press enter.
10831088 3. the display should return to the state before the test.
10841089|]
1085− , confirm_results = generic_output_match_confirm
1090+ , confirmResults = genericOutputMatchConfirm
10861091 }
10871092
1088−horiz_crop_test_3 :: Test
1089−horiz_crop_test_3 = Test
1090− { test_name = "Verify right cropping works as expected with double column chars"
1091− , test_ID = "crop_test_0"
1092− , test_action = do
1093− let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1094− cropped_image = crop_left (image_width base_image `div` 2) base_image
1095− image = base_image <-> background_fill 10 2 <-> cropped_image
1096− output_image_and_wait image
1097− , 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|
10981103 1. Verify the bottom text block is the right half of the top block. Ellipses on the left edge are OK.
10991104 2. press enter.
11001105 3. the display should return to the state before the test.
11011106|]
1102− , confirm_results = generic_output_match_confirm
1107+ , confirmResults = genericOutputMatchConfirm
1108+ }
1109+
1110+layer0 :: Test
1111+layer0 = Test
1112+ { testName = "verify layer 0"
1113+ , testID = "layer0"
1114+ , testAction = do
1115+ let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1116+ lowerImage = vertCat $ map (string defAttr) lorumIpsum
1117+ p = picForLayers [upperImage, lowerImage]
1118+ outputPicAndWait p
1119+ , printSummary = putStr $ [s|
1120+ 1. Verify the text block appears to be Chinese text placed on top Latin text.
1121+ 2. press enter.
1122+ 3. the display should return to the state before the test.
1123+|]
1124+ , confirmResults = genericOutputMatchConfirm
1125+ }
1126+
1127+layer1 :: Test
1128+layer1 = Test
1129+ { testName = "verify layer 1"
1130+ , testID = "layer1"
1131+ , testAction = do
1132+ let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1133+ block = resize 10 10 upperImage
1134+ layer0 = vertCat $ map (string defAttr) lorumIpsum
1135+ layer1 = charFill (defAttr `withBackColor` blue) '#' 1000 1000
1136+ cheesyAnim0 block [layer0, layer1]
1137+ , printSummary = putStr $ [s|
1138+ 1. Verify the text block appears to be Chinese text moving on top a Latin text.
1139+ Which is all on a background of '#' characters over blue.
1140+ 2. press enter.
1141+ 3. the display should return to the state before the test.
1142+|]
1143+ , confirmResults = genericOutputMatchConfirm
11031144 }
11041145
1105−lorum_ipsum :: [String]
1106−lorum_ipsum = lines [s|
1146+cheesyAnim0 :: Image -> [Image] -> IO ()
1147+cheesyAnim0 i background = do
1148+ t <- standardIOConfig >>= outputForConfig
1149+ reserveDisplay t
1150+ bounds <- displayBounds t
1151+ d <- displayContext t bounds
1152+ forM_ [0..2] $ \t -> do
1153+ forM_ [0..100] $ \t -> do
1154+ let i_offset = translate (t `mod` fst bounds)
1155+ (t `div` 2 `mod` snd bounds)
1156+ i
1157+ let pic = picForLayers $ i_offset : background
1158+ outputPicture d pic
1159+ threadDelay 50000
1160+ forM_ [0..100] $ \t -> do
1161+ let i_offset = translate (t * (-1) `mod` fst bounds)
1162+ (t * (-1) `div` 2 `mod` snd bounds)
1163+ i
1164+ let pic = picForLayers $ i_offset : background
1165+ outputPicture d pic
1166+ threadDelay 50000
1167+ releaseDisplay t
1168+ releaseTerminal t
1169+ return ()
1170+
1171+lorumIpsum :: [String]
1172+lorumIpsum = lines [s|
11071173Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium,
11081174totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae
11091175dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit,
@@ -1115,8 +1181,8 @@ commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate v
11151181molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
11161182|]
11171183
1118−lorum_ipsum_chinese :: [String]
1119−lorum_ipsum_chinese = lines [s|
1184+lorumIpsumChinese :: [String]
1185+lorumIpsumChinese = lines [s|
11201186輐銛 螷蟞覮 裌覅詵 暕 鴅噮 槶 惝掭掝 婸媥媕 耏胠臿, 汫汭沎 忕汌卣 蚡袀 僣 蒮 瀁瀎瀊 渮湸湤 緌翢,
11211187腠腶舝 糲蘥蠩 樏殣氀 蒮 蹢鎒 滍 鸄齴 櫧櫋瀩 鬄鵊鵙 莃荶衒, 毸溠 橀 簎艜薤 莃荶衒 翣聜蒢
11221188斔櫅檷 晛桼桾 拻敁柧 犿玒 膣, 墐 笓粊紒 bacon 鼀齕, 蔝蓶蓨 顊顃餭 姴怤 骱 暕 蹢鎒鎛 藒襓謥 鄻鎟霣