{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gtk.Objects.AspectFrame.AspectFrame' is useful when you want
-- pack a widget so that it can resize but always retains
-- the same aspect ratio. For instance, one might be
-- drawing a small preview of a larger image. t'GI.Gtk.Objects.AspectFrame.AspectFrame'
-- derives from t'GI.Gtk.Objects.Frame.Frame', so it can draw a label and
-- a frame around the child. The frame will be
-- “shrink-wrapped” to the size of the child.
-- 
-- = CSS nodes
-- 
-- GtkAspectFrame uses a CSS node with name frame.

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

module GI.Gtk.Objects.AspectFrame
    ( 

-- * Exported types
    AspectFrame(..)                         ,
    IsAspectFrame                           ,
    toAspectFrame                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAspectFrameMethod                ,
#endif


-- ** getChild #method:getChild#

#if defined(ENABLE_OVERLOADING)
    AspectFrameGetChildMethodInfo           ,
#endif
    aspectFrameGetChild                     ,


-- ** getObeyChild #method:getObeyChild#

#if defined(ENABLE_OVERLOADING)
    AspectFrameGetObeyChildMethodInfo       ,
#endif
    aspectFrameGetObeyChild                 ,


-- ** getRatio #method:getRatio#

#if defined(ENABLE_OVERLOADING)
    AspectFrameGetRatioMethodInfo           ,
#endif
    aspectFrameGetRatio                     ,


-- ** getXalign #method:getXalign#

#if defined(ENABLE_OVERLOADING)
    AspectFrameGetXalignMethodInfo          ,
#endif
    aspectFrameGetXalign                    ,


-- ** getYalign #method:getYalign#

#if defined(ENABLE_OVERLOADING)
    AspectFrameGetYalignMethodInfo          ,
#endif
    aspectFrameGetYalign                    ,


-- ** new #method:new#

    aspectFrameNew                          ,


-- ** setChild #method:setChild#

#if defined(ENABLE_OVERLOADING)
    AspectFrameSetChildMethodInfo           ,
#endif
    aspectFrameSetChild                     ,


-- ** setObeyChild #method:setObeyChild#

#if defined(ENABLE_OVERLOADING)
    AspectFrameSetObeyChildMethodInfo       ,
#endif
    aspectFrameSetObeyChild                 ,


-- ** setRatio #method:setRatio#

#if defined(ENABLE_OVERLOADING)
    AspectFrameSetRatioMethodInfo           ,
#endif
    aspectFrameSetRatio                     ,


-- ** setXalign #method:setXalign#

#if defined(ENABLE_OVERLOADING)
    AspectFrameSetXalignMethodInfo          ,
#endif
    aspectFrameSetXalign                    ,


-- ** setYalign #method:setYalign#

#if defined(ENABLE_OVERLOADING)
    AspectFrameSetYalignMethodInfo          ,
#endif
    aspectFrameSetYalign                    ,




 -- * Properties
-- ** child #attr:child#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AspectFrameChildPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    aspectFrameChild                        ,
#endif
    clearAspectFrameChild                   ,
    constructAspectFrameChild               ,
    getAspectFrameChild                     ,
    setAspectFrameChild                     ,


-- ** obeyChild #attr:obeyChild#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AspectFrameObeyChildPropertyInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    aspectFrameObeyChild                    ,
#endif
    constructAspectFrameObeyChild           ,
    getAspectFrameObeyChild                 ,
    setAspectFrameObeyChild                 ,


-- ** ratio #attr:ratio#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AspectFrameRatioPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    aspectFrameRatio                        ,
#endif
    constructAspectFrameRatio               ,
    getAspectFrameRatio                     ,
    setAspectFrameRatio                     ,


-- ** xalign #attr:xalign#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AspectFrameXalignPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    aspectFrameXalign                       ,
#endif
    constructAspectFrameXalign              ,
    getAspectFrameXalign                    ,
    setAspectFrameXalign                    ,


-- ** yalign #attr:yalign#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AspectFrameYalignPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    aspectFrameYalign                       ,
#endif
    constructAspectFrameYalign              ,
    getAspectFrameYalign                    ,
    setAspectFrameYalign                    ,




    ) where

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

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

import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "gtk_aspect_frame_get_type"
    c_gtk_aspect_frame_get_type :: IO B.Types.GType

instance B.Types.TypedObject AspectFrame where
    glibType :: IO GType
glibType = IO GType
c_gtk_aspect_frame_get_type

instance B.Types.GObject AspectFrame

-- | Convert 'AspectFrame' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue AspectFrame where
    toGValue :: AspectFrame -> IO GValue
toGValue AspectFrame
o = do
        GType
gtype <- IO GType
c_gtk_aspect_frame_get_type
        AspectFrame -> (Ptr AspectFrame -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AspectFrame
o (GType
-> (GValue -> Ptr AspectFrame -> IO ())
-> Ptr AspectFrame
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr AspectFrame -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO AspectFrame
fromGValue GValue
gv = do
        Ptr AspectFrame
ptr <- GValue -> IO (Ptr AspectFrame)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr AspectFrame)
        (ManagedPtr AspectFrame -> AspectFrame)
-> Ptr AspectFrame -> IO AspectFrame
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr AspectFrame -> AspectFrame
AspectFrame Ptr AspectFrame
ptr
        
    

-- | Type class for types which can be safely cast to `AspectFrame`, for instance with `toAspectFrame`.
class (SP.GObject o, O.IsDescendantOf AspectFrame o) => IsAspectFrame o
instance (SP.GObject o, O.IsDescendantOf AspectFrame o) => IsAspectFrame o

instance O.HasParentTypes AspectFrame
type instance O.ParentTypes AspectFrame = '[Gtk.Widget.Widget, GObject.Object.Object, Atk.ImplementorIface.ImplementorIface, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget]

-- | Cast to `AspectFrame`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toAspectFrame :: (MonadIO m, IsAspectFrame o) => o -> m AspectFrame
toAspectFrame :: o -> m AspectFrame
toAspectFrame = IO AspectFrame -> m AspectFrame
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AspectFrame -> m AspectFrame)
-> (o -> IO AspectFrame) -> o -> m AspectFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr AspectFrame -> AspectFrame) -> o -> IO AspectFrame
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr AspectFrame -> AspectFrame
AspectFrame

