{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Extra buffer metadata for performing an affine transformation using a 4x4
-- matrix. The transformation matrix can be composed with
-- 'GI.GstVideo.Structs.VideoAffineTransformationMeta.videoAffineTransformationMetaApplyMatrix'.
-- 
-- The vertices operated on are all in the range 0 to 1, not in
-- Normalized Device Coordinates (-1 to +1). Transforming points in this space
-- are assumed to have an origin at (0.5, 0.5, 0.5) in a left-handed coordinate
-- system with the x-axis moving horizontally (positive values to the right),
-- the y-axis moving vertically (positive values up the screen) and the z-axis
-- perpendicular to the screen (positive values into the screen).
-- 
-- /Since: 1.8/

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

module GI.GstVideo.Structs.VideoAffineTransformationMeta
    ( 

-- * Exported types
    VideoAffineTransformationMeta(..)       ,
    newZeroVideoAffineTransformationMeta    ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveVideoAffineTransformationMetaMethod,
#endif


-- ** applyMatrix #method:applyMatrix#

#if defined(ENABLE_OVERLOADING)
    VideoAffineTransformationMetaApplyMatrixMethodInfo,
#endif
    videoAffineTransformationMetaApplyMatrix,


-- ** getInfo #method:getInfo#

    videoAffineTransformationMetaGetInfo    ,




 -- * Properties
-- ** meta #attr:meta#
-- | parent t'GI.Gst.Structs.Meta.Meta'

    getVideoAffineTransformationMetaMeta    ,
#if defined(ENABLE_OVERLOADING)
    videoAffineTransformationMeta_meta      ,
#endif




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.Gst.Structs.Meta as Gst.Meta
import qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo

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

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

instance BoxedPtr VideoAffineTransformationMeta where
    boxedPtrCopy :: VideoAffineTransformationMeta -> IO VideoAffineTransformationMeta
boxedPtrCopy = \VideoAffineTransformationMeta
p -> VideoAffineTransformationMeta
-> (Ptr VideoAffineTransformationMeta
    -> IO VideoAffineTransformationMeta)
-> IO VideoAffineTransformationMeta
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VideoAffineTransformationMeta
p (Int
-> Ptr VideoAffineTransformationMeta
-> IO (Ptr VideoAffineTransformationMeta)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
80 (Ptr VideoAffineTransformationMeta
 -> IO (Ptr VideoAffineTransformationMeta))
-> (Ptr VideoAffineTransformationMeta
    -> IO VideoAffineTransformationMeta)
-> Ptr VideoAffineTransformationMeta
-> IO VideoAffineTransformationMeta
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr VideoAffineTransformationMeta
 -> VideoAffineTransformationMeta)
-> Ptr VideoAffineTransformationMeta
-> IO VideoAffineTransformationMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr VideoAffineTransformationMeta
-> VideoAffineTransformationMeta
VideoAffineTransformationMeta)
    boxedPtrFree :: VideoAffineTransformationMeta -> IO ()
boxedPtrFree = \VideoAffineTransformationMeta
x -> VideoAffineTransformationMeta
-> (Ptr VideoAffineTransformationMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr VideoAffineTransformationMeta
x Ptr VideoAffineTransformationMeta -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr VideoAffineTransformationMeta where
    boxedPtrCalloc :: IO (Ptr VideoAffineTransformationMeta)
boxedPtrCalloc = Int -> IO (Ptr VideoAffineTransformationMeta)
forall a. Int -> IO (Ptr a)
callocBytes Int
80


-- | Construct a `VideoAffineTransformationMeta` struct initialized to zero.
newZeroVideoAffineTransformationMeta :: MonadIO m => m VideoAffineTransformationMeta
newZeroVideoAffineTransformationMeta :: m VideoAffineTransformationMeta
newZeroVideoAffineTransformationMeta = IO VideoAffineTransformationMeta -> m VideoAffineTransformationMeta
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoAffineTransformationMeta
 -> m VideoAffineTransformationMeta)
-> IO VideoAffineTransformationMeta
-> m VideoAffineTransformationMeta
forall a b. (a -> b) -> a -> b
$ IO (Ptr VideoAffineTransformationMeta)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr VideoAffineTransformationMeta)
-> (Ptr VideoAffineTransformationMeta
    -> IO VideoAffineTransformationMeta)
