-- 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/WebKitPoint.chs" #-}
module Graphics.UI.Gtk.WebKit.DOM.WebKitPoint(
setX,
getX,
setY,
getY,
WebKitPoint,
castToWebKitPoint,
gTypeWebKitPoint,
WebKitPointClass,
toWebKitPoint,
) 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 23 "./Graphics/UI/Gtk/WebKit/DOM/WebKitPoint.chs" #-}
import Graphics.UI.Gtk.WebKit.DOM.Enums

 
setX :: (MonadIO m, WebKitPointClass self) => self -> Float -> m ()
setX self val
  = liftIO
      ((\(WebKitPoint arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_webkit_point_set_x argPtr1 arg2) (toWebKitPoint self)
         (realToFrac val))
 
getX :: (MonadIO m, WebKitPointClass self) => self -> m Float
getX self
  = liftIO
      (realToFrac <$>
         ((\(WebKitPoint arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_webkit_point_get_x argPtr1) (toWebKitPoint self)))
 
setY :: (MonadIO m, WebKitPointClass self) => self -> Float -> m ()
setY self val
  = liftIO
      ((\(WebKitPoint arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_webkit_point_set_y argPtr1 arg2) (toWebKitPoint self)
         (realToFrac val))
 
getY :: (MonadIO m, WebKitPointClass self) => self -> m Float
getY self
  = liftIO
      (realToFrac <$>
         ((\(WebKitPoint arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_webkit_point_get_y argPtr1) (toWebKitPoint self)))

foreign import ccall safe "webkit_dom_webkit_point_set_x"
  webkit_dom_webkit_point_set_x :: ((Ptr WebKitPoint) -> (CFloat -> (IO ())))

foreign import ccall safe "webkit_dom_webkit_point_get_x"
  webkit_dom_webkit_point_get_x :: ((Ptr WebKitPoint) -> (IO CFloat))

foreign import ccall safe "webkit_dom_webkit_point_set_y"
  webkit_dom_webkit_point_set_y :: ((Ptr WebKitPoint) -> (CFloat -> (IO ())))

foreign import ccall safe "webkit_dom_webkit_point_get_y"
  webkit_dom_webkit_point_get_y :: ((Ptr WebKitPoint) -> (IO CFloat))