{-# LINE 1 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
{-# LANGUAGE CPP #-}
module System.Win32.Automation.Input
( module System.Win32.Automation.Input
, module System.Win32.Automation.Input.Key
, module System.Win32.Automation.Input.Mouse
) where
import Data.Bits ( (.|.) )
import Foreign.Ptr ( Ptr )
import Foreign.Storable ( Storable(..) )
import Foreign.Marshal.Array ( withArrayLen )
import Foreign.C.Types ( CIntPtr(..) )
import Graphics.Win32.Key ( VKey, c_MapVirtualKey )
import System.Win32.Automation.Input.Key
import System.Win32.Automation.Input.Mouse ( MOUSEINPUT )
import System.Win32.Automation.Input.Mouse hiding ( MOUSEINPUT(..) )
import System.Win32.Types ( UINT, LPARAM, failIfZero )
import System.Win32.Word ( DWORD, WORD )
#include "windows_cconv.h"
sendInput :: [INPUT] -> IO UINT
sendInput input
= withArrayLen input $ \len c_input ->
sendInputPtr len c_input
{-# INLINE sendInputPtr #-}
sendInputPtr :: Int -> Ptr INPUT -> IO UINT
sendInputPtr len c_input
= failIfZero "SendInput" $
c_SendInput (fromIntegral len) c_input $ sizeOf (undefined :: INPUT)
foreign import WINDOWS_CCONV unsafe "windows.h SendInput"
c_SendInput :: UINT -> LPINPUT -> Int -> IO UINT
makeKeyboardInput :: VKey -> Maybe DWORD -> IO INPUT
makeKeyboardInput vkey flag = do
let flag' = maybe kEYEVENTF_EXTENDEDKEY (kEYEVENTF_EXTENDEDKEY .|.) flag
scan <- c_MapVirtualKey vkey 0
dwExtraInfo' <- getMessageExtraInfo
return $ Keyboard
$ KEYBDINPUT {
wVk = fromIntegral vkey
, wScan = fromIntegral scan
, dwFlags = flag'
, time = 0
, dwExtraInfo = fromIntegral $ dwExtraInfo'
}
type PINPUT = Ptr INPUT
type LPINPUT = Ptr INPUT
data INPUT = Mouse MOUSEINPUT | Keyboard KEYBDINPUT | OtherHardware HARDWAREINPUT
deriving Show
instance Storable INPUT where
sizeOf = const (40)
{-# LINE 74 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
alignment _ = 8
{-# LINE 75 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
poke buf (Mouse mouse) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (0:: DWORD)
{-# LINE 78 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf mouse
{-# LINE 79 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
poke buf (Keyboard key) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (1 :: DWORD)
{-# LINE 81 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf key
{-# LINE 82 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
poke buf (OtherHardware hard) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (2 :: DWORD)
{-# LINE 84 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf hard
{-# LINE 85 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
peek buf = do
type' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf :: IO DWORD
{-# LINE 88 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
case type' of
0 ->
{-# LINE 90 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
Mouse `fmap` ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf
{-# LINE 91 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
1 ->
{-# LINE 92 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
Keyboard `fmap` ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf
{-# LINE 93 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
_ -> OtherHardware `fmap` ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf
{-# LINE 94 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
type PHARDWAREINPUT = Ptr HARDWAREINPUT
data HARDWAREINPUT = HARDWAREINPUT
{ uMsg :: DWORD
, wParamL :: WORD
, wParamH :: WORD
} deriving Show
instance Storable HARDWAREINPUT where
sizeOf = const (8)
{-# LINE 106 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
alignment _ = 4
{-# LINE 107 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
poke buf input = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (uMsg input)
{-# LINE 109 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) buf (wParamL input)
{-# LINE 110 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 6)) buf (wParamH input)
{-# LINE 111 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
peek buf = do
uMsg' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
{-# LINE 113 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
wParamL' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf
{-# LINE 114 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
wParamH' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6)) buf
{-# LINE 115 "libraries\\Win32\\System\\Win32\\Automation\\Input.hsc" #-}
return $ HARDWAREINPUT uMsg' wParamL' wParamH'
foreign import WINDOWS_CCONV unsafe "windows.h GetMessageExtraInfo"
getMessageExtraInfo :: IO LPARAM
foreign import WINDOWS_CCONV unsafe "windows.h SetMessageExtraInfo"
setMessageExtraInfo :: LPARAM -> IO LPARAM