1-- |
2-- Module      : Basement.Terminal.ANSI
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5--
6-- ANSI Terminal escape for cursor and attributes manipulations
7--
8-- On Unix system, it should be supported by most terminal emulators.
9--
10-- On Windows system, all escape sequences are empty for maximum
11-- compatibility purpose, and easy implementation. newer version
12-- of Windows 10 supports ANSI escape now, but we'll need
13-- some kind of detection.
14--
15{-# LANGUAGE CPP #-}
16{-# LANGUAGE DataKinds #-}
17{-# LANGUAGE OverloadedStrings #-}
18module Basement.Terminal.ANSI
19    (
20    -- * Types
21      Escape
22    , Displacement
23    , ColorComponent
24    , GrayComponent
25    , RGBComponent
26    -- * Simple ANSI escape factory functions
27    , cursorUp
28    , cursorDown
29    , cursorForward
30    , cursorBack
31    , cursorNextLine
32    , cursorPrevLine
33    , cursorHorizontalAbsolute
34    , cursorPosition
35    , eraseScreenFromCursor
36    , eraseScreenToCursor
37    , eraseScreenAll
38    , eraseLineFromCursor
39    , eraseLineToCursor
40    , eraseLineAll
41    , scrollUp
42    , scrollDown
43    , sgrReset
44    , sgrForeground
45    , sgrBackground
46    , sgrForegroundGray24
47    , sgrBackgroundGray24
48    , sgrForegroundColor216
49    , sgrBackgroundColor216
50    ) where
51
52import Basement.String
53import Basement.Bounded
54import Basement.Imports
55import Basement.Numerical.Multiplicative
56import Basement.Numerical.Additive
57
58#ifndef mingw32_HOST_OS
59#define SUPPORT_ANSI_ESCAPE
60#endif
61
62type Escape = String
63
64type Displacement = Word64
65
66-- | Simple color component on 8 color terminal (maximum compatibility)
67type ColorComponent = Zn64 8
68
69-- | Gray color compent on 256colors terminals
70type GrayComponent = Zn64 24
71
72-- | Color compent on 256colors terminals
73type RGBComponent = Zn64 6
74
75cursorUp, cursorDown, cursorForward, cursorBack
76    , cursorNextLine, cursorPrevLine
77    , cursorHorizontalAbsolute :: Displacement -> Escape
78cursorUp n = csi1 n "A"
79cursorDown n = csi1 n "B"
80cursorForward n = csi1 n "C"
81cursorBack n = csi1 n "D"
82cursorNextLine n = csi1 n "E"
83cursorPrevLine n = csi1 n "F"
84cursorHorizontalAbsolute n = csi1 n "G"
85
86cursorPosition :: Displacement -> Displacement -> Escape
87cursorPosition row col = csi2 row col "H"
88
89eraseScreenFromCursor
90    , eraseScreenToCursor
91    , eraseScreenAll
92    , eraseLineFromCursor
93    , eraseLineToCursor
94    , eraseLineAll :: Escape
95eraseScreenFromCursor = csi1 0 "J"
96eraseScreenToCursor = csi1 1 "J"
97eraseScreenAll = csi1 2 "J"
98eraseLineFromCursor = csi1 0 "K"
99eraseLineToCursor = csi1 1 "K"
100eraseLineAll = csi1 2 "K"
101
102scrollUp, scrollDown :: Displacement -> Escape
103scrollUp n = csi1 n "S"
104scrollDown n = csi1 n "T"
105
106-- | All attribute off
107sgrReset :: Escape
108sgrReset = csi1 0 "m"
109
110-- | 8 Colors + Bold attribute for foreground
111sgrForeground :: ColorComponent -> Bool -> Escape
112sgrForeground n bold
113    | bold      = csi2 (30+unZn64 n) 1 "m"
114    | otherwise = csi1 (30+unZn64 n) "m"
115
116-- | 8 Colors + Bold attribute for background
117sgrBackground :: ColorComponent -> Bool -> Escape
118sgrBackground n bold
119    | bold      = csi2 (40+unZn64 n) 1 "m"
120    | otherwise = csi1 (40+unZn64 n) "m"
121
122-- 256 colors mode
123
124sgrForegroundGray24, sgrBackgroundGray24 :: GrayComponent -> Escape
125sgrForegroundGray24 v = csi3 38 5 (0xE8 + unZn64 v) "m"
126sgrBackgroundGray24 v = csi3 48 5 (0xE8 + unZn64 v) "m"
127
128sgrForegroundColor216 :: RGBComponent -- ^ Red component
129                      -> RGBComponent -- ^ Green component
130                      -> RGBComponent -- ^ Blue component
131                      -> Escape
132sgrForegroundColor216 r g b = csi3 38 5 (0x10 + 36 * unZn64 r + 6 * unZn64 g + unZn64 b) "m"
133
134sgrBackgroundColor216 :: RGBComponent -- ^ Red component
135                      -> RGBComponent -- ^ Green component
136                      -> RGBComponent -- ^ Blue component
137                      -> Escape
138sgrBackgroundColor216 r g b = csi3 48 5 (0x10 + 36 * unZn64 r + 6 * unZn64 g + unZn64 b) "m"
139
140#ifdef SUPPORT_ANSI_ESCAPE
141
142csi0 :: String -> String
143csi0 suffix = mconcat ["\ESC[", suffix]
144
145csi1 :: Displacement -> String -> String
146csi1 p1 suffix = mconcat ["\ESC[", pshow p1, suffix]
147
148csi2 :: Displacement -> Displacement -> String -> String
149csi2 p1 p2 suffix = mconcat ["\ESC[", pshow p1, ";", pshow p2, suffix]
150
151csi3 :: Displacement -> Displacement -> Displacement -> String -> String
152csi3 p1 p2 p3 suffix = mconcat ["\ESC[", pshow p1, ";", pshow p2, ";", pshow p3, suffix]
153
154pshow = show
155
156#else
157
158csi0 :: String -> String
159csi0 _ = ""
160
161csi1 :: Displacement -> String -> String
162csi1 _ _ = ""
163
164csi2 :: Displacement -> Displacement -> String -> String
165csi2 _ _ _ = ""
166
167csi3 :: Displacement -> Displacement -> Displacement -> String -> String
168csi3 _ _ _ _ = ""
169
170#endif
171