{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Dazzle.Objects.Animation
    ( 

-- * Exported types
    Animation(..)                           ,
    IsAnimation                             ,
    toAnimation                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addProperty]("GI.Dazzle.Objects.Animation#g:method:addProperty"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [start]("GI.Dazzle.Objects.Animation#g:method:start"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [stop]("GI.Dazzle.Objects.Animation#g:method:stop"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveAnimationMethod                  ,
#endif

-- ** addProperty #method:addProperty#

#if defined(ENABLE_OVERLOADING)
    AnimationAddPropertyMethodInfo          ,
#endif
    animationAddProperty                    ,


-- ** calculateDuration #method:calculateDuration#

    animationCalculateDuration              ,


-- ** start #method:start#

#if defined(ENABLE_OVERLOADING)
    AnimationStartMethodInfo                ,
#endif
    animationStart                          ,


-- ** stop #method:stop#

#if defined(ENABLE_OVERLOADING)
    AnimationStopMethodInfo                 ,
#endif
    animationStop                           ,




 -- * Properties


-- ** duration #attr:duration#
-- | The \"duration\" property is the total number of milliseconds that the
-- animation should run before being completed.

#if defined(ENABLE_OVERLOADING)
    AnimationDurationPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationDuration                       ,
#endif
    constructAnimationDuration              ,


-- ** frameClock #attr:frameClock#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AnimationFrameClockPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationFrameClock                     ,
#endif
    constructAnimationFrameClock            ,


-- ** mode #attr:mode#
-- | The \"mode\" property is the Alpha function that should be used to
-- determine the offset within the animation based on the current
-- offset in the animations duration.

#if defined(ENABLE_OVERLOADING)
    AnimationModePropertyInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationMode                           ,
#endif
    constructAnimationMode                  ,


-- ** target #attr:target#
-- | The \"target\" property is the t'GI.GObject.Objects.Object.Object' that should have its properties
-- animated.

#if defined(ENABLE_OVERLOADING)
    AnimationTargetPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationTarget                         ,
#endif
    constructAnimationTarget                ,




 -- * Signals


-- ** tick #signal:tick#

    AnimationTickCallback                   ,
#if defined(ENABLE_OVERLOADING)
    AnimationTickSignalInfo                 ,
#endif
    afterAnimationTick                      ,
    onAnimationTick                         ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import {-# SOURCE #-} qualified GI.Dazzle.Enums as Dazzle.Enums
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import qualified GI.Gdk.Objects.Monitor as Gdk.Monitor

#else
import {-# SOURCE #-} qualified GI.Dazzle.Enums as Dazzle.Enums
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import qualified GI.Gdk.Objects.Monitor as Gdk.Monitor

#endif

-- | Memory-managed wrapper type.
newtype Animation = Animation (SP.ManagedPtr Animation)
    deriving (Animation -> Animation -> Bool
(Animation -> Animation -> Bool)
-> (Animation -> Animation -> Bool) -> Eq Animation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Animation -> Animation -> Bool
== :: Animation -> Animation -> Bool
$c/= :: Animation -> Animation -> Bool
/= :: Animation -> Animation -> Bool
Eq)

instance SP.ManagedPtrNewtype Animation where
    toManagedPtr :: Animation -> ManagedPtr Animation
toManagedPtr (Animation ManagedPtr Animation
p) = ManagedPtr Animation
p

foreign import ccall "dzl_animation_get_type"
    c_dzl_animation_get_type :: IO B.Types.GType

instance B.Types.TypedObject Animation where
    glibType :: IO GType
glibType = IO GType
c_dzl_animation_get_type

instance B.Types.GObject Animation

-- | Type class for types which can be safely cast to `Animation`, for instance with `toAnimation`.
class (SP.GObject o, O.IsDescendantOf Animation o) => IsAnimation o
instance (SP.GObject o, O.IsDescendantOf Animation o) => IsAnimation o

instance O.HasParentTypes Animation
type instance O.ParentTypes Animation = '[GObject.Object.Object]

-- | Cast to `Animation`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toAnimation :: (MIO.MonadIO m, IsAnimation o) => o -> m Animation
toAnimation :: forall (m :: * -> *) o.
(MonadIO m, IsAnimation o) =>
o -> m Animation
toAnimation = IO Animation -> m Animation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Animation -> m Animation)
-> (o -> IO Animation) -> o -> m Animation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Animation -> Animation) -> o -> IO Animation
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Animation -> Animation
Animation

-- | Convert 'Animation' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Animation) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_dzl_animation_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Animation -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Animation
P.Nothing = Ptr GValue -> Ptr Animation -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Animation
forall a. Ptr a
FP.nullPtr :: FP.Ptr Animation)
    gvalueSet_ Ptr GValue
gv (P.Just Animation
obj) = Animation -> (Ptr Animation -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Animation
obj (Ptr GValue -> Ptr Animation -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Animation)
gvalueGet_ Ptr GValue
gv = do
        Ptr Animation
ptr <- Ptr GValue -> IO (Ptr Animation)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Animation)
        if Ptr Animation
ptr Ptr Animation -> Ptr Animation -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Animation
forall a. Ptr a
FP.nullPtr
        then Animation -> Maybe Animation
forall a. a -> Maybe a
P.Just (Animation -> Maybe Animation)
-> IO Animation -> IO (Maybe Animation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Animation -> Animation)
-> Ptr Animation -> IO Animation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Animation -> Animation
Animation Ptr Animation
ptr
        else Maybe Animation -> IO (Maybe Animation)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Animation
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveAnimationMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveAnimationMethod "addProperty" o = AnimationAddPropertyMethodInfo
    ResolveAnimationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAnimationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAnimationMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAnimationMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAnimationMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAnimationMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAnimationMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAnimationMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAnimationMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAnimationMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAnimationMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAnimationMethod "start" o = AnimationStartMethodInfo
    ResolveAnimationMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAnimationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAnimationMethod "stop" o = AnimationStopMethodInfo
    ResolveAnimationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAnimationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAnimationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAnimationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAnimationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAnimationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAnimationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAnimationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAnimationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAnimationMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveAnimationMethod t Animation, O.OverloadedMethod info Animation p) => OL.IsLabel t (Animation -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveAnimationMethod t Animation, O.OverloadedMethod info Animation p, R.HasField t Animation p) => R.HasField t Animation p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveAnimationMethod t Animation, O.OverloadedMethodInfo info Animation) => OL.IsLabel t (O.MethodProxy info Animation) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal Animation::tick
