{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module Basement.Terminal.ANSI
(
Escape
, Displacement
, ColorComponent
, GrayComponent
, RGBComponent
, 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
type ColorComponent = Zn64 8
type GrayComponent = Zn64 24
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"
sgrReset :: Escape
sgrReset :: Escape
sgrReset = Displacement -> Escape -> Escape
csi1 Displacement
0 Escape
"m"
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"
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"
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
-> RGBComponent
-> RGBComponent
-> 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
-> RGBComponent
-> RGBComponent
-> 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