{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The interface allows unified access to control flipping and autocenter
-- operation of video-sources or operators.

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

module GI.GstVideo.Interfaces.VideoOrientation
    ( 

-- * Exported types
    VideoOrientation(..)                    ,
    IsVideoOrientation                      ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- /None/.
-- 
-- ==== Getters
-- [getHcenter]("GI.GstVideo.Interfaces.VideoOrientation#g:method:getHcenter"), [getHflip]("GI.GstVideo.Interfaces.VideoOrientation#g:method:getHflip"), [getVcenter]("GI.GstVideo.Interfaces.VideoOrientation#g:method:getVcenter"), [getVflip]("GI.GstVideo.Interfaces.VideoOrientation#g:method:getVflip").
-- 
-- ==== Setters
-- [setHcenter]("GI.GstVideo.Interfaces.VideoOrientation#g:method:setHcenter"), [setHflip]("GI.GstVideo.Interfaces.VideoOrientation#g:method:setHflip"), [setVcenter]("GI.GstVideo.Interfaces.VideoOrientation#g:method:setVcenter"), [setVflip]("GI.GstVideo.Interfaces.VideoOrientation#g:method:setVflip").

#if defined(ENABLE_OVERLOADING)
    ResolveVideoOrientationMethod           ,
#endif

-- ** fromTag #method:fromTag#

    videoOrientationFromTag                 ,


-- ** getHcenter #method:getHcenter#

#if defined(ENABLE_OVERLOADING)
    VideoOrientationGetHcenterMethodInfo    ,
#endif
    videoOrientationGetHcenter              ,


-- ** getHflip #method:getHflip#

#if defined(ENABLE_OVERLOADING)
    VideoOrientationGetHflipMethodInfo      ,
#endif
    videoOrientationGetHflip                ,


-- ** getVcenter #method:getVcenter#

#if defined(ENABLE_OVERLOADING)
    VideoOrientationGetVcenterMethodInfo    ,
#endif
    videoOrientationGetVcenter              ,


-- ** getVflip #method:getVflip#

#if defined(ENABLE_OVERLOADING)
    VideoOrientationGetVflipMethodInfo      ,
#endif
    videoOrientationGetVflip                ,


-- ** setHcenter #method:setHcenter#

#if defined(ENABLE_OVERLOADING)
    VideoOrientationSetHcenterMethodInfo    ,
#endif
    videoOrientationSetHcenter              ,


-- ** setHflip #method:setHflip#

#if defined(ENABLE_OVERLOADING)
    VideoOrientationSetHflipMethodInfo      ,
#endif
    videoOrientationSetHflip                ,


-- ** setVcenter #method:setVcenter#

#if defined(ENABLE_OVERLOADING)
    VideoOrientationSetVcenterMethodInfo    ,
#endif
    videoOrientationSetVcenter              ,


-- ** setVflip #method:setVflip#

#if defined(ENABLE_OVERLOADING)
    VideoOrientationSetVflipMethodInfo      ,
#endif
    videoOrientationSetVflip                ,




    ) where

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

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

import qualified GI.Gst.Structs.TagList as Gst.TagList
import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums

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

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

-- | Type class for types which implement `VideoOrientation`.
class (ManagedPtrNewtype o, O.IsDescendantOf VideoOrientation o) => IsVideoOrientation o
instance (ManagedPtrNewtype o, O.IsDescendantOf VideoOrientation o) => IsVideoOrientation o
-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr VideoOrientation where
    boxedPtrCopy :: VideoOrientation -> IO VideoOrientation
boxedPtrCopy = VideoOrientation -> IO VideoOrientation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: VideoOrientation -> IO ()
boxedPtrFree = \VideoOrientation
_x -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


#if defined(ENABLE_OVERLOADING)
type family ResolveVideoOrientationMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveVideoOrientationMethod "getHcenter" o = VideoOrientationGetHcenterMethodInfo
    ResolveVideoOrientationMethod "getHflip" o = VideoOrientationGetHflipMethodInfo
    ResolveVideoOrientationMethod "getVcenter" o = VideoOrientationGetVcenterMethodInfo
    ResolveVideoOrientationMethod "getVflip" o = VideoOrientationGetVflipMethodInfo
    ResolveVideoOrientationMethod "setHcenter" o = VideoOrientationSetHcenterMethodInfo
    ResolveVideoOrientationMethod "setHflip" o = VideoOrientationSetHflipMethodInfo
    ResolveVideoOrientationMethod "setVcenter" o = VideoOrientationSetVcenterMethodInfo
    ResolveVideoOrientationMethod "setVflip" o = VideoOrientationSetVflipMethodInfo
    ResolveVideoOrientationMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method VideoOrientation::get_hcenter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "video_orientation"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoOrientation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GstVideoOrientation interface of a #GstElement"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "center"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the result"
--                 , 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 "gst_video_orientation_get_hcenter" gst_video_orientation_get_hcenter :: 
    Ptr VideoOrientation ->                 -- video_orientation : TInterface (Name {namespace = "GstVideo", name = "VideoOrientation"})
    Ptr Int32 ->                            -- center : TBasicType TInt
    IO CInt

-- | Get the horizontal centering offset from the given object.
videoOrientationGetHcenter ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoOrientation a) =>
    a
    -- ^ /@videoOrientation@/: t'GI.GstVideo.Interfaces.VideoOrientation.VideoOrientation' interface of a t'GI.Gst.Objects.Element.Element'
    -> m ((Bool, Int32))
    -- ^ __Returns:__ 'P.True' in case the element supports centering
