-- | 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
  ( classifyTable
  )
where

import Graphics.Vty.Input.Events

-- | Encoding for navigation keys.
navKeys0 :: ClassifyMap
navKeys0 :: ClassifyMap
navKeys0 =
    [ [Char] -> Key -> ([Char], Event)
k [Char]
"G" Key
KCenter
    , [Char] -> Key -> ([Char], Event)
k [Char]
"P" Key
KPause
    , [Char] -> Key -> ([Char], Event)
k [Char]
"A" Key
KUp
    , [Char] -> Key -> ([Char], Event)
k [Char]
"B" Key
KDown
    , [Char] -> Key -> ([Char], Event)
k [Char]
"C" Key
KRight
    , [Char] -> Key -> ([Char], Event)
k [Char]
"D" Key
KLeft
    , [Char] -> Key -> ([Char], Event)
k [Char]
"H" Key
KHome
    , [Char] -> Key -> ([Char], Event)
k [Char]
"F" Key
KEnd
    , [Char] -> Key -> ([Char], Event)
k [Char]
"E" Key
KBegin
    ]
    where k :: [Char] -> Key -> ([Char], Event)
k [Char]
c Key
s = ([Char]
"\ESC["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 =
   [([Char]
"\ESC[" forall a. [a] -> [a] -> [a]
++ [Char]
charCnt forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
mcforall a. [a] -> [a] -> [a]
++[Char]
c,Key -> [Modifier] -> Event
EvKey Key
s [Modifier]
m)
    | [Char]
charCnt <- [[Char]
"1;", [Char]
""], -- we can have a count or not
    ([Modifier]
m,Int
mc) <- [([Modifier
MShift],Int
2::Int), ([Modifier
MCtrl],Int
5), ([Modifier
MMeta],Int
3),
               -- modifiers and their codes
               ([Modifier
MShift, Modifier
MCtrl],Int
6), ([Modifier
MShift, Modifier
MMeta],Int
4)],
    -- directions and their codes
    ([Char]
c,Key
s) <- [([Char]
"A", Key
KUp), ([Char]
"B", Key
KDown), ([Char]
"C", Key
KRight), ([Char]
"D", Key
KLeft), ([Char]
"H", Key
KHome), ([Char]
"F", Key
KEnd)]
   ]

-- | encoding for ins, del, pageup, pagedown, home, end
navKeys2 :: ClassifyMap
navKeys2 :: ClassifyMap
navKeys2 =
    let k :: a -> Key -> ([Char], Event)
k a
n Key
s = ([Char]
"\ESC["forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show a
nforall a. [a] -> [a] -> [a]
++[Char]
"~",Key -> [Modifier] -> Event
EvKey Key
s [])
    in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Show a => a -> Key -> ([Char], Event)
k [Int
2::Int,Int
3,Int
5,Int
6,Int
1,Int
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 a
n Key
s = ([Char]
"\ESC["forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show a
nforall a. [a] -> [a] -> [a]
++[Char]
";5~",Key -> [Modifier] -> Event
EvKey Key
s [Modifier
MCtrl])
    in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Show a => a -> Key -> ([Char], Event)
k [Int
2::Int,Int
3,Int
5,Int
6,Int
1,Int
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 Int
ff [Int]
nrs [Modifier]
m = [ ([Char]
"\ESC["forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Int
nforall a. [a] -> [a] -> [a]
++[Char]
"~",Key -> [Modifier] -> Event
EvKey (Int -> Key
KFun forall a b. (a -> b) -> a -> b
$ Int
nforall a. Num a => a -> a -> a
-forall a. [a] -> a
head [Int]
nrsforall a. Num a => a -> a -> a
+Int
ff) [Modifier]
m) | Int
n <- [Int]
nrs ] in
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> [Int] -> [Modifier] -> ClassifyMap
f Int
1 [Int
25,Int
26] [Modifier
MShift], Int -> [Int] -> [Modifier] -> ClassifyMap
f Int
3 [Int
28,Int
29] [Modifier
MShift], Int -> [Int] -> [Modifier] -> ClassifyMap
f Int
5 [Int
31..Int
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 = [ (Char
'\ESC'forall a. a -> [a] -> [a]
:[Char
x],Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
x) [Modifier
MMeta])
                  | Char
x <- Char
'\t'forall a. a -> [a] -> [a]
:[Char
' ' .. Char
'~']
                  , Char
x forall a. Eq a => a -> a -> Bool
/= Char
'['
                  ]

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