vty/test/interactive_terminal_test.hs

{-# LANGUAGE QuasiQuotes #-}
module Main where

import Graphics.Vty
import Graphics.Vty.Attributes
import Graphics.Vty.Inline
import Graphics.Vty.Picture
import Graphics.Vty.Output

import Control.Concurrent (threadDelay)
import Control.Exception
import Control.Monad

import Data.Default (def)
import Data.List ( lookup )
import Data.Maybe ( isJust, fromJust )
import Data.Monoid
import Data.String.QQ
import Data.Word

import Foreign.Marshal.Array 

import qualified System.Environment as Env

import System.IO ( hFlush, hPutStr, hPutBuf, stdout )

main = do
    print_intro

output_file_path = "test_results.list"

print_intro = do
    putStr $ [s| 
This is an interactive verification program for the terminal input and output
support of the VTY library. This will ask a series of questions about what you
see on screen. The goal is to verify that VTY's output and input support
performs as expected with your terminal.

This program produces a file named 
    |] ++ output_file_path ++ [s| 
in the current directory that contains the results for each test assertion. This
can  be emailed to coreyoconnor@gmail.com and used by the VTY authors to improve
support for your terminal. No personal information is contained in the report.

Each test follows, more or less, the following format:
    0. A description of the test is printed which will include a detailed
    description of what VTY is going to try and what the expected results are.
    Press return to move on.
    1. The program will produce some output or ask for you to press a key.
    2. You will then be asked to confirm if the behavior matched the provided
    description.  Just pressing enter implies the default response that
    everything was as expected. 

All the tests assume the following about the terminal display:
    0. The terminal display will not be resized during a test and is at least 80 
    characters in width. 
    1. The terminal display is using a monospaced font for both single width and
    double width characters.
    2. A double width character is displayed with exactly twice the width of a 
    single column character. This may require adjusting the font used by the
    terminal. At least, that is the case using xterm. 
    3. Fonts are installed, and usable by the terminal, that define glyphs for
    a good range of the unicode characters. Each test involving unicode display
    describes the expected appearance of each glyph. 

Thanks for the help! :-D
To exit the test early enter "q" anytime at the following menu screen.

If any test failed then please post an issue to
    https://github.com/coreyoconnor/vty/issues
with the test_results.list file pasted into the issue. The issue summary can
mention the specific tests that failed or just say "interactive terminal test
failure".
|]
    wait_for_return
    results <- do_test_menu 1
    env_attributes <- mapM ( \env_name -> Control.Exception.catch ( Env.getEnv env_name >>= return . (,) env_name ) 
                                                ( \ (_ :: SomeException) -> return (env_name, "") ) 
                           ) 
                           [ "TERM", "COLORTERM", "LANG", "TERM_PROGRAM", "XTERM_VERSION" ]
    t <- output_for_current_terminal
    let results_txt = show env_attributes ++ "\n" 
                      ++ terminal_ID t ++ "\n"
                      ++ show results ++ "\n"
    release_terminal t
    writeFile output_file_path results_txt

wait_for_return = do
    putStr "\n(press return to continue)"
    hFlush stdout
    getLine

test_menu :: [(String, Test)]
test_menu = zip (map show [1..]) all_tests

do_test_menu :: Int -> IO [(String, Bool)]
do_test_menu next_ID 
    | next_ID > length all_tests = do
        putStrLn $ "Done! Please email the " ++ output_file_path ++ " file to coreyoconnor@gmail.com"
        return []
    | otherwise = do
        display_test_menu
        putStrLn $ "Press return to start with #" ++ show next_ID ++ "."
        putStrLn "Enter a test number to perform only that test."
        putStrLn "q (or control-C) to quit."
        putStr "> "
        hFlush stdout
        s <- getLine >>= return . filter (/= '\n')
        case s of
            "q" -> return mempty
            "" -> do 
                r <- run_test $ show next_ID 
                rs <- do_test_menu ( next_ID + 1 )
                return $ r : rs
            i | isJust ( lookup i test_menu ) -> do
                r <- run_test i 
                rs <- do_test_menu ( read i + 1 )
                return $ r : rs
        where
            display_test_menu 
                = mapM_ display_test_menu' test_menu
            display_test_menu' ( i, t ) 
                = putStrLn $ ( if i == show next_ID 
                                then "> " 
                                else "  "
                             ) ++ i ++ ". " ++ test_name t

run_test :: String -> IO (String, Bool)
run_test i = do
    let t = fromJust $ lookup i test_menu 
    print_summary t
    wait_for_return
    test_action t
    r <- confirm_results t
    return (test_ID t, r)

default_success_confirm_results = do
    putStr "\n"
    putStr "[Y/n] "
    hFlush stdout
    r <- getLine
    case r of
        "" -> return True
        "y" -> return True
        "Y" -> return True
        "n" -> return False

data Test = Test
    { test_name :: String
    , test_ID :: String
    , test_action :: IO ()
    , print_summary :: IO ()
    , confirm_results :: IO Bool
    }

all_tests 
    = [ reserve_output_test 
      , display_bounds_test_0
      , display_bounds_test_1
      , display_bounds_test_2
      , display_bounds_test_3
      , unicode_single_width_0
      , unicode_single_width_1
      , unicode_double_width_0
      , unicode_double_width_1
      , attributes_test_0
      , attributes_test_1
      , attributes_test_2
      , attributes_test_3
      , attributes_test_4
      , attributes_test_5
      , inline_test_0
      , inline_test_1
      , inline_test_2
      , cursor_hide_test_0
      , vert_crop_test_0
      , vert_crop_test_1
      , vert_crop_test_2
      , vert_crop_test_3
      , horiz_crop_test_0
      , horiz_crop_test_1
      , horiz_crop_test_2
      , horiz_crop_test_3
      , layer_0
      , layer_1
      ]

reserve_output_test = Test 
    { test_name = "Initialize and reserve terminal output then restore previous state."
    , test_ID = "reserve_output_test"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        putStrLn "Line 1"
        putStrLn "Line 2"
        putStrLn "Line 3"
        putStrLn "Line 4 (press return)"
        hFlush stdout
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = do
        putStr $ [s|
Once return is pressed:
    0. The screen will be cleared. 
    1. Four lines of text should be visible.
    1. The cursor should be visible and at the start of the fifth line.

After return is pressed for the second time this test then:
    * The screen containing the test summary should be restored;
    * The cursor is visible.
|]
    , confirm_results = do
        putStr $ [s|
Did the test output match the description?
|]
        default_success_confirm_results
    }

display_bounds_test_0 = Test
    { test_name = "Verify display bounds are correct test 0: Using spaces."
    , test_ID = "display_bounds_test_0"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        (w,h) <- display_bounds t
        let row_0 = replicate (fromEnum w) 'X' ++ "\n"
            row_h = replicate (fromEnum w - 1) 'X'
            row_n = "X" ++ replicate (fromEnum w - 2) ' ' ++ "X\n"
            image = row_0 ++ (concat $ replicate (fromEnum h - 2) row_n) ++ row_h
        putStr image
        hFlush stdout
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = display_bounds_test_summary True
    , confirm_results = generic_output_match_confirm
    }

display_bounds_test_1 = Test
    { test_name = "Verify display bounds are correct test 0: Using cursor movement."
    , test_ID = "display_bounds_test_1"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        (w,h) <- display_bounds t
        set_cursor_pos t 0 0
        let row_0 = replicate (fromEnum w) 'X' ++ "\n"
        putStr row_0
        forM_ [1 .. h - 2] $ \y -> do
            set_cursor_pos t 0 y
            putStr "X"
            hFlush stdout
            set_cursor_pos t (w - 1) y
            putStr "X"
            hFlush stdout
        set_cursor_pos t 0 (h - 1)
        let row_h = replicate (fromEnum w - 1) 'X'
        putStr row_h
        hFlush stdout
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = display_bounds_test_summary True
    , confirm_results = generic_output_match_confirm
    }

display_bounds_test_2 = Test
    { test_name = "Verify display bounds are correct test 0: Using Image ops."
    , test_ID = "display_bounds_test_2"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        bounds@(w,h) <- display_bounds t
        let first_row = horiz_cat $ replicate (fromEnum w) (char def_attr 'X')
            middle_rows = vert_cat $ replicate (fromEnum h - 2) middle_row
            middle_row = (char def_attr 'X') <|> background_fill (w - 2) 1 <|> (char def_attr 'X')
            end_row = first_row
            image = first_row <-> middle_rows <-> end_row
            pic = (pic_for_image image) { pic_cursor = Cursor (w - 1) (h - 1) }
        d <- display_context t bounds
        output_picture d pic
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = display_bounds_test_summary True
    , confirm_results = generic_output_match_confirm
    }

display_bounds_test_3 = Test
    { test_name = "Verify display bounds are correct test 0: Hide cursor; Set cursor pos."
    , test_ID = "display_bounds_test_3"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        (w,h) <- display_bounds t
        hide_cursor t
        set_cursor_pos t 0 0
        let row_0 = replicate (fromEnum w) 'X'
        putStrLn row_0
        forM_ [1 .. h - 2] $ \y -> do
            set_cursor_pos t 0 y
            putStr "X"
            hFlush stdout
            set_cursor_pos t (w - 1) y
            putStr "X"
            hFlush stdout
        set_cursor_pos t 0 (h - 1)
        let row_h = row_0
        putStr row_h
        hFlush stdout
        getLine
        show_cursor t
        release_display t
        release_terminal t
        return ()
    , print_summary = display_bounds_test_summary False
    , confirm_results = generic_output_match_confirm
    }

display_bounds_test_summary has_cursor = do
    putStr $ [s|
Once return is pressed:
    0. The screen will be cleared.
|]
    if has_cursor
        then putStr "    1. The cursor will be visible."
        else putStr "    1. The cursor will NOT be visible."
    putStr [s|

    2. The border of the display will be outlined in Xs. 
       So if - and | represented the edge of the terminal window:
         |-------------|
         |XXXXXXXXXXXXX|
         |X           X||]

    if has_cursor
        then putStr $ [s|

         |XXXXXXXXXXXXC| |]
        else putStr $ [s|

         |XXXXXXXXXXXXX| |]

    putStr $ [s|

         |-------------|

        ( Where C is the final position of the cursor. There may be an X drawn
        under the cursor. )
    3. The display will remain in this state until return is pressed again.

After return is pressed for the second time:
    0. The screen containing the test summary should be restored.
    1. The cursor should be visible.
|]

generic_output_match_confirm = do
    putStr $ [s|
Did the test output match the description?
|]
    default_success_confirm_results

-- Explicitely definethe bytes that encode each example text.
-- This avoids any issues with how the compiler represents string literals.
--
-- This document is UTF-8 encoded so the UTF-8 string is still included for
-- reference
--
-- It's assumed the compiler will at least not barf on UTF-8 encoded text in
-- comments ;-)
--
-- txt_0 = ↑↑↓↓←→←→BA

