-- | 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 List (intersperse,isPrefixOf)
import 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 -> Stringat (x :: Intx,y :: Inty) s :: Strings  = goto :: Int -> Int -> Stringgoto x :: Intx y :: Inty (++) :: [a] -> [a] -> [a]++ s :: Strings
goto :: Int -> Int -> Stringgoto x :: Intx y :: Inty    = '\ESC'(:) :: a -> [a] -> [a]:'['(:) :: a -> [a] -> [a]:(show :: Show a => a -> Stringshow y :: Inty (++) :: [a] -> [a] -> [a]++(';'(:) :: a -> [a] -> [a]:show :: Show a => a -> Stringshow x :: Intx (++) :: [a] -> [a] -> [a]++ "H"))
home :: Stringhome        = goto :: Int -> Int -> Stringgoto 1 1

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

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

savePosition :: [Char]savePosition    = "\ESC7"
restorePosition :: [Char]restorePosition = "\ESC8"


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

instance D:Enum ::
  (a -> a)
  -> (a -> a)
  -> (Int -> a)
  -> (a -> Int)
  -> (a -> [a])
  -> (a -> a -> [a])
  -> (a -> a -> [a])
  -> (a -> a -> a -> [a])
  -> T:Enum aEnum Highlight where
  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 _ _ _)) = error :: [Char] -> aerror "Internal error: fromEnum (Foreground (Rgb _ _ _))"
  fromEnum (Background (Rgb _ _ _)) = error :: [Char] -> aerror "Internal error: fromEnum (Background (Rgb _ _ _))"
  fromEnum (Foreground c :: Colourc) = 30 (+) :: Num a => a -> a -> a+ fromEnum :: Enum a => a -> IntfromEnum c :: Colourc
  fromEnum (Background c :: Colourc) = 40 (+) :: Num a => a -> a -> a+ fromEnum :: Enum a => a -> IntfromEnum c :: Colourc
  fromEnum Italic       = 2


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

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


-- | Make the given string appear with all of the listed highlights
highlightG :: TerminalType -> [Highlight] -> String -> String
highlightG :: TerminalType -> [Highlight] -> String -> StringhighlightG tt :: TerminalTypett attrs :: [Highlight]attrs s :: Strings = highlightOnG :: TerminalType -> [Highlight] -> StringhighlightOnG tt :: TerminalTypett attrs :: [Highlight]attrs (++) :: [a] -> [a] -> [a]++ s :: Strings (++) :: [a] -> [a] -> [a]++ highlightOff :: [Char]highlightOff

highlightOnG :: TerminalType -> [Highlight] -> String
highlightOnG :: TerminalType -> [Highlight] -> StringhighlightOnG tt :: TerminalTypett []     = highlightOnG :: TerminalType -> [Highlight] -> StringhighlightOnG tt :: TerminalTypett [Normal :: HighlightNormal]
highlightOnG tt :: TerminalTypett attrs :: [Highlight]attrs  = "\ESC["
                       (++) :: [a] -> [a] -> [a]++ concat :: [[a]] -> [a]concat (intersperse :: a -> [a] -> [a]intersperse ";" (concatMap :: (a -> [b]) -> [a] -> [b]concatMap (renderAttrG :: TerminalType -> Highlight -> [String]renderAttrG tt :: TerminalTypett) attrs :: [Highlight]attrs))
                       (++) :: [a] -> [a] -> [a]++"m"
highlightOff ::  [Char]
highlightOff :: [Char]highlightOff = "\ESC[0m"

renderAttrG ::  TerminalType -> Highlight -> [String]
renderAttrG :: TerminalType -> Highlight -> [String]renderAttrG XTerm256Compatible (Foreground (Rgb r :: Word8r g :: Word8g b :: Word8b)) = 
    [ "38", "5", show :: Show a => a -> Stringshow ( rgb24bit_to_xterm256 :: Integral t => Word8 -> Word8 -> Word8 -> trgb24bit_to_xterm256 r :: Word8r g :: Word8g b :: Word8b ) ]
renderAttrG XTerm256Compatible (Background (Rgb r :: Word8r g :: Word8g b :: Word8b)) = 
    [ "48", "5", show :: Show a => a -> Stringshow ( rgb24bit_to_xterm256 :: Integral t => Word8 -> Word8 -> Word8 -> trgb24bit_to_xterm256 r :: Word8r g :: Word8g b :: Word8b ) ]
renderAttrG _ a :: Highlighta                                         = 
    [ show :: Show a => a -> Stringshow (fromEnum :: Enum a => a -> IntfromEnum (hlProjectToBasicColour8 :: Highlight -> HighlighthlProjectToBasicColour8 a :: Highlighta)) ]

-- | An infinite supply of colours.
colourCycle :: [Colour]
colourCycle :: [Colour]colourCycle = cycle :: [a] -> [a]cycle [Red :: ColourRed,Blue :: ColourBlue,Magenta :: ColourMagenta,Green :: ColourGreen,Cyan :: ColourCyan]


-- | Scrolling
enableScrollRegion :: Int -> Int -> String
enableScrollRegion :: Int -> Int -> StringenableScrollRegion start :: Intstart end :: Intend = "\ESC["(++) :: [a] -> [a] -> [a]++show :: Show a => a -> Stringshow start :: Intstart(++) :: [a] -> [a] -> [a]++';'(:) :: a -> [a] -> [a]:show :: Show a => a -> Stringshow end :: Intend(++) :: [a] -> [a] -> [a]++"r"

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

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