-- GENERATED by C->Haskell Compiler, version 0.16.3 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Graphics/X11/XInput/Foreign.chs" #-}{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
{-|
This module contains FFI imports and thin wrappers for them.
-}
module Graphics.X11.XInput.Foreign
  (-- * XInput initialization
   xinputVersion,
   setEventMask,
   -- * Wrappers for XInput calls
   queryDevice,
   grabDevice, ungrabDevice,
   grabButton, ungrabButton,
   grabKeycode, ungrabKeycode,
   -- * FFI imports
   xiQueryDevice,
   xQueryExtension,
   getEventData,
   freeEventData
  ) where


import Control.Applicative
import Control.Monad
import Data.Bits
import Foreign.C
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import qualified Graphics.X11 as X11

import Graphics.X11.XInput.Types
import Graphics.X11.XInput.Parser

-- | Query list of devices
queryDevice :: X11.Display
            -> SelectDevices   -- ^ Which devices to list
            -> IO [DeviceInfo]
queryDevice dpy devs = do
  alloca $ \nptr -> do
    dptr <- xiQueryDevice dpy (selectDevices devs) nptr
    n <- peek nptr
    let sz = 28
{-# LINE 45 "./Graphics/X11/XInput/Foreign.chs" #-}
        offsets = take (fromIntegral n) [0, sz ..]
        dptrs = map (plusPtr dptr) offsets
    forM dptrs peekStruct

foreign import ccall "Foreign.chs.h XIQueryDevice"
  xiQueryDevice :: X11.Display -> CInt -> Ptr CInt -> IO DeviceInfoPtr

foreign import ccall "Foreign.chs.h XQueryExtension"
  xQueryExtension :: X11.Display -> CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CInt

foreign import ccall "Foreign.chs.h XIQueryVersion"
  xinputVersion :: X11.Display -> Ptr CInt -> Ptr CInt -> IO CInt

getEventData :: X11.Display -> EventCookiePtr -> IO (Bool)
getEventData a1 a2 =
  let {a1' = display2ptr a1} in 
  let {a2' = castPtr a2} in 
  getEventData'_ a1' a2' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 60 "./Graphics/X11/XInput/Foreign.chs" #-}

freeEventData :: X11.Display -> EventCookiePtr -> IO ()
freeEventData a1 a2 =
  let {a1' = display2ptr a1} in 
  let {a2' = castPtr a2} in 
  freeEventData'_ a1' a2' >>= \res ->
  return ()
{-# LINE 63 "./Graphics/X11/XInput/Foreign.chs" #-}

pokeAlloca :: Storable a => a -> (Ptr a -> IO b) -> IO b
pokeAlloca x f =
  alloca $ \ptr -> do
    poke ptr x
    f ptr

selectEvents :: X11.Display -> X11.Window -> EventMaskPtr -> Int -> IO ()
selectEvents a1 a2 a3 a4 =
  let {a1' = display2ptr a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = castPtr a3} in 
  let {a4' = fromIntegral a4} in 
  selectEvents'_ a1' a2' a3' a4' >>= \res ->
  return ()
{-# LINE 74 "./Graphics/X11/XInput/Foreign.chs" #-}

foreign import ccall unsafe "Foreign.chs.h XIGrabDevice"
    xiGrabDevice :: X11.Display
                 -> DeviceID
                 -> X11.Window
                 -> X11.Time
                 -> X11.Cursor
                 -> X11.GrabMode
                 -> X11.GrabMode
                 -> CInt
                 -> EventMaskPtr
                 -> IO CInt

foreign import ccall unsafe "Foreign.chs.h XIUngrabDevice"
    xiUngrabDevice :: X11.Display
                   -> DeviceID
                   -> X11.Time
                   -> IO X11.Status

foreign import ccall unsafe "Foreign.chs.h XIGrabButton"
    xiGrabButton :: X11.Display
                 -> DeviceID
                 -> CInt
                 -> X11.Window
                 -> X11.Cursor
                 -> X11.GrabMode
                 -> X11.GrabMode
                 -> CInt
                 -> EventMaskPtr
                 -> CInt
                 -> GrabModifiersPtr
                 -> IO CInt

foreign import ccall unsafe "Foreign.chs.h XIUngrabButton"
  xiUngrabButton :: X11.Display
                 -> DeviceID
                 -> X11.Button
                 -> X11.Window
                 -> CInt
                 -> GrabModifiersPtr
                 -> IO X11.Status

foreign import ccall unsafe "Foreign.chs.h XIGrabKeycode"
  xiGrabKeycode :: X11.Display
                -> DeviceID
                -> X11.KeyCode
                -> X11.Window
                -> X11.GrabMode
                -> X11.GrabMode
                -> CInt
                -> EventMaskPtr
                -> CInt
                -> GrabModifiersPtr
                -> IO CInt

foreign import ccall unsafe "Foreign.chs.h XIUngrabKeycode"
  xiUngrabKeycode :: X11.Display
                 -> DeviceID
                 -> X11.KeyCode
                 -> X11.Window
                 -> CInt
                 -> GrabModifiersPtr
                 -> IO X11.Status

grabDevice :: X11.Display
           -> DeviceID
           -> X11.Window
           -> X11.Cursor
           -> X11.GrabMode
           -> X11.GrabMode
           -> Bool
           -> EventMask 
           -> IO X11.Status
grabDevice dpy dev win cursor
           grab_mode paired_mode owner_events mask =
  pokeAlloca mask $ \maskPtr ->
    xiGrabDevice dpy dev win 0 cursor
                 grab_mode paired_mode
                 (fromBool owner_events)
                 maskPtr

ungrabDevice :: X11.Display
             -> DeviceID
             -> IO X11.Status
ungrabDevice dpy dev =
   xiUngrabDevice dpy dev 0

grabButton :: X11.Display
           -> SelectDevices
           -> X11.Button
           -> X11.Window
           -> X11.Cursor
           -> X11.GrabMode
           -> X11.GrabMode
           -> Bool
           -> [EventType]
           -> [GrabModifiers]
           -> IO [GrabModifiers]
grabButton dpy dev btn win cursor
           grab_mode paired_mode owner_events
           events mods = do
  let nMods = length mods
  allocaArray nMods $ \modsPtr ->
    withEventMask dpy win events $ \maskPtr -> do
      pokeArray modsPtr mods
      n <- xiGrabButton dpy (selectDevices dev)
                        (fromIntegral btn) win cursor
                        grab_mode paired_mode
                        (fromBool owner_events)
                        maskPtr
                        (fromIntegral nMods)
                        modsPtr
      peekArray (fromIntegral n) modsPtr

ungrabButton :: X11.Display
             -> SelectDevices
             -> X11.Button
             -> X11.Window
             -> [GrabModifiers]
             -> IO X11.Status
ungrabButton dpy dev btn win mods = do
  let nMods = length mods
  allocaArray nMods $ \modsPtr -> do
    xiUngrabButton dpy (selectDevices dev)
                   (fromIntegral btn) win
                   (fromIntegral nMods)
                   modsPtr

grabKeycode  :: X11.Display
             -> SelectDevices
             -> X11.KeyCode
             -> X11.Window
             -> X11.GrabMode
             -> X11.GrabMode
             -> Bool
             -> [EventType]
             -> [GrabModifiers]
             -> IO [GrabModifiers]
grabKeycode dpy dev btn win
            grab_mode paired_mode owner_events
            events mods = do
  let nMods = length mods
  allocaArray nMods $ \modsPtr ->
    withEventMask dpy win events $ \maskPtr -> do
      pokeArray modsPtr mods
      n <- xiGrabKeycode dpy (selectDevices dev)
                         (fromIntegral btn) win
                         grab_mode paired_mode
                         (fromBool owner_events)
                         maskPtr
                         (fromIntegral nMods)
                         modsPtr
      peekArray (fromIntegral n) modsPtr

ungrabKeycode :: X11.Display
             -> SelectDevices
             -> X11.KeyCode
             -> X11.Window
             -> [GrabModifiers]
             -> IO X11.Status
ungrabKeycode dpy dev btn win mods = do
  let nMods = length mods
  allocaArray nMods $ \modsPtr -> do
    xiUngrabKeycode dpy (selectDevices dev)
                    (fromIntegral btn) win
                    (fromIntegral nMods)
                    modsPtr

addMask :: Ptr CUChar -> EventType -> IO ()
addMask ptr t = do
  let event = eventType2int t
      offset = fromIntegral $ event `shiftR` 3
      mask  = (1 `shiftL` (event .&. 7)) :: CUChar
  value <- peekByteOff ptr offset :: IO CUChar
  let newValue = value .|. mask
  pokeByteOff ptr offset newValue

-- | Select XInput events.
setEventMask :: X11.Display
             -> X11.Window
             -> [EventType] -- ^ List of events to listen
             -> IO ()
setEventMask dpy win list =
  withEventMask dpy win list $ \maskptr ->
      selectEvents dpy win maskptr 1

withEventMask :: X11.Display
              -> X11.Window
              -> [EventType]
              -> (EventMaskPtr -> IO a)
              -> IO a
withEventMask dpy win list callback = do
  let len = (eventType2int XI_RawMotion + 7) `shiftR` 3
  allocaBytes (fromIntegral len) $ \(maskptr :: EventMaskPtr) -> do
    (\ptr val -> do {pokeByteOff ptr 0 (val::CInt)}) maskptr 0
    (\ptr val -> do {pokeByteOff ptr 4 (val::CInt)}) maskptr len
    allocaArray (fromIntegral len) $ \mask -> do
      forM list $ addMask mask
      (\ptr val -> do {pokeByteOff ptr 8 (val::(Ptr CUChar))})     maskptr mask
      callback maskptr


foreign import ccall unsafe "Graphics/X11/XInput/Foreign.chs.h XGetEventData"
  getEventData'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall unsafe "Graphics/X11/XInput/Foreign.chs.h XFreeEventData"
  freeEventData'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO ())))

foreign import ccall unsafe "Graphics/X11/XInput/Foreign.chs.h XISelectEvents"
  selectEvents'_ :: ((Ptr ()) -> (CULong -> ((Ptr ()) -> (CInt -> (IO CInt)))))