utf8_txt_0 :: [[Word8]]
utf8_txt_0 = [ [ 0xe2 , 0x86 , 0x91 ]
             , [ 0xe2 , 0x86 , 0x91 ]
             , [ 0xe2 , 0x86 , 0x93 ]
             , [ 0xe2 , 0x86 , 0x93 ]
             , [ 0xe2 , 0x86 , 0x90 ]
             , [ 0xe2 , 0x86 , 0x92 ]
             , [ 0xe2 , 0x86 , 0x90 ]
             , [ 0xe2 , 0x86 , 0x92 ]
             , [ 0x42 ]
             , [ 0x41 ]
             ]

iso_10646_txt_0 :: String
iso_10646_txt_0 = map toEnum
    [ 8593 
    , 8593
    , 8595
    , 8595
    , 8592
    , 8594
    , 8592
    , 8594
    , 66
    , 65
    ]

unicode_single_width_0 = Test
    { test_name = "Verify terminal can display unicode single-width characters. (Direct UTF-8)"
    , test_ID = "unicode_single_width_0"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        hide_cursor t
        withArrayLen (concat utf8_txt_0) (flip $ hPutBuf stdout)
        hPutStr stdout "\n"
        hPutStr stdout "0123456789\n"
        hFlush stdout
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = unicode_single_width_summary
    , confirm_results = generic_output_match_confirm
    }