-> IO VideoAffineTransformationMeta
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr VideoAffineTransformationMeta
 -> VideoAffineTransformationMeta)
-> Ptr VideoAffineTransformationMeta
-> IO VideoAffineTransformationMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr VideoAffineTransformationMeta
-> VideoAffineTransformationMeta
VideoAffineTransformationMeta

instance tag ~ 'AttrSet => Constructible VideoAffineTransformationMeta tag where
    new :: (ManagedPtr VideoAffineTransformationMeta
 -> VideoAffineTransformationMeta)
-> [AttrOp VideoAffineTransformationMeta tag]
-> m VideoAffineTransformationMeta
new ManagedPtr VideoAffineTransformationMeta
-> VideoAffineTransformationMeta
_ [AttrOp VideoAffineTransformationMeta tag]
attrs = do
        VideoAffineTransformationMeta
o <- m VideoAffineTransformationMeta
forall (m :: * -> *). MonadIO m => m VideoAffineTransformationMeta
newZeroVideoAffineTransformationMeta
        VideoAffineTransformationMeta
-> [AttrOp VideoAffineTransformationMeta 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set VideoAffineTransformationMeta
o [AttrOp VideoAffineTransformationMeta tag]
[AttrOp VideoAffineTransformationMeta 'AttrSet]
attrs
        VideoAffineTransformationMeta -> m VideoAffineTransformationMeta
forall (m :: * -> *) a. Monad m => a -> m a
return VideoAffineTransformationMeta
o


-- | Get the value of the “@meta@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoAffineTransformationMeta #meta
-- @
getVideoAffineTransformationMetaMeta :: MonadIO m => VideoAffineTransformationMeta -> m Gst.Meta.Meta
getVideoAffineTransformationMetaMeta :: VideoAffineTransformationMeta -> m Meta
getVideoAffineTransformationMetaMeta VideoAffineTransformationMeta
s = IO Meta -> m Meta
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Meta -> m Meta) -> IO Meta -> m Meta
forall a b. (a -> b) -> a -> b
$ VideoAffineTransformationMeta
-> (Ptr VideoAffineTransformationMeta -> IO Meta) -> IO Meta
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoAffineTransformationMeta
s ((Ptr VideoAffineTransformationMeta -> IO Meta) -> IO Meta)
-> (Ptr VideoAffineTransformationMeta -> IO Meta) -> IO Meta
forall a b. (a -> b) -> a -> b
$ \Ptr VideoAffineTransformationMeta
ptr -> do
    let val :: Ptr Meta
val = Ptr VideoAffineTransformationMeta
ptr Ptr VideoAffineTransformationMeta -> Int -> Ptr Meta
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: (Ptr Gst.Meta.Meta)
    Meta
val' <- ((ManagedPtr Meta -> Meta) -> Ptr Meta -> IO Meta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Meta -> Meta
Gst.Meta.Meta) Ptr Meta
val
    Meta -> IO Meta
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
val'

#if defined(ENABLE_OVERLOADING)
data VideoAffineTransformationMetaMetaFieldInfo
instance AttrInfo VideoAffineTransformationMetaMetaFieldInfo where
    type AttrBaseTypeConstraint VideoAffineTransformationMetaMetaFieldInfo = (~) VideoAffineTransformationMeta
    type AttrAllowedOps VideoAffineTransformationMetaMetaFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint VideoAffineTransformationMetaMetaFieldInfo = (~) (Ptr Gst.Meta.Meta)
    type AttrTransferTypeConstraint VideoAffineTransformationMetaMetaFieldInfo = (~)(Ptr Gst.Meta.Meta)
    type AttrTransferType VideoAffineTransformationMetaMetaFieldInfo = (Ptr Gst.Meta.Meta)
    type AttrGetType VideoAffineTransformationMetaMetaFieldInfo = Gst.Meta.Meta
    type AttrLabel VideoAffineTransformationMetaMetaFieldInfo = "meta"
    type AttrOrigin VideoAffineTransformationMetaMetaFieldInfo = VideoAffineTransformationMeta
    attrGet = getVideoAffineTransformationMetaMeta
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined

videoAffineTransformationMeta_meta :: AttrLabelProxy "meta"
videoAffineTransformationMeta_meta = AttrLabelProxy

#endif


