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