@@ -6,9 +6,9 @@ import Graphics.Vty
66import Graphics.Vty.Attributes
77import Graphics.Vty.Inline
88import Graphics.Vty.Picture
9−import Graphics.Vty.Output
9+import Graphics.Vty.Terminal
10+import Graphics.Vty.DisplayRegion
1011
11−import Control.Concurrent (threadDelay)
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− printIntro
28+ print_intro
2929
30−outputFilePath = "test_results.list"
30+output_file_path = "test_results.list"
3131
32−printIntro = do
32+print_intro = 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− |] ++ outputFilePath ++ [s|
40+ |] ++ output_file_path ++ [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.
@@ -63,43 +63,42 @@ All the tests assume the following about the terminal display:
6363 a good range of the unicode characters. Each test involving unicode display
6464 describes the expected appearance of each glyph.
6565
66−Thanks for the help! :-D
67−To exit the test early enter "q" anytime at the following menu screen.
68−
69−If any test fails then please post an issue to
70− https://github.com/coreyoconnor/vty/issues
71−with the test_results.list file pasted into the issue. A suitable summary is:
72−"interactive terminal test failure".
73−|]
74− waitForReturn
75− results <- doTestMenu 1
76− envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName )
77− ( \ (_ :: SomeException) -> return (envName, "") )
78− )
79− [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
80− t <- standardIOConfig >>= outputForConfig
81− let resultsTxt = show envAttributes ++ "\n"
82− ++ terminalID t ++ "\n"
83− ++ show results ++ "\n"
84− releaseTerminal t
85− writeFile outputFilePath resultsTxt
86−
87−waitForReturn = do
66+Thanks for the help! :-D
67+To exit the test early enter "q" anytime at the following menu screen. Even if
68+you exit the test early please email the test_results.list file to
69+coreyoconnor@gmail.com. The results file will still contain information useful
70+to debug terminal support.
71+
72+|]
73+ wait_for_return
74+ results <- do_test_menu 1
75+ env_attributes <- mapM ( \env_name -> catch ( Env.getEnv env_name >>= return . (,) env_name )
76+ ( \ (_ :: SomeException) -> return (env_name, "") )
77+ )
78+ [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
79+ t <- terminal_handle
80+ let results_txt = show env_attributes ++ "\n"
81+ ++ terminal_ID t ++ "\n"
82+ ++ show results ++ "\n"
83+ release_terminal t
84+ writeFile output_file_path results_txt
85+
86+wait_for_return = do
8887 putStr "\n(press return to continue)"
8988 hFlush stdout
9089 getLine
9190
92−testMenu :: [(String, Test)]
93−testMenu = zip (map show [1..]) allTests
91+test_menu :: [(String, Test)]
92+test_menu = zip (map show [1..]) all_tests
9493
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"
94+do_test_menu :: Int -> IO [(String, Bool)]
95+do_test_menu next_ID
96+ | next_ID > length all_tests = do
97+ putStrLn $ "Done! Please email the " ++ output_file_path ++ " file to coreyoconnor@gmail.com"
9998 return []
10099 | otherwise = do
101− displayTestMenu
102− putStrLn $ "Press return to start with #" ++ show nextID ++ "."
100+ display_test_menu
101+ putStrLn $ "Press return to start with #" ++ show next_ID ++ "."
103102 putStrLn "Enter a test number to perform only that test."
104103 putStrLn "q (or control-C) to quit."
105104 putStr "> "
@@ -107,102 +106,92 @@ doTestMenu nextID
107106 s <- getLine >>= return . filter (/= '\n')
108107 case s of
109108 "q" -> return mempty
110− "" -> do
111− r <- runTest $ show nextID
112− rs <- doTestMenu ( nextID + 1 )
109+ "" -> do
110+ r <- run_test $ show next_ID
111+ rs <- do_test_menu ( next_ID + 1 )
113112 return $ r : rs
114− i | isJust ( lookup i testMenu ) -> do
115− r <- runTest i
116− rs <- doTestMenu ( read i + 1 )
113+ i | isJust ( lookup i test_menu ) -> do
114+ r <- run_test i
115+ rs <- do_test_menu ( read i + 1 )
117116 return $ r : rs
118117 where
119− displayTestMenu
120− = mapM_ displayTestMenu' testMenu
121− displayTestMenu' ( i, t )
122− = putStrLn $ ( if i == show nextID
123− then "> "
118+ display_test_menu
119+ = mapM_ display_test_menu' test_menu
120+ display_test_menu' ( i, t )
121+ = putStrLn $ ( if i == show next_ID
122+ then "> "
124123 else " "
125− ) ++ i ++ ". " ++ testName t
126−
127−runTest :: String -> IO (String, Bool)
128−runTest i = do
129− let t = fromJust $ lookup i testMenu
130− printSummary t
131− waitForReturn
132− testAction t
133− r <- confirmResults t
134− return (testID t, r)
135−
136−defaultSuccessConfirmResults = do
124+ ) ++ i ++ ". " ++ test_name t
125+
126+run_test :: String -> IO (String, Bool)
127+run_test i = do
128+ let t = fromJust $ lookup i test_menu
129+ print_summary t
130+ wait_for_return
131+ test_action t
132+ r <- confirm_results t
133+ return (test_ID t, r)
134+
135+default_success_confirm_results = do
137136 putStr "\n"
138137 putStr "[Y/n] "
139138 hFlush stdout
140139 r <- getLine
141140 case r of
142− "" -> return True
141+ "" -> return True
143142 "y" -> return True
144143 "Y" -> return True
145144 "n" -> return False
146145
147146data Test = Test
148− { testName :: String
149− , testID :: String
150− , testAction :: IO ()
151− , printSummary :: IO ()
152− , confirmResults :: IO Bool
147+ { test_name :: String
148+ , test_ID :: String
149+ , test_action :: IO ()
150+ , print_summary :: IO ()
151+ , confirm_results :: IO Bool
153152 }
154153
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
154+all_tests
155+ = [ reserve_output_test
156+ , display_bounds_test_0
157+ , display_bounds_test_1
158+ , display_bounds_test_2
159+ , display_bounds_test_3
160+ , unicode_single_width_0
161+ , unicode_single_width_1
162+ , unicode_double_width_0
163+ , unicode_double_width_1
164+ , attributes_test_0
165+ , attributes_test_1
166+ , attributes_test_2
167+ , attributes_test_3
168+ , attributes_test_4
169+ , attributes_test_5
170+ , inline_test_0
171+ , inline_test_1
172+ , inline_test_2
173+ , cursor_hide_test_0
185174 ]
186175
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
176+reserve_output_test = Test
177+ { test_name = "Initialize and reserve terminal output then restore previous state."
178+ , test_ID = "reserve_output_test"
179+ , test_action = do
180+ t <- terminal_handle
181+ reserve_display t
193182 putStrLn "Line 1"
194183 putStrLn "Line 2"
195184 putStrLn "Line 3"
196185 putStrLn "Line 4 (press return)"
197186 hFlush stdout
198187 getLine
199− releaseDisplay t
200− releaseTerminal t
188+ release_display t
189+ release_terminal t
201190 return ()
202− , printSummary = do
191+ , print_summary = do
203192 putStr $ [s|
204193Once return is pressed:
205− 0. The screen will be cleared.
194+ 0. The screen will be cleared.
206195 1. Four lines of text should be visible.
207196 1. The cursor should be visible and at the start of the fifth line.
208197
@@ -210,143 +199,139 @@ After return is pressed for the second time this test then:
210199 * The screen containing the test summary should be restored;
211200 * The cursor is visible.
212201|]
213− , confirmResults = do
202+ , confirm_results = do
214203 putStr $ [s|
215204Did the test output match the description?
216205|]
217− defaultSuccessConfirmResults
206+ default_success_confirm_results
218207 }
219208
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
209+display_bounds_test_0 = Test
210+ { test_name = "Verify display bounds are correct test 0: Using spaces."
211+ , test_ID = "display_bounds_test_0"
212+ , test_action = do
213+ t <- terminal_handle
214+ reserve_display t
215+ DisplayRegion w h <- display_bounds t
216+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
217+ row_h = replicate (fromEnum w - 1) 'X'
218+ row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
219+ image = row_0 ++ (concat $ replicate (fromEnum h - 2) row_n) ++ row_h
231220 putStr image
232221 hFlush stdout
233222 getLine
234− releaseDisplay t
235− releaseTerminal t
223+ release_display t
224+ release_terminal t
236225 return ()
237− , printSummary = displayBoundsTestSummary True
238− , confirmResults = genericOutputMatchConfirm
226+ , print_summary = display_bounds_test_summary True
227+ , confirm_results = generic_output_match_confirm
239228 }
240229
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
230+display_bounds_test_1 = Test
231+ { test_name = "Verify display bounds are correct test 0: Using cursor movement."
232+ , test_ID = "display_bounds_test_1"
233+ , test_action = do
234+ t <- terminal_handle
235+ reserve_display t
236+ DisplayRegion w h <- display_bounds t
237+ set_cursor_pos t 0 0
238+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
239+ putStr row_0
251240 forM_ [1 .. h - 2] $ \y -> do
252− setCursorPos t 0 y
241+ set_cursor_pos t 0 y
253242 putStr "X"
254243 hFlush stdout
255− setCursorPos t (w - 1) y
244+ set_cursor_pos t (w - 1) y
256245 putStr "X"
257246 hFlush stdout
258− setCursorPos t 0 (h - 1)
259− let rowH = replicate (fromEnum w - 1) 'X'
260− putStr rowH
247+ set_cursor_pos t 0 (h - 1)
248+ let row_h = replicate (fromEnum w - 1) 'X'
249+ putStr row_h
261250 hFlush stdout
262251 getLine
263− releaseDisplay t
264− releaseTerminal t
252+ release_display t
253+ release_terminal t
265254 return ()
266− , printSummary = displayBoundsTestSummary True
267− , confirmResults = genericOutputMatchConfirm
255+ , print_summary = display_bounds_test_summary True
256+ , confirm_results = generic_output_match_confirm
268257 }
269258
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
259+display_bounds_test_2 = Test
260+ { test_name = "Verify display bounds are correct test 0: Using Image ops."
261+ , test_ID = "display_bounds_test_2"
262+ , test_action = do
263+ t <- terminal_handle
264+ reserve_display t
265+ bounds@(DisplayRegion w h) <- display_bounds t
266+ let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')
267+ middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row
268+ middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')
269+ end_row = first_row
270+ image = first_row <-> middle_rows <-> end_row
271+ pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) }
272+ d <- display_context t bounds
273+ output_picture d pic
285274 getLine
286− releaseDisplay t
287− releaseTerminal t
275+ release_display t
276+ release_terminal t
288277 return ()
289− , printSummary = displayBoundsTestSummary True
290− , confirmResults = genericOutputMatchConfirm
278+ , print_summary = display_bounds_test_summary True
279+ , confirm_results = generic_output_match_confirm
291280 }
292281
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
282+display_bounds_test_3 = Test
283+ { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
284+ , test_ID = "display_bounds_test_3"
285+ , test_action = do
286+ t <- terminal_handle
287+ reserve_display t
288+ DisplayRegion w h <- display_bounds t
289+ hide_cursor t
290+ set_cursor_pos t 0 0
291+ let row_0 = replicate (fromEnum w) 'X'
292+ putStrLn row_0
304293 forM_ [1 .. h - 2] $ \y -> do
305− setCursorPos t 0 y
294+ set_cursor_pos t 0 y
306295 putStr "X"
307296 hFlush stdout
308− setCursorPos t (w - 1) y
297+ set_cursor_pos t (w - 1) y
309298 putStr "X"
310299 hFlush stdout
311− setCursorPos t 0 (h - 1)
312− let rowH = row0
313− putStr rowH
300+ set_cursor_pos t 0 (h - 1)
301+ let row_h = row_0
302+ putStr row_h
314303 hFlush stdout
315304 getLine
316− showCursor t
317− releaseDisplay t
318− releaseTerminal t
305+ show_cursor t
306+ release_display t
307+ release_terminal t
319308 return ()
320− , printSummary = displayBoundsTestSummary False
321− , confirmResults = genericOutputMatchConfirm
309+ , print_summary = display_bounds_test_summary False
310+ , confirm_results = generic_output_match_confirm
322311 }
323312
324−displayBoundsTestSummary hasCursor = do
313+display_bounds_test_summary has_cursor = do
325314 putStr $ [s|
326315Once return is pressed:
327316 0. The screen will be cleared.
328317|]
329− if hasCursor
318+ if has_cursor
330319 then putStr " 1. The cursor will be visible."
331320 else putStr " 1. The cursor will NOT be visible."
332321 putStr [s|
333−
334322 2. The border of the display will be outlined in Xs.
335323 So if - and | represented the edge of the terminal window:
336324 |-------------|
337325 |XXXXXXXXXXXXX|
338326 |X X||]
339327
340− if hasCursor
328+ if has_cursor
341329 then putStr $ [s|
342−
343330 |XXXXXXXXXXXXC| |]
344331 else putStr $ [s|
345−
346332 |XXXXXXXXXXXXX| |]
347333
348334 putStr $ [s|
349−
350335 |-------------|
351336
352337 ( Where C is the final position of the cursor. There may be an X drawn
@@ -358,13 +343,13 @@ After return is pressed for the second time:
358343 1. The cursor should be visible.
359344|]
360345
361−genericOutputMatchConfirm = do
346+generic_output_match_confirm = do
362347 putStr $ [s|
363348Did the test output match the description?
364349|]
365− defaultSuccessConfirmResults
350+ default_success_confirm_results
366351
367−-- Explicitly define the bytes that encode each example text.
352+-- Explicitely definethe bytes that encode each example text.
368353-- This avoids any issues with how the compiler represents string literals.
369354--
370355-- This document is UTF-8 encoded so the UTF-8 string is still included for
@@ -373,24 +358,24 @@ Did the test output match the description?
373358-- It's assumed the compiler will at least not barf on UTF-8 encoded text in
374359-- comments ;-)
375360--
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
361+-- txt_0 = ↑↑↓↓←→←→BA
362+
363+utf8_txt_0 :: [[Word8]]
364+utf8_txt_0 = [ [ 0xe2 , 0x86 , 0x91 ]
365+ , [ 0xe2 , 0x86 , 0x91 ]
366+ , [ 0xe2 , 0x86 , 0x93 ]
367+ , [ 0xe2 , 0x86 , 0x93 ]
368+ , [ 0xe2 , 0x86 , 0x90 ]
369+ , [ 0xe2 , 0x86 , 0x92 ]
370+ , [ 0xe2 , 0x86 , 0x90 ]
371+ , [ 0xe2 , 0x86 , 0x92 ]
372+ , [ 0x42 ]
373+ , [ 0x41 ]
374+ ]
375+
376+iso_10646_txt_0 :: String
377+iso_10646_txt_0 = map toEnum
378+ [ 8593
394379 , 8593
395380 , 8595
396381 , 8595
@@ -402,46 +387,46 @@ iso10646Txt0 = map toEnum
402387 , 65
403388 ]
404389
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)
390+unicode_single_width_0 = Test
391+ { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
392+ , test_ID = "unicode_single_width_0"
393+ , test_action = do
394+ t <- terminal_handle
395+ reserve_display t
396+ hide_cursor t
397+ withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout)
413398 hPutStr stdout "\n"
414399 hPutStr stdout "0123456789\n"
415400 hFlush stdout
416401 getLine
417− releaseDisplay t
418− releaseTerminal t
402+ release_display t
403+ release_terminal t
419404 return ()
420− , printSummary = unicodeSingleWidthSummary
421− , confirmResults = genericOutputMatchConfirm
405+ , print_summary = unicode_single_width_summary
406+ , confirm_results = generic_output_match_confirm
422407 }
423408
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
409+unicode_single_width_1 = Test
410+ { test_name = "Verify terminal can display unicode single-width characters. (Image ops)"
411+ , test_ID = "unicode_single_width_1"
412+ , test_action = do
413+ t <- terminal_handle
414+ reserve_display t
415+ let pic = pic_for_image image
416+ image = line_0 <-> line_1
417+ line_0 = iso_10646_string def_attr iso_10646_txt_0
418+ line_1 = string def_attr "0123456789"
419+ d <- display_bounds t >>= display_context t
420+ output_picture d pic
436421 getLine
437− releaseDisplay t
438− releaseTerminal t
422+ release_display t
423+ release_terminal t
439424 return ()
440− , printSummary = unicodeSingleWidthSummary
441− , confirmResults = genericOutputMatchConfirm
425+ , print_summary = unicode_single_width_summary
426+ , confirm_results = generic_output_match_confirm
442427 }
443428
444−unicodeSingleWidthSummary = putStr [s|
429+unicode_single_width_summary = putStr [s|
445430Once return is pressed:
446431 0. The screen will be cleared.
447432 1. The cursor will be hidden.
@@ -475,55 +460,55 @@ After return is pressed for the second time:
475460
476461-- The second example is a unicode string containing double-width glyphs
477462-- 你好吗
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)
463+utf8_txt_1 :: [[Word8]]
464+utf8_txt_1 = [ [0xe4,0xbd,0xa0]
465+ , [0xe5,0xa5,0xbd]
466+ , [0xe5,0x90,0x97]
467+ ]
468+
469+iso_10646_txt_1 :: String
470+iso_10646_txt_1 = map toEnum [20320,22909,21527]
471+
472+unicode_double_width_0 = Test
473+ { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
474+ , test_ID = "unicode_double_width_0"
475+ , test_action = do
476+ t <- terminal_handle
477+ reserve_display t
478+ hide_cursor t
479+ withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout)
495480 hPutStr stdout "\n"
496481 hPutStr stdout "012345\n"
497482 hFlush stdout
498483 getLine
499− releaseDisplay t
500− releaseTerminal t
484+ release_display t
485+ release_terminal t
501486 return ()
502− , printSummary = unicodeDoubleWidthSummary
503− , confirmResults = genericOutputMatchConfirm
487+ , print_summary = unicode_double_width_summary
488+ , confirm_results = generic_output_match_confirm
504489 }
505490
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
491+unicode_double_width_1 = Test
492+ { test_name = "Verify terminal can display unicode double-width characters. (Image ops)"
493+ , test_ID = "unicode_double_width_1"
494+ , test_action = do
495+ t <- terminal_handle
496+ reserve_display t
497+ let pic = pic_for_image image
498+ image = line_0 <-> line_1
499+ line_0 = iso_10646_string def_attr iso_10646_txt_1
500+ line_1 = string def_attr "012345"
501+ d <- display_bounds t >>= display_context t
502+ output_picture d pic
518503 getLine
519− releaseDisplay t
520− releaseTerminal t
504+ release_display t
505+ release_terminal t
521506 return ()
522− , printSummary = unicodeDoubleWidthSummary
523− , confirmResults = genericOutputMatchConfirm
507+ , print_summary = unicode_double_width_summary
508+ , confirm_results = generic_output_match_confirm
524509 }
525510
526−unicodeDoubleWidthSummary = putStr [s|
511+unicode_double_width_summary = putStr [s|
527512Once return is pressed:
528513 0. The screen will be cleared.
529514 1. The cursor will be hidden.
@@ -550,32 +535,32 @@ After return is pressed for the second time:
550535 1. The cursor should be visible.
551536|]
552537
553−allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
554− [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
538+all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
539+ [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
555540
556−allBrightColors
557− = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]
541+all_bright_colors
542+ = zip [ bright_black, bright_red, bright_green, bright_yellow, bright_blue, bright_magenta, bright_cyan, bright_white ]
558543 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]
559544
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
545+attributes_test_0 = Test
546+ { test_name = "Character attributes: foreground colors."
547+ , test_ID = "attributes_test_0"
548+ , test_action = do
549+ t <- terminal_handle
550+ reserve_display t
551+ let pic = pic_for_image image
552+ image = border <|> column_0 <|> border <|> column_1 <|> border
553+ column_0 = vert_cat $ map line_with_color all_colors
554+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
555+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
556+ line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name
557+ d <- display_bounds t >>= display_context t
558+ output_picture d pic
574559 getLine
575− releaseDisplay t
576− releaseTerminal t
560+ release_display t
561+ release_terminal t
577562 return ()
578− , printSummary = do
563+ , print_summary = do
579564 putStr $ [s|
580565Once return is pressed:
581566 0. The screen will be cleared.
@@ -596,32 +581,32 @@ After return is pressed for the second time:
596581 0. The screen containing the test summary should be restored.
597582 1. The cursor should be visible.
598583|]
599− , confirmResults = do
584+ , confirm_results = do
600585 putStr $ [s|
601586Did the test output match the description?
602587|]
603− defaultSuccessConfirmResults
588+ default_success_confirm_results
604589 }
605590
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
591+attributes_test_1 = Test
592+ { test_name = "Character attributes: background colors."
593+ , test_ID = "attributes_test_1"
594+ , test_action = do
595+ t <- terminal_handle
596+ reserve_display t
597+ let pic = pic_for_image image
598+ image = border <|> column_0 <|> border <|> column_1 <|> border
599+ column_0 = vert_cat $ map line_with_color all_colors
600+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
601+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
602+ line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name
603+ d <- display_bounds t >>= display_context t
604+ output_picture d pic
620605 getLine
621− releaseDisplay t
622− releaseTerminal t
606+ release_display t
607+ release_terminal t
623608 return ()
624− , printSummary = do
609+ , print_summary = do
625610 putStr $ [s|
626611Once return is pressed:
627612 0. The screen will be cleared.
@@ -651,57 +636,57 @@ After return is pressed for the second time:
651636 0. The screen containing the test summary should be restored.
652637 1. The cursor should be visible.
653638|]
654− , confirmResults = do
639+ , confirm_results = do
655640 putStr $ [s|
656641Did the test output match the description?
657642|]
658− defaultSuccessConfirmResults
643+ default_success_confirm_results
659644 }
660645
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
646+attributes_test_2 = Test
647+ { test_name = "Character attributes: Vivid foreground colors."
648+ , test_ID = "attributes_test_2"
649+ , test_action = do
650+ t <- terminal_handle
651+ reserve_display t
652+ let pic = pic_for_image image
653+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
654+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
655+ column_0 = vert_cat $ map line_with_color_0 all_colors
656+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
657+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
658+ line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name
659+ line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name
660+ d <- display_bounds t >>= display_context t
661+ output_picture d pic
677662 getLine
678− releaseDisplay t
679− releaseTerminal t
663+ release_display t
664+ release_terminal t
680665 return ()
681− , printSummary = do
666+ , print_summary = do
682667 putStr $ [s|
683668Once return is pressed:
684669 0. The screen will be cleared.
685670 1. The cursor will be hidden.
686671 2. 9 lines of text in three columns will be drawn:
687672 a. The first column will be a name of a standard color (for an 8 color
688− terminal) rendered with that color as the foreground color.
673+ terminal) rendered with that color as the foreground color.
689674 b. The next column will be also be the name of a standard color rendered
690675 with that color as the foreground color but the shade used should be
691− more vivid than the shade used in the first column.
676+ more vivid than the shade used in the first column.
692677 c. The final column will be the name of a color rendered with the
693678 default attributes.
694679
695680For instance, one line will be the word "magenta" and that word should be
696−rendered in the magenta color.
681+rendered in the magenta color.
697682
698683I'm not actually sure exactly what "vivid" means in this context. For xterm the
699−vivid colors are brighter.
684+vivid colors are brighter.
700685
701−Verify:
686+Verify:
702687 * The first column: The foreground color matches the named color.
703688 * The second column: The foreground color matches the named color but is
704− more vivid than the color used in the first column.
689+ more vivid than the color used in the first column.
705690 * The third column: All text is rendered with the default attributes.
706691 * The vertical bars used in each line to mark the border of a column are
707692 lined up.
@@ -710,34 +695,34 @@ After return is pressed for the second time:
710695 0. The screen containing the test summary should be restored.
711696 1. The cursor should be visible.
712697|]
713− , confirmResults = do
698+ , confirm_results = do
714699 putStr $ [s|
715700Did the test output match the description?
716701|]
717− defaultSuccessConfirmResults
702+ default_success_confirm_results
718703 }
719704
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
705+attributes_test_3 = Test
706+ { test_name = "Character attributes: Vivid background colors."
707+ , test_ID = "attributes_test_3"
708+ , test_action = do
709+ t <- terminal_handle
710+ reserve_display t
711+ let pic = pic_for_image image
712+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
713+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
714+ column_0 = vert_cat $ map line_with_color_0 all_colors
715+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
716+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
717+ line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name
718+ line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name
719+ d <- display_bounds t >>= display_context t
720+ output_picture d pic
736721 getLine
737− releaseDisplay t
738− releaseTerminal t
722+ release_display t
723+ release_terminal t
739724 return ()
740− , printSummary = do
725+ , print_summary = do
741726 putStr $ [s|
742727Once return is pressed:
743728 0. The screen will be cleared.
@@ -745,23 +730,23 @@ Once return is pressed:
745730 2. 9 lines of text in three columns will be drawn:
746731 a. The first column will contain be a name of a standard color for an 8
747732 color terminal rendered with the default foreground color with a
748− background the named color.
733+ background the named color.
749734 b. The first column will contain be a name of a standard color for an 8
750735 color terminal rendered with the default foreground color with the
751− background a vivid version of the named color.
736+ background a vivid version of the named color.
752737 c. The third column will be the name of a standard color rendered with
753738 the default attributes.
754−
739+
755740For instance, one line will contain be the word "magenta" and the word should
756−be rendered in the default foreground color over a magenta background.
741+be rendered in the default foreground color over a magenta background.
757742
758743I'm not actually sure exactly what "vivid" means in this context. For xterm the
759744vivid colors are brighter.
760745
761−Verify:
746+Verify:
762747 * The first column: The background color matches the named color.
763748 * The second column: The background color matches the named color and is
764− more vivid than the color used in the first column.
749+ more vivid than the color used in the first column.
765750 * The third column column: All text is rendered with the default attributes.
766751 * The vertical bars used in each line to mark the border of a column are
767752 lined up.
@@ -777,51 +762,51 @@ After return is pressed for the second time:
777762 0. The screen containing the test summary should be restored.
778763 1. The cursor should be visible.
779764|]
780− , confirmResults = do
765+ , confirm_results = do
781766 putStr $ [s|
782767Did the test output match the description?
783768|]
784− defaultSuccessConfirmResults
769+ default_success_confirm_results
785770 }
786771
787−attrCombos =
772+attr_combos =
788773 [ ( "default", id )
789− , ( "bold", flip withStyle bold )
790− , ( "blink", flip withStyle blink )
791− , ( "underline", flip withStyle underline )
792− , ( "bold + blink", flip withStyle (bold + blink) )
793− , ( "bold + underline", flip withStyle (bold + underline) )
794− , ( "underline + blink", flip withStyle (underline + blink) )
795− , ( "bold + blink + underline", flip withStyle (bold + blink + underline) )
774+ , ( "bold", flip with_style bold )
775+ , ( "blink", flip with_style blink )
776+ , ( "underline", flip with_style underline )
777+ , ( "bold + blink", flip with_style (bold + blink) )
778+ , ( "bold + underline", flip with_style (bold + underline) )
779+ , ( "underline + blink", flip with_style (underline + blink) )
780+ , ( "bold + blink + underline", flip with_style (bold + blink + underline) )
796781 ]
797782
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
783+attributes_test_4 = Test
784+ { test_name = "Character attributes: Bold; Blink; Underline."
785+ , test_ID = "attributes_test_4"
786+ , test_action = do
787+ t <- terminal_handle
788+ reserve_display t
789+ let pic = pic_for_image image
790+ image = horiz_cat [border, column_0, border, column_1, border]
791+ border = vert_cat $ replicate (length attr_combos) $ string def_attr " | "
792+ column_0 = vert_cat $ map line_with_attrs attr_combos
793+ column_1 = vert_cat $ map (string def_attr . fst) attr_combos
794+ line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc
795+ d <- display_bounds t >>= display_context t
796+ output_picture d pic
812797 getLine
813− releaseDisplay t
814− releaseTerminal t
798+ release_display t
799+ release_terminal t
815800 return ()
816− , printSummary = do
801+ , print_summary = do
817802 putStr $ [s|
818803Once return is pressed:
819804 0. The screen will be cleared.
820805 1. The cursor will be hidden.
821− 2. 8 rows of text in two columns.
806+ 2. 8 rows of text in two columns.
822807 The rows will contain the following text:
823808 default
824− bold
809+ bold
825810 blink
826811 underline
827812 bold + blink
@@ -830,8 +815,8 @@ Once return is pressed:
830815 bold + blink + underline
831816 The first column will be rendered with the described attributes. The second
832817 column will be rendered with the default attributes.
833−
834−Verify:
818+
819+Verify:
835820 * The vertical bars used in each line to mark the border of a column are
836821 lined up.
837822 * The text in the first column is rendered as described.
@@ -840,31 +825,31 @@ After return is pressed for the second time:
840825 0. The screen containing the test summary should be restored.
841826 1. The cursor should be visible.
842827|]
843− , confirmResults = do
828+ , confirm_results = do
844829 putStr $ [s|
845830Did the test output match the description?
846831|]
847− defaultSuccessConfirmResults
832+ default_success_confirm_results
848833 }
849834
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
835+attributes_test_5 = Test
836+ { test_name = "Character attributes: 240 color palette"
837+ , test_ID = "attributes_test_5"
838+ , test_action = do
839+ t <- terminal_handle
840+ reserve_display t
841+ let pic = pic_for_image image
842+ image = vert_cat $ map horiz_cat $ split_color_images color_images
843+ color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239]
844+ split_color_images [] = []
845+ split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is))
846+ d <- display_bounds t >>= display_context t
847+ output_picture d pic
863848 getLine
864− releaseDisplay t
865− releaseTerminal t
849+ release_display t
850+ release_terminal t
866851 return ()
867− , printSummary = do
852+ , print_summary = do
868853 putStr $ [s|
869854Once return is pressed:
870855 0. The screen will be cleared.
@@ -872,321 +857,95 @@ Once return is pressed:
872857 2. A 20 character wide and 12 row high block of color squares. This should look like a palette
873858 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...
874859
875−Verify:
860+Verify:
876861
877862After return is pressed for the second time:
878863 0. The screen containing the test summary should be restored.
879864 1. The cursor should be visible.
880865|]
881− , confirmResults = do
866+ , confirm_results = do
882867 putStr $ [s|
883868Did the test output match the description?
884869|]
885− defaultSuccessConfirmResults
870+ default_success_confirm_results
886871 }
887872
888−inlineTest0 = Test
889− { testName = "Verify styled output can be performed without clearing the screen."
890− , testID = "inlineTest0"
891− , testAction = do
873+inline_test_0 = Test
874+ { test_name = "Verify styled output can be performed without clearing the screen."
875+ , test_ID = "inline_test_0"
876+ , test_action = do
877+ t <- terminal_handle
892878 putStrLn "line 1."
893− putAttrChange_ $ backColor red >> applyStyle underline
879+ put_attr_change t $ back_color red >> apply_style underline
894880 putStrLn "line 2."
895− putAttrChange_ $ defaultAll
881+ put_attr_change t $ default_all
896882 putStrLn "line 3."
897− , printSummary = putStr $ [s|
883+ release_terminal t
884+ return ()
885+ , print_summary = putStr $ [s|
898886lines are in order.
899887The second line "line 2" should have a red background and the text underline.
900888The third line "line 3" should be drawn in the same style as the first line.
901889|]
902890
903− , confirmResults = genericOutputMatchConfirm
891+ , confirm_results = generic_output_match_confirm
904892 }
905893
906−inlineTest1 = Test
907− { testName = "Verify styled output can be performed without clearing the screen."
908− , testID = "inlineTest1"
909− , testAction = do
894+inline_test_1 = Test
895+ { test_name = "Verify styled output can be performed without clearing the screen."
896+ , test_ID = "inline_test_1"
897+ , test_action = do
898+ t <- terminal_handle
910899 putStr "Not styled. "
911− putAttrChange_ $ backColor red >> applyStyle underline
900+ put_attr_change t $ back_color red >> apply_style underline
912901 putStr " Styled! "
913− putAttrChange_ $ defaultAll
902+ put_attr_change t $ default_all
914903 putStrLn "Not styled."
915− , printSummary = putStr $ [s|
904+ release_terminal t
905+ return ()
906+ , print_summary = putStr $ [s|
916907|]
917908
918− , confirmResults = genericOutputMatchConfirm
909+ , confirm_results = generic_output_match_confirm
919910 }
920911
921−inlineTest2 = Test
922− { testName = "Verify styled output can be performed without clearing the screen."
923− , testID = "inlineTest1"
924− , testAction = do
912+inline_test_2 = Test
913+ { test_name = "Verify styled output can be performed without clearing the screen."
914+ , test_ID = "inline_test_1"
915+ , test_action = do
916+ t <- terminal_handle
925917 putStr "Not styled. "
926− putAttrChange_ $ backColor red >> applyStyle underline
918+ put_attr_change t $ back_color red >> apply_style underline
927919 putStr " Styled! "
928− putAttrChange_ $ defaultAll
920+ put_attr_change t $ default_all
929921 putStr "Not styled.\n"
930− , printSummary = putStr $ [s|
922+ release_terminal t
923+ return ()
924+ , print_summary = putStr $ [s|
931925|]
932− , confirmResults = genericOutputMatchConfirm
926+ , confirm_results = generic_output_match_confirm
933927 }
934928
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
929+cursor_hide_test_0 :: Test
930+cursor_hide_test_0 = Test
931+ { test_name = "Verify the cursor is hid and re-shown. issue #7"
932+ , test_ID = "cursor_hide_test_0"
933+ , test_action = do
934+ vty <- mkVty
935+ show_cursor $ terminal vty
936+ set_cursor_pos (terminal vty) 5 5
937+ next_event vty
938+ hide_cursor $ terminal vty
939+ next_event vty
946940 shutdown vty
947941 return ()
948− , printSummary = putStr $ [s|
942+ , print_summary = putStr $ [s|
949943 1. verify the cursor is displayed.
950944 2. press enter
951945 3. verify the cursor is hid.
952946 4. press enter.
953947 5. the display should return to the state before the test.
954948|]
955− , confirmResults = genericOutputMatchConfirm
956− }
957−
958−outputImageAndWait :: Image -> IO ()
959−outputImageAndWait image = do
960− let pic = picForImage image
961− outputPicAndWait pic
962−
963−outputPicAndWait :: Picture -> IO ()
964−outputPicAndWait pic = do
965− t <- standardIOConfig >>= outputForConfig
966− reserveDisplay t
967− d <- displayBounds t >>= displayContext t
968− outputPicture d pic
969− getLine
970− releaseDisplay t
971− releaseTerminal t
972− return ()
973−
974−vertCropTest0 :: Test
975−vertCropTest0 = Test
976− { testName = "Verify bottom cropping works as expected with single column chars"
977− , testID = "cropTest0"
978− , testAction = do
979− let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsum
980− block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsum
981− image = block0 <-> backgroundFill 10 2 <-> block1
982− outputImageAndWait image
983− , printSummary = putStr $ [s|
984− 1. Verify the two text blocks are identical.
985− 2. press enter.
986− 3. the display should return to the state before the test.
987−|]
988− , confirmResults = genericOutputMatchConfirm
989− }
990−
991−vertCropTest1 :: Test
992−vertCropTest1 = Test
993− { testName = "Verify bottom cropping works as expected with double column chars"
994− , testID = "cropTest0"
995− , testAction = do
996− let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
997− block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsumChinese
998− image = block0 <-> backgroundFill 10 2 <-> block1
999− outputImageAndWait image
1000− , printSummary = putStr $ [s|
1001− 1. Verify the two text blocks are identical.
1002− 2. press enter.
1003− 3. the display should return to the state before the test.
1004−|]
1005− , confirmResults = genericOutputMatchConfirm
1006− }
1007−
1008−vertCropTest2 :: Test
1009−vertCropTest2 = Test
1010− { testName = "Verify top cropping works as expected with single column chars"
1011− , testID = "cropTest2"
1012− , testAction = do
1013− let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsum
1014− block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsum - 2) lorumIpsum
1015− image = block0 <-> backgroundFill 10 2 <-> block1
1016− outputImageAndWait image
1017− , printSummary = putStr $ [s|
1018− 1. Verify the two text blocks are identical.
1019− 2. press enter.
1020− 3. the display should return to the state before the test.
1021−|]
1022− , confirmResults = genericOutputMatchConfirm
1023− }
1024−
1025−vertCropTest3 :: Test
1026−vertCropTest3 = Test
1027− { testName = "Verify top cropping works as expected with double column chars"
1028− , testID = "cropTest0"
1029− , testAction = do
1030− let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
1031− block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsumChinese - 2 ) lorumIpsumChinese
1032− image = block0 <-> backgroundFill 10 2 <-> block1
1033− outputImageAndWait image
1034− , printSummary = putStr $ [s|
1035− 1. Verify the two text blocks are identical.
1036− 2. press enter.
1037− 3. the display should return to the state before the test.
1038−|]
1039− , confirmResults = genericOutputMatchConfirm
1040− }
1041−
1042−horizCropTest0 :: Test
1043−horizCropTest0 = Test
1044− { testName = "Verify right cropping works as expected with single column chars"
1045− , testID = "cropTest0"
1046− , testAction = do
1047− let baseImage = vertCat $ map (string defAttr) lorumIpsum
1048− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1049− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1050− outputImageAndWait image
1051− , printSummary = putStr $ [s|
1052− 1. Verify the bottom text block is about half the width of the top text block.
1053− 2. press enter.
1054− 3. the display should return to the state before the test.
1055−|]
1056− , confirmResults = genericOutputMatchConfirm
1057− }
1058−
1059−horizCropTest1 :: Test
1060−horizCropTest1 = Test
1061− { testName = "Verify right cropping works as expected with double column chars"
1062− , testID = "cropTest0"
1063− , testAction = do
1064− let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1065− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1066− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1067− outputImageAndWait image
1068− , printSummary = putStr $ [s|
1069− 1. Verify the bottom text block is the left half of the top block. Ellipses on the right edge are OK.
1070− 2. press enter.
1071− 3. the display should return to the state before the test.
1072−|]
1073− , confirmResults = genericOutputMatchConfirm
1074− }
1075−
1076−horizCropTest2 :: Test
1077−horizCropTest2 = Test
1078− { testName = "Verify left cropping works as expected with single column chars"
1079− , testID = "cropTest0"
1080− , testAction = do
1081− let baseImage = vertCat $ map (string defAttr) lorumIpsum
1082− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1083− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1084− outputImageAndWait image
1085− , printSummary = putStr $ [s|
1086− 1. Verify the bottom text block is the right half of the top text block.
1087− 2. press enter.
1088− 3. the display should return to the state before the test.
1089−|]
1090− , confirmResults = genericOutputMatchConfirm
949+ , confirm_results = generic_output_match_confirm
1091950 }
1092951
1093−horizCropTest3 :: Test
1094−horizCropTest3 = Test
1095− { testName = "Verify right cropping works as expected with double column chars"
1096− , testID = "cropTest0"
1097− , testAction = do
1098− let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1099− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1100− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1101− outputImageAndWait image
1102− , printSummary = putStr $ [s|
1103− 1. Verify the bottom text block is the right half of the top block. Ellipses on the left edge are OK.
1104− 2. press enter.
1105− 3. the display should return to the state before the test.
1106−|]
1107− , confirmResults = genericOutputMatchConfirm
1108− }
1109−
1110−layer0 :: Test
1111−layer0 = Test
1112− { testName = "verify layer 0"
1113− , testID = "layer0"
1114− , testAction = do
1115− let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1116− lowerImage = vertCat $ map (string defAttr) lorumIpsum
1117− p = picForLayers [upperImage, lowerImage]
1118− outputPicAndWait p
1119− , printSummary = putStr $ [s|
1120− 1. Verify the text block appears to be Chinese text placed on top Latin text.
1121− 2. press enter.
1122− 3. the display should return to the state before the test.
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
1144− }
1145−
1146−cheesyAnim0 :: Image -> [Image] -> IO ()
1147−cheesyAnim0 i background = do
1148− t <- standardIOConfig >>= outputForConfig
1149− reserveDisplay t
1150− bounds <- displayBounds t
1151− d <- displayContext t bounds
1152− forM_ [0..2] $ \t -> do
1153− forM_ [0..100] $ \t -> do
1154− let i_offset = translate (t `mod` fst bounds)
1155− (t `div` 2 `mod` snd bounds)
1156− i
1157− let pic = picForLayers $ i_offset : background
1158− outputPicture d pic
1159− threadDelay 50000
1160− forM_ [0..100] $ \t -> do
1161− let i_offset = translate (t * (-1) `mod` fst bounds)
1162− (t * (-1) `div` 2 `mod` snd bounds)
1163− i
1164− let pic = picForLayers $ i_offset : background
1165− outputPicture d pic
1166− threadDelay 50000
1167− releaseDisplay t
1168− releaseTerminal t
1169− return ()
1170−
1171−lorumIpsum :: [String]
1172−lorumIpsum = lines [s|
1173−Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium,
1174−totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae
1175−dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit,
1176−sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam
1177−est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius
1178−modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima
1179−veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea
1180−commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil
1181−molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
1182−|]
1183−
1184−lorumIpsumChinese :: [String]
1185−lorumIpsumChinese = lines [s|
1186−輐銛 螷蟞覮 裌覅詵 暕 鴅噮 槶 惝掭掝 婸媥媕 耏胠臿, 汫汭沎 忕汌卣 蚡袀 僣 蒮 瀁瀎瀊 渮湸湤 緌翢,
1187−腠腶舝 糲蘥蠩 樏殣氀 蒮 蹢鎒 滍 鸄齴 櫧櫋瀩 鬄鵊鵙 莃荶衒, 毸溠 橀 簎艜薤 莃荶衒 翣聜蒢
1188−斔櫅檷 晛桼桾 拻敁柧 犿玒 膣, 墐 笓粊紒 bacon 鼀齕, 蔝蓶蓨 顊顃餭 姴怤 骱 暕 蹢鎒鎛 藒襓謥 鄻鎟霣
1189−鬎鯪, 鐩闤 硻禂稢 谾踘遳 撱 赲 迡 箷 蛃袚觙 萇雊蜩 壿嫷 鋡 縢羱聬 跐鉠鉣 蔝蓶蓨 匢奾灱 溮煡煟 雥齆犪
1190−蔰 虈觿, 腷腯葹 鍹餳駷 蛚袲褁蜸 皯竻 瀁瀎 蜭蜸覟 梪涫湴 揗斝湁 毼
1191−|]
1192−