-- | This module exports functions that return 'String' values containing codes

-- in accordance with the \'ANSI\' standards for control character sequences

-- described in the documentation of module "System.Console.ANSI".

--

-- The module "System.Console.ANSI" exports functions with the same names as

-- those in this module. On some versions of Windows, the terminal in use may

-- not be ANSI-capable. When that is the case, the same-named functions exported

-- by module "System.Console.ANSI" return \"\", for the reasons set out in the

-- documentation of that module.

--

-- Consequently, if module "System.Console.ANSI" is also imported, this module

-- is intended to be imported qualified, to avoid name clashes with those

-- functions. For example:

--

-- > import qualified System.Console.ANSI.Codes as ANSI

--

module System.Console.ANSI.Codes
  (
    -- * Basic data types

    module System.Console.ANSI.Types

    -- * Cursor movement by character

  , cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode

    -- * Cursor movement by line

  , cursorUpLineCode, cursorDownLineCode

    -- * Directly changing cursor position

  , setCursorColumnCode, setCursorPositionCode

    -- * Saving, restoring and reporting cursor position

  , saveCursorCode, restoreCursorCode, reportCursorPositionCode

    -- * Clearing parts of the screen

  , clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode
  , clearScreenCode, clearFromCursorToLineEndCode
  , clearFromCursorToLineBeginningCode, clearLineCode

    -- * Scrolling the screen

  , scrollPageUpCode, scrollPageDownCode

    -- * Select Graphic Rendition mode: colors and other whizzy stuff

  , setSGRCode

    -- * Cursor visibilty changes

  , hideCursorCode, showCursorCode

    -- * Changing the title

    -- | Thanks to Brandon S. Allbery and Curt Sampson for pointing me in the

    -- right direction on xterm title setting on haskell-cafe. The "0"

    -- signifies that both the title and "icon" text should be set: i.e. the

    -- text for the window in the Start bar (or similar) as well as that in

    -- the actual window title. This is chosen for consistent behaviour

    -- between Unixes and Windows.

  , setTitleCode

    -- * Utilities

  , colorToCode, csi, sgrToCode
  ) where

import Data.List (intersperse)

import Data.Colour.SRGB (toSRGB24, RGB (..))

import System.Console.ANSI.Types

-- | 'csi' @parameters controlFunction@, where @parameters@ is a list of 'Int',

-- returns the control sequence comprising the control function CONTROL

-- SEQUENCE INTRODUCER (CSI) followed by the parameter(s) (separated by \';\')

-- and ending with the @controlFunction@ character(s) that identifies the

-- control function.

csi :: [Int]  -- ^ List of parameters for the control sequence

    -> String -- ^ Character(s) that identify the control function

    -> String
csi :: [Int] -> String -> String
csi args :: [Int]
args code :: String
code = "\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 ";" ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int]
args)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
code

-- | 'colorToCode' @color@ returns the 0-based index of the color (one of the

-- eight colors in the standard).

colorToCode :: Color -> Int
colorToCode :: Color -> Int
colorToCode color :: Color
color = case Color
color of
  Black   -> 0
  Red     -> 1
  Green   -> 2
  Yellow  -> 3
  Blue    -> 4
  Magenta -> 5
  Cyan    -> 6
  White   -> 7

-- | 'sgrToCode' @sgr@ returns the parameter of the SELECT GRAPHIC RENDITION

-- (SGR) aspect identified by @sgr@.

sgrToCode :: SGR -- ^ The SGR aspect

          -> [Int]
sgrToCode :: SGR -> [Int]
sgrToCode sgr :: SGR
sgr = case SGR
sgr of
  Reset -> [0]
  SetConsoleIntensity intensity :: ConsoleIntensity
intensity -> case ConsoleIntensity
intensity of
    BoldIntensity   -> [1]
    FaintIntensity  -> [2]
    NormalIntensity -> [22]
  SetItalicized True  -> [3]
  SetItalicized False -> [23]
  SetUnderlining underlining :: Underlining
underlining -> case Underlining
underlining of
    SingleUnderline -> [4]
    DoubleUnderline -> [21]
    NoUnderline     -> [24]
  SetBlinkSpeed blink_speed :: BlinkSpeed
blink_speed -> case BlinkSpeed
blink_speed of
    SlowBlink   -> [5]
    RapidBlink  -> [6]
    NoBlink     -> [25]
  SetVisible False -> [8]
  SetVisible True  -> [28]
  SetSwapForegroundBackground True  -> [7]
  SetSwapForegroundBackground False -> [27]
  SetColor Foreground Dull color :: Color
