-- |
-- Module      : Basement.Terminal.ANSI
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
--
-- ANSI Terminal escape for cursor and attributes manipulations
--
-- On Unix system, it should be supported by most terminal emulators.
--
-- On Windows system, all escape sequences are empty for maximum
-- compatibility purpose, and easy implementation. newer version
-- of Windows 10 supports ANSI escape now, but we'll need
-- some kind of detection.
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module Basement.Terminal.ANSI
    (
    -- * Types
      Escape
    , Displacement
    , ColorComponent
    , GrayComponent
    , RGBComponent
    -- * Simple ANSI escape factory functions
    , cursorUp
    , cursorDown
    , cursorForward
    , cursorBack
    , cursorNextLine
    , cursorPrevLine
    , cursorHorizontalAbsolute
    , cursorPosition
    , eraseScreenFromCursor
    , eraseScreenToCursor
    , eraseScreenAll
    , eraseLineFromCursor
    , eraseLineToCursor
    , eraseLineAll
    , scrollUp
    , scrollDown
    , sgrReset
    , sgrForeground
    , sgrBackground
    , sgrForegroundGray24
    , sgrBackgroundGray24
    , sgrForegroundColor216
    , sgrBackgroundColor216
    ) where

import Basement.String
import Basement.Bounded
import Basement.Imports
import Basement.Numerical.Multiplicative
import Basement.Numerical.Additive

#ifndef mingw32_HOST_OS
#define SUPPORT_ANSI_ESCAPE
#endif

type Escape = String

type Displacement = Word64

-- | Simple color component on 8 color terminal (maximum compatibility)
type ColorComponent = Zn64 8

-- | Gray color compent on 256colors terminals
type GrayComponent = Zn64 24

-- | Color compent on 256colors terminals
type RGBComponent = Zn64 6

cursorUp, cursorDown, cursorForward, cursorBack
    , cursorNextLine, cursorPrevLine
    , cursorHorizontalAbsolute :: Displacement -> Escape
cursorUp :: Word64 -> String
cursorUp Word64
n = Word64 -> String -> String
csi1 Word64
n String
"A"
cursorDown :: Word64 -> String
cursorDown Word64
n = Word64 -> String -> String
csi1 Word64
n String
"B"
cursorForward :: Word64 -> String
cursorForward Word64
n = Word64 -> String -> String
csi1 Word64
n String
"C"
cursorBack :: Word64 -> String
cursorBack Word64
n = Word64 -> String -> String
csi1 Word64
n String
"D"
cursorNextLine :: Word64 -> String
cursorNextLine Word64
n = Word64 -> String -> String
csi1 Word64
n String
"E"
cursorPrevLine :: Word64 -> String
cursorPrevLine Word64
n = Word64 -> String -> String
csi1 Word64
n String
"F"
cursorHorizontalAbsolute :: Word64 -> String
cursorHorizontalAbsolute Word64
n = Word64 -> String -> String
csi1 Word64
n String
"G"

cursorPosition :: Displacement -> Displacement -> Escape
cursorPosition :: Word64 -> Word64 -> String
cursorPosition Word64
row Word64
col = Word64 -> Word64 -> String -> String
csi2 Word64
row Word64
col String
"H"

eraseScreenFromCursor
    , eraseScreenToCursor
    , eraseScreenAll
    , eraseLineFromCursor
    , eraseLineToCursor
    , eraseLineAll :: Escape
eraseScreenFromCursor :: String
eraseScreenFromCursor = Word64 -> String -> String
csi1 Word64
0 String
"J"
eraseScreenToCursor :: String
eraseScreenToCursor = Word64 -> String -> String
csi1 Word64
1 String
"J"
eraseScreenAll :: String
eraseScreenAll = Word64 -> String -> String
csi1 Word64
2 String
"J"
eraseLineFromCursor :: String
eraseLineFromCursor = Word64 -> String -> String
csi1 Word64
0 String
"K"
eraseLineToCursor :: String
eraseLineToCursor = Word64 -> String -> String
csi1 Word64
1 String
"K"
eraseLineAll :: String
eraseLineAll = Word64 -> String -> String
csi1 Word64
2 String
"K"

scrollUp, scrollDown :: Displacement -> Escape
scrollUp :: Word64 -> String
scrollUp Word64
n = Word64 -> String -> String
csi1 Word64
n String
"S"
scrollDown :: Word64 -> String
scrollDown Word64
n = Word64 -> String -> String
csi1 Word64
n String
"T"

-- | All attribute off
sgrReset :: Escape
sgrReset :: String
sgrReset = Word64 -> String -> String
csi1 Word64
0 String
"m"

-- | 8 Colors + Bold attribute for foreground
sgrForeground :: ColorComponent -> Bool -> Escape
sgrForeground :: ColorComponent -> Bool -> String
sgrForeground ColorComponent
n Bool
bold
    | Bool
