twitter-0.1.1: GUI/Terminal.hs

-- Copied from the Nethask project
module GUI.Terminal (
    move, move_up, move_down, move_forward, move_back
  , clr, clear, clear_eol, reset, blinkRed, big, Color (..), color, geometry
  , hideCursor, showCursor
  ) where

import Control.Monad (liftM, liftM2)
import Data.List (intercalate)
import System.Environment (getEnvironment)

--------[ ansi escape sequence generation ]------------------------------------

-- Generic function for producing ANSI escape sequences.
esc :: String -> String -> [String] -> String
esc a b arg = concat ["\ESC[", a, intercalate ";" $ arg, b]

-- Move the cursor to the specified row and column.
move col row = esc "" "H" [show row, show col]

showCursor = esc "" "l" ["25"]
hideCursor = esc "" "l" ["25"]

move_up      rows = esc "" "A" [show rows]
move_down    rows = esc "" "B" [show rows]
move_back    rows = esc "" "D" [show rows]
move_forward rows = esc "" "C" [show rows]

-- Load and store the current cursor position.
save = esc "s" "" []
load = esc "u" "" []

-- Generic function for creating (forground) color sequences.
clr attr fg = esc "" "m" [attr, fg]

-- Clear screen and end-of-line
clear     = esc "2J" "" [] ++ move 1 1
clear_eol = esc "K"  "" []

reset = clear ++ color Reset

blinkRed = esc "" "m" ["1", "5", "31"]

big s =
     "\ESC#3" ++ s
  ++ move_back (length s)
  ++ move_down 1
  ++ "\ESC#4" ++ s ++ "\n"

--------[ ansi color listing ]-------------------------------------------------

data Color =
    Black   | Black_b   | Black_bl   | Black_bg
  | Red     | Red_b     | Red_bl     | Red_bg
  | Green   | Green_b   | Green_bl   | Green_bg
  | Yellow  | Yellow_b  | Yellow_bl  | Yellow_bg
  | Blue    | Blue_b    | Blue_bl    | Blue_bg
  | Magenta | Magenta_b | Magenta_bl | Magenta_bg
  | Cyan    | Cyan_b    | Cyan_bl    | Cyan_bg
  | White   | White_b   | White_bl   | White_bg
  | Reset   | Reset_b   | Reset_bl   | Reset_bg
  deriving (Show, Eq)

-- List of foreground color sequences.
color Black      = clr "0" "30"
color Red        = clr "0" "31"
color Green      = clr "0" "32"
color Yellow     = clr "0" "33"
color Blue       = clr "0" "34"
color Magenta    = clr "0" "35"
color Cyan       = clr "0" "36"
color White      = clr "0" "37"
color Reset      = clr "0" "39"

-- List of bold foreground color sequences.
color Black_b    = clr "1" "30"
color Red_b      = clr "1" "31"
color Green_b    = clr "1" "32"
color Yellow_b   = clr "1" "33"
color Blue_b     = clr "1" "34"
color Magenta_b  = clr "1" "35"
color Cyan_b     = clr "1" "36"
color White_b    = clr "1" "37"
color Reset_b    = clr "1" "39"

-- List of background color sequences.
color Black_bg   = clr "1" "40"
color Red_bg     = clr "1" "41"
color Green_bg   = clr "1" "42"
color Yellow_bg  = clr "1" "43"
color Blue_bg    = clr "1" "44"
color Magenta_bg = clr "1" "45"
color Cyan_bg    = clr "1" "46"
color White_bg   = clr "1" "47"
color Reset_bg   = clr "1" "49"

-- List of background color sequences.
color Black_bl   = esc "" "m" ["5", "30"]
color Red_bl     = esc "" "m" ["5", "31"]
color Green_bl   = esc "" "m" ["5", "32"]
color Yellow_bl  = esc "" "m" ["5", "33"]
color Blue_bl    = esc "" "m" ["5", "34"]
color Magenta_bl = esc "" "m" ["5", "35"]
color Cyan_bl    = esc "" "m" ["5", "36"]
color White_bl   = esc "" "m" ["5", "37"]
color Reset_bl   = esc "" "m" ["5", "39"]

--------[ terminal geometry ]--------------------------------------------------

-- Try to read terminal width from environment variable.
width :: IO Int
width = liftM (maybe 80 read . lookup "COLUMNS") getEnvironment

-- Try to read terminal height from environment variable.
height :: IO Int
height = liftM (maybe 24 read . lookup "LINES") getEnvironment

-- Try to read terminal width and height from environment variables.
geometry :: IO (Int, Int)
geometry = liftM2 (,) width height