{-# LINE 1 "System\\Win32\\Automation\\Input.hsc" #-}

{-# LANGUAGE CPP #-}

{- |

   Module      :  System.Win32.Automation.Input

   Copyright   :  2013 shelarcy

   License     :  BSD-style



   Maintainer  :  shelarcy@gmail.com

   Stability   :  Provisional

   Portability :  Non-portable (Win32 API)



   Provide sendInput function and INPUT types.

-}

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 #-}

-- | Raw pointer of array version of 'sendInput'.

-- Use this function to support non-list sequence.

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 "System\\Win32\\Automation\\Input.hsc" #-}

    alignment _ = 8

{-# LINE 75 "System\\Win32\\Automation\\Input.hsc" #-}



    poke buf (Mouse mouse) = do

        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (0:: DWORD)

{-# LINE 78 "System\\Win32\\Automation\\Input.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf mouse

{-# LINE 79 "System\\Win32\\Automation\\Input.hsc" #-}

    poke buf (Keyboard key) = do

        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (1 :: DWORD)

{-# LINE 81 "System\\Win32\\Automation\\Input.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf key

{-# LINE 82 "System\\Win32\\Automation\\Input.hsc" #-}

    poke buf (OtherHardware hard) = do

        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (2 :: DWORD)

{-# LINE 84 "System\\Win32\\Automation\\Input.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) buf hard

{-# LINE 85 "System\\Win32\\Automation\\Input.hsc" #-}



    peek buf = do

        type'  <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf :: IO DWORD

{-# LINE 88 "System\\Win32\\Automation\\Input.hsc" #-}

        case type' of

          0 ->

{-# LINE 90 "System\\Win32\\Automation\\Input.hsc" #-}

              Mouse `fmap` ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf

{-# LINE 91 "System\\Win32\\Automation\\Input.hsc" #-}

          1 ->

{-# LINE 92 "System\\Win32\\Automation\\Input.hsc" #-}

              Keyboard `fmap` ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf

{-# LINE 93 "System\\Win32\\Automation\\Input.hsc" #-}

          _ -> OtherHardware `fmap` ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf

{-# LINE 94 "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 "System\\Win32\\Automation\\Input.hsc" #-}

    alignment _ = 4

{-# LINE 107 "System\\Win32\\Automation\\Input.hsc" #-}

    poke buf input = do

        ((\hsc_ptr -> pokeByteOff hsc_ptr 0))    buf (uMsg input)

{-# LINE 109 "System\\Win32\\Automation\\Input.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) buf (wParamL input)

{-# LINE 110 "System\\Win32\\Automation\\Input.hsc" #-}

        ((\hsc_ptr -> pokeByteOff hsc_ptr 6)) buf (wParamH input)

{-# LINE 111 "System\\Win32\\Automation\\Input.hsc" #-}

    peek buf = do

        uMsg'    <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf

{-# LINE 113 "System\\Win32\\Automation\\Input.hsc" #-}

        wParamL' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf

{-# LINE 114 "System\\Win32\\Automation\\Input.hsc" #-}

        wParamH' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6)) buf

{-# LINE 115 "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