-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Gdk.Functions
    ( 

 -- * Methods


-- ** cairoDrawFromGl #method:cairoDrawFromGl#

    cairoDrawFromGl                         ,


-- ** cairoRectangle #method:cairoRectangle#

    cairoRectangle                          ,


-- ** cairoRegion #method:cairoRegion#

    cairoRegion                             ,


-- ** cairoRegionCreateFromSurface #method:cairoRegionCreateFromSurface#

    cairoRegionCreateFromSurface            ,


-- ** cairoSetSourcePixbuf #method:cairoSetSourcePixbuf#

    cairoSetSourcePixbuf                    ,


-- ** cairoSetSourceRgba #method:cairoSetSourceRgba#

    cairoSetSourceRgba                      ,


-- ** contentDeserializeAsync #method:contentDeserializeAsync#

    contentDeserializeAsync                 ,


-- ** contentDeserializeFinish #method:contentDeserializeFinish#

    contentDeserializeFinish                ,


-- ** contentRegisterDeserializer #method:contentRegisterDeserializer#

    contentRegisterDeserializer             ,


-- ** contentRegisterSerializer #method:contentRegisterSerializer#

    contentRegisterSerializer               ,


-- ** contentSerializeAsync #method:contentSerializeAsync#

    contentSerializeAsync                   ,


-- ** contentSerializeFinish #method:contentSerializeFinish#

    contentSerializeFinish                  ,


-- ** eventsGetAngle #method:eventsGetAngle#

    eventsGetAngle                          ,


-- ** eventsGetCenter #method:eventsGetCenter#

    eventsGetCenter                         ,


-- ** eventsGetDistance #method:eventsGetDistance#

    eventsGetDistance                       ,


-- ** internMimeType #method:internMimeType#

    internMimeType                          ,


-- ** keyvalConvertCase #method:keyvalConvertCase#

    keyvalConvertCase                       ,


-- ** keyvalFromName #method:keyvalFromName#

    keyvalFromName                          ,


-- ** keyvalIsLower #method:keyvalIsLower#

    keyvalIsLower                           ,


-- ** keyvalIsUpper #method:keyvalIsUpper#

    keyvalIsUpper                           ,


-- ** keyvalName #method:keyvalName#

    keyvalName                              ,


-- ** keyvalToLower #method:keyvalToLower#

    keyvalToLower                           ,


-- ** keyvalToUnicode #method:keyvalToUnicode#

    keyvalToUnicode                         ,


-- ** keyvalToUpper #method:keyvalToUpper#

    keyvalToUpper                           ,


-- ** pixbufGetFromSurface #method:pixbufGetFromSurface#

    pixbufGetFromSurface                    ,


-- ** pixbufGetFromTexture #method:pixbufGetFromTexture#

    pixbufGetFromTexture                    ,


-- ** setAllowedBackends #method:setAllowedBackends#

    setAllowedBackends                      ,


-- ** toplevelSizeGetType #method:toplevelSizeGetType#

    toplevelSizeGetType                     ,


-- ** unicodeToKeyval #method:unicodeToKeyval#

    unicodeToKeyval                         ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.Region as Cairo.Region
import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.Gdk.Callbacks as Gdk.Callbacks
import {-# SOURCE #-} qualified GI.Gdk.Objects.Event as Gdk.Event
import {-# SOURCE #-} qualified GI.Gdk.Objects.Surface as Gdk.Surface
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture
import {-# SOURCE #-} qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import {-# SOURCE #-} qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream

-- function unicode_to_keyval
-- Args: [ Arg
--           { argCName = "wc"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a Unicode character"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_unicode_to_keyval" gdk_unicode_to_keyval :: 
    Word32 ->                               -- wc : TBasicType TUInt32
    IO Word32

-- | Convert from a Unicode character to a key symbol.
unicodeToKeyval ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@wc@/: a Unicode character
    -> m Word32
    -- ^ __Returns:__ the corresponding GDK key symbol, if one exists.
    --   or, if there is no corresponding symbol, wc | 0x01000000
unicodeToKeyval :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Word32
unicodeToKeyval Word32
wc = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Word32
result <- Word32 -> IO Word32
gdk_unicode_to_keyval Word32
wc
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function toplevel_size_get_type
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_toplevel_size_get_type" gdk_toplevel_size_get_type :: 
    IO CGType

-- | /No description available in the introspection data./
toplevelSizeGetType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m GType
toplevelSizeGetType :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m GType
toplevelSizeGetType  = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    CGType
result <- IO CGType
gdk_toplevel_size_get_type
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'


-- function set_allowed_backends
-- Args: [ Arg
--           { argCName = "backends"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a comma-separated list of backends"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_set_allowed_backends" gdk_set_allowed_backends :: 
    CString ->                              -- backends : TBasicType TUTF8
    IO ()

-- | Sets a list of backends that GDK should try to use.
-- 
-- This can be useful if your application does not
-- work with certain GDK backends.
-- 
-- By default, GDK tries all included backends.
-- 
-- For example:
-- 
-- 
-- === /c code/
-- >gdk_set_allowed_backends ("wayland,macos,*");
-- 
-- 
-- instructs GDK to try the Wayland backend first, followed by the
-- MacOs backend, and then all others.
-- 
-- If the @GDK_BACKEND@ environment variable is set, it determines
-- what backends are tried in what order, while still respecting the
-- set of allowed backends that are specified by this function.
-- 
-- The possible backend names are:
-- 
--   - @broadway@
--   - @macos@
--   - @wayland@.
--   - @win32@
--   - @x11@
-- 
-- You can also include a @*@ in the list to try all remaining backends.
-- 
-- This call must happen prior to functions that open a display, such
-- as [func/@gdk@/.Display.open], @gtk_init()@, or @gtk_init_check()@
-- in order to take effect.
setAllowedBackends ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@backends@/: a comma-separated list of backends
    -> m ()
setAllowedBackends :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
setAllowedBackends Text
backends = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
backends' <- Text -> IO CString
textToCString Text
backends
    CString -> IO ()
gdk_set_allowed_backends CString
backends'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
backends'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function pixbuf_get_from_texture
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkTexture`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_pixbuf_get_from_texture" gdk_pixbuf_get_from_texture :: 
    Ptr Gdk.Texture.Texture ->              -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Creates a new pixbuf from /@texture@/.
-- 
-- This should generally not be used in newly written code as later
-- stages will almost certainly convert the pixbuf back into a texture
-- to draw it on screen.
pixbufGetFromTexture ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Texture.IsTexture a) =>
    a
    -- ^ /@texture@/: a @GdkTexture@
    -> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)
    -- ^ __Returns:__ a new @GdkPixbuf@
pixbufGetFromTexture :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m (Maybe Pixbuf)
pixbufGetFromTexture a
texture = IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pixbuf) -> m (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    Ptr Pixbuf
result <- Ptr Texture -> IO (Ptr Pixbuf)
gdk_pixbuf_get_from_texture Ptr Texture
texture'
    Maybe Pixbuf
maybeResult <- Ptr Pixbuf -> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pixbuf
result ((Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf))
-> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
result' -> do
        Pixbuf
result'' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result'
        Pixbuf -> IO Pixbuf
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Maybe Pixbuf -> IO (Maybe Pixbuf)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pixbuf
maybeResult


-- function pixbuf_get_from_surface
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "surface to copy from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Source X coordinate within @surface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Source Y coordinate within @surface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Width in pixels of region to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Height in pixels of region to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_pixbuf_get_from_surface" gdk_pixbuf_get_from_surface :: 
    Ptr Cairo.Surface.Surface ->            -- surface : TInterface (Name {namespace = "cairo", name = "Surface"})
    Int32 ->                                -- src_x : TBasicType TInt
    Int32 ->                                -- src_y : TBasicType TInt
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Transfers image data from a @cairo_surface_t@ and converts it
-- to a @GdkPixbuf@.
-- 
-- This allows you to efficiently read individual pixels from cairo surfaces.
-- 
-- This function will create an RGB pixbuf with 8 bits per channel.
-- The pixbuf will contain an alpha channel if the /@surface@/ contains one.
pixbufGetFromSurface ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cairo.Surface.Surface
    -- ^ /@surface@/: surface to copy from
    -> Int32
    -- ^ /@srcX@/: Source X coordinate within /@surface@/
    -> Int32
    -- ^ /@srcY@/: Source Y coordinate within /@surface@/
    -> Int32
    -- ^ /@width@/: Width in pixels of region to get
    -> Int32
    -- ^ /@height@/: Height in pixels of region to get
    -> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)
    -- ^ __Returns:__ A newly-created pixbuf with a
    --   reference count of 1
pixbufGetFromSurface :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Surface -> Int32 -> Int32 -> Int32 -> Int32 -> m (Maybe Pixbuf)
pixbufGetFromSurface Surface
surface Int32
srcX Int32
srcY Int32
width Int32
height = IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pixbuf) -> m (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Surface
surface' <- Surface -> IO (Ptr Surface)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Surface
surface
    Ptr Pixbuf
result <- Ptr Surface -> Int32 -> Int32 -> Int32 -> Int32 -> IO (Ptr Pixbuf)
gdk_pixbuf_get_from_surface Ptr Surface
surface' Int32
srcX Int32
srcY Int32
width Int32
height
    Maybe Pixbuf
maybeResult <- Ptr Pixbuf -> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pixbuf
result ((Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf))
-> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
result' -> do
        Pixbuf
result'' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result'
        Pixbuf -> IO Pixbuf
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result''
    Surface -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Surface
surface
    Maybe Pixbuf -> IO (Maybe Pixbuf)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pixbuf
maybeResult


-- function keyval_to_upper
-- Args: [ Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a key value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keyval_to_upper" gdk_keyval_to_upper :: 
    Word32 ->                               -- keyval : TBasicType TUInt
    IO Word32

-- | Converts a key value to upper case, if applicable.
keyvalToUpper ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@keyval@/: a key value.
    -> m Word32
    -- ^ __Returns:__ the upper case form of /@keyval@/, or /@keyval@/ itself if it is already
    --   in upper case or it is not subject to case conversion.
keyvalToUpper :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Word32
keyvalToUpper Word32
keyval = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Word32
result <- Word32 -> IO Word32
gdk_keyval_to_upper Word32
keyval
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function keyval_to_unicode
-- Args: [ Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GDK key symbol" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keyval_to_unicode" gdk_keyval_to_unicode :: 
    Word32 ->                               -- keyval : TBasicType TUInt
    IO Word32

-- | Convert from a GDK key symbol to the corresponding Unicode
-- character.
-- 
-- Note that the conversion does not take the current locale
-- into consideration, which might be expected for particular
-- keyvals, such as 'GI.Gdk.Constants.KEY_KP_Decimal'.
keyvalToUnicode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@keyval@/: a GDK key symbol
    -> m Word32
    -- ^ __Returns:__ the corresponding unicode character, or 0 if there
    --   is no corresponding character.
keyvalToUnicode :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Word32
keyvalToUnicode Word32
keyval = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Word32
result <- Word32 -> IO Word32
gdk_keyval_to_unicode Word32
keyval
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function keyval_to_lower
-- Args: [ Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a key value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keyval_to_lower" gdk_keyval_to_lower :: 
    Word32 ->                               -- keyval : TBasicType TUInt
    IO Word32

-- | Converts a key value to lower case, if applicable.
keyvalToLower ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@keyval@/: a key value.
    -> m Word32
    -- ^ __Returns:__ the lower case form of /@keyval@/, or /@keyval@/ itself if it is already
    --  in lower case or it is not subject to case conversion.
keyvalToLower :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Word32
keyvalToLower Word32
keyval = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Word32
result <- Word32 -> IO Word32
gdk_keyval_to_lower Word32
keyval
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function keyval_name
-- Args: [ Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a key value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keyval_name" gdk_keyval_name :: 
    Word32 ->                               -- keyval : TBasicType TUInt
    IO CString

-- | Converts a key value into a symbolic name.
-- 
-- The names are the same as those in the
-- @gdk\/gdkkeysyms.h@ header file
-- but without the leading “GDK_KEY_”.
keyvalName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@keyval@/: a key value
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a string containing the name
    --   of the key
keyvalName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m (Maybe Text)
keyvalName Word32
keyval = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    CString
result <- Word32 -> IO CString
gdk_keyval_name Word32
keyval
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult


-- function keyval_is_upper
-- Args: [ Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a key value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keyval_is_upper" gdk_keyval_is_upper :: 
    Word32 ->                               -- keyval : TBasicType TUInt
    IO CInt

-- | Returns 'P.True' if the given key value is in upper case.
keyvalIsUpper ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@keyval@/: a key value.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@keyval@/ is in upper case, or if /@keyval@/ is not subject to
    --  case conversion.
keyvalIsUpper :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Word32 -> m Bool
keyvalIsUpper Word32
keyval = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CInt
result <- Word32 -> IO CInt
gdk_keyval_is_upper Word32
keyval
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function keyval_is_lower
-- Args: [ Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a key value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keyval_is_lower" gdk_keyval_is_lower :: 
    Word32 ->                               -- keyval : TBasicType TUInt
    IO CInt

-- | Returns 'P.True' if the given key value is in lower case.
keyvalIsLower ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@keyval@/: a key value.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@keyval@/ is in lower case, or if /@keyval@/ is not
    --   subject to case conversion.
keyvalIsLower :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Word32 -> m Bool
keyvalIsLower Word32
keyval = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CInt
result <- Word32 -> IO CInt
gdk_keyval_is_lower Word32
keyval
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function keyval_from_name
-- Args: [ Arg
--           { argCName = "keyval_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a key name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keyval_from_name" gdk_keyval_from_name :: 
    CString ->                              -- keyval_name : TBasicType TUTF8
    IO Word32

-- | Converts a key name to a key value.
-- 
-- The names are the same as those in the
-- @gdk\/gdkkeysyms.h@ header file
-- but without the leading “GDK_KEY_”.
keyvalFromName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@keyvalName@/: a key name
    -> m Word32
    -- ^ __Returns:__ the corresponding key value, or 'GI.Gdk.Constants.KEY_VoidSymbol'
    --   if the key name is not a valid key
keyvalFromName :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Word32
keyvalFromName Text
keyvalName = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    CString
keyvalName' <- Text -> IO CString
textToCString Text
keyvalName
    Word32
result <- CString -> IO Word32
gdk_keyval_from_name CString
keyvalName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keyvalName'
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function keyval_convert_case
-- Args: [ Arg
--           { argCName = "symbol"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a keyval" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "lower"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for lowercase version of @symbol"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "upper"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for uppercase version of @symbol"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_keyval_convert_case" gdk_keyval_convert_case :: 
    Word32 ->                               -- symbol : TBasicType TUInt
    Ptr Word32 ->                           -- lower : TBasicType TUInt
    Ptr Word32 ->                           -- upper : TBasicType TUInt
    IO ()

-- | Obtains the upper- and lower-case versions of the keyval /@symbol@/.
-- 
-- Examples of keyvals are @GDK_KEY_a@, @GDK_KEY_Enter@, @GDK_KEY_F1@, etc.
keyvalConvertCase ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@symbol@/: a keyval
    -> m ((Word32, Word32))
keyvalConvertCase :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m (Word32, Word32)
keyvalConvertCase Word32
symbol = IO (Word32, Word32) -> m (Word32, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word32, Word32) -> m (Word32, Word32))
-> IO (Word32, Word32) -> m (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Word32
lower <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
upper <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Word32 -> Ptr Word32 -> Ptr Word32 -> IO ()
gdk_keyval_convert_case Word32
symbol Ptr Word32
lower Ptr Word32
upper
    Word32
lower' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
lower
    Word32
upper' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
upper
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
lower
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
upper
    (Word32, Word32) -> IO (Word32, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
lower', Word32
upper')


-- function intern_mime_type
-- Args: [ Arg
--           { argCName = "string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "string of a potential mime type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_intern_mime_type" gdk_intern_mime_type :: 
    CString ->                              -- string : TBasicType TUTF8
    IO CString

-- | Canonicalizes the given mime type and interns the result.
-- 
-- If /@string@/ is not a valid mime type, 'P.Nothing' is returned instead.
-- See RFC 2048 for the syntax if mime types.
internMimeType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@string@/: string of a potential mime type
    -> m (Maybe T.Text)
    -- ^ __Returns:__ An interned string for the canonicalized
    --   mime type or 'P.Nothing' if the string wasn\'t a valid mime type
internMimeType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe Text)
internMimeType Text
string = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    CString
string' <- Text -> IO CString
textToCString Text
string
    CString
result <- CString -> IO CString
gdk_intern_mime_type CString
string'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
string'
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult


-- function events_get_distance
-- Args: [ Arg
--           { argCName = "event1"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first `GdkEvent`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event2"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second `GdkEvent`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "distance"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the distance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_events_get_distance" gdk_events_get_distance :: 
    Ptr Gdk.Event.Event ->                  -- event1 : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Gdk.Event.Event ->                  -- event2 : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CDouble ->                          -- distance : TBasicType TDouble
    IO CInt

-- | Returns the distance between the event locations.
-- 
-- This assumes that both events have X\/Y information.
-- If not, this function returns 'P.False'.
eventsGetDistance ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Event.IsEvent a, Gdk.Event.IsEvent b) =>
    a
    -- ^ /@event1@/: first @GdkEvent@
    -> b
    -- ^ /@event2@/: second @GdkEvent@
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.True' if the distance could be calculated.
eventsGetDistance :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEvent a, IsEvent b) =>
a -> b -> m (Bool, Double)
eventsGetDistance a
event1 b
event2 = IO (Bool, Double) -> m (Bool, Double)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double) -> m (Bool, Double))
-> IO (Bool, Double) -> m (Bool, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event1' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event1
    Ptr Event
event2' <- b -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
event2
    Ptr CDouble
distance <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr Event -> Ptr CDouble -> IO CInt
gdk_events_get_distance Ptr Event
event1' Ptr Event
event2' Ptr CDouble
distance
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
distance' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
distance
    let distance'' :: Double
distance'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
distance'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event1
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
event2
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
distance
    (Bool, Double) -> IO (Bool, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
distance'')


-- function events_get_center
-- Args: [ Arg
--           { argCName = "event1"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first `GdkEvent`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event2"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second `GdkEvent`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the X coordinate of the center"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the Y coordinate of the center"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_events_get_center" gdk_events_get_center :: 
    Ptr Gdk.Event.Event ->                  -- event1 : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Gdk.Event.Event ->                  -- event2 : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CDouble ->                          -- x : TBasicType TDouble
    Ptr CDouble ->                          -- y : TBasicType TDouble
    IO CInt

-- | Returns the point halfway between the events\' positions.
-- 
-- This assumes that both events have X\/Y information.
-- If not, this function returns 'P.False'.
eventsGetCenter ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Event.IsEvent a, Gdk.Event.IsEvent b) =>
    a
    -- ^ /@event1@/: first @GdkEvent@
    -> b
    -- ^ /@event2@/: second @GdkEvent@
    -> m ((Bool, Double, Double))
    -- ^ __Returns:__ 'P.True' if the center could be calculated.
eventsGetCenter :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEvent a, IsEvent b) =>
a -> b -> m (Bool, Double, Double)
eventsGetCenter a
event1 b
event2 = IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double) -> m (Bool, Double, Double))
-> IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event1' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event1
    Ptr Event
event2' <- b -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
event2
    Ptr CDouble
x <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
y <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr Event -> Ptr CDouble -> Ptr CDouble -> IO CInt
gdk_events_get_center Ptr Event
event1' Ptr Event
event2' Ptr CDouble
x Ptr CDouble
y
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
x' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
x
    let x'' :: Double
x'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x'
    CDouble
y' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
y
    let y'' :: Double
y'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event1
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
event2
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
x
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
y
    (Bool, Double, Double) -> IO (Bool, Double, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
x'', Double
y'')


-- function events_get_angle
-- Args: [ Arg
--           { argCName = "event1"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first `GdkEvent`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event2"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second `GdkEvent`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "angle"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the relative angle between both events"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_events_get_angle" gdk_events_get_angle :: 
    Ptr Gdk.Event.Event ->                  -- event1 : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr Gdk.Event.Event ->                  -- event2 : TInterface (Name {namespace = "Gdk", name = "Event"})
    Ptr CDouble ->                          -- angle : TBasicType TDouble
    IO CInt

-- | Returns the relative angle from /@event1@/ to /@event2@/.
-- 
-- The relative angle is the angle between the X axis and the line
-- through both events\' positions. The rotation direction for positive
-- angles is from the positive X axis towards the positive Y axis.
-- 
-- This assumes that both events have X\/Y information.
-- If not, this function returns 'P.False'.
eventsGetAngle ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Event.IsEvent a, Gdk.Event.IsEvent b) =>
    a
    -- ^ /@event1@/: first @GdkEvent@
    -> b
    -- ^ /@event2@/: second @GdkEvent@
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.True' if the angle could be calculated.
eventsGetAngle :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsEvent a, IsEvent b) =>
a -> b -> m (Bool, Double)
eventsGetAngle a
event1 b
event2 = IO (Bool, Double) -> m (Bool, Double)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double) -> m (Bool, Double))
-> IO (Bool, Double) -> m (Bool, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event1' <- a -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event1
    Ptr Event
event2' <- b -> IO (Ptr Event)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
event2
    Ptr CDouble
angle <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr Event -> Ptr CDouble -> IO CInt
gdk_events_get_angle Ptr Event
event1' Ptr Event
event2' Ptr CDouble
angle
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
angle' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
angle
    let angle'' :: Double
angle'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
angle'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event1
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
event2
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
angle
    (Bool, Double) -> IO (Bool, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
angle'')


-- function content_serialize_finish
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `GAsyncResult`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gdk_content_serialize_finish" gdk_content_serialize_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a content serialization operation.
contentSerializeFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@result@/: the @GAsyncResult@
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
contentSerializeFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m ()
contentSerializeFinish a
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncResult
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
gdk_content_serialize_finish Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )


-- function content_serialize_async
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a `GOutputStream` to write the serialized content to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mime_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mime type to serialize to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the content to serialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the I/O priority of the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional `GCancellable` object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "callback to call when the operation is done"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_serialize_async" gdk_content_serialize_async :: 
    Ptr Gio.OutputStream.OutputStream ->    -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    CString ->                              -- mime_type : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    Int32 ->                                -- io_priority : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Serialize content and write it to the given output stream, asynchronously.
-- 
-- The default I\/O priority is 'GI.GLib.Constants.PRIORITY_DEFAULT' (i.e. 0), and lower numbers
-- indicate a higher priority.
-- 
-- When the operation is finished, /@callback@/ will be called. You must then
-- call 'GI.Gdk.Functions.contentSerializeFinish' to get the result of the operation.
contentSerializeAsync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.OutputStream.IsOutputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a @GOutputStream@ to write the serialized content to
    -> T.Text
    -- ^ /@mimeType@/: the mime type to serialize to
    -> GValue
    -- ^ /@value@/: the content to serialize
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the operation
    -> Maybe (b)
    -- ^ /@cancellable@/: optional @GCancellable@ object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the operation is done
    -> m ()
contentSerializeAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsOutputStream a, IsCancellable b) =>
a
-> Text
-> GValue
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
contentSerializeAsync a
stream Text
mimeType GValue
value Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr OutputStream
stream' <- a -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CString
mimeType' <- Text -> IO CString
textToCString Text
mimeType
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr OutputStream
-> CString
-> Ptr GValue
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gdk_content_serialize_async Ptr OutputStream
stream' CString
mimeType' Ptr GValue
value' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mimeType'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function content_register_serializer
-- Args: [ Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the type of objects that the function can serialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mime_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mime type to serialize to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "serialize"
--           , argType =
--               TInterface
--                 Name { namespace = "Gdk" , name = "ContentSerializeFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data that @serialize can access"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notify for @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_register_serializer" gdk_content_register_serializer :: 
    CGType ->                               -- type : TBasicType TGType
    CString ->                              -- mime_type : TBasicType TUTF8
    FunPtr Gdk.Callbacks.C_ContentSerializeFunc -> -- serialize : TInterface (Name {namespace = "Gdk", name = "ContentSerializeFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Registers a function to serialize objects of a given type.
contentRegisterSerializer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@type@/: the type of objects that the function can serialize
    -> T.Text
    -- ^ /@mimeType@/: the mime type to serialize to
    -> Gdk.Callbacks.ContentSerializeFunc
    -- ^ /@serialize@/: the callback
    -> m ()
contentRegisterSerializer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> Text -> ContentSerializeFunc -> m ()
contentRegisterSerializer GType
type_ Text
mimeType ContentSerializeFunc
serialize = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    CString
mimeType' <- Text -> IO CString
textToCString Text
mimeType
    FunPtr C_ContentSerializeFunc
serialize' <- C_ContentSerializeFunc -> IO (FunPtr C_ContentSerializeFunc)
Gdk.Callbacks.mk_ContentSerializeFunc (Maybe (Ptr (FunPtr C_ContentSerializeFunc))
-> ContentSerializeFunc -> C_ContentSerializeFunc
Gdk.Callbacks.wrap_ContentSerializeFunc Maybe (Ptr (FunPtr C_ContentSerializeFunc))
forall a. Maybe a
Nothing ContentSerializeFunc
serialize)
    let data_ :: Ptr ()
data_ = FunPtr C_ContentSerializeFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ContentSerializeFunc
serialize'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    CGType
-> CString
-> FunPtr C_ContentSerializeFunc
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO ()
gdk_content_register_serializer CGType
type_' CString
mimeType' FunPtr C_ContentSerializeFunc
serialize' Ptr ()
data_ FunPtr (Ptr () -> IO ())
forall a. FunPtr (Ptr a -> IO ())
notify
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mimeType'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function content_register_deserializer
-- Args: [ Arg
--           { argCName = "mime_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the mime type which the function can deserialize from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of objects that the function creates"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "deserialize"
--           , argType =
--               TInterface
--                 Name { namespace = "Gdk" , name = "ContentDeserializeFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data that @deserialize can access"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notify for @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_register_deserializer" gdk_content_register_deserializer :: 
    CString ->                              -- mime_type : TBasicType TUTF8
    CGType ->                               -- type : TBasicType TGType
    FunPtr Gdk.Callbacks.C_ContentDeserializeFunc -> -- deserialize : TInterface (Name {namespace = "Gdk", name = "ContentDeserializeFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Registers a function to deserialize object of a given type.
contentRegisterDeserializer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@mimeType@/: the mime type which the function can deserialize from
    -> GType
    -- ^ /@type@/: the type of objects that the function creates
    -> Gdk.Callbacks.ContentDeserializeFunc
    -- ^ /@deserialize@/: the callback
    -> m ()
contentRegisterDeserializer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> GType -> ContentDeserializeFunc -> m ()
contentRegisterDeserializer Text
mimeType GType
type_ ContentDeserializeFunc
deserialize = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
mimeType' <- Text -> IO CString
textToCString Text
mimeType
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    FunPtr C_ContentDeserializeFunc
deserialize' <- C_ContentDeserializeFunc -> IO (FunPtr C_ContentDeserializeFunc)
Gdk.Callbacks.mk_ContentDeserializeFunc (Maybe (Ptr (FunPtr C_ContentDeserializeFunc))
-> ContentDeserializeFunc -> C_ContentDeserializeFunc
Gdk.Callbacks.wrap_ContentDeserializeFunc Maybe (Ptr (FunPtr C_ContentDeserializeFunc))
forall a. Maybe a
Nothing ContentDeserializeFunc
deserialize)
    let data_ :: Ptr ()
data_ = FunPtr C_ContentDeserializeFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ContentDeserializeFunc
deserialize'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    CString
-> CGType
-> FunPtr C_ContentDeserializeFunc
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO ()
gdk_content_register_deserializer CString
mimeType' CGType
type_' FunPtr C_ContentDeserializeFunc
deserialize' Ptr ()
data_ FunPtr (Ptr () -> IO ())
forall a. FunPtr (Ptr a -> IO ())
notify
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mimeType'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function content_deserialize_finish
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `GAsyncResult`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the result of the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gdk_content_deserialize_finish" gdk_content_deserialize_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr GValue ->                           -- value : TGValue
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a content deserialization operation.
contentDeserializeFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@result@/: the @GAsyncResult@
    -> m (GValue)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
contentDeserializeFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m GValue
contentDeserializeFinish a
result_ = IO GValue -> m GValue
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncResult
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    IO GValue -> IO () -> IO GValue
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AsyncResult -> Ptr GValue -> Ptr (Ptr GError) -> IO CInt
gdk_content_deserialize_finish Ptr AsyncResult
result_' Ptr GValue
value
        GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
        GValue -> IO GValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
value'
     ) (do
        Ptr GValue -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr GValue
value
     )


-- function content_deserialize_async
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a `GInputStream` to read the serialized content from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mime_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mime type to deserialize from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the GType to deserialize from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the I/O priority of the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional `GCancellable` object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "callback to call when the operation is done"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_deserialize_async" gdk_content_deserialize_async :: 
    Ptr Gio.InputStream.InputStream ->      -- stream : TInterface (Name {namespace = "Gio", name = "InputStream"})
    CString ->                              -- mime_type : TBasicType TUTF8
    CGType ->                               -- type : TBasicType TGType
    Int32 ->                                -- io_priority : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Read content from the given input stream and deserialize it, asynchronously.
-- 
-- The default I\/O priority is 'GI.GLib.Constants.PRIORITY_DEFAULT' (i.e. 0), and lower numbers
-- indicate a higher priority.
-- 
-- When the operation is finished, /@callback@/ will be called. You must then
-- call 'GI.Gdk.Functions.contentDeserializeFinish' to get the result of the operation.
contentDeserializeAsync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.InputStream.IsInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a @GInputStream@ to read the serialized content from
    -> T.Text
    -- ^ /@mimeType@/: the mime type to deserialize from
    -> GType
    -- ^ /@type@/: the GType to deserialize from
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the operation
    -> Maybe (b)
    -- ^ /@cancellable@/: optional @GCancellable@ object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the operation is done
    -> m ()
contentDeserializeAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsInputStream a, IsCancellable b) =>
a
-> Text
-> GType
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
contentDeserializeAsync a
stream Text
mimeType GType
type_ Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputStream
stream' <- a -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CString
mimeType' <- Text -> IO CString
textToCString Text
mimeType
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr InputStream
-> CString
-> CGType
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gdk_content_deserialize_async Ptr InputStream
stream' CString
mimeType' CGType
type_' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mimeType'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function cairo_set_source_rgba
-- Args: [ Arg
--           { argCName = "cr"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cairo context" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rgba"
--           , argType = TInterface Name { namespace = "Gdk" , name = "RGBA" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkRGBA`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_cairo_set_source_rgba" gdk_cairo_set_source_rgba :: 
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    Ptr Gdk.RGBA.RGBA ->                    -- rgba : TInterface (Name {namespace = "Gdk", name = "RGBA"})
    IO ()

-- | Sets the specified @GdkRGBA@ as the source color of /@cr@/.
cairoSetSourceRgba ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cairo.Context.Context
    -- ^ /@cr@/: a cairo context
    -> Gdk.RGBA.RGBA
    -- ^ /@rgba@/: a @GdkRGBA@
    -> m ()
cairoSetSourceRgba :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Context -> RGBA -> m ()
cairoSetSourceRgba Context
cr RGBA
rgba = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    Ptr RGBA
rgba' <- RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RGBA
rgba
    Ptr Context -> Ptr RGBA -> IO ()
gdk_cairo_set_source_rgba Ptr Context
cr' Ptr RGBA
rgba'
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RGBA
rgba
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function cairo_set_source_pixbuf
-- Args: [ Arg
--           { argCName = "cr"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cairo context" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixbuf"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPixbuf`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixbuf_x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "X coordinate of location to place upper left corner of @pixbuf"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixbuf_y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Y coordinate of location to place upper left corner of @pixbuf"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_cairo_set_source_pixbuf" gdk_cairo_set_source_pixbuf :: 
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- pixbuf : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    CDouble ->                              -- pixbuf_x : TBasicType TDouble
    CDouble ->                              -- pixbuf_y : TBasicType TDouble
    IO ()

-- | Sets the given pixbuf as the source pattern for /@cr@/.
-- 
-- The pattern has an extend mode of 'GI.Cairo.Enums.ExtendNone' and is aligned
-- so that the origin of /@pixbuf@/ is /@pixbufX@/, /@pixbufY@/.
cairoSetSourcePixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, GdkPixbuf.Pixbuf.IsPixbuf a) =>
    Cairo.Context.Context
    -- ^ /@cr@/: a cairo context
    -> a
    -- ^ /@pixbuf@/: a @GdkPixbuf@
    -> Double
    -- ^ /@pixbufX@/: X coordinate of location to place upper left corner of /@pixbuf@/
    -> Double
    -- ^ /@pixbufY@/: Y coordinate of location to place upper left corner of /@pixbuf@/
    -> m ()
cairoSetSourcePixbuf :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPixbuf a) =>
Context -> a -> Double -> Double -> m ()
cairoSetSourcePixbuf Context
cr a
pixbuf Double
pixbufX Double
pixbufY = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    Ptr Pixbuf
pixbuf' <- a -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pixbuf
    let pixbufX' :: CDouble
pixbufX' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
pixbufX
    let pixbufY' :: CDouble
pixbufY' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
pixbufY
    Ptr Context -> Ptr Pixbuf -> CDouble -> CDouble -> IO ()
gdk_cairo_set_source_pixbuf Ptr Context
cr' Ptr Pixbuf
pixbuf' CDouble
pixbufX' CDouble
pixbufY'
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pixbuf
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function cairo_region_create_from_surface
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cairo surface" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "cairo" , name = "Region" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_cairo_region_create_from_surface" gdk_cairo_region_create_from_surface :: 
    Ptr Cairo.Surface.Surface ->            -- surface : TInterface (Name {namespace = "cairo", name = "Surface"})
    IO (Ptr Cairo.Region.Region)

-- | Creates region that covers the area where the given
-- /@surface@/ is more than 50% opaque.
-- 
-- This function takes into account device offsets that might be
-- set with @/cairo_surface_set_device_offset()/@.
cairoRegionCreateFromSurface ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cairo.Surface.Surface
    -- ^ /@surface@/: a cairo surface
    -> m Cairo.Region.Region
    -- ^ __Returns:__ A @cairo_region_t@
cairoRegionCreateFromSurface :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Surface -> m Region
cairoRegionCreateFromSurface Surface
surface = IO Region -> m Region
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Region -> m Region) -> IO Region -> m Region
forall a b. (a -> b) -> a -> b
$ do
    Ptr Surface
surface' <- Surface -> IO (Ptr Surface)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Surface
surface
    Ptr Region
result <- Ptr Surface -> IO (Ptr Region)
gdk_cairo_region_create_from_surface Ptr Surface
surface'
    Text -> Ptr Region -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cairoRegionCreateFromSurface" Ptr Region
result
    Region
result' <- ((ManagedPtr Region -> Region) -> Ptr Region -> IO Region
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Region -> Region
Cairo.Region.Region) Ptr Region
result
    Surface -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Surface
surface
    Region -> IO Region
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Region
result'


-- function cairo_region
-- Args: [ Arg
--           { argCName = "cr"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cairo context" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `cairo_region_t`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_cairo_region" gdk_cairo_region :: 
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    Ptr Cairo.Region.Region ->              -- region : TInterface (Name {namespace = "cairo", name = "Region"})
    IO ()

-- | Adds the given region to the current path of /@cr@/.
cairoRegion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cairo.Context.Context
    -- ^ /@cr@/: a cairo context
    -> Cairo.Region.Region
    -- ^ /@region@/: a @cairo_region_t@
    -> m ()
cairoRegion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Context -> Region -> m ()
cairoRegion Context
cr Region
region = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    Ptr Region
region' <- Region -> IO (Ptr Region)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Region
region
    Ptr Context -> Ptr Region -> IO ()
gdk_cairo_region Ptr Context
cr' Ptr Region
region'
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    Region -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Region
region
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function cairo_rectangle
-- Args: [ Arg
--           { argCName = "cr"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cairo context" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rectangle"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkRectangle`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_cairo_rectangle" gdk_cairo_rectangle :: 
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    Ptr Gdk.Rectangle.Rectangle ->          -- rectangle : TInterface (Name {namespace = "Gdk", name = "Rectangle"})
    IO ()

-- | Adds the given rectangle to the current path of /@cr@/.
cairoRectangle ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cairo.Context.Context
    -- ^ /@cr@/: a cairo context
    -> Gdk.Rectangle.Rectangle
    -- ^ /@rectangle@/: a @GdkRectangle@
    -> m ()
cairoRectangle :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Context -> Rectangle -> m ()
cairoRectangle Context
cr Rectangle
rectangle = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    Ptr Rectangle
rectangle' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
rectangle
    Ptr Context -> Ptr Rectangle -> IO ()
gdk_cairo_rectangle Ptr Context
cr' Ptr Rectangle
rectangle'
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
rectangle
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function cairo_draw_from_gl
-- Args: [ Arg
--           { argCName = "cr"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cairo context" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The surface we're rendering for (not necessarily into)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The GL ID of the source buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_type"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The type of the @source"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer_scale"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The scale-factor that the @source buffer is allocated for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The source x position in @source to start copying from in GL coordinates"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The source y position in @source to start copying from in GL coordinates"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The width of the region to draw"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The height of the region to draw"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_cairo_draw_from_gl" gdk_cairo_draw_from_gl :: 
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    Ptr Gdk.Surface.Surface ->              -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Int32 ->                                -- source : TBasicType TInt
    Int32 ->                                -- source_type : TBasicType TInt
    Int32 ->                                -- buffer_scale : TBasicType TInt
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    IO ()

{-# DEPRECATED cairoDrawFromGl ["(Since version 4.6)","The function is overly complex and produces broken output","  in various combinations of arguments. If you want to draw with GL textures","  in GTK, use 'GI.Gdk.Objects.GLTexture.gLTextureNew'; if you want to use that texture in","  Cairo, use 'GI.Gdk.Objects.Texture.textureDownload' to download the data into a Cairo","  image surface."] #-}
-- | The main way to not draw GL content in GTK.
-- 
-- It takes a render buffer ID (/@sourceType@/ == GL_RENDERBUFFER) or a texture
-- id (/@sourceType@/ == GL_TEXTURE) and draws it onto /@cr@/ with an OVER operation,
-- respecting the current clip. The top left corner of the rectangle specified
-- by /@x@/, /@y@/, /@width@/ and /@height@/ will be drawn at the current (0,0) position of
-- the @cairo_t@.
-- 
-- This will work for *all* @cairo_t@, as long as /@surface@/ is realized, but the
-- fallback implementation that reads back the pixels from the buffer may be
-- used in the general case. In the case of direct drawing to a surface with
-- no special effects applied to /@cr@/ it will however use a more efficient
-- approach.
-- 
-- For GL_RENDERBUFFER the code will always fall back to software for buffers
-- with alpha components, so make sure you use GL_TEXTURE if using alpha.
-- 
-- Calling this may change the current GL context.
cairoDrawFromGl ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Surface.IsSurface a) =>
    Cairo.Context.Context
    -- ^ /@cr@/: a cairo context
    -> a
    -- ^ /@surface@/: The surface we\'re rendering for (not necessarily into)
    -> Int32
    -- ^ /@source@/: The GL ID of the source buffer
    -> Int32
    -- ^ /@sourceType@/: The type of the /@source@/
    -> Int32
    -- ^ /@bufferScale@/: The scale-factor that the /@source@/ buffer is allocated for
    -> Int32
    -- ^ /@x@/: The source x position in /@source@/ to start copying from in GL coordinates
    -> Int32
    -- ^ /@y@/: The source y position in /@source@/ to start copying from in GL coordinates
    -> Int32
    -- ^ /@width@/: The width of the region to draw
    -> Int32
    -- ^ /@height@/: The height of the region to draw
    -> m ()
cairoDrawFromGl :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSurface a) =>
Context
-> a
-> Int32
-> Int32
-> Int32
-> Int32
-> Int32
-> Int32
-> Int32
-> m ()
cairoDrawFromGl Context
cr a
surface Int32
source Int32
sourceType Int32
bufferScale Int32
x Int32
y Int32
width Int32
height = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    Ptr Surface
surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    Ptr Context
-> Ptr Surface
-> Int32
-> Int32
-> Int32
-> Int32
-> Int32
-> Int32
-> Int32
-> IO ()
gdk_cairo_draw_from_gl Ptr Context
cr' Ptr Surface
surface' Int32
source Int32
sourceType Int32
bufferScale Int32
x Int32
y Int32
width Int32
height
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()