videoOrientationGetHcenter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoOrientation a) =>
a -> m (Bool, Int32)
videoOrientationGetHcenter a
videoOrientation = IO (Bool, Int32) -> m (Bool, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32) -> m (Bool, Int32))
-> IO (Bool, Int32) -> m (Bool, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoOrientation
videoOrientation' <- a -> IO (Ptr VideoOrientation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
videoOrientation
    Ptr Int32
center <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr VideoOrientation -> Ptr Int32 -> IO CInt
gst_video_orientation_get_hcenter Ptr VideoOrientation
videoOrientation' Ptr Int32
center
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
center' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
center
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
videoOrientation
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
center
    (Bool, Int32) -> IO (Bool, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
center')

#if defined(ENABLE_OVERLOADING)
data VideoOrientationGetHcenterMethodInfo
instance (signature ~ (m ((Bool, Int32))), MonadIO m, IsVideoOrientation a) => O.OverloadedMethod VideoOrientationGetHcenterMethodInfo a signature where
    overloadedMethod = videoOrientationGetHcenter

instance O.OverloadedMethodInfo VideoOrientationGetHcenterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.VideoOrientation.videoOrientationGetHcenter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-VideoOrientation.html#v:videoOrientationGetHcenter"
        })


#endif

-- method VideoOrientation::get_hflip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "video_orientation"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoOrientation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GstVideoOrientation interface of a #GstElement"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flip"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the result"
--                 , 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 "gst_video_orientation_get_hflip" gst_video_orientation_get_hflip :: 
    Ptr VideoOrientation ->                 -- video_orientation : TInterface (Name {namespace = "GstVideo", name = "VideoOrientation"})
    Ptr CInt ->                             -- flip : TBasicType TBoolean
    IO CInt

-- | Get the horizontal flipping state ('P.True' for flipped) from the given object.
videoOrientationGetHflip ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoOrientation a) =>
    a
    -- ^ /@videoOrientation@/: t'GI.GstVideo.Interfaces.VideoOrientation.VideoOrientation' interface of a t'GI.Gst.Objects.Element.Element'
    -> m ((Bool, Bool))
    -- ^ __Returns:__ 'P.True' in case the element supports flipping
