{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A structure specifying a transformation between user-space
-- coordinates and device coordinates. The transformation
-- is given by
-- 
-- \<programlisting>
-- x_device = x_user * matrix->xx + y_user * matrix->xy + matrix->x0;
-- y_device = x_user * matrix->yx + y_user * matrix->yy + matrix->y0;
-- \<\/programlisting>
-- 
-- /Since: 1.6/

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

module GI.Pango.Structs.Matrix
    ( 

-- * Exported types
    Matrix(..)                              ,
    newZeroMatrix                           ,
    noMatrix                                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveMatrixMethod                     ,
#endif


-- ** concat #method:concat#

#if defined(ENABLE_OVERLOADING)
    MatrixConcatMethodInfo                  ,
#endif
    matrixConcat                            ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    MatrixCopyMethodInfo                    ,
#endif
    matrixCopy                              ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    MatrixFreeMethodInfo                    ,
#endif
    matrixFree                              ,


-- ** getFontScaleFactor #method:getFontScaleFactor#

#if defined(ENABLE_OVERLOADING)
    MatrixGetFontScaleFactorMethodInfo      ,
#endif
    matrixGetFontScaleFactor                ,


-- ** getFontScaleFactors #method:getFontScaleFactors#

#if defined(ENABLE_OVERLOADING)
    MatrixGetFontScaleFactorsMethodInfo     ,
#endif
    matrixGetFontScaleFactors               ,


-- ** rotate #method:rotate#

#if defined(ENABLE_OVERLOADING)
    MatrixRotateMethodInfo                  ,
#endif
    matrixRotate                            ,


-- ** scale #method:scale#

#if defined(ENABLE_OVERLOADING)
    MatrixScaleMethodInfo                   ,
#endif
    matrixScale                             ,


-- ** transformDistance #method:transformDistance#

#if defined(ENABLE_OVERLOADING)
    MatrixTransformDistanceMethodInfo       ,
#endif
    matrixTransformDistance                 ,


-- ** transformPixelRectangle #method:transformPixelRectangle#

#if defined(ENABLE_OVERLOADING)
    MatrixTransformPixelRectangleMethodInfo ,
#endif
    matrixTransformPixelRectangle           ,


-- ** transformPoint #method:transformPoint#

#if defined(ENABLE_OVERLOADING)
    MatrixTransformPointMethodInfo          ,
#endif
    matrixTransformPoint                    ,


-- ** translate #method:translate#

#if defined(ENABLE_OVERLOADING)
    MatrixTranslateMethodInfo               ,
#endif
    matrixTranslate                         ,




 -- * Properties
-- ** x0 #attr:x0#
-- | x translation

    getMatrixX0                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_x0                               ,
#endif
    setMatrixX0                             ,


-- ** xx #attr:xx#
-- | 1st component of the transformation matrix

    getMatrixXx                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_xx                               ,
#endif
    setMatrixXx                             ,


-- ** xy #attr:xy#
-- | 2nd component of the transformation matrix

    getMatrixXy                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_xy                               ,
#endif
    setMatrixXy                             ,


-- ** y0 #attr:y0#
-- | y translation

    getMatrixY0                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_y0                               ,
#endif
    setMatrixY0                             ,


-- ** yx #attr:yx#
-- | 3rd component of the transformation matrix

    getMatrixYx                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_yx                               ,
#endif
    setMatrixYx                             ,


-- ** yy #attr:yy#
-- | 4th component of the transformation matrix

    getMatrixYy                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_yy                               ,
#endif
    setMatrixYy                             ,




    ) 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.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 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 {-# SOURCE #-} qualified GI.Pango.Structs.Rectangle as Pango.Rectangle

-- | Memory-managed wrapper type.
newtype Matrix = Matrix (ManagedPtr Matrix)
    deriving (Matrix -> Matrix -> Bool
(Matrix -> Matrix -> Bool)
-> (Matrix -> Matrix -> Bool) -> Eq Matrix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Matrix -> Matrix -> Bool
$c/= :: Matrix -> Matrix -> Bool
== :: Matrix -> Matrix -> Bool
$c== :: Matrix -> Matrix -> Bool
Eq)
foreign import ccall "pango_matrix_get_type" c_pango_matrix_get_type :: 
    IO GType

instance BoxedObject Matrix where
    boxedType :: Matrix -> IO GType
boxedType _ = IO GType
c_pango_matrix_get_type

-- | Convert 'Matrix' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Matrix where
    toGValue :: Matrix -> IO GValue
toGValue o :: Matrix
o = do
        GType
gtype <- IO GType
c_pango_matrix_get_type
        Matrix -> (Ptr Matrix -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Matrix
o (GType -> (GValue -> Ptr Matrix -> IO ()) -> Ptr Matrix -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Matrix -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Matrix
fromGValue gv :: GValue
gv = do
        Ptr Matrix
ptr <- GValue -> IO (Ptr Matrix)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Matrix)
        (ManagedPtr Matrix -> Matrix) -> Ptr Matrix -> IO Matrix
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Matrix -> Matrix
Matrix Ptr Matrix
ptr
        
    

-- | Construct a `Matrix` struct initialized to zero.
newZeroMatrix :: MonadIO m => m Matrix
newZeroMatrix :: m Matrix
newZeroMatrix = IO Matrix -> m Matrix
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Matrix -> m Matrix) -> IO Matrix -> m Matrix
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Matrix)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 48 IO (Ptr Matrix) -> (Ptr Matrix -> IO Matrix) -> IO Matrix
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Matrix -> Matrix) -> Ptr Matrix -> IO Matrix
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Matrix -> Matrix
Matrix

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


