ansi-terminal-0.8: System/Console/ANSI/Example.hs

module Main
  (
    main
  ) where

import Control.Concurrent (threadDelay)
import Control.Monad (forM_)
import System.IO (hFlush, stdout)

import System.Console.ANSI

examples :: [IO ()]
examples = [ cursorMovementExample
           , lineChangeExample
           , setCursorPositionExample
           , saveRestoreCursorExample
           , clearExample
           , scrollExample
           , sgrExample
           , cursorVisibilityExample
           , titleExample
           , getCursorPositionExample
           ]

main :: IO ()
main = mapM_ (\example -> resetScreen >> example) examples

-- Annex D to Standard ECMA-48 (5th Ed, 1991) identifies that the representation
-- of an erased state is implementation-dependent. There may or may not be a
-- distinction between a character position in the erased state and one imaging
-- SPACE. Consequently, to reset the screen, the default graphic rendition must
-- be selected (setSGR [Reset]) before all character positions are put into the
-- erased state (clearScreen).
resetScreen :: IO ()
resetScreen = setSGR [Reset] >> clearScreen >> setCursorPosition 0 0

pause :: IO ()
pause = do
  hFlush stdout
  -- 1 second pause
  threadDelay 1000000

cursorMovementExample :: IO ()
cursorMovementExample = do
  putStrLn "Line One"
  putStr "Line Two"
  pause
  -- Line One
  -- Line Two

  cursorUp 1
  putStr " - Extras"
  pause
  -- Line One - Extras
  -- Line Two

  cursorBackward 2
  putStr "zz"
  pause
  -- Line One - Extrzz
  -- Line Two

  cursorForward 2
  putStr "- And More"
  pause
  -- Line One - Extrzz  - And More
  -- Line Two

  cursorDown 1
  putStr "Disconnected"
  pause
  -- Line One - Extrzz  - And More
  -- Line Two                     Disconnected

lineChangeExample :: IO ()
lineChangeExample = do
  putStrLn "Line One"
  putStr "Line Two"
  pause
  -- Line One
  -- Line Two

  cursorUpLine 1
  putStr "New Line One"
  pause
  -- New Line One
  -- Line Two

  cursorDownLine 1
  putStr "New Line Two"
  pause
  -- New Line One
  -- New Line Two

setCursorPositionExample :: IO ()
setCursorPositionExample = do
  putStrLn "Line One"
  putStrLn "Line Two"
  pause
  -- Line One
  -- Line Two

  setCursorPosition 0 5
  putStr "Foo"
  pause
  -- Line Foo
  -- Line Two

  setCursorPosition 1 5
  putStr "Bar"
  pause
  -- Line Foo
  -- Line Bar

  setCursorColumn 1
  putStr "oaf"
  pause
  -- Line Foo
  -- Loaf Bar

saveRestoreCursorExample :: IO ()
saveRestoreCursorExample = do
  putStr "Start sentence ..."
  pause
  -- Start sentence ...

  saveCursor
  setCursorPosition 2 3
  putStr "SPLASH!"
  pause
  -- Start sentence ...
  --
  --    SPLASH!

  restoreCursor
  putStr " end sentence, uninterrupted."
  pause
  -- Start sentence ... end sentence, uninterrupted
  --
  --    SPLASH!

clearExample :: IO ()
clearExample = do
  putStrLn "Line One"
  putStrLn "Line Two"
  pause
  -- Line One
  -- Line Two

  setCursorPosition 0 4
  clearFromCursorToScreenEnd
  pause
  -- Line

  resetScreen
  putStrLn "Line One"
  putStrLn "Line Two"
  pause
  -- Line One
  -- Line Two

  setCursorPosition 1 4
  clearFromCursorToScreenBeginning
  pause
  --
  --     Two

  resetScreen
  putStrLn "Line One"
  putStrLn "Line Two"
  pause
  -- Line One
  -- Line Two

  setCursorPosition 0 4
  clearFromCursorToLineEnd
  pause
  -- Line
  -- Line Two

  setCursorPosition 1 4
  clearFromCursorToLineBeginning
  pause
  -- Line
  --      Two

  clearLine
  pause
  -- Line

  clearScreen
  pause
  --