unicode_single_width_1 = Test
    { test_name = "Verify terminal can display unicode single-width characters. (Image ops)"
    , test_ID = "unicode_single_width_1"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        let pic = pic_for_image image
            image = line_0 <-> line_1
            line_0 = iso_10646_string def_attr iso_10646_txt_0
            line_1 = string def_attr "0123456789"
        d <- display_bounds t >>= display_context t
        output_picture d pic
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = unicode_single_width_summary
    , confirm_results = generic_output_match_confirm
    }

unicode_single_width_summary = putStr [s|
Once return is pressed:
    0. The screen will be cleared.
    1. The cursor will be hidden.
    2. Two horizontal lines of text will be displayed:
        a. The first will be a sequence of glyphs in UTF-8 encoding. Each glyph
        will occupy one column of space. The order and appearance of the glyphs
        will be:
            | column | appearance    |
            ==========================
            | 0      | up arrow      |
            | 1      | up arrow      |
            | 2      | down arrow    |
            | 3      | down arrow    |
            | 4      | left arrow    |
            | 5      | right arrow   |
            | 6      | left arrow    |
            | 7      | right arrow   |
            | 8      | B             |
            | 9      | A             |
            ( see: http://en.wikipedia.org/wiki/Arrow_(symbol) )
        b. The second will be: 0123456789. 

Verify: 
    * The far right extent of the glyphs on both lines are equal; 
    * The glyphs are as described.

After return is pressed for the second time:
    0. The screen containing the test summary should be restored.
    1. The cursor should be visible.
|]

-- The second example is a unicode string containing double-width glyphs
-- 你好吗
utf8_txt_1 :: [[Word8]]
utf8_txt_1 = [ [0xe4,0xbd,0xa0]
             , [0xe5,0xa5,0xbd]
             , [0xe5,0x90,0x97]
             ]

iso_10646_txt_1 :: String
iso_10646_txt_1 = map toEnum [20320,22909,21527]

unicode_double_width_0 = Test
    { test_name = "Verify terminal can display unicode double-width characters. (Direct UTF-8)"
    , test_ID = "unicode_double_width_0"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        hide_cursor t
        withArrayLen (concat utf8_txt_1) (flip $ hPutBuf stdout)
        hPutStr stdout "\n"
        hPutStr stdout "012345\n"
        hFlush stdout
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = unicode_double_width_summary
    , confirm_results = generic_output_match_confirm
    }

unicode_double_width_1 = Test
    { test_name = "Verify terminal can display unicode double-width characters. (Image ops)"
    , test_ID = "unicode_double_width_1"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        let pic = pic_for_image image
            image = line_0 <-> line_1
            line_0 = iso_10646_string def_attr iso_10646_txt_1
            line_1 = string def_attr "012345"
        d <- display_bounds t >>= display_context t
        output_picture d pic
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = unicode_double_width_summary
    , confirm_results = generic_output_match_confirm
    }

unicode_double_width_summary = putStr [s|
Once return is pressed:
    0. The screen will be cleared.
    1. The cursor will be hidden.
    2. Two horizontal lines of text will be displayed:
        a. The first will be a sequence of glyphs in UTF-8 encoding. Each glyph
        will occupy two columns of space. The order and appearance of the glyphs
        will be:
            | column | appearance                |
            ======================================
            | 0      | first half of ni3         |
            | 1      | second half of ni3        |
            | 2      | first half of hao3        |
            | 3      | second half of hao3       |
            | 4      | first half of ma          |
            | 5      | second half of ma         |
        b. The second will be: 012345. 

Verify: 
    * The far right extent of the glyphs on both lines are equal; 
    * The glyphs are as described.

After return is pressed for the second time:
    0. The screen containing the test summary should be restored.
    1. The cursor should be visible.
|]

all_colors = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
                 [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]

all_bright_colors 
    = zip [ bright_black, bright_red, bright_green, bright_yellow, bright_blue, bright_magenta, bright_cyan, bright_white ]
          [ "bright black", "bright red", "bright green", "bright yellow", "bright blue", "bright magenta", "bright cyan", "bright white" ]

attributes_test_0 = Test 
    { test_name = "Character attributes: foreground colors."
    , test_ID = "attributes_test_0"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        let pic = pic_for_image image
            image = border <|> column_0 <|> border <|> column_1 <|> border
            column_0 = vert_cat $ map line_with_color all_colors
            border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
            column_1 = vert_cat $ map (string def_attr . snd) all_colors
            line_with_color (c, c_name) = string (def_attr `with_fore_color` c) c_name
        d <- display_bounds t >>= display_context t
        output_picture d pic
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = do
        putStr $ [s|
Once return is pressed:
    0. The screen will be cleared.
    1. The cursor will be hidden.
    2. 9 lines of text in two columns will be drawn. The first column will be a
    name of a standard color (for an 8 color terminal) rendered in that color.
    For instance, one line will be the word "magenta" and that word should be
    rendered in the magenta color. The second column will be the name of a
    standard color rendered with the default attributes.

Verify: 
    * In the first column: The foreground color matches the named color.
    * The second column: All text is rendered with the default attributes.
    * The vertical bars used in each line to mark the border of a column are
    lined up.

After return is pressed for the second time:
    0. The screen containing the test summary should be restored.
    1. The cursor should be visible.
|]
    , confirm_results = do
        putStr $ [s|
Did the test output match the description?
|]
        default_success_confirm_results
    }

attributes_test_1 = Test 
    { test_name = "Character attributes: background colors."
    , test_ID = "attributes_test_1"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        let pic = pic_for_image image
            image = border <|> column_0 <|> border <|> column_1 <|> border
            column_0 = vert_cat $ map line_with_color all_colors
            border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
            column_1 = vert_cat $ map (string def_attr . snd) all_colors
            line_with_color (c, c_name) = string (def_attr `with_back_color` c) c_name
        d <- display_bounds t >>= display_context t
        output_picture d pic
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = do
        putStr $ [s|
Once return is pressed:
    0. The screen will be cleared.
    1. The cursor will be hidden.
    2. 9 lines of text in two columns will be drawn. The first column will
    contain be a name of a standard color for an 8 color terminal rendered with
    the default foreground color with a background the named color.  For
    instance, one line will contain be the word "magenta" and the word should
    be rendered in the default foreground color over a magenta background. The
    second column will be the name of a standard color rendered with the default
    attributes.

Verify: 
    * The first column: The background color matches the named color.
    * The second column: All text is rendered with the default attributes.
    * The vertical bars used in each line to mark the border of a column are
    lined up.

Note: I haven't decided if, in this case, the background color should extend to
fills added for alignment. Right now the selected background color is only
applied to the background where the word is actually rendered. Since each word
is not of the same length VTY adds background fills to make the width of each
row effectively the same. These added fills are all currently rendered with the
default background pattern.

After return is pressed for the second time:
    0. The screen containing the test summary should be restored.
    1. The cursor should be visible.
|]
    , confirm_results = do
        putStr $ [s|
Did the test output match the description?
|]
        default_success_confirm_results
    }

attributes_test_2 = Test 
    { test_name = "Character attributes: Vivid foreground colors."
    , test_ID = "attributes_test_2"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        let pic = pic_for_image image
            image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
            border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
            column_0 = vert_cat $ map line_with_color_0 all_colors
            column_1 = vert_cat $ map line_with_color_1 all_bright_colors
            column_2 = vert_cat $ map (string def_attr . snd) all_colors
            line_with_color_0 (c, c_name) = string (def_attr `with_fore_color` c) c_name
            line_with_color_1 (c, c_name) = string (def_attr `with_fore_color` c) c_name
        d <- display_bounds t >>= display_context t
        output_picture d pic
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = do
        putStr $ [s|
Once return is pressed:
    0. The screen will be cleared.
    1. The cursor will be hidden.
    2. 9 lines of text in three columns will be drawn:
        a. The first column will be a name of a standard color (for an 8 color
        terminal) rendered with that color as the foreground color.  
        b. The next column will be also be the name of a standard color rendered
        with that color as the foreground color but the shade used should be
        more vivid than the shade used in the first column.    
        c. The final column will be the name of a color rendered with the
        default attributes.

For instance, one line will be the word "magenta" and that word should be
rendered in the magenta color. 

I'm not actually sure exactly what "vivid" means in this context. For xterm the
vivid colors are brighter.  

Verify: 
    * The first column: The foreground color matches the named color.
    * The second column: The foreground color matches the named color but is
    more vivid than the color used in the first column.  
    * The third column: All text is rendered with the default attributes.
    * The vertical bars used in each line to mark the border of a column are
    lined up.

After return is pressed for the second time:
    0. The screen containing the test summary should be restored.
    1. The cursor should be visible.
|]
    , confirm_results = do
        putStr $ [s|
Did the test output match the description?
|]
        default_success_confirm_results
    }

attributes_test_3 = Test 
    { test_name = "Character attributes: Vivid background colors."
    , test_ID = "attributes_test_3"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        let pic = pic_for_image image
            image = horiz_cat [border, column_0, border, column_1, border, column_2, border]
            border = vert_cat $ replicate (length all_colors) $ string def_attr " | "
            column_0 = vert_cat $ map line_with_color_0 all_colors
            column_1 = vert_cat $ map line_with_color_1 all_bright_colors
            column_2 = vert_cat $ map (string def_attr . snd) all_colors
            line_with_color_0 (c, c_name) = string (def_attr `with_back_color` c) c_name
            line_with_color_1 (c, c_name) = string (def_attr `with_back_color` c) c_name
        d <- display_bounds t >>= display_context t
        output_picture d pic
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = do
        putStr $ [s|
Once return is pressed:
    0. The screen will be cleared.
    1. The cursor will be hidden.
    2. 9 lines of text in three columns will be drawn:
        a. The first column will contain be a name of a standard color for an 8
        color terminal rendered with the default foreground color with a
        background the named color.  
        b. The first column will contain be a name of a standard color for an 8
        color terminal rendered with the default foreground color with the
        background a vivid version of the named color. 
        c. The third column will be the name of a standard color rendered with
        the default attributes.
        
For instance, one line will contain be the word "magenta" and the word should
be rendered in the default foreground color over a magenta background. 

I'm not actually sure exactly what "vivid" means in this context. For xterm the
vivid colors are brighter.

Verify: 
    * The first column: The background color matches the named color.
    * The second column: The background color matches the named color and is
    more vivid than the color used in the first column.  
    * The third column column: All text is rendered with the default attributes.
    * The vertical bars used in each line to mark the border of a column are
    lined up.

Note: I haven't decided if, in this case, the background color should extend to
fills added for alignment. Right now the selected background color is only
applied to the background where the word is actually rendered. Since each word
is not of the same length VTY adds background fills to make the width of each
row effectively the same. These added fills are all currently rendered with the
default background pattern.

After return is pressed for the second time:
    0. The screen containing the test summary should be restored.
    1. The cursor should be visible.
|]
    , confirm_results = do
        putStr $ [s|
Did the test output match the description?
|]
        default_success_confirm_results
    }

attr_combos = 
    [ ( "default", id )
    , ( "bold", flip with_style bold )
    , ( "blink", flip with_style blink )
    , ( "underline", flip with_style underline )
    , ( "bold + blink", flip with_style (bold + blink) )
    , ( "bold + underline", flip with_style (bold + underline) )
    , ( "underline + blink", flip with_style (underline + blink) )
    , ( "bold + blink + underline", flip with_style (bold + blink + underline) )
    ]

attributes_test_4 = Test 
    { test_name = "Character attributes: Bold; Blink; Underline."
    , test_ID = "attributes_test_4"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        let pic = pic_for_image image
            image = horiz_cat [border, column_0, border, column_1, border]
            border = vert_cat $ replicate (length attr_combos) $ string def_attr " | "
            column_0 = vert_cat $ map line_with_attrs attr_combos
            column_1 = vert_cat $ map (string def_attr . fst) attr_combos
            line_with_attrs (desc, attr_f) = string (attr_f def_attr) desc
        d <- display_bounds t >>= display_context t
        output_picture d pic
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = do
        putStr $ [s|
Once return is pressed:
    0. The screen will be cleared.
    1. The cursor will be hidden.
    2. 8 rows of text in two columns. 
    The rows will contain the following text:
        default
        bold 
        blink
        underline
        bold + blink
        bold + underline
        underline + blink
        bold + blink + underline
    The first column will be rendered with the described attributes. The second
    column will be rendered with the default attributes.
        
Verify: 
    * The vertical bars used in each line to mark the border of a column are
    lined up.
    * The text in the first column is rendered as described.

After return is pressed for the second time:
    0. The screen containing the test summary should be restored.
    1. The cursor should be visible.
|]
    , confirm_results = do
        putStr $ [s|
Did the test output match the description?
|]
        default_success_confirm_results
    }

attributes_test_5 = Test 
    { test_name = "Character attributes: 240 color palette"
    , test_ID = "attributes_test_5"
    , test_action = do
        t <- output_for_current_terminal
        reserve_display t
        let pic = pic_for_image image
            image = vert_cat $ map horiz_cat $ split_color_images color_images
            color_images = map (\i -> string (current_attr `with_back_color` Color240 i) " ") [0..239]
            split_color_images [] = []
            split_color_images is = (take 20 is ++ [string def_attr " "]) : (split_color_images (drop 20 is))
        d <- display_bounds t >>= display_context t
        output_picture d pic
        getLine
        release_display t
        release_terminal t
        return ()
    , print_summary = do
        putStr $ [s|
Once return is pressed:
    0. The screen will be cleared.
    1. The cursor will be hidden.
    2. A 20 character wide and 12 row high block of color squares. This should look like a palette
    of some sort. I'm not exactly sure if all color terminals use the same palette. I doubt it...

Verify: 

After return is pressed for the second time:
    0. The screen containing the test summary should be restored.
    1. The cursor should be visible.
|]
    , confirm_results = do
        putStr $ [s|
Did the test output match the description?
|]
        default_success_confirm_results
    }

inline_test_0 = Test
    { test_name = "Verify styled output can be performed without clearing the screen."
    , test_ID = "inline_test_0"
    , test_action = do
        putStrLn "line 1."
        put_attr_change_ $ back_color red >> apply_style underline
        putStrLn "line 2."
        put_attr_change_ $ default_all
        putStrLn "line 3."
    , print_summary = putStr $ [s|
lines are in order.
The second line "line 2" should have a red background and the text underline.
The third line "line 3" should be drawn in the same style as the first line.
|]

    , confirm_results = generic_output_match_confirm
    }

inline_test_1 = Test
    { test_name = "Verify styled output can be performed without clearing the screen."
    , test_ID = "inline_test_1"
    , test_action = do
        putStr "Not styled. "
        put_attr_change_ $ back_color red >> apply_style underline
        putStr " Styled! "
        put_attr_change_ $ default_all
        putStrLn "Not styled."
    , print_summary = putStr $ [s|
|]

    , confirm_results = generic_output_match_confirm
    }

inline_test_2 = Test
    { test_name = "Verify styled output can be performed without clearing the screen."
    , test_ID = "inline_test_1"
    , test_action = do
        putStr "Not styled. "
        put_attr_change_ $ back_color red >> apply_style underline
        putStr " Styled! "
        put_attr_change_ $ default_all
        putStr "Not styled.\n"
    , print_summary = putStr $ [s|
|]
    , confirm_results = generic_output_match_confirm
    }

cursor_hide_test_0 :: Test
cursor_hide_test_0 = Test
    { test_name = "Verify the cursor is hid and re-shown. issue #7"
    , test_ID = "cursor_hide_test_0"
    , test_action = do
        vty <- mkVty def
        show_cursor $ output_iface vty
        set_cursor_pos (output_iface vty) 5 5
        next_event vty
        hide_cursor $ output_iface vty
        next_event vty
        shutdown vty
        return ()
    , print_summary = putStr $ [s|
    1. verify the cursor is displayed.
    2. press enter
    3. verify the cursor is hid.
    4. press enter.
    5. the display should return to the state before the test.
|]
    , confirm_results = generic_output_match_confirm
    }

output_image_and_wait :: Image -> IO ()
output_image_and_wait image = do
    let pic = pic_for_image image
    output_pic_and_wait pic

output_pic_and_wait :: Picture -> IO ()
output_pic_and_wait pic = do
    t <- output_for_current_terminal
    reserve_display t
    d <- display_bounds t >>= display_context t
    output_picture d pic
    getLine
    release_display t
    release_terminal t
    return ()
    
vert_crop_test_0 :: Test
vert_crop_test_0 = Test
    { test_name = "Verify bottom cropping works as expected with single column chars"
    , test_ID = "crop_test_0"
    , test_action = do
        let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum
            block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum
            image = block_0 <-> background_fill 10 2 <-> block_1
        output_image_and_wait image
    , print_summary = putStr $ [s|
    1. Verify the two text blocks are identical.
    2. press enter.
    3. the display should return to the state before the test.
|]
    , confirm_results = generic_output_match_confirm
    }

vert_crop_test_1 :: Test
vert_crop_test_1 = Test
    { test_name = "Verify bottom cropping works as expected with double column chars"
    , test_ID = "crop_test_0"
    , test_action = do
        let block_0 = crop_bottom 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
            block_1 = vert_cat $ map (string def_attr) $ take 2 lorum_ipsum_chinese
            image = block_0 <-> background_fill 10 2 <-> block_1
        output_image_and_wait image
    , print_summary = putStr $ [s|
    1. Verify the two text blocks are identical.
    2. press enter.
    3. the display should return to the state before the test.
|]
    , confirm_results = generic_output_match_confirm
    }

vert_crop_test_2 :: Test
vert_crop_test_2 = Test
    { test_name = "Verify top cropping works as expected with single column chars"
    , test_ID = "crop_test_0"
    , test_action = do
        let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum
            block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum - 2) lorum_ipsum
            image = block_0 <-> background_fill 10 2 <-> block_1
        output_image_and_wait image
    , print_summary = putStr $ [s|
    1. Verify the two text blocks are identical.
    2. press enter.
    3. the display should return to the state before the test.
|]
    , confirm_results = generic_output_match_confirm
    }

