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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Clutter.Objects.ZoomAction.ZoomAction' structure contains only
-- private data and should be accessed using the provided API
-- 
-- /Since: 1.12/

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

module GI.Clutter.Objects.ZoomAction
    ( 

-- * Exported types
    ZoomAction(..)                          ,
    IsZoomAction                            ,
    toZoomAction                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [cancel]("GI.Clutter.Objects.GestureAction#g:method:cancel"), [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"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [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
-- [getActor]("GI.Clutter.Objects.ActorMeta#g:method:getActor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDevice]("GI.Clutter.Objects.GestureAction#g:method:getDevice"), [getEnabled]("GI.Clutter.Objects.ActorMeta#g:method:getEnabled"), [getFocalPoint]("GI.Clutter.Objects.ZoomAction#g:method:getFocalPoint"), [getLastEvent]("GI.Clutter.Objects.GestureAction#g:method:getLastEvent"), [getMotionCoords]("GI.Clutter.Objects.GestureAction#g:method:getMotionCoords"), [getMotionDelta]("GI.Clutter.Objects.GestureAction#g:method:getMotionDelta"), [getNCurrentPoints]("GI.Clutter.Objects.GestureAction#g:method:getNCurrentPoints"), [getNTouchPoints]("GI.Clutter.Objects.GestureAction#g:method:getNTouchPoints"), [getName]("GI.Clutter.Objects.ActorMeta#g:method:getName"), [getPressCoords]("GI.Clutter.Objects.GestureAction#g:method:getPressCoords"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getReleaseCoords]("GI.Clutter.Objects.GestureAction#g:method:getReleaseCoords"), [getSequence]("GI.Clutter.Objects.GestureAction#g:method:getSequence"), [getThresholdTriggerDistance]("GI.Clutter.Objects.GestureAction#g:method:getThresholdTriggerDistance"), [getThresholdTriggerEdge]("GI.Clutter.Objects.GestureAction#g:method:getThresholdTriggerEdge"), [getThresholdTriggerEgde]("GI.Clutter.Objects.GestureAction#g:method:getThresholdTriggerEgde"), [getTransformedFocalPoint]("GI.Clutter.Objects.ZoomAction#g:method:getTransformedFocalPoint"), [getVelocity]("GI.Clutter.Objects.GestureAction#g:method:getVelocity"), [getZoomAxis]("GI.Clutter.Objects.ZoomAction#g:method:getZoomAxis").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEnabled]("GI.Clutter.Objects.ActorMeta#g:method:setEnabled"), [setNTouchPoints]("GI.Clutter.Objects.GestureAction#g:method:setNTouchPoints"), [setName]("GI.Clutter.Objects.ActorMeta#g:method:setName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setThresholdTriggerDistance]("GI.Clutter.Objects.GestureAction#g:method:setThresholdTriggerDistance"), [setThresholdTriggerEdge]("GI.Clutter.Objects.GestureAction#g:method:setThresholdTriggerEdge"), [setZoomAxis]("GI.Clutter.Objects.ZoomAction#g:method:setZoomAxis").

#if defined(ENABLE_OVERLOADING)
    ResolveZoomActionMethod                 ,
#endif

-- ** getFocalPoint #method:getFocalPoint#

#if defined(ENABLE_OVERLOADING)
    ZoomActionGetFocalPointMethodInfo       ,
#endif
    zoomActionGetFocalPoint                 ,


-- ** getTransformedFocalPoint #method:getTransformedFocalPoint#

#if defined(ENABLE_OVERLOADING)
    ZoomActionGetTransformedFocalPointMethodInfo,
#endif
    zoomActionGetTransformedFocalPoint      ,


-- ** getZoomAxis #method:getZoomAxis#

#if defined(ENABLE_OVERLOADING)
    ZoomActionGetZoomAxisMethodInfo         ,
#endif
    zoomActionGetZoomAxis                   ,


-- ** new #method:new#

    zoomActionNew                           ,


-- ** setZoomAxis #method:setZoomAxis#

#if defined(ENABLE_OVERLOADING)
    ZoomActionSetZoomAxisMethodInfo         ,
#endif
    zoomActionSetZoomAxis                   ,




 -- * Properties


-- ** zoomAxis #attr:zoomAxis#
-- | Constraints the zooming action to the specified axis
-- 
-- /Since: 1.12/

#if defined(ENABLE_OVERLOADING)
    ZoomActionZoomAxisPropertyInfo          ,
#endif
    constructZoomActionZoomAxis             ,
    getZoomActionZoomAxis                   ,
    setZoomActionZoomAxis                   ,
#if defined(ENABLE_OVERLOADING)
    zoomActionZoomAxis                      ,
#endif




 -- * Signals


-- ** zoom #signal:zoom#

    ZoomActionZoomCallback                  ,
#if defined(ENABLE_OVERLOADING)
    ZoomActionZoomSignalInfo                ,
#endif
    afterZoomActionZoom                     ,
    onZoomActionZoom                        ,




    ) 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 {-# SOURCE #-} qualified GI.Clutter.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Objects.Action as Clutter.Action
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.ActorMeta as Clutter.ActorMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.GestureAction as Clutter.GestureAction
import {-# SOURCE #-} qualified GI.Clutter.Structs.Point as Clutter.Point
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_zoom_action_get_type"
    c_clutter_zoom_action_get_type :: IO B.Types.GType

instance B.Types.TypedObject ZoomAction where
    glibType :: IO GType
glibType = IO GType
c_clutter_zoom_action_get_type

instance B.Types.GObject ZoomAction

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

instance O.HasParentTypes ZoomAction
type instance O.ParentTypes ZoomAction = '[Clutter.GestureAction.GestureAction, Clutter.Action.Action, Clutter.ActorMeta.ActorMeta, GObject.Object.Object]

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

-- | Convert 'ZoomAction' 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 ZoomAction) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_zoom_action_get_type
    gvalueSet_ :: Ptr GValue -> Maybe ZoomAction -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ZoomAction
P.Nothing = Ptr GValue -> Ptr ZoomAction -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ZoomAction
forall a. Ptr a
FP.nullPtr :: FP.Ptr ZoomAction)
    gvalueSet_ Ptr GValue
gv (P.Just ZoomAction
obj) = ZoomAction -> (Ptr ZoomAction -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ZoomAction
obj (Ptr GValue -> Ptr ZoomAction -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe ZoomAction)
gvalueGet_ Ptr GValue
gv = do
        Ptr ZoomAction
ptr <- Ptr GValue -> IO (Ptr ZoomAction)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ZoomAction)
        if Ptr ZoomAction
ptr Ptr ZoomAction -> Ptr ZoomAction -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ZoomAction
forall a. Ptr a
FP.nullPtr
        then ZoomAction -> Maybe ZoomAction
forall a. a -> Maybe a
P.Just (ZoomAction -> Maybe ZoomAction)
-> IO ZoomAction -> IO (Maybe ZoomAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr ZoomAction -> ZoomAction)
-> Ptr ZoomAction -> IO ZoomAction
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ZoomAction -> ZoomAction
ZoomAction Ptr ZoomAction
ptr
        else Maybe ZoomAction -> IO (Maybe ZoomAction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ZoomAction
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveZoomActionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveZoomActionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveZoomActionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveZoomActionMethod "cancel" o = Clutter.GestureAction.GestureActionCancelMethodInfo
    ResolveZoomActionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveZoomActionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveZoomActionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveZoomActionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveZoomActionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveZoomActionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveZoomActionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveZoomActionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveZoomActionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveZoomActionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveZoomActionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveZoomActionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveZoomActionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveZoomActionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveZoomActionMethod "getActor" o = Clutter.ActorMeta.ActorMetaGetActorMethodInfo
    ResolveZoomActionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveZoomActionMethod "getDevice" o = Clutter.GestureAction.GestureActionGetDeviceMethodInfo
    ResolveZoomActionMethod "getEnabled" o = Clutter.ActorMeta.ActorMetaGetEnabledMethodInfo
    ResolveZoomActionMethod "getFocalPoint" o = ZoomActionGetFocalPointMethodInfo
    ResolveZoomActionMethod "getLastEvent" o = Clutter.GestureAction.GestureActionGetLastEventMethodInfo
    ResolveZoomActionMethod "getMotionCoords" o = Clutter.GestureAction.GestureActionGetMotionCoordsMethodInfo
    ResolveZoomActionMethod "getMotionDelta" o = Clutter.GestureAction.GestureActionGetMotionDeltaMethodInfo
    ResolveZoomActionMethod "getNCurrentPoints" o = Clutter.GestureAction.GestureActionGetNCurrentPointsMethodInfo
    ResolveZoomActionMethod "getNTouchPoints" o = Clutter.GestureAction.GestureActionGetNTouchPointsMethodInfo
    ResolveZoomActionMethod "getName" o = Clutter.ActorMeta.ActorMetaGetNameMethodInfo
    ResolveZoomActionMethod "getPressCoords" o = Clutter.GestureAction.GestureActionGetPressCoordsMethodInfo
    ResolveZoomActionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveZoomActionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveZoomActionMethod "getReleaseCoords" o = Clutter.GestureAction.GestureActionGetReleaseCoordsMethodInfo
    ResolveZoomActionMethod "getSequence" o = Clutter.GestureAction.GestureActionGetSequenceMethodInfo
    ResolveZoomActionMethod "getThresholdTriggerDistance" o = Clutter.GestureAction.GestureActionGetThresholdTriggerDistanceMethodInfo
    ResolveZoomActionMethod "getThresholdTriggerEdge" o = Clutter.GestureAction.GestureActionGetThresholdTriggerEdgeMethodInfo
    ResolveZoomActionMethod "getThresholdTriggerEgde" o = Clutter.GestureAction.GestureActionGetThresholdTriggerEgdeMethodInfo
    ResolveZoomActionMethod "getTransformedFocalPoint" o = ZoomActionGetTransformedFocalPointMethodInfo
    ResolveZoomActionMethod "getVelocity" o = Clutter.GestureAction.GestureActionGetVelocityMethodInfo
    ResolveZoomActionMethod "getZoomAxis" o = ZoomActionGetZoomAxisMethodInfo
    ResolveZoomActionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveZoomActionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveZoomActionMethod "setEnabled" o = Clutter.ActorMeta.ActorMetaSetEnabledMethodInfo
    ResolveZoomActionMethod "setNTouchPoints" o = Clutter.GestureAction.GestureActionSetNTouchPointsMethodInfo
    ResolveZoomActionMethod "setName" o = Clutter.ActorMeta.ActorMetaSetNameMethodInfo
    ResolveZoomActionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveZoomActionMethod "setThresholdTriggerDistance" o = Clutter.GestureAction.GestureActionSetThresholdTriggerDistanceMethodInfo
    ResolveZoomActionMethod "setThresholdTriggerEdge" o = Clutter.GestureAction.GestureActionSetThresholdTriggerEdgeMethodInfo
    ResolveZoomActionMethod "setZoomAxis" o = ZoomActionSetZoomAxisMethodInfo
    ResolveZoomActionMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveZoomActionMethod t ZoomAction, O.OverloadedMethod info ZoomAction p) => OL.IsLabel t (ZoomAction -> 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 ~ ResolveZoomActionMethod t ZoomAction, O.OverloadedMethod info ZoomAction p, R.HasField t ZoomAction p) => R.HasField t ZoomAction p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- signal ZoomAction::zoom
-- | The [zoom](#g:signal:zoom) signal is emitted for each series of touch events that
-- change the distance and focal point between the touch points.
-- 
-- The default handler of the signal will call
-- 'GI.Clutter.Objects.Actor.actorSetScale' on /@actor@/ using the ratio of the first
-- distance between the touch points and the current distance. To
-- override the default behaviour, connect to this signal and return
-- 'P.False'.
-- 
-- /Since: 1.12/
type ZoomActionZoomCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the t'GI.Clutter.Objects.Actor.Actor' attached to the action
    -> Clutter.Point.Point
    -- ^ /@focalPoint@/: the focal point of the zoom
    -> Double
    -- ^ /@factor@/: the initial distance between the 2 touch points
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the zoom should continue, and 'P.False' if
    --   the zoom should be cancelled.

type C_ZoomActionZoomCallback =
    Ptr ZoomAction ->                       -- object
    Ptr Clutter.Actor.Actor ->
    Ptr Clutter.Point.Point ->
    CDouble ->
    Ptr () ->                               -- user_data
    IO CInt

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

wrap_ZoomActionZoomCallback :: 
    GObject a => (a -> ZoomActionZoomCallback) ->
    C_ZoomActionZoomCallback
wrap_ZoomActionZoomCallback :: forall a.
GObject a =>
(a -> ZoomActionZoomCallback) -> C_ZoomActionZoomCallback
wrap_ZoomActionZoomCallback a -> ZoomActionZoomCallback
gi'cb Ptr ZoomAction
gi'selfPtr Ptr Actor
actor Ptr Point
focalPoint CDouble
factor Ptr ()
_ = do
    Actor
actor' <- ((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
actor
    Ptr Point -> (Point -> IO CInt) -> IO CInt
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Point
focalPoint ((Point -> IO CInt) -> IO CInt) -> (Point -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Point
focalPoint' -> do
        let factor' :: Double
factor' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
factor
        Bool
result <- Ptr ZoomAction -> (ZoomAction -> IO Bool) -> IO Bool
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr ZoomAction
gi'selfPtr ((ZoomAction -> IO Bool) -> IO Bool)
-> (ZoomAction -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ZoomAction
gi'self -> a -> ZoomActionZoomCallback
gi'cb (ZoomAction -> a
forall a b. Coercible a b => a -> b
Coerce.coerce ZoomAction
gi'self)  Actor
actor' Point
focalPoint' Double
factor'
        let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
result
        CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [zoom](#signal:zoom) 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' zoomAction #zoom callback
-- @
-- 
-- 
onZoomActionZoom :: (IsZoomAction a, MonadIO m) => a -> ((?self :: a) => ZoomActionZoomCallback) -> m SignalHandlerId
onZoomActionZoom :: forall a (m :: * -> *).
(IsZoomAction a, MonadIO m) =>
a -> ((?self::a) => ZoomActionZoomCallback) -> m SignalHandlerId
onZoomActionZoom a
obj (?self::a) => ZoomActionZoomCallback
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 -> ZoomActionZoomCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ZoomActionZoomCallback
ZoomActionZoomCallback
cb
    let wrapped' :: C_ZoomActionZoomCallback
wrapped' = (a -> ZoomActionZoomCallback) -> C_ZoomActionZoomCallback
forall a.
GObject a =>
(a -> ZoomActionZoomCallback) -> C_ZoomActionZoomCallback
wrap_ZoomActionZoomCallback a -> ZoomActionZoomCallback
wrapped
    FunPtr C_ZoomActionZoomCallback
wrapped'' <- C_ZoomActionZoomCallback -> IO (FunPtr C_ZoomActionZoomCallback)
mk_ZoomActionZoomCallback C_ZoomActionZoomCallback
wrapped'
    a
-> Text
-> FunPtr C_ZoomActionZoomCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"zoom" FunPtr C_ZoomActionZoomCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [zoom](#signal:zoom) 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' zoomAction #zoom 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.
-- 
afterZoomActionZoom :: (IsZoomAction a, MonadIO m) => a -> ((?self :: a) => ZoomActionZoomCallback) -> m SignalHandlerId
afterZoomActionZoom :: forall a (m :: * -> *).
(IsZoomAction a, MonadIO m) =>
a -> ((?self::a) => ZoomActionZoomCallback) -> m SignalHandlerId
afterZoomActionZoom a
obj (?self::a) => ZoomActionZoomCallback
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 -> ZoomActionZoomCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ZoomActionZoomCallback
ZoomActionZoomCallback
cb
    let wrapped' :: C_ZoomActionZoomCallback
wrapped' = (a -> ZoomActionZoomCallback) -> C_ZoomActionZoomCallback
forall a.
GObject a =>
(a -> ZoomActionZoomCallback) -> C_ZoomActionZoomCallback
wrap_ZoomActionZoomCallback a -> ZoomActionZoomCallback
wrapped
    FunPtr C_ZoomActionZoomCallback
wrapped'' <- C_ZoomActionZoomCallback -> IO (FunPtr C_ZoomActionZoomCallback)
mk_ZoomActionZoomCallback C_ZoomActionZoomCallback
wrapped'
    a
-> Text
-> FunPtr C_ZoomActionZoomCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"zoom" FunPtr C_ZoomActionZoomCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ZoomActionZoomSignalInfo
instance SignalInfo ZoomActionZoomSignalInfo where
    type HaskellCallbackType ZoomActionZoomSignalInfo = ZoomActionZoomCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ZoomActionZoomCallback cb
        cb'' <- mk_ZoomActionZoomCallback cb'
        connectSignalFunPtr obj "zoom" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.ZoomAction::zoom"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-ZoomAction.html#g:signal:zoom"})

#endif

-- VVV Prop "zoom-axis"
   -- Type: TInterface (Name {namespace = "Clutter", name = "ZoomAxis"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@zoom-axis@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' zoomAction #zoomAxis
-- @
getZoomActionZoomAxis :: (MonadIO m, IsZoomAction o) => o -> m Clutter.Enums.ZoomAxis
getZoomActionZoomAxis :: forall (m :: * -> *) o.
(MonadIO m, IsZoomAction o) =>
o -> m ZoomAxis
getZoomActionZoomAxis o
obj = IO ZoomAxis -> m ZoomAxis
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ZoomAxis -> m ZoomAxis) -> IO ZoomAxis -> m ZoomAxis
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ZoomAxis
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"zoom-axis"

-- | Set the value of the “@zoom-axis@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' zoomAction [ #zoomAxis 'Data.GI.Base.Attributes.:=' value ]
-- @
setZoomActionZoomAxis :: (MonadIO m, IsZoomAction o) => o -> Clutter.Enums.ZoomAxis -> m ()
setZoomActionZoomAxis :: forall (m :: * -> *) o.
(MonadIO m, IsZoomAction o) =>
o -> ZoomAxis -> m ()
setZoomActionZoomAxis o
obj ZoomAxis
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> ZoomAxis -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"zoom-axis" ZoomAxis
val

-- | Construct a `GValueConstruct` with valid value for the “@zoom-axis@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructZoomActionZoomAxis :: (IsZoomAction o, MIO.MonadIO m) => Clutter.Enums.ZoomAxis -> m (GValueConstruct o)
constructZoomActionZoomAxis :: forall o (m :: * -> *).
(IsZoomAction o, MonadIO m) =>
ZoomAxis -> m (GValueConstruct o)
constructZoomActionZoomAxis ZoomAxis
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 -> ZoomAxis -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"zoom-axis" ZoomAxis
val

#if defined(ENABLE_OVERLOADING)
data ZoomActionZoomAxisPropertyInfo
instance AttrInfo ZoomActionZoomAxisPropertyInfo where
    type AttrAllowedOps ZoomActionZoomAxisPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ZoomActionZoomAxisPropertyInfo = IsZoomAction
    type AttrSetTypeConstraint ZoomActionZoomAxisPropertyInfo = (~) Clutter.Enums.ZoomAxis
    type AttrTransferTypeConstraint ZoomActionZoomAxisPropertyInfo = (~) Clutter.Enums.ZoomAxis
    type AttrTransferType ZoomActionZoomAxisPropertyInfo = Clutter.Enums.ZoomAxis
    type AttrGetType ZoomActionZoomAxisPropertyInfo = Clutter.Enums.ZoomAxis
    type AttrLabel ZoomActionZoomAxisPropertyInfo = "zoom-axis"
    type AttrOrigin ZoomActionZoomAxisPropertyInfo = ZoomAction
    attrGet = getZoomActionZoomAxis
    attrSet = setZoomActionZoomAxis
    attrTransfer _ v = do
        return v
    attrConstruct = constructZoomActionZoomAxis
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.ZoomAction.zoomAxis"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-ZoomAction.html#g:attr:zoomAxis"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ZoomAction
type instance O.AttributeList ZoomAction = ZoomActionAttributeList
type ZoomActionAttributeList = ('[ '("actor", Clutter.ActorMeta.ActorMetaActorPropertyInfo), '("enabled", Clutter.ActorMeta.ActorMetaEnabledPropertyInfo), '("nTouchPoints", Clutter.GestureAction.GestureActionNTouchPointsPropertyInfo), '("name", Clutter.ActorMeta.ActorMetaNamePropertyInfo), '("thresholdTriggerDistanceX", Clutter.GestureAction.GestureActionThresholdTriggerDistanceXPropertyInfo), '("thresholdTriggerDistanceY", Clutter.GestureAction.GestureActionThresholdTriggerDistanceYPropertyInfo), '("thresholdTriggerEdge", Clutter.GestureAction.GestureActionThresholdTriggerEdgePropertyInfo), '("zoomAxis", ZoomActionZoomAxisPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
zoomActionZoomAxis :: AttrLabelProxy "zoomAxis"
zoomActionZoomAxis = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ZoomAction = ZoomActionSignalList
type ZoomActionSignalList = ('[ '("gestureBegin", Clutter.GestureAction.GestureActionGestureBeginSignalInfo), '("gestureCancel", Clutter.GestureAction.GestureActionGestureCancelSignalInfo), '("gestureEnd", Clutter.GestureAction.GestureActionGestureEndSignalInfo), '("gestureProgress", Clutter.GestureAction.GestureActionGestureProgressSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("zoom", ZoomActionZoomSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method ZoomAction::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "ZoomAction" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_zoom_action_new" clutter_zoom_action_new :: 
    IO (Ptr ZoomAction)

-- | Creates a new t'GI.Clutter.Objects.ZoomAction.ZoomAction' instance
-- 
-- /Since: 1.12/
zoomActionNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ZoomAction
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.ZoomAction.ZoomAction'
zoomActionNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ZoomAction
zoomActionNew  = IO ZoomAction -> m ZoomAction
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ZoomAction -> m ZoomAction) -> IO ZoomAction -> m ZoomAction
forall a b. (a -> b) -> a -> b
$ do
    Ptr ZoomAction
result <- IO (Ptr ZoomAction)
clutter_zoom_action_new
    Text -> Ptr ZoomAction -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"zoomActionNew" Ptr ZoomAction
result
    ZoomAction
result' <- ((ManagedPtr ZoomAction -> ZoomAction)
-> Ptr ZoomAction -> IO ZoomAction
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ZoomAction -> ZoomAction
ZoomAction) Ptr ZoomAction
result
    ZoomAction -> IO ZoomAction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ZoomAction
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ZoomAction::get_focal_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ZoomAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterZoomAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPoint" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_zoom_action_get_focal_point" clutter_zoom_action_get_focal_point :: 
    Ptr ZoomAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "ZoomAction"})
    Ptr Clutter.Point.Point ->              -- point : TInterface (Name {namespace = "Clutter", name = "Point"})
    IO ()

-- | Retrieves the focal point of the current zoom
-- 
-- /Since: 1.12/
zoomActionGetFocalPoint ::
    (B.CallStack.HasCallStack, MonadIO m, IsZoomAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.ZoomAction.ZoomAction'
    -> m (Clutter.Point.Point)
zoomActionGetFocalPoint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsZoomAction a) =>
a -> m Point
zoomActionGetFocalPoint a
action = IO Point -> m Point
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point -> m Point) -> IO Point -> m Point
forall a b. (a -> b) -> a -> b
$ do
    Ptr ZoomAction
action' <- a -> IO (Ptr ZoomAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr Point
point <- Int -> IO (Ptr Point)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
8 :: IO (Ptr Clutter.Point.Point)
    Ptr ZoomAction -> Ptr Point -> IO ()
clutter_zoom_action_get_focal_point Ptr ZoomAction
action' Ptr Point
point
    Point
point' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point -> Point
Clutter.Point.Point) Ptr Point
point
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Point -> IO Point
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Point
point'

#if defined(ENABLE_OVERLOADING)
data ZoomActionGetFocalPointMethodInfo
instance (signature ~ (m (Clutter.Point.Point)), MonadIO m, IsZoomAction a) => O.OverloadedMethod ZoomActionGetFocalPointMethodInfo a signature where
    overloadedMethod = zoomActionGetFocalPoint

instance O.OverloadedMethodInfo ZoomActionGetFocalPointMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.ZoomAction.zoomActionGetFocalPoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-ZoomAction.html#v:zoomActionGetFocalPoint"
        })