-- XXX Skipped attribute for "VideoAffineTransformationMeta:matrix"
-- Not implemented: Don't know how to unpack C array of type TCArray False 16 (-1) (TBasicType TFloat)

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoAffineTransformationMeta
type instance O.AttributeList VideoAffineTransformationMeta = VideoAffineTransformationMetaAttributeList
type VideoAffineTransformationMetaAttributeList = ('[ '("meta", VideoAffineTransformationMetaMetaFieldInfo)] :: [(Symbol, *)])
#endif

-- method VideoAffineTransformationMeta::apply_matrix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "meta"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstVideo" , name = "VideoAffineTransformationMeta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoAffineTransformationMeta"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "matrix"
--           , argType = TCArray False 16 (-1) (TBasicType TFloat)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a 4x4 transformation matrix to be applied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_affine_transformation_meta_apply_matrix" gst_video_affine_transformation_meta_apply_matrix :: 
    Ptr VideoAffineTransformationMeta ->    -- meta : TInterface (Name {namespace = "GstVideo", name = "VideoAffineTransformationMeta"})
    Ptr CFloat ->                           -- matrix : TCArray False 16 (-1) (TBasicType TFloat)
    IO ()

-- | Apply a transformation using the given 4x4 transformation matrix.
-- Performs the multiplication, meta->matrix X matrix.
-- 
-- /Since: 1.8/
videoAffineTransformationMetaApplyMatrix ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoAffineTransformationMeta
    -- ^ /@meta@/: a t'GI.GstVideo.Structs.VideoAffineTransformationMeta.VideoAffineTransformationMeta'
    -> [Float]
    -- ^ /@matrix@/: a 4x4 transformation matrix to be applied
    -> m ()
videoAffineTransformationMetaApplyMatrix :: VideoAffineTransformationMeta -> [Float] -> m ()
videoAffineTransformationMetaApplyMatrix VideoAffineTransformationMeta
meta [Float]
matrix = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoAffineTransformationMeta
meta' <- VideoAffineTransformationMeta
-> IO (Ptr VideoAffineTransformationMeta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoAffineTransformationMeta
meta
    Ptr CFloat
matrix' <- ((Float -> CFloat) -> [Float] -> IO (Ptr CFloat)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Float]
matrix
    Ptr VideoAffineTransformationMeta -> Ptr CFloat -> IO ()
gst_video_affine_transformation_meta_apply_matrix Ptr VideoAffineTransformationMeta
meta' Ptr CFloat
matrix'
    VideoAffineTransformationMeta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoAffineTransformationMeta
meta
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
matrix'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoAffineTransformationMetaApplyMatrixMethodInfo
instance (signature ~ ([Float] -> m ()), MonadIO m) => O.MethodInfo VideoAffineTransformationMetaApplyMatrixMethodInfo VideoAffineTransformationMeta signature where
    overloadedMethod = videoAffineTransformationMetaApplyMatrix

#endif

-- method VideoAffineTransformationMeta::get_info
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "MetaInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_affine_transformation_meta_get_info" gst_video_affine_transformation_meta_get_info :: 
    IO (Ptr Gst.MetaInfo.MetaInfo)

-- | /No description available in the introspection data./
videoAffineTransformationMetaGetInfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Gst.MetaInfo.MetaInfo
videoAffineTransformationMetaGetInfo :: m MetaInfo
videoAffineTransformationMetaGetInfo  = IO MetaInfo -> m MetaInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MetaInfo -> m MetaInfo) -> IO MetaInfo -> m MetaInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaInfo
result <- IO (Ptr MetaInfo)
gst_video_affine_transformation_meta_get_info
    Text -> Ptr MetaInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoAffineTransformationMetaGetInfo" Ptr MetaInfo
result
    MetaInfo
result' <- ((ManagedPtr MetaInfo -> MetaInfo) -> Ptr MetaInfo -> IO MetaInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MetaInfo -> MetaInfo
Gst.MetaInfo.MetaInfo) Ptr MetaInfo
result
    MetaInfo -> IO MetaInfo
forall (m :: * -> *) a. Monad m => a -> m a
return MetaInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoAffineTransformationMetaMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoAffineTransformationMetaMethod "applyMatrix" o = VideoAffineTransformationMetaApplyMatrixMethodInfo
    ResolveVideoAffineTransformationMetaMethod l o = O.MethodResolutionFailed l o

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

#endif