ztail-1.0: Display.hs

module Display (
    TermColor,
    parseColor,
    errMsg,
    output,
    reset
  ) where

import System.IO
import Data.Char
import Util

type TermColor = [Int]

displayColor :: TermColor -> String
displayColor [] = ""
displayColor c =
  "\ESC[" ++ (join ';' (map show c)) ++ "m"

displayResetColor = displayColor [colorReset]

colorReset = colorValue "reset"
colorValue "reset"	= 0
colorValue "br" 	= 1
--colorValue "dark"	= 2
colorValue "so"		= 3
colorValue "hl"		= 3
colorValue "ul"		= 4
colorValue "bl"		= 5
colorValue "rev"	= 7
colorValue "hidden"	= 8
colorValue "nobr"	= 22--21
--colorValue "nodark"	= 22
colorValue "noso"	= 23
colorValue "nohl"	= 23
colorValue "noul"	= 24
colorValue "nobl"	= 25
colorValue "norev"	= 27
colorValue "nohidden"	= 28
colorValue "black"	= 30
colorValue "red"	= 31
colorValue "green"	= 32
colorValue "yellow"	= 33
colorValue "blue"	= 34
colorValue "magenta"	= 35
colorValue "cyan"	= 36
colorValue "white"	= 37
--colorValue ('/':c)	= 10 + colorValue c
colorValue "/black"	= 40
colorValue "/red"	= 41
colorValue "/green"	= 42
colorValue "/yellow"	= 43
colorValue "/blue"	= 44
colorValue "/magenta"	= 45
colorValue "/cyan"	= 46
colorValue "/white"	= 47

colorValue "normal"	= colorValue "reset"
colorValue "bold"	= colorValue "br"
colorValue "nobold"	= colorValue "nobr"
colorValue "bright"	= colorValue "br"
colorValue "nobright"	= colorValue "nobr"
colorValue "dim"	= colorValue "dark"
colorValue "nodim"	= colorValue "nodark"
colorValue "standout"	= colorValue "so"
colorValue "nostandout"	= colorValue "noso"
colorValue "hilite"	= colorValue "hl"
colorValue "nohilite"	= colorValue "nohl"
colorValue "underline"  = colorValue "ul"
colorValue "nounderline"= colorValue "noul"
colorValue "blink"	= colorValue "bl"
colorValue "noblink"	= colorValue "nobl"
colorValue "reverse"	= colorValue "rev"
colorValue "noreverse"	= colorValue "norev"

colorValue x = error ("unknown color name: " ++ x)

colorSep = not . isAlphaNum

parseColor :: String -> TermColor
parseColor [] = []
parseColor ('/':s) =
  colorValue ('/':x) : parseColor r
  where
    (x, r) = break colorSep s
parseColor s@(c:s')
  | colorSep c = parseColor s'
  | otherwise = colorValue x : parseColor r
      where
	(x, r) = break colorSep s

errMsg :: String -> IO ()
errMsg m = putStr displayResetColor >> hPutStrLn stderr m

output :: TermColor -> String -> IO ()
output c m = putStrLn (displayColor (colorReset : c) ++ m)

reset :: IO ()
reset = putStr displayResetColor