{-|
Module      : KMonad.Keyboard.IO.Windows.Types
Description : The Windows-specific representation of KeyEvent.
Copyright   : (c) David Janssen, 2019
License     : MIT
Maintainer  : janssen.dhj@gmail.com
Stability   : experimental
Portability : portable

NOTE: The representation here lines up with the @keyio_win.c@ module, not with
Windows in general. There is some translation happening in the c-code.

-}
module KMonad.Keyboard.IO.Windows.Types
  ( WinError(..)
  , WinKeyEvent
  , mkWinKeyEvent
  , toWinKeyEvent
  , fromWinKeyEvent
  , winCodeKeyCodeMapping
  )

where

import KMonad.Prelude

import Foreign.Storable
import KMonad.Keyboard

import Data.Tuple (swap)
import qualified RIO.HashMap as M
import qualified RIO.NonEmpty as NE (groupAllWith)
-- TODO: use `Data.Foldable1` instead when `base` >= 4.18.0.0
import qualified Data.Foldable as NE (minimumBy, maximumBy)

----------------------------------------------------------------------------
-- $err

-- | Everything that can go wrong with Windows Key-IO
data WinError
  = NoWinKeycodeTo   Keycode    -- ^ Error translating to 'WinKeycode'
  | NoWinKeycodeFrom WinKeycode -- ^ Error translating from 'WinKeycode'

instance Exception WinError
instance Show WinError where
  show :: WinError -> String
show WinError
e = case WinError
e of
    NoWinKeycodeTo   Keycode
c -> String
"Cannot translate to windows keycode: "   String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Keycode -> String
forall a. Show a => a -> String
show Keycode
c
    NoWinKeycodeFrom WinKeycode
i -> String
"Cannot translate from windows keycode: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> WinKeycode -> String
forall a. Show a => a -> String
show WinKeycode
i

--------------------------------------------------------------------------------
-- $typ

type WinSwitch  = Word8  -- ^ Type alias for the switch value
type WinKeycode = Word32 -- ^ Type alias for the windows encoded keycode

-- | 'WinKeyEvent' is the C-representation of a a 'KeyEvent' for our Windows API.
--
-- It contains a 'Word8' signifying whether the event was a Press (0) or Release
-- (1), and a 'Word32' (Windows @DWORD@) signifying the *Windows keycode*.
--
-- NOTE: Windows and Linux keycodes do not line up. Internally we use Linux
-- Keycodes for everything, we translate at the KeyIO stage (here).
newtype WinKeyEvent = WinKeyEvent (WinSwitch, WinKeycode)
  deriving (WinKeyEvent -> WinKeyEvent -> Bool
(WinKeyEvent -> WinKeyEvent -> Bool)
-> (WinKeyEvent -> WinKeyEvent -> Bool) -> Eq WinKeyEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WinKeyEvent -> WinKeyEvent -> Bool
== :: WinKeyEvent -> WinKeyEvent -> Bool
$c/= :: WinKeyEvent -> WinKeyEvent -> Bool
/= :: WinKeyEvent -> WinKeyEvent -> Bool
Eq, Eq WinKeyEvent
Eq WinKeyEvent =>
(WinKeyEvent -> WinKeyEvent -> Ordering)
-> (WinKeyEvent -> WinKeyEvent -> Bool)
-> (WinKeyEvent -> WinKeyEvent -> Bool)
-> (WinKeyEvent -> WinKeyEvent -> Bool)
-> (WinKeyEvent -> WinKeyEvent -> Bool)
-> (WinKeyEvent -> WinKeyEvent -> WinKeyEvent)
-> (WinKeyEvent -> WinKeyEvent -> WinKeyEvent)
-> Ord WinKeyEvent
WinKeyEvent -> WinKeyEvent -> Bool
WinKeyEvent -> WinKeyEvent -> Ordering
WinKeyEvent -> WinKeyEvent -> WinKeyEvent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WinKeyEvent -> WinKeyEvent -> Ordering
compare :: WinKeyEvent -> WinKeyEvent -> Ordering
$c< :: WinKeyEvent -> WinKeyEvent -> Bool
< :: WinKeyEvent -> WinKeyEvent -> Bool
$c<= :: WinKeyEvent -> WinKeyEvent -> Bool
<= :: WinKeyEvent -> WinKeyEvent -> Bool
$c> :: WinKeyEvent -> WinKeyEvent -> Bool
> :: WinKeyEvent -> WinKeyEvent -> Bool
$c>= :: WinKeyEvent -> WinKeyEvent -> Bool
>= :: WinKeyEvent -> WinKeyEvent -> Bool
$cmax :: WinKeyEvent -> WinKeyEvent -> WinKeyEvent
max :: WinKeyEvent -> WinKeyEvent -> WinKeyEvent
$cmin :: WinKeyEvent -> WinKeyEvent -> WinKeyEvent
min :: WinKeyEvent -> WinKeyEvent -> WinKeyEvent
Ord, Int -> WinKeyEvent -> ShowS
[WinKeyEvent] -> ShowS
WinKeyEvent -> String
(Int -> WinKeyEvent -> ShowS)
-> (WinKeyEvent -> String)
-> ([WinKeyEvent] -> ShowS)
-> Show WinKeyEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WinKeyEvent -> ShowS
showsPrec :: Int -> WinKeyEvent -> ShowS
$cshow :: WinKeyEvent -> String
show :: WinKeyEvent -> String
$cshowList :: [WinKeyEvent] -> ShowS
showList :: [WinKeyEvent] -> ShowS
Show)

