-- | Input mappings for ANSI/VT100/VT50 terminals that is missing from
-- terminfo.
--
-- Or that are sent regardless of terminfo by terminal emulators. EG:
-- Terminal emulators will often use VT50 input bytes regardless of
-- declared terminal type. This provides compatibility with programs
-- that don't follow terminfo.
module Graphics.Vty.Input.Terminfo.ANSIVT where

import Graphics.Vty.Input.Events

-- | Encoding for navigation keys.
navKeys0 :: ClassifyMap
navKeys0 :: ClassifyMap
navKeys0 =
    [ [Char] -> Key -> ([Char], Event)
k "G" Key
KCenter
    , [Char] -> Key -> ([Char], Event)
k "P" Key
KPause
    , [Char] -> Key -> ([Char], Event)
k "A" Key
KUp
    , [Char] -> Key -> ([Char], Event)
k "B" Key
KDown
    , [Char] -> Key -> ([Char], Event)
k "C" Key
KRight
    , [Char] -> Key -> ([Char], Event)
k "D" Key
KLeft
    , [Char] -> Key -> ([Char], Event)
k "H" Key
KHome
    , [Char] -> Key -> ([Char], Event)
k "F" Key
KEnd
    , [Char] -> Key -> ([Char], Event)
k "E" Key
KBegin
    ]
    where k :: [Char] -> Key -> ([Char], Event)
k c :: [Char]
c s :: Key
s = ("\ESC["[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
c,Key -> [Modifier] -> Event
EvKey Key
s [])

-- | encoding for shift, meta and ctrl plus arrows/home/end
navKeys1 :: ClassifyMap
navKeys1 :: ClassifyMap
navKeys1 =
   [("\ESC[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
charCnt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
mc[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
c,Key -> [Modifier] -> Event
EvKey Key
s [Modifier]
m)
    | [Char]
charCnt <- ["1;", ""], -- we can have a count or not
    (m :: [Modifier]
m,mc :: Int
mc) <- [([Modifier
MShift],2::Int), ([Modifier
MCtrl],5), ([Modifier
MMeta],3),
               -- modifiers and their codes
               ([Modifier
MShift, Modifier
MCtrl],6), ([Modifier
MShift, Modifier
MMeta],4)],
    -- directions and their codes
    (c :: [Char]
c,s :: Key
s) <- [("A", Key
KUp), ("B", Key
KDown), ("C", Key
KRight), ("D", Key
KLeft), ("H", Key
KHome), ("F", Key
KEnd)]
   ]

-- | encoding for ins, del, pageup, pagedown, home, end
navKeys2 :: ClassifyMap
navKeys2 :: ClassifyMap
navKeys2 =
    let k :: a -> Key -> ([Char], Event)
k n :: a
n s :: Key
s = ("\ESC["[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++a -> [Char]
forall a. Show a => a -> [Char]
show a
n[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++"~",Key -> [Modifier] -> Event
EvKey Key
s [])
    in (Int -> Key -> ([Char], Event)) -> [Int] -> [Key] -> ClassifyMap
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Key -> ([Char], Event)
forall a. Show a => a -> Key -> ([Char], Event)
k [2::Int,3,5,6,1,4]
                 [Key
KIns,Key
KDel,Key
KPageUp,Key
KPageDown,Key
KHome,Key
KEnd]

-- | encoding for ctrl + ins, del, pageup, pagedown, home, end
navKeys3 :: ClassifyMap
navKeys3 :: ClassifyMap
navKeys3 =
    let k :: a -> Key -> ([Char], Event)
k n :: a
n s :: Key
s = ("\ESC["[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++a -> [Char]
forall a. Show a => a -> [Char]
show a
n[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++";5~",Key -> [Modifier] -> Event
EvKey Key
s [Modifier
MCtrl])
    in (Int -> Key -> ([Char], Event)) -> [Int] -> [Key] -> ClassifyMap
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Key -> ([Char], Event)
forall a. Show a => a -> Key -> ([Char], Event)
k [2::Int,3,5,6,1,4]
                 [Key
KIns,Key
KDel,Key
KPageUp,Key
KPageDown,Key
KHome,Key
KEnd]

-- | encoding for shift plus function keys
--
-- According to
--
--  * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html
--
-- This encoding depends on the terminal.
functionKeys1 :: ClassifyMap
functionKeys1 :: ClassifyMap
functionKeys1 =
    let f :: Int -> [Int] -> [Modifier] -> ClassifyMap
f ff :: Int
ff nrs :: [Int]
nrs m :: [Modifier]
m = [ ("\ESC["[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++"~",Key -> [Modifier] -> Event
EvKey (Int -> Key
KFun (Int -> Key) -> Int -> Key
forall a b. (a -> b) -> a -> b
$ Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-([Int]
nrs[Int] -> Int -> Int
forall a. [a] -> Int -> a
!!0)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ff) [Modifier]
m) | Int
n <- [Int]
nrs ] in
    [ClassifyMap] -> ClassifyMap
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> [Int] -> [Modifier] -> ClassifyMap
f 1 [25,26] [Modifier
MShift], Int -> [Int] -> [Modifier] -> ClassifyMap
f 3 [28,29] [Modifier
MShift], Int -> [Int] -> [Modifier] -> ClassifyMap
f 5 [31..34] [Modifier
MShift] ]

-- | encoding for meta plus char
--
-- 1. removed 'ESC' from second list due to duplication with
-- "special_support_keys".
-- 2. removed '[' from second list due to conflict with 7-bit encoding
-- for ESC. Whether meta+[ is the same as ESC should examine km and
-- current encoding.
-- 3. stopped enumeration at '~' instead of '\DEL'. The latter is mapped
-- to KBS by special_support_keys.
functionKeys2 :: ClassifyMap
functionKeys2 :: ClassifyMap
functionKeys2 = [ ('\ESC'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char
x],Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
x) [Modifier
MMeta])
                  | Char
x <- '\t'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[' ' .. '~']
                  , Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '['
                  ]

classifyTable :: [ClassifyMap]
classifyTable :: [ClassifyMap]
classifyTable =
    [ ClassifyMap
navKeys0
    , ClassifyMap
navKeys1
    , ClassifyMap
navKeys2
    , ClassifyMap
navKeys3
    , ClassifyMap
functionKeys1
    , ClassifyMap
functionKeys2
    ]