-- | A convenience alias for `Nothing` :: `Maybe` `Matrix`.
noMatrix :: Maybe Matrix
noMatrix :: Maybe Matrix
noMatrix = Maybe Matrix
forall a. Maybe a
Nothing

-- | Get the value of the “@xx@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' matrix #xx
-- @
getMatrixXx :: MonadIO m => Matrix -> m Double
getMatrixXx :: Matrix -> m Double
getMatrixXx s :: Matrix
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO Double) -> IO Double)
-> (Ptr Matrix -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

-- | Set the value of the “@xx@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' matrix [ #xx 'Data.GI.Base.Attributes.:=' value ]
-- @
setMatrixXx :: MonadIO m => Matrix -> Double -> m ()
setMatrixXx :: Matrix -> Double -> m ()
setMatrixXx s :: Matrix
s val :: Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO ()) -> IO ()) -> (Ptr Matrix -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    let val' :: CDouble
val' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data MatrixXxFieldInfo
instance AttrInfo MatrixXxFieldInfo where
    type AttrBaseTypeConstraint MatrixXxFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixXxFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixXxFieldInfo = (~) Double
    type AttrTransferTypeConstraint MatrixXxFieldInfo = (~)Double
    type AttrTransferType MatrixXxFieldInfo = Double
    type AttrGetType MatrixXxFieldInfo = Double
    type AttrLabel MatrixXxFieldInfo = "xx"
    type AttrOrigin MatrixXxFieldInfo = Matrix
    attrGet = getMatrixXx
    attrSet = setMatrixXx
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

matrix_xx :: AttrLabelProxy "xx"
matrix_xx = AttrLabelProxy

#endif


-- | Get the value of the “@xy@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' matrix #xy
-- @
getMatrixXy :: MonadIO m => Matrix -> m Double
getMatrixXy :: Matrix -> m Double
getMatrixXy s :: Matrix
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO Double) -> IO Double)
-> (Ptr Matrix -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

-- | Set the value of the “@xy@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' matrix [ #xy 'Data.GI.Base.Attributes.:=' value ]
-- @
setMatrixXy :: MonadIO m => Matrix -> Double -> m ()
setMatrixXy :: Matrix -> Double -> m ()
setMatrixXy s :: Matrix
s val :: Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO ()) -> IO ()) -> (Ptr Matrix -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    let val' :: CDouble
val' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data MatrixXyFieldInfo
instance AttrInfo MatrixXyFieldInfo where
    type AttrBaseTypeConstraint MatrixXyFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixXyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixXyFieldInfo = (~) Double
    type AttrTransferTypeConstraint MatrixXyFieldInfo = (~)Double
    type AttrTransferType MatrixXyFieldInfo = Double
    type AttrGetType MatrixXyFieldInfo = Double
    type AttrLabel MatrixXyFieldInfo = "xy"
    type AttrOrigin MatrixXyFieldInfo = Matrix
    attrGet = getMatrixXy
    attrSet = setMatrixXy
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

matrix_xy :: AttrLabelProxy "xy"
matrix_xy = AttrLabelProxy

#endif


-- | Get the value of the “@yx@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' matrix #yx
-- @
getMatrixYx :: MonadIO m => Matrix -> m Double
getMatrixYx :: Matrix -> m Double
getMatrixYx s :: Matrix
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO Double) -> IO Double)
-> (Ptr Matrix -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

-- | Set the value of the “@yx@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' matrix [ #yx 'Data.GI.Base.Attributes.:=' value ]
-- @
setMatrixYx :: MonadIO m => Matrix -> Double -> m ()
setMatrixYx :: Matrix -> Double -> m ()
setMatrixYx s :: Matrix
s val :: Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO ()) -> IO ()) -> (Ptr Matrix -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    let val' :: CDouble
val' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data MatrixYxFieldInfo
instance AttrInfo MatrixYxFieldInfo where
    type AttrBaseTypeConstraint MatrixYxFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixYxFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixYxFieldInfo = (~) Double
    type AttrTransferTypeConstraint MatrixYxFieldInfo = (~)Double
    type AttrTransferType MatrixYxFieldInfo = Double
    type AttrGetType MatrixYxFieldInfo = Double
    type AttrLabel MatrixYxFieldInfo = "yx"
    type AttrOrigin MatrixYxFieldInfo = Matrix
    attrGet = getMatrixYx
    attrSet = setMatrixYx
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

matrix_yx :: AttrLabelProxy "yx"
matrix_yx = AttrLabelProxy

#endif


-- | Get the value of the “@yy@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' matrix #yy
-- @
getMatrixYy :: MonadIO m => Matrix -> m Double
getMatrixYy :: Matrix -> m Double
getMatrixYy s :: Matrix
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO Double) -> IO Double)
-> (Ptr Matrix -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

-- | Set the value of the “@yy@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' matrix [ #yy 'Data.GI.Base.Attributes.:=' value ]
-- @
setMatrixYy :: MonadIO m => Matrix -> Double -> m ()
setMatrixYy :: Matrix -> Double -> m ()
setMatrixYy s :: Matrix
s val :: Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO ()) -> IO ()) -> (Ptr Matrix -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    let val' :: CDouble
val' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data MatrixYyFieldInfo
instance AttrInfo MatrixYyFieldInfo where
    type AttrBaseTypeConstraint MatrixYyFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixYyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixYyFieldInfo = (~) Double
    type AttrTransferTypeConstraint MatrixYyFieldInfo = (~)Double
    type AttrTransferType MatrixYyFieldInfo = Double
    type AttrGetType MatrixYyFieldInfo = Double
    type AttrLabel MatrixYyFieldInfo = "yy"
    type AttrOrigin MatrixYyFieldInfo = Matrix
    attrGet = getMatrixYy
    attrSet = setMatrixYy
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

matrix_yy :: AttrLabelProxy "yy"
matrix_yy = AttrLabelProxy

#endif


-- | Get the value of the “@x0@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' matrix #x0
-- @
getMatrixX0 :: MonadIO m => Matrix -> m Double
getMatrixX0 :: Matrix -> m Double
getMatrixX0 s :: Matrix
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO Double) -> IO Double)
-> (Ptr Matrix -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

-- | Set the value of the “@x0@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' matrix [ #x0 'Data.GI.Base.Attributes.:=' value ]
-- @
setMatrixX0 :: MonadIO m => Matrix -> Double -> m ()
setMatrixX0 :: Matrix -> Double -> m ()
setMatrixX0 s :: Matrix
s val :: Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO ()) -> IO ()) -> (Ptr Matrix -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    let val' :: CDouble
val' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data MatrixX0FieldInfo
instance AttrInfo MatrixX0FieldInfo where
    type AttrBaseTypeConstraint MatrixX0FieldInfo = (~) Matrix
    type AttrAllowedOps MatrixX0FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixX0FieldInfo = (~) Double
    type AttrTransferTypeConstraint MatrixX0FieldInfo = (~)Double
    type AttrTransferType MatrixX0FieldInfo = Double
    type AttrGetType MatrixX0FieldInfo = Double
    type AttrLabel MatrixX0FieldInfo = "x0"
    type AttrOrigin MatrixX0FieldInfo = Matrix
    attrGet = getMatrixX0
    attrSet = setMatrixX0
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

matrix_x0 :: AttrLabelProxy "x0"
matrix_x0 = AttrLabelProxy

#endif


-- | Get the value of the “@y0@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' matrix #y0
-- @
getMatrixY0 :: MonadIO m => Matrix -> m Double
getMatrixY0 :: Matrix -> m Double
getMatrixY0 s :: Matrix
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO Double) -> IO Double)
-> (Ptr Matrix -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

-- | Set the value of the “@y0@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' matrix [ #y0 'Data.GI.Base.Attributes.:=' value ]
-- @
setMatrixY0 :: MonadIO m => Matrix -> Double -> m ()
setMatrixY0 :: Matrix -> Double -> m ()
setMatrixY0 s :: Matrix
s val :: Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Matrix
s ((Ptr Matrix -> IO ()) -> IO ()) -> (Ptr Matrix -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Matrix
ptr -> do
    let val' :: CDouble
val' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Matrix
ptr Ptr Matrix -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data MatrixY0FieldInfo
instance AttrInfo MatrixY0FieldInfo where
    type AttrBaseTypeConstraint MatrixY0FieldInfo = (~) Matrix
    type AttrAllowedOps MatrixY0FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixY0FieldInfo = (~) Double
    type AttrTransferTypeConstraint MatrixY0FieldInfo = (~)Double
    type AttrTransferType MatrixY0FieldInfo = Double
    type AttrGetType MatrixY0FieldInfo = Double
    type AttrLabel MatrixY0FieldInfo = "y0"
    type AttrOrigin MatrixY0FieldInfo = Matrix
    attrGet = getMatrixY0
    attrSet = setMatrixY0
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

matrix_y0 :: AttrLabelProxy "y0"
matrix_y0 = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Matrix
type instance O.AttributeList Matrix = MatrixAttributeList
type MatrixAttributeList = ('[ '("xx", MatrixXxFieldInfo), '("xy", MatrixXyFieldInfo), '("yx", MatrixYxFieldInfo), '("yy", MatrixYyFieldInfo), '("x0", MatrixX0FieldInfo), '("y0", MatrixY0FieldInfo)] :: [(Symbol, *)])
#endif

-- method Matrix::concat
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_matrix_concat" pango_matrix_concat :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    Ptr Matrix ->                           -- new_matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    IO ()

-- | Changes the transformation represented by /@matrix@/ to be the
-- transformation given by first applying transformation
-- given by /@newMatrix@/ then applying the original transformation.
-- 
-- /Since: 1.6/
matrixConcat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix'
    -> Matrix
    -- ^ /@newMatrix@/: a t'GI.Pango.Structs.Matrix.Matrix'
    -> m ()
matrixConcat :: Matrix -> Matrix -> m ()
matrixConcat matrix :: Matrix
matrix newMatrix :: Matrix
newMatrix = 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 Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    Ptr Matrix
newMatrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
newMatrix
    Ptr Matrix -> Ptr Matrix -> IO ()
pango_matrix_concat Ptr Matrix
matrix' Ptr Matrix
newMatrix'
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
newMatrix
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MatrixConcatMethodInfo
instance (signature ~ (Matrix -> m ()), MonadIO m) => O.MethodInfo MatrixConcatMethodInfo Matrix signature where
    overloadedMethod = matrixConcat

#endif

-- method Matrix::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Matrix" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_matrix_copy" pango_matrix_copy :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    IO (Ptr Matrix)

-- | Copies a t'GI.Pango.Structs.Matrix.Matrix'.
-- 
-- /Since: 1.6/
matrixCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix', may be 'P.Nothing'
    -> m (Maybe Matrix)
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Structs.Matrix.Matrix', which
    --               should be freed with 'GI.Pango.Structs.Matrix.matrixFree', or 'P.Nothing' if
    --               /@matrix@/ was 'P.Nothing'.
matrixCopy :: Matrix -> m (Maybe Matrix)
matrixCopy matrix :: Matrix
matrix = IO (Maybe Matrix) -> m (Maybe Matrix)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Matrix) -> m (Maybe Matrix))
-> IO (Maybe Matrix) -> m (Maybe Matrix)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    Ptr Matrix
result <- Ptr Matrix -> IO (Ptr Matrix)
pango_matrix_copy Ptr Matrix
matrix'
    Maybe Matrix
maybeResult <- Ptr Matrix -> (Ptr Matrix -> IO Matrix) -> IO (Maybe Matrix)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Matrix
result ((Ptr Matrix -> IO Matrix) -> IO (Maybe Matrix))
-> (Ptr Matrix -> IO Matrix) -> IO (Maybe Matrix)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Matrix
result' -> do
        Matrix
result'' <- ((ManagedPtr Matrix -> Matrix) -> Ptr Matrix -> IO Matrix
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Matrix -> Matrix
Matrix) Ptr Matrix
result'
        Matrix -> IO Matrix
forall (m :: * -> *) a. Monad m => a -> m a
return Matrix
result''
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Maybe Matrix -> IO (Maybe Matrix)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Matrix
maybeResult

#if defined(ENABLE_OVERLOADING)
data MatrixCopyMethodInfo
instance (signature ~ (m (Maybe Matrix)), MonadIO m) => O.MethodInfo MatrixCopyMethodInfo Matrix signature where
    overloadedMethod = matrixCopy

#endif

-- method Matrix::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_matrix_free" pango_matrix_free :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    IO ()

-- | Free a t'GI.Pango.Structs.Matrix.Matrix' created with 'GI.Pango.Structs.Matrix.matrixCopy'.
-- 
-- /Since: 1.6/
matrixFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix', may be 'P.Nothing'
    -> m ()
matrixFree :: Matrix -> m ()
matrixFree matrix :: Matrix
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 Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    Ptr Matrix -> IO ()
pango_matrix_free Ptr Matrix
matrix'
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MatrixFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo MatrixFreeMethodInfo Matrix signature where
    overloadedMethod = matrixFree

#endif

-- method Matrix::get_font_scale_factor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "pango_matrix_get_font_scale_factor" pango_matrix_get_font_scale_factor :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    IO CDouble

-- | Returns the scale factor of a matrix on the height of the font.
-- That is, the scale factor in the direction perpendicular to the
-- vector that the X coordinate is mapped to.  If the scale in the X
-- coordinate is needed as well, use 'GI.Pango.Structs.Matrix.matrixGetFontScaleFactors'.
-- 
-- /Since: 1.12/
matrixGetFontScaleFactor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix', may be 'P.Nothing'
    -> m Double
    -- ^ __Returns:__ the scale factor of /@matrix@/ on the height of the font,
    -- or 1.0 if /@matrix@/ is 'P.Nothing'.
matrixGetFontScaleFactor :: Matrix -> m Double
matrixGetFontScaleFactor matrix :: Matrix
matrix = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    CDouble
result <- Ptr Matrix -> IO CDouble
pango_matrix_get_font_scale_factor Ptr Matrix
matrix'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data MatrixGetFontScaleFactorMethodInfo
instance (signature ~ (m Double), MonadIO m) => O.MethodInfo MatrixGetFontScaleFactorMethodInfo Matrix signature where
    overloadedMethod = matrixGetFontScaleFactor

#endif

-- method Matrix::get_font_scale_factors
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "xscale"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "output scale factor in the x direction, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "yscale"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "output scale factor perpendicular to the x direction, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_matrix_get_font_scale_factors" pango_matrix_get_font_scale_factors :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    Ptr CDouble ->                          -- xscale : TBasicType TDouble
    Ptr CDouble ->                          -- yscale : TBasicType TDouble
    IO ()

-- | Calculates the scale factor of a matrix on the width and height of the font.
-- That is, /@xscale@/ is the scale factor in the direction of the X coordinate,
-- and /@yscale@/ is the scale factor in the direction perpendicular to the
-- vector that the X coordinate is mapped to.
-- 
-- Note that output numbers will always be non-negative.
-- 
-- /Since: 1.38/
matrixGetFontScaleFactors ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix', or 'P.Nothing'
    -> m ((Double, Double))
matrixGetFontScaleFactors :: Matrix -> m (Double, Double)
matrixGetFontScaleFactors matrix :: Matrix
matrix = IO (Double, Double) -> m (Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Double) -> m (Double, Double))
-> IO (Double, Double) -> m (Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    Ptr CDouble
xscale <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
yscale <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr Matrix -> Ptr CDouble -> Ptr CDouble -> IO ()
pango_matrix_get_font_scale_factors Ptr Matrix
matrix' Ptr CDouble
xscale Ptr CDouble
yscale
    CDouble
xscale' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
xscale
    let xscale'' :: Double
xscale'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
xscale'
    CDouble
yscale' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
yscale
    let yscale'' :: Double
yscale'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
yscale'
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
xscale
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
yscale
    (Double, Double) -> IO (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
xscale'', Double
yscale'')

#if defined(ENABLE_OVERLOADING)
data MatrixGetFontScaleFactorsMethodInfo
instance (signature ~ (m ((Double, Double))), MonadIO m) => O.MethodInfo MatrixGetFontScaleFactorsMethodInfo Matrix signature where
    overloadedMethod = matrixGetFontScaleFactors

#endif

-- method Matrix::rotate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "degrees"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "degrees to rotate counter-clockwise"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_matrix_rotate" pango_matrix_rotate :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    CDouble ->                              -- degrees : TBasicType TDouble
    IO ()

-- | Changes the transformation represented by /@matrix@/ to be the
-- transformation given by first rotating by /@degrees@/ degrees
-- counter-clockwise then applying the original transformation.
-- 
-- /Since: 1.6/
matrixRotate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix'
    -> Double
    -- ^ /@degrees@/: degrees to rotate counter-clockwise
    -> m ()
matrixRotate :: Matrix -> Double -> m ()
matrixRotate matrix :: Matrix
matrix degrees :: Double
degrees = 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 Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    let degrees' :: CDouble
degrees' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
degrees
    Ptr Matrix -> CDouble -> IO ()
pango_matrix_rotate Ptr Matrix
matrix' CDouble
degrees'
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MatrixRotateMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m) => O.MethodInfo MatrixRotateMethodInfo Matrix signature where
    overloadedMethod = matrixRotate

