Initial commit

2026-01-25 02:27:22 +01:00 · 2026-01-25 02:27:22 +01:00 · c101616e62
commit c101616e62
309 changed files with 53937 additions and 0 deletions
--- a/bundled/Basement/Terminal/ANSI.hs
+++ b/bundled/Basement/Terminal/ANSI.hs
@ -0,0 +1,175 @@
+{-# 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