{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Data structure for holding a destination
-- 
-- Note that /@namedDest@/ is the string representation of the named
-- destination. This is the right form to pass to poppler functions,
-- e.g. 'GI.Poppler.Objects.Document.documentFindDest', but to get the destination as
-- it appears in the PDF itself, you need to convert it to a bytestring
-- with 'GI.Poppler.Functions.namedDestToBytestring' first.
-- Also note that /@namedDest@/ does not have a defined encoding and
-- is not in a form suitable to be displayed to the user.

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

module GI.Poppler.Structs.Dest
    ( 

-- * Exported types
    Dest(..)                                ,
    newZeroDest                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDestMethod                       ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    DestCopyMethodInfo                      ,
#endif
    destCopy                                ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    DestFreeMethodInfo                      ,
#endif
    destFree                                ,




 -- * Properties
-- ** bottom #attr:bottom#
-- | bottom coordinate

#if defined(ENABLE_OVERLOADING)
    dest_bottom                             ,
#endif
    getDestBottom                           ,
    setDestBottom                           ,


-- ** changeLeft #attr:changeLeft#
-- | whether left coordinate should be changed

#if defined(ENABLE_OVERLOADING)
    dest_changeLeft                         ,
#endif
    getDestChangeLeft                       ,
    setDestChangeLeft                       ,


-- ** changeTop #attr:changeTop#
-- | whether top coordinate should be changed

#if defined(ENABLE_OVERLOADING)
    dest_changeTop                          ,
#endif
    getDestChangeTop                        ,
    setDestChangeTop                        ,


-- ** changeZoom #attr:changeZoom#
-- | whether scale factor should be changed

#if defined(ENABLE_OVERLOADING)
    dest_changeZoom                         ,
#endif
    getDestChangeZoom                       ,
    setDestChangeZoom                       ,


-- ** left #attr:left#
-- | left coordinate

#if defined(ENABLE_OVERLOADING)
    dest_left                               ,
#endif
    getDestLeft                             ,
    setDestLeft                             ,


-- ** namedDest #attr:namedDest#
-- | name of the destination (@/POPPLER_DEST_NAMED/@ only)

    clearDestNamedDest                      ,
#if defined(ENABLE_OVERLOADING)
    dest_namedDest                          ,
#endif
    getDestNamedDest                        ,
    setDestNamedDest                        ,


-- ** pageNum #attr:pageNum#
-- | page number

#if defined(ENABLE_OVERLOADING)
    dest_pageNum                            ,
#endif
    getDestPageNum                          ,
    setDestPageNum                          ,


-- ** right #attr:right#
-- | right coordinate

#if defined(ENABLE_OVERLOADING)
    dest_right                              ,
#endif
    getDestRight                            ,
    setDestRight                            ,


-- ** top #attr:top#
-- | top coordinate

#if defined(ENABLE_OVERLOADING)
    dest_top                                ,
#endif
    getDestTop                              ,
    setDestTop                              ,


-- ** type #attr:type#
-- | type of destination

#if defined(ENABLE_OVERLOADING)
    dest_type                               ,
#endif
    getDestType                             ,
    setDestType                             ,


-- ** zoom #attr:zoom#
-- | scale factor

#if defined(ENABLE_OVERLOADING)
    dest_zoom                               ,
#endif
    getDestZoom                             ,
    setDestZoom                             ,




    ) 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 {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums

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

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

foreign import ccall "poppler_dest_get_type" c_poppler_dest_get_type :: 
    IO GType

type instance O.ParentTypes Dest = '[]
instance O.HasParentTypes Dest

instance B.Types.TypedObject Dest where
    glibType :: IO GType
glibType = IO GType
c_poppler_dest_get_type

instance B.Types.GBoxed Dest

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

-- | Construct a `Dest` struct initialized to zero.
newZeroDest :: MonadIO m => m Dest
newZeroDest :: m Dest
newZeroDest = IO Dest -> m Dest
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Dest -> m Dest) -> IO Dest -> m Dest
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Dest)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
72 IO (Ptr Dest) -> (Ptr Dest -> IO Dest) -> IO Dest
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Dest -> Dest) -> Ptr Dest -> IO Dest
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Dest -> Dest
Dest

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