videoOrientationGetHflip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoOrientation a) =>
a -> m (Bool, Bool)
videoOrientationGetHflip a
videoOrientation = IO (Bool, Bool) -> m (Bool, Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Bool) -> m (Bool, Bool))
-> IO (Bool, Bool) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoOrientation
videoOrientation' <- a -> IO (Ptr VideoOrientation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
videoOrientation
    Ptr CInt
flip <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr VideoOrientation -> Ptr CInt -> IO CInt
gst_video_orientation_get_hflip Ptr VideoOrientation
videoOrientation' Ptr CInt
flip
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CInt
flip' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
flip
    let flip'' :: Bool
flip'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
flip'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
videoOrientation
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
flip
    (Bool, Bool) -> IO (Bool, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
flip'')

#if defined(ENABLE_OVERLOADING)
data VideoOrientationGetHflipMethodInfo
instance (signature ~ (m ((Bool, Bool))), MonadIO m, IsVideoOrientation a) => O.OverloadedMethod VideoOrientationGetHflipMethodInfo a signature where
    overloadedMethod = videoOrientationGetHflip

instance O.OverloadedMethodInfo VideoOrientationGetHflipMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.VideoOrientation.videoOrientationGetHflip",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-VideoOrientation.html#v:videoOrientationGetHflip"
        })


#endif

-- method VideoOrientation::get_vcenter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "video_orientation"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoOrientation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GstVideoOrientation interface of a #GstElement"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "center"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the result"
--                 , 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 "gst_video_orientation_get_vcenter" gst_video_orientation_get_vcenter :: 
    Ptr VideoOrientation ->                 -- video_orientation : TInterface (Name {namespace = "GstVideo", name = "VideoOrientation"})
    Ptr Int32 ->                            -- center : TBasicType TInt
    IO CInt

-- | Get the vertical centering offset from the given object.
videoOrientationGetVcenter ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoOrientation a) =>
    a
    -- ^ /@videoOrientation@/: t'GI.GstVideo.Interfaces.VideoOrientation.VideoOrientation' interface of a t'GI.Gst.Objects.Element.Element'
    -> m ((Bool, Int32))
    -- ^ __Returns:__ 'P.True' in case the element supports centering
videoOrientationGetVcenter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoOrientation a) =>
a -> m (Bool, Int32)
videoOrientationGetVcenter a
videoOrientation = IO (Bool, Int32) -> m (Bool, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32) -> m (Bool, Int32))
-> IO (Bool, Int32) -> m (Bool, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoOrientation
videoOrientation' <- a -> IO (Ptr VideoOrientation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
videoOrientation
    Ptr Int32
center <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr VideoOrientation -> Ptr Int32 -> IO CInt
gst_video_orientation_get_vcenter Ptr VideoOrientation
videoOrientation' Ptr Int32
center
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
center' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
center
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
videoOrientation
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
center
    (Bool, Int32) -> IO (Bool, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
center')

#if defined(ENABLE_OVERLOADING)
data VideoOrientationGetVcenterMethodInfo
instance (signature ~ (m ((Bool, Int32))), MonadIO m, IsVideoOrientation a) => O.OverloadedMethod VideoOrientationGetVcenterMethodInfo a signature where
    overloadedMethod = videoOrientationGetVcenter

instance O.OverloadedMethodInfo VideoOrientationGetVcenterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.VideoOrientation.videoOrientationGetVcenter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-VideoOrientation.html#v:videoOrientationGetVcenter"
        })


#endif

-- method VideoOrientation::get_vflip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "video_orientation"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoOrientation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GstVideoOrientation interface of a #GstElement"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flip"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the result"
--                 , 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 "gst_video_orientation_get_vflip" gst_video_orientation_get_vflip :: 
    Ptr VideoOrientation ->                 -- video_orientation : TInterface (Name {namespace = "GstVideo", name = "VideoOrientation"})
    Ptr CInt ->                             -- flip : TBasicType TBoolean
    IO CInt

