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

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

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

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

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

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

-- 256 colors mode

sgrForegroundGray24, sgrBackgroundGray24 :: GrayComponent -> Escape
sgrForegroundGray24 :: GrayComponent -> String
sgrForegroundGray24 GrayComponent
v = Displacement -> Displacement -> Displacement -> String -> String
csi3 Displacement
38 Displacement
5 (Displacement
0xE8 forall a. Additive a => a -> a -> a
+ forall (n :: Nat). Zn64 n -> Displacement
unZn64 GrayComponent
v) String
"m"
sgrBackgroundGray24 :: GrayComponent -> String
sgrBackgroundGray24 GrayComponent
v = Displacement -> Displacement -> Displacement -> String -> String
csi3 Displacement
48 Displacement
5 (Displacement
0xE8 forall a. Additive a => a -> a -> a
+ forall (n :: Nat). Zn64 n -> Displacement
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 = Displacement -> Displacement -> Displacement -> String -> String
csi3 Displacement
38 Displacement
5 (Displacement
0x10 forall a. Additive a => a -> a -> a
+ Displacement
36 forall a. Multiplicative a => a -> a -> a
* forall (n :: Nat). Zn64 n -> Displacement
unZn64 RGBComponent
r forall a. Additive a => a -> a -> a
+ Displacement
6 forall a. Multiplicative a => a -> a -> a
* forall (n :: Nat). Zn64 n -> Displacement
unZn64 RGBComponent
g forall a. Additive a => a -> a -> a
+ forall (n :: Nat). Zn64 n -> Displacement
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 = Displacement -> Displacement -> Displacement -> String -> String
csi3 Displacement
48 Displacement
5 (Displacement
0x10 forall a. Additive a => a -> a -> a
+ Displacement
36 forall a. Multiplicative a => a -> a -> a
* forall (n :: Nat). Zn64 n -> Displacement
unZn64 RGBComponent
r forall a. Additive a => a -> a -> a
+ Displacement
6 forall a. Multiplicative a => a -> a -> a
* forall (n :: Nat). Zn64 n -> Displacement
unZn64 RGBComponent
g forall a. Additive a => a -> a -> a
+ forall (n :: Nat). Zn64 n -> Displacement
unZn64 RGBComponent
b) String
"m"

#ifdef SUPPORT_ANSI_ESCAPE

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

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

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

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

pshow :: Displacement -> String
pshow = 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