-- | This lets us send 'WinKeyEvent's between Haskell and C.
instance Storable WinKeyEvent where
  alignment :: WinKeyEvent -> Int
alignment WinKeyEvent
_ = Int
4 -- lowest common denominator of: 1 4
  sizeOf :: WinKeyEvent -> Int
sizeOf    WinKeyEvent
_ = Int
8 -- (1 + 3-padding) + 4
  peek :: Ptr WinKeyEvent -> IO WinKeyEvent
peek Ptr WinKeyEvent
ptr = do
    WinSwitch
s <- Ptr WinKeyEvent -> Int -> IO WinSwitch
forall b. Ptr b -> Int -> IO WinSwitch
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr WinKeyEvent
ptr Int
0
    WinKeycode
c <- Ptr WinKeyEvent -> Int -> IO WinKeycode
forall b. Ptr b -> Int -> IO WinKeycode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr WinKeyEvent
ptr Int
4
    WinKeyEvent -> IO WinKeyEvent
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WinKeyEvent -> IO WinKeyEvent) -> WinKeyEvent -> IO WinKeyEvent
forall a b. (a -> b) -> a -> b
$ (WinSwitch, WinKeycode) -> WinKeyEvent
WinKeyEvent (WinSwitch
s, WinKeycode
c)
  poke :: Ptr WinKeyEvent -> WinKeyEvent -> IO ()
poke Ptr WinKeyEvent
ptr (WinKeyEvent (WinSwitch
s, WinKeycode
c)) = do
    Ptr WinKeyEvent -> Int -> WinSwitch -> IO ()
forall b. Ptr b -> Int -> WinSwitch -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr WinKeyEvent
ptr Int
0 WinSwitch
s
    Ptr WinKeyEvent -> Int -> WinKeycode -> IO ()
forall b. Ptr b -> Int -> WinKeycode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr WinKeyEvent
ptr Int
4 WinKeycode
c

mkWinKeyEvent :: WinSwitch -> WinKeycode -> WinKeyEvent
mkWinKeyEvent :: WinSwitch -> WinKeycode -> WinKeyEvent
mkWinKeyEvent WinSwitch
s WinKeycode
e = (WinSwitch, WinKeycode) -> WinKeyEvent
WinKeyEvent (WinSwitch
s, WinKeycode
e)

--------------------------------------------------------------------------------
-- $conv

-- | Convert between 'WinSwitch' and 'Switch' representations.
--
-- NOTE: Although 'WinSwitch' could theoretically be something besides 0 or 1,
-- practically it can't, because those are the only values the API generates,
-- guaranteed.
_WinSwitch :: Iso' WinSwitch Switch
_WinSwitch :: Iso' WinSwitch Switch
_WinSwitch = (WinSwitch -> Switch)
-> (Switch -> WinSwitch) -> Iso' WinSwitch Switch
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso WinSwitch -> Switch
forall {a}. (Eq a, Num a) => a -> Switch
to' Switch -> WinSwitch
forall {a}. Num a => Switch -> a
from'
  where
    to' :: a -> Switch