#endif

-- method Matrix::scale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scale_x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "amount to scale by in X direction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scale_y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "amount to scale by in Y direction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_matrix_scale" pango_matrix_scale :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    CDouble ->                              -- scale_x : TBasicType TDouble
    CDouble ->                              -- scale_y : TBasicType TDouble
    IO ()

-- | Changes the transformation represented by /@matrix@/ to be the
-- transformation given by first scaling by /@sx@/ in the X direction
-- and /@sy@/ in the Y direction then applying the original
-- transformation.
-- 
-- /Since: 1.6/
matrixScale ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix'
    -> Double
    -- ^ /@scaleX@/: amount to scale by in X direction
    -> Double
    -- ^ /@scaleY@/: amount to scale by in Y direction
    -> m ()
matrixScale :: Matrix -> Double -> Double -> m ()
matrixScale matrix :: Matrix
matrix scaleX :: Double
scaleX scaleY :: Double
scaleY = 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 Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    let scaleX' :: CDouble
scaleX' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
scaleX
    let scaleY' :: CDouble
scaleY' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
scaleY
    Ptr Matrix -> CDouble -> CDouble -> IO ()
pango_matrix_scale Ptr Matrix
matrix' CDouble
scaleX' CDouble
scaleY'
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MatrixScaleMethodInfo
instance (signature ~ (Double -> Double -> m ()), MonadIO m) => O.MethodInfo MatrixScaleMethodInfo Matrix signature where
    overloadedMethod = matrixScale

