-- | 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.Clutter.Functions
    ( 

 -- * Methods


-- ** baseInit #method:baseInit#

    baseInit                                ,


-- ** cairoClear #method:cairoClear#

    cairoClear                              ,


-- ** cairoSetSourceColor #method:cairoSetSourceColor#

    cairoSetSourceColor                     ,


-- ** checkVersion #method:checkVersion#

    checkVersion                            ,


-- ** checkWindowingBackend #method:checkWindowingBackend#

    checkWindowingBackend                   ,


-- ** clearGlyphCache #method:clearGlyphCache#

    clearGlyphCache                         ,


-- ** disableAccessibility #method:disableAccessibility#

    disableAccessibility                    ,


-- ** doEvent #method:doEvent#

    doEvent                                 ,


-- ** eventsPending #method:eventsPending#

    eventsPending                           ,


-- ** featureAvailable #method:featureAvailable#

    featureAvailable                        ,


-- ** featureGetAll #method:featureGetAll#

    featureGetAll                           ,


-- ** frameSourceAdd #method:frameSourceAdd#

    frameSourceAdd                          ,


-- ** getAccessibilityEnabled #method:getAccessibilityEnabled#

    getAccessibilityEnabled                 ,


-- ** getActorByGid #method:getActorByGid#

    getActorByGid                           ,


-- ** getCurrentEvent #method:getCurrentEvent#

    getCurrentEvent                         ,


-- ** getCurrentEventTime #method:getCurrentEventTime#

    getCurrentEventTime                     ,


-- ** getDebugEnabled #method:getDebugEnabled#

    getDebugEnabled                         ,


-- ** getDefaultBackend #method:getDefaultBackend#

    getDefaultBackend                       ,


-- ** getDefaultFrameRate #method:getDefaultFrameRate#

    getDefaultFrameRate                     ,


-- ** getDefaultTextDirection #method:getDefaultTextDirection#

    getDefaultTextDirection                 ,


-- ** getFontFlags #method:getFontFlags#

    getFontFlags                            ,


-- ** getFontMap #method:getFontMap#

    getFontMap                              ,


-- ** getInputDeviceForId #method:getInputDeviceForId#

    getInputDeviceForId                     ,


-- ** getKeyboardGrab #method:getKeyboardGrab#

    getKeyboardGrab                         ,


-- ** getMotionEventsEnabled #method:getMotionEventsEnabled#

    getMotionEventsEnabled                  ,


-- ** getPointerGrab #method:getPointerGrab#

    getPointerGrab                          ,


-- ** getScriptId #method:getScriptId#

    getScriptId                             ,


-- ** getShowFps #method:getShowFps#

    getShowFps                              ,


-- ** getTimestamp #method:getTimestamp#

    getTimestamp                            ,


-- ** grabKeyboard #method:grabKeyboard#

    grabKeyboard                            ,


-- ** grabPointer #method:grabPointer#

    grabPointer                             ,


-- ** grabPointerForDevice #method:grabPointerForDevice#

    grabPointerForDevice                    ,


-- ** init #method:init#

    init                                    ,


-- ** initWithArgs #method:initWithArgs#

    initWithArgs                            ,


-- ** keysymToUnicode #method:keysymToUnicode#

    keysymToUnicode                         ,


-- ** main #method:main#

    main                                    ,


-- ** mainLevel #method:mainLevel#

    mainLevel                               ,


-- ** mainQuit #method:mainQuit#

    mainQuit                                ,


-- ** redraw #method:redraw#

    redraw                                  ,


-- ** setDefaultFrameRate #method:setDefaultFrameRate#

    setDefaultFrameRate                     ,


-- ** setFontFlags #method:setFontFlags#

    setFontFlags                            ,


-- ** setMotionEventsEnabled #method:setMotionEventsEnabled#

    setMotionEventsEnabled                  ,


-- ** setWindowingBackend #method:setWindowingBackend#

    setWindowingBackend                     ,


-- ** testAddDataFull #method:testAddDataFull#

    testAddDataFull                         ,


-- ** testCheckActorAtPoint #method:testCheckActorAtPoint#

    testCheckActorAtPoint                   ,


-- ** testCheckColorAtPoint #method:testCheckColorAtPoint#

    testCheckColorAtPoint                   ,


-- ** testGetStage #method:testGetStage#

    testGetStage                            ,


-- ** testInit #method:testInit#

    testInit                                ,


-- ** testRun #method:testRun#

    testRun                                 ,


-- ** threadsAddFrameSource #method:threadsAddFrameSource#

    threadsAddFrameSource                   ,


-- ** threadsAddIdle #method:threadsAddIdle#

    threadsAddIdle                          ,


-- ** threadsAddRepaintFunc #method:threadsAddRepaintFunc#

    threadsAddRepaintFunc                   ,


-- ** threadsAddRepaintFuncFull #method:threadsAddRepaintFuncFull#

    threadsAddRepaintFuncFull               ,


-- ** threadsAddTimeout #method:threadsAddTimeout#

    threadsAddTimeout                       ,


-- ** threadsEnter #method:threadsEnter#

    threadsEnter                            ,


-- ** threadsInit #method:threadsInit#

    threadsInit                             ,


-- ** threadsLeave #method:threadsLeave#

    threadsLeave                            ,


-- ** threadsRemoveRepaintFunc #method:threadsRemoveRepaintFunc#

    threadsRemoveRepaintFunc                ,


-- ** ungrabKeyboard #method:ungrabKeyboard#

    ungrabKeyboard                          ,


-- ** ungrabPointer #method:ungrabPointer#

    ungrabPointer                           ,


-- ** ungrabPointerForDevice #method:ungrabPointerForDevice#

    ungrabPointerForDevice                  ,


-- ** unicodeToKeysym #method:unicodeToKeysym#

    unicodeToKeysym                         ,


-- ** utilNextP2 #method:utilNextP2#

    utilNextP2                              ,


-- ** valueDupPaintNode #method:valueDupPaintNode#

    valueDupPaintNode                       ,


-- ** valueGetColor #method:valueGetColor#

    valueGetColor                           ,


-- ** valueGetPaintNode #method:valueGetPaintNode#

    valueGetPaintNode                       ,


-- ** valueGetShaderFloat #method:valueGetShaderFloat#

    valueGetShaderFloat                     ,


-- ** valueGetShaderInt #method:valueGetShaderInt#

    valueGetShaderInt                       ,


-- ** valueGetShaderMatrix #method:valueGetShaderMatrix#

    valueGetShaderMatrix                    ,


-- ** valueGetUnits #method:valueGetUnits#

    valueGetUnits                           ,


-- ** valueSetColor #method:valueSetColor#

    valueSetColor                           ,


-- ** valueSetPaintNode #method:valueSetPaintNode#

    valueSetPaintNode                       ,


-- ** valueSetShaderFloat #method:valueSetShaderFloat#

    valueSetShaderFloat                     ,


-- ** valueSetShaderInt #method:valueSetShaderInt#

    valueSetShaderInt                       ,


-- ** valueSetShaderMatrix #method:valueSetShaderMatrix#

    valueSetShaderMatrix                    ,


-- ** valueSetUnits #method:valueSetUnits#

    valueSetUnits                           ,


-- ** valueTakePaintNode #method:valueTakePaintNode#

    valueTakePaintNode                      ,




    ) 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.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 {-# SOURCE #-} qualified GI.Clutter.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Flags as Clutter.Flags
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.Backend as Clutter.Backend
import {-# SOURCE #-} qualified GI.Clutter.Objects.InputDevice as Clutter.InputDevice
import {-# SOURCE #-} qualified GI.Clutter.Objects.PaintNode as Clutter.PaintNode
import {-# SOURCE #-} qualified GI.Clutter.Objects.Stage as Clutter.Stage
import {-# SOURCE #-} qualified GI.Clutter.Structs.Color as Clutter.Color
import {-# SOURCE #-} qualified GI.Clutter.Structs.Point as Clutter.Point
import {-# SOURCE #-} qualified GI.Clutter.Structs.Units as Clutter.Units
import {-# SOURCE #-} qualified GI.Clutter.Unions.Event as Clutter.Event
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.OptionEntry as GLib.OptionEntry
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Pango.Objects.FontMap as Pango.FontMap

-- function value_take_paint_node
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue, initialized with %CLUTTER_TYPE_PAINT_NODE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintNode" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintNode, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_take_paint_node" clutter_value_take_paint_node :: 
    Ptr GValue ->                           -- value : TGValue
    Ptr Clutter.PaintNode.PaintNode ->      -- node : TInterface (Name {namespace = "Clutter", name = "PaintNode"})
    IO ()

-- | Sets the contents of a t'GI.GObject.Structs.Value.Value' initialized with @/CLUTTER_TYPE_PAINT_NODE/@.
-- 
-- Unlike 'GI.Clutter.Functions.valueSetPaintNode', this function will not take a
-- reference on the passed /@node@/: instead, it will take ownership of the
-- current reference count.
-- 
-- /Since: 1.10/
valueTakePaintNode ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.PaintNode.IsPaintNode a) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value', initialized with @/CLUTTER_TYPE_PAINT_NODE/@
    -> Maybe (a)
    -- ^ /@node@/: a t'GI.Clutter.Objects.PaintNode.PaintNode', or 'P.Nothing'
    -> m ()
valueTakePaintNode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPaintNode a) =>
GValue -> Maybe a -> m ()
valueTakePaintNode GValue
value Maybe a
node = 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 GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr PaintNode
maybeNode <- case Maybe a
node of
        Maybe a
Nothing -> Ptr PaintNode -> IO (Ptr PaintNode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr PaintNode
forall a. Ptr a
nullPtr
        Just a
jNode -> do
            Ptr PaintNode
jNode' <- a -> IO (Ptr PaintNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jNode
            Ptr PaintNode -> IO (Ptr PaintNode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr PaintNode
jNode'
    Ptr GValue -> Ptr PaintNode -> IO ()
clutter_value_take_paint_node Ptr GValue
value' Ptr PaintNode
maybeNode
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
node a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function value_set_units
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue initialized to %CLUTTER_TYPE_UNITS"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "units"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Units" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the units to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_set_units" clutter_value_set_units :: 
    Ptr GValue ->                           -- value : TGValue
    Ptr Clutter.Units.Units ->              -- units : TInterface (Name {namespace = "Clutter", name = "Units"})
    IO ()

-- | Sets /@value@/ to /@units@/
-- 
-- /Since: 0.8/
valueSetUnits ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' initialized to @/CLUTTER_TYPE_UNITS/@
    -> Clutter.Units.Units
    -- ^ /@units@/: the units to set
    -> m ()
valueSetUnits :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> Units -> m ()
valueSetUnits GValue
value Units
units = 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 GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Units
units' <- Units -> IO (Ptr Units)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Units
units
    Ptr GValue -> Ptr Units -> IO ()
clutter_value_set_units Ptr GValue
value' Ptr Units
units'
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Units -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Units
units
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function value_set_shader_matrix
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of floating point values in @floats"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "matrix"
--           , argType = TCArray False (-1) 1 (TBasicType TFloat)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a matrix of floating point values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of floating point values in @floats"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_set_shader_matrix" clutter_value_set_shader_matrix :: 
    Ptr GValue ->                           -- value : TGValue
    Int32 ->                                -- size : TBasicType TInt
    Ptr CFloat ->                           -- matrix : TCArray False (-1) 1 (TBasicType TFloat)
    IO ()

-- | Sets /@matrix@/ as the contents of /@value@/. The passed t'GI.GObject.Structs.Value.Value'
-- must have been initialized using @/CLUTTER_TYPE_SHADER_MATRIX/@.
-- 
-- /Since: 0.8/
valueSetShaderMatrix ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value'
    -> [Float]
    -- ^ /@matrix@/: a matrix of floating point values
    -> m ()
valueSetShaderMatrix :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> [Float] -> m ()
valueSetShaderMatrix GValue
value [Float]
matrix = 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 size :: Int32
size = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Float] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Float]
matrix
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr CFloat
matrix' <- ((Float -> CFloat) -> [Float] -> IO (Ptr CFloat)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Float]
matrix
    Ptr GValue -> Int32 -> Ptr CFloat -> IO ()
clutter_value_set_shader_matrix Ptr GValue
value' Int32
size Ptr CFloat
matrix'
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
matrix'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function value_set_shader_int
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of integer values in @ints"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ints"
--           , argType = TCArray False (-1) 1 (TBasicType TInt)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of integer values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of integer values in @ints"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_set_shader_int" clutter_value_set_shader_int :: 
    Ptr GValue ->                           -- value : TGValue
    Int32 ->                                -- size : TBasicType TInt
    Ptr Int32 ->                            -- ints : TCArray False (-1) 1 (TBasicType TInt)
    IO ()

-- | Sets /@ints@/ as the contents of /@value@/. The passed t'GI.GObject.Structs.Value.Value'
-- must have been initialized using @/CLUTTER_TYPE_SHADER_INT/@.
-- 
-- /Since: 0.8/
valueSetShaderInt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value'
    -> [Int32]
    -- ^ /@ints@/: an array of integer values
    -> m ()
valueSetShaderInt :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> [Int32] -> m ()
valueSetShaderInt GValue
value [Int32]
ints = 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 size :: Int32
size = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Int32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Int32]
ints
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Int32
ints' <- [Int32] -> IO (Ptr Int32)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Int32]
ints
    Ptr GValue -> Int32 -> Ptr Int32 -> IO ()
clutter_value_set_shader_int Ptr GValue
value' Int32
size Ptr Int32
ints'
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
ints'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function value_set_shader_float
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of floating point values in @floats"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "floats"
--           , argType = TCArray False (-1) 1 (TBasicType TFloat)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of floating point values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of floating point values in @floats"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_set_shader_float" clutter_value_set_shader_float :: 
    Ptr GValue ->                           -- value : TGValue
    Int32 ->                                -- size : TBasicType TInt
    Ptr CFloat ->                           -- floats : TCArray False (-1) 1 (TBasicType TFloat)
    IO ()

-- | Sets /@floats@/ as the contents of /@value@/. The passed t'GI.GObject.Structs.Value.Value'
-- must have been initialized using @/CLUTTER_TYPE_SHADER_FLOAT/@.
-- 
-- /Since: 0.8/
valueSetShaderFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value'
    -> [Float]
    -- ^ /@floats@/: an array of floating point values
    -> m ()
valueSetShaderFloat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> [Float] -> m ()
valueSetShaderFloat GValue
value [Float]
floats = 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 size :: Int32
size = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Float] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Float]
floats
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr CFloat
floats' <- ((Float -> CFloat) -> [Float] -> IO (Ptr CFloat)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Float]
floats
    Ptr GValue -> Int32 -> Ptr CFloat -> IO ()
clutter_value_set_shader_float Ptr GValue
value' Int32
size Ptr CFloat
floats'
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
floats'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function value_set_paint_node
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue initialized with %CLUTTER_TYPE_PAINT_NODE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PaintNode" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPaintNode, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_set_paint_node" clutter_value_set_paint_node :: 
    Ptr GValue ->                           -- value : TGValue
    Ptr Clutter.PaintNode.PaintNode ->      -- node : TInterface (Name {namespace = "Clutter", name = "PaintNode"})
    IO ()

-- | Sets the contents of a t'GI.GObject.Structs.Value.Value' initialized with @/CLUTTER_TYPE_PAINT_NODE/@.
-- 
-- This function increased the reference count of /@node@/; if you do not wish
-- to increase the reference count, use 'GI.Clutter.Functions.valueTakePaintNode'
-- instead. The reference count will be released by 'GI.GObject.Structs.Value.valueUnset'.
-- 
-- /Since: 1.10/
valueSetPaintNode ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.PaintNode.IsPaintNode a) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' initialized with @/CLUTTER_TYPE_PAINT_NODE/@
    -> Maybe (a)
    -- ^ /@node@/: a t'GI.Clutter.Objects.PaintNode.PaintNode', or 'P.Nothing'
    -> m ()
valueSetPaintNode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPaintNode a) =>
GValue -> Maybe a -> m ()
valueSetPaintNode GValue
value Maybe a
node = 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 GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr PaintNode
maybeNode <- case Maybe a
node of
        Maybe a
Nothing -> Ptr PaintNode -> IO (Ptr PaintNode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr PaintNode
forall a. Ptr a
nullPtr
        Just a
jNode -> do
            Ptr PaintNode
jNode' <- a -> IO (Ptr PaintNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jNode
            Ptr PaintNode -> IO (Ptr PaintNode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr PaintNode
jNode'
    Ptr GValue -> Ptr PaintNode -> IO ()
clutter_value_set_paint_node Ptr GValue
value' Ptr PaintNode
maybeNode
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
node a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function value_set_color
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue initialized to #CLUTTER_TYPE_COLOR"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the color to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_set_color" clutter_value_set_color :: 
    Ptr GValue ->                           -- value : TGValue
    Ptr Clutter.Color.Color ->              -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO ()

-- | Sets /@value@/ to /@color@/.
-- 
-- /Since: 0.8/
valueSetColor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' initialized to @/CLUTTER_TYPE_COLOR/@
    -> Clutter.Color.Color
    -- ^ /@color@/: the color to set
    -> m ()
valueSetColor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> Color -> m ()
valueSetColor GValue
value Color
color = 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 GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr GValue -> Ptr Color -> IO ()
clutter_value_set_color Ptr GValue
value' Ptr Color
color'
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function value_get_units
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue initialized to %CLUTTER_TYPE_UNITS"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Units" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_get_units" clutter_value_get_units :: 
    Ptr GValue ->                           -- value : TGValue
    IO (Ptr Clutter.Units.Units)

-- | Gets the t'GI.Clutter.Structs.Units.Units' contained in /@value@/.
-- 
-- /Since: 0.8/
valueGetUnits ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' initialized to @/CLUTTER_TYPE_UNITS/@
    -> m Clutter.Units.Units
    -- ^ __Returns:__ the units inside the passed t'GI.GObject.Structs.Value.Value'
valueGetUnits :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> m Units
valueGetUnits GValue
value = IO Units -> m Units
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Units -> m Units) -> IO Units -> m Units
forall a b. (a -> b) -> a -> b
$ do
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Units
result <- Ptr GValue -> IO (Ptr Units)
clutter_value_get_units Ptr GValue
value'
    Text -> Ptr Units -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueGetUnits" Ptr Units
result
    Units
result' <- ((ManagedPtr Units -> Units) -> Ptr Units -> IO Units
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Units -> Units
Clutter.Units.Units) Ptr Units
result
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Units -> IO Units
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Units
result'


-- function value_get_shader_matrix
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the number of returned floating\n  point values, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "return location for the number of returned floating\n  point values, or %NULL"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TFloat))
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_get_shader_matrix" clutter_value_get_shader_matrix :: 
    Ptr GValue ->                           -- value : TGValue
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    IO (Ptr CFloat)