-- | Get the vertical flipping state ('P.True' for flipped) from the given object.
videoOrientationGetVflip ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoOrientation a) =>
    a
    -- ^ /@videoOrientation@/: t'GI.GstVideo.Interfaces.VideoOrientation.VideoOrientation' interface of a t'GI.Gst.Objects.Element.Element'
    -> m ((Bool, Bool))
    -- ^ __Returns:__ 'P.True' in case the element supports flipping
videoOrientationGetVflip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoOrientation a) =>
a -> m (Bool, Bool)
videoOrientationGetVflip a
videoOrientation = IO (Bool, Bool) -> m (Bool, Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Bool) -> m (Bool, Bool))
-> IO (Bool, Bool) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoOrientation
videoOrientation' <- a -> IO (Ptr VideoOrientation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
videoOrientation
    Ptr CInt
flip <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr VideoOrientation -> Ptr CInt -> IO CInt
gst_video_orientation_get_vflip Ptr VideoOrientation
videoOrientation' Ptr CInt
flip
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CInt
flip' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
flip
    let flip'' :: Bool
flip'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
flip'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
videoOrientation
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
flip
    (Bool, Bool) -> IO (Bool, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
flip'')

#if defined(ENABLE_OVERLOADING)
data VideoOrientationGetVflipMethodInfo
instance (signature ~ (m ((Bool, Bool))), MonadIO m, IsVideoOrientation a) => O.OverloadedMethod VideoOrientationGetVflipMethodInfo a signature where
    overloadedMethod = videoOrientationGetVflip

instance O.OverloadedMethodInfo VideoOrientationGetVflipMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.VideoOrientation.videoOrientationGetVflip",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-VideoOrientation.html#v:videoOrientationGetVflip"
        })


#endif

-- method VideoOrientation::set_hcenter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "video_orientation"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoOrientation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GstVideoOrientation interface of a #GstElement"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "center"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "centering offset" , 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 "gst_video_orientation_set_hcenter" gst_video_orientation_set_hcenter :: 
    Ptr VideoOrientation ->                 -- video_orientation : TInterface (Name {namespace = "GstVideo", name = "VideoOrientation"})
    Int32 ->                                -- center : TBasicType TInt
    IO CInt

-- | Set the horizontal centering offset for the given object.
videoOrientationSetHcenter ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoOrientation a) =>
    a
    -- ^ /@videoOrientation@/: t'GI.GstVideo.Interfaces.VideoOrientation.VideoOrientation' interface of a t'GI.Gst.Objects.Element.Element'
    -> Int32
    -- ^ /@center@/: centering offset
    -> m Bool
    -- ^ __Returns:__ 'P.True' in case the element supports centering
videoOrientationSetHcenter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoOrientation a) =>
a -> Int32 -> m Bool
videoOrientationSetHcenter a
videoOrientation Int32
center = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoOrientation
videoOrientation' <- a -> IO (Ptr VideoOrientation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
videoOrientation
    CInt
result <- Ptr VideoOrientation -> Int32 -> IO CInt
gst_video_orientation_set_hcenter Ptr VideoOrientation
videoOrientation' Int32
center
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
videoOrientation
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoOrientationSetHcenterMethodInfo
instance (signature ~ (Int32 -> m Bool), MonadIO m, IsVideoOrientation a) => O.OverloadedMethod VideoOrientationSetHcenterMethodInfo a signature where
    overloadedMethod = videoOrientationSetHcenter

instance O.OverloadedMethodInfo VideoOrientationSetHcenterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.VideoOrientation.videoOrientationSetHcenter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-VideoOrientation.html#v:videoOrientationSetHcenter"
        })


#endif

-- method VideoOrientation::set_hflip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "video_orientation"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoOrientation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GstVideoOrientation interface of a #GstElement"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flip"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "use flipping" , 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 "gst_video_orientation_set_hflip" gst_video_orientation_set_hflip :: 
    Ptr VideoOrientation ->                 -- video_orientation : TInterface (Name {namespace = "GstVideo", name = "VideoOrientation"})
    CInt ->                                 -- flip : TBasicType TBoolean
    IO CInt