#endif

-- method Matrix::transform_distance
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dx"
--           , argType = TBasicType TDouble
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "in/out X component of a distance vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "dy"
--           , argType = TBasicType TDouble
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "in/out Y component of a distance vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_matrix_transform_distance" pango_matrix_transform_distance :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    Ptr CDouble ->                          -- dx : TBasicType TDouble
    Ptr CDouble ->                          -- dy : TBasicType TDouble
    IO ()

-- | Transforms the distance vector (/@dx@/,/@dy@/) by /@matrix@/. This is
-- similar to 'GI.Pango.Structs.Matrix.matrixTransformPoint' except that the translation
-- components of the transformation are ignored. The calculation of
-- the returned vector is as follows:
-- 
-- \<programlisting>
-- dx2 = dx1 * xx + dy1 * xy;
-- dy2 = dx1 * yx + dy1 * yy;
-- \<\/programlisting>
-- 
-- Affine transformations are position invariant, so the same vector
-- always transforms to the same vector. If (/@x1@/,/@y1@/) transforms
-- to (/@x2@/,/@y2@/) then (/@x1@/+/@dx1@/,/@y1@/+/@dy1@/) will transform to
-- (/@x1@/+/@dx2@/,/@y1@/+/@dy2@/) for all values of /@x1@/ and /@x2@/.
-- 
-- /Since: 1.16/
matrixTransformDistance ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix', or 'P.Nothing'
    -> Double
    -- ^ /@dx@/: in\/out X component of a distance vector
    -> Double
    -- ^ /@dy@/: in\/out Y component of a distance vector
    -> m ((Double, Double))
