{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Stage perspective definition. t'GI.Clutter.Structs.Perspective.Perspective' is only used by
-- the fixed point version of 'GI.Clutter.Objects.Stage.stageSetPerspective'.
-- 
-- /Since: 0.4/

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

module GI.Clutter.Structs.Perspective
    ( 

-- * Exported types
    Perspective(..)                         ,
    newZeroPerspective                      ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolvePerspectiveMethod                ,
#endif



 -- * Properties


-- ** aspect #attr:aspect#
-- | the aspect ratio that determines the field of view in the x
--   direction. The aspect ratio is the ratio of x (width) to y (height)

    getPerspectiveAspect                    ,
#if defined(ENABLE_OVERLOADING)
    perspective_aspect                      ,
#endif
    setPerspectiveAspect                    ,


-- ** fovy #attr:fovy#
-- | the field of view angle, in degrees, in the y direction

    getPerspectiveFovy                      ,
#if defined(ENABLE_OVERLOADING)
    perspective_fovy                        ,
#endif
    setPerspectiveFovy                      ,


-- ** zFar #attr:zFar#
-- | the distance from the viewer to the far clipping
--   plane (always positive)

    getPerspectiveZFar                      ,
#if defined(ENABLE_OVERLOADING)
    perspective_zFar                        ,
#endif
    setPerspectiveZFar                      ,


-- ** zNear #attr:zNear#
-- | the distance from the viewer to the near clipping
--   plane (always positive)

    getPerspectiveZNear                     ,
#if defined(ENABLE_OVERLOADING)
    perspective_zNear                       ,
#endif
    setPerspectiveZNear                     ,




    ) where

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

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


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

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

foreign import ccall "clutter_perspective_get_type" c_clutter_perspective_get_type :: 
    IO GType

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

instance B.Types.TypedObject Perspective where
    glibType :: IO GType
glibType = IO GType
c_clutter_perspective_get_type

instance B.Types.GBoxed Perspective

-- | Convert 'Perspective' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Perspective) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_perspective_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Perspective -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Perspective
P.Nothing = Ptr GValue -> Ptr Perspective -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Perspective
forall a. Ptr a
FP.nullPtr :: FP.Ptr Perspective)
    gvalueSet_ Ptr GValue
gv (P.Just Perspective
obj) = Perspective -> (Ptr Perspective -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Perspective
obj (Ptr GValue -> Ptr Perspective -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Perspective)
gvalueGet_ Ptr GValue
gv = do
        Ptr Perspective
ptr <- Ptr GValue -> IO (Ptr Perspective)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Perspective)
        if Ptr Perspective
ptr Ptr Perspective -> Ptr Perspective -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Perspective
forall a. Ptr a
FP.nullPtr
        then Perspective -> Maybe Perspective
forall a. a -> Maybe a
P.Just (Perspective -> Maybe Perspective)
-> IO Perspective -> IO (Maybe Perspective)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Perspective -> Perspective)
-> Ptr Perspective -> IO Perspective
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Perspective -> Perspective
Perspective Ptr Perspective
ptr
        else Maybe Perspective -> IO (Maybe Perspective)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Perspective
forall a. Maybe a
P.Nothing
        
    

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

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


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

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

#if defined(ENABLE_OVERLOADING)
data PerspectiveFovyFieldInfo
instance AttrInfo PerspectiveFovyFieldInfo where
    type AttrBaseTypeConstraint PerspectiveFovyFieldInfo = (~) Perspective
    type AttrAllowedOps PerspectiveFovyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PerspectiveFovyFieldInfo = (~) Float
    type AttrTransferTypeConstraint PerspectiveFovyFieldInfo = (~)Float
    type AttrTransferType PerspectiveFovyFieldInfo = Float
    type AttrGetType PerspectiveFovyFieldInfo = Float
    type AttrLabel PerspectiveFovyFieldInfo = "fovy"
    type AttrOrigin PerspectiveFovyFieldInfo = Perspective
    attrGet = getPerspectiveFovy
    attrSet = setPerspectiveFovy
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Perspective.fovy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Perspective.html#g:attr:fovy"
        })

perspective_fovy :: AttrLabelProxy "fovy"
perspective_fovy = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data PerspectiveAspectFieldInfo
instance AttrInfo PerspectiveAspectFieldInfo where
    type AttrBaseTypeConstraint PerspectiveAspectFieldInfo = (~) Perspective
    type AttrAllowedOps PerspectiveAspectFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PerspectiveAspectFieldInfo = (~) Float
    type AttrTransferTypeConstraint PerspectiveAspectFieldInfo = (~)Float
    type AttrTransferType PerspectiveAspectFieldInfo = Float
    type AttrGetType PerspectiveAspectFieldInfo = Float
    type AttrLabel PerspectiveAspectFieldInfo = "aspect"
    type AttrOrigin PerspectiveAspectFieldInfo = Perspective
    attrGet = getPerspectiveAspect
    attrSet = setPerspectiveAspect
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Perspective.aspect"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Perspective.html#g:attr:aspect"
        })

perspective_aspect :: AttrLabelProxy "aspect"
perspective_aspect = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data PerspectiveZNearFieldInfo
instance AttrInfo PerspectiveZNearFieldInfo where
    type AttrBaseTypeConstraint PerspectiveZNearFieldInfo = (~) Perspective
    type AttrAllowedOps PerspectiveZNearFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PerspectiveZNearFieldInfo = (~) Float
    type AttrTransferTypeConstraint PerspectiveZNearFieldInfo = (~)Float
    type AttrTransferType PerspectiveZNearFieldInfo = Float
    type AttrGetType PerspectiveZNearFieldInfo = Float
    type AttrLabel PerspectiveZNearFieldInfo = "z_near"
    type AttrOrigin PerspectiveZNearFieldInfo = Perspective
    attrGet = getPerspectiveZNear
    attrSet = setPerspectiveZNear
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Perspective.zNear"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Perspective.html#g:attr:zNear"
        })

perspective_zNear :: AttrLabelProxy "zNear"
perspective_zNear = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data PerspectiveZFarFieldInfo
instance AttrInfo PerspectiveZFarFieldInfo where
    type AttrBaseTypeConstraint PerspectiveZFarFieldInfo = (~) Perspective
    type AttrAllowedOps PerspectiveZFarFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PerspectiveZFarFieldInfo = (~) Float
    type AttrTransferTypeConstraint PerspectiveZFarFieldInfo = (~)Float
    type AttrTransferType PerspectiveZFarFieldInfo = Float
    type AttrGetType PerspectiveZFarFieldInfo = Float
    type AttrLabel PerspectiveZFarFieldInfo = "z_far"
    type AttrOrigin PerspectiveZFarFieldInfo = Perspective
    attrGet = getPerspectiveZFar
    attrSet = setPerspectiveZFar
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Perspective.zFar"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Structs-Perspective.html#g:attr:zFar"
        })

perspective_zFar :: AttrLabelProxy "zFar"
perspective_zFar = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Perspective
type instance O.AttributeList Perspective = PerspectiveAttributeList
type PerspectiveAttributeList = ('[ '("fovy", PerspectiveFovyFieldInfo), '("aspect", PerspectiveAspectFieldInfo), '("zNear", PerspectiveZNearFieldInfo), '("zFar", PerspectiveZFarFieldInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePerspectiveMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePerspectiveMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolvePerspectiveMethod t Perspective, O.OverloadedMethod info Perspective p, R.HasField t Perspective p) => R.HasField t Perspective p where
    getField = O.overloadedMethod @info

#endif

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

#endif