vert_crop_test_3 :: Test
vert_crop_test_3 = Test
    { test_name = "Verify top cropping works as expected with double column chars"
    , test_ID = "crop_test_0"
    , test_action = do
        let block_0 = crop_top 2 $ vert_cat $ map (string def_attr) lorum_ipsum_chinese
            block_1 = vert_cat $ map (string def_attr) $ drop (length lorum_ipsum_chinese - 2 ) lorum_ipsum_chinese
            image = block_0 <-> background_fill 10 2 <-> block_1
        output_image_and_wait image
    , print_summary = putStr $ [s|
    1. Verify the two text blocks are identical.
    2. press enter.
    3. the display should return to the state before the test.
|]
    , confirm_results = generic_output_match_confirm
    }

horiz_crop_test_0 :: Test
horiz_crop_test_0 = Test
    { test_name = "Verify right cropping works as expected with single column chars"
    , test_ID = "crop_test_0"
    , test_action = do
        let base_image = vert_cat $ map (string def_attr) lorum_ipsum
            cropped_image = crop_right (image_width base_image `div` 2) base_image 
            image = base_image <-> background_fill 10 2 <-> cropped_image
        output_image_and_wait image
    , print_summary = putStr $ [s|
    1. Verify the bottom text block is about half the width of the top text block.
    2. press enter.
    3. the display should return to the state before the test.
|]
    , confirm_results = generic_output_match_confirm
    }