bold      = Word64 -> Word64 -> String -> String
csi2 (Word64
30Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ColorComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 ColorComponent
n) Word64
1 String
"m"
    | Bool
otherwise = Word64 -> String -> String
csi1 (Word64
30Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ColorComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 ColorComponent
n) String
"m"

-- | 8 Colors + Bold attribute for background
sgrBackground :: ColorComponent -> Bool -> Escape
sgrBackground :: ColorComponent -> Bool -> String
sgrBackground ColorComponent
n Bool
bold
    | Bool
bold      = Word64 -> Word64 -> String -> String
csi2 (Word64
40Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ColorComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 ColorComponent
n) Word64
1 String
"m" 
    | Bool
otherwise = Word64 -> String -> String
csi1 (Word64
40Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ColorComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 ColorComponent
n) String
"m"

-- 256 colors mode

sgrForegroundGray24, sgrBackgroundGray24 :: GrayComponent -> Escape
sgrForegroundGray24 :: GrayComponent -> String
sgrForegroundGray24 GrayComponent
v = Word64 -> Word64 -> Word64 -> String -> String
csi3 Word64
38 Word64
5 (Word64
0xE8 Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ GrayComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 GrayComponent
v) String
"m"
sgrBackgroundGray24 :: GrayComponent -> String
sgrBackgroundGray24 GrayComponent
v = Word64 -> Word64 -> Word64 -> String -> String
csi3 Word64
48 Word64
5 (Word64
0xE8 Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ GrayComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 GrayComponent
v) String
"m"

sgrForegroundColor216 :: RGBComponent -- ^ Red component
                      -> RGBComponent -- ^ Green component
                      -> RGBComponent -- ^ Blue component
                      -> Escape
sgrForegroundColor216 :: RGBComponent -> RGBComponent -> RGBComponent -> String
sgrForegroundColor216 RGBComponent
r RGBComponent
g RGBComponent
b = Word64 -> Word64 -> Word64 -> String -> String
csi3 Word64
38 Word64
5 (Word64
0x10 Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ Word64
36 Word64 -> Word64 -> Word64
forall a. Multiplicative a => a -> a -> a
* RGBComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 RGBComponent
r Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ Word64
6 Word64 -> Word64 -> Word64
forall a. Multiplicative a => a -> a -> a
* RGBComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 RGBComponent
g Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ RGBComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 RGBComponent
b) String
"m"

sgrBackgroundColor216 :: RGBComponent -- ^ Red component
                      -> RGBComponent -- ^ Green component
                      -> RGBComponent -- ^ Blue component
                      -> Escape
sgrBackgroundColor216 :: RGBComponent -> RGBComponent -> RGBComponent -> String
sgrBackgroundColor216 RGBComponent
r RGBComponent
g RGBComponent
b = Word64 -> Word64 -> Word64 -> String -> String
csi3 Word64
48 Word64
5 (Word64
0x10 Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ Word64
36 Word64 -> Word64 -> Word64
forall a. Multiplicative a => a -> a -> a
* RGBComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 RGBComponent
r Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ Word64
6 Word64 -> Word64 -> Word64
forall a. Multiplicative a => a -> a -> a
* RGBComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 RGBComponent
g Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ RGBComponent -> Word64
forall (n :: Nat). Zn64 n -> Word64
unZn64 RGBComponent
b) String
"m"

#ifdef SUPPORT_ANSI_ESCAPE

csi0 :: String -> String
csi0 :: String -> String
csi0 String
suffix = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"\ESC[", String
suffix]

csi1 :: Displacement -> String -> String
csi1 :: Word64 -> String -> String
csi1 Word64
p1 String
suffix = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"\ESC[", Word64 -> String
pshow Word64
p1, String
suffix]

csi2 :: Displacement -> Displacement -> String -> String
csi2 :: Word64 -> Word64 -> String -> String
csi2 Word64
p1 Word64
p2 String
suffix = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"\ESC[", Word64 -> String
pshow Word64
p1, String
";", Word64 -> String
pshow Word64
p2, String
suffix]

csi3 :: Displacement -> Displacement -> Displacement -> String -> String
csi3 :: Word64 -> Word64 -> Word64 -> String -> String
csi3 Word64
p1 Word64
p2 Word64
p3 String
suffix = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"\ESC[", Word64 -> String
pshow Word64
p1, String
";", Word64 -> String
pshow Word64
p2, String
";", Word64 -> String
pshow Word64
p3, String
suffix]

pshow :: Word64 -> String
pshow = Word64 -> String
forall a. Show a => a -> String
show

#else

csi0 :: String -> String
csi0 _ = ""

csi1 :: Displacement -> String -> String
csi1 _ _ = ""

csi2 :: Displacement -> Displacement -> String -> String
csi2 _ _ _ = ""

csi3 :: Displacement -> Displacement -> Displacement -> String -> String
csi3 _ _ _ _ = ""

#endif