{-# LINE 1 "System\\Win32\\Automation\\Input.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LINE 2 "System\\Win32\\Automation\\Input.hsc" #-}
{- |
   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 )


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

{-# LINE 33 "System\\Win32\\Automation\\Input.hsc" #-}
#include "windows_cconv.h"

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

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