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