-- GENERATED by C->Haskell Compiler, version 0.13.13 (gtk2hs branch) "Bin IO", 27 May 2012 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.chs" #-}
module Graphics.UI.Gtk.WebKit.DOM.KeyboardEvent(
getModifierState,
initKeyboardEvent,
pattern KEY_LOCATION_STANDARD,
pattern KEY_LOCATION_LEFT,
pattern KEY_LOCATION_RIGHT,
pattern KEY_LOCATION_NUMPAD,
getKeyIdentifier,
getKeyLocation,
getCtrlKey,
getShiftKey,
getAltKey,
getMetaKey,
getAltGraphKey,
KeyboardEvent,
castToKeyboardEvent,
gTypeKeyboardEvent,
KeyboardEventClass,
toKeyboardEvent,
) where
import Prelude hiding (drop, error, print)
import Data.Typeable (Typeable)
import Foreign.Marshal (maybePeek, maybeWith)
import System.Glib.FFI (maybeNull, withForeignPtr, nullForeignPtr, Ptr, nullPtr, castPtr, Word, Int64, Word64, CChar(..), CInt(..), CUInt(..), CLong(..), CULong(..), CLLong(..), CULLong(..), CShort(..), CUShort(..), CFloat(..), CDouble(..), toBool, fromBool)
import System.Glib.UTFString (GlibString(..), readUTFString)
import Control.Applicative ((<$>))
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(..))
import System.Glib.GError
import Graphics.UI.Gtk.WebKit.DOM.EventTargetClosures
import Graphics.UI.Gtk.WebKit.DOM.EventM
import Graphics.UI.Gtk.WebKit.Types
{-# LINE 39 "./Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.chs" #-}
import Graphics.UI.Gtk.WebKit.DOM.Enums

 
getModifierState ::
                 (MonadIO m, KeyboardEventClass self, GlibString string) =>
                   self -> string -> m Bool
getModifierState self keyIdentifierArg
  = liftIO
      (toBool <$>
         (withUTFString keyIdentifierArg $
            \ keyIdentifierArgPtr ->
              (\(KeyboardEvent arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_keyboard_event_get_modifier_state argPtr1 arg2)
{-# LINE 51 "./Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.chs" #-}
                (toKeyboardEvent self)
                keyIdentifierArgPtr))
 
initKeyboardEvent ::
                  (MonadIO m, KeyboardEventClass self, WindowClass view,
                   GlibString string) =>
                    self ->
                      string ->
                        Bool ->
                          Bool ->
                            Maybe view ->
                              string -> Word -> Bool -> Bool -> Bool -> Bool -> Bool -> m ()
initKeyboardEvent self type' canBubble cancelable view
  keyIdentifier location ctrlKey altKey shiftKey metaKey altGraphKey
  = liftIO
      (withUTFString keyIdentifier $
         \ keyIdentifierPtr ->
           withUTFString type' $
             \ typePtr ->
               (\(KeyboardEvent arg1) arg2 arg3 arg4 (Window arg5) arg6 arg7 arg8 arg9 arg10 arg11 arg12 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg5 $ \argPtr5 ->webkit_dom_keyboard_event_init_keyboard_event argPtr1 arg2 arg3 arg4 argPtr5 arg6 arg7 arg8 arg9 arg10 arg11 arg12)
{-# LINE 71 "./Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.chs" #-}
                 (toKeyboardEvent self)
                 typePtr
             (fromBool canBubble)
             (fromBool cancelable)
             (maybe (Window nullForeignPtr) toWindow view)
             keyIdentifierPtr
         (fromIntegral location)
         (fromBool ctrlKey)
         (fromBool altKey)
         (fromBool shiftKey)
         (fromBool metaKey)
         (fromBool altGraphKey))
pattern KEY_LOCATION_STANDARD = 0
pattern KEY_LOCATION_LEFT = 1
pattern KEY_LOCATION_RIGHT = 2
pattern KEY_LOCATION_NUMPAD = 3
 
getKeyIdentifier ::
                 (MonadIO m, KeyboardEventClass self, GlibString string) =>
                   self -> m string
getKeyIdentifier self
  = liftIO
      (((\(KeyboardEvent arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_keyboard_event_get_key_identifier argPtr1)
{-# LINE 94 "./Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.chs" #-}
          (toKeyboardEvent self))
         >>=
         readUTFString)
 
getKeyLocation ::
               (MonadIO m, KeyboardEventClass self) => self -> m Word
getKeyLocation self
  = liftIO
      (fromIntegral <$>
         ((\(KeyboardEvent arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_keyboard_event_get_key_location argPtr1)
{-# LINE 104 "./Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.chs" #-}
            (toKeyboardEvent self)))
 
getCtrlKey ::
           (MonadIO m, KeyboardEventClass self) => self -> m Bool
getCtrlKey self
  = liftIO
      (toBool <$>
         ((\(KeyboardEvent arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_keyboard_event_get_ctrl_key argPtr1)
{-# LINE 112 "./Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.chs" #-}
            (toKeyboardEvent self)))
 
getShiftKey ::
            (MonadIO m, KeyboardEventClass self) => self -> m Bool
getShiftKey self
  = liftIO
      (toBool <$>
         ((\(KeyboardEvent arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_keyboard_event_get_shift_key argPtr1)
{-# LINE 120 "./Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.chs" #-}
            (toKeyboardEvent self)))
 
getAltKey :: (MonadIO m, KeyboardEventClass self) => self -> m Bool
getAltKey self
  = liftIO
      (toBool <$>
         ((\(KeyboardEvent arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_keyboard_event_get_alt_key argPtr1)
{-# LINE 127 "./Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.chs" #-}
            (toKeyboardEvent self)))
 
getMetaKey ::
           (MonadIO m, KeyboardEventClass self) => self -> m Bool
getMetaKey self
  = liftIO
      (toBool <$>
         ((\(KeyboardEvent arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_keyboard_event_get_meta_key argPtr1)
{-# LINE 135 "./Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.chs" #-}
            (toKeyboardEvent self)))
 
getAltGraphKey ::
               (MonadIO m, KeyboardEventClass self) => self -> m Bool
getAltGraphKey self
  = liftIO
      (toBool <$>
         ((\(KeyboardEvent arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_keyboard_event_get_alt_graph_key argPtr1)
{-# LINE 143 "./Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.chs" #-}
            (toKeyboardEvent self)))


foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.h webkit_dom_keyboard_event_get_modifier_state"
  webkit_dom_keyboard_event_get_modifier_state :: ((Ptr KeyboardEvent) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.h webkit_dom_keyboard_event_init_keyboard_event"
  webkit_dom_keyboard_event_init_keyboard_event :: ((Ptr KeyboardEvent) -> ((Ptr CChar) -> (CInt -> (CInt -> ((Ptr Window) -> ((Ptr CChar) -> (CULong -> (CInt -> (CInt -> (CInt -> (CInt -> (CInt -> (IO ())))))))))))))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.h webkit_dom_keyboard_event_get_key_identifier"
  webkit_dom_keyboard_event_get_key_identifier :: ((Ptr KeyboardEvent) -> (IO (Ptr CChar)))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.h webkit_dom_keyboard_event_get_key_location"
  webkit_dom_keyboard_event_get_key_location :: ((Ptr KeyboardEvent) -> (IO CULong))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.h webkit_dom_keyboard_event_get_ctrl_key"
  webkit_dom_keyboard_event_get_ctrl_key :: ((Ptr KeyboardEvent) -> (IO CInt))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.h webkit_dom_keyboard_event_get_shift_key"
  webkit_dom_keyboard_event_get_shift_key :: ((Ptr KeyboardEvent) -> (IO CInt))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.h webkit_dom_keyboard_event_get_alt_key"
  webkit_dom_keyboard_event_get_alt_key :: ((Ptr KeyboardEvent) -> (IO CInt))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.h webkit_dom_keyboard_event_get_meta_key"
  webkit_dom_keyboard_event_get_meta_key :: ((Ptr KeyboardEvent) -> (IO CInt))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/KeyboardEvent.h webkit_dom_keyboard_event_get_alt_graph_key"
  webkit_dom_keyboard_event_get_alt_graph_key :: ((Ptr KeyboardEvent) -> (IO CInt))