{-# LINE 1 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
{-# LANGUAGE CPP #-}
module System.Win32.Automation.Input.Key where
import Foreign.Ptr ( Ptr )
import Foreign.Storable ( Storable(..) )
import System.Win32.Types ( ULONG_PTR )
import System.Win32.Word ( DWORD, WORD )
type PKEYBDINPUT = Ptr KEYBDINPUT
data KEYBDINPUT = KEYBDINPUT
{ KEYBDINPUT -> WORD
wVk :: WORD
, KEYBDINPUT -> WORD
wScan :: WORD
, KEYBDINPUT -> DWORD
dwFlags :: DWORD
, KEYBDINPUT -> DWORD
time :: DWORD
, :: ULONG_PTR
} deriving Int -> KEYBDINPUT -> ShowS
[KEYBDINPUT] -> ShowS
KEYBDINPUT -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KEYBDINPUT] -> ShowS
$cshowList :: [KEYBDINPUT] -> ShowS
show :: KEYBDINPUT -> String
$cshow :: KEYBDINPUT -> String
showsPrec :: Int -> KEYBDINPUT -> ShowS
$cshowsPrec :: Int -> KEYBDINPUT -> ShowS
Show
instance Storable KEYBDINPUT where
sizeOf :: KEYBDINPUT -> Int
sizeOf = forall a b. a -> b -> a
const (Int
24)
{-# LINE 35 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
alignment _ = 8
{-# LINE 36 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
poke buf input = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (wVk input)
{-# LINE 38 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) buf (wScan input)
{-# LINE 39 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) buf (dwFlags input)
{-# LINE 40 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf (time input)
{-# LINE 41 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) buf (dwExtraInfo input)
{-# LINE 42 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
peek buf = do
wVk' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
{-# LINE 44 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
wScan' <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) buf
{-# LINE 45 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
dwFlags' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf
{-# LINE 46 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
time' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf
{-# LINE 47 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
dwExtraInfo' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) buf
{-# LINE 48 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}
return $ KEYBDINPUT wVk' wScan' dwFlags' time' dwExtraInfo'
kEYEVENTF_EXTENDEDKEY :: DWORD
kEYEVENTF_EXTENDEDKEY :: DWORD
kEYEVENTF_EXTENDEDKEY = DWORD
1
kEYEVENTF_KEYUP :: DWORD
kEYEVENTF_KEYUP :: DWORD
kEYEVENTF_KEYUP = DWORD
2
kEYEVENTF_SCANCODE :: DWORD
kEYEVENTF_SCANCODE :: DWORD
kEYEVENTF_SCANCODE = DWORD
8
kEYEVENTF_UNICODE :: DWORD
kEYEVENTF_UNICODE :: DWORD
kEYEVENTF_UNICODE = DWORD
4
{-# LINE 56 "libraries\\Win32\\System\\Win32\\Automation\\Input\\Key.hsc" #-}