{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
module Graphics.Vty.Input.Terminfo where
import Graphics.Vty.Input.Events
import qualified Graphics.Vty.Input.Terminfo.ANSIVT as ANSIVT
import Control.Arrow
import System.Console.Terminfo
classifyMapForTerm :: String -> Terminal -> ClassifyMap
classifyMapForTerm :: String -> Terminal -> ClassifyMap
classifyMapForTerm termName :: String
termName term :: Terminal
term =
[ClassifyMap] -> ClassifyMap
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ClassifyMap] -> ClassifyMap) -> [ClassifyMap] -> ClassifyMap
forall a b. (a -> b) -> a -> b
$ Terminal -> ClassifyMap -> ClassifyMap
capsClassifyMap Terminal
term ClassifyMap
keysFromCapsTable
ClassifyMap -> [ClassifyMap] -> [ClassifyMap]
forall a. a -> [a] -> [a]
: ClassifyMap
universalTable
ClassifyMap -> [ClassifyMap] -> [ClassifyMap]
forall a. a -> [a] -> [a]
: String -> [ClassifyMap]
termSpecificTables String
termName
universalTable :: ClassifyMap
universalTable :: ClassifyMap
universalTable = [ClassifyMap] -> ClassifyMap
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ClassifyMap
visibleChars, ClassifyMap
ctrlChars, ClassifyMap
ctrlMetaChars, ClassifyMap
specialSupportKeys]
capsClassifyMap :: Terminal -> [(String,Event)] -> ClassifyMap
capsClassifyMap :: Terminal -> ClassifyMap -> ClassifyMap
capsClassifyMap terminal :: Terminal
terminal table :: ClassifyMap
table = [(String
x,Event
y) | (Just x :: String
x,y :: Event
y) <- ((String, Event) -> (Maybe String, Event))
-> ClassifyMap -> [(Maybe String, Event)]
forall a b. (a -> b) -> [a] -> [b]
map (String, Event) -> (Maybe String, Event)
forall d. (String, d) -> (Maybe String, d)
extractCap ClassifyMap
table]
where extractCap :: (String, d) -> (Maybe String, d)
extractCap = (String -> Maybe String) -> (String, d) -> (Maybe String, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Terminal -> Capability String -> Maybe String
forall a. Terminal -> Capability a -> Maybe a
getCapability Terminal
terminal (Capability String -> Maybe String)
-> (String -> Capability String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Capability String
tiGetStr)
termSpecificTables :: String -> [ClassifyMap]
termSpecificTables :: String -> [ClassifyMap]
termSpecificTables _termName :: String
_termName = [ClassifyMap]
ANSIVT.classifyTable
visibleChars :: ClassifyMap
visibleChars :: ClassifyMap
visibleChars = [ ([Char
x], Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
x) [])
| Char
x <- [' ' .. Int -> Char
forall a. Enum a => Int -> a
toEnum 0xC1]
]
ctrlChars :: ClassifyMap
ctrlChars :: ClassifyMap
ctrlChars =
[ ([Int -> Char
forall a. Enum a => Int -> a
toEnum Int
x],Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
y) [Modifier
MCtrl])
| (x :: Int
x,y :: Char
y) <- [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([0..31]) ('@'Char -> String -> String
forall a. a -> [a] -> [a]
:['a'..'z']String -> String -> String
forall a. [a] -> [a] -> [a]
++['['..'_'])
, Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= 'i'
, Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= 'h'
]
ctrlMetaChars :: ClassifyMap
ctrlMetaChars :: ClassifyMap
ctrlMetaChars = ((String, Event) -> (String, Event)) -> ClassifyMap -> ClassifyMap
forall a b. (a -> b) -> [a] -> [b]
map (\(s :: String
s,EvKey c :: Key
c m :: [Modifier]
m) -> ('\ESC'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s, Key -> [Modifier] -> Event
EvKey Key
c (Modifier
MMetaModifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
:[Modifier]
m))) ClassifyMap
ctrlChars
specialSupportKeys :: ClassifyMap
specialSupportKeys :: ClassifyMap
specialSupportKeys =
[
("\ESC",Key -> [Modifier] -> Event
EvKey Key
KEsc []), ("\ESC\ESC",Key -> [Modifier] -> Event
EvKey Key
KEsc [Modifier
MMeta])
, ("\DEL",Key -> [Modifier] -> Event
EvKey Key
KBS []), ("\ESC\DEL",Key -> [Modifier] -> Event
EvKey Key
KBS [Modifier
MMeta])
, ("\ESC\^J",Key -> [Modifier] -> Event
EvKey Key
KEnter [Modifier
MMeta]), ("\^J",Key -> [Modifier] -> Event
EvKey Key
KEnter [])
, ("\t", Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar '\t') [])
]
keysFromCapsTable :: ClassifyMap
keysFromCapsTable :: ClassifyMap
keysFromCapsTable =
[ ("ka1", Key -> [Modifier] -> Event
EvKey Key
KUpLeft [])
, ("ka3", Key -> [Modifier] -> Event
EvKey Key
KUpRight [])
, ("kb2", Key -> [Modifier] -> Event
EvKey Key
KCenter [])
, ("kbs", Key -> [Modifier] -> Event
EvKey Key
KBS [])
, ("kbeg", Key -> [Modifier] -> Event
EvKey Key
KBegin [])
, ("kcbt", Key -> [Modifier] -> Event
EvKey Key
KBackTab [])
, ("kc1", Key -> [Modifier] -> Event
EvKey Key
KDownLeft [])
, ("kc3", Key -> [Modifier] -> Event
EvKey Key
KDownRight [])
, ("kdch1", Key -> [Modifier] -> Event
EvKey Key
KDel [])
, ("kcud1", Key -> [Modifier] -> Event
EvKey Key
KDown [])
, ("kend", Key -> [Modifier] -> Event
EvKey Key
KEnd [])
, ("kent", Key -> [Modifier] -> Event
EvKey Key
KEnter [])
, ("khome", Key -> [Modifier] -> Event
EvKey Key
KHome [])
, ("kich1", Key -> [Modifier] -> Event
EvKey Key
KIns [])
, ("kcub1", Key -> [Modifier] -> Event
EvKey Key
KLeft [])
, ("knp", Key -> [Modifier] -> Event
EvKey Key
KPageDown [])
, ("kpp", Key -> [Modifier] -> Event
EvKey Key
KPageUp [])
, ("kcuf1", Key -> [Modifier] -> Event
EvKey Key
KRight [])
, ("kDC", Key -> [Modifier] -> Event
EvKey Key
KDel [Modifier
MShift])
, ("kEND", Key -> [Modifier] -> Event
EvKey Key
KEnd [Modifier
MShift])
, ("kHOM", Key -> [Modifier] -> Event
EvKey Key
KHome [Modifier
MShift])
, ("kIC", Key -> [Modifier] -> Event
EvKey Key
KIns [Modifier
MShift])
, ("kLFT", Key -> [Modifier] -> Event
EvKey Key
KLeft [Modifier
MShift])
, ("kRIT", Key -> [Modifier] -> Event
EvKey Key
KRight [Modifier
MShift])
, ("kcuu1", Key -> [Modifier] -> Event
EvKey Key
KUp [])
] ClassifyMap -> ClassifyMap -> ClassifyMap
forall a. [a] -> [a] -> [a]
++ ClassifyMap
functionKeyCapsTable
functionKeyCapsTable :: ClassifyMap
functionKeyCapsTable :: ClassifyMap
functionKeyCapsTable = ((Int -> (String, Event)) -> [Int] -> ClassifyMap)
-> [Int] -> (Int -> (String, Event)) -> ClassifyMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> (String, Event)) -> [Int] -> ClassifyMap
forall a b. (a -> b) -> [a] -> [b]
map [0..63] ((Int -> (String, Event)) -> ClassifyMap)
-> (Int -> (String, Event)) -> ClassifyMap
forall a b. (a -> b) -> a -> b
$ \n :: Int
n -> ("kf" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n, Key -> [Modifier] -> Event
EvKey (Int -> Key
KFun Int
n) [])