-- | Set the horizontal flipping state ('P.True' for flipped) for the given object.
videoOrientationSetHflip ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoOrientation a) =>
    a
    -- ^ /@videoOrientation@/: t'GI.GstVideo.Interfaces.VideoOrientation.VideoOrientation' interface of a t'GI.Gst.Objects.Element.Element'
    -> Bool
    -- ^ /@flip@/: use flipping
    -> m Bool
    -- ^ __Returns:__ 'P.True' in case the element supports flipping
videoOrientationSetHflip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoOrientation a) =>
a -> Bool -> m Bool
videoOrientationSetHflip a
videoOrientation Bool
flip = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoOrientation
videoOrientation' <- a -> IO (Ptr VideoOrientation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
videoOrientation
    let flip' :: CInt
flip' = (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
flip
    CInt
result <- Ptr VideoOrientation -> CInt -> IO CInt
gst_video_orientation_set_hflip Ptr VideoOrientation
videoOrientation' CInt
flip'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
videoOrientation
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoOrientationSetHflipMethodInfo
instance (signature ~ (Bool -> m Bool), MonadIO m, IsVideoOrientation a) => O.OverloadedMethod VideoOrientationSetHflipMethodInfo a signature where
    overloadedMethod = videoOrientationSetHflip

instance O.OverloadedMethodInfo VideoOrientationSetHflipMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.VideoOrientation.videoOrientationSetHflip",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-VideoOrientation.html#v:videoOrientationSetHflip"
        })


#endif

-- method VideoOrientation::set_vcenter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "video_orientation"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoOrientation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GstVideoOrientation interface of a #GstElement"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "center"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "centering offset" , 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 "gst_video_orientation_set_vcenter" gst_video_orientation_set_vcenter :: 
    Ptr VideoOrientation ->                 -- video_orientation : TInterface (Name {namespace = "GstVideo", name = "VideoOrientation"})
    Int32 ->                                -- center : TBasicType TInt
    IO CInt

-- | Set the vertical centering offset for the given object.
videoOrientationSetVcenter ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoOrientation a) =>
    a
    -- ^ /@videoOrientation@/: t'GI.GstVideo.Interfaces.VideoOrientation.VideoOrientation' interface of a t'GI.Gst.Objects.Element.Element'
    -> Int32
    -- ^ /@center@/: centering offset
    -> m Bool
    -- ^ __Returns:__ 'P.True' in case the element supports centering
videoOrientationSetVcenter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoOrientation a) =>
a -> Int32 -> m Bool
videoOrientationSetVcenter a
videoOrientation Int32
center = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoOrientation
videoOrientation' <- a -> IO (Ptr VideoOrientation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
videoOrientation
    CInt
result <- Ptr VideoOrientation -> Int32 -> IO CInt
gst_video_orientation_set_vcenter Ptr VideoOrientation
videoOrientation' Int32
center
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
videoOrientation
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoOrientationSetVcenterMethodInfo
instance (signature ~ (Int32 -> m Bool), MonadIO m, IsVideoOrientation a) => O.OverloadedMethod VideoOrientationSetVcenterMethodInfo a signature where
    overloadedMethod = videoOrientationSetVcenter

instance O.OverloadedMethodInfo VideoOrientationSetVcenterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.VideoOrientation.videoOrientationSetVcenter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-VideoOrientation.html#v:videoOrientationSetVcenter"
        })


#endif

-- method VideoOrientation::set_vflip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "video_orientation"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoOrientation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GstVideoOrientation interface of a #GstElement"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flip"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "use flipping" , 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 "gst_video_orientation_set_vflip" gst_video_orientation_set_vflip :: 
    Ptr VideoOrientation ->                 -- video_orientation : TInterface (Name {namespace = "GstVideo", name = "VideoOrientation"})
    CInt ->                                 -- flip : TBasicType TBoolean
    IO CInt