-- | Get the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dest #type
-- @
getDestType :: MonadIO m => Dest -> m Poppler.Enums.DestType
getDestType :: Dest -> m DestType
getDestType Dest
s = IO DestType -> m DestType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DestType -> m DestType) -> IO DestType -> m DestType
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO DestType) -> IO DestType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO DestType) -> IO DestType)
-> (Ptr Dest -> IO DestType) -> IO DestType
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Dest
ptr Ptr Dest -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CUInt
    let val' :: DestType
val' = (Int -> DestType
forall a. Enum a => Int -> a
toEnum (Int -> DestType) -> (CUInt -> Int) -> CUInt -> DestType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    DestType -> IO DestType
forall (m :: * -> *) a. Monad m => a -> m a
return DestType
val'

-- | Set the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dest [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setDestType :: MonadIO m => Dest -> Poppler.Enums.DestType -> m ()
setDestType :: Dest -> DestType -> m ()
setDestType Dest
s DestType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (DestType -> Int) -> DestType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DestType -> Int
forall a. Enum a => a -> Int
fromEnum) DestType
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Dest
ptr Ptr Dest -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data DestTypeFieldInfo
instance AttrInfo DestTypeFieldInfo where
    type AttrBaseTypeConstraint DestTypeFieldInfo = (~) Dest
    type AttrAllowedOps DestTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestTypeFieldInfo = (~) Poppler.Enums.DestType
    type AttrTransferTypeConstraint DestTypeFieldInfo = (~)Poppler.Enums.DestType
    type AttrTransferType DestTypeFieldInfo = Poppler.Enums.DestType
    type AttrGetType DestTypeFieldInfo = Poppler.Enums.DestType
    type AttrLabel DestTypeFieldInfo = "type"
    type AttrOrigin DestTypeFieldInfo = Dest
    attrGet = getDestType
    attrSet = setDestType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

dest_type :: AttrLabelProxy "type"
dest_type = AttrLabelProxy

#endif