to' a
w   = if a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then Switch
Press else Switch
Release
    from' :: Switch -> a
from' Switch
s = if Switch
s Switch -> Switch -> Bool
forall a. Eq a => a -> a -> Bool
== Switch
Press then a
0 else a
1

-- | Lookup the corresponding 'Keycode' for this 'WinKeycode'
fromWinKeycode :: WinKeycode -> Maybe Keycode
fromWinKeycode :: WinKeycode -> Maybe Keycode
fromWinKeycode = (WinKeycode -> HashMap WinKeycode Keycode -> Maybe Keycode)
-> HashMap WinKeycode Keycode -> WinKeycode -> Maybe Keycode
forall a b c. (a -> b -> c) -> b -> a -> c
flip WinKeycode -> HashMap WinKeycode Keycode -> Maybe Keycode
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup HashMap WinKeycode Keycode
winCodeToKeyCode

-- | Lookup the correspondig 'WinKeycode' for this 'Keycode'
toWinKeycode :: Keycode -> Maybe WinKeycode
toWinKeycode :: Keycode -> Maybe WinKeycode
toWinKeycode = (Keycode -> HashMap Keycode WinKeycode -> Maybe WinKeycode)
-> HashMap Keycode WinKeycode -> Keycode -> Maybe WinKeycode
forall a b c. (a -> b -> c) -> b -> a -> c
flip Keycode -> HashMap Keycode WinKeycode -> Maybe WinKeycode
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup HashMap Keycode WinKeycode
keyCodeToWinCode

-- | Convert a 'KeyEvent' to a 'WinKeyEvent'
--
-- NOTE: Windows keycodes are different, and I am not confident I have full
-- coverage, therefore this conversion is not total. We are going to leave this
-- error-handling in until we are sure this is covered well. Once it lines up
-- perfectly, this is essentially an Iso.
toWinKeyEvent :: KeyEvent -> Either WinError WinKeyEvent
toWinKeyEvent :: KeyEvent -> Either WinError WinKeyEvent
toWinKeyEvent KeyEvent
e = case Keycode -> Maybe WinKeycode
toWinKeycode (Keycode -> Maybe WinKeycode) -> Keycode -> Maybe WinKeycode
forall a b. (a -> b) -> a -> b
$ KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode of
  Just WinKeycode
c  -> WinKeyEvent -> Either WinError WinKeyEvent
forall a b. b -> Either a b
Right (WinKeyEvent -> Either WinError WinKeyEvent)
-> WinKeyEvent -> Either WinError WinKeyEvent
forall a b. (a -> b) -> a -> b
$ (WinSwitch, WinKeycode) -> WinKeyEvent
WinKeyEvent (KeyEvent
eKeyEvent -> Getting WinSwitch KeyEvent WinSwitch -> WinSwitch
forall s a. s -> Getting a s a -> a
^.(Switch -> Const WinSwitch Switch)
-> KeyEvent -> Const WinSwitch KeyEvent
forall c. HasKeyEvent c => Lens' c Switch
Lens' KeyEvent Switch
switch((Switch -> Const WinSwitch Switch)
 -> KeyEvent -> Const WinSwitch KeyEvent)
-> ((WinSwitch -> Const WinSwitch WinSwitch)
    -> Switch -> Const WinSwitch Switch)
-> Getting WinSwitch KeyEvent WinSwitch
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AnIso WinSwitch WinSwitch Switch Switch
-> Iso Switch Switch WinSwitch WinSwitch
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso WinSwitch WinSwitch Switch Switch
Iso' WinSwitch Switch
_WinSwitch, WinKeycode
c)
  Maybe WinKeycode
Nothing -> WinError -> Either WinError WinKeyEvent
forall a b. a -> Either a b
Left (WinError -> Either WinError WinKeyEvent)
-> (Keycode -> WinError) -> Keycode -> Either WinError WinKeyEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keycode -> WinError
NoWinKeycodeTo (Keycode -> Either WinError WinKeyEvent)
-> Keycode -> Either WinError WinKeyEvent
forall a b. (a -> b) -> a -> b
$ KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode

-- | Convert a 'WinKeyEvent' to a 'KeyEvent'
--
-- NOTE: Same limitations as 'toWinKeyEvent' apply
fromWinKeyEvent :: WinKeyEvent -> Either WinError KeyEvent
fromWinKeyEvent :: WinKeyEvent -> Either WinError KeyEvent
fromWinKeyEvent (WinKeyEvent (WinSwitch
s, WinKeycode
c)) = case WinKeycode -> Maybe Keycode
fromWinKeycode WinKeycode
c of
  Just Keycode
c' -> KeyEvent -> Either WinError KeyEvent
forall a b. b -> Either a b
Right (KeyEvent -> Either WinError KeyEvent)
-> KeyEvent -> Either WinError KeyEvent
forall a b. (a -> b) -> a -> b
$ Switch -> Keycode -> KeyEvent
mkKeyEvent (WinSwitch
sWinSwitch -> Getting Switch WinSwitch Switch -> Switch
forall s a. s -> Getting a s a -> a
^.Getting Switch WinSwitch Switch
Iso' WinSwitch Switch
_WinSwitch) Keycode
c'
  Maybe Keycode
Nothing -> WinError -> Either WinError KeyEvent
forall a b. a -> Either a b
Left (WinError -> Either WinError KeyEvent)
-> (WinKeycode -> WinError)
-> WinKeycode
-> Either WinError KeyEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WinKeycode -> WinError
NoWinKeycodeFrom (WinKeycode -> Either WinError KeyEvent)
-> WinKeycode -> Either WinError KeyEvent
forall a b. (a -> b) -> a -> b
$ WinKeycode
c


--------------------------------------------------------------------------------
-- $kc

