1-- | Partially taken from Hugs AnsiScreen.hs library:
2module Language.Haskell.HsColour.ANSI
3  ( highlightOnG,highlightOn
4  , highlightOff
5  , highlightG,highlight
6  , cleareol, clearbol, clearline, clearDown, clearUp, cls
7  , goto
8  , cursorUp, cursorDown, cursorLeft, cursorRight
9  , savePosition, restorePosition
10  , Highlight(..)
11  , Colour(..)
12  , colourCycle
13  , enableScrollRegion, scrollUp, scrollDown
14  , lineWrap
15  , TerminalType(..)
16  ) where
17
18import Language.Haskell.HsColour.ColourHighlight
19import Language.Haskell.HsColour.Output(TerminalType(..))
20
21import Data.List (intersperse,isPrefixOf)
22import Data.Char (isDigit)
23
24
25
26-- Basic screen control codes:
27
28type Pos           = (Int,Int)
29
30at        :: Pos -> String -> String
31-- | Move the screen cursor to the given position.
32goto      :: Int -> Int -> String
33home      :: String
34-- | Clear the screen.
35cls       :: String
36
37at (x,y) s  = goto x y ++ s
38goto x y    = '\ESC':'[':(show y ++(';':show x ++ "H"))
39home        = goto 1 1
40
41cursorUp    = "\ESC[A"
42cursorDown  = "\ESC[B"
43cursorRight = "\ESC[C"
44cursorLeft  = "\ESC[D"
45
46cleareol    = "\ESC[K"
47clearbol    = "\ESC[1K"
48clearline   = "\ESC[2K"
49clearDown   = "\ESC[J"
50clearUp     = "\ESC[1J"
51-- Choose whichever of the following lines is suitable for your system:
52cls         = "\ESC[2J"     -- for PC with ANSI.SYS
53--cls         = "\^L"         -- for Sun window
54
55savePosition    = "\ESC7"
56restorePosition = "\ESC8"
57
58
59-- data Colour    -- imported from ColourHighlight
60-- data Highlight -- imported from ColourHighlight
61
62instance Enum Highlight where
63  fromEnum Normal       = 0
64  fromEnum Bold         = 1
65  fromEnum Dim          = 2
66  fromEnum Underscore   = 4
67  fromEnum Blink        = 5
68  fromEnum ReverseVideo = 7
69  fromEnum Concealed    = 8
70  -- The translation of these depends on the terminal type, and they don't translate to single numbers anyway. Should we really use the Enum class for this purpose rather than simply moving this table to 'renderAttrG'?
71  fromEnum (Foreground (Rgb _ _ _)) = error "Internal error: fromEnum (Foreground (Rgb _ _ _))"
72  fromEnum (Background (Rgb _ _ _)) = error "Internal error: fromEnum (Background (Rgb _ _ _))"
73  fromEnum (Foreground c) = 30 + fromEnum c
74  fromEnum (Background c) = 40 + fromEnum c
75  fromEnum Italic       = 2
76
77
78-- | = 'highlightG' 'Ansi16Colour'
79highlight ::  [Highlight] -> String -> String
80highlight = highlightG Ansi16Colour
81
82-- | = 'highlightOn' 'Ansi16Colour'
83highlightOn ::  [Highlight] -> String
84highlightOn = highlightOnG Ansi16Colour
85
86
87-- | Make the given string appear with all of the listed highlights
88highlightG :: TerminalType -> [Highlight] -> String -> String
89highlightG tt attrs s = highlightOnG tt attrs ++ s ++ highlightOff
90
91highlightOnG :: TerminalType -> [Highlight] -> String
92highlightOnG tt []     = highlightOnG tt [Normal]
93highlightOnG tt attrs  = "\ESC["
94                       ++ concat (intersperse ";" (concatMap (renderAttrG tt) attrs))
95                       ++"m"
96highlightOff ::  [Char]
97highlightOff = "\ESC[0m"
98
99renderAttrG ::  TerminalType -> Highlight -> [String]
100renderAttrG XTerm256Compatible (Foreground (Rgb r g b)) =
101    [ "38", "5", show ( rgb24bit_to_xterm256 r g b ) ]
102renderAttrG XTerm256Compatible (Background (Rgb r g b)) =
103    [ "48", "5", show ( rgb24bit_to_xterm256 r g b ) ]
104renderAttrG _ a                                         =
105    [ show (fromEnum (hlProjectToBasicColour8 a)) ]
106
107-- | An infinite supply of colours.
108colourCycle :: [Colour]
109colourCycle = cycle [Red,Blue,Magenta,Green,Cyan]
110
111
112-- | Scrolling
113enableScrollRegion :: Int -> Int -> String
114enableScrollRegion start end = "\ESC["++show start++';':show end++"r"
115
116scrollDown ::  String
117scrollDown  = "\ESCD"
118scrollUp ::  String
119scrollUp    = "\ESCM"
120
121-- Line-wrapping mode
122lineWrap ::  Bool -> [Char]
123lineWrap True  = "\ESC[7h"
124lineWrap False = "\ESC[7l"
125
126