@@ -1,12 +1,12 @@
11{-# LANGUAGE QuasiQuotes #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
32module Main where
43
54import Graphics.Vty
65import Graphics.Vty.Attributes
76import Graphics.Vty.Inline
87import Graphics.Vty.Picture
9−import Graphics.Vty.Output
8+import Graphics.Vty.Terminal
9+import Graphics.Vty.DisplayRegion
1010
1111import Control.Concurrent (threadDelay)
1212import Control.Exception
@@ -18,18 +18,18 @@ import Data.Monoid
1818import Data.String.QQ
1919import Data.Word
2020
21−import Foreign.Marshal.Array
21+import Foreign.Marshal.Array
2222
2323import qualified System.Environment as Env
2424
2525import System.IO ( hFlush, hPutStr, hPutBuf, stdout )
2626
2727main = do
28− printIntro
28+ print_intro
2929
30−outputFilePath = "test_results.list"
30+output_file_path = "test_results.list"
3131
32−printIntro = do
32+print_intro = do
3333 putStr $ [s|
3434This is an interactive verification program for the terminal input and output
3535support of the VTY library. This will ask a series of questions about what you
@@ -37,7 +37,7 @@ see on screen. The goal is to verify that VTY's output and input support
3737performs as expected with your terminal.
3838
3939This program produces a file named
40− |] ++ outputFilePath ++ [s|
40+ |] ++ output_file_path ++ [s|
4141in the current directory that contains the results for each test assertion. This
4242can be emailed to coreyoconnor@gmail.com and used by the VTY authors to improve
4343support for your terminal. No personal information is contained in the report.
@@ -66,40 +66,41 @@ All the tests assume the following about the terminal display:
6666Thanks for the help! :-D
6767To exit the test early enter "q" anytime at the following menu screen.
6868
69−If any test fails then please post an issue to
69+If any test failed then please post an issue to
7070 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".
71+with the test_results.list file pasted into the issue. The issue summary can
72+mention the specific tests that failed or just say "interactive terminal test
73+failure".
7374|]
74− waitForReturn
75− results <- doTestMenu 1
76− envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName )
77− ( \ (_ :: SomeException) -> return (envName, "") )
78− )
79− [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
80− t <- standardIOConfig >>= outputForConfig
81− let resultsTxt = show envAttributes ++ "\n"
82− ++ terminalID t ++ "\n"
83− ++ show results ++ "\n"
84− releaseTerminal t
85− writeFile outputFilePath resultsTxt
86−
87−waitForReturn = do
75+ wait_for_return
76+ results <- do_test_menu 1
77+ env_attributes <- mapM ( \env_name -> Control.Exception.catch ( Env.getEnv env_name >>= return . (,) env_name )
78+ ( \ (_ :: SomeException) -> return (env_name, "") )
79+ )
80+ [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
81+ t <- current_terminal
82+ let results_txt = show env_attributes ++ "\n"
83+ ++ terminal_ID t ++ "\n"
84+ ++ show results ++ "\n"
85+ release_terminal t
86+ writeFile output_file_path results_txt
87+
88+wait_for_return = do
8889 putStr "\n(press return to continue)"
8990 hFlush stdout
9091 getLine
9192
92−testMenu :: [(String, Test)]
93−testMenu = zip (map show [1..]) allTests
93+test_menu :: [(String, Test)]
94+test_menu = zip (map show [1..]) all_tests
9495
95−doTestMenu :: Int -> IO [(String, Bool)]
96−doTestMenu nextID
97− | nextID > length allTests = do
98− putStrLn $ "Done! Please email the " ++ outputFilePath ++ " file to coreyoconnor@gmail.com"
96+do_test_menu :: Int -> IO [(String, Bool)]
97+do_test_menu next_ID
98+ | next_ID > length all_tests = do
99+ putStrLn $ "Done! Please email the " ++ output_file_path ++ " file to coreyoconnor@gmail.com"
99100 return []
100101 | otherwise = do
101− displayTestMenu
102− putStrLn $ "Press return to start with #" ++ show nextID ++ "."
102+ display_test_menu
103+ putStrLn $ "Press return to start with #" ++ show next_ID ++ "."
103104 putStrLn "Enter a test number to perform only that test."
104105 putStrLn "q (or control-C) to quit."
105106 putStr "> "
@@ -107,102 +108,102 @@ doTestMenu nextID
107108 s <- getLine >>= return . filter (/= '\n')
108109 case s of
109110 "q" -> return mempty
110− "" -> do
111− r <- runTest $ show nextID
112− rs <- doTestMenu ( nextID + 1 )
111+ "" -> do
112+ r <- run_test $ show next_ID
113+ rs <- do_test_menu ( next_ID + 1 )
113114 return $ r : rs
114− i | isJust ( lookup i testMenu ) -> do
115− r <- runTest i
116− rs <- doTestMenu ( read i + 1 )
115+ i | isJust ( lookup i test_menu ) -> do
116+ r <- run_test i
117+ rs <- do_test_menu ( read i + 1 )
117118 return $ r : rs
118119 where
119− displayTestMenu
120− = mapM_ displayTestMenu' testMenu
121− displayTestMenu' ( i, t )
122− = putStrLn $ ( if i == show nextID
123− then "> "
120+ display_test_menu
121+ = mapM_ display_test_menu' test_menu
122+ display_test_menu' ( i, t )
123+ = putStrLn $ ( if i == show next_ID
124+ then "> "
124125 else " "
125− ) ++ i ++ ". " ++ testName t
126−
127−runTest :: String -> IO (String, Bool)
128−runTest i = do
129− let t = fromJust $ lookup i testMenu
130− printSummary t
131− waitForReturn
132− testAction t
133− r <- confirmResults t
134− return (testID t, r)
135−
136−defaultSuccessConfirmResults = do
126+ ) ++ i ++ ". " ++ test_name t
127+
128+run_test :: String -> IO (String, Bool)
129+run_test i = do
130+ let t = fromJust $ lookup i test_menu
131+ print_summary t
132+ wait_for_return
133+ test_action t
134+ r <- confirm_results t
135+ return (test_ID t, r)
136+
137+default_success_confirm_results = do
137138 putStr "\n"
138139 putStr "[Y/n] "
139140 hFlush stdout
140141 r <- getLine
141142 case r of
142− "" -> return True
143+ "" -> return True
143144 "y" -> return True
144145 "Y" -> return True
145146 "n" -> return False
146147
147148data Test = Test
148− { testName :: String
149− , testID :: String
150− , testAction :: IO ()
151− , printSummary :: IO ()
152− , confirmResults :: IO Bool
149+ { test_name :: String
150+ , test_ID :: String
151+ , test_action :: IO ()
152+ , print_summary :: IO ()
153+ , confirm_results :: IO Bool
153154 }
154155
155−allTests
156− = [ reserveOutputTest
157− , displayBoundsTest0
158− , displayBoundsTest1
159− , displayBoundsTest2
160− , displayBoundsTest3
161− , unicodeSingleWidth0
162− , unicodeSingleWidth1
163− , unicodeDoubleWidth0
164− , unicodeDoubleWidth1
165− , attributesTest0
166− , attributesTest1
167− , attributesTest2
168− , attributesTest3
169− , attributesTest4
170− , attributesTest5
171− , inlineTest0
172− , inlineTest1
173− , inlineTest2
174− , cursorHideTest0
175− , vertCropTest0
176− , vertCropTest1
177− , vertCropTest2
178− , vertCropTest3
179− , horizCropTest0
180− , horizCropTest1
181− , horizCropTest2
182− , horizCropTest3
183− , layer0
184− , layer1
156+all_tests
157+ = [ reserve_output_test
158+ , display_bounds_test_0
159+ , display_bounds_test_1
160+ , display_bounds_test_2
161+ , display_bounds_test_3
162+ , unicode_single_width_0
163+ , unicode_single_width_1
164+ , unicode_double_width_0
165+ , unicode_double_width_1
166+ , attributes_test_0
167+ , attributes_test_1
168+ , attributes_test_2
169+ , attributes_test_3
170+ , attributes_test_4
171+ , attributes_test_5
172+ , inline_test_0
173+ , inline_test_1
174+ , inline_test_2
175+ , cursor_hide_test_0
176+ , vert_crop_test_0
177+ , vert_crop_test_1
178+ , vert_crop_test_2
179+ , vert_crop_test_3
180+ , horiz_crop_test_0
181+ , horiz_crop_test_1
182+ , horiz_crop_test_2
183+ , horiz_crop_test_3
184+ , layer_0
185+ , layer_1
185186 ]
186187
187−reserveOutputTest = Test
188− { testName = "Initialize and reserve terminal output then restore previous state."
189− , testID = "reserveOutputTest"
190− , testAction = do
191− t <- standardIOConfig >>= outputForConfig
192− reserveDisplay t
188+reserve_output_test = Test
189+ { test_name = "Initialize and reserve terminal output then restore previous state."
190+ , test_ID = "reserve_output_test"
191+ , test_action = do
192+ t <- current_terminal
193+ reserve_display t
193194 putStrLn "Line 1"
194195 putStrLn "Line 2"
195196 putStrLn "Line 3"
196197 putStrLn "Line 4 (press return)"
197198 hFlush stdout
198199 getLine
199− releaseDisplay t
200− releaseTerminal t
200+ release_display t
201+ release_terminal t
201202 return ()
202− , printSummary = do
203+ , print_summary = do
203204 putStr $ [s|
204205Once return is pressed:
205− 0. The screen will be cleared.
206+ 0. The screen will be cleared.
206207 1. Four lines of text should be visible.
207208 1. The cursor should be visible and at the start of the fifth line.
208209
@@ -210,123 +211,123 @@ After return is pressed for the second time this test then:
210211 * The screen containing the test summary should be restored;
211212 * The cursor is visible.
212213|]
213− , confirmResults = do
214+ , confirm_results = do
214215 putStr $ [s|
215216Did the test output match the description?
216217|]
217− defaultSuccessConfirmResults
218+ default_success_confirm_results
218219 }
219220
220−displayBoundsTest0 = Test
221− { testName = "Verify display bounds are correct test 0: Using spaces."
222− , testID = "displayBoundsTest0"
223− , testAction = do
224− t <- standardIOConfig >>= outputForConfig
225− reserveDisplay t
226− (w,h) <- displayBounds t
227− let row0 = replicate (fromEnum w) 'X' ++ "\n"
228− rowH = replicate (fromEnum w - 1) 'X'
229− rowN = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
230− image = row0 ++ (concat $ replicate (fromEnum h - 2) rowN) ++ rowH
221+display_bounds_test_0 = Test
222+ { test_name = "Verify display bounds are correct test 0: Using spaces."
223+ , test_ID = "display_bounds_test_0"
224+ , test_action = do
225+ t <- current_terminal
226+ reserve_display t
227+ DisplayRegion w h <- display_bounds t
228+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
229+ row_h = replicate (fromEnum w - 1) 'X'
230+ row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
231+ image = row_0 ++ (concat $ replicate (fromEnum h - 2) row_n) ++ row_h
231232 putStr image
232233 hFlush stdout
233234 getLine
234− releaseDisplay t
235− releaseTerminal t
235+ release_display t
236+ release_terminal t
236237 return ()
237− , printSummary = displayBoundsTestSummary True
238− , confirmResults = genericOutputMatchConfirm
238+ , print_summary = display_bounds_test_summary True
239+ , confirm_results = generic_output_match_confirm
239240 }
240241
241−displayBoundsTest1 = Test
242− { testName = "Verify display bounds are correct test 0: Using cursor movement."
243− , testID = "displayBoundsTest1"
244− , testAction = do
245− t <- standardIOConfig >>= outputForConfig
246− reserveDisplay t
247− (w,h) <- displayBounds t
248− setCursorPos t 0 0
249− let row0 = replicate (fromEnum w) 'X' ++ "\n"
250− putStr row0
242+display_bounds_test_1 = Test
243+ { test_name = "Verify display bounds are correct test 0: Using cursor movement."
244+ , test_ID = "display_bounds_test_1"
245+ , test_action = do
246+ t <- current_terminal
247+ reserve_display t
248+ DisplayRegion w h <- display_bounds t
249+ set_cursor_pos t 0 0
250+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
251+ putStr row_0
251252 forM_ [1 .. h - 2] $ \y -> do
252− setCursorPos t 0 y
253+ set_cursor_pos t 0 y
253254 putStr "X"
254255 hFlush stdout
255− setCursorPos t (w - 1) y
256+ set_cursor_pos t (w - 1) y
256257 putStr "X"
257258 hFlush stdout
258− setCursorPos t 0 (h - 1)
259− let rowH = replicate (fromEnum w - 1) 'X'
260− putStr rowH
259+ set_cursor_pos t 0 (h - 1)
260+ let row_h = replicate (fromEnum w - 1) 'X'
261+ putStr row_h
261262 hFlush stdout
262263 getLine
263− releaseDisplay t
264− releaseTerminal t
264+ release_display t
265+ release_terminal t
265266 return ()
266− , printSummary = displayBoundsTestSummary True
267− , confirmResults = genericOutputMatchConfirm
267+ , print_summary = display_bounds_test_summary True
268+ , confirm_results = generic_output_match_confirm
268269 }
269270
270−displayBoundsTest2 = Test
271− { testName = "Verify display bounds are correct test 0: Using Image ops."
272− , testID = "displayBoundsTest2"
273− , testAction = do
274− t <- standardIOConfig >>= outputForConfig
275− reserveDisplay t
276− bounds@(w,h) <- displayBounds t
277− let firstRow = horizCat $ replicate (fromEnum w) (char defAttr 'X')
278− middleRows = vertCat $ replicate (fromEnum h - 2) middleRow
279− middleRow = (char defAttr 'X') <|> backgroundFill (w - 2) 1 <|> (char defAttr 'X')
280− endRow = firstRow
281− image = firstRow <-> middleRows <-> endRow
282− pic = (picForImage image) { picCursor = Cursor (w - 1) (h - 1) }
283− d <- displayContext t bounds
284− outputPicture d pic
271+display_bounds_test_2 = Test
272+ { test_name = "Verify display bounds are correct test 0: Using Image ops."
273+ , test_ID = "display_bounds_test_2"
274+ , test_action = do
275+ t <- current_terminal
276+ reserve_display t
277+ bounds@(DisplayRegion w h) <- display_bounds t
278+ let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')
279+ middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row
280+ middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')
281+ end_row = first_row
282+ image = first_row <-> middle_rows <-> end_row
283+ pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) }
284+ d <- display_context t bounds
285+ output_picture d pic
285286 getLine
286− releaseDisplay t
287− releaseTerminal t
287+ release_display t
288+ release_terminal t
288289 return ()
289− , printSummary = displayBoundsTestSummary True
290− , confirmResults = genericOutputMatchConfirm
290+ , print_summary = display_bounds_test_summary True
291+ , confirm_results = generic_output_match_confirm
291292 }
292293
293−displayBoundsTest3 = Test
294− { testName = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
295− , testID = "displayBoundsTest3"
296− , testAction = do
297− t <- standardIOConfig >>= outputForConfig
298− reserveDisplay t
299− (w,h) <- displayBounds t
300− hideCursor t
301− setCursorPos t 0 0
302− let row0 = replicate (fromEnum w) 'X'
303− putStrLn row0
294+display_bounds_test_3 = Test
295+ { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
296+ , test_ID = "display_bounds_test_3"
297+ , test_action = do
298+ t <- current_terminal
299+ reserve_display t
300+ DisplayRegion w h <- display_bounds t
301+ hide_cursor t
302+ set_cursor_pos t 0 0
303+ let row_0 = replicate (fromEnum w) 'X'
304+ putStrLn row_0
304305 forM_ [1 .. h - 2] $ \y -> do
305− setCursorPos t 0 y
306+ set_cursor_pos t 0 y
306307 putStr "X"
307308 hFlush stdout
308− setCursorPos t (w - 1) y
309+ set_cursor_pos t (w - 1) y
309310 putStr "X"
310311 hFlush stdout
311− setCursorPos t 0 (h - 1)
312− let rowH = row0
313− putStr rowH
312+ set_cursor_pos t 0 (h - 1)
313+ let row_h = row_0
314+ putStr row_h
314315 hFlush stdout
315316 getLine
316− showCursor t
317− releaseDisplay t
318− releaseTerminal t
317+ show_cursor t
318+ release_display t
319+ release_terminal t
319320 return ()
320− , printSummary = displayBoundsTestSummary False
321− , confirmResults = genericOutputMatchConfirm
321+ , print_summary = display_bounds_test_summary False
322+ , confirm_results = generic_output_match_confirm
322323 }
323324
324−displayBoundsTestSummary hasCursor = do
325+display_bounds_test_summary has_cursor = do
325326 putStr $ [s|
326327Once return is pressed:
327328 0. The screen will be cleared.
328329|]
329− if hasCursor
330+ if has_cursor
330331 then putStr " 1. The cursor will be visible."
331332 else putStr " 1. The cursor will NOT be visible."
332333 putStr [s|
@@ -337,7 +338,7 @@ Once return is pressed:
337338 |XXXXXXXXXXXXX|
338339 |X X||]
339340
340− if hasCursor
341+ if has_cursor
341342 then putStr $ [s|
342343
343344 |XXXXXXXXXXXXC| |]
@@ -358,13 +359,13 @@ After return is pressed for the second time:
358359 1. The cursor should be visible.
359360|]
360361
361−genericOutputMatchConfirm = do
362+generic_output_match_confirm = do
362363 putStr $ [s|
363364Did the test output match the description?
364365|]
365− defaultSuccessConfirmResults
366+ default_success_confirm_results
366367
367−-- Explicitly define the bytes that encode each example text.
368+-- Explicitely definethe bytes that encode each example text.
368369-- This avoids any issues with how the compiler represents string literals.
369370--
370371-- This document is UTF-8 encoded so the UTF-8 string is still included for
@@ -373,24 +374,24 @@ Did the test output match the description?
373374-- It's assumed the compiler will at least not barf on UTF-8 encoded text in
374375-- comments ;-)
375376--
376−-- txt0 = ↑↑↓↓←→←→BA
377−
378−utf8Txt0 :: [[Word8]]
379−utf8Txt0 = [ [ 0xe2 , 0x86 , 0x91 ]
380− , [ 0xe2 , 0x86 , 0x91 ]
381− , [ 0xe2 , 0x86 , 0x93 ]
382− , [ 0xe2 , 0x86 , 0x93 ]
383− , [ 0xe2 , 0x86 , 0x90 ]
384− , [ 0xe2 , 0x86 , 0x92 ]
385− , [ 0xe2 , 0x86 , 0x90 ]
386− , [ 0xe2 , 0x86 , 0x92 ]
387− , [ 0x42 ]
388− , [ 0x41 ]
389− ]
390−
391−iso10646Txt0 :: String
392−iso10646Txt0 = map toEnum
393− [ 8593
377+-- txt_0 = ↑↑↓↓←→←→BA
378+
379+utf8_txt_0 :: [[Word8]]
380+utf8_txt_0 = [ [ 0xe2 , 0x86 , 0x91 ]
381+ , [ 0xe2 , 0x86 , 0x91 ]
382+ , [ 0xe2 , 0x86 , 0x93 ]
383+ , [ 0xe2 , 0x86 , 0x93 ]
384+ , [ 0xe2 , 0x86 , 0x90 ]
385+ , [ 0xe2 , 0x86 , 0x92 ]
386+ , [ 0xe2 , 0x86 , 0x90 ]
387+ , [ 0xe2 , 0x86 , 0x92 ]
388+ , [ 0x42 ]
389+ , [ 0x41 ]
390+ ]
391+
392+iso_10646_txt_0 :: String
393+iso_10646_txt_0 = map toEnum
394+ [ 8593
394395 , 8593
395396 , 8595
396397 , 8595
@@ -402,46 +403,46 @@ iso10646Txt0 = map toEnum
402403 , 65
403404 ]
404405
405−unicodeSingleWidth0 = Test
406− { testName = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
407− , testID = "unicodeSingleWidth0"
408− , testAction = do
409− t <- standardIOConfig >>= outputForConfig
410− reserveDisplay t
411− hideCursor t
412− withArrayLen (concat utf8Txt0) (flip $ hPutBuf stdout)
406+unicode_single_width_0 = Test
407+ { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
408+ , test_ID = "unicode_single_width_0"
409+ , test_action = do
410+ t <- current_terminal
411+ reserve_display t
412+ hide_cursor t
413+ withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout)
413414 hPutStr stdout "\n"
414415 hPutStr stdout "0123456789\n"
415416 hFlush stdout
416417 getLine
417− releaseDisplay t
418− releaseTerminal t
418+ release_display t
419+ release_terminal t
419420 return ()
420− , printSummary = unicodeSingleWidthSummary
421− , confirmResults = genericOutputMatchConfirm
421+ , print_summary = unicode_single_width_summary
422+ , confirm_results = generic_output_match_confirm
422423 }
423424
424−unicodeSingleWidth1 = Test
425− { testName = "Verify terminal can display unicode single-width characters. (Image ops)"
426− , testID = "unicodeSingleWidth1"
427− , testAction = do
428− t <- standardIOConfig >>= outputForConfig
429− reserveDisplay t
430− let pic = picForImage image
431− image = line0 <-> line1
432− line0 = iso10646String defAttr iso10646Txt0
433− line1 = string defAttr "0123456789"
434− d <- displayBounds t >>= displayContext t
435− outputPicture d pic
425+unicode_single_width_1 = Test
426+ { test_name = "Verify terminal can display unicode single-width characters. (Image ops)"
427+ , test_ID = "unicode_single_width_1"
428+ , test_action = do
429+ t <- current_terminal
430+ reserve_display t
431+ let pic = pic_for_image image
432+ image = line_0 <-> line_1
433+ line_0 = iso_10646_string def_attr iso_10646_txt_0
434+ line_1 = string def_attr "0123456789"
435+ d <- display_bounds t >>= display_context t
436+ output_picture d pic
436437 getLine
437− releaseDisplay t
438− releaseTerminal t
438+ release_display t
439+ release_terminal t
439440 return ()
440− , printSummary = unicodeSingleWidthSummary
441− , confirmResults = genericOutputMatchConfirm
441+ , print_summary = unicode_single_width_summary
442+ , confirm_results = generic_output_match_confirm
442443 }
443444
444−unicodeSingleWidthSummary = putStr [s|
445+unicode_single_width_summary = putStr [s|
445446Once return is pressed:
446447 0. The screen will be cleared.
447448 1. The cursor will be hidden.
@@ -475,55 +476,55 @@ After return is pressed for the second time:
475476
476477-- The second example is a unicode string containing double-width glyphs
477478-- 你好吗
478−utf8Txt1 :: [[Word8]]
479−utf8Txt1 = [ [0xe4,0xbd,0xa0]
480− , [0xe5,0xa5,0xbd]
481− , [0xe5,0x90,0x97]
482− ]
483−
484−iso10646Txt1 :: String
485−iso10646Txt1 = map toEnum [20320,22909,21527]
486−
487−unicodeDoubleWidth0 = Test
488− { testName = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
489− , testID = "unicodeDoubleWidth0"
490− , testAction = do
491− t <- standardIOConfig >>= outputForConfig
492− reserveDisplay t
493− hideCursor t
494− withArrayLen (concat utf8Txt1) (flip $ hPutBuf stdout)
479+utf8_txt_1 :: [[Word8]]
480+utf8_txt_1 = [ [0xe4,0xbd,0xa0]
481+ , [0xe5,0xa5,0xbd]
482+ , [0xe5,0x90,0x97]
483+ ]
484+
485+iso_10646_txt_1 :: String
486+iso_10646_txt_1 = map toEnum [20320,22909,21527]
487+
488+unicode_double_width_0 = Test
489+ { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
490+ , test_ID = "unicode_double_width_0"
491+ , test_action = do
492+ t <- current_terminal
493+ reserve_display t
494+ hide_cursor t
495+ withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout)
495496 hPutStr stdout "\n"
496497 hPutStr stdout "012345\n"
497498 hFlush stdout
498499 getLine
499− releaseDisplay t
500− releaseTerminal t
500+ release_display t
501+ release_terminal t
501502 return ()
502− , printSummary = unicodeDoubleWidthSummary
503− , confirmResults = genericOutputMatchConfirm
503+ , print_summary = unicode_double_width_summary
504+ , confirm_results = generic_output_match_confirm
504505 }
505506
506−unicodeDoubleWidth1 = Test
507− { testName = "Verify terminal can display unicode double-width characters. (Image ops)"
508− , testID = "unicodeDoubleWidth1"
509− , testAction = do
510− t <- standardIOConfig >>= outputForConfig
511− reserveDisplay t
512− let pic = picForImage image
513− image = line0 <-> line1
514− line0 = iso10646String defAttr iso10646Txt1
515− line1 = string defAttr "012345"
516− d <- displayBounds t >>= displayContext t
517− outputPicture d pic
507+unicode_double_width_1 = Test
508+ { test_name = "Verify terminal can display unicode double-width characters. (Image ops)"
509+ , test_ID = "unicode_double_width_1"
510+ , test_action = do
511+ t <- current_terminal
512+ reserve_display t
513+ let pic = pic_for_image image
514+ image = line_0 <-> line_1
515+ line_0 = iso_10646_string def_attr iso_10646_txt_1
516+ line_1 = string def_attr "012345"
517+ d <- display_bounds t >>= display_context t
518+ output_picture d pic
518519 getLine
519− releaseDisplay t
520− releaseTerminal t
520+ release_display t
521+ release_terminal t
521522 return ()
522− , printSummary = unicodeDoubleWidthSummary
523− , confirmResults = genericOutputMatchConfirm
523+ , print_summary = unicode_double_width_summary
524+ , confirm_results = generic_output_match_confirm
524525 }
525526
526−unicodeDoubleWidthSummary = putStr [s|
527+unicode_double_width_summary = putStr [s|
527528Once return is pressed:
528529 0. The screen will be cleared.
529530 1. The cursor will be hidden.
@@ -550,32 +551,32 @@ After return is pressed for the second time:
550551 1. The cursor should be visible.
551552|]
552553
553−allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
554− [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
554+all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
555+ [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
555556
556−allBrightColors
557− = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]
557+all_bright_colors
558+ = zip [ bright_black, bright_red, bright_green, bright_yellow, bright_blue, bright_magenta, bright_cyan, bright_white ]
558559 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]
559560
560−attributesTest0 = Test
561− { testName = "Character attributes: foreground colors."
562− , testID = "attributesTest0"
563− , testAction = do
564− t <- standardIOConfig >>= outputForConfig
565− reserveDisplay t
566− let pic = picForImage image
567− image = border <|> column0 <|> border <|> column1 <|> border
568− column0 = vertCat $ map lineWithColor allColors
569− border = vertCat $ replicate (length allColors) $ string defAttr " | "
570− column1 = vertCat $ map (string defAttr . snd) allColors
571− lineWithColor (c, cName) = string (defAttr `withForeColor` c) cName
572− d <- displayBounds t >>= displayContext t
573− outputPicture d pic
561+attributes_test_0 = Test
562+ { test_name = "Character attributes: foreground colors."
563+ , test_ID = "attributes_test_0"
564+ , test_action = do
565+ t <- current_terminal
566+ reserve_display t
567+ let pic = pic_for_image image
568+ image = border <|> column_0 <|> border <|> column_1 <|> border
569+ column_0 = vert_cat $ map line_with_color all_colors
570+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
571+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
572+ line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name
573+ d <- display_bounds t >>= display_context t
574+ output_picture d pic
574575 getLine
575− releaseDisplay t
576− releaseTerminal t
576+ release_display t
577+ release_terminal t
577578 return ()
578− , printSummary = do
579+ , print_summary = do
579580 putStr $ [s|
580581Once return is pressed:
581582 0. The screen will be cleared.
@@ -596,32 +597,32 @@ After return is pressed for the second time:
596597 0. The screen containing the test summary should be restored.
597598 1. The cursor should be visible.
598599|]
599− , confirmResults = do
600+ , confirm_results = do
600601 putStr $ [s|
601602Did the test output match the description?
602603|]
603− defaultSuccessConfirmResults
604+ default_success_confirm_results
604605 }
605606
606−attributesTest1 = Test
607− { testName = "Character attributes: background colors."
608− , testID = "attributesTest1"
609− , testAction = do
610− t <- standardIOConfig >>= outputForConfig
611− reserveDisplay t
612− let pic = picForImage image
613− image = border <|> column0 <|> border <|> column1 <|> border
614− column0 = vertCat $ map lineWithColor allColors
615− border = vertCat $ replicate (length allColors) $ string defAttr " | "
616− column1 = vertCat $ map (string defAttr . snd) allColors
617− lineWithColor (c, cName) = string (defAttr `withBackColor` c) cName
618− d <- displayBounds t >>= displayContext t
619− outputPicture d pic
607+attributes_test_1 = Test
608+ { test_name = "Character attributes: background colors."
609+ , test_ID = "attributes_test_1"
610+ , test_action = do
611+ t <- current_terminal
612+ reserve_display t
613+ let pic = pic_for_image image
614+ image = border <|> column_0 <|> border <|> column_1 <|> border
615+ column_0 = vert_cat $ map line_with_color all_colors
616+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
617+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
618+ line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name
619+ d <- display_bounds t >>= display_context t
620+ output_picture d pic
620621 getLine
621− releaseDisplay t
622− releaseTerminal t
622+ release_display t
623+ release_terminal t
623624 return ()
624− , printSummary = do
625+ , print_summary = do
625626 putStr $ [s|
626627Once return is pressed:
627628 0. The screen will be cleared.
@@ -651,57 +652,57 @@ After return is pressed for the second time:
651652 0. The screen containing the test summary should be restored.
652653 1. The cursor should be visible.
653654|]
654− , confirmResults = do
655+ , confirm_results = do
655656 putStr $ [s|
656657Did the test output match the description?
657658|]
658− defaultSuccessConfirmResults
659+ default_success_confirm_results
659660 }
660661
661−attributesTest2 = Test
662− { testName = "Character attributes: Vivid foreground colors."
663− , testID = "attributesTest2"
664− , testAction = do
665− t <- standardIOConfig >>= outputForConfig
666− reserveDisplay t
667− let pic = picForImage image
668− image = horizCat [border, column0, border, column1, border, column2, border]
669− border = vertCat $ replicate (length allColors) $ string defAttr " | "
670− column0 = vertCat $ map lineWithColor0 allColors
671− column1 = vertCat $ map lineWithColor1 allBrightColors
672− column2 = vertCat $ map (string defAttr . snd) allColors
673− lineWithColor0 (c, cName) = string (defAttr `withForeColor` c) cName
674− lineWithColor1 (c, cName) = string (defAttr `withForeColor` c) cName
675− d <- displayBounds t >>= displayContext t
676− outputPicture d pic
662+attributes_test_2 = Test
663+ { test_name = "Character attributes: Vivid foreground colors."
664+ , test_ID = "attributes_test_2"
665+ , test_action = do
666+ t <- current_terminal
667+ reserve_display t
668+ let pic = pic_for_image image
669+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
670+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
671+ column_0 = vert_cat $ map line_with_color_0 all_colors
672+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
673+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
674+ line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name
675+ line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name
676+ d <- display_bounds t >>= display_context t
677+ output_picture d pic
677678 getLine
678− releaseDisplay t
679− releaseTerminal t
679+ release_display t
680+ release_terminal t
680681 return ()
681− , printSummary = do
682+ , print_summary = do
682683 putStr $ [s|
683684Once return is pressed:
684685 0. The screen will be cleared.
685686 1. The cursor will be hidden.
686687 2. 9 lines of text in three columns will be drawn:
687688 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.
689+ terminal) rendered with that color as the foreground color.
689690 b. The next column will be also be the name of a standard color rendered
690691 with that color as the foreground color but the shade used should be
691− more vivid than the shade used in the first column.
692+ more vivid than the shade used in the first column.
692693 c. The final column will be the name of a color rendered with the
693694 default attributes.
694695
695696For instance, one line will be the word "magenta" and that word should be
696−rendered in the magenta color.
697+rendered in the magenta color.
697698
698699I'm not actually sure exactly what "vivid" means in this context. For xterm the
699−vivid colors are brighter.
700+vivid colors are brighter.
700701
701−Verify:
702+Verify:
702703 * The first column: The foreground color matches the named color.
703704 * The second column: The foreground color matches the named color but is
704− more vivid than the color used in the first column.
705+ more vivid than the color used in the first column.
705706 * The third column: All text is rendered with the default attributes.
706707 * The vertical bars used in each line to mark the border of a column are
707708 lined up.
@@ -710,34 +711,34 @@ After return is pressed for the second time:
710711 0. The screen containing the test summary should be restored.
711712 1. The cursor should be visible.
712713|]
713− , confirmResults = do
714+ , confirm_results = do
714715 putStr $ [s|
715716Did the test output match the description?
716717|]
717− defaultSuccessConfirmResults
718+ default_success_confirm_results
718719 }
719720
720−attributesTest3 = Test
721− { testName = "Character attributes: Vivid background colors."
722− , testID = "attributesTest3"
723− , testAction = do
724− t <- standardIOConfig >>= outputForConfig
725− reserveDisplay t
726− let pic = picForImage image
727− image = horizCat [border, column0, border, column1, border, column2, border]
728− border = vertCat $ replicate (length allColors) $ string defAttr " | "
729− column0 = vertCat $ map lineWithColor0 allColors
730− column1 = vertCat $ map lineWithColor1 allBrightColors
731− column2 = vertCat $ map (string defAttr . snd) allColors
732− lineWithColor0 (c, cName) = string (defAttr `withBackColor` c) cName
733− lineWithColor1 (c, cName) = string (defAttr `withBackColor` c) cName
734− d <- displayBounds t >>= displayContext t
735− outputPicture d pic
721+attributes_test_3 = Test
722+ { test_name = "Character attributes: Vivid background colors."
723+ , test_ID = "attributes_test_3"
724+ , test_action = do
725+ t <- current_terminal
726+ reserve_display t
727+ let pic = pic_for_image image
728+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
729+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
730+ column_0 = vert_cat $ map line_with_color_0 all_colors
731+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
732+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
733+ line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name
734+ line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name
735+ d <- display_bounds t >>= display_context t
736+ output_picture d pic
736737 getLine
737− releaseDisplay t
738− releaseTerminal t
738+ release_display t
739+ release_terminal t
739740 return ()
740− , printSummary = do
741+ , print_summary = do
741742 putStr $ [s|
742743Once return is pressed:
743744 0. The screen will be cleared.
@@ -745,23 +746,23 @@ Once return is pressed:
745746 2. 9 lines of text in three columns will be drawn:
746747 a. The first column will contain be a name of a standard color for an 8
747748 color terminal rendered with the default foreground color with a
748− background the named color.
749+ background the named color.
749750 b. The first column will contain be a name of a standard color for an 8
750751 color terminal rendered with the default foreground color with the
751− background a vivid version of the named color.
752+ background a vivid version of the named color.
752753 c. The third column will be the name of a standard color rendered with
753754 the default attributes.
754−
755+
755756For instance, one line will contain be the word "magenta" and the word should
756−be rendered in the default foreground color over a magenta background.
757+be rendered in the default foreground color over a magenta background.
757758
758759I'm not actually sure exactly what "vivid" means in this context. For xterm the
759760vivid colors are brighter.
760761
761−Verify:
762+Verify:
762763 * The first column: The background color matches the named color.
763764 * The second column: The background color matches the named color and is
764− more vivid than the color used in the first column.
765+ more vivid than the color used in the first column.
765766 * The third column column: All text is rendered with the default attributes.
766767 * The vertical bars used in each line to mark the border of a column are
767768 lined up.
@@ -777,51 +778,51 @@ After return is pressed for the second time:
777778 0. The screen containing the test summary should be restored.
778779 1. The cursor should be visible.
779780|]
780− , confirmResults = do
781+ , confirm_results = do
781782 putStr $ [s|
782783Did the test output match the description?
783784|]
784− defaultSuccessConfirmResults
785+ default_success_confirm_results
785786 }
786787
787−attrCombos =
788+attr_combos =
788789 [ ( "default", id )
789− , ( "bold", flip withStyle bold )
790− , ( "blink", flip withStyle blink )
791− , ( "underline", flip withStyle underline )
792− , ( "bold + blink", flip withStyle (bold + blink) )
793− , ( "bold + underline", flip withStyle (bold + underline) )
794− , ( "underline + blink", flip withStyle (underline + blink) )
795− , ( "bold + blink + underline", flip withStyle (bold + blink + underline) )
790+ , ( "bold", flip with_style bold )
791+ , ( "blink", flip with_style blink )
792+ , ( "underline", flip with_style underline )
793+ , ( "bold + blink", flip with_style (bold + blink) )
794+ , ( "bold + underline", flip with_style (bold + underline) )
795+ , ( "underline + blink", flip with_style (underline + blink) )
796+ , ( "bold + blink + underline", flip with_style (bold + blink + underline) )
796797 ]
797798
798−attributesTest4 = Test
799− { testName = "Character attributes: Bold; Blink; Underline."
800− , testID = "attributesTest4"
801− , testAction = do
802− t <- standardIOConfig >>= outputForConfig
803− reserveDisplay t
804− let pic = picForImage image
805− image = horizCat [border, column0, border, column1, border]
806− border = vertCat $ replicate (length attrCombos) $ string defAttr " | "
807− column0 = vertCat $ map lineWithAttrs attrCombos
808− column1 = vertCat $ map (string defAttr . fst) attrCombos
809− lineWithAttrs (desc, attrF) = string (attrF defAttr) desc
810− d <- displayBounds t >>= displayContext t
811− outputPicture d pic
799+attributes_test_4 = Test
800+ { test_name = "Character attributes: Bold; Blink; Underline."
801+ , test_ID = "attributes_test_4"
802+ , test_action = do
803+ t <- current_terminal
804+ reserve_display t
805+ let pic = pic_for_image image
806+ image = horiz_cat [border, column_0, border, column_1, border]
807+ border = vert_cat $ replicate (length attr_combos) $ string def_attr " | "
808+ column_0 = vert_cat $ map line_with_attrs attr_combos
809+ column_1 = vert_cat $ map (string def_attr . fst) attr_combos
810+ line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc
811+ d <- display_bounds t >>= display_context t
812+ output_picture d pic
812813 getLine
813− releaseDisplay t
814− releaseTerminal t
814+ release_display t
815+ release_terminal t
815816 return ()
816− , printSummary = do
817+ , print_summary = do
817818 putStr $ [s|
818819Once return is pressed:
819820 0. The screen will be cleared.
820821 1. The cursor will be hidden.
821− 2. 8 rows of text in two columns.
822+ 2. 8 rows of text in two columns.
822823 The rows will contain the following text:
823824 default
824− bold
825+ bold
825826 blink
826827 underline
827828 bold + blink
@@ -830,8 +831,8 @@ Once return is pressed:
830831 bold + blink + underline
831832 The first column will be rendered with the described attributes. The second
832833 column will be rendered with the default attributes.
833−
834−Verify:
834+
835+Verify:
835836 * The vertical bars used in each line to mark the border of a column are
836837 lined up.
837838 * The text in the first column is rendered as described.
@@ -840,31 +841,31 @@ After return is pressed for the second time:
840841 0. The screen containing the test summary should be restored.
841842 1. The cursor should be visible.
842843|]
843− , confirmResults = do
844+ , confirm_results = do
844845 putStr $ [s|
845846Did the test output match the description?
846847|]
847− defaultSuccessConfirmResults
848+ default_success_confirm_results
848849 }
849850
850−attributesTest5 = Test
851− { testName = "Character attributes: 240 color palette"
852− , testID = "attributesTest5"
853− , testAction = do
854− t <- standardIOConfig >>= outputForConfig
855− reserveDisplay t
856− let pic = picForImage image
857− image = vertCat $ map horizCat $ splitColorImages colorImages
858− colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]
859− splitColorImages [] = []
860− splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))
861− d <- displayBounds t >>= displayContext t
862− outputPicture d pic
851+attributes_test_5 = Test
852+ { test_name = "Character attributes: 240 color palette"
853+ , test_ID = "attributes_test_5"
854+ , test_action = do
855+ t <- current_terminal
856+ reserve_display t
857+ let pic = pic_for_image image
858+ image = vert_cat $ map horiz_cat $ split_color_images color_images
859+ color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239]
860+ split_color_images [] = []
861+ split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is))
862+ d <- display_bounds t >>= display_context t
863+ output_picture d pic
863864 getLine
864− releaseDisplay t
865− releaseTerminal t
865+ release_display t
866+ release_terminal t
866867 return ()
867− , printSummary = do
868+ , print_summary = do
868869 putStr $ [s|
869870Once return is pressed:
870871 0. The screen will be cleared.
@@ -872,304 +873,296 @@ Once return is pressed:
872873 2. A 20 character wide and 12 row high block of color squares. This should look like a palette
873874 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...
874875
875−Verify:
876+Verify:
876877
877878After return is pressed for the second time:
878879 0. The screen containing the test summary should be restored.
879880 1. The cursor should be visible.
880881|]
881− , confirmResults = do
882+ , confirm_results = do
882883 putStr $ [s|
883884Did the test output match the description?
884885|]
885− defaultSuccessConfirmResults
886+ default_success_confirm_results
886887 }
887888
888−inlineTest0 = Test
889− { testName = "Verify styled output can be performed without clearing the screen."
890− , testID = "inlineTest0"
891− , testAction = do
889+inline_test_0 = Test
890+ { test_name = "Verify styled output can be performed without clearing the screen."
891+ , test_ID = "inline_test_0"
892+ , test_action = do
892893 putStrLn "line 1."
893− putAttrChange_ $ backColor red >> applyStyle underline
894+ put_attr_change_ $ back_color red >> apply_style underline
894895 putStrLn "line 2."
895− putAttrChange_ $ defaultAll
896+ put_attr_change_ $ default_all
896897 putStrLn "line 3."
897− , printSummary = putStr $ [s|
898+ , print_summary = putStr $ [s|
898899lines are in order.
899900The second line "line 2" should have a red background and the text underline.
900901The third line "line 3" should be drawn in the same style as the first line.
901902|]
902903
903− , confirmResults = genericOutputMatchConfirm
904+ , confirm_results = generic_output_match_confirm
904905 }
905906
906−inlineTest1 = Test
907− { testName = "Verify styled output can be performed without clearing the screen."
908− , testID = "inlineTest1"
909− , testAction = do
907+inline_test_1 = Test
908+ { test_name = "Verify styled output can be performed without clearing the screen."
909+ , test_ID = "inline_test_1"
910+ , test_action = do
910911 putStr "Not styled. "
911− putAttrChange_ $ backColor red >> applyStyle underline
912+ put_attr_change_ $ back_color red >> apply_style underline
912913 putStr " Styled! "
913− putAttrChange_ $ defaultAll
914+ put_attr_change_ $ default_all
914915 putStrLn "Not styled."
915− , printSummary = putStr $ [s|
916+ , print_summary = putStr $ [s|
916917|]
917918
918− , confirmResults = genericOutputMatchConfirm
919+ , confirm_results = generic_output_match_confirm
919920 }
920921
921−inlineTest2 = Test
922− { testName = "Verify styled output can be performed without clearing the screen."
923− , testID = "inlineTest1"
924− , testAction = do
922+inline_test_2 = Test
923+ { test_name = "Verify styled output can be performed without clearing the screen."
924+ , test_ID = "inline_test_1"
925+ , test_action = do
925926 putStr "Not styled. "
926− putAttrChange_ $ backColor red >> applyStyle underline
927+ put_attr_change_ $ back_color red >> apply_style underline
927928 putStr " Styled! "
928− putAttrChange_ $ defaultAll
929+ put_attr_change_ $ default_all
929930 putStr "Not styled.\n"
930− , printSummary = putStr $ [s|
931+ , print_summary = putStr $ [s|
931932|]
932− , confirmResults = genericOutputMatchConfirm
933+ , confirm_results = generic_output_match_confirm
933934 }
934935
935−cursorHideTest0 :: Test
936−cursorHideTest0 = Test
937− { testName = "Verify the cursor is hid and re-shown. issue #7"
938− , testID = "cursorHideTest0"
939− , testAction = do
940− vty <- mkVty defaultConfig
941− showCursor $ outputIface vty
942− setCursorPos (outputIface vty) 5 5
943− nextEvent vty
944− hideCursor $ outputIface vty
945− nextEvent vty
936+cursor_hide_test_0 :: Test
937+cursor_hide_test_0 = Test
938+ { test_name = "Verify the cursor is hid and re-shown. issue #7"
939+ , test_ID = "cursor_hide_test_0"
940+ , test_action = do
941+ vty <- mkVty
942+ show_cursor $ terminal vty
943+ set_cursor_pos (terminal vty) 5 5
944+ next_event vty
945+ hide_cursor $ terminal vty
946+ next_event vty
946947 shutdown vty
947948 return ()
948− , printSummary = putStr $ [s|
949+ , print_summary = putStr $ [s|
949950 1. verify the cursor is displayed.
950951 2. press enter
951952 3. verify the cursor is hid.
952953 4. press enter.
953954 5. the display should return to the state before the test.
954955|]
955− , confirmResults = genericOutputMatchConfirm
956+ , confirm_results = generic_output_match_confirm
956957 }
957958
958−outputImageAndWait :: Image -> IO ()
959−outputImageAndWait image = do
960− let pic = picForImage image
961− outputPicAndWait pic
962−
963−outputPicAndWait :: Picture -> IO ()
964−outputPicAndWait pic = do
965− t <- standardIOConfig >>= outputForConfig
966− reserveDisplay t
967− d <- displayBounds t >>= displayContext t
968− outputPicture d pic
959+output_image_and_wait :: Image -> IO ()
960+output_image_and_wait image = do
961+ let pic = pic_for_image image
962+ output_pic_and_wait pic
963+
964+output_pic_and_wait :: Picture -> IO ()
965+output_pic_and_wait pic = do
966+ t <- current_terminal
967+ reserve_display t
968+ d <- display_bounds t >>= display_context t
969+ output_picture d pic
969970 getLine
970− releaseDisplay t
971− releaseTerminal t
971+ release_display t
972+ release_terminal t
972973 return ()
973−
974−vertCropTest0 :: Test
975−vertCropTest0 = Test
976− { testName = "Verify bottom cropping works as expected with single column chars"
977− , testID = "cropTest0"
978− , testAction = do
979− let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsum
980− block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsum
981− image = block0 <-> backgroundFill 10 2 <-> block1
982− outputImageAndWait image
983− , printSummary = putStr $ [s|
974+
975+vert_crop_test_0 :: Test
976+vert_crop_test_0 = Test
977+ { test_name = "Verify bottom cropping works as expected with single column chars"
978+ , test_ID = "crop_test_0"
979+ , test_action = do
980+ let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum
981+ block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum
982+ image = block_0 <-> background_fill 10 2 <-> block_1
983+ output_image_and_wait image
984+ , print_summary = putStr $ [s|
984985 1. Verify the two text blocks are identical.
985986 2. press enter.
986987 3. the display should return to the state before the test.
987988|]
988− , confirmResults = genericOutputMatchConfirm
989+ , confirm_results = generic_output_match_confirm
989990 }
990991
991−vertCropTest1 :: Test
992−vertCropTest1 = Test
993− { testName = "Verify bottom cropping works as expected with double column chars"
994− , testID = "cropTest0"
995− , testAction = do
996− let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
997− block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsumChinese
998− image = block0 <-> backgroundFill 10 2 <-> block1
999− outputImageAndWait image
1000− , printSummary = putStr $ [s|
992+vert_crop_test_1 :: Test
993+vert_crop_test_1 = Test
994+ { test_name = "Verify bottom cropping works as expected with double column chars"
995+ , test_ID = "crop_test_0"
996+ , test_action = do
997+ let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
998+ block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum_chinese
999+ image = block_0 <-> background_fill 10 2 <-> block_1
1000+ output_image_and_wait image
1001+ , print_summary = putStr $ [s|
10011002 1. Verify the two text blocks are identical.
10021003 2. press enter.
10031004 3. the display should return to the state before the test.
10041005|]
1005− , confirmResults = genericOutputMatchConfirm
1006+ , confirm_results = generic_output_match_confirm
10061007 }
10071008
1008−vertCropTest2 :: Test
1009−vertCropTest2 = Test
1010− { testName = "Verify top cropping works as expected with single column chars"
1011− , testID = "cropTest2"
1012− , testAction = do
1013− let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsum
1014− block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsum - 2) lorumIpsum
1015− image = block0 <-> backgroundFill 10 2 <-> block1
1016− outputImageAndWait image
1017− , printSummary = putStr $ [s|
1009+vert_crop_test_2 :: Test
1010+vert_crop_test_2 = Test
1011+ { test_name = "Verify top cropping works as expected with single column chars"
1012+ , test_ID = "crop_test_0"
1013+ , test_action = do
1014+ let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum
1015+ block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum - 2) lorum_ipsum
1016+ image = block_0 <-> background_fill 10 2 <-> block_1
1017+ output_image_and_wait image
1018+ , print_summary = putStr $ [s|
10181019 1. Verify the two text blocks are identical.
10191020 2. press enter.
10201021 3. the display should return to the state before the test.
10211022|]
1022− , confirmResults = genericOutputMatchConfirm
1023+ , confirm_results = generic_output_match_confirm
10231024 }
10241025
1025−vertCropTest3 :: Test
1026−vertCropTest3 = Test
1027− { testName = "Verify top cropping works as expected with double column chars"
1028− , testID = "cropTest0"
1029− , testAction = do
1030− let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
1031− block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsumChinese - 2 ) lorumIpsumChinese
1032− image = block0 <-> backgroundFill 10 2 <-> block1
1033− outputImageAndWait image
1034− , printSummary = putStr $ [s|
1026+vert_crop_test_3 :: Test
1027+vert_crop_test_3 = Test
1028+ { test_name = "Verify top cropping works as expected with double column chars"
1029+ , test_ID = "crop_test_0"
1030+ , test_action = do
1031+ let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
1032+ block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum_chinese - 2 ) lorum_ipsum_chinese
1033+ image = block_0 <-> background_fill 10 2 <-> block_1
1034+ output_image_and_wait image
1035+ , print_summary = putStr $ [s|
10351036 1. Verify the two text blocks are identical.
10361037 2. press enter.
10371038 3. the display should return to the state before the test.
10381039|]
1039− , confirmResults = genericOutputMatchConfirm
1040+ , confirm_results = generic_output_match_confirm
10401041 }
10411042
1042−horizCropTest0 :: Test
1043−horizCropTest0 = Test
1044− { testName = "Verify right cropping works as expected with single column chars"
1045− , testID = "cropTest0"
1046− , testAction = do
1047− let baseImage = vertCat $ map (string defAttr) lorumIpsum
1048− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1049− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1050− outputImageAndWait image
1051− , printSummary = putStr $ [s|
1043+horiz_crop_test_0 :: Test
1044+horiz_crop_test_0 = Test
1045+ { test_name = "Verify right cropping works as expected with single column chars"
1046+ , test_ID = "crop_test_0"
1047+ , test_action = do
1048+ let base_image = vert_cat $ map (string def_attr) lorum_ipsum
1049+ cropped_image = crop_right (image_width base_image `div` 2) base_image
1050+ image = base_image <-> background_fill 10 2 <-> cropped_image
1051+ output_image_and_wait image
1052+ , print_summary = putStr $ [s|
10521053 1. Verify the bottom text block is about half the width of the top text block.
10531054 2. press enter.
10541055 3. the display should return to the state before the test.
10551056|]
1056− , confirmResults = genericOutputMatchConfirm
1057+ , confirm_results = generic_output_match_confirm
10571058 }
10581059
1059−horizCropTest1 :: Test
1060−horizCropTest1 = Test
1061− { testName = "Verify right cropping works as expected with double column chars"
1062− , testID = "cropTest0"
1063− , testAction = do
1064− let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1065− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1066− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1067− outputImageAndWait image
1068− , printSummary = putStr $ [s|
1060+horiz_crop_test_1 :: Test
1061+horiz_crop_test_1 = Test
1062+ { test_name = "Verify right cropping works as expected with double column chars"
1063+ , test_ID = "crop_test_0"
1064+ , test_action = do
1065+ let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1066+ cropped_image = crop_right (image_width base_image `div` 2) base_image
1067+ image = base_image <-> background_fill 10 2 <-> cropped_image
1068+ output_image_and_wait image
1069+ , print_summary = putStr $ [s|
10691070 1. Verify the bottom text block is the left half of the top block. Ellipses on the right edge are OK.
10701071 2. press enter.
10711072 3. the display should return to the state before the test.
10721073|]
1073− , confirmResults = genericOutputMatchConfirm
1074+ , confirm_results = generic_output_match_confirm
10741075 }
10751076
1076−horizCropTest2 :: Test
1077−horizCropTest2 = Test
1078− { testName = "Verify left cropping works as expected with single column chars"
1079− , testID = "cropTest0"
1080− , testAction = do
1081− let baseImage = vertCat $ map (string defAttr) lorumIpsum
1082− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1083− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1084− outputImageAndWait image
1085− , printSummary = putStr $ [s|
1077+horiz_crop_test_2 :: Test
1078+horiz_crop_test_2 = Test
1079+ { test_name = "Verify left cropping works as expected with single column chars"
1080+ , test_ID = "crop_test_0"
1081+ , test_action = do
1082+ let base_image = vert_cat $ map (string def_attr) lorum_ipsum
1083+ cropped_image = crop_left (image_width base_image `div` 2) base_image
1084+ image = base_image <-> background_fill 10 2 <-> cropped_image
1085+ output_image_and_wait image
1086+ , print_summary = putStr $ [s|
10861087 1. Verify the bottom text block is the right half of the top text block.
10871088 2. press enter.
10881089 3. the display should return to the state before the test.
10891090|]
1090− , confirmResults = genericOutputMatchConfirm
1091+ , confirm_results = generic_output_match_confirm
10911092 }
10921093
1093−horizCropTest3 :: Test
1094−horizCropTest3 = Test
1095− { testName = "Verify right cropping works as expected with double column chars"
1096− , testID = "cropTest0"
1097− , testAction = do
1098− let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1099− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1100− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1101− outputImageAndWait image
1102− , printSummary = putStr $ [s|
1094+horiz_crop_test_3 :: Test
1095+horiz_crop_test_3 = Test
1096+ { test_name = "Verify right cropping works as expected with double column chars"
1097+ , test_ID = "crop_test_0"
1098+ , test_action = do
1099+ let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1100+ cropped_image = crop_left (image_width base_image `div` 2) base_image
1101+ image = base_image <-> background_fill 10 2 <-> cropped_image
1102+ output_image_and_wait image
1103+ , print_summary = putStr $ [s|
11031104 1. Verify the bottom text block is the right half of the top block. Ellipses on the left edge are OK.
11041105 2. press enter.
11051106 3. the display should return to the state before the test.
11061107|]
1107− , confirmResults = genericOutputMatchConfirm
1108+ , confirm_results = generic_output_match_confirm
11081109 }
11091110
1110−layer0 :: Test
1111−layer0 = Test
1112− { testName = "verify layer 0"
1113− , testID = "layer0"
1114− , testAction = do
1115− let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1116− lowerImage = vertCat $ map (string defAttr) lorumIpsum
1117− p = picForLayers [upperImage, lowerImage]
1118− outputPicAndWait p
1119− , printSummary = putStr $ [s|
1111+layer_0 :: Test
1112+layer_0 = Test
1113+ { test_name = "verify layer 0"
1114+ , test_ID = "layer_0"
1115+ , test_action = do
1116+ let upper_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1117+ lower_image = vert_cat $ map (string def_attr) lorum_ipsum
1118+ p = pic_for_layers [upper_image, lower_image]
1119+ output_pic_and_wait p
1120+ , print_summary = putStr $ [s|
11201121 1. Verify the text block appears to be Chinese text placed on top Latin text.
11211122 2. press enter.
11221123 3. the display should return to the state before the test.
11231124|]
1124− , confirmResults = genericOutputMatchConfirm
1125+ , confirm_results = generic_output_match_confirm
11251126 }
11261127
1127−layer1 :: Test
1128−layer1 = Test
1129− { testName = "verify layer 1"
1130− , testID = "layer1"
1131− , testAction = do
1132− let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1133− block = resize 10 10 upperImage
1134− layer0 = vertCat $ map (string defAttr) lorumIpsum
1135− layer1 = charFill (defAttr `withBackColor` blue) '#' 1000 1000
1136− cheesyAnim0 block [layer0, layer1]
1137− , printSummary = putStr $ [s|
1128+layer_1 :: Test
1129+layer_1 = Test
1130+ { test_name = "verify layer 1"
1131+ , test_ID = "layer_1"
1132+ , test_action = do
1133+ let upper_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
1134+ block = resize 10 10 upper_image
1135+ layer_0 = vert_cat $ map (string def_attr) lorum_ipsum
1136+ layer_1 = char_fill (def_attr `with_back_color` blue) '#' 1000 1000
1137+ cheesy_anim_0 block [layer_0, layer_1]
1138+ , print_summary = putStr $ [s|
11381139 1. Verify the text block appears to be Chinese text moving on top a Latin text.
11391140 Which is all on a background of '#' characters over blue.
11401141 2. press enter.
11411142 3. the display should return to the state before the test.
11421143|]
1143− , confirmResults = genericOutputMatchConfirm
1144+ , confirm_results = generic_output_match_confirm
11441145 }
11451146
1146−cheesyAnim0 :: Image -> [Image] -> IO ()
1147−cheesyAnim0 i background = do
1148− t <- standardIOConfig >>= outputForConfig
1149− reserveDisplay t
1150− bounds <- displayBounds t
1151− d <- displayContext t bounds
1152− forM_ [0..2] $ \t -> do
1153− forM_ [0..100] $ \t -> do
1154− let i_offset = translate (t `mod` fst bounds)
1155− (t `div` 2 `mod` snd bounds)
1156− i
1157− let pic = picForLayers $ i_offset : background
1158− outputPicture d pic
1159− threadDelay 50000
1160− forM_ [0..100] $ \t -> do
1161− let i_offset = translate (t * (-1) `mod` fst bounds)
1162− (t * (-1) `div` 2 `mod` snd bounds)
1147+cheesy_anim_0 :: Image -> [Image] -> IO ()
1148+cheesy_anim_0 i background = do
1149+ t <- current_terminal
1150+ reserve_display t
1151+ bounds <- display_bounds t
1152+ d <- display_context t bounds
1153+ forM_ [0..100] $ \t -> do
1154+ let i_offset = translate (t `mod` region_width bounds)
1155+ (t `div` 2 `mod` region_height bounds)
11631156 i
1164− let pic = picForLayers $ i_offset : background
1165− outputPicture d pic
1157+ let pic = pic_for_layers $ i_offset : background
1158+ output_picture d pic
11661159 threadDelay 50000
1167− releaseDisplay t
1168− releaseTerminal t
1160+ release_display t
1161+ release_terminal t
11691162 return ()
11701163
1171−lorumIpsum :: [String]
1172−lorumIpsum = lines [s|
1164+lorum_ipsum :: [String]
1165+lorum_ipsum = lines [s|
11731166Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium,
11741167totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae
11751168dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit,
@@ -1181,8 +1174,8 @@ commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate v
11811174molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
11821175|]
11831176
1184−lorumIpsumChinese :: [String]
1185−lorumIpsumChinese = lines [s|
1177+lorum_ipsum_chinese :: [String]
1178+lorum_ipsum_chinese = lines [s|
11861179輐銛 螷蟞覮 裌覅詵 暕 鴅噮 槶 惝掭掝 婸媥媕 耏胠臿, 汫汭沎 忕汌卣 蚡袀 僣 蒮 瀁瀎瀊 渮湸湤 緌翢,
11871180腠腶舝 糲蘥蠩 樏殣氀 蒮 蹢鎒 滍 鸄齴 櫧櫋瀩 鬄鵊鵙 莃荶衒, 毸溠 橀 簎艜薤 莃荶衒 翣聜蒢
11881181斔櫅檷 晛桼桾 拻敁柧 犿玒 膣, 墐 笓粊紒 bacon 鼀齕, 蔝蓶蓨 顊顃餭 姴怤 骱 暕 蹢鎒鎛 藒襓謥 鄻鎟霣