-- | Set the vertical flipping state ('P.True' for flipped) for the given object.
videoOrientationSetVflip ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoOrientation a) =>
    a
    -- ^ /@videoOrientation@/: t'GI.GstVideo.Interfaces.VideoOrientation.VideoOrientation' interface of a t'GI.Gst.Objects.Element.Element'
    -> Bool
    -- ^ /@flip@/: use flipping
    -> m Bool
    -- ^ __Returns:__ 'P.True' in case the element supports flipping
videoOrientationSetVflip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoOrientation a) =>
a -> Bool -> m Bool
videoOrientationSetVflip a
videoOrientation Bool
flip = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoOrientation
videoOrientation' <- a -> IO (Ptr VideoOrientation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
videoOrientation
    let flip' :: CInt
flip' = (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
flip
    CInt
result <- Ptr VideoOrientation -> CInt -> IO CInt
gst_video_orientation_set_vflip Ptr VideoOrientation
videoOrientation' CInt
flip'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
videoOrientation
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoOrientationSetVflipMethodInfo
instance (signature ~ (Bool -> m Bool), MonadIO m, IsVideoOrientation a) => O.OverloadedMethod VideoOrientationSetVflipMethodInfo a signature where
    overloadedMethod = videoOrientationSetVflip

instance O.OverloadedMethodInfo VideoOrientationSetVflipMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.VideoOrientation.videoOrientationSetVflip",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-VideoOrientation.html#v:videoOrientationSetVflip"
        })


#endif

-- method VideoOrientation::from_tag
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "taglist"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTagList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "method"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoOrientationMethod" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The location where to return the orientation."
--                 , 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 "gst_video_orientation_from_tag" gst_video_orientation_from_tag :: 
    Ptr Gst.TagList.TagList ->              -- taglist : TInterface (Name {namespace = "Gst", name = "TagList"})
    Ptr CUInt ->                            -- method : TInterface (Name {namespace = "GstVideo", name = "VideoOrientationMethod"})
    IO CInt

-- | Parses the \"image-orientation\" tag and transforms it into the
-- t'GI.GstVideo.Enums.VideoOrientationMethod' enum.
-- 
-- /Since: 1.20/
videoOrientationFromTag ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.TagList.TagList
    -- ^ /@taglist@/: A t'GI.Gst.Structs.TagList.TagList'
    -> m ((Bool, GstVideo.Enums.VideoOrientationMethod))
    -- ^ __Returns:__ TRUE if there was a valid \"image-orientation\" tag in the taglist.
videoOrientationFromTag :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TagList -> m (Bool, VideoOrientationMethod)
videoOrientationFromTag TagList
taglist = IO (Bool, VideoOrientationMethod)
-> m (Bool, VideoOrientationMethod)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, VideoOrientationMethod)
 -> m (Bool, VideoOrientationMethod))
-> IO (Bool, VideoOrientationMethod)
-> m (Bool, VideoOrientationMethod)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
taglist' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
taglist
    Ptr CUInt
method <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr TagList -> Ptr CUInt -> IO CInt
gst_video_orientation_from_tag Ptr TagList
taglist' Ptr CUInt
method
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CUInt
method' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
method
    let method'' :: VideoOrientationMethod
method'' = (Int -> VideoOrientationMethod
forall a. Enum a => Int -> a
toEnum (Int -> VideoOrientationMethod)
-> (CUInt -> Int) -> CUInt -> VideoOrientationMethod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
method'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
taglist
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
method
    (Bool, VideoOrientationMethod) -> IO (Bool, VideoOrientationMethod)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', VideoOrientationMethod
method'')

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList VideoOrientation = VideoOrientationSignalList
type VideoOrientationSignalList = ('[ ] :: [(Symbol, DK.Type)])

#endif