horiz_crop_test_1 :: Test
horiz_crop_test_1 = Test
    { test_name = "Verify right cropping works as expected with double column chars"
    , test_ID = "crop_test_0"
    , test_action = do
        let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
            cropped_image = crop_right (image_width base_image `div` 2) base_image 
            image = base_image <-> background_fill 10 2 <-> cropped_image
        output_image_and_wait image
    , print_summary = putStr $ [s|
    1. Verify the bottom text block is the left half of the top block. Ellipses on the right edge are OK.
    2. press enter.
    3. the display should return to the state before the test.
|]
    , confirm_results = generic_output_match_confirm
    }

horiz_crop_test_2 :: Test
horiz_crop_test_2 = Test
    { test_name = "Verify left cropping works as expected with single column chars"
    , test_ID = "crop_test_0"
    , test_action = do
        let base_image = vert_cat $ map (string def_attr) lorum_ipsum
            cropped_image = crop_left (image_width base_image `div` 2) base_image 
            image = base_image <-> background_fill 10 2 <-> cropped_image
        output_image_and_wait image
    , print_summary = putStr $ [s|
    1. Verify the bottom text block is the right half of the top text block.
    2. press enter.
    3. the display should return to the state before the test.
|]
    , confirm_results = generic_output_match_confirm
    }

