-- | 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 (x :: Int
x,y :: Int
y) s :: 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 x :: Int
x y :: Int
y    = '\ESC'Char -> String -> String
forall a. a -> [a] -> [a]
:'['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 -> 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]
++ "H"))
home :: String
home        = Int -> Int -> String
goto 1 1

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

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

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


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

instance Enum Highlight where
  fromEnum :: Highlight -> Int
fromEnum Normal       = 0
  fromEnum Bold         = 1
  fromEnum Dim          = 2
  fromEnum Underscore   = 4
  fromEnum Blink        = 5
  fromEnum ReverseVideo = 7
  fromEnum Concealed    = 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 _ _ _)) = String -> Int
forall a. HasCallStack => String -> a
error "Internal error: fromEnum (Foreground (Rgb _ _ _))"
  fromEnum (Background (Rgb _ _ _)) = String -> Int
forall a. HasCallStack => String -> a
error "Internal error: fromEnum (Background (Rgb _ _ _))"
  fromEnum (Foreground c :: Colour
c) = 30 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Colour -> Int
forall a. Enum a => a -> Int
fromEnum Colour
c
  fromEnum (Background c :: Colour
c) = 40 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Colour -> Int
forall a. Enum a => a -> Int
fromEnum Colour
c
  fromEnum Italic       = 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 tt :: TerminalType
tt attrs :: [Highlight]
attrs s :: 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 tt :: TerminalType
tt []     = TerminalType -> [Highlight] -> String
highlightOnG TerminalType
tt [Highlight
Normal]
highlightOnG tt :: TerminalType
tt attrs :: [Highlight]
attrs  = "\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 ";" ((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]
++"m"
highlightOff ::  [Char]
highlightOff :: String
highlightOff = "\ESC[0m"

renderAttrG ::  TerminalType -> Highlight -> [String]
renderAttrG :: TerminalType -> Highlight -> [String]
renderAttrG XTerm256Compatible (Foreground (Rgb r :: Word8
r g :: Word8
g b :: Word8
b)) = 
    [ "38", "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 XTerm256Compatible (Background (Rgb r :: Word8
r g :: Word8
g b :: Word8
b)) = 
    [ "48", "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 _ a :: 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 start :: Int
start end :: Int
end = "\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 -> 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]
++"r"

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

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