color  -> [30 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
  SetColor Foreground Vivid color :: Color
color -> [90 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
  SetColor Background Dull color :: Color
color  -> [40 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
  SetColor Background Vivid color :: Color
color -> [100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Color -> Int
colorToCode Color
color]
  SetRGBColor Foreground color :: Colour Float
color -> [38, 2] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Colour Float -> [Int]
forall b b. (Num b, RealFrac b, Floating b) => Colour b -> [b]
toRGB Colour Float
color
  SetRGBColor Background color :: Colour Float
color -> [48, 2] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Colour Float -> [Int]
forall b b. (Num b, RealFrac b, Floating b) => Colour b -> [b]
toRGB Colour Float
color
 where
  toRGB :: Colour b -> [b]
toRGB color :: Colour b
color = let RGB r :: Word8
r g :: Word8
g b :: Word8
b = Colour b -> RGB Word8
forall b. (RealFrac b, Floating b) => Colour b -> RGB Word8
toSRGB24 Colour b
color
                in  (Word8 -> b) -> [Word8] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8
r, Word8
g, Word8
b]

cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode
  :: Int -- ^ Number of lines or characters to move

  -> String
cursorUpCode :: Int -> String
cursorUpCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "A"
cursorDownCode :: Int -> String
cursorDownCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "B"
cursorForwardCode :: Int -> String
cursorForwardCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "C"
cursorBackwardCode :: Int -> String
cursorBackwardCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "D"

cursorDownLineCode, cursorUpLineCode :: Int -- ^ Number of lines to move

                                     -> String
cursorDownLineCode :: Int -> String
cursorDownLineCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "E"
cursorUpLineCode :: Int -> String
cursorUpLineCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "F"

-- | Code to move the cursor to the specified column. The column numbering is

-- 0-based (that is, the left-most column is numbered 0).

setCursorColumnCode :: Int -- ^ 0-based column to move to

                    -> String
setCursorColumnCode :: Int -> String
setCursorColumnCode n :: Int
n = [Int] -> String -> String
csi [Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1] "G"

-- | Code to move the cursor to the specified position (row and column). The

-- position is 0-based (that is, the top-left corner is at row 0 column 0).

setCursorPositionCode :: Int -- ^ 0-based row to move to

                      -> Int -- ^ 0-based column to move to

                      -> String
setCursorPositionCode :: Int -> Int -> String
setCursorPositionCode n :: Int
n m :: Int
m = [Int] -> String -> String
csi [Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1] "H"

-- | @since 0.7.1

saveCursorCode, restoreCursorCode :: String
saveCursorCode :: String
saveCursorCode = "\ESC7"
restoreCursorCode :: String
restoreCursorCode = "\ESC8"

-- | Code to emit the cursor position into the console input stream, immediately

-- after being recognised on the output stream, as:

-- @ESC [ \<cursor row> ; \<cursor column> R@

--

-- Note that the information that is emitted is 1-based (the top-left corner is

-- at row 1 column 1) but 'setCursorPositionCode' is 0-based.

--

-- In isolation of 'getReportedCursorPosition' or 'getCursorPosition0', this

-- function may be of limited use on Windows operating systems because of

-- difficulties in obtaining the data emitted into the console input stream.

-- The function 'hGetBufNonBlocking' in module "System.IO" does not work on

-- Windows. This has been attributed to the lack of non-blocking primatives in

-- the operating system (see the GHC bug report #806 at

-- <https://ghc.haskell.org/trac/ghc/ticket/806>).

--

-- @since 0.7.1

reportCursorPositionCode :: String

reportCursorPositionCode :: String
reportCursorPositionCode = [Int] -> String -> String
csi [] "6n"

clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode,
  clearScreenCode :: String
clearFromCursorToLineEndCode, clearFromCursorToLineBeginningCode,
  clearLineCode :: String

clearFromCursorToScreenEndCode :: String
clearFromCursorToScreenEndCode = [Int] -> String -> String
csi [0] "J"
clearFromCursorToScreenBeginningCode :: String
clearFromCursorToScreenBeginningCode = [Int] -> String -> String
csi [1] "J"
clearScreenCode :: String
clearScreenCode = [Int] -> String -> String
csi [2] "J"
clearFromCursorToLineEndCode :: String
clearFromCursorToLineEndCode = [Int] -> String -> String
csi [0] "K"
clearFromCursorToLineBeginningCode :: String
clearFromCursorToLineBeginningCode = [Int] -> String -> String
csi [1] "K"
clearLineCode :: String
clearLineCode = [Int] -> String -> String
csi [2] "K"

scrollPageUpCode, scrollPageDownCode :: Int -- ^ Number of lines to scroll by

                                     -> String
scrollPageUpCode :: Int -> String
scrollPageUpCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "S"
scrollPageDownCode :: Int -> String
scrollPageDownCode n :: Int
n = [Int] -> String -> String
csi [Int
n] "T"

setSGRCode :: [SGR] -- ^ Commands: these will typically be applied on top of the

                    -- current console SGR mode. An empty list of commands is

                    -- equivalent to the list @[Reset]@. Commands are applied

                    -- left to right.

           -> String
setSGRCode :: [SGR] -> String
setSGRCode sgrs :: [SGR]
sgrs = [Int] -> String -> String
csi ((SGR -> [Int]) -> [SGR] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SGR -> [Int]
sgrToCode [SGR]
sgrs) "m"

hideCursorCode, showCursorCode :: String
hideCursorCode :: String
hideCursorCode = [Int] -> String -> String
csi [] "?25l"
showCursorCode :: String
showCursorCode = [Int] -> String -> String
csi [] "?25h"


-- | XTerm control sequence to set the Icon Name and Window Title.

setTitleCode :: String -- ^ New Icon Name and Window Title

             -> String
setTitleCode :: String -> String
setTitleCode title :: String
title = "\ESC]0;" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\007') String
title String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\007"