1module Main
2  (
3    main
4  ) where
5
6import Control.Concurrent (threadDelay)
7import Control.Monad (forM_)
8import System.IO (hFlush, stdout)
9
10import System.Console.ANSI
11
12examples :: [IO ()]
13examples = [ cursorMovementExample
14           , lineChangeExample
15           , setCursorPositionExample
16           , saveRestoreCursorExample
17           , clearExample
18           , scrollExample
19           , sgrExample
20           , cursorVisibilityExample
21           , titleExample
22           , getCursorPositionExample
23           ]
24
25main :: IO ()
26main = mapM_ (\example -> resetScreen >> example) examples
27
28-- Annex D to Standard ECMA-48 (5th Ed, 1991) identifies that the representation
29-- of an erased state is implementation-dependent. There may or may not be a
30-- distinction between a character position in the erased state and one imaging
31-- SPACE. Consequently, to reset the screen, the default graphic rendition must
32-- be selected (setSGR [Reset]) before all character positions are put into the
33-- erased state (clearScreen).
34resetScreen :: IO ()
35resetScreen = setSGR [Reset] >> clearScreen >> setCursorPosition 0 0
36
37pause :: IO ()
38pause = do
39  hFlush stdout
40  -- 1 second pause
41  threadDelay 1000000
42
43cursorMovementExample :: IO ()
44cursorMovementExample = do
45  putStrLn "Line One"
46  putStr "Line Two"
47  pause
48  -- Line One
49  -- Line Two
50
51  cursorUp 1
52  putStr " - Extras"
53  pause
54  -- Line One - Extras
55  -- Line Two
56
57  cursorBackward 2
58  putStr "zz"
59  pause
60  -- Line One - Extrzz
61  -- Line Two
62
63  cursorForward 2
64  putStr "- And More"
65  pause
66  -- Line One - Extrzz  - And More
67  -- Line Two
68
69  cursorDown 1
70  putStr "Disconnected"
71  pause
72  -- Line One - Extrzz  - And More
73  -- Line Two                     Disconnected
74
75lineChangeExample :: IO ()
76lineChangeExample = do
77  putStrLn "Line One"
78  putStr "Line Two"
79  pause
80  -- Line One
81  -- Line Two
82
83  cursorUpLine 1
84  putStr "New Line One"
85  pause
86  -- New Line One
87  -- Line Two
88
89  cursorDownLine 1
90  putStr "New Line Two"
91  pause
92  -- New Line One
93  -- New Line Two
94
95setCursorPositionExample :: IO ()
96setCursorPositionExample = do
97  putStrLn "Line One"
98  putStrLn "Line Two"
99  pause
100  -- Line One
101  -- Line Two
102
103  setCursorPosition 0 5
104  putStr "Foo"
105  pause
106  -- Line Foo
107  -- Line Two
108
109  setCursorPosition 1 5
110  putStr "Bar"
111  pause
112  -- Line Foo
113  -- Line Bar
114
115  setCursorColumn 1
116  putStr "oaf"
117  pause
118  -- Line Foo
119  -- Loaf Bar
120
121saveRestoreCursorExample :: IO ()
122saveRestoreCursorExample = do
123  putStr "Start sentence ..."
124  pause
125  -- Start sentence ...
126
127  saveCursor
128  setCursorPosition 2 3
129  putStr "SPLASH!"
130  pause
131  -- Start sentence ...
132  --
133  --    SPLASH!
134
135  restoreCursor
136  putStr " end sentence, uninterrupted."
137  pause
138  -- Start sentence ... end sentence, uninterrupted
139  --
140  --    SPLASH!
141
142clearExample :: IO ()
143clearExample = do
144  putStrLn "Line One"
145  putStrLn "Line Two"
146  pause
147  -- Line One
148  -- Line Two
149
150  setCursorPosition 0 4
151  clearFromCursorToScreenEnd
152  pause
153  -- Line
154
155  resetScreen
156  putStrLn "Line One"
157  putStrLn "Line Two"
158  pause
159  -- Line One
160  -- Line Two
161
162  setCursorPosition 1 4
163  clearFromCursorToScreenBeginning
164  pause
165  --
166  --     Two
167
168  resetScreen
169  putStrLn "Line One"
170  putStrLn "Line Two"
171  pause
172  -- Line One
173  -- Line Two
174
175  setCursorPosition 0 4
176  clearFromCursorToLineEnd
177  pause
178  -- Line
179  -- Line Two
180
181  setCursorPosition 1 4
182  clearFromCursorToLineBeginning
183  pause
184  -- Line
185  --      Two
186
187  clearLine
188  pause
189  -- Line
190
191  clearScreen
192  pause
193  --
194
195scrollExample :: IO ()
196scrollExample = do
197  putStrLn "Line One"
198  putStrLn "Line Two"
199  putStrLn "Line Three"
200  pause
201  -- Line One
202  -- Line Two
203  -- Line Three
204
205  scrollPageDown 2
206  pause
207  --
208  --
209  -- Line One
210  -- Line Two
211  -- Line Three
212
213  scrollPageUp 3
214  pause
215  -- Line Two
216  -- Line Three
217
218sgrExample :: IO ()
219sgrExample = do
220  let colors = enumFromTo minBound maxBound :: [Color]
221  forM_ [Foreground, Background] $ \layer ->  do
222    forM_ [Dull, Vivid] $ \intensity -> do
223      resetScreen
224      forM_ colors $ \color -> do
225        setSGR [Reset]
226        setSGR [SetColor layer intensity color]
227        putStrLn (show color)
228      pause
229  -- All the colors, 4 times in sequence
230
231  let named_styles = [ (SetConsoleIntensity BoldIntensity, "Bold")
232                     , (SetConsoleIntensity FaintIntensity, "Faint")
233                     , (SetConsoleIntensity NormalIntensity, "Normal")
234                     , (SetItalicized True, "Italic")
235                     , (SetItalicized False, "No Italics")
236                     , (SetUnderlining SingleUnderline, "Single Underline")
237                     , (SetUnderlining DoubleUnderline, "Double Underline")
238                     , (SetUnderlining NoUnderline, "No Underline")
239                     , (SetBlinkSpeed SlowBlink, "Slow Blink")
240                     , (SetBlinkSpeed RapidBlink, "Rapid Blink")
241                     , (SetBlinkSpeed NoBlink, "No Blink")
242                     , (SetVisible False, "Conceal")
243                     , (SetVisible True, "Reveal")
244                     ]
245  forM_ named_styles $ \(style, name) -> do
246    resetScreen
247    setSGR [style]
248    putStrLn name
249    pause
250  -- Text describing a style displayed in that style in sequence
251
252  setSGR [SetColor Foreground Vivid Red]
253  setSGR [SetColor Background Vivid Blue]
254
255  clearScreen >> setCursorPosition 0 0
256  setSGR [SetSwapForegroundBackground False]
257  putStr "Red-On-Blue"
258  pause
259  -- Red-On-Blue
260
261  clearScreen >> setCursorPosition 0 0
262  setSGR [SetSwapForegroundBackground True]
263  putStr "Blue-On-Red"
264  pause
265  -- Blue-On-Red
266
267cursorVisibilityExample :: IO ()
268cursorVisibilityExample = do
269  putStr "Cursor Demo"
270  pause
271  -- Cursor Demo|
272
273  hideCursor
274  pause
275  -- Cursor Demo
276
277  showCursor
278  pause
279  -- Cursor Demo|
280
281titleExample :: IO ()
282titleExample = do
283  putStr "Title Demo"
284  pause
285  -- ~/foo/ - ansi-terminal-ex - 83x70
286  ------------------------------------
287  -- Title Demo
288
289  setTitle "Yup, I'm a new title!"
290  pause
291  -- Yup, I'm a new title! - ansi-terminal-ex - 83x70
292  ---------------------------------------------------
293  -- Title Demo
294
295getCursorPositionExample :: IO ()
296getCursorPositionExample = do
297  putStrLn "         11111111112222222222"
298  putStrLn "12345678901234567890123456789"
299  putStr   "Report cursor position here:"
300  pause
301  --          11111111112222222222
302  -- 12345678901234567890123456789
303  -- Report cursor position here:|
304  result <- getCursorPosition0
305  putStrLn " (3rd row, 29th column) to stdin, as CSI 3 ; 29 R.\n"
306  case result of
307    Just (row, col) -> putStrLn $ "The cursor was at row number " ++
308      show (row + 1) ++ " and column number " ++ show (col + 1) ++ ".\n"
309    Nothing -> putStrLn "Error: unable to get the cursor position\n"
310  pause
311  --          11111111112222222222
312  -- 12345678901234567890123456789
313  -- Report cursor position here: (3rd row, 29th column) to stdin, as CSI 3 ; 29 R.
314  --
315  -- The cursor was at row number 3 and column number 29.
316