-- | Translate a virtual-key code from Windows into a suitable KMonad KeyCode
--
-- FIXME: There are loads of missing correspondences, mostly for rare-keys. How
-- do these line up? Ideally this mapping would be total.
winCodeToKeyCode :: M.HashMap WinKeycode Keycode
winCodeToKeyCode :: HashMap WinKeycode Keycode
winCodeToKeyCode = [(WinKeycode, Keycode)] -> HashMap WinKeycode Keycode
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(WinKeycode, Keycode)] -> HashMap WinKeycode Keycode)
-> [(WinKeycode, Keycode)] -> HashMap WinKeycode Keycode
forall a b. (a -> b) -> a -> b
$ ((WinKeycode, Keycode) -> (WinKeycode, Keycode) -> Ordering)
-> NonEmpty (WinKeycode, Keycode) -> (WinKeycode, Keycode)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
NE.minimumBy (Keycode -> Keycode -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Keycode -> Keycode -> Ordering)
-> ((WinKeycode, Keycode) -> Keycode)
-> (WinKeycode, Keycode)
-> (WinKeycode, Keycode)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (WinKeycode, Keycode) -> Keycode
forall a b. (a, b) -> b
snd) (NonEmpty (WinKeycode, Keycode) -> (WinKeycode, Keycode))
-> [NonEmpty (WinKeycode, Keycode)] -> [(WinKeycode, Keycode)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((WinKeycode, Keycode) -> WinKeycode)
-> [(WinKeycode, Keycode)] -> [NonEmpty (WinKeycode, Keycode)]
forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
NE.groupAllWith (WinKeycode, Keycode) -> WinKeycode
forall a b. (a, b) -> a
fst [(WinKeycode, Keycode)]
winCodeKeyCodeMapping

-- | Translate a KMonad KeyCode to the corresponding Windows virtual-key code
--
-- We cannot simply reverse the above map for the opposite direction, because
-- there will be duplicates where more than one virtual-key code produces the
-- same KMonad KeyCode. See https://github.com/kmonad/kmonad/issues/326
keyCodeToWinCode :: M.HashMap Keycode WinKeycode
keyCodeToWinCode :: HashMap Keycode WinKeycode
keyCodeToWinCode = [(Keycode, WinKeycode)] -> HashMap Keycode WinKeycode
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Keycode, WinKeycode)] -> HashMap Keycode WinKeycode)
-> [(Keycode, WinKeycode)] -> HashMap Keycode WinKeycode
forall a b. (a -> b) -> a -> b
$ (WinKeycode, Keycode) -> (Keycode, WinKeycode)
forall a b. (a, b) -> (b, a)
swap ((WinKeycode, Keycode) -> (Keycode, WinKeycode))
-> (NonEmpty (WinKeycode, Keycode) -> (WinKeycode, Keycode))
-> NonEmpty (WinKeycode, Keycode)
-> (Keycode, WinKeycode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WinKeycode, Keycode) -> (WinKeycode, Keycode) -> Ordering)
-> NonEmpty (WinKeycode, Keycode) -> (WinKeycode, Keycode)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
NE.maximumBy (WinKeycode -> WinKeycode -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (WinKeycode -> WinKeycode -> Ordering)
-> ((WinKeycode, Keycode) -> WinKeycode)
-> (WinKeycode, Keycode)
-> (WinKeycode, Keycode)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (WinKeycode, Keycode) -> WinKeycode
forall a b. (a, b) -> a
fst) (NonEmpty (WinKeycode, Keycode) -> (Keycode, WinKeycode))
-> [NonEmpty (WinKeycode, Keycode)] -> [(Keycode, WinKeycode)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((WinKeycode, Keycode) -> Keycode)
-> [(WinKeycode, Keycode)] -> [NonEmpty (WinKeycode, Keycode)]
forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
NE.groupAllWith (WinKeycode, Keycode) -> Keycode
forall a b. (a, b) -> b
snd [(WinKeycode, Keycode)]
winCodeKeyCodeMapping

-- | A table of which virtual-key code from Windows
-- correspond to which KMonad KeyCode.
-- This table may have the same virtual-key code from Windows multiple times
-- and also may have the same KMonad KeyCode multiple times.
--
-- It is essentially a merge of 'winCodeToKeyCode' and 'keyCodeToWinCode'.
winCodeKeyCodeMapping :: [(WinKeycode, Keycode)]
winCodeKeyCodeMapping :: [(WinKeycode, Keycode)]
winCodeKeyCodeMapping =
  [ (WinKeycode
0x00, Keycode
Missing254)     -- Not documented, but happens often. Why??
  -- , (0x01, ???)         -- Defined as VK_LBUTTON
  -- , (0x02, ???)         -- Defined as VK_RBUTTON
  , (WinKeycode
0x03, Keycode
KeyCancel)
  -- , (0x04, ???)         -- Defined as VK_MBUTTON
  -- , (0x05, ???)         -- Defined as VK_XBUTTON1
  -- , (0x06, ???)         -- Defined as VK_XBUTTON2
  , (WinKeycode
0x08, Keycode
KeyBackspace)
  , (WinKeycode
0x09, Keycode
KeyTab)
  , (WinKeycode
0x0C, Keycode
KeyDelete)      -- Defined as VK_CLEAR
  , (WinKeycode
0x0D, Keycode
KeyEnter)
  , (WinKeycode
0x0D, Keycode
KeyKpEnter)
  , (WinKeycode
0x10, Keycode
KeyLeftShift)   -- No 'sidedness'??
  , (WinKeycode
0x11, Keycode
KeyLeftCtrl)    -- No 'sidedness'??
  , (WinKeycode
0x12, Keycode
KeyLeftAlt)     -- No 'sidedness'??
  , (WinKeycode
0x13, Keycode
KeyPause)
  , (WinKeycode
0x14, Keycode
KeyCapsLock)
  , (WinKeycode
0x15, Keycode
KeyKatakana)
  , (WinKeycode
0x15, Keycode
KeyKatakanaHiragana)
  , (WinKeycode
0x15, Keycode
KeyHangeul)
  -- , (0x16, ???)            -- Defined as VK_IME_ON
  -- , (0x17, ???)            -- Defined as VK_JUNJA
  -- , (0x18, ???)            -- Defined as VK_FINAL
  , (WinKeycode
0x19, Keycode
KeyHanja)
  -- , (0x1A, ???)            -- Defined as VK_IME_OFF
  , (WinKeycode
0x1B, Keycode
KeyEsc)
  , (WinKeycode
0x1C, Keycode
KeyHenkan)         -- Defined as VK_CONVERT
  , (WinKeycode
0x1D, Keycode
KeyMuhenkan)       -- Defined as VK_NONCONVERT
  -- , (0x1E, ???)            -- Defined as VK_ACCEPT
  -- , (0x1F, ???)            -- Defined as VK_MODECHANGE
  , (WinKeycode
0x20, Keycode
KeySpace)
  , (WinKeycode
0x21, Keycode
KeyPageUp)
  , (WinKeycode
0x22, Keycode
KeyPageDown)
  , (WinKeycode
0x23, Keycode
KeyEnd)
  , (WinKeycode
0x24, Keycode
KeyHome)
  , (WinKeycode
0x25, Keycode
KeyLeft)
  , (WinKeycode
0x26, Keycode
KeyUp)
  , (WinKeycode
0x27, Keycode
KeyRight)
  , (WinKeycode
0x28, Keycode
KeyDown)
  -- , (0x29, ???)            -- Defined as VK_SELECT
  -- , (0x2A, ???)            -- Defined as VK_PRINT (legacy PrintScreen)
  -- , (0x2B, ???)            -- Defined as VK_EXECUTE
  , (WinKeycode
0x2C, Keycode
KeyPrint)          -- Defined as VK_PRINT_SCREEN / VK_SNAPSHOT
  , (WinKeycode
0x2D, Keycode
KeyInsert)
  , (WinKeycode
0x2E, Keycode
KeyDelete)
  , (WinKeycode
0x2F, Keycode
KeyHelp)
  , (WinKeycode
0x30, Keycode
Key0)
  , (WinKeycode
0x31, Keycode
Key1)
  , (WinKeycode
0x32, Keycode
Key2)
  , (WinKeycode
0x33, Keycode
Key3)
  , (WinKeycode
0x34, Keycode
Key4)
  , (WinKeycode
0x35, Keycode
Key5)
  , (WinKeycode
0x36, Keycode
Key6)
  , (WinKeycode
0x37, Keycode
Key7)
  , (WinKeycode
0x38, Keycode
Key8)
  , (WinKeycode
0x39, Keycode
Key9)
  , (WinKeycode
0x41, Keycode
KeyA)
  , (WinKeycode
0x42, Keycode
KeyB)
  , (WinKeycode
0x43, Keycode
KeyC)
  , (WinKeycode
0x44, Keycode
KeyD)
  , (WinKeycode
0x45, Keycode
KeyE)
  , (WinKeycode
0x46, Keycode
KeyF)
  , (WinKeycode
0x47, Keycode
KeyG)
  , (WinKeycode
0x48, Keycode
KeyH)
  , (WinKeycode
0x49, Keycode
KeyI)
  , (WinKeycode
0x4A, Keycode
KeyJ)
  , (WinKeycode
0x4B, Keycode
KeyK)
  , (WinKeycode
0x4C, Keycode
KeyL)
  , (WinKeycode
0x4D, Keycode
KeyM)
  , (WinKeycode
0x4E, Keycode
KeyN)
  , (WinKeycode
0x4F, Keycode
KeyO)
  , (WinKeycode
0x50, Keycode
KeyP)
  , (WinKeycode
0x51, Keycode
KeyQ)
  , (WinKeycode
0x52, Keycode
KeyR)
  , (WinKeycode
0x53, Keycode
KeyS)
  , (WinKeycode
0x54, Keycode
KeyT)
  , (WinKeycode
0x55, Keycode
KeyU)
  , (WinKeycode
0x56, Keycode
KeyV)
  , (WinKeycode
0x57, Keycode
KeyW)
  , (WinKeycode
0x58, Keycode
KeyX)
  , (WinKeycode
0x59, Keycode
KeyY)
  , (WinKeycode
0x5A, Keycode
KeyZ)
  , (WinKeycode
0x5B, Keycode
KeyLeftMeta)             -- Defined as Left Windows key (Natural Keyboard)
  , (WinKeycode
0x5C, Keycode
KeyRightMeta)             -- Defined as Right Windows key (Natural Keyboard)
  , (WinKeycode
0x5D, Keycode
KeyCompose)             -- Defined as Applications key (Natural Keyboard)
  , (WinKeycode
0x5D, Keycode
KeyMenu)
  , (WinKeycode
0x5F, Keycode
KeySleep)
  , (WinKeycode
0x60, Keycode
KeyKp0)
  , (WinKeycode
0x61, Keycode
KeyKp1)
  , (WinKeycode
0x62, Keycode
KeyKp2)
  , (WinKeycode
0x63, Keycode
KeyKp3)
  , (WinKeycode
0x64, Keycode
KeyKp4)
  , (WinKeycode
0x65, Keycode
KeyKp5)
  , (WinKeycode
0x66, Keycode
KeyKp6)
  , (WinKeycode
0x67, Keycode
KeyKp7)
  , (WinKeycode
0x68, Keycode
KeyKp8)
  , (WinKeycode
0x69, Keycode
KeyKp9)
  , (WinKeycode
0x6A, Keycode
KeyKpAsterisk)
  , (WinKeycode
0x6B, Keycode
KeyKpPlus)
  -- , (0x6C, KeyKpDot)        -- Defined as VK_SEPARATOR
  , (WinKeycode
0x6D, Keycode
KeyKpMinus)
  , (WinKeycode
0x6E, Keycode
KeyKpDot)
  , (WinKeycode
0x6F, Keycode
KeyKpSlash)
  , (WinKeycode
0x70, Keycode
KeyF1)
  , (WinKeycode
0x71, Keycode
KeyF2)
  , (WinKeycode
0x72, Keycode
KeyF3)
  , (WinKeycode
0x73, Keycode
KeyF4)
  , (WinKeycode
0x74, Keycode
KeyF5)
  , (WinKeycode
0x75, Keycode
KeyF6)
  , (WinKeycode
0x76, Keycode
KeyF7)
  , (WinKeycode
0x77, Keycode
KeyF8)
  , (WinKeycode
0x78, Keycode
KeyF9)
  , (WinKeycode
0x79, Keycode
KeyF10)
  , (WinKeycode
0x7A, Keycode
KeyF11)
  , (WinKeycode
0x7B, Keycode
KeyF12)
  , (WinKeycode
0x7C, Keycode
KeyF13)
  , (WinKeycode
0x7D, Keycode
KeyF14)
  , (WinKeycode
0x7E, Keycode
KeyF15)
  , (WinKeycode
0x7F, Keycode
KeyF16)
  , (WinKeycode
0x80, Keycode
KeyF17)
  , (WinKeycode
0x81, Keycode
KeyF18)
  , (WinKeycode
0x82, Keycode
KeyF19)
  , (WinKeycode
0x83, Keycode
KeyF20)
  , (WinKeycode
0x84, Keycode
KeyF21)
  , (WinKeycode
0x85, Keycode
KeyF22)
  , (WinKeycode
0x86, Keycode
KeyF23)
  , (WinKeycode
0x87, Keycode
KeyF24)
  , (WinKeycode
0x90, Keycode
KeyNumLock)
  , (WinKeycode
0x91, Keycode
KeyScrollLock)
  , (WinKeycode
0xA0, Keycode
KeyLeftShift)
  , (WinKeycode
0xA1, Keycode
KeyRightShift)
  , (WinKeycode
0xA2, Keycode
KeyLeftCtrl)
  , (WinKeycode
0xA3, Keycode
KeyRightCtrl)
  , (WinKeycode
0xA4, Keycode
KeyLeftAlt)
  , (WinKeycode
0xA5, Keycode
KeyRightAlt)
  , (WinKeycode
0xA6, Keycode
KeyBack)
  , (WinKeycode
0xA7, Keycode
KeyForward)
  , (WinKeycode
0xA8, Keycode
KeyRefresh)
  , (WinKeycode
0xA9, Keycode
KeyStop)
  , (WinKeycode
0xAA, Keycode
KeySearch)
  -- , (0xAB, ???)             -- Defined as VK_BROWSER_FAVORITES
  , (WinKeycode
0xAC, Keycode
KeyHomepage)
  , (WinKeycode
0xAD, Keycode
KeyMute)
  , (WinKeycode
0xAE, Keycode
KeyVolumeDown)
  , (WinKeycode
0xAF, Keycode
KeyVolumeUp)
  , (WinKeycode
0xB0, Keycode
KeyNextSong)
  , (WinKeycode
0xB0, Keycode
KeyVideoNext)
  , (WinKeycode
0xB1, Keycode
KeyPreviousSong)
  , (WinKeycode
0xB1, Keycode
KeyVideoPrev)
  , (WinKeycode
0xB2, Keycode
KeyStopCd)
  , (WinKeycode
0xB3, Keycode
KeyPlayPause)
  , (WinKeycode
0xB4, Keycode
KeyMail)
  , (WinKeycode
0xB4, Keycode
KeyEmail)
  , (WinKeycode
0xB5, Keycode
KeyMedia)
  , (WinKeycode
0xB6, Keycode
KeyProg1)           -- Defined as VK_LAUNCH_APP1
  , (WinKeycode
0xB7, Keycode
KeyProg2)           -- Defined as VK_LAUNCH_APP2
  , (WinKeycode
0xBA, Keycode
KeySemicolon)    -- Defined as VK_OEM_1
  , (WinKeycode
0xBB, Keycode
KeyEqual)        -- Defined as VK_OEM_PLUS
  , (WinKeycode
0xBC, Keycode
KeyComma)        -- Defined as VK_OEM_COMMA
  , (WinKeycode
0xBD, Keycode
KeyMinus)        -- Defined as VK_OEM_MINUS
  , (WinKeycode
0xBE, Keycode
KeyDot)          -- Defined as VK_OEM_PERIOD
  , (WinKeycode
0xBF, Keycode
KeySlash)        -- Defined as VK_OEM_2
  , (WinKeycode
0xC0, Keycode
KeyGrave)        -- Defined as VK_OEM_3
  , (WinKeycode
0xC1, Keycode
KeyRo)
  , (WinKeycode
0xDB, Keycode
KeyLeftBrace)    -- Defined as VK_OEM_4
  , (WinKeycode
0xDC, Keycode
KeyBackslash)    -- Defined as VK_OEM_5
  , (WinKeycode
0xDD, Keycode
KeyRightBrace)   -- Defined as VK_OEM_6
  , (WinKeycode
0xDE, Keycode
KeyApostrophe)   -- Defined as VK_OEM_7
  -- , (0xDF, ???)             -- Defined ask VK_OEM_8
  -- , (0xE1, ???)             -- Defined as `OEM specific`
  , (WinKeycode
0xE2, Keycode
Key102nd)
  -- , (0xE3, ???)             -- Defined as `OEM specific`
  -- , (0xE4, ???)             -- Defined as `OEM specific`
  -- , (0xE5, ???)             -- Defined as VK_PROCESSKEY
  -- , (0xE6, ???)             -- Defined as `OEM specific`
  -- , (0xE7, ???)             -- Defined as VK_PACKET
  -- , (0xE9, ???)             -- Defined as `OEM specific`
  -- , (0xEA, ???)             -- Defined as `OEM specific`
  -- , (0xEB, ???)             -- Defined as `OEM specific`
  -- , (0xEC, ???)             -- Defined as `OEM specific`
  -- , (0xED, ???)             -- Defined as `OEM specific`
  -- , (0xEE, ???)             -- Defined as `OEM specific`
  -- , (0xEF, ???)             -- Defined as `OEM specific`
  -- , (0xF0, ???)             -- Defined as `OEM specific`
  -- , (0xF1, ???)             -- Defined as `OEM specific`
  -- , (0xF2, ???)             -- Defined as `OEM specific`
  -- , (0xF3, ???)             -- Defined as `OEM specific`
  -- , (0xF4, ???)             -- Defined as `OEM specific`
  -- , (0xF5, ???)             -- Defined as `OEM specific`
  -- , (0xF6, ???)             -- Defined as VK_ATTN
  -- , (0xF7, ???)             -- Defined as VK_CRSEL
  -- , (0xF8, ???)             -- Defined as VK_EXSEL
  -- , (0xF9, ???)             -- Defined as VK_EREOF
  , (WinKeycode
0xFA, Keycode
KeyPlay)
  -- , (0xFB, ???)             -- Defined as VK_ZOOM
  -- , (0xFC, ???)             -- Defined as VK_NONAME
  -- , (0xFD, ???)             -- Defined as VK_PA1
  -- , (0xFE, KeyDelete)       -- Defined as VK_OEM_CLEAR
  ]