-- | This module provides functions to obtain VT escape sequences for the Windows platform

module Graphics.Vty.Platform.Windows.WindowsCapabilities
    ( getStringCapability,
      getIntCapability
    ) where

import qualified Data.Map as M

-- | Lookup for terminal capabilities that have a string value.

-- All Windows supported escape sequences are described here:

-- https://learn.microsoft.com/en-us/windows/console/console-virtual-terminal-sequences

getStringCapability :: String -> Maybe String
getStringCapability :: String -> Maybe String
getStringCapability String
cap = String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
cap Map String String
windowsStringCaps

-- | Lookup a terminal capability that has an integer value

getIntCapability :: String -> Maybe Int
getIntCapability :: String -> Maybe Int
getIntCapability String
cap = String -> Map String Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
cap Map String Int
windowsIntCaps

esc :: String -> String
esc :: String -> String
esc String
code = Char
'\ESC' Char -> String -> String
forall a. a -> [a] -> [a]
: String
code

csi :: String -> String
csi :: String -> String
csi String
code = String -> String
esc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char
'[' Char -> String -> String
forall a. a -> [a] -> [a]
: String
code

-- | Mapping of capability names to VT escape sequences for the Windows platform

-- All Windows supported escape sequences are described here:

-- https://learn.microsoft.com/en-us/windows/console/console-virtual-terminal-sequences

windowsStringCaps :: M.Map String String
windowsStringCaps :: Map String String
windowsStringCaps = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (String
"sgr0", String -> String
csi String
"0m")   -- reset styles and colors

    , (String
"bold", String -> String
csi String
"1m")   -- set bold style

    , (String
"dim", String -> String
csi String
"2m")    -- set dim style

    , (String
"sitm", String -> String
csi String
"3m")   -- set italic style

    , (String
"smul", String -> String
csi String
"4m")   -- set underline style

    , (String
"rev", String -> String
csi String
"7m")    -- set reverse video mode (reverse foreground/background colors)

    , (String
"invis", String -> String
csi String
"8m")  -- set hidden text style

    , (String
"smxx", String -> String
csi String
"9m")   -- set strike-through style

    , (String
"ritm", String -> String
csi String
"23m")  -- exit italic mode

    , (String
"rmul", String -> String
csi String
"24m")  -- exit underline mode

    , (String
"rmso", String -> String
csi String
"27m")  -- exit reverse video mode

    , (String
"rmxx", String -> String
csi String
"29m")  -- exit strikethrough mode

    , (String
"clear", String -> String
csi String
"H" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
csi String
"J")   -- move cursor to home row, then clear from cursor to end of screen (whole screen)

    , (String
"cup", String -> String
csi String
"%i%p1%d;%p2%dH")
    , (String
"civis", String -> String
csi String
"?25l")
    , (String
"cnorm", String -> String
csi String
"?25h")
    , (String
"home", String -> String
csi String
"H")
    , (String
"ed", String -> String
csi String
"J")
    , (String
"el", String -> String
csi String
"K")
    , (String
"kbs", String
"^H")
    , (String
"setab", String -> String
csi String
"%?%p1%{8}%<%t4%p1%d%e%p1%{16}%<%t10%p1%{8}%-%d%e48;5;%p1%d%;m")
    , (String
"setaf", String -> String
csi String
"%?%p1%{8}%<%t3%p1%d%e%p1%{16}%<%t9%p1%{8}%-%d%e38;5;%p1%d%;m")
    , (String
"sgr", String -> String
csi String
"0%?%p6%t;1%;%?%p2%t;4%;%?%p1%p3%|%t;7%;%?%p4%t;5%;%?%p5%t;2%;%?%p7%t;8%;m")
    , (String
"smcup", String -> String
csi String
"?1049h")   -- switch to the alternate screen buffer

    , (String
"rmcup", String -> String
csi String
"?1049l")   -- exit the alternate screen buffer

    ]

windowsIntCaps :: M.Map String Int
windowsIntCaps :: Map String Int
windowsIntCaps = [(String, Int)] -> Map String Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList 
    [ (String
"colors", Int
256)
    ]