#endif

-- method ZoomAction::get_transformed_focal_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ZoomAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterZoomAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPoint" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_zoom_action_get_transformed_focal_point" clutter_zoom_action_get_transformed_focal_point :: 
    Ptr ZoomAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "ZoomAction"})
    Ptr Clutter.Point.Point ->              -- point : TInterface (Name {namespace = "Clutter", name = "Point"})
    IO ()

-- | Retrieves the focal point relative to the actor\'s coordinates of
-- the current zoom
-- 
-- /Since: 1.12/
zoomActionGetTransformedFocalPoint ::
    (B.CallStack.HasCallStack, MonadIO m, IsZoomAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.ZoomAction.ZoomAction'
    -> m (Clutter.Point.Point)
zoomActionGetTransformedFocalPoint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsZoomAction a) =>
a -> m Point
zoomActionGetTransformedFocalPoint a
action = IO Point -> m Point
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point -> m Point) -> IO Point -> m Point
forall a b. (a -> b) -> a -> b
$ do
    Ptr ZoomAction
action' <- a -> IO (Ptr ZoomAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr Point
point <- Int -> IO (Ptr Point)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
8 :: IO (Ptr Clutter.Point.Point)
    Ptr ZoomAction -> Ptr Point -> IO ()
clutter_zoom_action_get_transformed_focal_point Ptr ZoomAction
action' Ptr Point
point
    Point
point' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point -> Point
Clutter.Point.Point) Ptr Point
point
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Point -> IO Point
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Point
point'

#if defined(ENABLE_OVERLOADING)
data ZoomActionGetTransformedFocalPointMethodInfo
instance (signature ~ (m (Clutter.Point.Point)), MonadIO m, IsZoomAction a) => O.OverloadedMethod ZoomActionGetTransformedFocalPointMethodInfo a signature where
    overloadedMethod = zoomActionGetTransformedFocalPoint

instance O.OverloadedMethodInfo ZoomActionGetTransformedFocalPointMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.ZoomAction.zoomActionGetTransformedFocalPoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-ZoomAction.html#v:zoomActionGetTransformedFocalPoint"
        })


#endif

-- method ZoomAction::get_zoom_axis
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ZoomAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterZoomAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "ZoomAxis" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_zoom_action_get_zoom_axis" clutter_zoom_action_get_zoom_axis :: 
    Ptr ZoomAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "ZoomAction"})
    IO CUInt

-- | Retrieves the axis constraint set by 'GI.Clutter.Objects.ZoomAction.zoomActionSetZoomAxis'
-- 
-- /Since: 1.12/
zoomActionGetZoomAxis ::
    (B.CallStack.HasCallStack, MonadIO m, IsZoomAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.ZoomAction.ZoomAction'
    -> m Clutter.Enums.ZoomAxis
    -- ^ __Returns:__ the axis constraint
zoomActionGetZoomAxis :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsZoomAction a) =>
a -> m ZoomAxis
zoomActionGetZoomAxis a
action = IO ZoomAxis -> m ZoomAxis
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ZoomAxis -> m ZoomAxis) -> IO ZoomAxis -> m ZoomAxis
forall a b. (a -> b) -> a -> b
$ do
    Ptr ZoomAction
