{-# 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 -> 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"
sgrReset :: Escape
sgrReset :: String
sgrReset = Displacement -> String -> String
csi1 Displacement
0 String
"m"
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"
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"
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
-> RGBComponent
-> RGBComponent
-> 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
-> RGBComponent
-> RGBComponent
-> 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