#if defined(ENABLE_OVERLOADING)
type family ResolveAspectFrameMethod (t :: Symbol) (o :: *) :: * where
    ResolveAspectFrameMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveAspectFrameMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveAspectFrameMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveAspectFrameMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveAspectFrameMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveAspectFrameMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveAspectFrameMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolveAspectFrameMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveAspectFrameMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveAspectFrameMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveAspectFrameMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAspectFrameMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAspectFrameMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveAspectFrameMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveAspectFrameMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveAspectFrameMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveAspectFrameMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveAspectFrameMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveAspectFrameMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveAspectFrameMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveAspectFrameMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveAspectFrameMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveAspectFrameMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveAspectFrameMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveAspectFrameMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveAspectFrameMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveAspectFrameMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveAspectFrameMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAspectFrameMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAspectFrameMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAspectFrameMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveAspectFrameMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveAspectFrameMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveAspectFrameMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveAspectFrameMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveAspectFrameMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveAspectFrameMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveAspectFrameMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveAspectFrameMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveAspectFrameMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveAspectFrameMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveAspectFrameMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveAspectFrameMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveAspectFrameMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAspectFrameMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveAspectFrameMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveAspectFrameMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveAspectFrameMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveAspectFrameMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveAspectFrameMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveAspectFrameMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveAspectFrameMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveAspectFrameMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAspectFrameMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAspectFrameMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveAspectFrameMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveAspectFrameMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveAspectFrameMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveAspectFrameMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveAspectFrameMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveAspectFrameMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveAspectFrameMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveAspectFrameMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAspectFrameMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAspectFrameMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveAspectFrameMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveAspectFrameMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveAspectFrameMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveAspectFrameMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAspectFrameMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolveAspectFrameMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveAspectFrameMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveAspectFrameMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveAspectFrameMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAspectFrameMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAspectFrameMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAspectFrameMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveAspectFrameMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveAspectFrameMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveAspectFrameMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveAspectFrameMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveAspectFrameMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAspectFrameMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveAspectFrameMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAspectFrameMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolveAspectFrameMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveAspectFrameMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveAspectFrameMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveAspectFrameMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveAspectFrameMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveAspectFrameMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveAspectFrameMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveAspectFrameMethod "getChild" o = AspectFrameGetChildMethodInfo
    ResolveAspectFrameMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveAspectFrameMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveAspectFrameMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveAspectFrameMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolveAspectFrameMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveAspectFrameMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAspectFrameMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveAspectFrameMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveAspectFrameMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveAspectFrameMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveAspectFrameMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveAspectFrameMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolveAspectFrameMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveAspectFrameMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveAspectFrameMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveAspectFrameMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveAspectFrameMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveAspectFrameMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveAspectFrameMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveAspectFrameMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveAspectFrameMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveAspectFrameMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveAspectFrameMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveAspectFrameMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveAspectFrameMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveAspectFrameMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveAspectFrameMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveAspectFrameMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveAspectFrameMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveAspectFrameMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolveAspectFrameMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveAspectFrameMethod "getObeyChild" o = AspectFrameGetObeyChildMethodInfo
    ResolveAspectFrameMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveAspectFrameMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveAspectFrameMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveAspectFrameMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveAspectFrameMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveAspectFrameMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveAspectFrameMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveAspectFrameMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAspectFrameMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAspectFrameMethod "getRatio" o = AspectFrameGetRatioMethodInfo
    ResolveAspectFrameMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveAspectFrameMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveAspectFrameMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveAspectFrameMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveAspectFrameMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveAspectFrameMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveAspectFrameMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveAspectFrameMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveAspectFrameMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveAspectFrameMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveAspectFrameMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolveAspectFrameMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveAspectFrameMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveAspectFrameMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveAspectFrameMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveAspectFrameMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveAspectFrameMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveAspectFrameMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveAspectFrameMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveAspectFrameMethod "getXalign" o = AspectFrameGetXalignMethodInfo
    ResolveAspectFrameMethod "getYalign" o = AspectFrameGetYalignMethodInfo
    ResolveAspectFrameMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveAspectFrameMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveAspectFrameMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveAspectFrameMethod "setChild" o = AspectFrameSetChildMethodInfo
    ResolveAspectFrameMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveAspectFrameMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolveAspectFrameMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveAspectFrameMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveAspectFrameMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAspectFrameMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAspectFrameMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveAspectFrameMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveAspectFrameMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveAspectFrameMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveAspectFrameMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveAspectFrameMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveAspectFrameMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveAspectFrameMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveAspectFrameMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveAspectFrameMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveAspectFrameMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveAspectFrameMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveAspectFrameMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveAspectFrameMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveAspectFrameMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveAspectFrameMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveAspectFrameMethod "setObeyChild" o = AspectFrameSetObeyChildMethodInfo
    ResolveAspectFrameMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveAspectFrameMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveAspectFrameMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveAspectFrameMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAspectFrameMethod "setRatio" o = AspectFrameSetRatioMethodInfo
    ResolveAspectFrameMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveAspectFrameMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveAspectFrameMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveAspectFrameMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveAspectFrameMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolveAspectFrameMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveAspectFrameMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveAspectFrameMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveAspectFrameMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveAspectFrameMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveAspectFrameMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveAspectFrameMethod "setXalign" o = AspectFrameSetXalignMethodInfo
    ResolveAspectFrameMethod "setYalign" o = AspectFrameSetYalignMethodInfo
    ResolveAspectFrameMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "child"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Widget"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@child@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' aspectFrame #child
