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