action' <- a -> IO (Ptr ZoomAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    CUInt
result <- Ptr ZoomAction -> IO CUInt
clutter_zoom_action_get_zoom_axis Ptr ZoomAction
action'
    let result' :: ZoomAxis
result' = (Int -> ZoomAxis
forall a. Enum a => Int -> a
toEnum (Int -> ZoomAxis) -> (CUInt -> Int) -> CUInt -> ZoomAxis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    ZoomAxis -> IO ZoomAxis
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ZoomAxis
result'

#if defined(ENABLE_OVERLOADING)
data ZoomActionGetZoomAxisMethodInfo
instance (signature ~ (m Clutter.Enums.ZoomAxis), MonadIO m, IsZoomAction a) => O.OverloadedMethod ZoomActionGetZoomAxisMethodInfo a signature where
    overloadedMethod = zoomActionGetZoomAxis

instance O.OverloadedMethodInfo ZoomActionGetZoomAxisMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.ZoomAction.zoomActionGetZoomAxis",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-ZoomAction.html#v:zoomActionGetZoomAxis"
        })


#endif

-- method ZoomAction::set_zoom_axis
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ZoomAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterZoomAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "axis"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ZoomAxis" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the axis to constraint the zooming to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_zoom_action_set_zoom_axis" clutter_zoom_action_set_zoom_axis :: 
    Ptr ZoomAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "ZoomAction"})
    CUInt ->                                -- axis : TInterface (Name {namespace = "Clutter", name = "ZoomAxis"})
    IO ()

