-- |
-- 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 :: Displacement -> Escape
cursorUp Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n Escape
"A"
cursorDown :: Displacement -> Escape
cursorDown Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n Escape
"B"
cursorForward :: Displacement -> Escape
cursorForward Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n Escape
"C"
cursorBack :: Displacement -> Escape
cursorBack Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n Escape
"D"
cursorNextLine :: Displacement -> Escape
cursorNextLine Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n Escape
"E"
cursorPrevLine :: Displacement -> Escape
cursorPrevLine Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n Escape
"F"
cursorHorizontalAbsolute :: Displacement -> Escape
cursorHorizontalAbsolute Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n Escape
"G"

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

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

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

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

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

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

-- 256 colors mode

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

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

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

#ifdef SUPPORT_ANSI_ESCAPE

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

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

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

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

pshow :: Displacement -> Escape
pshow = Displacement -> Escape
forall a. Show a => a -> Escape
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