@@ -2,42 +2,41 @@
22{-# LANGUAGE ScopedTypeVariables #-}
33module Main where
44
5−import Graphics.Vty
65import Graphics.Vty.Attributes
6+import Graphics.Vty.Image
77import Graphics.Vty.Inline
88import Graphics.Vty.Picture
9−import Graphics.Vty.Output
9+import Graphics.Vty.Terminal
10+import Graphics.Vty.DisplayRegion
1011
11−import Control.Concurrent (threadDelay)
12−import Control.Exception
1312import Control.Monad
1413
1514import Data.List ( lookup )
1615import Data.Maybe ( isJust, fromJust )
1716import Data.Monoid
18−import Data.String.QQ
1917import Data.Word
2018
21−import Foreign.Marshal.Array
19+import Foreign.Marshal.Array
20+import HereDoc
2221
2322import qualified System.Environment as Env
2423
2524import System.IO ( hFlush, hPutStr, hPutBuf, stdout )
2625
2726main = do
28− printIntro
27+ print_intro
2928
30−outputFilePath = "test_results.list"
29+output_file_path = "test_results.list"
3130
32−printIntro = do
33− putStr $ [s|
31+print_intro = do
32+ putStr $ [$heredoc|
3433This is an interactive verification program for the terminal input and output
3534support of the VTY library. This will ask a series of questions about what you
3635see on screen. The goal is to verify that VTY's output and input support
3736performs as expected with your terminal.
3837
3938This program produces a file named
40− |] ++ outputFilePath ++ [s|
39+ |] ++ output_file_path ++ [$heredoc|
4140in the current directory that contains the results for each test assertion. This
4241can be emailed to coreyoconnor@gmail.com and used by the VTY authors to improve
4342support for your terminal. No personal information is contained in the report.
@@ -63,43 +62,42 @@ All the tests assume the following about the terminal display:
6362 a good range of the unicode characters. Each test involving unicode display
6463 describes the expected appearance of each glyph.
6564
66−Thanks for the help! :-D
67−To exit the test early enter "q" anytime at the following menu screen.
68−
69−If any test fails then please post an issue to
70− https://github.com/coreyoconnor/vty/issues
71−with the test_results.list file pasted into the issue. A suitable summary is:
72−"interactive terminal test failure".
73−|]
74− waitForReturn
75− results <- doTestMenu 1
76− envAttributes <- mapM ( \envName -> Control.Exception.catch ( Env.getEnv envName >>= return . (,) envName )
77− ( \ (_ :: SomeException) -> return (envName, "") )
78− )
79− [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
80− t <- standardIOConfig >>= outputForConfig
81− let resultsTxt = show envAttributes ++ "\n"
82− ++ terminalID t ++ "\n"
83− ++ show results ++ "\n"
84− releaseTerminal t
85− writeFile outputFilePath resultsTxt
86−
87−waitForReturn = do
65+Thanks for the help! :-D
66+To exit the test early enter "q" anytime at the following menu screen. Even if
67+you exit the test early please email the test_results.list file to
68+coreyoconnor@gmail.com. The results file will still contain information useful
69+to debug terminal support.
70+
71+|]
72+ wait_for_return
73+ results <- do_test_menu 1
74+ env_attributes <- mapM ( \env_name -> catch ( Env.getEnv env_name >>= return . (,) env_name )
75+ ( const $ return (env_name, "") )
76+ )
77+ [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
78+ t <- terminal_handle
79+ let results_txt = show env_attributes ++ "\n"
80+ ++ terminal_ID t ++ "\n"
81+ ++ show results ++ "\n"
82+ release_terminal t
83+ writeFile output_file_path results_txt
84+
85+wait_for_return = do
8886 putStr "\n(press return to continue)"
8987 hFlush stdout
9088 getLine
9189
92−testMenu :: [(String, Test)]
93−testMenu = zip (map show [1..]) allTests
90+test_menu :: [(String, Test)]
91+test_menu = zip (map show [1..]) all_tests
9492
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"
93+do_test_menu :: Int -> IO [(String, Bool)]
94+do_test_menu next_ID
95+ | next_ID > length all_tests = do
96+ putStrLn $ "Done! Please email the " ++ output_file_path ++ " file to coreyoconnor@gmail.com"
9997 return []
10098 | otherwise = do
101− displayTestMenu
102− putStrLn $ "Press return to start with #" ++ show nextID ++ "."
99+ display_test_menu
100+ putStrLn $ "Press return to start with #" ++ show next_ID ++ "."
103101 putStrLn "Enter a test number to perform only that test."
104102 putStrLn "q (or control-C) to quit."
105103 putStr "> "
@@ -107,102 +105,91 @@ doTestMenu nextID
107105 s <- getLine >>= return . filter (/= '\n')
108106 case s of
109107 "q" -> return mempty
110− "" -> do
111− r <- runTest $ show nextID
112− rs <- doTestMenu ( nextID + 1 )
108+ "" -> do
109+ r <- run_test $ show next_ID
110+ rs <- do_test_menu ( next_ID + 1 )
113111 return $ r : rs
114− i | isJust ( lookup i testMenu ) -> do
115− r <- runTest i
116− rs <- doTestMenu ( read i + 1 )
112+ i | isJust ( lookup i test_menu ) -> do
113+ r <- run_test i
114+ rs <- do_test_menu ( read i + 1 )
117115 return $ r : rs
118116 where
119− displayTestMenu
120− = mapM_ displayTestMenu' testMenu
121− displayTestMenu' ( i, t )
122− = putStrLn $ ( if i == show nextID
123− then "> "
117+ display_test_menu
118+ = mapM_ display_test_menu' test_menu
119+ display_test_menu' ( i, t )
120+ = putStrLn $ ( if i == show next_ID
121+ then "> "
124122 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
123+ ) ++ i ++ ". " ++ test_name t
124+
125+run_test :: String -> IO (String, Bool)
126+run_test i = do
127+ let t = fromJust $ lookup i test_menu
128+ print_summary t
129+ wait_for_return
130+ test_action t
131+ r <- confirm_results t
132+ return (test_ID t, r)
133+
134+default_success_confirm_results = do
137135 putStr "\n"
138136 putStr "[Y/n] "
139137 hFlush stdout
140138 r <- getLine
141139 case r of
142− "" -> return True
140+ "" -> return True
143141 "y" -> return True
144142 "Y" -> return True
145143 "n" -> return False
146144
147145data Test = Test
148− { testName :: String
149− , testID :: String
150− , testAction :: IO ()
151− , printSummary :: IO ()
152− , confirmResults :: IO Bool
146+ { test_name :: String
147+ , test_ID :: String
148+ , test_action :: IO ()
149+ , print_summary :: IO ()
150+ , confirm_results :: IO Bool
153151 }
154152
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
153+all_tests
154+ = [ reserve_output_test
155+ , display_bounds_test_0
156+ , display_bounds_test_1
157+ , display_bounds_test_2
158+ , display_bounds_test_3
159+ , unicode_single_width_0
160+ , unicode_single_width_1
161+ , unicode_double_width_0
162+ , unicode_double_width_1
163+ , attributes_test_0
164+ , attributes_test_1
165+ , attributes_test_2
166+ , attributes_test_3
167+ , attributes_test_4
168+ , attributes_test_5
169+ , inline_test_0
170+ , inline_test_1
171+ , inline_test_2
185172 ]
186173
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
174+reserve_output_test = Test
175+ { test_name = "Initialize and reserve terminal output then restore previous state."
176+ , test_ID = "reserve_output_test"
177+ , test_action = do
178+ t <- terminal_handle
179+ reserve_display t
193180 putStrLn "Line 1"
194181 putStrLn "Line 2"
195182 putStrLn "Line 3"
196183 putStrLn "Line 4 (press return)"
197184 hFlush stdout
198185 getLine
199− releaseDisplay t
200− releaseTerminal t
186+ release_display t
187+ release_terminal t
201188 return ()
202− , printSummary = do
203− putStr $ [s|
189+ , print_summary = do
190+ putStr $ [$heredoc|
204191Once return is pressed:
205− 0. The screen will be cleared.
192+ 0. The screen will be cleared.
206193 1. Four lines of text should be visible.
207194 1. The cursor should be visible and at the start of the fifth line.
208195
@@ -210,143 +197,139 @@ After return is pressed for the second time this test then:
210197 * The screen containing the test summary should be restored;
211198 * The cursor is visible.
212199|]
213− , confirmResults = do
214− putStr $ [s|
200+ , confirm_results = do
201+ putStr $ [$heredoc|
215202Did the test output match the description?
216203|]
217− defaultSuccessConfirmResults
204+ default_success_confirm_results
218205 }
219206
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
207+display_bounds_test_0 = Test
208+ { test_name = "Verify display bounds are correct test 0: Using spaces."
209+ , test_ID = "display_bounds_test_0"
210+ , test_action = do
211+ t <- terminal_handle
212+ reserve_display t
213+ DisplayRegion w h <- display_bounds t
214+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
215+ row_h = replicate (fromEnum w - 1) 'X'
216+ row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
217+ image = row_0 ++ (concat $ replicate (fromEnum h - 2) row_n) ++ row_h
231218 putStr image
232219 hFlush stdout
233220 getLine
234− releaseDisplay t
235− releaseTerminal t
221+ release_display t
222+ release_terminal t
236223 return ()
237− , printSummary = displayBoundsTestSummary True
238− , confirmResults = genericOutputMatchConfirm
224+ , print_summary = display_bounds_test_summary True
225+ , confirm_results = generic_output_match_confirm
239226 }
240227
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
228+display_bounds_test_1 = Test
229+ { test_name = "Verify display bounds are correct test 0: Using cursor movement."
230+ , test_ID = "display_bounds_test_1"
231+ , test_action = do
232+ t <- terminal_handle
233+ reserve_display t
234+ DisplayRegion w h <- display_bounds t
235+ set_cursor_pos t 0 0
236+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
237+ putStr row_0
251238 forM_ [1 .. h - 2] $ \y -> do
252− setCursorPos t 0 y
239+ set_cursor_pos t 0 y
253240 putStr "X"
254241 hFlush stdout
255− setCursorPos t (w - 1) y
242+ set_cursor_pos t (w - 1) y
256243 putStr "X"
257244 hFlush stdout
258− setCursorPos t 0 (h - 1)
259− let rowH = replicate (fromEnum w - 1) 'X'
260− putStr rowH
245+ set_cursor_pos t 0 (h - 1)
246+ let row_h = replicate (fromEnum w - 1) 'X'
247+ putStr row_h
261248 hFlush stdout
262249 getLine
263− releaseDisplay t
264− releaseTerminal t
250+ release_display t
251+ release_terminal t
265252 return ()
266− , printSummary = displayBoundsTestSummary True
267− , confirmResults = genericOutputMatchConfirm
253+ , print_summary = display_bounds_test_summary True
254+ , confirm_results = generic_output_match_confirm
268255 }
269256
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
257+display_bounds_test_2 = Test
258+ { test_name = "Verify display bounds are correct test 0: Using Image ops."
259+ , test_ID = "display_bounds_test_2"
260+ , test_action = do
261+ t <- terminal_handle
262+ reserve_display t
263+ bounds@(DisplayRegion w h) <- display_bounds t
264+ let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')
265+ middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row
266+ middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')
267+ end_row = first_row
268+ image = first_row <-> middle_rows <-> end_row
269+ pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) }
270+ d <- display_context t bounds
271+ output_picture d pic
285272 getLine
286− releaseDisplay t
287− releaseTerminal t
273+ release_display t
274+ release_terminal t
288275 return ()
289− , printSummary = displayBoundsTestSummary True
290− , confirmResults = genericOutputMatchConfirm
276+ , print_summary = display_bounds_test_summary True
277+ , confirm_results = generic_output_match_confirm
291278 }
292279
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
280+display_bounds_test_3 = Test
281+ { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
282+ , test_ID = "display_bounds_test_3"
283+ , test_action = do
284+ t <- terminal_handle
285+ reserve_display t
286+ DisplayRegion w h <- display_bounds t
287+ hide_cursor t
288+ set_cursor_pos t 0 0
289+ let row_0 = replicate (fromEnum w) 'X'
290+ putStrLn row_0
304291 forM_ [1 .. h - 2] $ \y -> do
305− setCursorPos t 0 y
292+ set_cursor_pos t 0 y
306293 putStr "X"
307294 hFlush stdout
308− setCursorPos t (w - 1) y
295+ set_cursor_pos t (w - 1) y
309296 putStr "X"
310297 hFlush stdout
311− setCursorPos t 0 (h - 1)
312− let rowH = row0
313− putStr rowH
298+ set_cursor_pos t 0 (h - 1)
299+ let row_h = row_0
300+ putStr row_h
314301 hFlush stdout
315302 getLine
316− showCursor t
317− releaseDisplay t
318− releaseTerminal t
303+ show_cursor t
304+ release_display t
305+ release_terminal t
319306 return ()
320− , printSummary = displayBoundsTestSummary False
321− , confirmResults = genericOutputMatchConfirm
307+ , print_summary = display_bounds_test_summary False
308+ , confirm_results = generic_output_match_confirm
322309 }
323310
324−displayBoundsTestSummary hasCursor = do
325− putStr $ [s|
311+display_bounds_test_summary has_cursor = do
312+ putStr $ [$heredoc|
326313Once return is pressed:
327314 0. The screen will be cleared.
328315|]
329− if hasCursor
316+ if has_cursor
330317 then putStr " 1. The cursor will be visible."
331318 else putStr " 1. The cursor will NOT be visible."
332− putStr [s|
333−
319+ putStr [$heredoc|
334320 2. The border of the display will be outlined in Xs.
335321 So if - and | represented the edge of the terminal window:
336322 |-------------|
337323 |XXXXXXXXXXXXX|
338324 |X X||]
339325
340− if hasCursor
341− then putStr $ [s|
342−
326+ if has_cursor
327+ then putStr $ [$heredoc|
343328 |XXXXXXXXXXXXC| |]
344− else putStr $ [s|
345−
329+ else putStr $ [$heredoc|
346330 |XXXXXXXXXXXXX| |]
347331
348− putStr $ [s|
349−
332+ putStr $ [$heredoc|
350333 |-------------|
351334
352335 ( Where C is the final position of the cursor. There may be an X drawn
@@ -358,13 +341,13 @@ After return is pressed for the second time:
358341 1. The cursor should be visible.
359342|]
360343
361−genericOutputMatchConfirm = do
362− putStr $ [s|
344+generic_output_match_confirm = do
345+ putStr $ [$heredoc|
363346Did the test output match the description?
364347|]
365− defaultSuccessConfirmResults
348+ default_success_confirm_results
366349
367−-- Explicitly define the bytes that encode each example text.
350+-- Explicitely definethe bytes that encode each example text.
368351-- This avoids any issues with how the compiler represents string literals.
369352--
370353-- This document is UTF-8 encoded so the UTF-8 string is still included for
@@ -373,24 +356,24 @@ Did the test output match the description?
373356-- It's assumed the compiler will at least not barf on UTF-8 encoded text in
374357-- comments ;-)
375358--
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
359+-- txt_0 = ↑↑↓↓←→←→BA
360+
361+utf8_txt_0 :: [[Word8]]
362+utf8_txt_0 = [ [ 0xe2 , 0x86 , 0x91 ]
363+ , [ 0xe2 , 0x86 , 0x91 ]
364+ , [ 0xe2 , 0x86 , 0x93 ]
365+ , [ 0xe2 , 0x86 , 0x93 ]
366+ , [ 0xe2 , 0x86 , 0x90 ]
367+ , [ 0xe2 , 0x86 , 0x92 ]
368+ , [ 0xe2 , 0x86 , 0x90 ]
369+ , [ 0xe2 , 0x86 , 0x92 ]
370+ , [ 0x42 ]
371+ , [ 0x41 ]
372+ ]
373+
374+iso_10646_txt_0 :: String
375+iso_10646_txt_0 = map toEnum
376+ [ 8593
394377 , 8593
395378 , 8595
396379 , 8595
@@ -402,46 +385,46 @@ iso10646Txt0 = map toEnum
402385 , 65
403386 ]
404387
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)
388+unicode_single_width_0 = Test
389+ { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
390+ , test_ID = "unicode_single_width_0"
391+ , test_action = do
392+ t <- terminal_handle
393+ reserve_display t
394+ hide_cursor t
395+ withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout)
413396 hPutStr stdout "\n"
414397 hPutStr stdout "0123456789\n"
415398 hFlush stdout
416399 getLine
417− releaseDisplay t
418− releaseTerminal t
400+ release_display t
401+ release_terminal t
419402 return ()
420− , printSummary = unicodeSingleWidthSummary
421− , confirmResults = genericOutputMatchConfirm
403+ , print_summary = unicode_single_width_summary
404+ , confirm_results = generic_output_match_confirm
422405 }
423406
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
407+unicode_single_width_1 = Test
408+ { test_name = "Verify terminal can display unicode single-width characters. (Image ops)"
409+ , test_ID = "unicode_single_width_1"
410+ , test_action = do
411+ t <- terminal_handle
412+ reserve_display t
413+ let pic = pic_for_image image
414+ image = line_0 <-> line_1
415+ line_0 = iso_10646_string def_attr iso_10646_txt_0
416+ line_1 = string def_attr "0123456789"
417+ d <- display_bounds t >>= display_context t
418+ output_picture d pic
436419 getLine
437− releaseDisplay t
438− releaseTerminal t
420+ release_display t
421+ release_terminal t
439422 return ()
440− , printSummary = unicodeSingleWidthSummary
441− , confirmResults = genericOutputMatchConfirm
423+ , print_summary = unicode_single_width_summary
424+ , confirm_results = generic_output_match_confirm
442425 }
443426
444−unicodeSingleWidthSummary = putStr [s|
427+unicode_single_width_summary = putStr [$heredoc|
445428Once return is pressed:
446429 0. The screen will be cleared.
447430 1. The cursor will be hidden.
@@ -475,55 +458,55 @@ After return is pressed for the second time:
475458
476459-- The second example is a unicode string containing double-width glyphs
477460-- 你好吗
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)
461+utf8_txt_1 :: [[Word8]]
462+utf8_txt_1 = [ [0xe4,0xbd,0xa0]
463+ , [0xe5,0xa5,0xbd]
464+ , [0xe5,0x90,0x97]
465+ ]
466+
467+iso_10646_txt_1 :: String
468+iso_10646_txt_1 = map toEnum [20320,22909,21527]
469+
470+unicode_double_width_0 = Test
471+ { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
472+ , test_ID = "unicode_double_width_0"
473+ , test_action = do
474+ t <- terminal_handle
475+ reserve_display t
476+ hide_cursor t
477+ withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout)
495478 hPutStr stdout "\n"
496479 hPutStr stdout "012345\n"
497480 hFlush stdout
498481 getLine
499− releaseDisplay t
500− releaseTerminal t
482+ release_display t
483+ release_terminal t
501484 return ()
502− , printSummary = unicodeDoubleWidthSummary
503− , confirmResults = genericOutputMatchConfirm
485+ , print_summary = unicode_double_width_summary
486+ , confirm_results = generic_output_match_confirm
504487 }
505488
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
489+unicode_double_width_1 = Test
490+ { test_name = "Verify terminal can display unicode double-width characters. (Image ops)"
491+ , test_ID = "unicode_double_width_1"
492+ , test_action = do
493+ t <- terminal_handle
494+ reserve_display t
495+ let pic = pic_for_image image
496+ image = line_0 <-> line_1
497+ line_0 = iso_10646_string def_attr iso_10646_txt_1
498+ line_1 = string def_attr "012345"
499+ d <- display_bounds t >>= display_context t
500+ output_picture d pic
518501 getLine
519− releaseDisplay t
520− releaseTerminal t
502+ release_display t
503+ release_terminal t
521504 return ()
522− , printSummary = unicodeDoubleWidthSummary
523− , confirmResults = genericOutputMatchConfirm
505+ , print_summary = unicode_double_width_summary
506+ , confirm_results = generic_output_match_confirm
524507 }
525508
526−unicodeDoubleWidthSummary = putStr [s|
509+unicode_double_width_summary = putStr [$heredoc|
527510Once return is pressed:
528511 0. The screen will be cleared.
529512 1. The cursor will be hidden.
@@ -550,33 +533,33 @@ After return is pressed for the second time:
550533 1. The cursor should be visible.
551534|]
552535
553−allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
554− [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
536+all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
537+ [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
555538
556−allBrightColors
557− = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]
539+all_bright_colors
540+ = zip [ bright_black, bright_red, bright_green, bright_yellow, bright_blue, bright_magenta, bright_cyan, bright_white ]
558541 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]
559542
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
543+attributes_test_0 = Test
544+ { test_name = "Character attributes: foreground colors."
545+ , test_ID = "attributes_test_0"
546+ , test_action = do
547+ t <- terminal_handle
548+ reserve_display t
549+ let pic = pic_for_image image
550+ image = border <|> column_0 <|> border <|> column_1 <|> border
551+ column_0 = vert_cat $ map line_with_color all_colors
552+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
553+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
554+ line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name
555+ d <- display_bounds t >>= display_context t
556+ output_picture d pic
574557 getLine
575− releaseDisplay t
576− releaseTerminal t
558+ release_display t
559+ release_terminal t
577560 return ()
578− , printSummary = do
579− putStr $ [s|
561+ , print_summary = do
562+ putStr $ [$heredoc|
580563Once return is pressed:
581564 0. The screen will be cleared.
582565 1. The cursor will be hidden.
@@ -596,33 +579,33 @@ After return is pressed for the second time:
596579 0. The screen containing the test summary should be restored.
597580 1. The cursor should be visible.
598581|]
599− , confirmResults = do
600− putStr $ [s|
582+ , confirm_results = do
583+ putStr $ [$heredoc|
601584Did the test output match the description?
602585|]
603− defaultSuccessConfirmResults
586+ default_success_confirm_results
604587 }
605588
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
589+attributes_test_1 = Test
590+ { test_name = "Character attributes: background colors."
591+ , test_ID = "attributes_test_1"
592+ , test_action = do
593+ t <- terminal_handle
594+ reserve_display t
595+ let pic = pic_for_image image
596+ image = border <|> column_0 <|> border <|> column_1 <|> border
597+ column_0 = vert_cat $ map line_with_color all_colors
598+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
599+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
600+ line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name
601+ d <- display_bounds t >>= display_context t
602+ output_picture d pic
620603 getLine
621− releaseDisplay t
622− releaseTerminal t
604+ release_display t
605+ release_terminal t
623606 return ()
624− , printSummary = do
625− putStr $ [s|
607+ , print_summary = do
608+ putStr $ [$heredoc|
626609Once return is pressed:
627610 0. The screen will be cleared.
628611 1. The cursor will be hidden.
@@ -651,57 +634,57 @@ After return is pressed for the second time:
651634 0. The screen containing the test summary should be restored.
652635 1. The cursor should be visible.
653636|]
654− , confirmResults = do
655− putStr $ [s|
637+ , confirm_results = do
638+ putStr $ [$heredoc|
656639Did the test output match the description?
657640|]
658− defaultSuccessConfirmResults
641+ default_success_confirm_results
659642 }
660643
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
644+attributes_test_2 = Test
645+ { test_name = "Character attributes: Vivid foreground colors."
646+ , test_ID = "attributes_test_2"
647+ , test_action = do
648+ t <- terminal_handle
649+ reserve_display t
650+ let pic = pic_for_image image
651+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
652+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
653+ column_0 = vert_cat $ map line_with_color_0 all_colors
654+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
655+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
656+ line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name
657+ line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name
658+ d <- display_bounds t >>= display_context t
659+ output_picture d pic
677660 getLine
678− releaseDisplay t
679− releaseTerminal t
661+ release_display t
662+ release_terminal t
680663 return ()
681− , printSummary = do
682− putStr $ [s|
664+ , print_summary = do
665+ putStr $ [$heredoc|
683666Once return is pressed:
684667 0. The screen will be cleared.
685668 1. The cursor will be hidden.
686669 2. 9 lines of text in three columns will be drawn:
687670 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.
671+ terminal) rendered with that color as the foreground color.
689672 b. The next column will be also be the name of a standard color rendered
690673 with that color as the foreground color but the shade used should be
691− more vivid than the shade used in the first column.
674+ more vivid than the shade used in the first column.
692675 c. The final column will be the name of a color rendered with the
693676 default attributes.
694677
695678For instance, one line will be the word "magenta" and that word should be
696−rendered in the magenta color.
679+rendered in the magenta color.
697680
698681I'm not actually sure exactly what "vivid" means in this context. For xterm the
699−vivid colors are brighter.
682+vivid colors are brighter.
700683
701−Verify:
684+Verify:
702685 * The first column: The foreground color matches the named color.
703686 * The second column: The foreground color matches the named color but is
704− more vivid than the color used in the first column.
687+ more vivid than the color used in the first column.
705688 * The third column: All text is rendered with the default attributes.
706689 * The vertical bars used in each line to mark the border of a column are
707690 lined up.
@@ -710,58 +693,58 @@ After return is pressed for the second time:
710693 0. The screen containing the test summary should be restored.
711694 1. The cursor should be visible.
712695|]
713− , confirmResults = do
714− putStr $ [s|
696+ , confirm_results = do
697+ putStr $ [$heredoc|
715698Did the test output match the description?
716699|]
717− defaultSuccessConfirmResults
700+ default_success_confirm_results
718701 }
719702
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
703+attributes_test_3 = Test
704+ { test_name = "Character attributes: Vivid background colors."
705+ , test_ID = "attributes_test_3"
706+ , test_action = do
707+ t <- terminal_handle
708+ reserve_display t
709+ let pic = pic_for_image image
710+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
711+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
712+ column_0 = vert_cat $ map line_with_color_0 all_colors
713+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
714+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
715+ line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name
716+ line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name
717+ d <- display_bounds t >>= display_context t
718+ output_picture d pic
736719 getLine
737− releaseDisplay t
738− releaseTerminal t
720+ release_display t
721+ release_terminal t
739722 return ()
740− , printSummary = do
741− putStr $ [s|
723+ , print_summary = do
724+ putStr $ [$heredoc|
742725Once return is pressed:
743726 0. The screen will be cleared.
744727 1. The cursor will be hidden.
745728 2. 9 lines of text in three columns will be drawn:
746729 a. The first column will contain be a name of a standard color for an 8
747730 color terminal rendered with the default foreground color with a
748− background the named color.
731+ background the named color.
749732 b. The first column will contain be a name of a standard color for an 8
750733 color terminal rendered with the default foreground color with the
751− background a vivid version of the named color.
734+ background a vivid version of the named color.
752735 c. The third column will be the name of a standard color rendered with
753736 the default attributes.
754−
737+
755738For 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.
739+be rendered in the default foreground color over a magenta background.
757740
758741I'm not actually sure exactly what "vivid" means in this context. For xterm the
759742vivid colors are brighter.
760743
761−Verify:
744+Verify:
762745 * The first column: The background color matches the named color.
763746 * The second column: The background color matches the named color and is
764− more vivid than the color used in the first column.
747+ more vivid than the color used in the first column.
765748 * The third column column: All text is rendered with the default attributes.
766749 * The vertical bars used in each line to mark the border of a column are
767750 lined up.
@@ -777,51 +760,51 @@ After return is pressed for the second time:
777760 0. The screen containing the test summary should be restored.
778761 1. The cursor should be visible.
779762|]
780− , confirmResults = do
781− putStr $ [s|
763+ , confirm_results = do
764+ putStr $ [$heredoc|
782765Did the test output match the description?
783766|]
784− defaultSuccessConfirmResults
767+ default_success_confirm_results
785768 }
786769
787−attrCombos =
770+attr_combos =
788771 [ ( "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) )
772+ , ( "bold", flip with_style bold )
773+ , ( "blink", flip with_style blink )
774+ , ( "underline", flip with_style underline )
775+ , ( "bold + blink", flip with_style (bold + blink) )
776+ , ( "bold + underline", flip with_style (bold + underline) )
777+ , ( "underline + blink", flip with_style (underline + blink) )
778+ , ( "bold + blink + underline", flip with_style (bold + blink + underline) )
796779 ]
797780
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
781+attributes_test_4 = Test
782+ { test_name = "Character attributes: Bold; Blink; Underline."
783+ , test_ID = "attributes_test_4"
784+ , test_action = do
785+ t <- terminal_handle
786+ reserve_display t
787+ let pic = pic_for_image image
788+ image = horiz_cat [border, column_0, border, column_1, border]
789+ border = vert_cat $ replicate (length attr_combos) $ string def_attr " | "
790+ column_0 = vert_cat $ map line_with_attrs attr_combos
791+ column_1 = vert_cat $ map (string def_attr . fst) attr_combos
792+ line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc
793+ d <- display_bounds t >>= display_context t
794+ output_picture d pic
812795 getLine
813− releaseDisplay t
814− releaseTerminal t
796+ release_display t
797+ release_terminal t
815798 return ()
816− , printSummary = do
817− putStr $ [s|
799+ , print_summary = do
800+ putStr $ [$heredoc|
818801Once return is pressed:
819802 0. The screen will be cleared.
820803 1. The cursor will be hidden.
821− 2. 8 rows of text in two columns.
804+ 2. 8 rows of text in two columns.
822805 The rows will contain the following text:
823806 default
824− bold
807+ bold
825808 blink
826809 underline
827810 bold + blink
@@ -830,8 +813,8 @@ Once return is pressed:
830813 bold + blink + underline
831814 The first column will be rendered with the described attributes. The second
832815 column will be rendered with the default attributes.
833−
834−Verify:
816+
817+Verify:
835818 * The vertical bars used in each line to mark the border of a column are
836819 lined up.
837820 * The text in the first column is rendered as described.
@@ -840,353 +823,104 @@ After return is pressed for the second time:
840823 0. The screen containing the test summary should be restored.
841824 1. The cursor should be visible.
842825|]
843− , confirmResults = do
844− putStr $ [s|
826+ , confirm_results = do
827+ putStr $ [$heredoc|
845828Did the test output match the description?
846829|]
847− defaultSuccessConfirmResults
830+ default_success_confirm_results
848831 }
849832
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
833+attributes_test_5 = Test
834+ { test_name = "Character attributes: 240 color palette"
835+ , test_ID = "attributes_test_5"
836+ , test_action = do
837+ t <- terminal_handle
838+ reserve_display t
839+ let pic = pic_for_image image
840+ image = vert_cat $ map horiz_cat $ split_color_images color_images
841+ color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239]
842+ split_color_images [] = []
843+ split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is))
844+ d <- display_bounds t >>= display_context t
845+ output_picture d pic
863846 getLine
864− releaseDisplay t
865− releaseTerminal t
847+ release_display t
848+ release_terminal t
866849 return ()
867− , printSummary = do
868− putStr $ [s|
850+ , print_summary = do
851+ putStr $ [$heredoc|
869852Once return is pressed:
870853 0. The screen will be cleared.
871854 1. The cursor will be hidden.
872855 2. A 20 character wide and 12 row high block of color squares. This should look like a palette
873856 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...
874857
875−Verify:
858+Verify:
876859
877860After return is pressed for the second time:
878861 0. The screen containing the test summary should be restored.
879862 1. The cursor should be visible.
880863|]
881− , confirmResults = do
882− putStr $ [s|
864+ , confirm_results = do
865+ putStr $ [$heredoc|
883866Did the test output match the description?
884867|]
885− defaultSuccessConfirmResults
868+ default_success_confirm_results
886869 }
887870
888−inlineTest0 = Test
889− { testName = "Verify styled output can be performed without clearing the screen."
890− , testID = "inlineTest0"
891− , testAction = do
871+inline_test_0 = Test
872+ { test_name = "Verify styled output can be performed without clearing the screen."
873+ , test_ID = "inline_test_0"
874+ , test_action = do
875+ t <- terminal_handle
892876 putStrLn "line 1."
893− putAttrChange_ $ backColor red >> applyStyle underline
877+ put_attr_change t $ back_color red >> apply_style underline
894878 putStrLn "line 2."
895− putAttrChange_ $ defaultAll
879+ put_attr_change t $ default_all
896880 putStrLn "line 3."
897− , printSummary = putStr $ [s|
881+ release_terminal t
882+ return ()
883+ , print_summary = putStr $ [$heredoc|
898884lines are in order.
899885The second line "line 2" should have a red background and the text underline.
900886The third line "line 3" should be drawn in the same style as the first line.
901887|]
902888
903− , confirmResults = genericOutputMatchConfirm
889+ , confirm_results = generic_output_match_confirm
904890 }
905891
906−inlineTest1 = Test
907− { testName = "Verify styled output can be performed without clearing the screen."
908− , testID = "inlineTest1"
909− , testAction = do
892+inline_test_1 = Test
893+ { test_name = "Verify styled output can be performed without clearing the screen."
894+ , test_ID = "inline_test_1"
895+ , test_action = do
896+ t <- terminal_handle
910897 putStr "Not styled. "
911− putAttrChange_ $ backColor red >> applyStyle underline
898+ put_attr_change t $ back_color red >> apply_style underline
912899 putStr " Styled! "
913− putAttrChange_ $ defaultAll
900+ put_attr_change t $ default_all
914901 putStrLn "Not styled."
915− , printSummary = putStr $ [s|
916−|]
917−
918− , confirmResults = genericOutputMatchConfirm
919− }
920−
921−inlineTest2 = Test
922− { testName = "Verify styled output can be performed without clearing the screen."
923− , testID = "inlineTest1"
924− , testAction = do
925− putStr "Not styled. "
926− putAttrChange_ $ backColor red >> applyStyle underline
927− putStr " Styled! "
928− putAttrChange_ $ defaultAll
929− putStr "Not styled.\n"
930− , printSummary = putStr $ [s|
931−|]
932− , confirmResults = genericOutputMatchConfirm
933− }
934−
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
946− shutdown vty
902+ release_terminal t
947903 return ()
948− , printSummary = putStr $ [s|
949− 1. verify the cursor is displayed.
950− 2. press enter
951− 3. verify the cursor is hid.
952− 4. press enter.
953− 5. the display should return to the state before the test.
954−|]
955− , confirmResults = genericOutputMatchConfirm
956− }
957−
958−outputImageAndWait :: Image -> IO ()
959−outputImageAndWait image = do
960− let pic = picForImage image
961− outputPicAndWait pic
962−
963−outputPicAndWait :: Picture -> IO ()
964−outputPicAndWait pic = do
965− t <- standardIOConfig >>= outputForConfig
966− reserveDisplay t
967− d <- displayBounds t >>= displayContext t
968− outputPicture d pic
969− getLine
970− releaseDisplay t
971− releaseTerminal t
972− return ()
973−
974−vertCropTest0 :: Test
975−vertCropTest0 = Test
976− { testName = "Verify bottom cropping works as expected with single column chars"
977− , testID = "cropTest0"
978− , testAction = do
979− let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsum
980− block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsum
981− image = block0 <-> backgroundFill 10 2 <-> block1
982− outputImageAndWait image
983− , printSummary = putStr $ [s|
984− 1. Verify the two text blocks are identical.
985− 2. press enter.
986− 3. the display should return to the state before the test.
904+ , print_summary = putStr $ [$heredoc|
987905|]
988− , confirmResults = genericOutputMatchConfirm
989− }
990−
991−vertCropTest1 :: Test
992−vertCropTest1 = Test
993− { testName = "Verify bottom cropping works as expected with double column chars"
994− , testID = "cropTest0"
995− , testAction = do
996− let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
997− block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsumChinese
998− image = block0 <-> backgroundFill 10 2 <-> block1
999− outputImageAndWait image
1000− , printSummary = putStr $ [s|
1001− 1. Verify the two text blocks are identical.
1002− 2. press enter.
1003− 3. the display should return to the state before the test.
1004−|]
1005− , confirmResults = genericOutputMatchConfirm
1006− }
1007−
1008−vertCropTest2 :: Test
1009−vertCropTest2 = Test
1010− { testName = "Verify top cropping works as expected with single column chars"
1011− , testID = "cropTest2"
1012− , testAction = do
1013− let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsum
1014− block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsum - 2) lorumIpsum
1015− image = block0 <-> backgroundFill 10 2 <-> block1
1016− outputImageAndWait image
1017− , printSummary = putStr $ [s|
1018− 1. Verify the two text blocks are identical.
1019− 2. press enter.
1020− 3. the display should return to the state before the test.
1021−|]
1022− , confirmResults = genericOutputMatchConfirm
1023− }
1024−
1025−vertCropTest3 :: Test
1026−vertCropTest3 = Test
1027− { testName = "Verify top cropping works as expected with double column chars"
1028− , testID = "cropTest0"
1029− , testAction = do
1030− let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
1031− block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsumChinese - 2 ) lorumIpsumChinese
1032− image = block0 <-> backgroundFill 10 2 <-> block1
1033− outputImageAndWait image
1034− , printSummary = putStr $ [s|
1035− 1. Verify the two text blocks are identical.
1036− 2. press enter.
1037− 3. the display should return to the state before the test.
1038−|]
1039− , confirmResults = genericOutputMatchConfirm
1040− }
1041−
1042−horizCropTest0 :: Test
1043−horizCropTest0 = Test
1044− { testName = "Verify right cropping works as expected with single column chars"
1045− , testID = "cropTest0"
1046− , testAction = do
1047− let baseImage = vertCat $ map (string defAttr) lorumIpsum
1048− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1049− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1050− outputImageAndWait image
1051− , printSummary = putStr $ [s|
1052− 1. Verify the bottom text block is about half the width of the top text block.
1053− 2. press enter.
1054− 3. the display should return to the state before the test.
1055−|]
1056− , confirmResults = genericOutputMatchConfirm
1057− }
1058−
1059−horizCropTest1 :: Test
1060−horizCropTest1 = Test
1061− { testName = "Verify right cropping works as expected with double column chars"
1062− , testID = "cropTest0"
1063− , testAction = do
1064− let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1065− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1066− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1067− outputImageAndWait image
1068− , printSummary = putStr $ [s|
1069− 1. Verify the bottom text block is the left half of the top block. Ellipses on the right edge are OK.
1070− 2. press enter.
1071− 3. the display should return to the state before the test.
1072−|]
1073− , confirmResults = genericOutputMatchConfirm
1074− }
1075906
1076−horizCropTest2 :: Test
1077−horizCropTest2 = Test
1078− { testName = "Verify left cropping works as expected with single column chars"
1079− , testID = "cropTest0"
1080− , testAction = do
1081− let baseImage = vertCat $ map (string defAttr) lorumIpsum
1082− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1083− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1084− outputImageAndWait image
1085− , printSummary = putStr $ [s|
1086− 1. Verify the bottom text block is the right half of the top text block.
1087− 2. press enter.
1088− 3. the display should return to the state before the test.
1089−|]
1090− , confirmResults = genericOutputMatchConfirm
907+ , confirm_results = generic_output_match_confirm
1091908 }
1092909
1093−horizCropTest3 :: Test
1094−horizCropTest3 = Test
1095− { testName = "Verify right cropping works as expected with double column chars"
1096− , testID = "cropTest0"
1097− , testAction = do
1098− let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1099− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1100− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1101− outputImageAndWait image
1102− , printSummary = putStr $ [s|
1103− 1. Verify the bottom text block is the right half of the top block. Ellipses on the left edge are OK.
1104− 2. press enter.
1105− 3. the display should return to the state before the test.
1106−|]
1107− , confirmResults = genericOutputMatchConfirm
1108− }
1109−
1110−layer0 :: Test
1111−layer0 = Test
1112− { testName = "verify layer 0"
1113− , testID = "layer0"
1114− , testAction = do
1115− let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1116− lowerImage = vertCat $ map (string defAttr) lorumIpsum
1117− p = picForLayers [upperImage, lowerImage]
1118− outputPicAndWait p
1119− , printSummary = putStr $ [s|
1120− 1. Verify the text block appears to be Chinese text placed on top Latin text.
1121− 2. press enter.
1122− 3. the display should return to the state before the test.
910+inline_test_2 = Test
911+ { test_name = "Verify styled output can be performed without clearing the screen."
912+ , test_ID = "inline_test_1"
913+ , test_action = do
914+ t <- terminal_handle
915+ put_string t "Not styled. "
916+ put_attr_change t $ back_color red >> apply_style underline
917+ put_string t " Styled! "
918+ put_attr_change t $ default_all
919+ put_string t "Not styled.\n"
920+ release_terminal t
921+ return ()
922+ , print_summary = putStr $ [$heredoc|
1123923|]
1124− , confirmResults = genericOutputMatchConfirm
1125− }
1126924
1127−layer1 :: Test
1128−layer1 = Test
1129− { testName = "verify layer 1"
1130− , testID = "layer1"
1131− , testAction = do
1132− let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1133− block = resize 10 10 upperImage
1134− layer0 = vertCat $ map (string defAttr) lorumIpsum
1135− layer1 = charFill (defAttr `withBackColor` blue) '#' 1000 1000
1136− cheesyAnim0 block [layer0, layer1]
1137− , printSummary = putStr $ [s|
1138− 1. Verify the text block appears to be Chinese text moving on top a Latin text.
1139− Which is all on a background of '#' characters over blue.
1140− 2. press enter.
1141− 3. the display should return to the state before the test.
1142−|]
1143− , confirmResults = genericOutputMatchConfirm
925+ , confirm_results = generic_output_match_confirm
1144926 }
1145−
1146−cheesyAnim0 :: Image -> [Image] -> IO ()
1147−cheesyAnim0 i background = do
1148− t <- standardIOConfig >>= outputForConfig
1149− reserveDisplay t
1150− bounds <- displayBounds t
1151− d <- displayContext t bounds
1152− forM_ [0..2] $ \t -> do
1153− forM_ [0..100] $ \t -> do
1154− let i_offset = translate (t `mod` fst bounds)
1155− (t `div` 2 `mod` snd bounds)
1156− i
1157− let pic = picForLayers $ i_offset : background
1158− outputPicture d pic
1159− threadDelay 50000
1160− forM_ [0..100] $ \t -> do
1161− let i_offset = translate (t * (-1) `mod` fst bounds)
1162− (t * (-1) `div` 2 `mod` snd bounds)
1163− i
1164− let pic = picForLayers $ i_offset : background
1165− outputPicture d pic
1166− threadDelay 50000
1167− releaseDisplay t
1168− releaseTerminal t
1169− return ()
1170−
1171−lorumIpsum :: [String]
1172−lorumIpsum = lines [s|
1173−Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium,
1174−totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae
1175−dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit,
1176−sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam
1177−est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius
1178−modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima
1179−veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea
1180−commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil
1181−molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
1182−|]
1183−
1184−lorumIpsumChinese :: [String]
1185−lorumIpsumChinese = lines [s|
1186−輐銛 螷蟞覮 裌覅詵 暕 鴅噮 槶 惝掭掝 婸媥媕 耏胠臿, 汫汭沎 忕汌卣 蚡袀 僣 蒮 瀁瀎瀊 渮湸湤 緌翢,
1187−腠腶舝 糲蘥蠩 樏殣氀 蒮 蹢鎒 滍 鸄齴 櫧櫋瀩 鬄鵊鵙 莃荶衒, 毸溠 橀 簎艜薤 莃荶衒 翣聜蒢
1188−斔櫅檷 晛桼桾 拻敁柧 犿玒 膣, 墐 笓粊紒 bacon 鼀齕, 蔝蓶蓨 顊顃餭 姴怤 骱 暕 蹢鎒鎛 藒襓謥 鄻鎟霣
1189−鬎鯪, 鐩闤 硻禂稢 谾踘遳 撱 赲 迡 箷 蛃袚觙 萇雊蜩 壿嫷 鋡 縢羱聬 跐鉠鉣 蔝蓶蓨 匢奾灱 溮煡煟 雥齆犪
1190−蔰 虈觿, 腷腯葹 鍹餳駷 蛚袲褁蜸 皯竻 瀁瀎 蜭蜸覟 梪涫湴 揗斝湁 毼
1191−|]
1192−