175 lines
4.8 KiB
Haskell
175 lines
4.8 KiB
Haskell
{-# LANGUAGE BangPatterns #-}
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE RebindableSyntax #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
-- |
|
|
-- Module : Basement.Terminal.ANSI
|
|
-- License : BSD-style
|
|
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
|
--
|
|
-- ANSI Terminal escape for cursor and attributes manipulations
|
|
--
|
|
-- On Unix system, it should be supported by most terminal emulators.
|
|
--
|
|
-- On Windows system, all escape sequences are empty for maximum
|
|
-- compatibility purpose, and easy implementation. newer version
|
|
-- of Windows 10 supports ANSI escape now, but we'll need
|
|
-- some kind of detection.
|
|
--
|
|
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Basement.Terminal.ANSI
|
|
(
|
|
-- * Types
|
|
Escape
|
|
, Displacement
|
|
, ColorComponent
|
|
, GrayComponent
|
|
, RGBComponent
|
|
-- * Simple ANSI escape factory functions
|
|
, 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
|
|
|
|
-- | Simple color component on 8 color terminal (maximum compatibility)
|
|
type ColorComponent = Zn64 8
|
|
|
|
-- | Gray color compent on 256colors terminals
|
|
type GrayComponent = Zn64 24
|
|
|
|
-- | Color compent on 256colors terminals
|
|
type RGBComponent = Zn64 6
|
|
|
|
cursorUp, cursorDown, cursorForward, cursorBack
|
|
, cursorNextLine, cursorPrevLine
|
|
, cursorHorizontalAbsolute :: Displacement -> Escape
|
|
cursorUp n = csi1 n "A"
|
|
cursorDown n = csi1 n "B"
|
|
cursorForward n = csi1 n "C"
|
|
cursorBack n = csi1 n "D"
|
|
cursorNextLine n = csi1 n "E"
|
|
cursorPrevLine n = csi1 n "F"
|
|
cursorHorizontalAbsolute n = csi1 n "G"
|
|
|
|
cursorPosition :: Displacement -> Displacement -> Escape
|
|
cursorPosition row col = csi2 row col "H"
|
|
|
|
eraseScreenFromCursor
|
|
, eraseScreenToCursor
|
|
, eraseScreenAll
|
|
, eraseLineFromCursor
|
|
, eraseLineToCursor
|
|
, eraseLineAll :: Escape
|
|
eraseScreenFromCursor = csi1 0 "J"
|
|
eraseScreenToCursor = csi1 1 "J"
|
|
eraseScreenAll = csi1 2 "J"
|
|
eraseLineFromCursor = csi1 0 "K"
|
|
eraseLineToCursor = csi1 1 "K"
|
|
eraseLineAll = csi1 2 "K"
|
|
|
|
scrollUp, scrollDown :: Displacement -> Escape
|
|
scrollUp n = csi1 n "S"
|
|
scrollDown n = csi1 n "T"
|
|
|
|
-- | All attribute off
|
|
sgrReset :: Escape
|
|
sgrReset = csi1 0 "m"
|
|
|
|
-- | 8 Colors + Bold attribute for foreground
|
|
sgrForeground :: ColorComponent -> Bool -> Escape
|
|
sgrForeground n bold
|
|
| bold = csi2 (30+unZn64 n) 1 "m"
|
|
| otherwise = csi1 (30+unZn64 n) "m"
|
|
|
|
-- | 8 Colors + Bold attribute for background
|
|
sgrBackground :: ColorComponent -> Bool -> Escape
|
|
sgrBackground n bold
|
|
| bold = csi2 (40+unZn64 n) 1 "m"
|
|
| otherwise = csi1 (40+unZn64 n) "m"
|
|
|
|
-- 256 colors mode
|
|
|
|
sgrForegroundGray24, sgrBackgroundGray24 :: GrayComponent -> Escape
|
|
sgrForegroundGray24 v = csi3 38 5 (0xE8 + unZn64 v) "m"
|
|
sgrBackgroundGray24 v = csi3 48 5 (0xE8 + unZn64 v) "m"
|
|
|
|
sgrForegroundColor216 :: RGBComponent -- ^ Red component
|
|
-> RGBComponent -- ^ Green component
|
|
-> RGBComponent -- ^ Blue component
|
|
-> Escape
|
|
sgrForegroundColor216 r g b = csi3 38 5 (0x10 + 36 * unZn64 r + 6 * unZn64 g + unZn64 b) "m"
|
|
|
|
sgrBackgroundColor216 :: RGBComponent -- ^ Red component
|
|
-> RGBComponent -- ^ Green component
|
|
-> RGBComponent -- ^ Blue component
|
|
-> Escape
|
|
sgrBackgroundColor216 r g b = csi3 48 5 (0x10 + 36 * unZn64 r + 6 * unZn64 g + unZn64 b) "m"
|
|
|
|
#ifdef SUPPORT_ANSI_ESCAPE
|
|
|
|
csi0 :: String -> String
|
|
csi0 suffix = mconcat ["\ESC[", suffix]
|
|
|
|
csi1 :: Displacement -> String -> String
|
|
csi1 p1 suffix = mconcat ["\ESC[", pshow p1, suffix]
|
|
|
|
csi2 :: Displacement -> Displacement -> String -> String
|
|
csi2 p1 p2 suffix = mconcat ["\ESC[", pshow p1, ";", pshow p2, suffix]
|
|
|
|
csi3 :: Displacement -> Displacement -> Displacement -> String -> String
|
|
csi3 p1 p2 p3 suffix = mconcat ["\ESC[", pshow p1, ";", pshow p2, ";", pshow p3, suffix]
|
|
|
|
pshow = 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
|