scrollExample :: IO ()
scrollExample = do
  putStrLn "Line One"
  putStrLn "Line Two"
  putStrLn "Line Three"
  pause
  -- Line One
  -- Line Two
  -- Line Three

  scrollPageDown 2
  pause
  --
  --
  -- Line One
  -- Line Two
  -- Line Three

  scrollPageUp 3
  pause
  -- Line Two
  -- Line Three

sgrExample :: IO ()
sgrExample = do
  let colors = enumFromTo minBound maxBound :: [Color]
  forM_ [Foreground, Background] $ \layer ->  do
    forM_ [Dull, Vivid] $ \intensity -> do
      resetScreen
      forM_ colors $ \color -> do
        setSGR [Reset]
        setSGR [SetColor layer intensity color]
        putStrLn (show color)
      pause
  -- All the colors, 4 times in sequence

  let named_styles = [ (SetConsoleIntensity BoldIntensity, "Bold")
                     , (SetConsoleIntensity FaintIntensity, "Faint")
                     , (SetConsoleIntensity NormalIntensity, "Normal")
                     , (SetItalicized True, "Italic")
                     , (SetItalicized False, "No Italics")
                     , (SetUnderlining SingleUnderline, "Single Underline")
                     , (SetUnderlining DoubleUnderline, "Double Underline")
                     , (SetUnderlining NoUnderline, "No Underline")
                     , (SetBlinkSpeed SlowBlink, "Slow Blink")
                     , (SetBlinkSpeed RapidBlink, "Rapid Blink")
                     , (SetBlinkSpeed NoBlink, "No Blink")
                     , (SetVisible False, "Conceal")
                     , (SetVisible True, "Reveal")
                     ]
  forM_ named_styles $ \(style, name) -> do
    resetScreen
    setSGR [style]
    putStrLn name
    pause
  -- Text describing a style displayed in that style in sequence

  setSGR [SetColor Foreground Vivid Red]
  setSGR [SetColor Background Vivid Blue]

  clearScreen >> setCursorPosition 0 0
  setSGR [SetSwapForegroundBackground False]
  putStr "Red-On-Blue"
  pause
  -- Red-On-Blue

  clearScreen >> setCursorPosition 0 0
  setSGR [SetSwapForegroundBackground True]
  putStr "Blue-On-Red"
  pause
  -- Blue-On-Red

cursorVisibilityExample :: IO ()
cursorVisibilityExample = do
  putStr "Cursor Demo"
  pause
  -- Cursor Demo|

  hideCursor
  pause
  -- Cursor Demo

  showCursor
  pause
  -- Cursor Demo|

titleExample :: IO ()
titleExample = do
  putStr "Title Demo"
  pause
  -- ~/foo/ - ansi-terminal-ex - 83x70
  ------------------------------------
  -- Title Demo

  setTitle "Yup, I'm a new title!"
  pause
  -- Yup, I'm a new title! - ansi-terminal-ex - 83x70
  ---------------------------------------------------
  -- Title Demo

getCursorPositionExample :: IO ()
getCursorPositionExample = do
  putStrLn "         11111111112222222222"
  putStrLn "12345678901234567890123456789"
  putStr   "Report cursor position here:"
  pause
  --          11111111112222222222
  -- 12345678901234567890123456789
  -- Report cursor position here:|
  result <- getCursorPosition
  putStrLn " (3rd row, 29th column) to stdin, as CSI 3 ; 29 R.\n"
  case result of
    Just (row, col) -> putStrLn $ "The cursor was at row number " ++
      show row ++ " and column number " ++ show col ++ ".\n"
    Nothing -> putStrLn "Error: unable to get the cursor position\n"
  pause
  --          11111111112222222222
  -- 12345678901234567890123456789
  -- Report cursor position here: (3rd row, 29th column) to stdin, as CSI 3 ; 29 R.
  --
  -- The cursor was at row number 3 and column number 29.