VT100.hs

{-# OPTIONS -fno-warn-missing-signatures #-}
-- | Generation of VT100 terminal control codes.
module DDC.War.Interface.VT100 
        ( Color(..),            codeOfColor
        , Mode (..),            codeOfMode
        , ModeState (..),       modeStateInit, applyMode
        
        , eraseDisplay
        , eraseLine
        , setCursorPos
        , moveCursorUp
        , moveCursorDown
        , moveCursorLeft
        , moveCursorRight
        , saveCursorPosition
        , restoreCursorPosition
        , setMode )
where
import Data.List

-- Color ----------------------------------------------------------------------
-- | VT100 / ANSI colors
data Color
        = Black
        | Red
        | Green
        | Yellow
        | Blue
        | Magenta
        | Cyan
        | White
        deriving (Show, Eq, Ord)

-- | Control code offset for rendering colors.
--      Need to add 30 for foreground, 40 for background to get real code.
codeOfColor :: Color -> Int
codeOfColor color
 = case color of
        Black   -> 0
        Red     -> 1
        Green   -> 2
        Yellow  -> 3
        Blue    -> 4
        Magenta -> 5
        Cyan    -> 6
        White   -> 7
        

-- Mode -----------------------------------------------------------------------
-- | Rendering mode commands.
data Mode
        = Reset
        | Bold
        | Dim
        | Underscore
        | Blink
        | Reverse
        | Concealed
        | Foreground Color
        | Background Color
        deriving (Show, Eq, Ord)


-- | Control codes for rendering mode commands.
codeOfMode :: Mode -> Int
codeOfMode mode
 = case mode of
        Reset                   -> 0
        Bold                    -> 1
        Dim                     -> 3
        Underscore              -> 4
        Blink                   -> 5
        Reverse                 -> 7
        Concealed               -> 8
        Foreground color        -> 30 + codeOfColor color
        Background color        -> 40 + codeOfColor color


-- ModeState ------------------------------------------------------------------
-- Model of VT100 terminal state, to help keep track what state
--      the terminal is in after accepting a string of commands.

data ModeState
        = ModeState
        { sBold         :: Bool
        , sDim          :: Bool
        , sUnderscore   :: Bool
        , sBlink        :: Bool
        , sReverse      :: Bool
        , sConcealed    :: Bool
        , sForeground   :: Color
        , sBackground   :: Color }
        deriving (Show, Eq)
        
modeStateInit
        = ModeState
        { sBold         = False
        , sDim          = False
        , sUnderscore   = False
        , sBlink        = False
        , sReverse      = False
        , sConcealed    = False
        , sForeground   = White
        , sBackground   = Black }


applyMode :: ModeState -> Mode -> ModeState
applyMode state m
 = case m of
        Reset           -> modeStateInit
        Bold            -> state { sBold        = True }
        Dim             -> state { sDim         = True }
        Underscore      -> state { sUnderscore  = True }
        Blink           -> state { sBlink       = True }
        Reverse         -> state { sReverse     = True }
        Concealed       -> state { sConcealed   = True }
        Foreground c    -> state { sForeground  = c }
        Background c    -> state { sBackground  = c }


-- Commands -------------------------------------------------------------------

-- | Erase entire display.
eraseDisplay            = "\27[2J"

-- | Erase current line of display.
eraseLine               = "\27[K"

-- | Set the position of the cursor.
setCursorPos x y        = "\27[" ++ show y ++ ";" ++ show x ++ "H"

-- | Move cursor up some number of lines.
moveCursorUp n          = "\27[" ++ show n ++ "A"

-- | Move cursor down some number of lines.
moveCursorDown n        = "\27[" ++ show n ++ "B"

-- | Move cursor right / forward some number of columns.
moveCursorRight n       = "\27[" ++ show n ++ "C"

-- | Move cursor left / backward some number of columns.
moveCursorLeft n        = "\27[" ++ show n ++ "D"

-- | Save cursor position 
saveCursorPosition      = "\27[s"

-- | Restore cursor position
restoreCursorPosition   = "\27[u"

-- | Set graphics mode
setMode modes
        = "\27[" 
        ++ concat 
                (intersperse ";" 
                $ map (show . codeOfMode) modes) 
        ++ "m"