horiz_crop_test_3 :: Test
horiz_crop_test_3 = Test
    { test_name = "Verify right cropping works as expected with double column chars"
    , test_ID = "crop_test_0"
    , test_action = do
        let base_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
            cropped_image = crop_left (image_width base_image `div` 2) base_image 
            image = base_image <-> background_fill 10 2 <-> cropped_image
        output_image_and_wait image
    , print_summary = putStr $ [s|
    1. Verify the bottom text block is the right half of the top block. Ellipses on the left edge are OK.
    2. press enter.
    3. the display should return to the state before the test.
|]
    , confirm_results = generic_output_match_confirm
    }

layer_0 :: Test
layer_0 = Test
    { test_name = "verify layer 0"
    , test_ID = "layer_0"
    , test_action = do
        let upper_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
            lower_image = vert_cat $ map (string def_attr) lorum_ipsum
            p = pic_for_layers [upper_image, lower_image]
        output_pic_and_wait p
    , print_summary = putStr $ [s|
    1. Verify the text block appears to be Chinese text placed on top Latin text.
    2. press enter.
    3. the display should return to the state before the test.
|]
    , confirm_results = generic_output_match_confirm
    }

layer_1 :: Test
layer_1 = Test
    { test_name = "verify layer 1"
    , test_ID = "layer_1"
    , test_action = do
        let upper_image = vert_cat $ map (string def_attr) lorum_ipsum_chinese
            block = resize 10 10 upper_image
            layer_0 = vert_cat $ map (string def_attr) lorum_ipsum
            layer_1 = char_fill (def_attr `with_back_color` blue) '#' 1000 1000
        cheesy_anim_0 block [layer_0, layer_1]
    , print_summary = putStr $ [s|
    1. Verify the text block appears to be Chinese text moving on top a Latin text.
       Which is all on a background of '#' characters over blue.
    2. press enter.
    3. the display should return to the state before the test.
|]
    , confirm_results = generic_output_match_confirm
    }

