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