-- @
getAspectFrameChild :: (MonadIO m, IsAspectFrame o) => o -> m (Maybe Gtk.Widget.Widget)
getAspectFrameChild :: o -> m (Maybe Widget)
getAspectFrameChild o
obj = IO (Maybe Widget) -> m (Maybe Widget)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Widget -> Widget) -> IO (Maybe Widget)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"child" ManagedPtr Widget -> Widget
Gtk.Widget.Widget

-- | Set the value of the “@child@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' aspectFrame [ #child 'Data.GI.Base.Attributes.:=' value ]
-- @
setAspectFrameChild :: (MonadIO m, IsAspectFrame o, Gtk.Widget.IsWidget a) => o -> a -> m ()
setAspectFrameChild :: o -> a -> m ()
setAspectFrameChild o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"child" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@child@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAspectFrameChild :: (IsAspectFrame o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructAspectFrameChild :: a -> m (GValueConstruct o)
constructAspectFrameChild a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"child" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@child@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #child
-- @
clearAspectFrameChild :: (MonadIO m, IsAspectFrame o) => o -> m ()
clearAspectFrameChild :: o -> m ()
clearAspectFrameChild o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"child" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

#if defined(ENABLE_OVERLOADING)
data AspectFrameChildPropertyInfo
instance AttrInfo AspectFrameChildPropertyInfo where
    type AttrAllowedOps AspectFrameChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AspectFrameChildPropertyInfo = IsAspectFrame
    type AttrSetTypeConstraint AspectFrameChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint AspectFrameChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType AspectFrameChildPropertyInfo = Gtk.Widget.Widget
    type AttrGetType AspectFrameChildPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel AspectFrameChildPropertyInfo = "child"
    type AttrOrigin AspectFrameChildPropertyInfo = AspectFrame
    attrGet = getAspectFrameChild
    attrSet = setAspectFrameChild
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructAspectFrameChild
    attrClear = clearAspectFrameChild
#endif

-- VVV Prop "obey-child"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@obey-child@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' aspectFrame #obeyChild
-- @
getAspectFrameObeyChild :: (MonadIO m, IsAspectFrame o) => o -> m Bool
getAspectFrameObeyChild :: o -> m Bool
getAspectFrameObeyChild o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"obey-child"

-- | Set the value of the “@obey-child@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' aspectFrame [ #obeyChild 'Data.GI.Base.Attributes.:=' value ]
-- @
setAspectFrameObeyChild :: (MonadIO m, IsAspectFrame o) => o -> Bool -> m ()
setAspectFrameObeyChild :: o -> Bool -> m ()
setAspectFrameObeyChild o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"obey-child" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@obey-child@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAspectFrameObeyChild :: (IsAspectFrame o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructAspectFrameObeyChild :: Bool -> m (GValueConstruct o)
constructAspectFrameObeyChild Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"obey-child" Bool
val

#if defined(ENABLE_OVERLOADING)
data AspectFrameObeyChildPropertyInfo
instance AttrInfo AspectFrameObeyChildPropertyInfo where
    type AttrAllowedOps AspectFrameObeyChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AspectFrameObeyChildPropertyInfo = IsAspectFrame
    type AttrSetTypeConstraint AspectFrameObeyChildPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AspectFrameObeyChildPropertyInfo = (~) Bool
    type AttrTransferType AspectFrameObeyChildPropertyInfo = Bool
    type AttrGetType AspectFrameObeyChildPropertyInfo = Bool
    type AttrLabel AspectFrameObeyChildPropertyInfo = "obey-child"
    type AttrOrigin AspectFrameObeyChildPropertyInfo = AspectFrame
    attrGet = getAspectFrameObeyChild
    attrSet = setAspectFrameObeyChild
    attrTransfer _ v = do
        return v
    attrConstruct = constructAspectFrameObeyChild
    attrClear = undefined
#endif

-- VVV Prop "ratio"
   -- Type: TBasicType TFloat
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@ratio@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' aspectFrame #ratio
-- @
getAspectFrameRatio :: (MonadIO m, IsAspectFrame o) => o -> m Float
getAspectFrameRatio :: o -> m Float
getAspectFrameRatio o
obj = IO Float -> m Float
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
$ o -> String -> IO Float
forall a. GObject a => a -> String -> IO Float
B.Properties.getObjectPropertyFloat o
obj String
"ratio"

-- | Set the value of the “@ratio@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' aspectFrame [ #ratio 'Data.GI.Base.Attributes.:=' value ]
-- @
setAspectFrameRatio :: (MonadIO m, IsAspectFrame o) => o -> Float -> m ()
setAspectFrameRatio :: o -> Float -> m ()
setAspectFrameRatio o
obj Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"ratio" Float
val

-- | Construct a `GValueConstruct` with valid value for the “@ratio@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAspectFrameRatio :: (IsAspectFrame o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructAspectFrameRatio :: Float -> m (GValueConstruct o)
constructAspectFrameRatio Float
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"ratio" Float
val

#if defined(ENABLE_OVERLOADING)
data AspectFrameRatioPropertyInfo
instance AttrInfo AspectFrameRatioPropertyInfo where
    type AttrAllowedOps AspectFrameRatioPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AspectFrameRatioPropertyInfo = IsAspectFrame
    type AttrSetTypeConstraint AspectFrameRatioPropertyInfo = (~) Float
    type AttrTransferTypeConstraint AspectFrameRatioPropertyInfo = (~) Float
    type AttrTransferType AspectFrameRatioPropertyInfo = Float
    type AttrGetType AspectFrameRatioPropertyInfo = Float
    type AttrLabel AspectFrameRatioPropertyInfo = "ratio"
    type AttrOrigin AspectFrameRatioPropertyInfo = AspectFrame
    attrGet = getAspectFrameRatio
    attrSet = setAspectFrameRatio
    attrTransfer _ v = do
        return v
    attrConstruct = constructAspectFrameRatio
    attrClear = undefined
#endif

-- VVV Prop "xalign"
   -- Type: TBasicType TFloat
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@xalign@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' aspectFrame #xalign
-- @
getAspectFrameXalign :: (MonadIO m, IsAspectFrame o) => o -> m Float
getAspectFrameXalign :: o -> m Float
getAspectFrameXalign o
obj = IO Float -> m Float
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
$ o -> String -> IO Float
forall a. GObject a => a -> String -> IO Float
B.Properties.getObjectPropertyFloat o
obj String
"xalign"

-- | Set the value of the “@xalign@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' aspectFrame [ #xalign 'Data.GI.Base.Attributes.:=' value ]
-- @
setAspectFrameXalign :: (MonadIO m, IsAspectFrame o) => o -> Float -> m ()
setAspectFrameXalign :: o -> Float -> m ()
setAspectFrameXalign o
obj Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"xalign" Float
val

-- | Construct a `GValueConstruct` with valid value for the “@xalign@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAspectFrameXalign :: (IsAspectFrame o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructAspectFrameXalign :: Float -> m (GValueConstruct o)
constructAspectFrameXalign Float
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"xalign" Float
val

#if defined(ENABLE_OVERLOADING)
data AspectFrameXalignPropertyInfo
instance AttrInfo AspectFrameXalignPropertyInfo where
    type AttrAllowedOps AspectFrameXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AspectFrameXalignPropertyInfo = IsAspectFrame
    type AttrSetTypeConstraint AspectFrameXalignPropertyInfo = (~) Float
    type AttrTransferTypeConstraint AspectFrameXalignPropertyInfo = (~) Float
    type AttrTransferType AspectFrameXalignPropertyInfo = Float
    type AttrGetType AspectFrameXalignPropertyInfo = Float
    type AttrLabel AspectFrameXalignPropertyInfo = "xalign"
    type AttrOrigin AspectFrameXalignPropertyInfo = AspectFrame
    attrGet = getAspectFrameXalign
    attrSet = setAspectFrameXalign
    attrTransfer _ v = do
        return v
    attrConstruct = constructAspectFrameXalign
    attrClear = undefined
#endif

-- VVV Prop "yalign"
   -- Type: TBasicType TFloat
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@yalign@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' aspectFrame #yalign
-- @
getAspectFrameYalign :: (MonadIO m, IsAspectFrame o) => o -> m Float
getAspectFrameYalign :: o -> m Float
getAspectFrameYalign o
obj = IO Float -> m Float
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
$ o -> String -> IO Float
forall a. GObject a => a -> String -> IO Float
B.Properties.getObjectPropertyFloat o
obj String
"yalign"

-- | Set the value of the “@yalign@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' aspectFrame [ #yalign 'Data.GI.Base.Attributes.:=' value ]
-- @
setAspectFrameYalign :: (MonadIO m, IsAspectFrame o) => o -> Float -> m ()
setAspectFrameYalign :: o -> Float -> m ()
setAspectFrameYalign o
obj Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"yalign" Float
val

-- | Construct a `GValueConstruct` with valid value for the “@yalign@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAspectFrameYalign :: (IsAspectFrame o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructAspectFrameYalign :: Float -> m (GValueConstruct o)
constructAspectFrameYalign Float
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"yalign" Float
val

#if defined(ENABLE_OVERLOADING)
data AspectFrameYalignPropertyInfo
instance AttrInfo AspectFrameYalignPropertyInfo where
    type AttrAllowedOps AspectFrameYalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AspectFrameYalignPropertyInfo = IsAspectFrame
    type AttrSetTypeConstraint AspectFrameYalignPropertyInfo = (~) Float
    type AttrTransferTypeConstraint AspectFrameYalignPropertyInfo = (~) Float
    type AttrTransferType AspectFrameYalignPropertyInfo = Float
    type AttrGetType AspectFrameYalignPropertyInfo = Float
    type AttrLabel AspectFrameYalignPropertyInfo = "yalign"
    type AttrOrigin AspectFrameYalignPropertyInfo = AspectFrame
    attrGet = getAspectFrameYalign
    attrSet = setAspectFrameYalign
    attrTransfer _ v = do
        return v
    attrConstruct = constructAspectFrameYalign
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AspectFrame
type instance O.AttributeList AspectFrame = AspectFrameAttributeList
type AspectFrameAttributeList = ('[ '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("child", AspectFrameChildPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("obeyChild", AspectFrameObeyChildPropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("ratio", AspectFrameRatioPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo), '("xalign", AspectFrameXalignPropertyInfo), '("yalign", AspectFrameYalignPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
aspectFrameChild :: AttrLabelProxy "child"
aspectFrameChild = AttrLabelProxy

aspectFrameObeyChild :: AttrLabelProxy "obeyChild"
aspectFrameObeyChild = AttrLabelProxy

aspectFrameRatio :: AttrLabelProxy "ratio"
aspectFrameRatio = AttrLabelProxy

aspectFrameXalign :: AttrLabelProxy "xalign"
aspectFrameXalign = AttrLabelProxy

aspectFrameYalign :: AttrLabelProxy "yalign"
aspectFrameYalign = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AspectFrame = AspectFrameSignalList
type AspectFrameSignalList = ('[ '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

-- method AspectFrame::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "xalign"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Horizontal alignment of the child within the allocation of\n the #GtkAspectFrame. This ranges from 0.0 (left aligned)\n to 1.0 (right aligned)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "yalign"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Vertical alignment of the child within the allocation of\n the #GtkAspectFrame. This ranges from 0.0 (top aligned)\n to 1.0 (bottom aligned)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ratio"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The desired aspect ratio."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "obey_child"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "If %TRUE, @ratio is ignored, and the aspect\n ratio is taken from the requistion of the child."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "AspectFrame" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_aspect_frame_new" gtk_aspect_frame_new :: 
    CFloat ->                               -- xalign : TBasicType TFloat
    CFloat ->                               -- yalign : TBasicType TFloat
    CFloat ->                               -- ratio : TBasicType TFloat
    CInt ->                                 -- obey_child : TBasicType TBoolean
    IO (Ptr AspectFrame)

-- | Create a new t'GI.Gtk.Objects.AspectFrame.AspectFrame'.
aspectFrameNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Float
    -- ^ /@xalign@/: Horizontal alignment of the child within the allocation of
    --  the t'GI.Gtk.Objects.AspectFrame.AspectFrame'. This ranges from 0.0 (left aligned)
    --  to 1.0 (right aligned)
    -> Float
    -- ^ /@yalign@/: Vertical alignment of the child within the allocation of
    --  the t'GI.Gtk.Objects.AspectFrame.AspectFrame'. This ranges from 0.0 (top aligned)
    --  to 1.0 (bottom aligned)
    -> Float
    -- ^ /@ratio@/: The desired aspect ratio.
    -> Bool
    -- ^ /@obeyChild@/: If 'P.True', /@ratio@/ is ignored, and the aspect
    --  ratio is taken from the requistion of the child.
    -> m AspectFrame
    -- ^ __Returns:__ the new t'GI.Gtk.Objects.AspectFrame.AspectFrame'.
aspectFrameNew :: Float -> Float -> Float -> Bool -> m AspectFrame
aspectFrameNew Float
xalign Float
yalign Float
ratio Bool
obeyChild = IO AspectFrame -> m AspectFrame
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AspectFrame -> m AspectFrame)
-> IO AspectFrame -> m AspectFrame
forall a b. (a -> b) -> a -> b
$ do
    let xalign' :: CFloat
xalign' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
xalign
    let yalign' :: CFloat
yalign' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
yalign
    let ratio' :: CFloat
ratio' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
ratio
    let obeyChild' :: CInt
obeyChild' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
obeyChild
    Ptr AspectFrame
result <- CFloat -> CFloat -> CFloat -> CInt -> IO (Ptr AspectFrame)
gtk_aspect_frame_new CFloat
xalign' CFloat
yalign' CFloat
ratio' CInt
obeyChild'
    Text -> Ptr AspectFrame -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"aspectFrameNew" Ptr AspectFrame
result
    AspectFrame
result' <- ((ManagedPtr AspectFrame -> AspectFrame)
-> Ptr AspectFrame -> IO AspectFrame
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AspectFrame -> AspectFrame
AspectFrame) Ptr AspectFrame
result
    AspectFrame -> IO AspectFrame
forall (m :: * -> *) a. Monad m => a -> m a
return AspectFrame
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_aspect_frame_get_child" gtk_aspect_frame_get_child :: 
    Ptr AspectFrame ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AspectFrame"})
    IO (Ptr Gtk.Widget.Widget)

-- | Gets the child widget of /@self@/.
aspectFrameGetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsAspectFrame a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.AspectFrame.AspectFrame'
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ the child widget of self\@
aspectFrameGetChild :: a -> m (Maybe Widget)
aspectFrameGetChild a
self = IO (Maybe Widget) -> m (Maybe Widget)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AspectFrame
self' <- a -> IO (Ptr AspectFrame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr AspectFrame -> IO (Ptr Widget)
gtk_aspect_frame_get_child Ptr AspectFrame
self'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Widget -> IO (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data AspectFrameGetChildMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsAspectFrame a) => O.MethodInfo AspectFrameGetChildMethodInfo a signature where
    overloadedMethod = aspectFrameGetChild

#endif

-- method AspectFrame::get_obey_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AspectFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAspectFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_aspect_frame_get_obey_child" gtk_aspect_frame_get_obey_child :: 
    Ptr AspectFrame ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AspectFrame"})
    IO CInt

-- | Returns whether the childs size request should override
-- the set aspect ratio of the t'GI.Gtk.Objects.AspectFrame.AspectFrame'.
aspectFrameGetObeyChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsAspectFrame a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.AspectFrame.AspectFrame'
    -> m Bool
    -- ^ __Returns:__ whether to obey the childs size request
aspectFrameGetObeyChild :: a -> m Bool
aspectFrameGetObeyChild a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AspectFrame
self' <- a -> IO (Ptr AspectFrame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr AspectFrame -> IO CInt
gtk_aspect_frame_get_obey_child Ptr AspectFrame
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AspectFrameGetObeyChildMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAspectFrame a) => O.MethodInfo AspectFrameGetObeyChildMethodInfo a signature where
    overloadedMethod = aspectFrameGetObeyChild

#endif

-- method AspectFrame::get_ratio
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AspectFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAspectFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_aspect_frame_get_ratio" gtk_aspect_frame_get_ratio :: 
    Ptr AspectFrame ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AspectFrame"})
    IO CFloat

-- | Returns the desired aspect ratio of the child.
aspectFrameGetRatio ::
    (B.CallStack.HasCallStack, MonadIO m, IsAspectFrame a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.AspectFrame.AspectFrame'
    -> m Float
    -- ^ __Returns:__ the desired aspect ratio
aspectFrameGetRatio :: a -> m Float
aspectFrameGetRatio a
self = IO Float -> m Float
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
$ do
    Ptr AspectFrame
self' <- a -> IO (Ptr AspectFrame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CFloat
result <- Ptr AspectFrame -> IO CFloat
gtk_aspect_frame_get_ratio Ptr AspectFrame
self'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data AspectFrameGetRatioMethodInfo
instance (signature ~ (m Float), MonadIO m, IsAspectFrame a) => O.MethodInfo AspectFrameGetRatioMethodInfo a signature where
    overloadedMethod = aspectFrameGetRatio

#endif

-- method AspectFrame::get_xalign
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AspectFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAspectFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_aspect_frame_get_xalign" gtk_aspect_frame_get_xalign :: 
    Ptr AspectFrame ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AspectFrame"})
    IO CFloat

-- | Returns the horizontal alignment of the child within the
-- allocation of the t'GI.Gtk.Objects.AspectFrame.AspectFrame'.
aspectFrameGetXalign ::
    (B.CallStack.HasCallStack, MonadIO m, IsAspectFrame a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.AspectFrame.AspectFrame'
    -> m Float
    -- ^ __Returns:__ the horizontal alignment
aspectFrameGetXalign :: a -> m Float
aspectFrameGetXalign a
self = IO Float -> m Float
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
$ do
    Ptr AspectFrame
self' <- a -> IO (Ptr AspectFrame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CFloat
result <- Ptr AspectFrame -> IO CFloat
gtk_aspect_frame_get_xalign Ptr AspectFrame
self'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data AspectFrameGetXalignMethodInfo
instance (signature ~ (m Float), MonadIO m, IsAspectFrame a) => O.MethodInfo AspectFrameGetXalignMethodInfo a signature where
    overloadedMethod = aspectFrameGetXalign

#endif

-- method AspectFrame::get_yalign
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AspectFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAspectFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_aspect_frame_get_yalign" gtk_aspect_frame_get_yalign :: 
    Ptr AspectFrame ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AspectFrame"})
    IO CFloat

-- | Returns the vertical alignment of the child within the
-- allocation of the t'GI.Gtk.Objects.AspectFrame.AspectFrame'.
aspectFrameGetYalign ::
    (B.CallStack.HasCallStack, MonadIO m, IsAspectFrame a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.AspectFrame.AspectFrame'
    -> m Float
    -- ^ __Returns:__ the vertical alignment
aspectFrameGetYalign :: a -> m Float
aspectFrameGetYalign a
self = IO Float -> m Float
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
$ do
    Ptr AspectFrame
self' <- a -> IO (Ptr AspectFrame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CFloat
result <- Ptr AspectFrame -> IO CFloat
gtk_aspect_frame_get_yalign Ptr AspectFrame
self'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data AspectFrameGetYalignMethodInfo
instance (signature ~ (m Float), MonadIO m, IsAspectFrame a) => O.MethodInfo AspectFrameGetYalignMethodInfo a signature where
    overloadedMethod = aspectFrameGetYalign

#endif

-- method AspectFrame::set_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AspectFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAspectFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the child widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_aspect_frame_set_child" gtk_aspect_frame_set_child :: 
    Ptr AspectFrame ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AspectFrame"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Sets the child widget of /@self@/.
aspectFrameSetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsAspectFrame a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.AspectFrame.AspectFrame'
    -> Maybe (b)
    -- ^ /@child@/: the child widget
    -> m ()
aspectFrameSetChild :: a -> Maybe b -> m ()
aspectFrameSetChild a
self Maybe b
child = 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 AspectFrame
self' <- a -> IO (Ptr AspectFrame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
maybeChild <- case Maybe b
child of
        Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just b
jChild -> do
            Ptr Widget
jChild' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jChild
            Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jChild'
    Ptr AspectFrame -> Ptr Widget -> IO ()
gtk_aspect_frame_set_child Ptr AspectFrame
self' Ptr Widget
maybeChild
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
child b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AspectFrameSetChildMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsAspectFrame a, Gtk.Widget.IsWidget b) => O.MethodInfo AspectFrameSetChildMethodInfo a signature where
    overloadedMethod = aspectFrameSetChild

#endif

-- method AspectFrame::set_obey_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AspectFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAspectFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "obey_child"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "If %TRUE, @ratio is ignored, and the aspect\n   ratio is taken from the requistion of the child."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_aspect_frame_set_obey_child" gtk_aspect_frame_set_obey_child :: 
    Ptr AspectFrame ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AspectFrame"})
    CInt ->                                 -- obey_child : TBasicType TBoolean
    IO ()

-- | Sets whether the aspect ratio of the childs size
-- request should override the set aspect ratio of
-- the t'GI.Gtk.Objects.AspectFrame.AspectFrame'.
aspectFrameSetObeyChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsAspectFrame a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.AspectFrame.AspectFrame'
    -> Bool
    -- ^ /@obeyChild@/: If 'P.True', /@ratio@/ is ignored, and the aspect
    --    ratio is taken from the requistion of the child.
    -> m ()
aspectFrameSetObeyChild :: a -> Bool -> m ()
aspectFrameSetObeyChild a
self Bool
obeyChild = 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 AspectFrame
self' <- a -> IO (Ptr AspectFrame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let obeyChild' :: CInt
obeyChild' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
obeyChild
    Ptr AspectFrame -> CInt -> IO ()
gtk_aspect_frame_set_obey_child Ptr AspectFrame
self' CInt
obeyChild'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AspectFrameSetObeyChildMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAspectFrame a) => O.MethodInfo AspectFrameSetObeyChildMethodInfo a signature where
    overloadedMethod = aspectFrameSetObeyChild

#endif

-- method AspectFrame::set_ratio
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AspectFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAspectFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ratio"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "aspect ratio of the child"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_aspect_frame_set_ratio" gtk_aspect_frame_set_ratio :: 
    Ptr AspectFrame ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AspectFrame"})
    CFloat ->                               -- ratio : TBasicType TFloat
    IO ()

-- | Sets the desired aspect ratio of the child.
aspectFrameSetRatio ::
    (B.CallStack.HasCallStack, MonadIO m, IsAspectFrame a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.AspectFrame.AspectFrame'
    -> Float
    -- ^ /@ratio@/: aspect ratio of the child
    -> m ()
aspectFrameSetRatio :: a -> Float -> m ()
aspectFrameSetRatio a
self Float
ratio = 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 AspectFrame
self' <- a -> IO (Ptr AspectFrame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let ratio' :: CFloat
ratio' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
ratio
    Ptr AspectFrame -> CFloat -> IO ()
gtk_aspect_frame_set_ratio Ptr AspectFrame
self' CFloat
ratio'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AspectFrameSetRatioMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsAspectFrame a) => O.MethodInfo AspectFrameSetRatioMethodInfo a signature where
    overloadedMethod = aspectFrameSetRatio

#endif

-- method AspectFrame::set_xalign
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AspectFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAspectFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "xalign"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "horizontal alignment, from 0.0 (left aligned) to 1.0 (right aligned)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_aspect_frame_set_xalign" gtk_aspect_frame_set_xalign :: 
    Ptr AspectFrame ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AspectFrame"})
    CFloat ->                               -- xalign : TBasicType TFloat
    IO ()

-- | Sets the horizontal alignment of the child within the allocation
-- of the t'GI.Gtk.Objects.AspectFrame.AspectFrame'.
aspectFrameSetXalign ::
    (B.CallStack.HasCallStack, MonadIO m, IsAspectFrame a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.AspectFrame.AspectFrame'
    -> Float
    -- ^ /@xalign@/: horizontal alignment, from 0.0 (left aligned) to 1.0 (right aligned)
    -> m ()
aspectFrameSetXalign :: a -> Float -> m ()
aspectFrameSetXalign a
self Float
xalign = 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 AspectFrame
self' <- a -> IO (Ptr AspectFrame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let xalign' :: CFloat
xalign' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
xalign
    Ptr AspectFrame -> CFloat -> IO ()
gtk_aspect_frame_set_xalign Ptr AspectFrame
self' CFloat
xalign'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AspectFrameSetXalignMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsAspectFrame a) => O.MethodInfo AspectFrameSetXalignMethodInfo a signature where
    overloadedMethod = aspectFrameSetXalign

#endif

-- method AspectFrame::set_yalign
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AspectFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAspectFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "yalign"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "horizontal alignment, from 0.0 (top aligned) to 1.0 (bottom aligned)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_aspect_frame_set_yalign" gtk_aspect_frame_set_yalign :: 
    Ptr AspectFrame ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AspectFrame"})
    CFloat ->                               -- yalign : TBasicType TFloat
    IO ()

-- | Sets the vertical alignment of the child within the allocation
-- of the t'GI.Gtk.Objects.AspectFrame.AspectFrame'.
aspectFrameSetYalign ::
    (B.CallStack.HasCallStack, MonadIO m, IsAspectFrame a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.AspectFrame.AspectFrame'
    -> Float
    -- ^ /@yalign@/: horizontal alignment, from 0.0 (top aligned) to 1.0 (bottom aligned)
    -> m ()
aspectFrameSetYalign :: a -> Float -> m ()
aspectFrameSetYalign a
self Float
yalign = 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 AspectFrame
self' <- a -> IO (Ptr AspectFrame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let yalign' :: CFloat
yalign' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
yalign
    Ptr AspectFrame -> CFloat -> IO ()
gtk_aspect_frame_set_yalign Ptr AspectFrame
self' CFloat
yalign'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AspectFrameSetYalignMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsAspectFrame a) => O.MethodInfo AspectFrameSetYalignMethodInfo a signature where
    overloadedMethod = aspectFrameSetYalign

#endif