cheesy_anim_0 :: Image -> [Image] -> IO ()
cheesy_anim_0 i background = do
    t <- output_for_current_terminal
    reserve_display t
    bounds <- display_bounds t
    d <- display_context t bounds
    forM_ [0..100] $ \t -> do
        let i_offset = translate (t `mod` fst bounds)
                                 (t `div` 2 `mod` snd bounds)
                                 i
        let pic = pic_for_layers $ i_offset : background
        output_picture d pic
        threadDelay 50000
    release_display t
    release_terminal t
    return ()

lorum_ipsum :: [String]
lorum_ipsum = lines [s|
Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium,
totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae
dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit,
sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam
est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius
modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima
veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea
commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil
molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?
|]

lorum_ipsum_chinese :: [String]
lorum_ipsum_chinese = lines [s|
輐銛 螷蟞覮 裌覅詵 暕 鴅噮 槶 惝掭掝 婸媥媕 耏胠臿, 汫汭沎 忕汌卣 蚡袀 僣 蒮 瀁瀎瀊 渮湸湤 緌翢,
腠腶舝 糲蘥蠩 樏殣氀 蒮 蹢鎒 滍 鸄齴 櫧櫋瀩 鬄鵊鵙 莃荶衒, 毸溠 橀 簎艜薤 莃荶衒 翣聜蒢
斔櫅檷 晛桼桾 拻敁柧 犿玒 膣, 墐 笓粊紒 bacon 鼀齕, 蔝蓶蓨 顊顃餭 姴怤 骱 暕 蹢鎒鎛 藒襓謥 鄻鎟霣
鬎鯪, 鐩闤 硻禂稢 谾踘遳 撱 赲 迡 箷 蛃袚觙 萇雊蜩 壿嫷 鋡 縢羱聬 跐鉠鉣 蔝蓶蓨 匢奾灱 溮煡煟 雥齆犪
蔰 虈觿, 腷腯葹 鍹餳駷 蛚袲褁蜸 皯竻 瀁瀎 蜭蜸覟 梪涫湴 揗斝湁 毼
|]