-- | Restricts the zooming action to a specific axis
-- 
-- /Since: 1.12/
zoomActionSetZoomAxis ::
    (B.CallStack.HasCallStack, MonadIO m, IsZoomAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.ZoomAction.ZoomAction'
    -> Clutter.Enums.ZoomAxis
    -- ^ /@axis@/: the axis to constraint the zooming to
    -> m ()
zoomActionSetZoomAxis :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsZoomAction a) =>
a -> ZoomAxis -> m ()
zoomActionSetZoomAxis a
action ZoomAxis
axis = 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 ZoomAction
action' <- a -> IO (Ptr ZoomAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    let axis' :: CUInt
axis' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ZoomAxis -> Int) -> ZoomAxis -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZoomAxis -> Int
forall a. Enum a => a -> Int
fromEnum) ZoomAxis
axis
    Ptr ZoomAction -> CUInt -> IO ()
clutter_zoom_action_set_zoom_axis Ptr ZoomAction
action' CUInt
axis'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ZoomActionSetZoomAxisMethodInfo
instance (signature ~ (Clutter.Enums.ZoomAxis -> m ()), MonadIO m, IsZoomAction a) => O.OverloadedMethod ZoomActionSetZoomAxisMethodInfo a signature where
    overloadedMethod = zoomActionSetZoomAxis

instance O.OverloadedMethodInfo ZoomActionSetZoomAxisMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.ZoomAction.zoomActionSetZoomAxis",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-ZoomAction.html#v:zoomActionSetZoomAxis"
        })


#endif