@@ -2,14 +2,12 @@
22{-# LANGUAGE ScopedTypeVariables #-}
33module Main where
44
5−import 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
11−import Control.Concurrent (threadDelay)
12−import Control.Exception
1311import Control.Monad
1412
1513import Data.List ( lookup )
@@ -18,18 +16,18 @@ import Data.Monoid
1816import Data.String.QQ
1917import Data.Word
2018
21−import Foreign.Marshal.Array
19+import Foreign.Marshal.Array
2220
2321import qualified System.Environment as Env
2422
2523import System.IO ( hFlush, hPutStr, hPutBuf, stdout )
2624
2725main = do
28− printIntro
26+ print_intro
2927
30−outputFilePath = "test_results.list"
28+output_file_path = "test_results.list"
3129
32−printIntro = do
30+print_intro = do
3331 putStr $ [s|
3432This is an interactive verification program for the terminal input and output
3533support of the VTY library. This will ask a series of questions about what you
@@ -37,7 +35,7 @@ see on screen. The goal is to verify that VTY's output and input support
3735performs as expected with your terminal.
3836
3937This program produces a file named
40− |] ++ outputFilePath ++ [s|
38+ |] ++ output_file_path ++ [s|
4139in the current directory that contains the results for each test assertion. This
4240can be emailed to coreyoconnor@gmail.com and used by the VTY authors to improve
4341support for your terminal. No personal information is contained in the report.
@@ -63,43 +61,42 @@ All the tests assume the following about the terminal display:
6361 a good range of the unicode characters. Each test involving unicode display
6462 describes the expected appearance of each glyph.
6563
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
64+Thanks for the help! :-D
65+To exit the test early enter "q" anytime at the following menu screen. Even if
66+you exit the test early please email the test_results.list file to
67+coreyoconnor@gmail.com. The results file will still contain information useful
68+to debug terminal support.
69+
70+|]
71+ wait_for_return
72+ results <- do_test_menu 1
73+ env_attributes <- mapM ( \env_name -> catch ( Env.getEnv env_name >>= return . (,) env_name )
74+ ( const $ return (env_name, "") )
75+ )
76+ [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
77+ t <- terminal_handle
78+ let results_txt = show env_attributes ++ "\n"
79+ ++ terminal_ID t ++ "\n"
80+ ++ show results ++ "\n"
81+ release_terminal t
82+ writeFile output_file_path results_txt
83+
84+wait_for_return = do
8885 putStr "\n(press return to continue)"
8986 hFlush stdout
9087 getLine
9188
92−testMenu :: [(String, Test)]
93−testMenu = zip (map show [1..]) allTests
89+test_menu :: [(String, Test)]
90+test_menu = zip (map show [1..]) all_tests
9491
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"
92+do_test_menu :: Int -> IO [(String, Bool)]
93+do_test_menu next_ID
94+ | next_ID > length all_tests = do
95+ putStrLn $ "Done! Please email the " ++ output_file_path ++ " file to coreyoconnor@gmail.com"
9996 return []
10097 | otherwise = do
101− displayTestMenu
102− putStrLn $ "Press return to start with #" ++ show nextID ++ "."
98+ display_test_menu
99+ putStrLn $ "Press return to start with #" ++ show next_ID ++ "."
103100 putStrLn "Enter a test number to perform only that test."
104101 putStrLn "q (or control-C) to quit."
105102 putStr "> "
@@ -107,102 +104,91 @@ doTestMenu nextID
107104 s <- getLine >>= return . filter (/= '\n')
108105 case s of
109106 "q" -> return mempty
110− "" -> do
111− r <- runTest $ show nextID
112− rs <- doTestMenu ( nextID + 1 )
107+ "" -> do
108+ r <- run_test $ show next_ID
109+ rs <- do_test_menu ( next_ID + 1 )
113110 return $ r : rs
114− i | isJust ( lookup i testMenu ) -> do
115− r <- runTest i
116− rs <- doTestMenu ( read i + 1 )
111+ i | isJust ( lookup i test_menu ) -> do
112+ r <- run_test i
113+ rs <- do_test_menu ( read i + 1 )
117114 return $ r : rs
118115 where
119− displayTestMenu
120− = mapM_ displayTestMenu' testMenu
121− displayTestMenu' ( i, t )
122− = putStrLn $ ( if i == show nextID
123− then "> "
116+ display_test_menu
117+ = mapM_ display_test_menu' test_menu
118+ display_test_menu' ( i, t )
119+ = putStrLn $ ( if i == show next_ID
120+ then "> "
124121 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
122+ ) ++ i ++ ". " ++ test_name t
123+
124+run_test :: String -> IO (String, Bool)
125+run_test i = do
126+ let t = fromJust $ lookup i test_menu
127+ print_summary t
128+ wait_for_return
129+ test_action t
130+ r <- confirm_results t
131+ return (test_ID t, r)
132+
133+default_success_confirm_results = do
137134 putStr "\n"
138135 putStr "[Y/n] "
139136 hFlush stdout
140137 r <- getLine
141138 case r of
142− "" -> return True
139+ "" -> return True
143140 "y" -> return True
144141 "Y" -> return True
145142 "n" -> return False
146143
147144data Test = Test
148− { testName :: String
149− , testID :: String
150− , testAction :: IO ()
151− , printSummary :: IO ()
152− , confirmResults :: IO Bool
145+ { test_name :: String
146+ , test_ID :: String
147+ , test_action :: IO ()
148+ , print_summary :: IO ()
149+ , confirm_results :: IO Bool
153150 }
154151
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
152+all_tests
153+ = [ reserve_output_test
154+ , display_bounds_test_0
155+ , display_bounds_test_1
156+ , display_bounds_test_2
157+ , display_bounds_test_3
158+ , unicode_single_width_0
159+ , unicode_single_width_1
160+ , unicode_double_width_0
161+ , unicode_double_width_1
162+ , attributes_test_0
163+ , attributes_test_1
164+ , attributes_test_2
165+ , attributes_test_3
166+ , attributes_test_4
167+ , attributes_test_5
168+ , inline_test_0
169+ , inline_test_1
170+ , inline_test_2
185171 ]
186172
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
173+reserve_output_test = Test
174+ { test_name = "Initialize and reserve terminal output then restore previous state."
175+ , test_ID = "reserve_output_test"
176+ , test_action = do
177+ t <- terminal_handle
178+ reserve_display t
193179 putStrLn "Line 1"
194180 putStrLn "Line 2"
195181 putStrLn "Line 3"
196182 putStrLn "Line 4 (press return)"
197183 hFlush stdout
198184 getLine
199− releaseDisplay t
200− releaseTerminal t
185+ release_display t
186+ release_terminal t
201187 return ()
202− , printSummary = do
188+ , print_summary = do
203189 putStr $ [s|
204190Once return is pressed:
205− 0. The screen will be cleared.
191+ 0. The screen will be cleared.
206192 1. Four lines of text should be visible.
207193 1. The cursor should be visible and at the start of the fifth line.
208194
@@ -210,143 +196,139 @@ After return is pressed for the second time this test then:
210196 * The screen containing the test summary should be restored;
211197 * The cursor is visible.
212198|]
213− , confirmResults = do
199+ , confirm_results = do
214200 putStr $ [s|
215201Did the test output match the description?
216202|]
217− defaultSuccessConfirmResults
203+ default_success_confirm_results
218204 }
219205
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
206+display_bounds_test_0 = Test
207+ { test_name = "Verify display bounds are correct test 0: Using spaces."
208+ , test_ID = "display_bounds_test_0"
209+ , test_action = do
210+ t <- terminal_handle
211+ reserve_display t
212+ DisplayRegion w h <- display_bounds t
213+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
214+ row_h = replicate (fromEnum w - 1) 'X'
215+ row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
216+ image = row_0 ++ (concat $ replicate (fromEnum h - 2) row_n) ++ row_h
231217 putStr image
232218 hFlush stdout
233219 getLine
234− releaseDisplay t
235− releaseTerminal t
220+ release_display t
221+ release_terminal t
236222 return ()
237− , printSummary = displayBoundsTestSummary True
238− , confirmResults = genericOutputMatchConfirm
223+ , print_summary = display_bounds_test_summary True
224+ , confirm_results = generic_output_match_confirm
239225 }
240226
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
227+display_bounds_test_1 = Test
228+ { test_name = "Verify display bounds are correct test 0: Using cursor movement."
229+ , test_ID = "display_bounds_test_1"
230+ , test_action = do
231+ t <- terminal_handle
232+ reserve_display t
233+ DisplayRegion w h <- display_bounds t
234+ set_cursor_pos t 0 0
235+ let row_0 = replicate (fromEnum w) 'X' ++ "\n"
236+ putStr row_0
251237 forM_ [1 .. h - 2] $ \y -> do
252− setCursorPos t 0 y
238+ set_cursor_pos t 0 y
253239 putStr "X"
254240 hFlush stdout
255− setCursorPos t (w - 1) y
241+ set_cursor_pos t (w - 1) y
256242 putStr "X"
257243 hFlush stdout
258− setCursorPos t 0 (h - 1)
259− let rowH = replicate (fromEnum w - 1) 'X'
260− putStr rowH
244+ set_cursor_pos t 0 (h - 1)
245+ let row_h = replicate (fromEnum w - 1) 'X'
246+ putStr row_h
261247 hFlush stdout
262248 getLine
263− releaseDisplay t
264− releaseTerminal t
249+ release_display t
250+ release_terminal t
265251 return ()
266− , printSummary = displayBoundsTestSummary True
267− , confirmResults = genericOutputMatchConfirm
252+ , print_summary = display_bounds_test_summary True
253+ , confirm_results = generic_output_match_confirm
268254 }
269255
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
256+display_bounds_test_2 = Test
257+ { test_name = "Verify display bounds are correct test 0: Using Image ops."
258+ , test_ID = "display_bounds_test_2"
259+ , test_action = do
260+ t <- terminal_handle
261+ reserve_display t
262+ bounds@(DisplayRegion w h) <- display_bounds t
263+ let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')
264+ middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row
265+ middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')
266+ end_row = first_row
267+ image = first_row <-> middle_rows <-> end_row
268+ pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) }
269+ d <- display_context t bounds
270+ output_picture d pic
285271 getLine
286− releaseDisplay t
287− releaseTerminal t
272+ release_display t
273+ release_terminal t
288274 return ()
289− , printSummary = displayBoundsTestSummary True
290− , confirmResults = genericOutputMatchConfirm
275+ , print_summary = display_bounds_test_summary True
276+ , confirm_results = generic_output_match_confirm
291277 }
292278
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
279+display_bounds_test_3 = Test
280+ { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
281+ , test_ID = "display_bounds_test_3"
282+ , test_action = do
283+ t <- terminal_handle
284+ reserve_display t
285+ DisplayRegion w h <- display_bounds t
286+ hide_cursor t
287+ set_cursor_pos t 0 0
288+ let row_0 = replicate (fromEnum w) 'X'
289+ putStrLn row_0
304290 forM_ [1 .. h - 2] $ \y -> do
305− setCursorPos t 0 y
291+ set_cursor_pos t 0 y
306292 putStr "X"
307293 hFlush stdout
308− setCursorPos t (w - 1) y
294+ set_cursor_pos t (w - 1) y
309295 putStr "X"
310296 hFlush stdout
311− setCursorPos t 0 (h - 1)
312− let rowH = row0
313− putStr rowH
297+ set_cursor_pos t 0 (h - 1)
298+ let row_h = row_0
299+ putStr row_h
314300 hFlush stdout
315301 getLine
316− showCursor t
317− releaseDisplay t
318− releaseTerminal t
302+ show_cursor t
303+ release_display t
304+ release_terminal t
319305 return ()
320− , printSummary = displayBoundsTestSummary False
321− , confirmResults = genericOutputMatchConfirm
306+ , print_summary = display_bounds_test_summary False
307+ , confirm_results = generic_output_match_confirm
322308 }
323309
324−displayBoundsTestSummary hasCursor = do
310+display_bounds_test_summary has_cursor = do
325311 putStr $ [s|
326312Once return is pressed:
327313 0. The screen will be cleared.
328314|]
329− if hasCursor
315+ if has_cursor
330316 then putStr " 1. The cursor will be visible."
331317 else putStr " 1. The cursor will NOT be visible."
332318 putStr [s|
333−
334319 2. The border of the display will be outlined in Xs.
335320 So if - and | represented the edge of the terminal window:
336321 |-------------|
337322 |XXXXXXXXXXXXX|
338323 |X X||]
339324
340− if hasCursor
325+ if has_cursor
341326 then putStr $ [s|
342−
343327 |XXXXXXXXXXXXC| |]
344328 else putStr $ [s|
345−
346329 |XXXXXXXXXXXXX| |]
347330
348331 putStr $ [s|
349−
350332 |-------------|
351333
352334 ( Where C is the final position of the cursor. There may be an X drawn
@@ -358,13 +340,13 @@ After return is pressed for the second time:
358340 1. The cursor should be visible.
359341|]
360342
361−genericOutputMatchConfirm = do
343+generic_output_match_confirm = do
362344 putStr $ [s|
363345Did the test output match the description?
364346|]
365− defaultSuccessConfirmResults
347+ default_success_confirm_results
366348
367−-- Explicitly define the bytes that encode each example text.
349+-- Explicitely definethe bytes that encode each example text.
368350-- This avoids any issues with how the compiler represents string literals.
369351--
370352-- This document is UTF-8 encoded so the UTF-8 string is still included for
@@ -373,24 +355,24 @@ Did the test output match the description?
373355-- It's assumed the compiler will at least not barf on UTF-8 encoded text in
374356-- comments ;-)
375357--
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
358+-- txt_0 = ↑↑↓↓←→←→BA
359+
360+utf8_txt_0 :: [[Word8]]
361+utf8_txt_0 = [ [ 0xe2 , 0x86 , 0x91 ]
362+ , [ 0xe2 , 0x86 , 0x91 ]
363+ , [ 0xe2 , 0x86 , 0x93 ]
364+ , [ 0xe2 , 0x86 , 0x93 ]
365+ , [ 0xe2 , 0x86 , 0x90 ]
366+ , [ 0xe2 , 0x86 , 0x92 ]
367+ , [ 0xe2 , 0x86 , 0x90 ]
368+ , [ 0xe2 , 0x86 , 0x92 ]
369+ , [ 0x42 ]
370+ , [ 0x41 ]
371+ ]
372+
373+iso_10646_txt_0 :: String
374+iso_10646_txt_0 = map toEnum
375+ [ 8593
394376 , 8593
395377 , 8595
396378 , 8595
@@ -402,46 +384,46 @@ iso10646Txt0 = map toEnum
402384 , 65
403385 ]
404386
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)
387+unicode_single_width_0 = Test
388+ { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
389+ , test_ID = "unicode_single_width_0"
390+ , test_action = do
391+ t <- terminal_handle
392+ reserve_display t
393+ hide_cursor t
394+ withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout)
413395 hPutStr stdout "\n"
414396 hPutStr stdout "0123456789\n"
415397 hFlush stdout
416398 getLine
417− releaseDisplay t
418− releaseTerminal t
399+ release_display t
400+ release_terminal t
419401 return ()
420− , printSummary = unicodeSingleWidthSummary
421− , confirmResults = genericOutputMatchConfirm
402+ , print_summary = unicode_single_width_summary
403+ , confirm_results = generic_output_match_confirm
422404 }
423405
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
406+unicode_single_width_1 = Test
407+ { test_name = "Verify terminal can display unicode single-width characters. (Image ops)"
408+ , test_ID = "unicode_single_width_1"
409+ , test_action = do
410+ t <- terminal_handle
411+ reserve_display t
412+ let pic = pic_for_image image
413+ image = line_0 <-> line_1
414+ line_0 = iso_10646_string def_attr iso_10646_txt_0
415+ line_1 = string def_attr "0123456789"
416+ d <- display_bounds t >>= display_context t
417+ output_picture d pic
436418 getLine
437− releaseDisplay t
438− releaseTerminal t
419+ release_display t
420+ release_terminal t
439421 return ()
440− , printSummary = unicodeSingleWidthSummary
441− , confirmResults = genericOutputMatchConfirm
422+ , print_summary = unicode_single_width_summary
423+ , confirm_results = generic_output_match_confirm
442424 }
443425
444−unicodeSingleWidthSummary = putStr [s|
426+unicode_single_width_summary = putStr [s|
445427Once return is pressed:
446428 0. The screen will be cleared.
447429 1. The cursor will be hidden.
@@ -475,55 +457,55 @@ After return is pressed for the second time:
475457
476458-- The second example is a unicode string containing double-width glyphs
477459-- 你好吗
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)
460+utf8_txt_1 :: [[Word8]]
461+utf8_txt_1 = [ [0xe4,0xbd,0xa0]
462+ , [0xe5,0xa5,0xbd]
463+ , [0xe5,0x90,0x97]
464+ ]
465+
466+iso_10646_txt_1 :: String
467+iso_10646_txt_1 = map toEnum [20320,22909,21527]
468+
469+unicode_double_width_0 = Test
470+ { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
471+ , test_ID = "unicode_double_width_0"
472+ , test_action = do
473+ t <- terminal_handle
474+ reserve_display t
475+ hide_cursor t
476+ withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout)
495477 hPutStr stdout "\n"
496478 hPutStr stdout "012345\n"
497479 hFlush stdout
498480 getLine
499− releaseDisplay t
500− releaseTerminal t
481+ release_display t
482+ release_terminal t
501483 return ()
502− , printSummary = unicodeDoubleWidthSummary
503− , confirmResults = genericOutputMatchConfirm
484+ , print_summary = unicode_double_width_summary
485+ , confirm_results = generic_output_match_confirm
504486 }
505487
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
488+unicode_double_width_1 = Test
489+ { test_name = "Verify terminal can display unicode double-width characters. (Image ops)"
490+ , test_ID = "unicode_double_width_1"
491+ , test_action = do
492+ t <- terminal_handle
493+ reserve_display t
494+ let pic = pic_for_image image
495+ image = line_0 <-> line_1
496+ line_0 = iso_10646_string def_attr iso_10646_txt_1
497+ line_1 = string def_attr "012345"
498+ d <- display_bounds t >>= display_context t
499+ output_picture d pic
518500 getLine
519− releaseDisplay t
520− releaseTerminal t
501+ release_display t
502+ release_terminal t
521503 return ()
522− , printSummary = unicodeDoubleWidthSummary
523− , confirmResults = genericOutputMatchConfirm
504+ , print_summary = unicode_double_width_summary
505+ , confirm_results = generic_output_match_confirm
524506 }
525507
526−unicodeDoubleWidthSummary = putStr [s|
508+unicode_double_width_summary = putStr [s|
527509Once return is pressed:
528510 0. The screen will be cleared.
529511 1. The cursor will be hidden.
@@ -550,32 +532,32 @@ After return is pressed for the second time:
550532 1. The cursor should be visible.
551533|]
552534
553−allColors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
554− [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
535+all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
536+ [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
555537
556−allBrightColors
557− = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue, brightMagenta, brightCyan, brightWhite ]
538+all_bright_colors
539+ = zip [ bright_black, bright_red, bright_green, bright_yellow, bright_blue, bright_magenta, bright_cyan, bright_white ]
558540 [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]
559541
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
542+attributes_test_0 = Test
543+ { test_name = "Character attributes: foreground colors."
544+ , test_ID = "attributes_test_0"
545+ , test_action = do
546+ t <- terminal_handle
547+ reserve_display t
548+ let pic = pic_for_image image
549+ image = border <|> column_0 <|> border <|> column_1 <|> border
550+ column_0 = vert_cat $ map line_with_color all_colors
551+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
552+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
553+ line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name
554+ d <- display_bounds t >>= display_context t
555+ output_picture d pic
574556 getLine
575− releaseDisplay t
576− releaseTerminal t
557+ release_display t
558+ release_terminal t
577559 return ()
578− , printSummary = do
560+ , print_summary = do
579561 putStr $ [s|
580562Once return is pressed:
581563 0. The screen will be cleared.
@@ -596,32 +578,32 @@ After return is pressed for the second time:
596578 0. The screen containing the test summary should be restored.
597579 1. The cursor should be visible.
598580|]
599− , confirmResults = do
581+ , confirm_results = do
600582 putStr $ [s|
601583Did the test output match the description?
602584|]
603− defaultSuccessConfirmResults
585+ default_success_confirm_results
604586 }
605587
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
588+attributes_test_1 = Test
589+ { test_name = "Character attributes: background colors."
590+ , test_ID = "attributes_test_1"
591+ , test_action = do
592+ t <- terminal_handle
593+ reserve_display t
594+ let pic = pic_for_image image
595+ image = border <|> column_0 <|> border <|> column_1 <|> border
596+ column_0 = vert_cat $ map line_with_color all_colors
597+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
598+ column_1 = vert_cat $ map (string def_attr . snd) all_colors
599+ line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name
600+ d <- display_bounds t >>= display_context t
601+ output_picture d pic
620602 getLine
621− releaseDisplay t
622− releaseTerminal t
603+ release_display t
604+ release_terminal t
623605 return ()
624− , printSummary = do
606+ , print_summary = do
625607 putStr $ [s|
626608Once return is pressed:
627609 0. The screen will be cleared.
@@ -651,57 +633,57 @@ After return is pressed for the second time:
651633 0. The screen containing the test summary should be restored.
652634 1. The cursor should be visible.
653635|]
654− , confirmResults = do
636+ , confirm_results = do
655637 putStr $ [s|
656638Did the test output match the description?
657639|]
658− defaultSuccessConfirmResults
640+ default_success_confirm_results
659641 }
660642
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
643+attributes_test_2 = Test
644+ { test_name = "Character attributes: Vivid foreground colors."
645+ , test_ID = "attributes_test_2"
646+ , test_action = do
647+ t <- terminal_handle
648+ reserve_display t
649+ let pic = pic_for_image image
650+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
651+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
652+ column_0 = vert_cat $ map line_with_color_0 all_colors
653+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
654+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
655+ line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name
656+ line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name
657+ d <- display_bounds t >>= display_context t
658+ output_picture d pic
677659 getLine
678− releaseDisplay t
679− releaseTerminal t
660+ release_display t
661+ release_terminal t
680662 return ()
681− , printSummary = do
663+ , print_summary = do
682664 putStr $ [s|
683665Once return is pressed:
684666 0. The screen will be cleared.
685667 1. The cursor will be hidden.
686668 2. 9 lines of text in three columns will be drawn:
687669 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.
670+ terminal) rendered with that color as the foreground color.
689671 b. The next column will be also be the name of a standard color rendered
690672 with that color as the foreground color but the shade used should be
691− more vivid than the shade used in the first column.
673+ more vivid than the shade used in the first column.
692674 c. The final column will be the name of a color rendered with the
693675 default attributes.
694676
695677For instance, one line will be the word "magenta" and that word should be
696−rendered in the magenta color.
678+rendered in the magenta color.
697679
698680I'm not actually sure exactly what "vivid" means in this context. For xterm the
699−vivid colors are brighter.
681+vivid colors are brighter.
700682
701−Verify:
683+Verify:
702684 * The first column: The foreground color matches the named color.
703685 * The second column: The foreground color matches the named color but is
704− more vivid than the color used in the first column.
686+ more vivid than the color used in the first column.
705687 * The third column: All text is rendered with the default attributes.
706688 * The vertical bars used in each line to mark the border of a column are
707689 lined up.
@@ -710,34 +692,34 @@ After return is pressed for the second time:
710692 0. The screen containing the test summary should be restored.
711693 1. The cursor should be visible.
712694|]
713− , confirmResults = do
695+ , confirm_results = do
714696 putStr $ [s|
715697Did the test output match the description?
716698|]
717− defaultSuccessConfirmResults
699+ default_success_confirm_results
718700 }
719701
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
702+attributes_test_3 = Test
703+ { test_name = "Character attributes: Vivid background colors."
704+ , test_ID = "attributes_test_3"
705+ , test_action = do
706+ t <- terminal_handle
707+ reserve_display t
708+ let pic = pic_for_image image
709+ image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
710+ border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
711+ column_0 = vert_cat $ map line_with_color_0 all_colors
712+ column_1 = vert_cat $ map line_with_color_1 all_bright_colors
713+ column_2 = vert_cat $ map (string def_attr . snd) all_colors
714+ line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name
715+ line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name
716+ d <- display_bounds t >>= display_context t
717+ output_picture d pic
736718 getLine
737− releaseDisplay t
738− releaseTerminal t
719+ release_display t
720+ release_terminal t
739721 return ()
740− , printSummary = do
722+ , print_summary = do
741723 putStr $ [s|
742724Once return is pressed:
743725 0. The screen will be cleared.
@@ -745,23 +727,23 @@ Once return is pressed:
745727 2. 9 lines of text in three columns will be drawn:
746728 a. The first column will contain be a name of a standard color for an 8
747729 color terminal rendered with the default foreground color with a
748− background the named color.
730+ background the named color.
749731 b. The first column will contain be a name of a standard color for an 8
750732 color terminal rendered with the default foreground color with the
751− background a vivid version of the named color.
733+ background a vivid version of the named color.
752734 c. The third column will be the name of a standard color rendered with
753735 the default attributes.
754−
736+
755737For 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.
738+be rendered in the default foreground color over a magenta background.
757739
758740I'm not actually sure exactly what "vivid" means in this context. For xterm the
759741vivid colors are brighter.
760742
761−Verify:
743+Verify:
762744 * The first column: The background color matches the named color.
763745 * The second column: The background color matches the named color and is
764− more vivid than the color used in the first column.
746+ more vivid than the color used in the first column.
765747 * The third column column: All text is rendered with the default attributes.
766748 * The vertical bars used in each line to mark the border of a column are
767749 lined up.
@@ -777,51 +759,51 @@ After return is pressed for the second time:
777759 0. The screen containing the test summary should be restored.
778760 1. The cursor should be visible.
779761|]
780− , confirmResults = do
762+ , confirm_results = do
781763 putStr $ [s|
782764Did the test output match the description?
783765|]
784− defaultSuccessConfirmResults
766+ default_success_confirm_results
785767 }
786768
787−attrCombos =
769+attr_combos =
788770 [ ( "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) )
771+ , ( "bold", flip with_style bold )
772+ , ( "blink", flip with_style blink )
773+ , ( "underline", flip with_style underline )
774+ , ( "bold + blink", flip with_style (bold + blink) )
775+ , ( "bold + underline", flip with_style (bold + underline) )
776+ , ( "underline + blink", flip with_style (underline + blink) )
777+ , ( "bold + blink + underline", flip with_style (bold + blink + underline) )
796778 ]
797779
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
780+attributes_test_4 = Test
781+ { test_name = "Character attributes: Bold; Blink; Underline."
782+ , test_ID = "attributes_test_4"
783+ , test_action = do
784+ t <- terminal_handle
785+ reserve_display t
786+ let pic = pic_for_image image
787+ image = horiz_cat [border, column_0, border, column_1, border]
788+ border = vert_cat $ replicate (length attr_combos) $ string def_attr " | "
789+ column_0 = vert_cat $ map line_with_attrs attr_combos
790+ column_1 = vert_cat $ map (string def_attr . fst) attr_combos
791+ line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc
792+ d <- display_bounds t >>= display_context t
793+ output_picture d pic
812794 getLine
813− releaseDisplay t
814− releaseTerminal t
795+ release_display t
796+ release_terminal t
815797 return ()
816− , printSummary = do
798+ , print_summary = do
817799 putStr $ [s|
818800Once return is pressed:
819801 0. The screen will be cleared.
820802 1. The cursor will be hidden.
821− 2. 8 rows of text in two columns.
803+ 2. 8 rows of text in two columns.
822804 The rows will contain the following text:
823805 default
824− bold
806+ bold
825807 blink
826808 underline
827809 bold + blink
@@ -830,8 +812,8 @@ Once return is pressed:
830812 bold + blink + underline
831813 The first column will be rendered with the described attributes. The second
832814 column will be rendered with the default attributes.
833−
834−Verify:
815+
816+Verify:
835817 * The vertical bars used in each line to mark the border of a column are
836818 lined up.
837819 * The text in the first column is rendered as described.
@@ -840,31 +822,31 @@ After return is pressed for the second time:
840822 0. The screen containing the test summary should be restored.
841823 1. The cursor should be visible.
842824|]
843− , confirmResults = do
825+ , confirm_results = do
844826 putStr $ [s|
845827Did the test output match the description?
846828|]
847− defaultSuccessConfirmResults
829+ default_success_confirm_results
848830 }
849831
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
832+attributes_test_5 = Test
833+ { test_name = "Character attributes: 240 color palette"
834+ , test_ID = "attributes_test_5"
835+ , test_action = do
836+ t <- terminal_handle
837+ reserve_display t
838+ let pic = pic_for_image image
839+ image = vert_cat $ map horiz_cat $ split_color_images color_images
840+ color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239]
841+ split_color_images [] = []
842+ split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is))
843+ d <- display_bounds t >>= display_context t
844+ output_picture d pic
863845 getLine
864− releaseDisplay t
865− releaseTerminal t
846+ release_display t
847+ release_terminal t
866848 return ()
867− , printSummary = do
849+ , print_summary = do
868850 putStr $ [s|
869851Once return is pressed:
870852 0. The screen will be cleared.
@@ -872,321 +854,73 @@ Once return is pressed:
872854 2. A 20 character wide and 12 row high block of color squares. This should look like a palette
873855 of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...
874856
875−Verify:
857+Verify:
876858
877859After return is pressed for the second time:
878860 0. The screen containing the test summary should be restored.
879861 1. The cursor should be visible.
880862|]
881− , confirmResults = do
863+ , confirm_results = do
882864 putStr $ [s|
883865Did the test output match the description?
884866|]
885− defaultSuccessConfirmResults
867+ default_success_confirm_results
886868 }
887869
888−inlineTest0 = Test
889− { testName = "Verify styled output can be performed without clearing the screen."
890− , testID = "inlineTest0"
891− , testAction = do
870+inline_test_0 = Test
871+ { test_name = "Verify styled output can be performed without clearing the screen."
872+ , test_ID = "inline_test_0"
873+ , test_action = do
874+ t <- terminal_handle
892875 putStrLn "line 1."
893− putAttrChange_ $ backColor red >> applyStyle underline
876+ put_attr_change t $ back_color red >> apply_style underline
894877 putStrLn "line 2."
895− putAttrChange_ $ defaultAll
878+ put_attr_change t $ default_all
896879 putStrLn "line 3."
897− , printSummary = putStr $ [s|
880+ release_terminal t
881+ return ()
882+ , print_summary = putStr $ [s|
898883lines are in order.
899884The second line "line 2" should have a red background and the text underline.
900885The third line "line 3" should be drawn in the same style as the first line.
901886|]
902887
903− , confirmResults = genericOutputMatchConfirm
888+ , confirm_results = generic_output_match_confirm
904889 }
905890
906−inlineTest1 = Test
907− { testName = "Verify styled output can be performed without clearing the screen."
908− , testID = "inlineTest1"
909− , testAction = do
891+inline_test_1 = Test
892+ { test_name = "Verify styled output can be performed without clearing the screen."
893+ , test_ID = "inline_test_1"
894+ , test_action = do
895+ t <- terminal_handle
910896 putStr "Not styled. "
911− putAttrChange_ $ backColor red >> applyStyle underline
897+ put_attr_change t $ back_color red >> apply_style underline
912898 putStr " Styled! "
913− putAttrChange_ $ defaultAll
899+ put_attr_change t $ default_all
914900 putStrLn "Not styled."
915− , printSummary = putStr $ [s|
901+ release_terminal t
902+ return ()
903+ , print_summary = putStr $ [s|
916904|]
917905
918− , confirmResults = genericOutputMatchConfirm
906+ , confirm_results = generic_output_match_confirm
919907 }
920908
921−inlineTest2 = Test
922− { testName = "Verify styled output can be performed without clearing the screen."
923− , testID = "inlineTest1"
924− , testAction = do
909+inline_test_2 = Test
910+ { test_name = "Verify styled output can be performed without clearing the screen."
911+ , test_ID = "inline_test_1"
912+ , test_action = do
913+ t <- terminal_handle
925914 putStr "Not styled. "
926− putAttrChange_ $ backColor red >> applyStyle underline
915+ put_attr_change t $ back_color red >> apply_style underline
927916 putStr " Styled! "
928− putAttrChange_ $ defaultAll
917+ put_attr_change t $ default_all
929918 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
919+ release_terminal t
947920 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.
921+ , print_summary = putStr $ [s|
954922|]
955− , confirmResults = genericOutputMatchConfirm
956− }
957923
958−outputImageAndWait :: Image -> IO ()
959−outputImageAndWait image = do
960− let pic = picForImage image
961− outputPicAndWait pic
962−
963−outputPicAndWait :: Picture -> IO ()
964−outputPicAndWait pic = do
965− t <- standardIOConfig >>= outputForConfig
966− reserveDisplay t
967− d <- displayBounds t >>= displayContext t
968− outputPicture d pic
969− getLine
970− releaseDisplay t
971− releaseTerminal t
972− return ()
973−
974−vertCropTest0 :: Test
975−vertCropTest0 = Test
976− { testName = "Verify bottom cropping works as expected with single column chars"
977− , testID = "cropTest0"
978− , testAction = do
979− let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsum
980− block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsum
981− image = block0 <-> backgroundFill 10 2 <-> block1
982− outputImageAndWait image
983− , printSummary = putStr $ [s|
984− 1. Verify the two text blocks are identical.
985− 2. press enter.
986− 3. the display should return to the state before the test.
987−|]
988− , confirmResults = genericOutputMatchConfirm
989− }
990−
991−vertCropTest1 :: Test
992−vertCropTest1 = Test
993− { testName = "Verify bottom cropping works as expected with double column chars"
994− , testID = "cropTest0"
995− , testAction = do
996− let block0 = cropBottom 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
997− block1 = vertCat $ map (string defAttr) $ take 2 lorumIpsumChinese
998− image = block0 <-> backgroundFill 10 2 <-> block1
999− outputImageAndWait image
1000− , printSummary = putStr $ [s|
1001− 1. Verify the two text blocks are identical.
1002− 2. press enter.
1003− 3. the display should return to the state before the test.
1004−|]
1005− , confirmResults = genericOutputMatchConfirm
924+ , confirm_results = generic_output_match_confirm
1006925 }
1007926
1008−vertCropTest2 :: Test
1009−vertCropTest2 = Test
1010− { testName = "Verify top cropping works as expected with single column chars"
1011− , testID = "cropTest2"
1012− , testAction = do
1013− let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsum
1014− block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsum - 2) lorumIpsum
1015− image = block0 <-> backgroundFill 10 2 <-> block1
1016− outputImageAndWait image
1017− , printSummary = putStr $ [s|
1018− 1. Verify the two text blocks are identical.
1019− 2. press enter.
1020− 3. the display should return to the state before the test.
1021−|]
1022− , confirmResults = genericOutputMatchConfirm
1023− }
1024−
1025−vertCropTest3 :: Test
1026−vertCropTest3 = Test
1027− { testName = "Verify top cropping works as expected with double column chars"
1028− , testID = "cropTest0"
1029− , testAction = do
1030− let block0 = cropTop 2 $ vertCat $ map (string defAttr) lorumIpsumChinese
1031− block1 = vertCat $ map (string defAttr) $ drop (length lorumIpsumChinese - 2 ) lorumIpsumChinese
1032− image = block0 <-> backgroundFill 10 2 <-> block1
1033− outputImageAndWait image
1034− , printSummary = putStr $ [s|
1035− 1. Verify the two text blocks are identical.
1036− 2. press enter.
1037− 3. the display should return to the state before the test.
1038−|]
1039− , confirmResults = genericOutputMatchConfirm
1040− }
1041−
1042−horizCropTest0 :: Test
1043−horizCropTest0 = Test
1044− { testName = "Verify right cropping works as expected with single column chars"
1045− , testID = "cropTest0"
1046− , testAction = do
1047− let baseImage = vertCat $ map (string defAttr) lorumIpsum
1048− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1049− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1050− outputImageAndWait image
1051− , printSummary = putStr $ [s|
1052− 1. Verify the bottom text block is about half the width of the top text block.
1053− 2. press enter.
1054− 3. the display should return to the state before the test.
1055−|]
1056− , confirmResults = genericOutputMatchConfirm
1057− }
1058−
1059−horizCropTest1 :: Test
1060−horizCropTest1 = Test
1061− { testName = "Verify right cropping works as expected with double column chars"
1062− , testID = "cropTest0"
1063− , testAction = do
1064− let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1065− croppedImage = cropRight (imageWidth baseImage `div` 2) baseImage
1066− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1067− outputImageAndWait image
1068− , printSummary = putStr $ [s|
1069− 1. Verify the bottom text block is the left half of the top block. Ellipses on the right edge are OK.
1070− 2. press enter.
1071− 3. the display should return to the state before the test.
1072−|]
1073− , confirmResults = genericOutputMatchConfirm
1074− }
1075−
1076−horizCropTest2 :: Test
1077−horizCropTest2 = Test
1078− { testName = "Verify left cropping works as expected with single column chars"
1079− , testID = "cropTest0"
1080− , testAction = do
1081− let baseImage = vertCat $ map (string defAttr) lorumIpsum
1082− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1083− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1084− outputImageAndWait image
1085− , printSummary = putStr $ [s|
1086− 1. Verify the bottom text block is the right half of the top text block.
1087− 2. press enter.
1088− 3. the display should return to the state before the test.
1089−|]
1090− , confirmResults = genericOutputMatchConfirm
1091− }
1092−
1093−horizCropTest3 :: Test
1094−horizCropTest3 = Test
1095− { testName = "Verify right cropping works as expected with double column chars"
1096− , testID = "cropTest0"
1097− , testAction = do
1098− let baseImage = vertCat $ map (string defAttr) lorumIpsumChinese
1099− croppedImage = cropLeft (imageWidth baseImage `div` 2) baseImage
1100− image = baseImage <-> backgroundFill 10 2 <-> croppedImage
1101− outputImageAndWait image
1102− , printSummary = putStr $ [s|
1103− 1. Verify the bottom text block is the right half of the top block. Ellipses on the left edge are OK.
1104− 2. press enter.
1105− 3. the display should return to the state before the test.
1106−|]
1107− , confirmResults = genericOutputMatchConfirm
1108− }
1109−
1110−layer0 :: Test
1111−layer0 = Test
1112− { testName = "verify layer 0"
1113− , testID = "layer0"
1114− , testAction = do
1115− let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1116− lowerImage = vertCat $ map (string defAttr) lorumIpsum
1117− p = picForLayers [upperImage, lowerImage]
1118− outputPicAndWait p
1119− , printSummary = putStr $ [s|
1120− 1. Verify the text block appears to be Chinese text placed on top Latin text.
1121− 2. press enter.
1122− 3. the display should return to the state before the test.
1123−|]
1124− , confirmResults = genericOutputMatchConfirm
1125− }
1126−
1127−layer1 :: Test
1128−layer1 = Test
1129− { testName = "verify layer 1"
1130− , testID = "layer1"
1131− , testAction = do
1132− let upperImage = vertCat $ map (string defAttr) lorumIpsumChinese
1133− block = resize 10 10 upperImage
1134− layer0 = vertCat $ map (string defAttr) lorumIpsum
1135− layer1 = charFill (defAttr `withBackColor` blue) '#' 1000 1000
1136− cheesyAnim0 block [layer0, layer1]
1137− , printSummary = putStr $ [s|
1138− 1. Verify the text block appears to be Chinese text moving on top a Latin text.
1139− Which is all on a background of '#' characters over blue.
1140− 2. press enter.
1141− 3. the display should return to the state before the test.
1142−|]
1143− , confirmResults = genericOutputMatchConfirm
1144− }
1145−
1146−cheesyAnim0 :: Image -> [Image] -> IO ()
1147−cheesyAnim0 i background = do
1148− t <- standardIOConfig >>= outputForConfig
1149− reserveDisplay t
1150− bounds <- displayBounds t
1151− d <- displayContext t bounds
1152− forM_ [0..2] $ \t -> do
1153− forM_ [0..100] $ \t -> do
1154− let i_offset = translate (t `mod` fst bounds)
1155− (t `div` 2 `mod` snd bounds)
1156− i
1157− let pic = picForLayers $ i_offset : background
1158− outputPicture d pic
1159− threadDelay 50000
1160− forM_ [0..100] $ \t -> do
1161− let i_offset = translate (t * (-1) `mod` fst bounds)
1162− (t * (-1) `div` 2 `mod` snd bounds)
1163− i
1164− let pic = picForLayers $ i_offset : background
1165− outputPicture d pic
1166− threadDelay 50000
1167− releaseDisplay t
1168− releaseTerminal t
1169− return ()
1170−
1171−lorumIpsum :: [String]
1172−lorumIpsum = lines [s|
1173−Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium,
1174−totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae
1175−dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit,
1176−sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam
1177−est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius
1178−modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima
1179−veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea
1180−commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil
1181−molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
1182−|]
1183−
1184−lorumIpsumChinese :: [String]
1185−lorumIpsumChinese = lines [s|
1186−輐銛 螷蟞覮 裌覅詵 暕 鴅噮 槶 惝掭掝 婸媥媕 耏胠臿, 汫汭沎 忕汌卣 蚡袀 僣 蒮 瀁瀎瀊 渮湸湤 緌翢,
1187−腠腶舝 糲蘥蠩 樏殣氀 蒮 蹢鎒 滍 鸄齴 櫧櫋瀩 鬄鵊鵙 莃荶衒, 毸溠 橀 簎艜薤 莃荶衒 翣聜蒢
1188−斔櫅檷 晛桼桾 拻敁柧 犿玒 膣, 墐 笓粊紒 bacon 鼀齕, 蔝蓶蓨 顊顃餭 姴怤 骱 暕 蹢鎒鎛 藒襓謥 鄻鎟霣
1189−鬎鯪, 鐩闤 硻禂稢 谾踘遳 撱 赲 迡 箷 蛃袚觙 萇雊蜩 壿嫷 鋡 縢羱聬 跐鉠鉣 蔝蓶蓨 匢奾灱 溮煡煟 雥齆犪
1190−蔰 虈觿, 腷腯葹 鍹餳駷 蛚袲褁蜸 皯竻 瀁瀎 蜭蜸覟 梪涫湴 揗斝湁 毼
1191−|]
1192−