{-# 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 n :: Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n "A"
cursorDown :: Displacement -> Escape
cursorDown n :: Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n "B"
cursorForward :: Displacement -> Escape
cursorForward n :: Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n "C"
cursorBack :: Displacement -> Escape
cursorBack n :: Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n "D"
cursorNextLine :: Displacement -> Escape
cursorNextLine n :: Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n "E"
cursorPrevLine :: Displacement -> Escape
cursorPrevLine n :: Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n "F"
cursorHorizontalAbsolute :: Displacement -> Escape
cursorHorizontalAbsolute n :: Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n "G"
cursorPosition :: Displacement -> Displacement -> Escape
cursorPosition :: Displacement -> Displacement -> Escape
cursorPosition row :: Displacement
row col :: Displacement
col = Displacement -> Displacement -> Escape -> Escape
csi2 Displacement
row Displacement
col "H"
eraseScreenFromCursor
, eraseScreenToCursor
, eraseScreenAll
, eraseLineFromCursor
, eraseLineToCursor
, eraseLineAll :: Escape
eraseScreenFromCursor :: Escape
eraseScreenFromCursor = Displacement -> Escape -> Escape
csi1 0 "J"
eraseScreenToCursor :: Escape
eraseScreenToCursor = Displacement -> Escape -> Escape
csi1 1 "J"
eraseScreenAll :: Escape
eraseScreenAll = Displacement -> Escape -> Escape
csi1 2 "J"
eraseLineFromCursor :: Escape
eraseLineFromCursor = Displacement -> Escape -> Escape
csi1 0 "K"
eraseLineToCursor :: Escape
eraseLineToCursor = Displacement -> Escape -> Escape
csi1 1 "K"
eraseLineAll :: Escape
eraseLineAll = Displacement -> Escape -> Escape
csi1 2 "K"
scrollUp, scrollDown :: Displacement -> Escape
scrollUp :: Displacement -> Escape
scrollUp n :: Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n "S"
scrollDown :: Displacement -> Escape
scrollDown n :: Displacement
n = Displacement -> Escape -> Escape
csi1 Displacement
n "T"
sgrReset :: Escape
sgrReset :: Escape
sgrReset = Displacement -> Escape -> Escape
csi1 0 "m"
sgrForeground :: ColorComponent -> Bool -> Escape
sgrForeground :: ColorComponent -> Bool -> Escape
sgrForeground n :: ColorComponent
n bold :: Bool
bold
| Bool
bold = Displacement -> Displacement -> Escape -> Escape
csi2 (30Displacement -> Displacement -> Displacement
forall a. Additive a => a -> a -> a
+ColorComponent -> Displacement
forall (n :: Nat). Zn64 n -> Displacement
unZn64 ColorComponent
n) 1 "m"
| Bool
otherwise = Displacement -> Escape -> Escape
csi1 (30Displacement -> Displacement -> Displacement
forall a. Additive a => a -> a -> a
+ColorComponent -> Displacement
forall (n :: Nat). Zn64 n -> Displacement
unZn64 ColorComponent
n) "m"
sgrBackground :: ColorComponent -> Bool -> Escape
sgrBackground :: ColorComponent -> Bool -> Escape
sgrBackground n :: ColorComponent
n bold :: Bool
bold
| Bool
bold = Displacement -> Displacement -> Escape -> Escape
csi2 (40Displacement -> Displacement -> Displacement
forall a. Additive a => a -> a -> a
+ColorComponent -> Displacement
forall (n :: Nat). Zn64 n -> Displacement
unZn64 ColorComponent
n) 1 "m"
| Bool
otherwise = Displacement -> Escape -> Escape
csi1 (40Displacement -> Displacement -> Displacement
forall a. Additive a => a -> a -> a
+ColorComponent -> Displacement
forall (n :: Nat). Zn64 n -> Displacement
unZn64 ColorComponent
n) "m"
sgrForegroundGray24, sgrBackgroundGray24 :: GrayComponent -> Escape
sgrForegroundGray24 :: GrayComponent -> Escape
sgrForegroundGray24 v :: GrayComponent
v = Displacement -> Displacement -> Displacement -> Escape -> Escape
csi3 38 5 (0xE8 Displacement -> Displacement -> Displacement
forall a. Additive a => a -> a -> a
+ GrayComponent -> Displacement
forall (n :: Nat). Zn64 n -> Displacement
unZn64 GrayComponent
v) "m"
sgrBackgroundGray24 :: GrayComponent -> Escape
sgrBackgroundGray24 v :: GrayComponent
v = Displacement -> Displacement -> Displacement -> Escape -> Escape
csi3 48 5 (0xE8 Displacement -> Displacement -> Displacement
forall a. Additive a => a -> a -> a
+ GrayComponent -> Displacement
forall (n :: Nat). Zn64 n -> Displacement
unZn64 GrayComponent
v) "m"
sgrForegroundColor216 :: RGBComponent
-> RGBComponent
-> RGBComponent
-> Escape
sgrForegroundColor216 :: RGBComponent -> RGBComponent -> RGBComponent -> Escape
sgrForegroundColor216 r :: RGBComponent
r g :: RGBComponent
g b :: RGBComponent
b = Displacement -> Displacement -> Displacement -> Escape -> Escape
csi3 38 5 (0x10 Displacement -> Displacement -> Displacement
forall a. Additive a => a -> a -> a
+ 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
+ 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) "m"
sgrBackgroundColor216 :: RGBComponent
-> RGBComponent
-> RGBComponent
-> Escape
sgrBackgroundColor216 :: RGBComponent -> RGBComponent -> RGBComponent -> Escape
sgrBackgroundColor216 r :: RGBComponent
r g :: RGBComponent
g b :: RGBComponent
b = Displacement -> Displacement -> Displacement -> Escape -> Escape
csi3 48 5 (0x10 Displacement -> Displacement -> Displacement
forall a. Additive a => a -> a -> a
+ 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
+ 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) "m"
#ifdef SUPPORT_ANSI_ESCAPE
csi0 :: String -> String
csi0 :: Escape -> Escape
csi0 suffix :: Escape
suffix = [Escape] -> Escape
forall a. Monoid a => [a] -> a
mconcat ["\ESC[", Escape
suffix]
csi1 :: Displacement -> String -> String
csi1 :: Displacement -> Escape -> Escape
csi1 p1 :: Displacement
p1 suffix :: Escape
suffix = [Escape] -> Escape
forall a. Monoid a => [a] -> a
mconcat ["\ESC[", Displacement -> Escape
pshow Displacement
p1, Escape
suffix]
csi2 :: Displacement -> Displacement -> String -> String
csi2 :: Displacement -> Displacement -> Escape -> Escape
csi2 p1 :: Displacement
p1 p2 :: Displacement
p2 suffix :: Escape
suffix = [Escape] -> Escape
forall a. Monoid a => [a] -> a
mconcat ["\ESC[", Displacement -> Escape
pshow Displacement
p1, ";", Displacement -> Escape
pshow Displacement
p2, Escape
suffix]
csi3 :: Displacement -> Displacement -> Displacement -> String -> String
csi3 :: Displacement -> Displacement -> Displacement -> Escape -> Escape
csi3 p1 :: Displacement
p1 p2 :: Displacement
p2 p3 :: Displacement
p3 suffix :: Escape
suffix = [Escape] -> Escape
forall a. Monoid a => [a] -> a
mconcat ["\ESC[", Displacement -> Escape
pshow Displacement
p1, ";", Displacement -> Escape
pshow Displacement
p2, ";", 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