@@ -2,48 +2,49 @@
2{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3module Main where
3module Main where
5import Graphics.Vty.Attributes
6import Graphics.Vty.Attributes
6−import Graphics.Vty.Image
7import Graphics.Vty.Inline
7import Graphics.Vty.Inline
8import Graphics.Vty.Picture
8import Graphics.Vty.Picture
9−import Graphics.Vty.Terminal
9+import Graphics.Vty.Output
10−import Graphics.Vty.DisplayRegion
11+import Control.Concurrent (threadDelay)
12+import Control.Exception
12import Control.Monad
13import Control.Monad
14import Data.List ( lookup )
15import Data.List ( lookup )
15import Data.Maybe ( isJust, fromJust )
16import Data.Maybe ( isJust, fromJust )
16import Data.Monoid
17import Data.Monoid
17import Data.Word
19import Data.Word
19−import Foreign.Marshal.Array
21+import Foreign.Marshal.Array
22import qualified System.Environment as Env
23import qualified System.Environment as Env
24import System.IO ( hFlush, hPutStr, hPutBuf, stdout )
25import System.IO ( hFlush, hPutStr, hPutBuf, stdout )
27− print_intro
28+ printIntro
29−output_file_path = "test_results.list"
30+outputFilePath = "test_results.list"
31−print_intro = do
32+printIntro = do
32− putStr $ [$heredoc|
33+ putStr $ [s|
33This is an interactive verification program for the terminal input and output
34This is an interactive verification program for the terminal input and output
34support of the VTY library. This will ask a series of questions about what you
35support of the VTY library. This will ask a series of questions about what you
35−see onscreen. The goal is to verify that VTY's output and input support
36+see on screen. The goal is to verify that VTY's output and input support
36performs as expected with your terminal.
37performs as expected with your terminal.
38This program produces a file named
39This program produces a file named
39− |] ++ output_file_path ++ [$heredoc|
40+ |] ++ outputFilePath ++ [s|
40in the current directory that contains the results for each test assertion. This
41in the current directory that contains the results for each test assertion. This
41can be emailed to coreyoconnor@gmail.com and used by the VTY authors to improve
42can be emailed to coreyoconnor@gmail.com and used by the VTY authors to improve
42support for your terminal. No personal information is contained in the report.
43support for your terminal. No personal information is contained in the report.
44Each test follows, more or less, the following format:
45Each test follows, more or less, the following format:
45 0. A description of the test is printed which will include a detailed
46 0. A description of the test is printed which will include a detailed
46− description of what VTY is going to try and what the expected results are.
47+ description of what VTY is going to try and what the expected results are.
47 Press return to move on.
48 Press return to move on.
48 1. The program will produce some output or ask for you to press a key.
49 1. The program will produce some output or ask for you to press a key.
49 2. You will then be asked to confirm if the behavior matched the provided
50 2. You will then be asked to confirm if the behavior matched the provided
@@ -63,32 +64,42 @@ All the tests assume the following about the terminal display:
63 describes the expected appearance of each glyph.
64 describes the expected appearance of each glyph.
65Thanks for the help! :-D
66Thanks for the help! :-D
66−|]
67+To exit the test early enter "q" anytime at the following menu screen.
68− results <- do_test_menu 1
69− env_attributes <- mapM ( \env_name -> catch ( Env.getEnv env_name >>= return . (,) env_name )
70− ( const $ return (env_name, "") )
72− [ "TERM", "COLORTERM", "LANG" ]
73− let results_txt = show env_attributes ++ "\n" ++ show results ++ "\n"
74− writeFile output_file_path results_txt
76−wait_for_return = do
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".
75+ results <- doTestMenu 1
76+ envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName )
77+ ( \ (_ :: SomeException) -> return (envName, "") )
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"
85+ writeFile outputFilePath resultsTxt
77 putStr "\n(press return to continue)"
88 putStr "\n(press return to continue)"
78 hFlush stdout
89 hFlush stdout
81−test_menu :: [(String, Test)]
92+testMenu :: [(String, Test)]
82−test_menu = zip (map show [1..]) all_tests
93+testMenu = zip (map show [1..]) allTests
84−do_test_menu :: Int -> IO [(String, Bool)]
95+doTestMenu :: Int -> IO [(String, Bool)]
85−do_test_menu next_ID
96+doTestMenu nextID
86− | next_ID > length all_tests = do
97+ | nextID > length allTests = do
87− putStrLn $ "Done! Please email the " ++ output_file_path ++ " file to coreyoconnor@gmail.com"
98+ putStrLn $ "Done! Please email the " ++ outputFilePath ++ " file to coreyoconnor@gmail.com"
89 | otherwise = do
100 | otherwise = do
90− display_test_menu
101+ displayTestMenu
91− putStrLn $ "Press return to start with #" ++ show next_ID ++ "."
102+ putStrLn $ "Press return to start with #" ++ show nextID ++ "."
92 putStrLn "Enter a test number to perform only that test."
103 putStrLn "Enter a test number to perform only that test."
93 putStrLn "q (or control-C) to quit."
104 putStrLn "q (or control-C) to quit."
94 putStr "> "
105 putStr "> "
@@ -96,226 +107,246 @@ do_test_menu next_ID
96 s <- getLine >>= return . filter (/= '\n')
107 s <- getLine >>= return . filter (/= '\n')
97 case s of
108 case s of
98 "q" -> return mempty
109 "q" -> return mempty
99− "" -> do
110+ "" -> do
100− r <- run_test $ show next_ID
111+ r <- runTest $ show nextID
101− rs <- do_test_menu ( next_ID + 1 )
112+ rs <- doTestMenu ( nextID + 1 )
102 return $ r : rs
113 return $ r : rs
103− i | isJust ( lookup i test_menu ) -> do
114+ i | isJust ( lookup i testMenu ) -> do
104− r <- run_test i
115+ r <- runTest i
105− rs <- do_test_menu ( read i + 1 )
116+ rs <- doTestMenu ( read i + 1 )
106 return $ r : rs
117 return $ r : rs
108− display_test_menu
119+ displayTestMenu
109− = mapM_ display_test_menu' test_menu
120+ = mapM_ displayTestMenu' testMenu
110− display_test_menu' ( i, t )
121+ displayTestMenu' ( i, t )
111− = putStrLn $ ( if i == show next_ID
122+ = putStrLn $ ( if i == show nextID
112− then "> "
123+ then "> "
114− ) ++ i ++ ". " ++ test_name t
125+ ) ++ i ++ ". " ++ testName t
116−run_test :: String -> IO (String, Bool)
127+runTest :: String -> IO (String, Bool)
117−run_test i = do
128+runTest i = do
118− let t = fromJust $ lookup i test_menu
129+ let t = fromJust $ lookup i testMenu
119− print_summary t
130+ printSummary t
120− wait_for_return
131+ waitForReturn
121− test_action t
132+ testAction t
122− r <- confirm_results t
133+ r <- confirmResults t
123− return (test_ID t, r)
134+ return (testID t, r)
125−default_success_confirm_results = do
136+defaultSuccessConfirmResults = do
126 putStr "\n"
137 putStr "\n"
127 putStr "[Y/n] "
138 putStr "[Y/n] "
128 hFlush stdout
139 hFlush stdout
129 r <- getLine
140 r <- getLine
130 case r of
141 case r of
131− "" -> return True
142+ "" -> return True
132 "y" -> return True
143 "y" -> return True
133 "Y" -> return True
144 "Y" -> return True
134 "n" -> return False
145 "n" -> return False
136data Test = Test
147data Test = Test
137− { test_name :: String
148+ { testName :: String
138− , test_ID :: String
149+ , testID :: String
139− , test_action :: IO ()
150+ , testAction :: IO ()
140− , print_summary :: IO ()
151+ , printSummary :: IO ()
141− , confirm_results :: IO Bool
152+ , confirmResults :: IO Bool
144−all_tests
155+allTests
145− = [ reserve_output_test
156+ = [ reserveOutputTest
146− , display_bounds_test_0
157+ , displayBoundsTest0
147− , display_bounds_test_1
158+ , displayBoundsTest1
148− , display_bounds_test_2
159+ , displayBoundsTest2
149− , display_bounds_test_3
160+ , displayBoundsTest3
150− , unicode_single_width_0
161+ , unicodeSingleWidth0
151− , unicode_single_width_1
162+ , unicodeSingleWidth1
152− , unicode_double_width_0
163+ , unicodeDoubleWidth0
153− , unicode_double_width_1
164+ , unicodeDoubleWidth1
154− , attributes_test_0
165+ , attributesTest0
155− , attributes_test_1
166+ , attributesTest1
156− , attributes_test_2
167+ , attributesTest2
157− , attributes_test_3
168+ , attributesTest3
158− , attributes_test_4
169+ , attributesTest4
159− , attributes_test_5
170+ , attributesTest5
160− , inline_test_0
171+ , inlineTest0
161− , inline_test_1
172+ , inlineTest1
164−reserve_output_test = Test
187+reserveOutputTest = Test
165− { test_name = "Initialize and reserve terminal output then restore previous state."
188+ { testName = "Initialize and reserve terminal output then restore previous state."
166− , test_ID = "reserve_output_test"
189+ , testID = "reserveOutputTest"
167− , test_action = do
190+ , testAction = do
168− t <- terminal_handle
191+ t <- standardIOConfig >>= outputForConfig
169− reserve_display t
192+ reserveDisplay t
170 putStrLn "Line 1"
193 putStrLn "Line 1"
171 putStrLn "Line 2"
194 putStrLn "Line 2"
172 putStrLn "Line 3"
195 putStrLn "Line 3"
173 putStrLn "Line 4 (press return)"
196 putStrLn "Line 4 (press return)"
174 hFlush stdout
197 hFlush stdout
176− release_display t
199+ releaseDisplay t
177− release_terminal t
200+ releaseTerminal t
178 return ()
201 return ()
179− , print_summary = do
202+ , printSummary = do
180− putStr $ [$heredoc|
203+ putStr $ [s|
181Once return is pressed:
204Once return is pressed:
182−The screen will be cleared.
205+ 0. The screen will be cleared.
183−The cursor should be visible and at the top left corner.
184−Four lines of text should be visible.
206+ 1. Four lines of text should be visible.
207+ 1. The cursor should be visible and at the start of the fifth line.
186−After enter is pressed for the second time this test then:
209+After return is pressed for the second time this test then:
187 * The screen containing the test summary should be restored;
210 * The screen containing the test summary should be restored;
188 * The cursor is visible.
211 * The cursor is visible.
190− , confirm_results = do
213+ , confirmResults = do
191− putStr $ [$heredoc|
214+ putStr $ [s|
192Did the test output match the description?
215Did the test output match the description?
194− default_success_confirm_results
217+ defaultSuccessConfirmResults
197−display_bounds_test_0 = Test
220+displayBoundsTest0 = Test
198− { test_name = "Verify display bounds are correct test 0: Using spaces."
221+ { testName = "Verify display bounds are correct test 0: Using spaces."
199− , test_ID = "display_bounds_test_0"
222+ , testID = "displayBoundsTest0"
200− , test_action = do
223+ , testAction = do
201− t <- terminal_handle
224+ t <- standardIOConfig >>= outputForConfig
202− reserve_display t
225+ reserveDisplay t
203− DisplayRegion w h <- display_bounds t
226+ (w,h) <- displayBounds t
204− let row_0 = replicate (fromEnum w) 'X' ++ "\n"
227+ let row0 = replicate (fromEnum w) 'X' ++ "\n"
205− row_h = replicate (fromEnum w - 1) 'X'
228+ rowH = replicate (fromEnum w - 1) 'X'
206− row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
229+ rowN = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
207− image = row_0 ++ (concat $ replicate (fromEnum h - 2) row_n) ++ row_h
230+ image = row0 ++ (concat $ replicate (fromEnum h - 2) rowN) ++ rowH
208 putStr image
231 putStr image
209 hFlush stdout
232 hFlush stdout
211− release_display t
234+ releaseDisplay t
212− release_terminal t
235+ releaseTerminal t
213 return ()
236 return ()
214− , print_summary = display_bounds_test_summary True
237+ , printSummary = displayBoundsTestSummary True
215− , confirm_results = generic_output_match_confirm
238+ , confirmResults = genericOutputMatchConfirm
218−display_bounds_test_1 = Test
241+displayBoundsTest1 = Test
219− { test_name = "Verify display bounds are correct test 0: Using cursor movement."
242+ { testName = "Verify display bounds are correct test 0: Using cursor movement."
220− , test_ID = "display_bounds_test_1"
243+ , testID = "displayBoundsTest1"
221− , test_action = do
244+ , testAction = do
222− t <- terminal_handle
245+ t <- standardIOConfig >>= outputForConfig
223− reserve_display t
246+ reserveDisplay t
224− DisplayRegion w h <- display_bounds t
247+ (w,h) <- displayBounds t
225− set_cursor_pos t 0 0
248+ setCursorPos t 0 0
226− let row_0 = replicate (fromEnum w) 'X' ++ "\n"
249+ let row0 = replicate (fromEnum w) 'X' ++ "\n"
227− putStr row_0
250+ putStr row0
228 forM_ [1 .. h - 2] $ \y -> do
251 forM_ [1 .. h - 2] $ \y -> do
229− set_cursor_pos t 0 y
252+ setCursorPos t 0 y
230 putStr "X"
253 putStr "X"
231− set_cursor_pos t (w - 1) y
254+ hFlush stdout
255+ setCursorPos t (w - 1) y
232 putStr "X"
256 putStr "X"
233− set_cursor_pos t 0 (h - 1)
257+ hFlush stdout
258+ setCursorPos t 0 (h - 1)
234− let row_h = replicate (fromEnum w - 1) 'X'
259+ let rowH = replicate (fromEnum w - 1) 'X'
235− putStr row_h
260+ putStr rowH
236 hFlush stdout
261 hFlush stdout
238− release_display t
263+ releaseDisplay t
239− release_terminal t
264+ releaseTerminal t
240 return ()
265 return ()
241− , print_summary = display_bounds_test_summary True
266+ , printSummary = displayBoundsTestSummary True
242− , confirm_results = generic_output_match_confirm
267+ , confirmResults = genericOutputMatchConfirm
245−display_bounds_test_2 = Test
270+displayBoundsTest2 = Test
246− { test_name = "Verify display bounds are correct test 0: Using Image ops."
271+ { testName = "Verify display bounds are correct test 0: Using Image ops."
247− , test_ID = "display_bounds_test_2"
272+ , testID = "displayBoundsTest2"
248− , test_action = do
273+ , testAction = do
249− t <- terminal_handle
274+ t <- standardIOConfig >>= outputForConfig
250− reserve_display t
275+ reserveDisplay t
251− bounds@(DisplayRegion w h) <- display_bounds t
276+ bounds@(w,h) <- displayBounds t
252− let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')
277+ let firstRow = horizCat $ replicate (fromEnum w) (char defAttr 'X')
253− middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row
278+ middleRows = vertCat $ replicate (fromEnum h - 2) middleRow
254− middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')
279+ middleRow = (char defAttr 'X') <|> backgroundFill (w - 2) 1 <|> (char defAttr 'X')
255− end_row = first_row
280+ endRow = firstRow
256− image = first_row <-> middle_rows <-> end_row
281+ image = firstRow <-> middleRows <-> endRow
257− pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) }
282+ pic = (picForImage image) { picCursor = Cursor (w - 1) (h - 1) }
258− d <- display_context t bounds
283+ d <- displayContext t bounds
259− output_picture d pic
284+ outputPicture d pic
261− release_display t
286+ releaseDisplay t
262− release_terminal t
287+ releaseTerminal t
263 return ()
288 return ()
264− , print_summary = display_bounds_test_summary True
289+ , printSummary = displayBoundsTestSummary True
265− , confirm_results = generic_output_match_confirm
290+ , confirmResults = genericOutputMatchConfirm
268−display_bounds_test_3 = Test
293+displayBoundsTest3 = Test
269− { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
294+ { testName = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
270− , test_ID = "display_bounds_test_3"
295+ , testID = "displayBoundsTest3"
271− , test_action = do
296+ , testAction = do
272− t <- terminal_handle
297+ t <- standardIOConfig >>= outputForConfig
273− reserve_display t
298+ reserveDisplay t
274− DisplayRegion w h <- display_bounds t
299+ (w,h) <- displayBounds t
275− hide_cursor t
300+ hideCursor t
276− set_cursor_pos t 0 0
301+ setCursorPos t 0 0
277− let row_0 = replicate (fromEnum w) 'X'
302+ let row0 = replicate (fromEnum w) 'X'
278− putStrLn row_0
303+ putStrLn row0
279 forM_ [1 .. h - 2] $ \y -> do
304 forM_ [1 .. h - 2] $ \y -> do
280− set_cursor_pos t 0 y
305+ setCursorPos t 0 y
281 putStr "X"
306 putStr "X"
282− set_cursor_pos t (w - 1) y
307+ hFlush stdout
308+ setCursorPos t (w - 1) y
283 putStr "X"
309 putStr "X"
284− set_cursor_pos t 0 (h - 1)
310+ hFlush stdout
285− let row_h = row_0
311+ setCursorPos t 0 (h - 1)
286− putStr row_h
313+ putStr rowH
287 hFlush stdout
314 hFlush stdout
289− show_cursor t
316+ showCursor t
290− release_display t
317+ releaseDisplay t
291− release_terminal t
318+ releaseTerminal t
292 return ()
319 return ()
293− , print_summary = display_bounds_test_summary False
320+ , printSummary = displayBoundsTestSummary False
294− , confirm_results = generic_output_match_confirm
321+ , confirmResults = genericOutputMatchConfirm
297−display_bounds_test_summary has_cursor = do
324+displayBoundsTestSummary hasCursor = do
298− putStr $ [$heredoc|
325+ putStr $ [s|
299Once return is pressed:
326Once return is pressed:
300 0. The screen will be cleared.
327 0. The screen will be cleared.
302− if has_cursor
329+ if hasCursor
303 then putStr " 1. The cursor will be visible."
330 then putStr " 1. The cursor will be visible."
304 else putStr " 1. The cursor will NOT be visible."
331 else putStr " 1. The cursor will NOT be visible."
305− putStr [$heredoc|
332+ putStr [s|
306 2. The border of the display will be outlined in Xs.
334 2. The border of the display will be outlined in Xs.
307 So if - and | represented the edge of the terminal window:
335 So if - and | represented the edge of the terminal window:
308 |-------------|
336 |-------------|
309 |XXXXXXXXXXXXX|
337 |XXXXXXXXXXXXX|
312− if has_cursor
340+ if hasCursor
313− then putStr $ [$heredoc|
341+ then putStr $ [s|
314 |XXXXXXXXXXXXC| |]
343 |XXXXXXXXXXXXC| |]
315− else putStr $ [$heredoc|
344+ else putStr $ [s|
316 |XXXXXXXXXXXXX| |]
346 |XXXXXXXXXXXXX| |]
318− putStr $ [$heredoc|
348+ putStr $ [s|
319 |-------------|
350 |-------------|
321 ( Where C is the final position of the cursor. There may be an X drawn
352 ( Where C is the final position of the cursor. There may be an X drawn
@@ -327,13 +358,13 @@ After return is pressed for the second time:
327 1. The cursor should be visible.
358 1. The cursor should be visible.
330−generic_output_match_confirm = do
361+genericOutputMatchConfirm = do
331− putStr $ [$heredoc|
362+ putStr $ [s|
332Did the test output match the description?
363Did the test output match the description?
334− default_success_confirm_results
365+ defaultSuccessConfirmResults
336−-- Explicitely definethe bytes that encode each example text.
367+-- Explicitly define the bytes that encode each example text.
337-- This avoids any issues with how the compiler represents string literals.
368-- This avoids any issues with how the compiler represents string literals.
339-- This document is UTF-8 encoded so the UTF-8 string is still included for
370-- This document is UTF-8 encoded so the UTF-8 string is still included for
@@ -342,24 +373,24 @@ Did the test output match the description?
342-- It's assumed the compiler will at least not barf on UTF-8 encoded text in
373-- It's assumed the compiler will at least not barf on UTF-8 encoded text in
343-- comments ;-)
374-- comments ;-)
345−-- txt_0 = ↑↑↓↓←→←→BA
376+-- txt0 = ↑↑↓↓←→←→BA
347−utf8_txt_0 :: [[Word8]]
378+utf8Txt0 :: [[Word8]]
348−utf8_txt_0 = [ [ 0xe2 , 0x86 , 0x91 ]
379+utf8Txt0 = [ [ 0xe2 , 0x86 , 0x91 ]
349− , [ 0xe2 , 0x86 , 0x91 ]
380+ , [ 0xe2 , 0x86 , 0x91 ]
350− , [ 0xe2 , 0x86 , 0x93 ]
381+ , [ 0xe2 , 0x86 , 0x93 ]
351− , [ 0xe2 , 0x86 , 0x93 ]
382+ , [ 0xe2 , 0x86 , 0x93 ]
352− , [ 0xe2 , 0x86 , 0x90 ]
383+ , [ 0xe2 , 0x86 , 0x90 ]
353− , [ 0xe2 , 0x86 , 0x92 ]
384+ , [ 0xe2 , 0x86 , 0x92 ]
354− , [ 0xe2 , 0x86 , 0x90 ]
385+ , [ 0xe2 , 0x86 , 0x90 ]
355− , [ 0xe2 , 0x86 , 0x92 ]
386+ , [ 0xe2 , 0x86 , 0x92 ]
356− , [ 0x42 ]
387+ , [ 0x42 ]
357− , [ 0x41 ]
388+ , [ 0x41 ]
360−iso_10646_txt_0 :: String
391+iso10646Txt0 :: String
361−iso_10646_txt_0 = map toEnum
392+iso10646Txt0 = map toEnum
@@ -371,45 +402,46 @@ iso_10646_txt_0 = map toEnum
374−unicode_single_width_0 = Test
405+unicodeSingleWidth0 = Test
375− { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
406+ { testName = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
376− , test_ID = "unicode_single_width_0"
407+ , testID = "unicodeSingleWidth0"
377− , test_action = do
408+ , testAction = do
378− t <- terminal_handle
409+ t <- standardIOConfig >>= outputForConfig
379− reserve_display t
410+ reserveDisplay t
380− withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout)
412+ withArrayLen (concat utf8Txt0) (flip $ hPutBuf stdout)
381 hPutStr stdout "\n"
413 hPutStr stdout "\n"
382 hPutStr stdout "0123456789\n"
414 hPutStr stdout "0123456789\n"
383 hFlush stdout
415 hFlush stdout
385− release_display t
417+ releaseDisplay t
386− release_terminal t
418+ releaseTerminal t
387 return ()
419 return ()
388− , print_summary = unicode_single_width_summary
420+ , printSummary = unicodeSingleWidthSummary
389− , confirm_results = generic_output_match_confirm
421+ , confirmResults = genericOutputMatchConfirm
392−unicode_single_width_1 = Test
424+unicodeSingleWidth1 = Test
393− { test_name = "Verify terminal can display unicode single-width characters. (Image ops)"
425+ { testName = "Verify terminal can display unicode single-width characters. (Image ops)"
394− , test_ID = "unicode_single_width_1"
426+ , testID = "unicodeSingleWidth1"
395− , test_action = do
427+ , testAction = do
396− t <- terminal_handle
428+ t <- standardIOConfig >>= outputForConfig
397− reserve_display t
429+ reserveDisplay t
398− let pic = pic_for_image image
430+ let pic = picForImage image
399− image = line_0 <-> line_1
431+ image = line0 <-> line1
400− line_0 = iso_10646_string def_attr iso_10646_txt_0
432+ line0 = iso10646String defAttr iso10646Txt0
401− line_1 = string def_attr "0123456789"
433+ line1 = string defAttr "0123456789"
402− d <- display_bounds t >>= display_context t
434+ d <- displayBounds t >>= displayContext t
403− output_picture d pic
435+ outputPicture d pic
405− release_display t
437+ releaseDisplay t
406− release_terminal t
438+ releaseTerminal t
407 return ()
439 return ()
408− , print_summary = unicode_single_width_summary
440+ , printSummary = unicodeSingleWidthSummary
409− , confirm_results = generic_output_match_confirm
441+ , confirmResults = genericOutputMatchConfirm
412−unicode_single_width_summary = putStr [$heredoc|
444+unicodeSingleWidthSummary = putStr [s|
413Once return is pressed:
445Once return is pressed:
414 0. The screen will be cleared.
446 0. The screen will be cleared.
415 1. The cursor will be hidden.
447 1. The cursor will be hidden.
@@ -443,54 +475,55 @@ After return is pressed for the second time:
444-- The second example is a unicode string containing double-width glyphs
476-- The second example is a unicode string containing double-width glyphs
446−utf8_txt_1 :: [[Word8]]
478+utf8Txt1 :: [[Word8]]
447−utf8_txt_1 = [ [0xe4,0xbd,0xa0]
479+utf8Txt1 = [ [0xe4,0xbd,0xa0]
448− , [0xe5,0xa5,0xbd]
480+ , [0xe5,0xa5,0xbd]
449− , [0xe5,0x90,0x97]
481+ , [0xe5,0x90,0x97]
452−iso_10646_txt_1 :: String
484+iso10646Txt1 :: String
453−iso_10646_txt_1 = map toEnum [20320,22909,21527]
485+iso10646Txt1 = map toEnum [20320,22909,21527]
455−unicode_double_width_0 = Test
487+unicodeDoubleWidth0 = Test
456− { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
488+ { testName = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
457− , test_ID = "unicode_double_width_0"
489+ , testID = "unicodeDoubleWidth0"
458− , test_action = do
490+ , testAction = do
459− t <- terminal_handle
491+ t <- standardIOConfig >>= outputForConfig
460− reserve_display t
492+ reserveDisplay t
461− withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout)
494+ withArrayLen (concat utf8Txt1) (flip $ hPutBuf stdout)
462 hPutStr stdout "\n"
495 hPutStr stdout "\n"
463 hPutStr stdout "012345\n"
496 hPutStr stdout "012345\n"
464 hFlush stdout
497 hFlush stdout
466− release_display t
499+ releaseDisplay t
467− release_terminal t
500+ releaseTerminal t
468 return ()
501 return ()
469− , print_summary = unicode_double_width_summary
502+ , printSummary = unicodeDoubleWidthSummary
470− , confirm_results = generic_output_match_confirm
503+ , confirmResults = genericOutputMatchConfirm
473−unicode_double_width_1 = Test
506+unicodeDoubleWidth1 = Test
474− { test_name = "Verify terminal can display unicode double-width characters. (Image ops)"
507+ { testName = "Verify terminal can display unicode double-width characters. (Image ops)"
475− , test_ID = "unicode_double_width_1"
508+ , testID = "unicodeDoubleWidth1"
476− , test_action = do
509+ , testAction = do
477− t <- terminal_handle
510+ t <- standardIOConfig >>= outputForConfig
478− reserve_display t
511+ reserveDisplay t
479− let pic = pic_for_image image
512+ let pic = picForImage image
480− image = line_0 <-> line_1
513+ image = line0 <-> line1
481− line_0 = iso_10646_string def_attr iso_10646_txt_1
514+ line0 = iso10646String defAttr iso10646Txt1
482− line_1 = string def_attr "012345"
515+ line1 = string defAttr "012345"
483− d <- display_bounds t >>= display_context t
516+ d <- displayBounds t >>= displayContext t
484− output_picture d pic
517+ outputPicture d pic
486− release_display t
519+ releaseDisplay t
487− release_terminal t
520+ releaseTerminal t
488 return ()
521 return ()
489− , print_summary = unicode_double_width_summary
522+ , printSummary = unicodeDoubleWidthSummary
490− , confirm_results = generic_output_match_confirm
523+ , confirmResults = genericOutputMatchConfirm
493−unicode_double_width_summary = putStr [$heredoc|
526+unicodeDoubleWidthSummary = putStr [s|
494Once return is pressed:
527Once return is pressed:
495 0. The screen will be cleared.
528 0. The screen will be cleared.
496 1. The cursor will be hidden.
529 1. The cursor will be hidden.
@@ -517,29 +550,33 @@ After return is pressed for the second time:
517 1. The cursor should be visible.
550 1. The cursor should be visible.
520−all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white, def ]
553+allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
521− [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white", "default" ]
554+ [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
523−attributes_test_0 = Test
556+allBrightColors
557+ = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]
558+ [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]
560+attributesTest0 = Test
524− { test_name = "Character attributes: foreground colors."
561+ { testName = "Character attributes: foreground colors."
525− , test_ID = "attributes_test_0"
562+ , testID = "attributesTest0"
526− , test_action = do
563+ , testAction = do
527− t <- terminal_handle
564+ t <- standardIOConfig >>= outputForConfig
528− reserve_display t
565+ reserveDisplay t
529− let pic = pic_for_image image
566+ let pic = picForImage image
530− image = border <|> column_0 <|> border <|> column_1 <|> border
567+ image = border <|> column0 <|> border <|> column1 <|> border
531− column_0 = vert_cat $ map line_with_color all_colors
568+ column0 = vertCat $ map lineWithColor allColors
532− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
569+ border = vertCat $ replicate (length allColors) $ string defAttr " | "
533− column_1 = vert_cat $ map (string def_attr . snd) all_colors
570+ column1 = vertCat $ map (string defAttr . snd) allColors
534− line_with_color (c_value, c_name) = string (setFG c_value def_attr) c_name
571+ lineWithColor (c, cName) = string (defAttr `withForeColor` c) cName
535− d <- display_bounds t >>= display_context t
572+ d <- displayBounds t >>= displayContext t
536− output_picture d pic
573+ outputPicture d pic
538− release_display t
575+ releaseDisplay t
539− release_terminal t
576+ releaseTerminal t
540 return ()
577 return ()
541− , print_summary = do
578+ , printSummary = do
542− putStr $ [$heredoc|
579+ putStr $ [s|
543Once return is pressed:
580Once return is pressed:
544 0. The screen will be cleared.
581 0. The screen will be cleared.
545 1. The cursor will be hidden.
582 1. The cursor will be hidden.
@@ -559,40 +596,40 @@ After return is pressed for the second time:
559 0. The screen containing the test summary should be restored.
596 0. The screen containing the test summary should be restored.
560 1. The cursor should be visible.
597 1. The cursor should be visible.
562− , confirm_results = do
599+ , confirmResults = do
563− putStr $ [$heredoc|
600+ putStr $ [s|
564Did the test output match the description?
601Did the test output match the description?
566− default_success_confirm_results
603+ defaultSuccessConfirmResults
569−attributes_test_1 = Test
606+attributesTest1 = Test
570− { test_name = "Character attributes: background colors."
607+ { testName = "Character attributes: background colors."
571− , test_ID = "attributes_test_1"
608+ , testID = "attributesTest1"
572− , test_action = do
609+ , testAction = do
573− t <- terminal_handle
610+ t <- standardIOConfig >>= outputForConfig
574− reserve_display t
611+ reserveDisplay t
575− let pic = pic_for_image image
612+ let pic = picForImage image
576− image = border <|> column_0 <|> border <|> column_1 <|> border
613+ image = border <|> column0 <|> border <|> column1 <|> border
577− column_0 = vert_cat $ map line_with_color all_colors
614+ column0 = vertCat $ map lineWithColor allColors
578− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
615+ border = vertCat $ replicate (length allColors) $ string defAttr " | "
579− column_1 = vert_cat $ map (string def_attr . snd) all_colors
616+ column1 = vertCat $ map (string defAttr . snd) allColors
580− line_with_color (c_value, c_name) = string (setBG c_value def_attr) c_name
617+ lineWithColor (c, cName) = string (defAttr `withBackColor` c) cName
581− d <- display_bounds t >>= display_context t
618+ d <- displayBounds t >>= displayContext t
582− output_picture d pic
619+ outputPicture d pic
584− release_display t
621+ releaseDisplay t
585− release_terminal t
622+ releaseTerminal t
586 return ()
623 return ()
587− , print_summary = do
624+ , printSummary = do
588− putStr $ [$heredoc|
625+ putStr $ [s|
589Once return is pressed:
626Once return is pressed:
590 0. The screen will be cleared.
627 0. The screen will be cleared.
591 1. The cursor will be hidden.
628 1. The cursor will be hidden.
592 2. 9 lines of text in two columns will be drawn. The first column will
629 2. 9 lines of text in two columns will be drawn. The first column will
593 contain be a name of a standard color for an 8 color terminal rendered with
630 contain be a name of a standard color for an 8 color terminal rendered with
594 the default foreground color with a background the named color. For
631 the default foreground color with a background the named color. For
595− instance, one line will contain be the word "magenta" and that words should
632+ instance, one line will contain be the word "magenta" and the word should
596 be rendered in the default foreground color over a magenta background. The
633 be rendered in the default foreground color over a magenta background. The
597 second column will be the name of a standard color rendered with the default
634 second column will be the name of a standard color rendered with the default
598 attributes.
635 attributes.
@@ -614,57 +651,57 @@ After return is pressed for the second time:
614 0. The screen containing the test summary should be restored.
651 0. The screen containing the test summary should be restored.
615 1. The cursor should be visible.
652 1. The cursor should be visible.
617− , confirm_results = do
654+ , confirmResults = do
618− putStr $ [$heredoc|
655+ putStr $ [s|
619Did the test output match the description?
656Did the test output match the description?
621− default_success_confirm_results
658+ defaultSuccessConfirmResults
624−attributes_test_2 = Test
661+attributesTest2 = Test
625− { test_name = "Character attributes: Vivid foreground colors."
662+ { testName = "Character attributes: Vivid foreground colors."
626− , test_ID = "attributes_test_2"
663+ , testID = "attributesTest2"
627− , test_action = do
664+ , testAction = do
628− t <- terminal_handle
665+ t <- standardIOConfig >>= outputForConfig
629− reserve_display t
666+ reserveDisplay t
630− let pic = pic_for_image image
667+ let pic = picForImage image
631− image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
668+ image = horizCat [border, column0, border, column1, border, column2, border]
632− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
669+ border = vertCat $ replicate (length allColors) $ string defAttr " | "
633− column_0 = vert_cat $ map line_with_color_0 all_colors
670+ column0 = vertCat $ map lineWithColor0 allColors
634− column_1 = vert_cat $ map line_with_color_1 all_colors
671+ column1 = vertCat $ map lineWithColor1 allBrightColors
635− column_2 = vert_cat $ map (string def_attr . snd) all_colors
672+ column2 = vertCat $ map (string defAttr . snd) allColors
636− line_with_color_0 (c_value, c_name) = string (setFG c_value def_attr) c_name
673+ lineWithColor0 (c, cName) = string (defAttr `withForeColor` c) cName
637− line_with_color_1 (c_value, c_name) = string (setFGVivid c_value def_attr) c_name
674+ lineWithColor1 (c, cName) = string (defAttr `withForeColor` c) cName
638− d <- display_bounds t >>= display_context t
675+ d <- displayBounds t >>= displayContext t
639− output_picture d pic
676+ outputPicture d pic
641− release_display t
678+ releaseDisplay t
642− release_terminal t
679+ releaseTerminal t
643 return ()
680 return ()
644− , print_summary = do
681+ , printSummary = do
645− putStr $ [$heredoc|
682+ putStr $ [s|
646Once return is pressed:
683Once return is pressed:
647 0. The screen will be cleared.
684 0. The screen will be cleared.
648 1. The cursor will be hidden.
685 1. The cursor will be hidden.
649 2. 9 lines of text in three columns will be drawn:
686 2. 9 lines of text in three columns will be drawn:
650 a. The first column will be a name of a standard color (for an 8 color
687 a. The first column will be a name of a standard color (for an 8 color
651− terminal) rendered with that color as the foreground color.
688+ terminal) rendered with that color as the foreground color.
652 b. The next column will be also be the name of a standard color rendered
689 b. The next column will be also be the name of a standard color rendered
653 with that color as the foreground color but the shade used should be
690 with that color as the foreground color but the shade used should be
654− more vivid than the shade used in the first column.
691+ more vivid than the shade used in the first column.
655 c. The final column will be the name of a color rendered with the
692 c. The final column will be the name of a color rendered with the
656 default attributes.
693 default attributes.
658For instance, one line will be the word "magenta" and that word should be
695For instance, one line will be the word "magenta" and that word should be
659−rendered in the magenta color.
696+rendered in the magenta color.
661I'm not actually sure exactly what "vivid" means in this context. For xterm the
698I'm not actually sure exactly what "vivid" means in this context. For xterm the
662−vivid colors are brighter.
699+vivid colors are brighter.
665 * The first column: The foreground color matches the named color.
702 * The first column: The foreground color matches the named color.
666 * The second column: The foreground color matches the named color but is
703 * The second column: The foreground color matches the named color but is
667− more vivid than the color used in the first column.
704+ more vivid than the color used in the first column.
668 * The third column: All text is rendered with the default attributes.
705 * The third column: All text is rendered with the default attributes.
669 * The vertical bars used in each line to mark the border of a column are
706 * The vertical bars used in each line to mark the border of a column are
670 lined up.
707 lined up.
@@ -673,58 +710,58 @@ After return is pressed for the second time:
673 0. The screen containing the test summary should be restored.
710 0. The screen containing the test summary should be restored.
674 1. The cursor should be visible.
711 1. The cursor should be visible.
676− , confirm_results = do
713+ , confirmResults = do
677− putStr $ [$heredoc|
714+ putStr $ [s|
678Did the test output match the description?
715Did the test output match the description?
680− default_success_confirm_results
717+ defaultSuccessConfirmResults
683−attributes_test_3 = Test
720+attributesTest3 = Test
684− { test_name = "Character attributes: vivid background colors."
721+ { testName = "Character attributes: Vivid background colors."
685− , test_ID = "attributes_test_3"
722+ , testID = "attributesTest3"
686− , test_action = do
723+ , testAction = do
687− t <- terminal_handle
724+ t <- standardIOConfig >>= outputForConfig
688− reserve_display t
725+ reserveDisplay t
689− let pic = pic_for_image image
726+ let pic = picForImage image
690− image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
727+ image = horizCat [border, column0, border, column1, border, column2, border]
691− border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
728+ border = vertCat $ replicate (length allColors) $ string defAttr " | "
692− column_0 = vert_cat $ map line_with_color_0 all_colors
729+ column0 = vertCat $ map lineWithColor0 allColors
693− column_1 = vert_cat $ map line_with_color_1 all_colors
730+ column1 = vertCat $ map lineWithColor1 allBrightColors
694− column_2 = vert_cat $ map (string def_attr . snd) all_colors
731+ column2 = vertCat $ map (string defAttr . snd) allColors
695− line_with_color_0 (c_value, c_name) = string (setBG c_value def_attr) c_name
732+ lineWithColor0 (c, cName) = string (defAttr `withBackColor` c) cName
696− line_with_color_1 (c_value, c_name) = string (setBGVivid c_value def_attr) c_name
733+ lineWithColor1 (c, cName) = string (defAttr `withBackColor` c) cName
697− d <- display_bounds t >>= display_context t
734+ d <- displayBounds t >>= displayContext t
698− output_picture d pic
735+ outputPicture d pic
700− release_display t
737+ releaseDisplay t
701− release_terminal t
738+ releaseTerminal t
702 return ()
739 return ()
703− , print_summary = do
740+ , printSummary = do
704− putStr $ [$heredoc|
741+ putStr $ [s|
705Once return is pressed:
742Once return is pressed:
706 0. The screen will be cleared.
743 0. The screen will be cleared.
707 1. The cursor will be hidden.
744 1. The cursor will be hidden.
708 2. 9 lines of text in three columns will be drawn:
745 2. 9 lines of text in three columns will be drawn:
709 a. The first column will contain be a name of a standard color for an 8
746 a. The first column will contain be a name of a standard color for an 8
710 color terminal rendered with the default foreground color with a
747 color terminal rendered with the default foreground color with a
711− background the named color.
748+ background the named color.
712 b. The first column will contain be a name of a standard color for an 8
749 b. The first column will contain be a name of a standard color for an 8
713 color terminal rendered with the default foreground color with the
750 color terminal rendered with the default foreground color with the
714− background a vivid version of the named color.
751+ background a vivid version of the named color.
715 c. The third column will be the name of a standard color rendered with
752 c. The third column will be the name of a standard color rendered with
716 the default attributes.
753 the default attributes.
718−For instance, one line will contain be the word "magenta" and that words should
755+For instance, one line will contain be the word "magenta" and the word should
719−be rendered in the default foreground color over a magenta background.
756+be rendered in the default foreground color over a magenta background.
721I'm not actually sure exactly what "vivid" means in this context. For xterm the
758I'm not actually sure exactly what "vivid" means in this context. For xterm the
722vivid colors are brighter.
759vivid colors are brighter.
725 * The first column: The background color matches the named color.
762 * The first column: The background color matches the named color.
726 * The second column: The background color matches the named color and is
763 * The second column: The background color matches the named color and is
727− more vivid than the color used in the first column.
764+ more vivid than the color used in the first column.
728 * The third column column: All text is rendered with the default attributes.
765 * The third column column: All text is rendered with the default attributes.
729 * The vertical bars used in each line to mark the border of a column are
766 * The vertical bars used in each line to mark the border of a column are
730 lined up.
767 lined up.
@@ -740,51 +777,51 @@ After return is pressed for the second time:
740 0. The screen containing the test summary should be restored.
777 0. The screen containing the test summary should be restored.
741 1. The cursor should be visible.
778 1. The cursor should be visible.
743− , confirm_results = do
780+ , confirmResults = do
744− putStr $ [$heredoc|
781+ putStr $ [s|
745Did the test output match the description?
782Did the test output match the description?
747− default_success_confirm_results
784+ defaultSuccessConfirmResults
750−attr_combos =
787+attrCombos =
751− [ ("default", id)
788+ [ ( "default", id )
752− , ("bold", setBold)
789+ , ( "bold", flip withStyle bold )
753− , ("blink", setBlink)
790+ , ( "blink", flip withStyle blink )
754− , ("underline", setUnderline)
791+ , ( "underline", flip withStyle underline )
755− , ("bold + blink", setBlink . setBold)
792+ , ( "bold + blink", flip withStyle (bold + blink) )
756− , ("bold + underline", setUnderline . setBold)
793+ , ( "bold + underline", flip withStyle (bold + underline) )
757− , ("underline + blink", setBlink . setUnderline)
794+ , ( "underline + blink", flip withStyle (underline + blink) )
758− , ("bold + blink + underline", setUnderline . setBlink . setBold)
795+ , ( "bold + blink + underline", flip withStyle (bold + blink + underline) )
761−attributes_test_4 = Test
798+attributesTest4 = Test
762− { test_name = "Character attributes: Bold; Blink; Underline."
799+ { testName = "Character attributes: Bold; Blink; Underline."
763− , test_ID = "attributes_test_4"
800+ , testID = "attributesTest4"
764− , test_action = do
801+ , testAction = do
765− t <- terminal_handle
802+ t <- standardIOConfig >>= outputForConfig
766− reserve_display t
803+ reserveDisplay t
767− let pic = pic_for_image image
804+ let pic = picForImage image
768− image = horiz_cat [border, column_0, border, column_1, border]
805+ image = horizCat [border, column0, border, column1, border]
769− border = vert_cat $ replicate (length attr_combos) $ string def_attr " | "
806+ border = vertCat $ replicate (length attrCombos) $ string defAttr " | "
770− column_0 = vert_cat $ map line_with_attrs attr_combos
807+ column0 = vertCat $ map lineWithAttrs attrCombos
771− column_1 = vert_cat $ map (string def_attr . fst) attr_combos
808+ column1 = vertCat $ map (string defAttr . fst) attrCombos
772− line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc
809+ lineWithAttrs (desc, attrF) = string (attrF defAttr) desc
773− d <- display_bounds t >>= display_context t
810+ d <- displayBounds t >>= displayContext t
774− output_picture d pic
811+ outputPicture d pic
776− release_display t
813+ releaseDisplay t
777− release_terminal t
814+ releaseTerminal t
778 return ()
815 return ()
779− , print_summary = do
816+ , printSummary = do
780− putStr $ [$heredoc|
817+ putStr $ [s|
781Once return is pressed:
818Once return is pressed:
782 0. The screen will be cleared.
819 0. The screen will be cleared.
783 1. The cursor will be hidden.
820 1. The cursor will be hidden.
784− 2. 8 rows of text in two columns.
821+ 2. 8 rows of text in two columns.
785 The rows will contain the following text:
822 The rows will contain the following text:
789 underline
826 underline
790 bold + blink
827 bold + blink
@@ -793,8 +830,8 @@ Once return is pressed:
793 bold + blink + underline
830 bold + blink + underline
794 The first column will be rendered with the described attributes. The second
831 The first column will be rendered with the described attributes. The second
795 column will be rendered with the default attributes.
832 column will be rendered with the default attributes.
798 * The vertical bars used in each line to mark the border of a column are
835 * The vertical bars used in each line to mark the border of a column are
799 lined up.
836 lined up.
800 * The text in the first column is rendered as described.
837 * The text in the first column is rendered as described.
@@ -803,86 +840,353 @@ After return is pressed for the second time:
803 0. The screen containing the test summary should be restored.
840 0. The screen containing the test summary should be restored.
804 1. The cursor should be visible.
841 1. The cursor should be visible.
806− , confirm_results = do
843+ , confirmResults = do
807− putStr $ [$heredoc|
844+ putStr $ [s|
808Did the test output match the description?
845Did the test output match the description?
810− default_success_confirm_results
847+ defaultSuccessConfirmResults
813−attributes_test_5 = Test
850+attributesTest5 = Test
814− { test_name = "Character attributes: 240 color palette"
851+ { testName = "Character attributes: 240 color palette"
815− , test_ID = "attributes_test_5"
852+ , testID = "attributesTest5"
816− , test_action = do
853+ , testAction = do
817− t <- terminal_handle
854+ t <- standardIOConfig >>= outputForConfig
818− reserve_display t
855+ reserveDisplay t
819− let pic = pic_for_image image
856+ let pic = picForImage image
820− image = vert_cat $ map horiz_cat $ split_color_images color_images
857+ image = vertCat $ map horizCat $ splitColorImages colorImages
821− color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239]
858+ colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]
822− split_color_images [] = []
859+ splitColorImages [] = []
823− split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is))
860+ splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))
824− d <- display_bounds t >>= display_context t
861+ d <- displayBounds t >>= displayContext t
825− output_picture d pic
862+ outputPicture d pic
827− release_display t
864+ releaseDisplay t
828− release_terminal t
865+ releaseTerminal t
829 return ()
866 return ()
830− , print_summary = do
867+ , printSummary = do
831− putStr $ [$heredoc|
868+ putStr $ [s|
832Once return is pressed:
869Once return is pressed:
833 0. The screen will be cleared.
870 0. The screen will be cleared.
834 1. The cursor will be hidden.
871 1. The cursor will be hidden.
835 2. A 20 character wide and 12 row high block of color squares. This should look like a palette
872 2. A 20 character wide and 12 row high block of color squares. This should look like a palette
836 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...
873 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...
840After return is pressed for the second time:
877After return is pressed for the second time:
841 0. The screen containing the test summary should be restored.
878 0. The screen containing the test summary should be restored.
842 1. The cursor should be visible.
879 1. The cursor should be visible.
844− , confirm_results = do
881+ , confirmResults = do
845− putStr $ [$heredoc|
882+ putStr $ [s|
846Did the test output match the description?
883Did the test output match the description?
848− default_success_confirm_results
885+ defaultSuccessConfirmResults
851−inline_test_0 = Test
888+inlineTest0 = Test
852− { test_name = "Verify styled output can be performed without clearing the screen."
889+ { testName = "Verify styled output can be performed without clearing the screen."
853− , test_ID = "inline_test_0"
890+ , testID = "inlineTest0"
854− , test_action = do
891+ , testAction = do
855− t <- terminal_handle
856 putStrLn "line 1."
892 putStrLn "line 1."
857− put_attr_change t $ back_color red >> apply_style underline
893+ putAttrChange_ $ backColor red >> applyStyle underline
858 putStrLn "line 2."
894 putStrLn "line 2."
859− put_attr_change t $ default_all
895+ putAttrChange_ $ defaultAll
860 putStrLn "line 3."
896 putStrLn "line 3."
861− release_terminal t
897+ , printSummary = putStr $ [s|
863− , print_summary = putStr $ [$heredoc|
864lines are in order.
898lines are in order.
865The second line "line 2" should have a red background and the text underline.
899The second line "line 2" should have a red background and the text underline.
866The third line "line 3" should be drawn in the same style as the first line.
900The third line "line 3" should be drawn in the same style as the first line.
869− , confirm_results = generic_output_match_confirm
903+ , confirmResults = genericOutputMatchConfirm
872−inline_test_1 = Test
906+inlineTest1 = Test
873− { test_name = "Verify styled output can be performed without clearing the screen."
907+ { testName = "Verify styled output can be performed without clearing the screen."
874− , test_ID = "inline_test_1"
908+ , testID = "inlineTest1"
875− , test_action = do
909+ , testAction = do
876− t <- terminal_handle
877 putStr "Not styled. "
910 putStr "Not styled. "
878− put_attr_change t $ back_color red >> apply_style underline
911+ putAttrChange_ $ backColor red >> applyStyle underline
879 putStr " Styled! "
912 putStr " Styled! "
880− put_attr_change t $ default_all
913+ putAttrChange_ $ defaultAll
881 putStrLn "Not styled."
914 putStrLn "Not styled."
882− release_terminal t
915+ , printSummary = putStr $ [s|
918+ , confirmResults = genericOutputMatchConfirm
922+ { testName = "Verify styled output can be performed without clearing the screen."
923+ , testID = "inlineTest1"
925+ putStr "Not styled. "
926+ putAttrChange_ $ backColor red >> applyStyle underline
928+ putAttrChange_ $ defaultAll
929+ putStr "Not styled.\n"
930+ , printSummary = putStr $ [s|
932+ , confirmResults = genericOutputMatchConfirm
935+cursorHideTest0 :: Test
936+cursorHideTest0 = Test
937+ { testName = "Verify the cursor is hid and re-shown. issue #7"
938+ , testID = "cursorHideTest0"
940+ vty <- mkVty defaultConfig
941+ showCursor $ outputIface vty
942+ setCursorPos (outputIface vty) 5 5
944+ hideCursor $ outputIface vty
883 return ()
947 return ()
884− , print_summary = putStr $ [$heredoc|
948+ , printSummary = putStr $ [s|
949+ 1. verify the cursor is displayed.
951+ 3. verify the cursor is hid.
953+ 5. the display should return to the state before the test.
955+ , confirmResults = genericOutputMatchConfirm
887− , confirm_results = generic_output_match_confirm
958+outputImageAndWait :: Image -> IO ()
959+outputImageAndWait image = do
960+ let pic = picForImage image
961+ outputPicAndWait pic
963+outputPicAndWait :: Picture -> IO ()
964+outputPicAndWait pic = do
965+ t <- standardIOConfig >>= outputForConfig
967+ d <- displayBounds t >>= displayContext t
974+vertCropTest0 :: Test
976+ { testName = "Verify bottom cropping works as expected with single column chars"
977+ , testID = "cropTest0"
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.
986+ 3. the display should return to the state before the test.
988+ , confirmResults = genericOutputMatchConfirm
991+vertCropTest1 :: Test
993+ { testName = "Verify bottom cropping works as expected with double column chars"
994+ , testID = "cropTest0"
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.
1003+ 3. the display should return to the state before the test.
1005+ , confirmResults = genericOutputMatchConfirm
1008+vertCropTest2 :: Test
1009+vertCropTest2 = Test
1010+ { testName = "Verify top cropping works as expected with single column chars"
1011+ , testID = "cropTest2"
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.
1020+ 3. the display should return to the state before the test.
1022+ , confirmResults = genericOutputMatchConfirm
1025+vertCropTest3 :: Test
1026+vertCropTest3 = Test
1027+ { testName = "Verify top cropping works as expected with double column chars"
1028+ , testID = "cropTest0"
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.
1037+ 3. the display should return to the state before the test.
1039+ , confirmResults = genericOutputMatchConfirm
1042+horizCropTest0 :: Test
1043+horizCropTest0 = Test
1044+ { testName = "Verify right cropping works as expected with single column chars"
1045+ , testID = "cropTest0"
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.
1054+ 3. the display should return to the state before the test.
1056+ , confirmResults = genericOutputMatchConfirm
1059+horizCropTest1 :: Test
1060+horizCropTest1 = Test
1061+ { testName = "Verify right cropping works as expected with double column chars"
1062+ , testID = "cropTest0"
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.
1071+ 3. the display should return to the state before the test.
1073+ , confirmResults = genericOutputMatchConfirm
1076+horizCropTest2 :: Test
1077+horizCropTest2 = Test
1078+ { testName = "Verify left cropping works as expected with single column chars"
1079+ , testID = "cropTest0"
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.
1088+ 3. the display should return to the state before the test.
1090+ , confirmResults = genericOutputMatchConfirm
1093+horizCropTest3 :: Test
1094+horizCropTest3 = Test
1095+ { testName = "Verify right cropping works as expected with double column chars"
1096+ , testID = "cropTest0"
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.
1105+ 3. the display should return to the state before the test.
1107+ , confirmResults = genericOutputMatchConfirm
1112+ { testName = "verify layer 0"
1113+ , testID = "layer0"
1115+ let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1116+ lowerImage = vertCat $ map (string defAttr) lorumIpsum
1117+ p = picForLayers [upperImage, lowerImage]
1119+ , printSummary = putStr $ [s|
1120+ 1. Verify the text block appears to be Chinese text placed on top Latin text.
1122+ 3. the display should return to the state before the test.
1124+ , confirmResults = genericOutputMatchConfirm
1129+ { testName = "verify layer 1"
1130+ , testID = "layer1"
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.
1141+ 3. the display should return to the state before the test.
1143+ , confirmResults = genericOutputMatchConfirm
1146+cheesyAnim0 :: Image -> [Image] -> IO ()
1147+cheesyAnim0 i background = do
1148+ t <- standardIOConfig >>= outputForConfig
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)
1157+ let pic = picForLayers $ i_offset : background
1158+ outputPicture d pic
1160+ forM_ [0..100] $ \t -> do
1161+ let i_offset = translate (t * (-1) `mod` fst bounds)
1162+ (t * (-1) `div` 2 `mod` snd bounds)
1164+ let pic = picForLayers $ i_offset : background
1165+ outputPicture d pic
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?
1184+lorumIpsumChinese :: [String]
1185+lorumIpsumChinese = lines [s|
1186+輐銛 螷蟞覮 裌覅詵 暕 鴅噮 槶 惝掭掝 婸媥媕 耏胠臿, 汫汭沎 忕汌卣 蚡袀 僣 蒮 瀁瀎瀊 渮湸湤 緌翢,
1187+腠腶舝 糲蘥蠩 樏殣氀 蒮 蹢鎒 滍 鸄齴 櫧櫋瀩 鬄鵊鵙 莃荶衒, 毸溠 橀 簎艜薤 莃荶衒 翣聜蒢
1188+斔櫅檷 晛桼桾 拻敁柧 犿玒 膣, 墐 笓粊紒 bacon 鼀齕, 蔝蓶蓨 顊顃餭 姴怤 骱 暕 蹢鎒鎛 藒襓謥 鄻鎟霣
1189+鬎鯪, 鐩闤 硻禂稢 谾踘遳 撱 赲 迡 箷 蛃袚觙 萇雊蜩 壿嫷 鋡 縢羱聬 跐鉠鉣 蔝蓶蓨 匢奾灱 溮煡煟 雥齆犪
1190+蔰 虈觿, 腷腯葹 鍹餳駷 蛚袲褁蜸 皯竻 瀁瀎 蜭蜸覟 梪涫湴 揗斝湁 毼