-- | The \"tick\" signal is emitted on each frame in the animation.
type AnimationTickCallback =
    IO ()

type C_AnimationTickCallback =
    Ptr Animation ->                        -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_AnimationTickCallback`.
foreign import ccall "wrapper"
    mk_AnimationTickCallback :: C_AnimationTickCallback -> IO (FunPtr C_AnimationTickCallback)

wrap_AnimationTickCallback :: 
    GObject a => (a -> AnimationTickCallback) ->
    C_AnimationTickCallback
wrap_AnimationTickCallback :: forall a. GObject a => (a -> IO ()) -> C_AnimationTickCallback
wrap_AnimationTickCallback a -> IO ()
gi'cb Ptr Animation
gi'selfPtr Ptr ()
_ = do
    Ptr Animation -> (Animation -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Animation
gi'selfPtr ((Animation -> IO ()) -> IO ()) -> (Animation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Animation
gi'self -> a -> IO ()
gi'cb (Animation -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Animation
gi'self) 


-- | Connect a signal handler for the [tick](#signal:tick) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' animation #tick callback
-- @
-- 
-- 
onAnimationTick :: (IsAnimation a, MonadIO m) => a -> ((?self :: a) => AnimationTickCallback) -> m SignalHandlerId
onAnimationTick :: forall a (m :: * -> *).
(IsAnimation a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onAnimationTick a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AnimationTickCallback
wrapped' = (a -> IO ()) -> C_AnimationTickCallback
forall a. GObject a => (a -> IO ()) -> C_AnimationTickCallback
wrap_AnimationTickCallback a -> IO ()
wrapped
    FunPtr C_AnimationTickCallback
wrapped'' <- C_AnimationTickCallback -> IO (FunPtr C_AnimationTickCallback)
mk_AnimationTickCallback C_AnimationTickCallback
wrapped'
    a
-> Text
-> FunPtr C_AnimationTickCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"tick" FunPtr C_AnimationTickCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [tick](#signal:tick) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' animation #tick callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterAnimationTick :: (IsAnimation a, MonadIO m) => a -> ((?self :: a) => AnimationTickCallback) -> m SignalHandlerId
afterAnimationTick :: forall a (m :: * -> *).
(IsAnimation a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterAnimationTick a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AnimationTickCallback
wrapped' = (a -> IO ()) -> C_AnimationTickCallback
forall a. GObject a => (a -> IO ()) -> C_AnimationTickCallback
wrap_AnimationTickCallback a -> IO ()
wrapped
    FunPtr C_AnimationTickCallback
wrapped'' <- C_AnimationTickCallback -> IO (FunPtr C_AnimationTickCallback)
mk_AnimationTickCallback C_AnimationTickCallback
wrapped'
    a
-> Text
-> FunPtr C_AnimationTickCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"tick" FunPtr C_AnimationTickCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AnimationTickSignalInfo
instance SignalInfo AnimationTickSignalInfo where
    type HaskellCallbackType AnimationTickSignalInfo = AnimationTickCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AnimationTickCallback cb
        cb'' <- mk_AnimationTickCallback cb'
        connectSignalFunPtr obj "tick" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Animation::tick"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Animation.html#g:signal:tick"})

#endif

-- VVV Prop "duration"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@duration@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAnimationDuration :: (IsAnimation o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructAnimationDuration :: forall o (m :: * -> *).
(IsAnimation o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructAnimationDuration Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"duration" Word32
val

#if defined(ENABLE_OVERLOADING)
data AnimationDurationPropertyInfo
instance AttrInfo AnimationDurationPropertyInfo where
    type AttrAllowedOps AnimationDurationPropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint AnimationDurationPropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationDurationPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint AnimationDurationPropertyInfo = (~) Word32
    type AttrTransferType AnimationDurationPropertyInfo = Word32
    type AttrGetType AnimationDurationPropertyInfo = ()
    type AttrLabel AnimationDurationPropertyInfo = "duration"
    type AttrOrigin AnimationDurationPropertyInfo = Animation
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructAnimationDuration
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Animation.duration"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Animation.html#g:attr:duration"
        })
#endif

-- VVV Prop "frame-clock"
   -- Type: TInterface (Name {namespace = "Gdk", name = "FrameClock"})
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@frame-clock@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAnimationFrameClock :: (IsAnimation o, MIO.MonadIO m, Gdk.FrameClock.IsFrameClock a) => a -> m (GValueConstruct o)
constructAnimationFrameClock :: forall o (m :: * -> *) a.
(IsAnimation o, MonadIO m, IsFrameClock a) =>
a -> m (GValueConstruct o)
constructAnimationFrameClock a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"frame-clock" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data AnimationFrameClockPropertyInfo
instance AttrInfo AnimationFrameClockPropertyInfo where
    type AttrAllowedOps AnimationFrameClockPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint AnimationFrameClockPropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationFrameClockPropertyInfo = Gdk.FrameClock.IsFrameClock
    type AttrTransferTypeConstraint AnimationFrameClockPropertyInfo = Gdk.FrameClock.IsFrameClock
    type AttrTransferType AnimationFrameClockPropertyInfo = Gdk.FrameClock.FrameClock
    type AttrGetType AnimationFrameClockPropertyInfo = ()
    type AttrLabel AnimationFrameClockPropertyInfo = "frame-clock"
    type AttrOrigin AnimationFrameClockPropertyInfo = Animation
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.FrameClock.FrameClock v
    attrConstruct = constructAnimationFrameClock
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Animation.frameClock"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Animation.html#g:attr:frameClock"
        })
#endif

-- VVV Prop "mode"
   -- Type: TInterface (Name {namespace = "Dazzle", name = "AnimationMode"})
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@mode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAnimationMode :: (IsAnimation o, MIO.MonadIO m) => Dazzle.Enums.AnimationMode -> m (GValueConstruct o)
constructAnimationMode :: forall o (m :: * -> *).
(IsAnimation o, MonadIO m) =>
AnimationMode -> m (GValueConstruct o)
constructAnimationMode AnimationMode
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> AnimationMode -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"mode" AnimationMode
val

#if defined(ENABLE_OVERLOADING)
data AnimationModePropertyInfo
instance AttrInfo AnimationModePropertyInfo where
    type AttrAllowedOps AnimationModePropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint AnimationModePropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationModePropertyInfo = (~) Dazzle.Enums.AnimationMode
    type AttrTransferTypeConstraint AnimationModePropertyInfo = (~) Dazzle.Enums.AnimationMode
    type AttrTransferType AnimationModePropertyInfo = Dazzle.Enums.AnimationMode
    type AttrGetType AnimationModePropertyInfo = ()
    type AttrLabel AnimationModePropertyInfo = "mode"
    type AttrOrigin AnimationModePropertyInfo = Animation
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructAnimationMode
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Animation.mode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Animation.html#g:attr:mode"
        })
#endif

-- VVV Prop "target"
   -- Type: TInterface (Name {namespace = "GObject", name = "Object"})
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@target@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAnimationTarget :: (IsAnimation o, MIO.MonadIO m, GObject.Object.IsObject a) => a -> m (GValueConstruct o)
constructAnimationTarget :: forall o (m :: * -> *) a.
(IsAnimation o, MonadIO m, IsObject a) =>
a -> m (GValueConstruct o)
constructAnimationTarget a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"target" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data AnimationTargetPropertyInfo
instance AttrInfo AnimationTargetPropertyInfo where
    type AttrAllowedOps AnimationTargetPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint AnimationTargetPropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationTargetPropertyInfo = GObject.Object.IsObject
    type AttrTransferTypeConstraint AnimationTargetPropertyInfo = GObject.Object.IsObject
    type AttrTransferType AnimationTargetPropertyInfo = GObject.Object.Object
    type AttrGetType AnimationTargetPropertyInfo = ()
    type AttrLabel AnimationTargetPropertyInfo = "target"
    type AttrOrigin AnimationTargetPropertyInfo = Animation
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo GObject.Object.Object v
    attrConstruct = constructAnimationTarget
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Animation.target"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Animation.html#g:attr:target"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Animation
type instance O.AttributeList Animation = AnimationAttributeList
type AnimationAttributeList = ('[ '("duration", AnimationDurationPropertyInfo), '("frameClock", AnimationFrameClockPropertyInfo), '("mode", AnimationModePropertyInfo), '("target", AnimationTargetPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
animationDuration :: AttrLabelProxy "duration"
animationDuration = AttrLabelProxy

animationFrameClock :: AttrLabelProxy "frameClock"
animationFrameClock = AttrLabelProxy

animationMode :: AttrLabelProxy "mode"
animationMode = AttrLabelProxy

animationTarget :: AttrLabelProxy "target"
animationTarget = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Animation = AnimationSignalList
type AnimationSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("tick", AnimationTickSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Animation::add_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlAnimation." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pspec"
--           , argType = TParamSpec
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A #ParamSpec of @target or a #GtkWidget<!-- -->'s parent."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The new value for the property at the end of the animation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_animation_add_property" dzl_animation_add_property :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Dazzle", name = "Animation"})
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Adds a new property to the set of properties to be animated during the
-- lifetime of the animation.
-- 
-- Side effects: None.
animationAddProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: A t'GI.Dazzle.Objects.Animation.Animation'.
    -> GParamSpec
    -- ^ /@pspec@/: A @/ParamSpec/@ of /@target@/ or a t'GI.Gtk.Objects.Widget.Widget'\'s parent.
    -> GValue
    -- ^ /@value@/: The new value for the property at the end of the animation.
    -> m ()
animationAddProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> GParamSpec -> GValue -> m ()
animationAddProperty a
animation GParamSpec
pspec GValue
value = 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 Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Animation -> Ptr GParamSpec -> Ptr GValue -> IO ()
dzl_animation_add_property Ptr Animation
animation' Ptr GParamSpec
pspec' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationAddPropertyMethodInfo
instance (signature ~ (GParamSpec -> GValue -> m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationAddPropertyMethodInfo a signature where
    overloadedMethod = animationAddProperty

instance O.OverloadedMethodInfo AnimationAddPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Animation.animationAddProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Animation.html#v:animationAddProperty"
        })


#endif

-- method Animation::start
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlAnimation." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_animation_start" dzl_animation_start :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Dazzle", name = "Animation"})
    IO ()

-- | Start the animation. When the animation stops, the internal reference will
-- be dropped and the animation may be finalized.
-- 
-- Side effects: None.
animationStart ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: A t'GI.Dazzle.Objects.Animation.Animation'.
    -> m ()
animationStart :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m ()
animationStart a
animation = 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 Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr Animation -> IO ()
dzl_animation_start Ptr Animation
animation'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationStartMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationStartMethodInfo a signature where
    overloadedMethod = animationStart

instance O.OverloadedMethodInfo AnimationStartMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Animation.animationStart",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Animation.html#v:animationStart"
        })


#endif

-- method Animation::stop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlAnimation." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_animation_stop" dzl_animation_stop :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Dazzle", name = "Animation"})
    IO ()

-- | Stops a running animation. The internal reference to the animation is
-- dropped and therefore may cause the object to finalize.
-- 
-- As a convenience, this function accepts 'P.Nothing' for /@animation@/ but
-- does nothing if that should occur.
animationStop ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    Maybe (a)
    -- ^ /@animation@/: A t'GI.Dazzle.Objects.Animation.Animation'.
    -> m ()
animationStop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
Maybe a -> m ()
animationStop Maybe a
animation = 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 Animation
maybeAnimation <- case Maybe a
animation of
        Maybe a
Nothing -> Ptr Animation -> IO (Ptr Animation)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Animation
forall a. Ptr a
nullPtr
        Just a
jAnimation -> do
            Ptr Animation
jAnimation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jAnimation
            Ptr Animation -> IO (Ptr Animation)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Animation
jAnimation'
    Ptr Animation -> IO ()
dzl_animation_stop Ptr Animation
maybeAnimation
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
animation a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationStopMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationStopMethodInfo a signature where
    overloadedMethod i = animationStop (Just i)

instance O.OverloadedMethodInfo AnimationStopMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Animation.animationStop",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Animation.html#v:animationStop"
        })


#endif

-- method Animation::calculate_duration
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "monitor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Monitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "from_value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to_value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_animation_calculate_duration" dzl_animation_calculate_duration :: 
    Ptr Gdk.Monitor.Monitor ->              -- monitor : TInterface (Name {namespace = "Gdk", name = "Monitor"})
    CDouble ->                              -- from_value : TBasicType TDouble
    CDouble ->                              -- to_value : TBasicType TDouble
    IO Word32

-- | /No description available in the introspection data./
animationCalculateDuration ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Monitor.IsMonitor a) =>
    a
    -> Double
    -> Double
    -> m Word32
animationCalculateDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMonitor a) =>
a -> Double -> Double -> m Word32
animationCalculateDuration a
monitor Double
fromValue Double
toValue = 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
    Ptr Monitor
monitor' <- a -> IO (Ptr Monitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
monitor
    let fromValue' :: CDouble
fromValue' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fromValue
    let toValue' :: CDouble
toValue' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
toValue
    Word32
result <- Ptr Monitor -> CDouble -> CDouble -> IO Word32
dzl_animation_calculate_duration Ptr Monitor
monitor' CDouble
fromValue' CDouble
toValue'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
monitor
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
#endif