-- | Retrieves a matrix of floating point values stored inside
-- the passed t'GI.GObject.Structs.Value.Value'. /@value@/ must have been initialized with
-- @/CLUTTER_TYPE_SHADER_MATRIX/@.
-- 
-- /Since: 0.8/
valueGetShaderMatrix ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value'
    -> m [Float]
    -- ^ __Returns:__ the pointer to a matrix
    --   of floating point values. The returned value is owned by the t'GI.GObject.Structs.Value.Value' and
    --   should never be modified or freed.
valueGetShaderMatrix :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> m [Float]
valueGetShaderMatrix GValue
value = IO [Float] -> m [Float]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Float] -> m [Float]) -> IO [Float] -> m [Float]
forall a b. (a -> b) -> a -> b
$ do
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr CFloat
result <- Ptr GValue -> Ptr Word64 -> IO (Ptr CFloat)
clutter_value_get_shader_matrix Ptr GValue
value' Ptr Word64
length_
    Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
    Text -> Ptr CFloat -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueGetShaderMatrix" Ptr CFloat
result
    [Float]
result' <- ((CFloat -> Float) -> Word64 -> Ptr CFloat -> IO [Float]
forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
length_') Ptr CFloat
result
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
    [Float] -> IO [Float]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Float]
result'


-- function value_get_shader_int
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the number of returned integer\n  values, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "return location for the number of returned integer\n  values, or %NULL"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TInt))
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_get_shader_int" clutter_value_get_shader_int :: 
    Ptr GValue ->                           -- value : TGValue
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    IO (Ptr Int32)

-- | Retrieves the list of integer values stored inside the passed
-- t'GI.GObject.Structs.Value.Value'. /@value@/ must have been initialized with
-- @/CLUTTER_TYPE_SHADER_INT/@.
-- 
-- /Since: 0.8/
valueGetShaderInt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value'
    -> m [Int32]
    -- ^ __Returns:__ the pointer to a list of
    --   integer values.  The returned value is owned by the t'GI.GObject.Structs.Value.Value' and
    --   should never be modified or freed.
valueGetShaderInt :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> m [Int32]
valueGetShaderInt GValue
value = IO [Int32] -> m [Int32]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Int32] -> m [Int32]) -> IO [Int32] -> m [Int32]
forall a b. (a -> b) -> a -> b
$ do
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Int32
result <- Ptr GValue -> Ptr Word64 -> IO (Ptr Int32)
clutter_value_get_shader_int Ptr GValue
value' Ptr Word64
length_
    Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
    Text -> Ptr Int32 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueGetShaderInt" Ptr Int32
result
    [Int32]
result' <- (Word64 -> Ptr Int32 -> IO [Int32]
forall a b. (Integral a, Storable b) => a -> Ptr b -> IO [b]
unpackStorableArrayWithLength Word64
length_') Ptr Int32
result
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
    [Int32] -> IO [Int32]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int32]
result'


-- function value_get_shader_float
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the number of returned floating\n  point values, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "return location for the number of returned floating\n  point values, or %NULL"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TFloat))
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_get_shader_float" clutter_value_get_shader_float :: 
    Ptr GValue ->                           -- value : TGValue
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    IO (Ptr CFloat)

-- | Retrieves the list of floating point values stored inside
-- the passed t'GI.GObject.Structs.Value.Value'. /@value@/ must have been initialized with
-- @/CLUTTER_TYPE_SHADER_FLOAT/@.
-- 
-- /Since: 0.8/
valueGetShaderFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value'
    -> m [Float]
    -- ^ __Returns:__ the pointer to a list of
    --   floating point values.  The returned value is owned by the
    --   t'GI.GObject.Structs.Value.Value' and should never be modified or freed.
valueGetShaderFloat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> m [Float]
valueGetShaderFloat GValue
value = IO [Float] -> m [Float]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Float] -> m [Float]) -> IO [Float] -> m [Float]
forall a b. (a -> b) -> a -> b
$ do
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr CFloat
result <- Ptr GValue -> Ptr Word64 -> IO (Ptr CFloat)
clutter_value_get_shader_float Ptr GValue
value' Ptr Word64
length_
    Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
    Text -> Ptr CFloat -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueGetShaderFloat" Ptr CFloat
result
    [Float]
result' <- ((CFloat -> Float) -> Word64 -> Ptr CFloat -> IO [Float]
forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
length_') Ptr CFloat
result
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
    [Float] -> IO [Float]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Float]
result'


-- function value_get_paint_node
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue initialized with %CLUTTER_TYPE_PAINT_NODE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "PaintNode" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_get_paint_node" clutter_value_get_paint_node :: 
    Ptr GValue ->                           -- value : TGValue
    IO (Ptr Clutter.PaintNode.PaintNode)

-- | Retrieves a pointer to the t'GI.Clutter.Objects.PaintNode.PaintNode' contained inside
-- the passed t'GI.GObject.Structs.Value.Value'.
-- 
-- /Since: 1.10/
valueGetPaintNode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' initialized with @/CLUTTER_TYPE_PAINT_NODE/@
    -> m Clutter.PaintNode.PaintNode
    -- ^ __Returns:__ a pointer to
    --   a t'GI.Clutter.Objects.PaintNode.PaintNode', or 'P.Nothing'
valueGetPaintNode :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> m PaintNode
valueGetPaintNode GValue
value = IO PaintNode -> m PaintNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PaintNode -> m PaintNode) -> IO PaintNode -> m PaintNode
forall a b. (a -> b) -> a -> b
$ do
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr PaintNode
result <- Ptr GValue -> IO (Ptr PaintNode)
clutter_value_get_paint_node Ptr GValue
value'
    Text -> Ptr PaintNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueGetPaintNode" Ptr PaintNode
result
    PaintNode
result' <- ((ManagedPtr PaintNode -> PaintNode)
-> Ptr PaintNode -> IO PaintNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr PaintNode -> PaintNode
Clutter.PaintNode.PaintNode) Ptr PaintNode
result
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    PaintNode -> IO PaintNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PaintNode
result'


-- function value_get_color
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue initialized to #CLUTTER_TYPE_COLOR"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Color" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_get_color" clutter_value_get_color :: 
    Ptr GValue ->                           -- value : TGValue
    IO (Ptr Clutter.Color.Color)

-- | Gets the t'GI.Clutter.Structs.Color.Color' contained in /@value@/.
-- 
-- /Since: 0.8/
valueGetColor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' initialized to @/CLUTTER_TYPE_COLOR/@
    -> m Clutter.Color.Color
    -- ^ __Returns:__ the color inside the passed t'GI.GObject.Structs.Value.Value'
valueGetColor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> m Color
valueGetColor GValue
value = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Color
result <- Ptr GValue -> IO (Ptr Color)
clutter_value_get_color Ptr GValue
value'
    Text -> Ptr Color -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueGetColor" Ptr Color
result
    Color
result' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Color -> Color
Clutter.Color.Color) Ptr Color
result
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result'


-- function value_dup_paint_node
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue initialized with %CLUTTER_TYPE_PAINT_NODE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "PaintNode" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_value_dup_paint_node" clutter_value_dup_paint_node :: 
    Ptr GValue ->                           -- value : TGValue
    IO (Ptr Clutter.PaintNode.PaintNode)

-- | Retrieves a pointer to the t'GI.Clutter.Objects.PaintNode.PaintNode' contained inside
-- the passed t'GI.GObject.Structs.Value.Value', and if not 'P.Nothing' it will increase the
-- reference count.
-- 
-- /Since: 1.10/
valueDupPaintNode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' initialized with @/CLUTTER_TYPE_PAINT_NODE/@
    -> m Clutter.PaintNode.PaintNode
    -- ^ __Returns:__ a pointer
    --   to the t'GI.Clutter.Objects.PaintNode.PaintNode', with its reference count increased,
    --   or 'P.Nothing'
valueDupPaintNode :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> m PaintNode
valueDupPaintNode GValue
value = IO PaintNode -> m PaintNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PaintNode -> m PaintNode) -> IO PaintNode -> m PaintNode
forall a b. (a -> b) -> a -> b
$ do
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr PaintNode
result <- Ptr GValue -> IO (Ptr PaintNode)
clutter_value_dup_paint_node Ptr GValue
value'
    Text -> Ptr PaintNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueDupPaintNode" Ptr PaintNode
result
    PaintNode
result' <- ((ManagedPtr PaintNode -> PaintNode)
-> Ptr PaintNode -> IO PaintNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr PaintNode -> PaintNode
Clutter.PaintNode.PaintNode) Ptr PaintNode
result
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    PaintNode -> IO PaintNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PaintNode
result'


