-- | Partially taken from Hugs AnsiScreen.hs library:
module Language.Haskell.HsColour.ANSI
  ( highlightOnG,highlightOn
  , highlightOff
  , highlightG,highlight
  , cleareol, clearbol, clearline, clearDown, clearUp, cls
  , goto
  , cursorUp, cursorDown, cursorLeft, cursorRight
  , savePosition, restorePosition
  , Highlight(..)
  , Colour(..)
  , colourCycle
  , enableScrollRegion, scrollUp, scrollDown
  , lineWrap
  , TerminalType(..)
  ) where

import Language.Haskell.HsColour.ColourHighlight
import Language.Haskell.HsColour.Output(TerminalType(..))

import Data.List (intersperse,isPrefixOf)
import Data.Char (isDigit)



-- Basic screen control codes:

type Pos           = (Int,Int)

at        :: Pos -> String -> String
-- | Move the screen cursor to the given position.
goto      :: Int -> Int -> String
home      :: String
-- | Clear the screen.
cls       :: String

at :: Pos -> String -> String
at (Int
x,Int
y) String
s  = Int -> Int -> String
goto Int
x Int
y forall a. [a] -> [a] -> [a]
++ String
s
goto :: Int -> Int -> String
goto Int
x Int
y    = Char
'\ESC'forall a. a -> [a] -> [a]
:Char
'['forall a. a -> [a] -> [a]
:(forall a. Show a => a -> String
show Int
y forall a. [a] -> [a] -> [a]
++(Char
';'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Int
x forall a. [a] -> [a] -> [a]
++ String
"H"))
home :: String
home        = Int -> Int -> String
goto Int
1 Int
1

cursorUp :: String
cursorUp    = String
"\ESC[A"
cursorDown :: String
cursorDown  = String
"\ESC[B"
cursorRight :: String
cursorRight = String
"\ESC[C"
cursorLeft :: String
cursorLeft  = String
"\ESC[D"

cleareol :: String
cleareol    = String
"\ESC[K"
clearbol :: String
clearbol    = String
"\ESC[1K"
clearline :: String
clearline   = String
"\ESC[2K"
clearDown :: String
clearDown   = String
"\ESC[J"
clearUp :: String
clearUp     = String
"\ESC[1J"
-- Choose whichever of the following lines is suitable for your system:
cls :: String
cls         = String
"\ESC[2J"     -- for PC with ANSI.SYS
--cls         = "\^L"         -- for Sun window

savePosition :: String
savePosition    = String
"\ESC7"
restorePosition :: String
restorePosition = String
"\ESC8"


-- data Colour    -- imported from ColourHighlight
-- data Highlight -- imported from ColourHighlight

instance Enum Highlight where
  fromEnum :: Highlight -> Int
fromEnum Highlight
Normal       = Int
0
  fromEnum Highlight
Bold         = Int
1
  fromEnum Highlight
Dim          = Int
2
  fromEnum Highlight
Underscore   = Int
4
  fromEnum Highlight
Blink        = Int
5
  fromEnum Highlight
ReverseVideo = Int
7
  fromEnum Highlight
Concealed    = Int
8
  -- 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'?
  fromEnum (Foreground (Rgb Word8
_ Word8
_ Word8
_)) = forall a. HasCallStack => String -> a
error String
"Internal error: fromEnum (Foreground (Rgb _ _ _))"
  fromEnum (Background (Rgb Word8
_ Word8
_ Word8
_)) = forall a. HasCallStack => String -> a
error String
"Internal error: fromEnum (Background (Rgb _ _ _))"
  fromEnum (Foreground Colour
c) = Int
30 forall a. Num a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum Colour
c
  fromEnum (Background Colour
c) = Int
40 forall a. Num a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum Colour
c
  fromEnum Highlight
Italic       = Int
2


-- | = 'highlightG' 'Ansi16Colour'
highlight ::  [Highlight] -> String -> String
highlight :: [Highlight] -> String -> String
highlight = TerminalType -> [Highlight] -> String -> String
highlightG TerminalType
Ansi16Colour

-- | = 'highlightOn' 'Ansi16Colour'
highlightOn ::  [Highlight] -> String
highlightOn :: [Highlight] -> String
highlightOn = TerminalType -> [Highlight] -> String
highlightOnG TerminalType
Ansi16Colour


-- | Make the given string appear with all of the listed highlights
highlightG :: TerminalType -> [Highlight] -> String -> String
highlightG :: TerminalType -> [Highlight] -> String -> String
highlightG TerminalType
tt [Highlight]
attrs String
s = TerminalType -> [Highlight] -> String
highlightOnG TerminalType
tt [Highlight]
attrs forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
highlightOff

highlightOnG :: TerminalType -> [Highlight] -> String
highlightOnG :: TerminalType -> [Highlight] -> String
highlightOnG TerminalType
tt []     = TerminalType -> [Highlight] -> String
highlightOnG TerminalType
tt [Highlight
Normal]
highlightOnG TerminalType
tt [Highlight]
attrs  = String
"\ESC["
                       forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. a -> [a] -> [a]
intersperse String
";" (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TerminalType -> Highlight -> [String]
renderAttrG TerminalType
tt) [Highlight]
attrs))
                       forall a. [a] -> [a] -> [a]
++String
"m"
highlightOff ::  [Char]
highlightOff :: String
highlightOff = String
"\ESC[0m"

renderAttrG ::  TerminalType -> Highlight -> [String]
renderAttrG :: TerminalType -> Highlight -> [String]
renderAttrG TerminalType
XTerm256Compatible (Foreground (Rgb Word8
r Word8
g Word8
b)) = 
    [ String
"38", String
"5", forall a. Show a => a -> String
show ( forall t. Integral t => Word8 -> Word8 -> Word8 -> t
rgb24bit_to_xterm256 Word8
r Word8
g Word8
b ) ]
renderAttrG TerminalType
XTerm256Compatible (Background (Rgb Word8
r Word8
g Word8
b)) = 
    [ String
"48", String
"5", forall a. Show a => a -> String
show ( forall t. Integral t => Word8 -> Word8 -> Word8 -> t
rgb24bit_to_xterm256 Word8
r Word8
g Word8
b ) ]
renderAttrG TerminalType
_ Highlight
a                                         = 
    [ forall a. Show a => a -> String
show (forall a. Enum a => a -> Int
fromEnum (Highlight -> Highlight
hlProjectToBasicColour8 Highlight
a)) ]

-- | An infinite supply of colours.
colourCycle :: [Colour]
colourCycle :: [Colour]
colourCycle = forall a. [a] -> [a]
cycle [Colour
Red,Colour
Blue,Colour
Magenta,Colour
Green,Colour
Cyan]


-- | Scrolling
enableScrollRegion :: Int -> Int -> String
enableScrollRegion :: Int -> Int -> String
enableScrollRegion Int
start Int
end = String
"\ESC["forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Int
startforall a. [a] -> [a] -> [a]
++Char
';'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Int
endforall a. [a] -> [a] -> [a]
++String
"r"

scrollDown ::  String
scrollDown :: String
scrollDown  = String
"\ESCD"
scrollUp ::  String
scrollUp :: String
scrollUp    = String
"\ESCM"

-- Line-wrapping mode
lineWrap ::  Bool -> [Char]
lineWrap :: Bool -> String
lineWrap Bool
True  = String
"\ESC[7h"
lineWrap Bool
False = String
"\ESC[7l"