matrixTransformDistance :: Matrix -> Double -> Double -> m (Double, Double)
matrixTransformDistance matrix :: Matrix
matrix dx :: Double
dx dy :: Double
dy = IO (Double, Double) -> m (Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Double) -> m (Double, Double))
-> IO (Double, Double) -> m (Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    let dx' :: CDouble
dx' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
dx
    Ptr CDouble
dx'' <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDouble
dx'' CDouble
dx'
    let dy' :: CDouble
dy' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
dy
    Ptr CDouble
dy'' <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDouble
dy'' CDouble
dy'
    Ptr Matrix -> Ptr CDouble -> Ptr CDouble -> IO ()
pango_matrix_transform_distance Ptr Matrix
matrix' Ptr CDouble
dx'' Ptr CDouble
dy''
    CDouble
dx''' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
dx''
    let dx'''' :: Double
dx'''' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
dx'''
    CDouble
dy''' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
dy''
    let dy'''' :: Double
dy'''' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
dy'''
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
dx''
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
dy''
    (Double, Double) -> IO (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
dx'''', Double
dy'''')

#if defined(ENABLE_OVERLOADING)
data MatrixTransformDistanceMethodInfo
instance (signature ~ (Double -> Double -> m ((Double, Double))), MonadIO m) => O.MethodInfo MatrixTransformDistanceMethodInfo Matrix signature where
    overloadedMethod = matrixTransformDistance

#endif

-- method Matrix::transform_pixel_rectangle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "in/out bounding box in device units, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_matrix_transform_pixel_rectangle" pango_matrix_transform_pixel_rectangle :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    Ptr Pango.Rectangle.Rectangle ->        -- rect : TInterface (Name {namespace = "Pango", name = "Rectangle"})
    IO ()

-- | First transforms the /@rect@/ using /@matrix@/, then calculates the bounding box
-- of the transformed rectangle.  The rectangle should be in device units
-- (pixels).
-- 
-- This function is useful for example when you want to draw a rotated
-- /@pangoLayout@/ to an image buffer, and want to know how large the image
-- should be and how much you should shift the layout when rendering.
-- 
-- For better accuracy, you should use 'GI.Pango.Structs.Matrix.matrixTransformRectangle' on
-- original rectangle in Pango units and convert to pixels afterward
-- using 'GI.Pango.Functions.extentsToPixels'\'s first argument.
-- 
-- /Since: 1.16/
matrixTransformPixelRectangle ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix', or 'P.Nothing'
    -> Maybe (Pango.Rectangle.Rectangle)
    -- ^ /@rect@/: in\/out bounding box in device units, or 'P.Nothing'
    -> m ()
matrixTransformPixelRectangle :: Matrix -> Maybe Rectangle -> m ()
matrixTransformPixelRectangle matrix :: Matrix
matrix rect :: Maybe Rectangle
rect = 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 Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    Ptr Rectangle
maybeRect <- case Maybe Rectangle
rect of
        Nothing -> Ptr Rectangle -> IO (Ptr Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Rectangle
forall a. Ptr a
nullPtr
        Just jRect :: Rectangle
jRect -> do
            Ptr Rectangle
jRect' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
jRect
            Ptr Rectangle -> IO (Ptr Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Rectangle
jRect'
    Ptr Matrix -> Ptr Rectangle -> IO ()
pango_matrix_transform_pixel_rectangle Ptr Matrix
matrix' Ptr Rectangle
maybeRect
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Maybe Rectangle -> (Rectangle -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Rectangle
rect Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MatrixTransformPixelRectangleMethodInfo
instance (signature ~ (Maybe (Pango.Rectangle.Rectangle) -> m ()), MonadIO m) => O.MethodInfo MatrixTransformPixelRectangleMethodInfo Matrix signature where
    overloadedMethod = matrixTransformPixelRectangle

#endif

-- method Matrix::transform_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "in/out X position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "in/out Y position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_matrix_transform_point" pango_matrix_transform_point :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    Ptr CDouble ->                          -- x : TBasicType TDouble
    Ptr CDouble ->                          -- y : TBasicType TDouble
    IO ()

-- | Transforms the point (/@x@/, /@y@/) by /@matrix@/.
-- 
-- /Since: 1.16/
matrixTransformPoint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix', or 'P.Nothing'
    -> Double
    -- ^ /@x@/: in\/out X position
    -> Double
    -- ^ /@y@/: in\/out Y position
    -> m ((Double, Double))
matrixTransformPoint :: Matrix -> Double -> Double -> m (Double, Double)
matrixTransformPoint matrix :: Matrix
matrix x :: Double
x y :: Double
y = IO (Double, Double) -> m (Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Double) -> m (Double, Double))
-> IO (Double, Double) -> m (Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    let x' :: CDouble
x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    Ptr CDouble
x'' <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDouble
x'' CDouble
x'
    let y' :: CDouble
y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    Ptr CDouble
y'' <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDouble
y'' CDouble
y'
    Ptr Matrix -> Ptr CDouble -> Ptr CDouble -> IO ()
pango_matrix_transform_point Ptr Matrix
matrix' Ptr CDouble
x'' Ptr CDouble
y''
    CDouble
x''' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
x''
    let x'''' :: Double
x'''' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x'''
    CDouble
y''' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
y''
    let y'''' :: Double
y'''' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y'''
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
x''
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
y''
    (Double, Double) -> IO (Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x'''', Double
y'''')

#if defined(ENABLE_OVERLOADING)
data MatrixTransformPointMethodInfo
instance (signature ~ (Double -> Double -> m ((Double, Double))), MonadIO m) => O.MethodInfo MatrixTransformPointMethodInfo Matrix signature where
    overloadedMethod = matrixTransformPoint

#endif

-- XXX Could not generate method Matrix::transform_rectangle
-- Error was : Not implemented: "Nullable inout structs not supported"
-- method Matrix::translate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoMatrix" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tx"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "amount to translate in the X direction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ty"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "amount to translate in the Y direction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_matrix_translate" pango_matrix_translate :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Pango", name = "Matrix"})
    CDouble ->                              -- tx : TBasicType TDouble
    CDouble ->                              -- ty : TBasicType TDouble
    IO ()

-- | Changes the transformation represented by /@matrix@/ to be the
-- transformation given by first translating by (/@tx@/, /@ty@/)
-- then applying the original transformation.
-- 
-- /Since: 1.6/
matrixTranslate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Pango.Structs.Matrix.Matrix'
    -> Double
    -- ^ /@tx@/: amount to translate in the X direction
    -> Double
    -- ^ /@ty@/: amount to translate in the Y direction
    -> m ()
matrixTranslate :: Matrix -> Double -> Double -> m ()
matrixTranslate matrix :: Matrix
matrix tx :: Double
tx ty :: Double
ty = 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 Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    let tx' :: CDouble
tx' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
tx
    let ty' :: CDouble
ty' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ty
    Ptr Matrix -> CDouble -> CDouble -> IO ()
pango_matrix_translate Ptr Matrix
matrix' CDouble
tx' CDouble
ty'
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MatrixTranslateMethodInfo
instance (signature ~ (Double -> Double -> m ()), MonadIO m) => O.MethodInfo MatrixTranslateMethodInfo Matrix signature where
    overloadedMethod = matrixTranslate

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMatrixMethod (t :: Symbol) (o :: *) :: * where
    ResolveMatrixMethod "concat" o = MatrixConcatMethodInfo
    ResolveMatrixMethod "copy" o = MatrixCopyMethodInfo
    ResolveMatrixMethod "free" o = MatrixFreeMethodInfo
    ResolveMatrixMethod "rotate" o = MatrixRotateMethodInfo
    ResolveMatrixMethod "scale" o = MatrixScaleMethodInfo
    ResolveMatrixMethod "transformDistance" o = MatrixTransformDistanceMethodInfo
    ResolveMatrixMethod "transformPixelRectangle" o = MatrixTransformPixelRectangleMethodInfo
    ResolveMatrixMethod "transformPoint" o = MatrixTransformPointMethodInfo
    ResolveMatrixMethod "translate" o = MatrixTranslateMethodInfo
    ResolveMatrixMethod "getFontScaleFactor" o = MatrixGetFontScaleFactorMethodInfo
    ResolveMatrixMethod "getFontScaleFactors" o = MatrixGetFontScaleFactorsMethodInfo
    ResolveMatrixMethod l o = O.MethodResolutionFailed l o

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

#endif