-- function util_next_p2
-- Args: [ Arg
--           { argCName = "a"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Value to get the next power"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_util_next_p2" clutter_util_next_p2 :: 
    Int32 ->                                -- a : TBasicType TInt
    IO Int32

{-# DEPRECATED utilNextP2 ["(Since version 1.2)"] #-}
-- | Calculates the nearest power of two, greater than or equal to /@a@/.
utilNextP2 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@a@/: Value to get the next power
    -> m Int32
    -- ^ __Returns:__ The nearest power of two, greater or equal to /@a@/.
utilNextP2 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Int32 -> m Int32
utilNextP2 Int32
a = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Int32
result <- Int32 -> IO Int32
clutter_util_next_p2 Int32
a
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function unicode_to_keysym
-- Args: [ Arg
--           { argCName = "wc"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a ISO10646 encoded 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 "clutter_unicode_to_keysym" clutter_unicode_to_keysym :: 
    Word32 ->                               -- wc : TBasicType TUInt32
    IO Word32

-- | Convert from a ISO10646 character to a key symbol.
-- 
-- /Since: 1.10/
unicodeToKeysym ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@wc@/: a ISO10646 encoded character
    -> m Word32
    -- ^ __Returns:__ the corresponding Clutter key symbol, if one exists.
    --   or, if there is no corresponding symbol, wc | 0x01000000
unicodeToKeysym :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Word32
unicodeToKeysym 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
clutter_unicode_to_keysym Word32
wc
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function ungrab_pointer_for_device
-- Args: [ Arg
--           { argCName = "id_"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a device id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_ungrab_pointer_for_device" clutter_ungrab_pointer_for_device :: 
    Int32 ->                                -- id_ : TBasicType TInt
    IO ()

{-# DEPRECATED ungrabPointerForDevice ["(Since version 1.10)","Use 'GI.Clutter.Objects.InputDevice.inputDeviceUngrab' instead."] #-}
-- | Removes an existing grab of the pointer events for device /@id_@/.
-- 
-- /Since: 0.8/
ungrabPointerForDevice ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@id_@/: a device id
    -> m ()
ungrabPointerForDevice :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Int32 -> m ()
ungrabPointerForDevice Int32
id_ = 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
    Int32 -> IO ()
clutter_ungrab_pointer_for_device Int32
id_
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function ungrab_pointer
-- Args: []
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_ungrab_pointer" clutter_ungrab_pointer :: 
    IO ()

-- | Removes an existing grab of the pointer.
-- 
-- /Since: 0.6/
ungrabPointer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ()
ungrabPointer :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
ungrabPointer  = 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
    IO ()
clutter_ungrab_pointer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function ungrab_keyboard
-- Args: []
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_ungrab_keyboard" clutter_ungrab_keyboard :: 
    IO ()

-- | Removes an existing grab of the keyboard.
-- 
-- /Since: 0.6/
ungrabKeyboard ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ()
ungrabKeyboard :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
ungrabKeyboard  = 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
    IO ()
clutter_ungrab_keyboard
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function threads_remove_repaint_func
-- Args: [ Arg
--           { argCName = "handle_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an unsigned integer greater than zero"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_threads_remove_repaint_func" clutter_threads_remove_repaint_func :: 
    Word32 ->                               -- handle_id : TBasicType TUInt
    IO ()

-- | Removes the repaint function with /@handleId@/ as its id
-- 
-- /Since: 1.0/
threadsRemoveRepaintFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@handleId@/: an unsigned integer greater than zero
    -> m ()
threadsRemoveRepaintFunc :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Word32 -> m ()
threadsRemoveRepaintFunc Word32
handleId = 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
    Word32 -> IO ()
clutter_threads_remove_repaint_func Word32
handleId
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function threads_leave
-- Args: []
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_threads_leave" clutter_threads_leave :: 
    IO ()

{-# DEPRECATED threadsLeave ["(Since version 1.12)","This function should not be used by application","  code; marking critical sections is not portable on various","  platforms. Instead of acquiring the Clutter lock, schedule UI","  updates from the main loop using @/clutter_threads_add_idle()/@ or","  @/clutter_threads_add_timeout()/@."] #-}
-- | Unlocks the Clutter thread lock.
-- 
-- /Since: 0.4/
threadsLeave ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ()
threadsLeave :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
threadsLeave  = 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
    IO ()
clutter_threads_leave
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function threads_init
-- Args: []
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_threads_init" clutter_threads_init :: 
    IO ()

{-# DEPRECATED threadsInit ["(Since version 1.10)","This function does not do anything. Threading support","  is initialized when Clutter is initialized."] #-}
-- | Initialises the Clutter threading mechanism, so that Clutter API can be
-- called by multiple threads, using 'GI.Clutter.Functions.threadsEnter' and
-- 'GI.Clutter.Functions.threadsLeave' to mark the critical sections.
-- 
-- You must call @/g_thread_init()/@ before this function.
-- 
-- This function must be called before 'GI.Clutter.Functions.init'.
-- 
-- It is safe to call this function multiple times.
-- 
-- /Since: 0.4/
threadsInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ()
threadsInit :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
threadsInit  = 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
    IO ()
clutter_threads_init
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function threads_enter
-- Args: []
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_threads_enter" clutter_threads_enter :: 
    IO ()

{-# DEPRECATED threadsEnter ["(Since version 1.12)","This function should not be used by application","  code; marking critical sections is not portable on various","  platforms. Instead of acquiring the Clutter lock, schedule UI","  updates from the main loop using @/clutter_threads_add_idle()/@ or","  @/clutter_threads_add_timeout()/@."] #-}
-- | Locks the Clutter thread lock.
-- 
-- /Since: 0.4/
threadsEnter ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ()
threadsEnter :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
threadsEnter  = 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
    IO ()
clutter_threads_enter
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function threads_add_timeout
-- Args: [ Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the priority of the timeout source. Typically this will be in the\n           range between #G_PRIORITY_DEFAULT and #G_PRIORITY_HIGH."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the time between calls to the function, in milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "SourceFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function to call" , 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 to pass to the function"
--                 , 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 "function to call when the timeout source is removed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_threads_add_timeout_full" clutter_threads_add_timeout_full :: 
    Int32 ->                                -- priority : TBasicType TInt
    Word32 ->                               -- interval : TBasicType TUInt
    FunPtr GLib.Callbacks.C_SourceFunc ->   -- func : TInterface (Name {namespace = "GLib", name = "SourceFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO Word32

-- | Sets a function to be called at regular intervals holding the Clutter
-- threads lock, with the given priority. The function is called repeatedly
-- until it returns 'P.False', at which point the timeout is automatically
-- removed and the function will not be called again. The /@notify@/ function
-- is called when the timeout is removed.
-- 
-- The first call to the function will be at the end of the first /@interval@/.
-- 
-- It is important to note that, due to how the Clutter main loop is
-- implemented, the timing will not be accurate and it will not try to
-- \"keep up\" with the interval.
-- 
-- See also 'GI.Clutter.Functions.threadsAddIdle'.
-- 
-- /Since: 0.4/
threadsAddTimeout ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@priority@/: the priority of the timeout source. Typically this will be in the
    --            range between 'GI.GLib.Constants.PRIORITY_DEFAULT' and 'GI.GLib.Constants.PRIORITY_HIGH'.
    -> Word32
    -- ^ /@interval@/: the time between calls to the function, in milliseconds
    -> GLib.Callbacks.SourceFunc
    -- ^ /@func@/: function to call
    -> m Word32
    -- ^ __Returns:__ the ID (greater than 0) of the event source.
threadsAddTimeout :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Word32 -> SourceFunc -> m Word32
threadsAddTimeout Int32
priority Word32
interval SourceFunc
func = 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
    FunPtr C_SourceFunc
func' <- C_SourceFunc -> IO (FunPtr C_SourceFunc)
GLib.Callbacks.mk_SourceFunc (Maybe (Ptr (FunPtr C_SourceFunc))
-> SourceFunc_WithClosures -> C_SourceFunc
GLib.Callbacks.wrap_SourceFunc Maybe (Ptr (FunPtr C_SourceFunc))
forall a. Maybe a
Nothing (SourceFunc -> SourceFunc_WithClosures
GLib.Callbacks.drop_closures_SourceFunc SourceFunc
func))
    let data_ :: Ptr ()
data_ = FunPtr C_SourceFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_SourceFunc
func'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Word32
result <- Int32
-> Word32
-> FunPtr C_SourceFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO Word32
clutter_threads_add_timeout_full Int32
priority Word32
interval FunPtr C_SourceFunc
func' Ptr ()
data_ FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function threads_add_repaint_func_full
-- Args: [ Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "RepaintFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags for the repaint function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "SourceFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the function to be called within the paint cycle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the function, or %NULL"
--                 , 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
--                       "function to be called when removing the repaint\n   function, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_threads_add_repaint_func_full" clutter_threads_add_repaint_func_full :: 
    CUInt ->                                -- flags : TInterface (Name {namespace = "Clutter", name = "RepaintFlags"})
    FunPtr GLib.Callbacks.C_SourceFunc ->   -- func : TInterface (Name {namespace = "GLib", name = "SourceFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO Word32

-- | Adds a function to be called whenever Clutter is processing a new
-- frame.
-- 
-- If the function returns 'P.False' it is automatically removed from the
-- list of repaint functions and will not be called again.
-- 
-- This function is guaranteed to be called from within the same thread
-- that called 'GI.Clutter.Functions.main', and while the Clutter lock is being held;
-- the function will be called within the main loop, so it is imperative
-- that it does not block, otherwise the frame time budget may be lost.
-- 
-- A repaint function is useful to ensure that an update of the scenegraph
-- is performed before the scenegraph is repainted; for instance, uploading
-- a frame from a video into a t'GI.Clutter.Objects.Texture.Texture'. The /@flags@/ passed to this
-- function will determine the section of the frame processing that will
-- result in /@func@/ being called.
-- 
-- Adding a repaint function does not automatically ensure that a new
-- frame will be queued.
-- 
-- When the repaint function is removed (either because it returned 'P.False'
-- or because 'GI.Clutter.Functions.threadsRemoveRepaintFunc' has been called) the
-- /@notify@/ function will be called, if any is set.
-- 
-- /Since: 1.10/
threadsAddRepaintFuncFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Clutter.Flags.RepaintFlags]
    -- ^ /@flags@/: flags for the repaint function
    -> GLib.Callbacks.SourceFunc
    -- ^ /@func@/: the function to be called within the paint cycle
    -> m Word32
    -- ^ __Returns:__ the ID (greater than 0) of the repaint function. You
    --   can use the returned integer to remove the repaint function by
    --   calling 'GI.Clutter.Functions.threadsRemoveRepaintFunc'.
threadsAddRepaintFuncFull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[RepaintFlags] -> SourceFunc -> m Word32
threadsAddRepaintFuncFull [RepaintFlags]
flags SourceFunc
func = 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
    let flags' :: CUInt
flags' = [RepaintFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [RepaintFlags]
flags
    FunPtr C_SourceFunc
func' <- C_SourceFunc -> IO (FunPtr C_SourceFunc)
GLib.Callbacks.mk_SourceFunc (Maybe (Ptr (FunPtr C_SourceFunc))
-> SourceFunc_WithClosures -> C_SourceFunc
GLib.Callbacks.wrap_SourceFunc Maybe (Ptr (FunPtr C_SourceFunc))
forall a. Maybe a
Nothing (SourceFunc -> SourceFunc_WithClosures
GLib.Callbacks.drop_closures_SourceFunc SourceFunc
func))
    let data_ :: Ptr ()
data_ = FunPtr C_SourceFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_SourceFunc
func'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Word32
result <- CUInt
-> FunPtr C_SourceFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO Word32
clutter_threads_add_repaint_func_full CUInt
flags' FunPtr C_SourceFunc
func' Ptr ()
data_ FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function threads_add_repaint_func
-- Args: [ Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "SourceFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the function to be called within the paint cycle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 1
--           , argDestroy = 2
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the function, or %NULL"
--                 , 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
--                       "function to be called when removing the repaint\n   function, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_threads_add_repaint_func" clutter_threads_add_repaint_func :: 
    FunPtr GLib.Callbacks.C_SourceFunc ->   -- func : TInterface (Name {namespace = "GLib", name = "SourceFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO Word32

-- | Adds a function to be called whenever Clutter is processing a new
-- frame.
-- 
-- If the function returns 'P.False' it is automatically removed from the
-- list of repaint functions and will not be called again.
-- 
-- This function is guaranteed to be called from within the same thread
-- that called 'GI.Clutter.Functions.main', and while the Clutter lock is being held;
-- the function will be called within the main loop, so it is imperative
-- that it does not block, otherwise the frame time budget may be lost.
-- 
-- A repaint function is useful to ensure that an update of the scenegraph
-- is performed before the scenegraph is repainted; for instance, uploading
-- a frame from a video into a t'GI.Clutter.Objects.Texture.Texture'. By default, a repaint
-- function added using this function will be invoked prior to the frame
-- being processed.
-- 
-- Adding a repaint function does not automatically ensure that a new
-- frame will be queued.
-- 
-- When the repaint function is removed (either because it returned 'P.False'
-- or because 'GI.Clutter.Functions.threadsRemoveRepaintFunc' has been called) the
-- /@notify@/ function will be called, if any is set.
-- 
-- See also: 'GI.Clutter.Functions.threadsAddRepaintFuncFull'
-- 
-- /Since: 1.0/
threadsAddRepaintFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GLib.Callbacks.SourceFunc
    -- ^ /@func@/: the function to be called within the paint cycle
    -> m Word32
    -- ^ __Returns:__ the ID (greater than 0) of the repaint function. You
    --   can use the returned integer to remove the repaint function by
    --   calling 'GI.Clutter.Functions.threadsRemoveRepaintFunc'.
threadsAddRepaintFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SourceFunc -> m Word32
threadsAddRepaintFunc SourceFunc
func = 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
    FunPtr C_SourceFunc
func' <- C_SourceFunc -> IO (FunPtr C_SourceFunc)
GLib.Callbacks.mk_SourceFunc (Maybe (Ptr (FunPtr C_SourceFunc))
-> SourceFunc_WithClosures -> C_SourceFunc
GLib.Callbacks.wrap_SourceFunc Maybe (Ptr (FunPtr C_SourceFunc))
forall a. Maybe a
Nothing (SourceFunc -> SourceFunc_WithClosures
GLib.Callbacks.drop_closures_SourceFunc SourceFunc
func))
    let data_ :: Ptr ()
data_ = FunPtr C_SourceFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_SourceFunc
func'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Word32
result <- FunPtr C_SourceFunc
-> Ptr () -> FunPtr C_DestroyNotify -> IO Word32
clutter_threads_add_repaint_func FunPtr C_SourceFunc
func' Ptr ()
data_ FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function threads_add_idle
-- Args: [ Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the priority of the timeout source. Typically this will be in the\n   range between #G_PRIORITY_DEFAULT_IDLE and #G_PRIORITY_HIGH_IDLE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "SourceFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function to call" , sinceVersion = Nothing }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the function"
--                 , 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 "functio to call when the idle source is removed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_threads_add_idle_full" clutter_threads_add_idle_full :: 
    Int32 ->                                -- priority : TBasicType TInt
    FunPtr GLib.Callbacks.C_SourceFunc ->   -- func : TInterface (Name {namespace = "GLib", name = "SourceFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO Word32

-- | Adds a function to be called whenever there are no higher priority
-- events pending. If the function returns 'P.False' it is automatically
-- removed from the list of event sources and will not be called again.
-- 
-- This function can be considered a thread-safe variant of 'GI.GLib.Functions.idleAdd':
-- it will call /@function@/ while holding the Clutter lock. It is logically
-- equivalent to the following implementation:
-- 
-- >
-- >static gboolean
-- >idle_safe_callback (gpointer data)
-- >{
-- >   SafeClosure *closure = data;
-- >   gboolean res = FALSE;
-- >
-- >   // mark the critical section //
-- >
-- >   clutter_threads_enter();
-- >
-- >   // the callback does not need to acquire the Clutter
-- >    / lock itself, as it is held by the this proxy handler
-- >    //
-- >   res = closure->callback (closure->data);
-- >
-- >   clutter_threads_leave();
-- >
-- >   return res;
-- >}
-- >static gulong
-- >add_safe_idle (GSourceFunc callback,
-- >               gpointer    data)
-- >{
-- >  SafeClosure *closure = g_new0 (SafeClosure, 1);
-- >
-- >  closure->callback = callback;
-- >  closure->data = data;
-- >
-- >  return g_idle_add_full (G_PRIORITY_DEFAULT_IDLE,
-- >                          idle_safe_callback,
-- >                          closure,
-- >                          g_free)
-- >}
-- 
-- 
-- This function should be used by threaded applications to make sure
-- that /@func@/ is emitted under the Clutter threads lock and invoked
-- from the same thread that started the Clutter main loop. For instance,
-- it can be used to update the UI using the results from a worker
-- thread:
-- 
-- >
-- >static gboolean
-- >update_ui (gpointer data)
-- >{
-- >  SomeClosure *closure = data;
-- >
-- >  // it is safe to call Clutter API from this function because
-- >   / it is invoked from the same thread that started the main
-- >   / loop and under the Clutter thread lock
-- >   //
-- >  clutter_label_set_text (CLUTTER_LABEL (closure->label),
-- >                          closure->text);
-- >
-- >  g_object_unref (closure->label);
-- >  g_free (closure);
-- >
-- >  return FALSE;
-- >}
-- >
-- >  // within another thread //
-- >  closure = g_new0 (SomeClosure, 1);
-- >  // always take a reference on GObject instances //
-- >  closure->label = g_object_ref (my_application->label);
-- >  closure->text = g_strdup (processed_text_to_update_the_label);
-- >
-- >  clutter_threads_add_idle_full (G_PRIORITY_HIGH_IDLE,
-- >                                 update_ui,
-- >                                 closure,
-- >                                 NULL);
-- 
-- 
-- /Since: 0.4/
threadsAddIdle ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@priority@/: the priority of the timeout source. Typically this will be in the
    --    range between 'GI.GLib.Constants.PRIORITY_DEFAULT_IDLE' and 'GI.GLib.Constants.PRIORITY_HIGH_IDLE'
    -> GLib.Callbacks.SourceFunc
    -- ^ /@func@/: function to call
    -> m Word32
    -- ^ __Returns:__ the ID (greater than 0) of the event source.
threadsAddIdle :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> SourceFunc -> m Word32
threadsAddIdle Int32
priority SourceFunc
func = 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
    FunPtr C_SourceFunc
func' <- C_SourceFunc -> IO (FunPtr C_SourceFunc)
GLib.Callbacks.mk_SourceFunc (Maybe (Ptr (FunPtr C_SourceFunc))
-> SourceFunc_WithClosures -> C_SourceFunc
GLib.Callbacks.wrap_SourceFunc Maybe (Ptr (FunPtr C_SourceFunc))
forall a. Maybe a
Nothing (SourceFunc -> SourceFunc_WithClosures
GLib.Callbacks.drop_closures_SourceFunc SourceFunc
func))
    let data_ :: Ptr ()
data_ = FunPtr C_SourceFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_SourceFunc
func'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Word32
result <- Int32
-> FunPtr C_SourceFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO Word32
clutter_threads_add_idle_full Int32
priority FunPtr C_SourceFunc
func' Ptr ()
data_ FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function threads_add_frame_source
-- Args: [ Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the priority of the frame source. Typically this will be in the\n  range between %G_PRIORITY_DEFAULT and %G_PRIORITY_HIGH."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the number of times per second to call the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "SourceFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function to call" , 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 to pass to the function"
--                 , 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 "function to call when the timeout source is removed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_threads_add_frame_source_full" clutter_threads_add_frame_source_full :: 
    Int32 ->                                -- priority : TBasicType TInt
    Word32 ->                               -- fps : TBasicType TUInt
    FunPtr GLib.Callbacks.C_SourceFunc ->   -- func : TInterface (Name {namespace = "GLib", name = "SourceFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO Word32

{-# DEPRECATED threadsAddFrameSource ["(Since version 1.6)","There is no direct replacement for this API"] #-}
-- | Sets a function to be called at regular intervals holding the Clutter
-- threads lock, with the given priority. The function is called repeatedly
-- until it returns 'P.False', at which point the timeout is automatically
-- removed and the function will not be called again. The /@notify@/ function
-- is called when the timeout is removed.
-- 
-- This function is similar to 'GI.Clutter.Functions.threadsAddTimeout'
-- except that it will try to compensate for delays. For example, if
-- /@func@/ takes half the interval time to execute then the function
-- will be called again half the interval time after it finished. In
-- contrast 'GI.Clutter.Functions.threadsAddTimeout' would not fire until a
-- full interval after the function completes so the delay between
-- calls would be /@interval@/ * 1.5. This function does not however try
-- to invoke the function multiple times to catch up missing frames if
-- /@func@/ takes more than /@interval@/ ms to execute.
-- 
-- See also 'GI.Clutter.Functions.threadsAddIdle'.
-- 
-- /Since: 0.8/
threadsAddFrameSource ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@priority@/: the priority of the frame source. Typically this will be in the
    --   range between 'GI.GLib.Constants.PRIORITY_DEFAULT' and 'GI.GLib.Constants.PRIORITY_HIGH'.
    -> Word32
    -- ^ /@fps@/: the number of times per second to call the function
    -> GLib.Callbacks.SourceFunc
    -- ^ /@func@/: function to call
    -> m Word32
    -- ^ __Returns:__ the ID (greater than 0) of the event source.
threadsAddFrameSource :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Word32 -> SourceFunc -> m Word32
threadsAddFrameSource Int32
priority Word32
fps SourceFunc
func = 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
    FunPtr C_SourceFunc
func' <- C_SourceFunc -> IO (FunPtr C_SourceFunc)
GLib.Callbacks.mk_SourceFunc (Maybe (Ptr (FunPtr C_SourceFunc))
-> SourceFunc_WithClosures -> C_SourceFunc
GLib.Callbacks.wrap_SourceFunc Maybe (Ptr (FunPtr C_SourceFunc))
forall a. Maybe a
Nothing (SourceFunc -> SourceFunc_WithClosures
GLib.Callbacks.drop_closures_SourceFunc SourceFunc
func))
    let data_ :: Ptr ()
data_ = FunPtr C_SourceFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_SourceFunc
func'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Word32
result <- Int32
-> Word32
-> FunPtr C_SourceFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO Word32
clutter_threads_add_frame_source_full Int32
priority Word32
fps FunPtr C_SourceFunc
func' Ptr ()
data_ FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


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

foreign import ccall "clutter_test_run" clutter_test_run :: 
    IO Int32

-- | Runs the test suite using the units added by calling
-- @/clutter_test_add()/@.
-- 
-- The typical test suite is composed of a list of functions
-- called by 'GI.Clutter.Functions.testRun', for instance:
-- 
-- >
-- >static void unit_foo (void) { ... }
-- >
-- >static void unit_bar (void) { ... }
-- >
-- >static void unit_baz (void) { ... }
-- >
-- >int
-- >main (int argc, char *argv[])
-- >{
-- >  clutter_test_init (&argc, &argv);
-- >
-- >  clutter_test_add ("/unit/foo", unit_foo);
-- >  clutter_test_add ("/unit/bar", unit_bar);
-- >  clutter_test_add ("/unit/baz", unit_baz);
-- >
-- >  return clutter_test_run ();
-- >}
-- 
-- 
-- /Since: 1.18/
testRun ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Int32
    -- ^ __Returns:__ the exit code for the test suite
testRun :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Int32
testRun  = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Int32
result <- IO Int32
clutter_test_run
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function test_init
-- Args: [ Arg
--           { argCName = "argc"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "argv"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_test_init" clutter_test_init :: 
    Int32 ->                                -- argc : TBasicType TInt
    CString ->                              -- argv : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
testInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -> T.Text
    -> m ()
testInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Text -> m ()
testInit Int32
argc Text
argv = 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
argv' <- Text -> IO CString
textToCString Text
argv
    Int32 -> CString -> IO ()
clutter_test_init Int32
argc CString
argv'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
argv'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function test_get_stage
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_test_get_stage" clutter_test_get_stage :: 
    IO (Ptr Clutter.Actor.Actor)

-- | Retrieves the t'GI.Clutter.Objects.Stage.Stage' used for testing.
-- 
-- /Since: 1.18/
testGetStage ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Clutter.Actor.Actor
    -- ^ __Returns:__ the stage used for testing
testGetStage :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Actor
testGetStage  = IO Actor -> m Actor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr Actor
result <- IO (Ptr Actor)
clutter_test_get_stage
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"testGetStage" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'


-- function test_check_color_at_point
-- Args: [ Arg
--           { argCName = "stage"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterStage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "coordinates to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "expected color" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "color at the given coordinates"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_test_check_color_at_point" clutter_test_check_color_at_point :: 
    Ptr Clutter.Actor.Actor ->              -- stage : TInterface (Name {namespace = "Clutter", name = "Actor"})
    Ptr Clutter.Point.Point ->              -- point : TInterface (Name {namespace = "Clutter", name = "Point"})
    Ptr Clutter.Color.Color ->              -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    Ptr Clutter.Color.Color ->              -- result : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO CInt

-- | Checks the color at the given coordinates on /@stage@/, and matches
-- it with the red, green, and blue channels of /@color@/. The alpha
-- component of /@color@/ and /@result@/ is ignored.
-- 
-- /Since: 1.18/
testCheckColorAtPoint ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Actor.IsActor a) =>
    a
    -- ^ /@stage@/: a t'GI.Clutter.Objects.Stage.Stage'
    -> Clutter.Point.Point
    -- ^ /@point@/: coordinates to check
    -> Clutter.Color.Color
    -- ^ /@color@/: expected color
    -> m ((Bool, Clutter.Color.Color))
    -- ^ __Returns:__ 'P.True' if the colors match
testCheckColorAtPoint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActor a) =>
a -> Point -> Color -> m (Bool, Color)
testCheckColorAtPoint a
stage Point
point Color
color = IO (Bool, Color) -> m (Bool, Color)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Color) -> m (Bool, Color))
-> IO (Bool, Color) -> m (Bool, Color)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Actor
stage' <- a -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stage
    Ptr Point
point' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
point
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr Color
result_ <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
4 :: IO (Ptr Clutter.Color.Color)
    CInt
result <- Ptr Actor -> Ptr Point -> Ptr Color -> Ptr Color -> IO CInt
clutter_test_check_color_at_point Ptr Actor
stage' Ptr Point
point' Ptr Color
color' Ptr Color
result_
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Color
result_' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Clutter.Color.Color) Ptr Color
result_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stage
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
point
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    (Bool, Color) -> IO (Bool, Color)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Color
result_')


-- function test_check_actor_at_point
-- Args: [ Arg
--           { argCName = "stage"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterStage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "coordinates to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the expected actor at the given coordinates"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "actor at the coordinates"
--                 , 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 "clutter_test_check_actor_at_point" clutter_test_check_actor_at_point :: 
    Ptr Clutter.Actor.Actor ->              -- stage : TInterface (Name {namespace = "Clutter", name = "Actor"})
    Ptr Clutter.Point.Point ->              -- point : TInterface (Name {namespace = "Clutter", name = "Point"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    Ptr (Ptr Clutter.Actor.Actor) ->        -- result : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO CInt

-- | Checks the given coordinates of the /@stage@/ and compares the
-- actor found there with the given /@actor@/.
-- 
-- /Since: 1.18/
testCheckActorAtPoint ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Actor.IsActor a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@stage@/: a t'GI.Clutter.Objects.Stage.Stage'
    -> Clutter.Point.Point
    -- ^ /@point@/: coordinates to check
    -> b
    -- ^ /@actor@/: the expected actor at the given coordinates
    -> m ((Bool, Maybe Clutter.Actor.Actor))
    -- ^ __Returns:__ 'P.True' if the actor at the given coordinates matches
testCheckActorAtPoint :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsActor a, IsActor b) =>
a -> Point -> b -> m (Bool, Maybe Actor)
testCheckActorAtPoint a
stage Point
point b
actor = IO (Bool, Maybe Actor) -> m (Bool, Maybe Actor)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Maybe Actor) -> m (Bool, Maybe Actor))
-> IO (Bool, Maybe Actor) -> m (Bool, Maybe Actor)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Actor
stage' <- a -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stage
    Ptr Point
point' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
point
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr (Ptr Actor)
result_ <- IO (Ptr (Ptr Actor))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Clutter.Actor.Actor))
    CInt
result <- Ptr Actor -> Ptr Point -> Ptr Actor -> Ptr (Ptr Actor) -> IO CInt
clutter_test_check_actor_at_point Ptr Actor
stage' Ptr Point
point' Ptr Actor
actor' Ptr (Ptr Actor)
result_
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Actor
result_' <- Ptr (Ptr Actor) -> IO (Ptr Actor)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Actor)
result_
    Maybe Actor
maybeResult_' <- Ptr Actor -> (Ptr Actor -> IO Actor) -> IO (Maybe Actor)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Actor
result_' ((Ptr Actor -> IO Actor) -> IO (Maybe Actor))
-> (Ptr Actor -> IO Actor) -> IO (Maybe Actor)
forall a b. (a -> b) -> a -> b
$ \Ptr Actor
result_'' -> do
        Actor
result_''' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result_''
        Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result_'''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stage
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
point
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    Ptr (Ptr Actor) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Actor)
result_
    (Bool, Maybe Actor) -> IO (Bool, Maybe Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Maybe Actor
maybeResult_')


-- function test_add_data_full
-- Args: [ Arg
--           { argCName = "test_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "unique path for identifying the test"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "test_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "TestDataFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function containing the test"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "test_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to the test function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "test_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function called when the test function ends"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_test_add_data_full" clutter_test_add_data_full :: 
    CString ->                              -- test_path : TBasicType TUTF8
    FunPtr GLib.Callbacks.C_TestDataFunc -> -- test_func : TInterface (Name {namespace = "GLib", name = "TestDataFunc"})
    Ptr () ->                               -- test_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- test_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Adds a test unit to the Clutter test environment.
-- 
-- See also: @/g_test_add_data_func_full()/@
-- 
-- /Since: 1.18/
testAddDataFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@testPath@/: unique path for identifying the test
    -> GLib.Callbacks.TestDataFunc
    -- ^ /@testFunc@/: function containing the test
    -> m ()
testAddDataFull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> IO () -> m ()
testAddDataFull Text
testPath IO ()
testFunc = 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
testPath' <- Text -> IO CString
textToCString Text
testPath
    FunPtr C_DestroyNotify
testFunc' <- C_DestroyNotify -> IO (FunPtr C_DestroyNotify)
GLib.Callbacks.mk_TestDataFunc (Maybe (Ptr (FunPtr C_DestroyNotify))
-> C_DestroyNotify -> C_DestroyNotify
GLib.Callbacks.wrap_TestDataFunc Maybe (Ptr (FunPtr C_DestroyNotify))
forall a. Maybe a
Nothing (IO () -> C_DestroyNotify
GLib.Callbacks.drop_closures_TestDataFunc IO ()
testFunc))
    let testData :: Ptr ()
testData = FunPtr C_DestroyNotify -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_DestroyNotify
testFunc'
    let testNotify :: FunPtr (Ptr a -> IO ())
testNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    CString
-> FunPtr C_DestroyNotify
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
clutter_test_add_data_full CString
testPath' FunPtr C_DestroyNotify
testFunc' Ptr ()
testData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
testNotify
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
testPath'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


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

foreign import ccall "clutter_set_windowing_backend" clutter_set_windowing_backend :: 
    CString ->                              -- backend_type : TBasicType TUTF8
    IO ()

-- | Restricts Clutter to only use the specified backend or list of backends.
-- 
-- You can use one of the @CLUTTER_WINDOWING_*@ symbols, e.g.
-- 
-- 
-- === /C code/
-- >
-- >  clutter_set_windowing_backend (CLUTTER_WINDOWING_X11);
-- 
-- 
-- Will force Clutter to use the X11 windowing and input backend, and terminate
-- if the X11 backend could not be initialized successfully.
-- 
-- Since Clutter 1.26, you can also use a comma-separated list of windowing
-- system backends to provide a fallback in case backends are not available or
-- enabled, e.g.:
-- 
-- 
-- === /C code/
-- >
-- >  clutter_set_windowing_backend ("gdk,wayland,x11");
-- 
-- 
-- Will make Clutter test for the GDK, Wayland, and X11 backends in that order.
-- 
-- You can use the @*@ special value to ask Clutter to use the internally
-- defined list of backends. For instance:
-- 
-- 
-- === /C code/
-- >
-- >  clutter_set_windowing_backend ("x11,wayland,*");
-- 
-- 
-- Will make Clutter test the X11 and Wayland backends, and then fall back
-- to the internal list of available backends.
-- 
-- This function must be called before the first API call to Clutter, including
-- @/clutter_get_option_context()/@
-- 
-- /Since: 1.16/
setWindowingBackend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@backendType@/: a comma separated list of windowing backends
    -> m ()
setWindowingBackend :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
setWindowingBackend Text
backendType = 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
backendType' <- Text -> IO CString
textToCString Text
backendType
    CString -> IO ()
clutter_set_windowing_backend CString
backendType'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
backendType'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function set_motion_events_enabled
-- Args: [ Arg
--           { argCName = "enable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to enable per-actor motion events"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_set_motion_events_enabled" clutter_set_motion_events_enabled :: 
    CInt ->                                 -- enable : TBasicType TBoolean
    IO ()

{-# DEPRECATED setMotionEventsEnabled ["(Since version 1.8)","Use 'GI.Clutter.Objects.Stage.stageSetMotionEventsEnabled' instead."] #-}
-- | Sets whether per-actor motion events should be enabled or not on
-- all t'GI.Clutter.Objects.Stage.Stage's managed by Clutter.
-- 
-- If /@enable@/ is 'P.False' the following events will not work:
-- 
--  - ClutterActor[motionEvent](#g:signal:motionEvent), except on the t'GI.Clutter.Objects.Stage.Stage'
--  - ClutterActor[enterEvent](#g:signal:enterEvent)
--  - ClutterActor[leaveEvent](#g:signal:leaveEvent)
-- 
-- /Since: 0.6/
setMotionEventsEnabled ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Bool
    -- ^ /@enable@/: 'P.True' to enable per-actor motion events
    -> m ()
setMotionEventsEnabled :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Bool -> m ()
setMotionEventsEnabled Bool
enable = 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 enable' :: CInt
enable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
enable
    CInt -> IO ()
clutter_set_motion_events_enabled CInt
enable'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function set_font_flags
-- Args: [ Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "FontFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new flags" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_set_font_flags" clutter_set_font_flags :: 
    CUInt ->                                -- flags : TInterface (Name {namespace = "Clutter", name = "FontFlags"})
    IO ()

{-# DEPRECATED setFontFlags ["(Since version 1.10)","Use 'GI.Clutter.Objects.Backend.backendSetFontOptions' and the","  @/cairo_font_option_t/@ API."] #-}
-- | Sets the font quality options for subsequent text rendering
-- operations.
-- 
-- Using mipmapped textures will improve the quality for scaled down
-- text but will use more texture memory.
-- 
-- Enabling hinting improves text quality for static text but may
-- introduce some artifacts if the text is animated.
-- 
-- /Since: 1.0/
setFontFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Clutter.Flags.FontFlags]
    -- ^ /@flags@/: The new flags
    -> m ()
setFontFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[FontFlags] -> m ()
setFontFlags [FontFlags]
flags = 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 flags' :: CUInt
flags' = [FontFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FontFlags]
flags
    CUInt -> IO ()
clutter_set_font_flags CUInt
flags'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function set_default_frame_rate
-- Args: [ Arg
--           { argCName = "frames_per_sec"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new default frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_set_default_frame_rate" clutter_set_default_frame_rate :: 
    Word32 ->                               -- frames_per_sec : TBasicType TUInt
    IO ()

{-# DEPRECATED setDefaultFrameRate ["(Since version 1.10)","This function does not do anything any more."] #-}
-- | Sets the default frame rate. This frame rate will be used to limit
-- the number of frames drawn if Clutter is not able to synchronize
-- with the vertical refresh rate of the display. When synchronization
-- is possible, this value is ignored.
-- 
-- /Since: 0.6/
setDefaultFrameRate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@framesPerSec@/: the new default frame rate
    -> m ()
setDefaultFrameRate :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Word32 -> m ()
setDefaultFrameRate Word32
framesPerSec = 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
    Word32 -> IO ()
clutter_set_default_frame_rate Word32
framesPerSec
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function redraw
-- Args: [ Arg
--           { argCName = "stage"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Stage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_redraw" clutter_redraw :: 
    Ptr Clutter.Stage.Stage ->              -- stage : TInterface (Name {namespace = "Clutter", name = "Stage"})
    IO ()

{-# DEPRECATED redraw ["(Since version 1.10)","Use 'GI.Clutter.Objects.Stage.stageEnsureRedraw' instead."] #-}
-- | Forces a redraw of the entire stage. Applications should never use this
-- function, but queue a redraw using 'GI.Clutter.Objects.Actor.actorQueueRedraw'.
-- 
-- This function should only be used by libraries integrating Clutter from
-- within another toolkit.
redraw ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Stage.IsStage a) =>
    a
    -> m ()
redraw :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStage a) =>
a -> m ()
redraw a
stage = 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 Stage
stage' <- a -> IO (Ptr Stage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stage
    Ptr Stage -> IO ()
clutter_redraw Ptr Stage
stage'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stage
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function main_quit
-- Args: []
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_main_quit" clutter_main_quit :: 
    IO ()

-- | Terminates the Clutter mainloop.
mainQuit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ()
mainQuit :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
mainQuit  = 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
    IO ()
clutter_main_quit
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


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

foreign import ccall "clutter_main_level" clutter_main_level :: 
    IO Int32

-- | Retrieves the depth of the Clutter mainloop.
mainLevel ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Int32
    -- ^ __Returns:__ The level of the mainloop.
mainLevel :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Int32
mainLevel  = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Int32
result <- IO Int32
clutter_main_level
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function main
-- Args: []
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_main" clutter_main :: 
    IO ()

-- | Starts the Clutter mainloop.
main ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ()
main :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
main  = 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
    IO ()
clutter_main
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function keysym_to_unicode
-- Args: [ Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a 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 "clutter_keysym_to_unicode" clutter_keysym_to_unicode :: 
    Word32 ->                               -- keyval : TBasicType TUInt
    IO Word32

-- | Converts /@keyval@/ from a Clutter key symbol to the corresponding
-- ISO10646 (Unicode) character.
keysymToUnicode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@keyval@/: a key symbol
    -> m Word32
    -- ^ __Returns:__ a Unicode character, or 0 if there  is no corresponding
    --   character.
keysymToUnicode :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Word32
keysymToUnicode 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
clutter_keysym_to_unicode Word32
keyval
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function init_with_args
-- Args: [ Arg
--           { argCName = "argc"
--           , argType = TBasicType TInt
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a pointer to the number of command line arguments"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "argv"
--           , argType = TCArray False (-1) 0 (TBasicType TUTF8)
--           , direction = DirectionInout
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a pointer to the array\n  of command line arguments"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "parameter_string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a string which is displayed in the\n  first line of <option>--help</option> output, after\n  <literal><replaceable>programname</replaceable> [OPTION...]</literal>"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "entries"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 (-1)
--                 (TInterface Name { namespace = "GLib" , name = "OptionEntry" })
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a %NULL terminated array of\n  #GOptionEntry<!-- -->s describing the options of your program"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "translation_domain"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a translation domain to use for\n  translating the <option>--help</option> output for the options in\n  @entries with gettext(), or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "argc"
--              , argType = TBasicType TInt
--              , direction = DirectionInout
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "a pointer to the number of command line arguments"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "InitError" })
-- throws : True
-- Skip return : False

foreign import ccall "clutter_init_with_args" clutter_init_with_args :: 
    Ptr Int32 ->                            -- argc : TBasicType TInt
    Ptr (Ptr CString) ->                    -- argv : TCArray False (-1) 0 (TBasicType TUTF8)
    CString ->                              -- parameter_string : TBasicType TUTF8
    Ptr GLib.OptionEntry.OptionEntry ->     -- entries : TCArray False (-1) (-1) (TInterface (Name {namespace = "GLib", name = "OptionEntry"}))
    CString ->                              -- translation_domain : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | This function does the same work as 'GI.Clutter.Functions.init'. Additionally,
-- it allows you to add your own command line options, and it
-- automatically generates nicely formatted \<option>--help\<\/option>
-- output. Note that your program will be terminated after writing
-- out the help output. Also note that, in case of error, the
-- error message will be placed inside /@error@/ instead of being
-- printed on the display.
-- 
-- Just like 'GI.Clutter.Functions.init', if this function returns an error code then
-- any subsequent call to any other Clutter API will result in undefined
-- behaviour - including segmentation faults.
-- 
-- /Since: 0.2/
initWithArgs ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe ([T.Text])
    -- ^ /@argv@/: a pointer to the array
    --   of command line arguments
    -> Maybe (T.Text)
    -- ^ /@parameterString@/: a string which is displayed in the
    --   first line of \<option>--help\<\/option> output, after
    --   \<literal>\<replaceable>programname\<\/replaceable> [OPTION...]\<\/literal>
    -> Maybe ([GLib.OptionEntry.OptionEntry])
    -- ^ /@entries@/: a 'P.Nothing' terminated array of
    --   t'GI.GLib.Structs.OptionEntry.OptionEntry's describing the options of your program
    -> Maybe (T.Text)
    -- ^ /@translationDomain@/: a translation domain to use for
    --   translating the \<option>--help\<\/option> output for the options in
    --   /@entries@/ with @/gettext()/@, or 'P.Nothing'
    -> m ((Clutter.Enums.InitError, Maybe [T.Text]))
    -- ^ __Returns:__ 'GI.Clutter.Enums.InitErrorSuccess' if Clutter has been successfully
    --   initialised, or other values or t'GI.Clutter.Enums.InitError' in case of
    --   error. /(Can throw 'Data.GI.Base.GError.GError')/
initWithArgs :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [Text]
-> Maybe Text
-> Maybe [OptionEntry]
-> Maybe Text
-> m (InitError, Maybe [Text])
initWithArgs Maybe [Text]
argv Maybe Text
parameterString Maybe [OptionEntry]
entries Maybe Text
translationDomain = IO (InitError, Maybe [Text]) -> m (InitError, Maybe [Text])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InitError, Maybe [Text]) -> m (InitError, Maybe [Text]))
-> IO (InitError, Maybe [Text]) -> m (InitError, Maybe [Text])
forall a b. (a -> b) -> a -> b
$ do
    let argc :: Int32
argc = case Maybe [Text]
argv of
            Maybe [Text]
Nothing -> Int32
0
            Just [Text]
jArgv -> Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Text]
jArgv
    Ptr Int32
argc' <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int32
argc' Int32
argc
    Ptr CString
maybeArgv <- case Maybe [Text]
argv of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jArgv -> do
            Ptr CString
jArgv' <- [Text] -> IO (Ptr CString)
packUTF8CArray [Text]
jArgv
            Ptr CString -> IO (Ptr CString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jArgv'
    Ptr (Ptr CString)
maybeArgv' <- IO (Ptr (Ptr CString))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr CString))
    Ptr (Ptr CString) -> Ptr CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CString)
maybeArgv' Ptr CString
maybeArgv
    CString
maybeParameterString <- case Maybe Text
parameterString of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jParameterString -> do
            CString
jParameterString' <- Text -> IO CString
textToCString Text
jParameterString
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jParameterString'
    Ptr OptionEntry
maybeEntries <- case Maybe [OptionEntry]
entries of
        Maybe [OptionEntry]
Nothing -> Ptr OptionEntry -> IO (Ptr OptionEntry)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr OptionEntry
forall a. Ptr a
nullPtr
        Just [OptionEntry]
jEntries -> do
            [Ptr OptionEntry]
jEntries' <- (OptionEntry -> IO (Ptr OptionEntry))
-> [OptionEntry] -> IO [Ptr OptionEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM OptionEntry -> IO (Ptr OptionEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [OptionEntry]
jEntries
            Ptr OptionEntry
jEntries'' <- Int -> [Ptr OptionEntry] -> IO (Ptr OptionEntry)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
48 [Ptr OptionEntry]
jEntries'
            Ptr OptionEntry -> IO (Ptr OptionEntry)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr OptionEntry
jEntries''
    CString
maybeTranslationDomain <- case Maybe Text
translationDomain of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jTranslationDomain -> do
            CString
jTranslationDomain' <- Text -> IO CString
textToCString Text
jTranslationDomain
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTranslationDomain'
    IO (InitError, Maybe [Text])
-> IO () -> IO (InitError, Maybe [Text])
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
result <- (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 Int32
-> Ptr (Ptr CString)
-> CString
-> Ptr OptionEntry
-> CString
-> Ptr (Ptr GError)
-> IO CInt
clutter_init_with_args Ptr Int32
argc' Ptr (Ptr CString)
maybeArgv' CString
maybeParameterString Ptr OptionEntry
maybeEntries CString
maybeTranslationDomain
        Int32
argc'' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
argc'
        let result' :: InitError
result' = (Int -> InitError
forall a. Enum a => Int -> a
toEnum (Int -> InitError) -> (CInt -> Int) -> CInt -> InitError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
        Ptr CString
maybeArgv'' <- Ptr (Ptr CString) -> IO (Ptr CString)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CString)
maybeArgv'
        Maybe [Text]
maybeMaybeArgv'' <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
maybeArgv'' ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
maybeArgv''' -> do
            [Text]
maybeArgv'''' <- (Int32 -> Ptr CString -> IO [Text]
forall a.
(HasCallStack, Integral a) =>
a -> Ptr CString -> IO [Text]
unpackUTF8CArrayWithLength Int32
argc'') Ptr CString
maybeArgv'''
            (Int32 -> (CString -> IO ()) -> Ptr CString -> IO ()
forall a b c.
(Storable a, Integral b) =>
b -> (a -> IO c) -> Ptr a -> IO ()
mapCArrayWithLength Int32
argc'') CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeArgv'''
            Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeArgv'''
            [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
maybeArgv''''
        Maybe [OptionEntry] -> ([OptionEntry] -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe [OptionEntry]
entries ((OptionEntry -> IO ()) -> [OptionEntry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ OptionEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr)
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
argc'
        Ptr (Ptr CString) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CString)
maybeArgv'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeParameterString
        Ptr OptionEntry -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr OptionEntry
maybeEntries
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTranslationDomain
        (InitError, Maybe [Text]) -> IO (InitError, Maybe [Text])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InitError
result', Maybe [Text]
maybeMaybeArgv'')
     ) (do
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
argc'
        Ptr (Ptr CString) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CString)
maybeArgv'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeParameterString
        Ptr OptionEntry -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr OptionEntry
maybeEntries
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTranslationDomain
     )


-- function init
-- Args: [ Arg
--           { argCName = "argc"
--           , argType = TBasicType TInt
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The number of arguments in @argv"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "argv"
--           , argType = TCArray False (-1) 0 (TBasicType TUTF8)
--           , direction = DirectionInout
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to an array\n  of arguments."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "argc"
--              , argType = TBasicType TInt
--              , direction = DirectionInout
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "The number of arguments in @argv"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "InitError" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_init" clutter_init :: 
    Ptr Int32 ->                            -- argc : TBasicType TInt
    Ptr (Ptr CString) ->                    -- argv : TCArray False (-1) 0 (TBasicType TUTF8)
    IO CInt

-- | Initialises everything needed to operate with Clutter and parses some
-- standard command line options; /@argc@/ and /@argv@/ are adjusted accordingly
-- so your own code will never see those standard arguments.
-- 
-- It is safe to call this function multiple times.
-- 
-- This function will not abort in case of errors during
-- initialization; 'GI.Clutter.Functions.init' will print out the error message on
-- stderr, and will return an error code. It is up to the application
-- code to handle this case. If you need to display the error message
-- yourself, you can use 'GI.Clutter.Functions.initWithArgs', which takes a t'GError'
-- pointer.
-- 
-- If this function fails, and returns an error code, any subsequent
-- Clutter API will have undefined behaviour - including segmentation
-- faults and assertion failures. Make sure to handle the returned
-- t'GI.Clutter.Enums.InitError' enumeration value.
init ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe ([T.Text])
    -- ^ /@argv@/: A pointer to an array
    --   of arguments.
    -> m ((Clutter.Enums.InitError, Maybe [T.Text]))
    -- ^ __Returns:__ a t'GI.Clutter.Enums.InitError' value
init :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [Text] -> m (InitError, Maybe [Text])
init Maybe [Text]
argv = IO (InitError, Maybe [Text]) -> m (InitError, Maybe [Text])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InitError, Maybe [Text]) -> m (InitError, Maybe [Text]))
-> IO (InitError, Maybe [Text]) -> m (InitError, Maybe [Text])
forall a b. (a -> b) -> a -> b
$ do
    let argc :: Int32
argc = case Maybe [Text]
argv of
            Maybe [Text]
Nothing -> Int32
0
            Just [Text]
jArgv -> Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Text]
jArgv
    Ptr Int32
argc' <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int32
argc' Int32
argc
    Ptr CString
maybeArgv <- case Maybe [Text]
argv of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jArgv -> do
            Ptr CString
jArgv' <- [Text] -> IO (Ptr CString)
packUTF8CArray [Text]
jArgv
            Ptr CString -> IO (Ptr CString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jArgv'
    Ptr (Ptr CString)
maybeArgv' <- IO (Ptr (Ptr CString))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr CString))
    Ptr (Ptr CString) -> Ptr CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CString)
maybeArgv' Ptr CString
maybeArgv
    CInt
result <- Ptr Int32 -> Ptr (Ptr CString) -> IO CInt
clutter_init Ptr Int32
argc' Ptr (Ptr CString)
maybeArgv'
    Int32
argc'' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
argc'
    let result' :: InitError
result' = (Int -> InitError
forall a. Enum a => Int -> a
toEnum (Int -> InitError) -> (CInt -> Int) -> CInt -> InitError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    Ptr CString
maybeArgv'' <- Ptr (Ptr CString) -> IO (Ptr CString)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CString)
maybeArgv'
    Maybe [Text]
maybeMaybeArgv'' <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
maybeArgv'' ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
maybeArgv''' -> do
        [Text]
maybeArgv'''' <- (Int32 -> Ptr CString -> IO [Text]
forall a.
(HasCallStack, Integral a) =>
a -> Ptr CString -> IO [Text]
unpackUTF8CArrayWithLength Int32
argc'') Ptr CString
maybeArgv'''
        (Int32 -> (CString -> IO ()) -> Ptr CString -> IO ()
forall a b c.
(Storable a, Integral b) =>
b -> (a -> IO c) -> Ptr a -> IO ()
mapCArrayWithLength Int32
argc'') CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeArgv'''
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeArgv'''
        [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
maybeArgv''''
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
argc'
    Ptr (Ptr CString) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CString)
maybeArgv'
    (InitError, Maybe [Text]) -> IO (InitError, Maybe [Text])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InitError
result', Maybe [Text]
maybeMaybeArgv'')


-- function grab_pointer_for_device
-- Args: [ Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id_"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a device id, or -1" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_grab_pointer_for_device" clutter_grab_pointer_for_device :: 
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    Int32 ->                                -- id_ : TBasicType TInt
    IO ()

{-# DEPRECATED grabPointerForDevice ["(Since version 1.10)","Use 'GI.Clutter.Objects.InputDevice.inputDeviceGrab' instead."] #-}
-- | Grabs all the pointer events coming from the device /@id@/ for /@actor@/.
-- 
-- If /@id@/ is -1 then this function is equivalent to 'GI.Clutter.Functions.grabPointer'.
-- 
-- /Since: 0.8/
grabPointerForDevice ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Actor.IsActor a) =>
    a
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> Int32
    -- ^ /@id_@/: a device id, or -1
    -> m ()
grabPointerForDevice :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActor a) =>
a -> Int32 -> m ()
grabPointerForDevice a
actor Int32
id_ = 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 Actor
actor' <- a -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
actor
    Ptr Actor -> Int32 -> IO ()
clutter_grab_pointer_for_device Ptr Actor
actor' Int32
id_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
actor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function grab_pointer
-- Args: [ Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_grab_pointer" clutter_grab_pointer :: 
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

-- | Grabs pointer events, after the grab is done all pointer related events
-- (press, motion, release, enter, leave and scroll) are delivered to this
-- actor directly without passing through both capture and bubble phases of
-- the event delivery chain. The source set in the event will be the actor
-- that would have received the event if the pointer grab was not in effect.
-- 
-- Grabs completely override the entire event delivery chain
-- done by Clutter. Pointer grabs should only be used as a last resource;
-- using the [Actor::capturedEvent]("GI.Clutter.Objects.Actor#g:signal:capturedEvent") signal should always be the
-- preferred way to intercept event delivery to reactive actors.
-- 
-- This function should rarely be used.
-- 
-- If a grab is required, you are strongly encouraged to use a specific
-- input device by calling 'GI.Clutter.Objects.InputDevice.inputDeviceGrab'.
-- 
-- /Since: 0.6/
grabPointer ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Actor.IsActor a) =>
    a
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m ()
grabPointer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActor a) =>
a -> m ()
grabPointer a
actor = 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 Actor
actor' <- a -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
actor
    Ptr Actor -> IO ()
clutter_grab_pointer Ptr Actor
actor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
actor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function grab_keyboard
-- Args: [ Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_grab_keyboard" clutter_grab_keyboard :: 
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

-- | Grabs keyboard events, after the grab is done keyboard
-- events ([Actor::keyPressEvent]("GI.Clutter.Objects.Actor#g:signal:keyPressEvent") and [Actor::keyReleaseEvent]("GI.Clutter.Objects.Actor#g:signal:keyReleaseEvent"))
-- are delivered to this actor directly. The source set in the event will be
-- the actor that would have received the event if the keyboard grab was not
-- in effect.
-- 
-- Like pointer grabs, keyboard grabs should only be used as a last
-- resource.
-- 
-- See also 'GI.Clutter.Objects.Stage.stageSetKeyFocus' and 'GI.Clutter.Objects.Actor.actorGrabKeyFocus'
-- to perform a \"soft\" key grab and assign key focus to a specific actor.
-- 
-- /Since: 0.6/
grabKeyboard ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Actor.IsActor a) =>
    a
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m ()
grabKeyboard :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActor a) =>
a -> m ()
grabKeyboard a
actor = 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 Actor
actor' <- a -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
actor
    Ptr Actor -> IO ()
clutter_grab_keyboard Ptr Actor
actor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
actor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


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

foreign import ccall "clutter_get_timestamp" clutter_get_timestamp :: 
    IO CULong

{-# DEPRECATED getTimestamp ["(Since version 1.10)","Use t'GI.GLib.Structs.Timer.Timer' or 'GI.GLib.Functions.getMonotonicTime' for a proper","  timing source"] #-}
-- | Returns the approximate number of microseconds passed since Clutter was
-- intialised.
-- 
-- This function shdould not be used by application code.
-- 
-- The output of this function depends on whether Clutter was configured to
-- enable its debugging code paths, so it\'s less useful than intended.
-- 
-- Since Clutter 1.10, this function is an alias to 'GI.GLib.Functions.getMonotonicTime'
-- if Clutter was configured to enable the debugging code paths.
getTimestamp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m CULong
    -- ^ __Returns:__ Number of microseconds since 'GI.Clutter.Functions.init' was called, or
    --   zero if Clutter was not configured with debugging code paths.
getTimestamp :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m CULong
getTimestamp  = IO CULong -> m CULong
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CULong -> m CULong) -> IO CULong -> m CULong
forall a b. (a -> b) -> a -> b
$ do
    CULong
result <- IO CULong
clutter_get_timestamp
    CULong -> IO CULong
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CULong
result


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

foreign import ccall "clutter_get_show_fps" clutter_get_show_fps :: 
    IO CInt

{-# DEPRECATED getShowFps ["(Since version 1.10)","This function does not do anything. Use the environment","  variable or the configuration file to determine whether Clutter should","  print out the FPS counter on the console."] #-}
-- | Returns whether Clutter should print out the frames per second on the
-- console. You can enable this setting either using the
-- \<literal>CLUTTER_SHOW_FPS\<\/literal> environment variable or passing
-- the \<literal>--clutter-show-fps\<\/literal> command line argument. *
-- 
-- /Since: 0.4/
getShowFps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Bool
    -- ^ __Returns:__ 'P.True' if Clutter should show the FPS.
getShowFps :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Bool
getShowFps  = SourceFunc -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SourceFunc -> m Bool) -> SourceFunc -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CInt
result <- IO CInt
clutter_get_show_fps
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> SourceFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function get_script_id
-- Args: [ Arg
--           { argCName = "gobject"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GObject" , 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 "clutter_get_script_id" clutter_get_script_id :: 
    Ptr GObject.Object.Object ->            -- gobject : TInterface (Name {namespace = "GObject", name = "Object"})
    IO CString

-- | Retrieves the Clutter script id, if any.
-- 
-- /Since: 0.6/
getScriptId ::
    (B.CallStack.HasCallStack, MonadIO m, GObject.Object.IsObject a) =>
    a
    -- ^ /@gobject@/: a t'GI.GObject.Objects.Object.Object'
    -> m T.Text
    -- ^ __Returns:__ the script id, or 'P.Nothing' if /@object@/ was not defined inside
    --   a UI definition file. The returned string is owned by the object and
    --   should never be modified or freed.
getScriptId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObject a) =>
a -> m Text
getScriptId a
gobject = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
gobject' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gobject
    CString
result <- Ptr Object -> IO CString
clutter_get_script_id Ptr Object
gobject'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"getScriptId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
gobject
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function get_pointer_grab
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_get_pointer_grab" clutter_get_pointer_grab :: 
    IO (Ptr Clutter.Actor.Actor)

-- | Queries the current pointer grab of clutter.
-- 
-- /Since: 0.6/
getPointerGrab ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Clutter.Actor.Actor
    -- ^ __Returns:__ the actor currently holding the pointer grab, or NULL if there is no grab.
getPointerGrab :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Actor
getPointerGrab  = IO Actor -> m Actor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr Actor
result <- IO (Ptr Actor)
clutter_get_pointer_grab
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"getPointerGrab" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'


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

foreign import ccall "clutter_get_motion_events_enabled" clutter_get_motion_events_enabled :: 
    IO CInt

{-# DEPRECATED getMotionEventsEnabled ["(Since version 1.8)","Use 'GI.Clutter.Objects.Stage.stageGetMotionEventsEnabled' instead."] #-}
-- | Gets whether the per-actor motion events are enabled.
-- 
-- /Since: 0.6/
getMotionEventsEnabled ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Bool
    -- ^ __Returns:__ 'P.True' if the motion events are enabled
getMotionEventsEnabled :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Bool
getMotionEventsEnabled  = SourceFunc -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SourceFunc -> m Bool) -> SourceFunc -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CInt
result <- IO CInt
clutter_get_motion_events_enabled
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> SourceFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function get_keyboard_grab
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_get_keyboard_grab" clutter_get_keyboard_grab :: 
    IO (Ptr Clutter.Actor.Actor)

-- | Queries the current keyboard grab of clutter.
-- 
-- /Since: 0.6/
getKeyboardGrab ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Clutter.Actor.Actor
    -- ^ __Returns:__ the actor currently holding the keyboard grab, or NULL if there is no grab.
getKeyboardGrab :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Actor
getKeyboardGrab  = IO Actor -> m Actor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr Actor
result <- IO (Ptr Actor)
clutter_get_keyboard_grab
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"getKeyboardGrab" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'


-- function get_input_device_for_id
-- Args: [ Arg
--           { argCName = "id_"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the unique id for a device"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "InputDevice" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_get_input_device_for_id" clutter_get_input_device_for_id :: 
    Int32 ->                                -- id_ : TBasicType TInt
    IO (Ptr Clutter.InputDevice.InputDevice)

{-# DEPRECATED getInputDeviceForId ["(Since version 1.10)","Use 'GI.Clutter.Objects.DeviceManager.deviceManagerGetDevice' instead."] #-}
-- | Retrieves the t'GI.Clutter.Objects.InputDevice.InputDevice' from its /@id_@/. This is a convenience
-- wrapper for 'GI.Clutter.Objects.DeviceManager.deviceManagerGetDevice' and it is functionally
-- equivalent to:
-- 
-- >
-- >  ClutterDeviceManager *manager;
-- >  ClutterInputDevice *device;
-- >
-- >  manager = clutter_device_manager_get_default ();
-- >  device = clutter_device_manager_get_device (manager, id);
-- 
-- 
-- /Since: 0.8/
getInputDeviceForId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@id_@/: the unique id for a device
    -> m Clutter.InputDevice.InputDevice
    -- ^ __Returns:__ a t'GI.Clutter.Objects.InputDevice.InputDevice', or 'P.Nothing'
getInputDeviceForId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> m InputDevice
getInputDeviceForId Int32
id_ = IO InputDevice -> m InputDevice
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputDevice -> m InputDevice)
-> IO InputDevice -> m InputDevice
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputDevice
result <- Int32 -> IO (Ptr InputDevice)
clutter_get_input_device_for_id Int32
id_
    Text -> Ptr InputDevice -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"getInputDeviceForId" Ptr InputDevice
result
    InputDevice
result' <- ((ManagedPtr InputDevice -> InputDevice)
-> Ptr InputDevice -> IO InputDevice
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr InputDevice -> InputDevice
Clutter.InputDevice.InputDevice) Ptr InputDevice
result
    InputDevice -> IO InputDevice
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputDevice
result'


-- function get_font_map
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "FontMap" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_get_font_map" clutter_get_font_map :: 
    IO (Ptr Pango.FontMap.FontMap)

-- | Retrieves the t'GI.Pango.Objects.FontMap.FontMap' instance used by Clutter.
-- You can use the global font map object with the COGL
-- Pango API.
-- 
-- /Since: 1.0/
getFontMap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Pango.FontMap.FontMap
    -- ^ __Returns:__ the t'GI.Pango.Objects.FontMap.FontMap' instance. The returned
    --   value is owned by Clutter and it should never be unreferenced.
getFontMap :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m FontMap
getFontMap  = IO FontMap -> m FontMap
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontMap -> m FontMap) -> IO FontMap -> m FontMap
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontMap
result <- IO (Ptr FontMap)
clutter_get_font_map
    Text -> Ptr FontMap -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"getFontMap" Ptr FontMap
result
    FontMap
result' <- ((ManagedPtr FontMap -> FontMap) -> Ptr FontMap -> IO FontMap
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr FontMap -> FontMap
Pango.FontMap.FontMap) Ptr FontMap
result
    FontMap -> IO FontMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FontMap
result'


-- function get_font_flags
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "FontFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_get_font_flags" clutter_get_font_flags :: 
    IO CUInt

{-# DEPRECATED getFontFlags ["(Since version 1.10)","Use 'GI.Clutter.Objects.Backend.backendGetFontOptions' and the","  t'GI.Cairo.Structs.FontOptions.FontOptions' API."] #-}
-- | Gets the current font flags for rendering text. See
-- 'GI.Clutter.Functions.setFontFlags'.
-- 
-- /Since: 1.0/
getFontFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m [Clutter.Flags.FontFlags]
    -- ^ __Returns:__ The font flags
getFontFlags :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m [FontFlags]
getFontFlags  = IO [FontFlags] -> m [FontFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FontFlags] -> m [FontFlags])
-> IO [FontFlags] -> m [FontFlags]
forall a b. (a -> b) -> a -> b
$ do
    CUInt
result <- IO CUInt
clutter_get_font_flags
    let result' :: [FontFlags]
result' = CUInt -> [FontFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    [FontFlags] -> IO [FontFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FontFlags]
result'


-- function get_default_text_direction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "TextDirection" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_get_default_text_direction" clutter_get_default_text_direction :: 
    IO CUInt

-- | Retrieves the default direction for the text. The text direction is
-- determined by the locale and\/or by the @CLUTTER_TEXT_DIRECTION@
-- environment variable.
-- 
-- The default text direction can be overridden on a per-actor basis by using
-- 'GI.Clutter.Objects.Actor.actorSetTextDirection'.
-- 
-- /Since: 1.2/
getDefaultTextDirection ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Clutter.Enums.TextDirection
    -- ^ __Returns:__ the default text direction
getDefaultTextDirection :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m TextDirection
getDefaultTextDirection  = IO TextDirection -> m TextDirection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextDirection -> m TextDirection)
-> IO TextDirection -> m TextDirection
forall a b. (a -> b) -> a -> b
$ do
    CUInt
result <- IO CUInt
clutter_get_default_text_direction
    let result' :: TextDirection
result' = (Int -> TextDirection
forall a. Enum a => Int -> a
toEnum (Int -> TextDirection) -> (CUInt -> Int) -> CUInt -> TextDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    TextDirection -> IO TextDirection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TextDirection
result'


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

foreign import ccall "clutter_get_default_frame_rate" clutter_get_default_frame_rate :: 
    IO Word32

-- | Retrieves the default frame rate. See 'GI.Clutter.Functions.setDefaultFrameRate'.
-- 
-- /Since: 0.6/
getDefaultFrameRate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Word32
    -- ^ __Returns:__ the default frame rate
getDefaultFrameRate :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Word32
getDefaultFrameRate  = 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 <- IO Word32
clutter_get_default_frame_rate
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function get_default_backend
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Backend" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_get_default_backend" clutter_get_default_backend :: 
    IO (Ptr Clutter.Backend.Backend)

-- | Retrieves the default t'GI.Clutter.Objects.Backend.Backend' used by Clutter. The
-- t'GI.Clutter.Objects.Backend.Backend' holds backend-specific configuration options.
-- 
-- /Since: 0.4/
getDefaultBackend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Clutter.Backend.Backend
    -- ^ __Returns:__ the default backend. You should
    --   not ref or unref the returned object. Applications should rarely
    --   need to use this.
getDefaultBackend :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Backend
getDefaultBackend  = IO Backend -> m Backend
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Backend -> m Backend) -> IO Backend -> m Backend
forall a b. (a -> b) -> a -> b
$ do
    Ptr Backend
result <- IO (Ptr Backend)
clutter_get_default_backend
    Text -> Ptr Backend -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"getDefaultBackend" Ptr Backend
result
    Backend
result' <- ((ManagedPtr Backend -> Backend) -> Ptr Backend -> IO Backend
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Backend -> Backend
Clutter.Backend.Backend) Ptr Backend
result
    Backend -> IO Backend
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Backend
result'


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

foreign import ccall "clutter_get_debug_enabled" clutter_get_debug_enabled :: 
    IO CInt

{-# DEPRECATED getDebugEnabled ["(Since version 1.10)","This function does not do anything."] #-}
-- | Check if Clutter has debugging enabled.
getDebugEnabled ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Bool
    -- ^ __Returns:__ 'P.False'
getDebugEnabled :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Bool
getDebugEnabled  = SourceFunc -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SourceFunc -> m Bool) -> SourceFunc -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CInt
result <- IO CInt
clutter_get_debug_enabled
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> SourceFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


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

foreign import ccall "clutter_get_current_event_time" clutter_get_current_event_time :: 
    IO Word32

-- | Retrieves the timestamp of the last event, if there is an
-- event or if the event has a timestamp.
-- 
-- /Since: 1.0/
getCurrentEventTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Word32
    -- ^ __Returns:__ the event timestamp, or 'GI.Clutter.Constants.CURRENT_TIME'
getCurrentEventTime :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Word32
getCurrentEventTime  = 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 <- IO Word32
clutter_get_current_event_time
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function get_current_event
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Event" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_get_current_event" clutter_get_current_event :: 
    IO (Ptr Clutter.Event.Event)

-- | If an event is currently being processed, return that event.
-- This function is intended to be used to access event state
-- that might not be exposed by higher-level widgets.  For
-- example, to get the key modifier state from a Button \'clicked\'
-- event.
-- 
-- /Since: 1.2/
getCurrentEvent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Clutter.Event.Event
    -- ^ __Returns:__ The current ClutterEvent, or 'P.Nothing' if none
getCurrentEvent :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Event
getCurrentEvent  = IO Event -> m Event
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
result <- IO (Ptr Event)
clutter_get_current_event
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"getCurrentEvent" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Event -> Event
Clutter.Event.Event) Ptr Event
result
    Event -> IO Event
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'


-- function get_actor_by_gid
-- Args: [ Arg
--           { argCName = "id_"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor unique id."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_get_actor_by_gid" clutter_get_actor_by_gid :: 
    Word32 ->                               -- id_ : TBasicType TUInt32
    IO (Ptr Clutter.Actor.Actor)

{-# DEPRECATED getActorByGid ["(Since version 1.8)","The id is deprecated, and this function always returns","  'P.Nothing'. Use the proper scene graph API in t'GI.Clutter.Objects.Actor.Actor' to find a child","  of the stage."] #-}
-- | Retrieves the t'GI.Clutter.Objects.Actor.Actor' with /@id_@/.
-- 
-- /Since: 0.6/
getActorByGid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@id_@/: a t'GI.Clutter.Objects.Actor.Actor' unique id.
    -> m Clutter.Actor.Actor
    -- ^ __Returns:__ the actor with the passed id or 'P.Nothing'.
    --   The returned actor does not have its reference count increased.
getActorByGid :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Actor
getActorByGid Word32
id_ = IO Actor -> m Actor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr Actor
result <- Word32 -> IO (Ptr Actor)
clutter_get_actor_by_gid Word32
id_
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"getActorByGid" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'


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

foreign import ccall "clutter_get_accessibility_enabled" clutter_get_accessibility_enabled :: 
    IO CInt

-- | Returns whether Clutter has accessibility support enabled.  As
-- least, a value of TRUE means that there are a proper AtkUtil
-- implementation available
-- 
-- /Since: 1.4/
getAccessibilityEnabled ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Bool
    -- ^ __Returns:__ 'P.True' if Clutter has accessibility support enabled
getAccessibilityEnabled :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Bool
getAccessibilityEnabled  = SourceFunc -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SourceFunc -> m Bool) -> SourceFunc -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CInt
result <- IO CInt
clutter_get_accessibility_enabled
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> SourceFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function frame_source_add
-- Args: [ Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the priority of the frame source. Typically this will be in the\n  range between %G_PRIORITY_DEFAULT and %G_PRIORITY_HIGH."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the number of times per second to call the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "SourceFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function to call" , 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 to pass to the function"
--                 , 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 "function to call when the timeout source is removed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_frame_source_add_full" clutter_frame_source_add_full :: 
    Int32 ->                                -- priority : TBasicType TInt
    Word32 ->                               -- fps : TBasicType TUInt
    FunPtr GLib.Callbacks.C_SourceFunc ->   -- func : TInterface (Name {namespace = "GLib", name = "SourceFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO Word32

{-# DEPRECATED frameSourceAdd ["(Since version 1.6)","There is no direct replacement for this API."] #-}
-- | Sets a function to be called at regular intervals with the given
-- priority.  The function is called repeatedly until it returns
-- 'P.False', at which point the timeout is automatically destroyed and
-- the function will not be called again.  The /@notify@/ function is
-- called when the timeout is destroyed.  The first call to the
-- function will be at the end of the first /@interval@/.
-- 
-- This function is similar to 'GI.GLib.Functions.timeoutAdd' except that it
-- will try to compensate for delays. For example, if /@func@/ takes half
-- the interval time to execute then the function will be called again
-- half the interval time after it finished. In contrast
-- 'GI.GLib.Functions.timeoutAdd' would not fire until a full interval after the
-- function completes so the delay between calls would be 1.0 \/ /@fps@/ *
-- 1.5. This function does not however try to invoke the function
-- multiple times to catch up missing frames if /@func@/ takes more than
-- /@interval@/ ms to execute.
-- 
-- /Since: 0.8/
frameSourceAdd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@priority@/: the priority of the frame source. Typically this will be in the
    --   range between 'GI.GLib.Constants.PRIORITY_DEFAULT' and 'GI.GLib.Constants.PRIORITY_HIGH'.
    -> Word32
    -- ^ /@fps@/: the number of times per second to call the function
    -> GLib.Callbacks.SourceFunc
    -- ^ /@func@/: function to call
    -> m Word32
    -- ^ __Returns:__ the ID (greater than 0) of the event source.
frameSourceAdd :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Word32 -> SourceFunc -> m Word32
frameSourceAdd Int32
priority Word32
fps SourceFunc
func = 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
    FunPtr C_SourceFunc
func' <- C_SourceFunc -> IO (FunPtr C_SourceFunc)
GLib.Callbacks.mk_SourceFunc (Maybe (Ptr (FunPtr C_SourceFunc))
-> SourceFunc_WithClosures -> C_SourceFunc
GLib.Callbacks.wrap_SourceFunc Maybe (Ptr (FunPtr C_SourceFunc))
forall a. Maybe a
Nothing (SourceFunc -> SourceFunc_WithClosures
GLib.Callbacks.drop_closures_SourceFunc SourceFunc
func))
    let data_ :: Ptr ()
data_ = FunPtr C_SourceFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_SourceFunc
func'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Word32
result <- Int32
-> Word32
-> FunPtr C_SourceFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO Word32
clutter_frame_source_add_full Int32
priority Word32
fps FunPtr C_SourceFunc
func' Ptr ()
data_ FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function feature_get_all
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "FeatureFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_feature_get_all" clutter_feature_get_all :: 
    IO CUInt

-- | Returns all the supported features.
-- 
-- /Since: 0.2/
featureGetAll ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m [Clutter.Flags.FeatureFlags]
    -- ^ __Returns:__ a logical OR of all the supported features.
featureGetAll :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m [FeatureFlags]
featureGetAll  = IO [FeatureFlags] -> m [FeatureFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FeatureFlags] -> m [FeatureFlags])
-> IO [FeatureFlags] -> m [FeatureFlags]
forall a b. (a -> b) -> a -> b
$ do
    CUInt
result <- IO CUInt
clutter_feature_get_all
    let result' :: [FeatureFlags]
result' = CUInt -> [FeatureFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    [FeatureFlags] -> IO [FeatureFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FeatureFlags]
result'


-- function feature_available
-- Args: [ Arg
--           { argCName = "feature"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "FeatureFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterFeatureFlags"
--                 , 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 "clutter_feature_available" clutter_feature_available :: 
    CUInt ->                                -- feature : TInterface (Name {namespace = "Clutter", name = "FeatureFlags"})
    IO CInt

-- | Checks whether /@feature@/ is available.  /@feature@/ can be a logical
-- OR of t'GI.Clutter.Flags.FeatureFlags'.
-- 
-- /Since: 0.2/
featureAvailable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Clutter.Flags.FeatureFlags]
    -- ^ /@feature@/: a t'GI.Clutter.Flags.FeatureFlags'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a feature is available
featureAvailable :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[FeatureFlags] -> m Bool
featureAvailable [FeatureFlags]
feature = SourceFunc -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SourceFunc -> m Bool) -> SourceFunc -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    let feature' :: CUInt
feature' = [FeatureFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FeatureFlags]
feature
    CInt
result <- CUInt -> IO CInt
clutter_feature_available CUInt
feature'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> SourceFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


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

foreign import ccall "clutter_events_pending" clutter_events_pending :: 
    IO CInt

-- | Checks if events are pending in the event queue.
-- 
-- /Since: 0.4/
eventsPending ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Bool
    -- ^ __Returns:__ TRUE if there are pending events, FALSE otherwise.
eventsPending :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Bool
eventsPending  = SourceFunc -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SourceFunc -> m Bool) -> SourceFunc -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CInt
result <- IO CInt
clutter_events_pending
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> SourceFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function do_event
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_do_event" clutter_do_event :: 
    Ptr Clutter.Event.Event ->              -- event : TInterface (Name {namespace = "Clutter", name = "Event"})
    IO ()

-- | Processes an event.
-- 
-- The /@event@/ must be a valid t'GI.Clutter.Unions.Event.Event' and have a t'GI.Clutter.Objects.Stage.Stage'
-- associated to it.
-- 
-- This function is only useful when embedding Clutter inside another
-- toolkit, and it should never be called by applications.
-- 
-- /Since: 0.4/
doEvent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Clutter.Event.Event
    -- ^ /@event@/: a t'GI.Clutter.Unions.Event.Event'.
    -> m ()
doEvent :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Event -> m ()
doEvent Event
event = 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 Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Event -> IO ()
clutter_do_event Ptr Event
event'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function disable_accessibility
-- Args: []
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_disable_accessibility" clutter_disable_accessibility :: 
    IO ()

-- | Disable loading the accessibility support. It has the same effect
-- as setting the environment variable
-- CLUTTER_DISABLE_ACCESSIBILITY. For the same reason, this method
-- should be called before 'GI.Clutter.Functions.init'.
-- 
-- /Since: 1.14/
disableAccessibility ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ()
disableAccessibility :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
disableAccessibility  = 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
    IO ()
clutter_disable_accessibility
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function clear_glyph_cache
-- Args: []
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_clear_glyph_cache" clutter_clear_glyph_cache :: 
    IO ()

{-# DEPRECATED clearGlyphCache ["(Since version 1.10)","Use 'GI.Clutter.Functions.getFontMap' and","  'GI.CoglPango.Functions.fontMapClearGlyphCache' instead."] #-}
-- | Clears the internal cache of glyphs used by the Pango
-- renderer. This will free up some memory and GL texture
-- resources. The cache will be automatically refilled as more text is
-- drawn.
-- 
-- /Since: 0.8/
clearGlyphCache ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ()
clearGlyphCache :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
clearGlyphCache  = 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
    IO ()
clutter_clear_glyph_cache
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function check_windowing_backend
-- Args: [ Arg
--           { argCName = "backend_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the backend to check"
--                 , 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 "clutter_check_windowing_backend" clutter_check_windowing_backend :: 
    CString ->                              -- backend_type : TBasicType TUTF8
    IO CInt

-- | Checks the run-time name of the Clutter windowing system backend, using
-- the symbolic macros like @/CLUTTER_WINDOWING_WIN32/@ or
-- 'GI.Clutter.Constants.WINDOWING_X11'.
-- 
-- This function should be used in conjuction with the compile-time macros
-- inside applications and libraries that are using the platform-specific
-- windowing system API, to ensure that they are running on the correct
-- windowing system; for instance:
-- 
-- >
-- >#ifdef CLUTTER_WINDOWING_X11
-- >  if (clutter_check_windowing_backend (CLUTTER_WINDOWING_X11))
-- >    {
-- >      // it is safe to use the clutter_x11_* API
-- >    }
-- >  else
-- >#endif
-- >#ifdef CLUTTER_WINDOWING_WIN32
-- >  if (clutter_check_windowing_backend (CLUTTER_WINDOWING_WIN32))
-- >    {
-- >      // it is safe to use the clutter_win32_* API
-- >    }
-- >  else
-- >#endif
-- >    g_error ("Unknown Clutter backend.");
-- 
-- 
-- /Since: 1.10/
checkWindowingBackend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@backendType@/: the name of the backend to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the current Clutter windowing system backend is
    --   the one checked, and 'P.False' otherwise
checkWindowingBackend :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Bool
checkWindowingBackend Text
backendType = SourceFunc -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SourceFunc -> m Bool) -> SourceFunc -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CString
backendType' <- Text -> IO CString
textToCString Text
backendType
    CInt
result <- CString -> IO CInt
clutter_check_windowing_backend CString
backendType'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
backendType'
    Bool -> SourceFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function check_version
-- Args: [ Arg
--           { argCName = "major"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "major version, like 1 in 1.2.3"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "minor"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "minor version, like 2 in 1.2.3"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "micro"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "micro version, like 3 in 1.2.3"
--                 , 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 "clutter_check_version" clutter_check_version :: 
    Word32 ->                               -- major : TBasicType TUInt
    Word32 ->                               -- minor : TBasicType TUInt
    Word32 ->                               -- micro : TBasicType TUInt
    IO CInt

-- | Run-time version check, to check the version the Clutter library
-- that an application is currently linked against
-- 
-- This is the run-time equivalent of the compile-time @/CLUTTER_CHECK_VERSION/@
-- pre-processor macro
-- 
-- /Since: 1.2/
checkVersion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@major@/: major version, like 1 in 1.2.3
    -> Word32
    -- ^ /@minor@/: minor version, like 2 in 1.2.3
    -> Word32
    -- ^ /@micro@/: micro version, like 3 in 1.2.3
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the version of the Clutter library is
    --   greater than (/@major@/, /@minor@/, /@micro@/), and 'P.False' otherwise
checkVersion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> Word32 -> Word32 -> m Bool
checkVersion Word32
major Word32
minor Word32
micro = SourceFunc -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SourceFunc -> m Bool) -> SourceFunc -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CInt
result <- Word32 -> Word32 -> Word32 -> IO CInt
clutter_check_version Word32
major Word32
minor Word32
micro
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> SourceFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function cairo_set_source_color
-- 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 = "color"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterColor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_cairo_set_source_color" clutter_cairo_set_source_color :: 
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    Ptr Clutter.Color.Color ->              -- color : TInterface (Name {namespace = "Clutter", name = "Color"})
    IO ()

-- | Utility function for setting the source color of /@cr@/ using
-- a t'GI.Clutter.Structs.Color.Color'. This function is the equivalent of:
-- 
-- >
-- >  cairo_set_source_rgba (cr,
-- >                         color->red / 255.0,
-- >                         color->green / 255.0,
-- >                         color->blue / 255.0,
-- >                         color->alpha / 255.0);
-- 
-- 
-- /Since: 1.0/
cairoSetSourceColor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cairo.Context.Context
    -- ^ /@cr@/: a Cairo context
    -> Clutter.Color.Color
    -- ^ /@color@/: a t'GI.Clutter.Structs.Color.Color'
    -> m ()
cairoSetSourceColor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Context -> Color -> m ()
cairoSetSourceColor Context
cr Color
color = 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 Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr Context -> Ptr Color -> IO ()
clutter_cairo_set_source_color Ptr Context
cr' Ptr Color
color'
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function cairo_clear
-- 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Utility function to clear a Cairo context.
-- 
-- /Since: 1.12/
cairoClear ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cairo.Context.Context
    -- ^ /@cr@/: a Cairo context
    -> m ()
cairoClear :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Context -> m ()
cairoClear Context
cr = 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 Context -> IO ()
clutter_cairo_clear Ptr Context
cr'
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function base_init
-- Args: []
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_base_init" clutter_base_init :: 
    IO ()

-- | /No description available in the introspection data./
baseInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ()
baseInit :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ()
baseInit  = 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
    IO ()
clutter_base_init
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()