-- | 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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
goto :: Int -> Int -> String
goto Int
x Int
y    = Char
'\ESC'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'['Char -> String -> String
forall a. a -> [a] -> [a]
:(Int -> String
forall a. Show a => a -> String
show Int
y String -> String -> String
forall a. [a] -> [a] -> [a]
++(Char
';'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
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
_)) = String -> Int
forall a. HasCallStack => String -> a
error String
"Internal error: fromEnum (Foreground (Rgb _ _ _))"
  fromEnum (Background (Rgb Word8
_ Word8
_ Word8
_)) = String -> Int
forall a. HasCallStack => String -> a
error String
"Internal error: fromEnum (Background (Rgb _ _ _))"
  fromEnum (Foreground Colour
c) = Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Colour -> Int
forall a. Enum a => a -> Int
fromEnum Colour
c
  fromEnum (Background Colour
c) = Int
40 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Colour -> Int
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
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["
                       String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
";" ((Highlight -> [String]) -> [Highlight] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TerminalType -> Highlight -> [String]
renderAttrG TerminalType
tt) [Highlight]
attrs))
                       String -> String -> String
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", Integer -> String
forall a. Show a => a -> String
show ( Word8 -> Word8 -> Word8 -> Integer
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", Integer -> String
forall a. Show a => a -> String
show ( Word8 -> Word8 -> Word8 -> Integer
forall t. Integral t => Word8 -> Word8 -> Word8 -> t
rgb24bit_to_xterm256 Word8
r Word8
g Word8
b ) ]
renderAttrG TerminalType
_ Highlight
a                                         = 
    [ Int -> String
forall a. Show a => a -> String
show (Highlight -> Int
forall a. Enum a => a -> Int
fromEnum (Highlight -> Highlight
hlProjectToBasicColour8 Highlight
a)) ]

-- | An infinite supply of colours.
colourCycle :: [Colour]
colourCycle :: [Colour]
colourCycle = [Colour] -> [Colour]
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["String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
startString -> String -> String
forall a. [a] -> [a] -> [a]
++Char
';'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show Int
endString -> String -> String
forall 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"