-- | Get the value of the “@page_num@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dest #pageNum
-- @
getDestPageNum :: MonadIO m => Dest -> m Int32
getDestPageNum :: Dest -> m Int32
getDestPageNum Dest
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO Int32) -> IO Int32)
-> (Ptr Dest -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Dest
ptr Ptr Dest -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@page_num@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dest [ #pageNum 'Data.GI.Base.Attributes.:=' value ]
-- @
setDestPageNum :: MonadIO m => Dest -> Int32 -> m ()
setDestPageNum :: Dest -> Int32 -> m ()
setDestPageNum Dest
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Dest
ptr Ptr Dest -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data DestPageNumFieldInfo
instance AttrInfo DestPageNumFieldInfo where
    type AttrBaseTypeConstraint DestPageNumFieldInfo = (~) Dest
    type AttrAllowedOps DestPageNumFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestPageNumFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DestPageNumFieldInfo = (~)Int32
    type AttrTransferType DestPageNumFieldInfo = Int32
    type AttrGetType DestPageNumFieldInfo = Int32
    type AttrLabel DestPageNumFieldInfo = "page_num"
    type AttrOrigin DestPageNumFieldInfo = Dest
    attrGet = getDestPageNum
    attrSet = setDestPageNum
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

dest_pageNum :: AttrLabelProxy "pageNum"
dest_pageNum = AttrLabelProxy

#endif


-- | Get the value of the “@left@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dest #left
-- @
getDestLeft :: MonadIO m => Dest -> m Double
getDestLeft :: Dest -> m Double
getDestLeft Dest
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
$ Dest -> (Ptr Dest -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO Double) -> IO Double)
-> (Ptr Dest -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Dest
ptr Ptr Dest -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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 “@left@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dest [ #left 'Data.GI.Base.Attributes.:=' value ]
-- @
setDestLeft :: MonadIO m => Dest -> Double -> m ()
setDestLeft :: Dest -> Double -> m ()
setDestLeft Dest
s 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
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
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 Dest
ptr Ptr Dest -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data DestLeftFieldInfo
instance AttrInfo DestLeftFieldInfo where
    type AttrBaseTypeConstraint DestLeftFieldInfo = (~) Dest
    type AttrAllowedOps DestLeftFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestLeftFieldInfo = (~) Double
    type AttrTransferTypeConstraint DestLeftFieldInfo = (~)Double
    type AttrTransferType DestLeftFieldInfo = Double
    type AttrGetType DestLeftFieldInfo = Double
    type AttrLabel DestLeftFieldInfo = "left"
    type AttrOrigin DestLeftFieldInfo = Dest
    attrGet = getDestLeft
    attrSet = setDestLeft
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

dest_left :: AttrLabelProxy "left"
dest_left = AttrLabelProxy

#endif


-- | Get the value of the “@bottom@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dest #bottom
-- @
getDestBottom :: MonadIO m => Dest -> m Double
getDestBottom :: Dest -> m Double
getDestBottom Dest
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
$ Dest -> (Ptr Dest -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO Double) -> IO Double)
-> (Ptr Dest -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Dest
ptr Ptr Dest -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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 “@bottom@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dest [ #bottom 'Data.GI.Base.Attributes.:=' value ]
-- @
setDestBottom :: MonadIO m => Dest -> Double -> m ()
setDestBottom :: Dest -> Double -> m ()
setDestBottom Dest
s 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
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
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 Dest
ptr Ptr Dest -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data DestBottomFieldInfo
instance AttrInfo DestBottomFieldInfo where
    type AttrBaseTypeConstraint DestBottomFieldInfo = (~) Dest
    type AttrAllowedOps DestBottomFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestBottomFieldInfo = (~) Double
    type AttrTransferTypeConstraint DestBottomFieldInfo = (~)Double
    type AttrTransferType DestBottomFieldInfo = Double
    type AttrGetType DestBottomFieldInfo = Double
    type AttrLabel DestBottomFieldInfo = "bottom"
    type AttrOrigin DestBottomFieldInfo = Dest
    attrGet = getDestBottom
    attrSet = setDestBottom
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

dest_bottom :: AttrLabelProxy "bottom"
dest_bottom = AttrLabelProxy

#endif


-- | Get the value of the “@right@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dest #right
-- @
getDestRight :: MonadIO m => Dest -> m Double
getDestRight :: Dest -> m Double
getDestRight Dest
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
$ Dest -> (Ptr Dest -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO Double) -> IO Double)
-> (Ptr Dest -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Dest
ptr Ptr Dest -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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 “@right@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dest [ #right 'Data.GI.Base.Attributes.:=' value ]
-- @
setDestRight :: MonadIO m => Dest -> Double -> m ()
setDestRight :: Dest -> Double -> m ()
setDestRight Dest
s 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
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
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 Dest
ptr Ptr Dest -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data DestRightFieldInfo
instance AttrInfo DestRightFieldInfo where
    type AttrBaseTypeConstraint DestRightFieldInfo = (~) Dest
    type AttrAllowedOps DestRightFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestRightFieldInfo = (~) Double
    type AttrTransferTypeConstraint DestRightFieldInfo = (~)Double
    type AttrTransferType DestRightFieldInfo = Double
    type AttrGetType DestRightFieldInfo = Double
    type AttrLabel DestRightFieldInfo = "right"
    type AttrOrigin DestRightFieldInfo = Dest
    attrGet = getDestRight
    attrSet = setDestRight
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

dest_right :: AttrLabelProxy "right"
dest_right = AttrLabelProxy

#endif


-- | Get the value of the “@top@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dest #top
-- @
getDestTop :: MonadIO m => Dest -> m Double
getDestTop :: Dest -> m Double
getDestTop Dest
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
$ Dest -> (Ptr Dest -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO Double) -> IO Double)
-> (Ptr Dest -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Dest
ptr Ptr Dest -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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 “@top@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dest [ #top 'Data.GI.Base.Attributes.:=' value ]
-- @
setDestTop :: MonadIO m => Dest -> Double -> m ()
setDestTop :: Dest -> Double -> m ()
setDestTop Dest
s 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
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
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 Dest
ptr Ptr Dest -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data DestTopFieldInfo
instance AttrInfo DestTopFieldInfo where
    type AttrBaseTypeConstraint DestTopFieldInfo = (~) Dest
    type AttrAllowedOps DestTopFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestTopFieldInfo = (~) Double
    type AttrTransferTypeConstraint DestTopFieldInfo = (~)Double
    type AttrTransferType DestTopFieldInfo = Double
    type AttrGetType DestTopFieldInfo = Double
    type AttrLabel DestTopFieldInfo = "top"
    type AttrOrigin DestTopFieldInfo = Dest
    attrGet = getDestTop
    attrSet = setDestTop
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

dest_top :: AttrLabelProxy "top"
dest_top = AttrLabelProxy

#endif


-- | Get the value of the “@zoom@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dest #zoom
-- @
getDestZoom :: MonadIO m => Dest -> m Double
getDestZoom :: Dest -> m Double
getDestZoom Dest
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
$ Dest -> (Ptr Dest -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO Double) -> IO Double)
-> (Ptr Dest -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr Dest
ptr Ptr Dest -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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 “@zoom@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dest [ #zoom 'Data.GI.Base.Attributes.:=' value ]
-- @
setDestZoom :: MonadIO m => Dest -> Double -> m ()
setDestZoom :: Dest -> Double -> m ()
setDestZoom Dest
s 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
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
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 Dest
ptr Ptr Dest -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data DestZoomFieldInfo
instance AttrInfo DestZoomFieldInfo where
    type AttrBaseTypeConstraint DestZoomFieldInfo = (~) Dest
    type AttrAllowedOps DestZoomFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestZoomFieldInfo = (~) Double
    type AttrTransferTypeConstraint DestZoomFieldInfo = (~)Double
    type AttrTransferType DestZoomFieldInfo = Double
    type AttrGetType DestZoomFieldInfo = Double
    type AttrLabel DestZoomFieldInfo = "zoom"
    type AttrOrigin DestZoomFieldInfo = Dest
    attrGet = getDestZoom
    attrSet = setDestZoom
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

dest_zoom :: AttrLabelProxy "zoom"
dest_zoom = AttrLabelProxy

#endif


-- | Get the value of the “@named_dest@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dest #namedDest
-- @
getDestNamedDest :: MonadIO m => Dest -> m (Maybe T.Text)
getDestNamedDest :: Dest -> m (Maybe Text)
getDestNamedDest Dest
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Dest -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr Dest
ptr Ptr Dest -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@named_dest@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dest [ #namedDest 'Data.GI.Base.Attributes.:=' value ]
-- @
setDestNamedDest :: MonadIO m => Dest -> CString -> m ()
setDestNamedDest :: Dest -> CString -> m ()
setDestNamedDest Dest
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Dest
ptr Ptr Dest -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (CString
val :: CString)

-- | Set the value of the “@named_dest@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #namedDest
-- @
clearDestNamedDest :: MonadIO m => Dest -> m ()
clearDestNamedDest :: Dest -> m ()
clearDestNamedDest Dest
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Dest
ptr Ptr Dest -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data DestNamedDestFieldInfo
instance AttrInfo DestNamedDestFieldInfo where
    type AttrBaseTypeConstraint DestNamedDestFieldInfo = (~) Dest
    type AttrAllowedOps DestNamedDestFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint DestNamedDestFieldInfo = (~) CString
    type AttrTransferTypeConstraint DestNamedDestFieldInfo = (~)CString
    type AttrTransferType DestNamedDestFieldInfo = CString
    type AttrGetType DestNamedDestFieldInfo = Maybe T.Text
    type AttrLabel DestNamedDestFieldInfo = "named_dest"
    type AttrOrigin DestNamedDestFieldInfo = Dest
    attrGet = getDestNamedDest
    attrSet = setDestNamedDest
    attrConstruct = undefined
    attrClear = clearDestNamedDest
    attrTransfer _ v = do
        return v

dest_namedDest :: AttrLabelProxy "namedDest"
dest_namedDest = AttrLabelProxy

#endif


-- | Get the value of the “@change_left@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dest #changeLeft
-- @
getDestChangeLeft :: MonadIO m => Dest -> m Word32
getDestChangeLeft :: Dest -> m Word32
getDestChangeLeft Dest
s = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO Word32) -> IO Word32)
-> (Ptr Dest -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Dest
ptr Ptr Dest -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@change_left@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dest [ #changeLeft 'Data.GI.Base.Attributes.:=' value ]
-- @
setDestChangeLeft :: MonadIO m => Dest -> Word32 -> m ()
setDestChangeLeft :: Dest -> Word32 -> m ()
setDestChangeLeft Dest
s Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Dest
ptr Ptr Dest -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data DestChangeLeftFieldInfo
instance AttrInfo DestChangeLeftFieldInfo where
    type AttrBaseTypeConstraint DestChangeLeftFieldInfo = (~) Dest
    type AttrAllowedOps DestChangeLeftFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestChangeLeftFieldInfo = (~) Word32
    type AttrTransferTypeConstraint DestChangeLeftFieldInfo = (~)Word32
    type AttrTransferType DestChangeLeftFieldInfo = Word32
    type AttrGetType DestChangeLeftFieldInfo = Word32
    type AttrLabel DestChangeLeftFieldInfo = "change_left"
    type AttrOrigin DestChangeLeftFieldInfo = Dest
    attrGet = getDestChangeLeft
    attrSet = setDestChangeLeft
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

dest_changeLeft :: AttrLabelProxy "changeLeft"
dest_changeLeft = AttrLabelProxy

#endif


-- | Get the value of the “@change_top@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dest #changeTop
-- @
getDestChangeTop :: MonadIO m => Dest -> m Word32
getDestChangeTop :: Dest -> m Word32
getDestChangeTop Dest
s = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO Word32) -> IO Word32)
-> (Ptr Dest -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Dest
ptr Ptr Dest -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@change_top@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dest [ #changeTop 'Data.GI.Base.Attributes.:=' value ]
-- @
setDestChangeTop :: MonadIO m => Dest -> Word32 -> m ()
setDestChangeTop :: Dest -> Word32 -> m ()
setDestChangeTop Dest
s Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Dest
ptr Ptr Dest -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data DestChangeTopFieldInfo
instance AttrInfo DestChangeTopFieldInfo where
    type AttrBaseTypeConstraint DestChangeTopFieldInfo = (~) Dest
    type AttrAllowedOps DestChangeTopFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestChangeTopFieldInfo = (~) Word32
    type AttrTransferTypeConstraint DestChangeTopFieldInfo = (~)Word32
    type AttrTransferType DestChangeTopFieldInfo = Word32
    type AttrGetType DestChangeTopFieldInfo = Word32
    type AttrLabel DestChangeTopFieldInfo = "change_top"
    type AttrOrigin DestChangeTopFieldInfo = Dest
    attrGet = getDestChangeTop
    attrSet = setDestChangeTop
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

dest_changeTop :: AttrLabelProxy "changeTop"
dest_changeTop = AttrLabelProxy

#endif


-- | Get the value of the “@change_zoom@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dest #changeZoom
-- @
getDestChangeZoom :: MonadIO m => Dest -> m Word32
getDestChangeZoom :: Dest -> m Word32
getDestChangeZoom Dest
s = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO Word32) -> IO Word32)
-> (Ptr Dest -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Dest
ptr Ptr Dest -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@change_zoom@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dest [ #changeZoom 'Data.GI.Base.Attributes.:=' value ]
-- @
setDestChangeZoom :: MonadIO m => Dest -> Word32 -> m ()
setDestChangeZoom :: Dest -> Word32 -> m ()
setDestChangeZoom Dest
s Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Dest -> (Ptr Dest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Dest
s ((Ptr Dest -> IO ()) -> IO ()) -> (Ptr Dest -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Dest
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Dest
ptr Ptr Dest -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data DestChangeZoomFieldInfo
instance AttrInfo DestChangeZoomFieldInfo where
    type AttrBaseTypeConstraint DestChangeZoomFieldInfo = (~) Dest
    type AttrAllowedOps DestChangeZoomFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DestChangeZoomFieldInfo = (~) Word32
    type AttrTransferTypeConstraint DestChangeZoomFieldInfo = (~)Word32
    type AttrTransferType DestChangeZoomFieldInfo = Word32
    type AttrGetType DestChangeZoomFieldInfo = Word32
    type AttrLabel DestChangeZoomFieldInfo = "change_zoom"
    type AttrOrigin DestChangeZoomFieldInfo = Dest
    attrGet = getDestChangeZoom
    attrSet = setDestChangeZoom
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

dest_changeZoom :: AttrLabelProxy "changeZoom"
dest_changeZoom = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Dest
type instance O.AttributeList Dest = DestAttributeList
type DestAttributeList = ('[ '("type", DestTypeFieldInfo), '("pageNum", DestPageNumFieldInfo), '("left", DestLeftFieldInfo), '("bottom", DestBottomFieldInfo), '("right", DestRightFieldInfo), '("top", DestTopFieldInfo), '("zoom", DestZoomFieldInfo), '("namedDest", DestNamedDestFieldInfo), '("changeLeft", DestChangeLeftFieldInfo), '("changeTop", DestChangeTopFieldInfo), '("changeZoom", DestChangeZoomFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "poppler_dest_copy" poppler_dest_copy :: 
    Ptr Dest ->                             -- dest : TInterface (Name {namespace = "Poppler", name = "Dest"})
    IO (Ptr Dest)

-- | Copies /@dest@/, creating an identical t'GI.Poppler.Structs.Dest.Dest'.
destCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Dest
    -- ^ /@dest@/: a t'GI.Poppler.Structs.Dest.Dest'
    -> m Dest
    -- ^ __Returns:__ a new destination identical to /@dest@/
destCopy :: Dest -> m Dest
destCopy Dest
dest = IO Dest -> m Dest
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Dest -> m Dest) -> IO Dest -> m Dest
forall a b. (a -> b) -> a -> b
$ do
    Ptr Dest
dest' <- Dest -> IO (Ptr Dest)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Dest
dest
    Ptr Dest
result <- Ptr Dest -> IO (Ptr Dest)
poppler_dest_copy Ptr Dest
dest'
    Text -> Ptr Dest -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"destCopy" Ptr Dest
result
    Dest
result' <- ((ManagedPtr Dest -> Dest) -> Ptr Dest -> IO Dest
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Dest -> Dest
Dest) Ptr Dest
result
    Dest -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Dest
dest
    Dest -> IO Dest
forall (m :: * -> *) a. Monad m => a -> m a
return Dest
result'

#if defined(ENABLE_OVERLOADING)
data DestCopyMethodInfo
instance (signature ~ (m Dest), MonadIO m) => O.MethodInfo DestCopyMethodInfo Dest signature where
    overloadedMethod = destCopy

#endif

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

foreign import ccall "poppler_dest_free" poppler_dest_free :: 
    Ptr Dest ->                             -- dest : TInterface (Name {namespace = "Poppler", name = "Dest"})
    IO ()

-- | Frees /@dest@/
destFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Dest
    -- ^ /@dest@/: a t'GI.Poppler.Structs.Dest.Dest'
    -> m ()
destFree :: Dest -> m ()
destFree Dest
dest = 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 Dest
dest' <- Dest -> IO (Ptr Dest)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Dest
dest
    Ptr Dest -> IO ()
poppler_dest_free Ptr Dest
dest'
    Dest -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Dest
dest
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DestFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo DestFreeMethodInfo Dest signature where
    overloadedMethod = destFree

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDestMethod (t :: Symbol) (o :: *) :: * where
    ResolveDestMethod "copy" o = DestCopyMethodInfo
    ResolveDestMethod "free" o = DestFreeMethodInfo
    ResolveDestMethod l o = O.MethodResolutionFailed l o

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

#endif