{-# 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.Picture.Picture' widget displays a t'GI.Gdk.Interfaces.Paintable.Paintable'. Many convenience functions
-- are provided to make pictures simple to use. For example, if you want to load
-- an image from a file, and then display that, there’s a convenience function
-- to do this:
-- 
-- === /C code/
-- >
-- >  GtkWidget *widget;
-- >  widget = gtk_picture_new_for_filename ("myfile.png");
-- 
-- If the file isn’t loaded successfully, the picture will contain a
-- “broken image” icon similar to that used in many web browsers.
-- If you want to handle errors in loading the file yourself,
-- for example by displaying an error message, then load the image with
-- 'GI.Gdk.Objects.Texture.textureNewFromFile', then create the t'GI.Gtk.Objects.Picture.Picture' with
-- 'GI.Gtk.Objects.Picture.pictureNewForPaintable'.
-- 
-- Sometimes an application will want to avoid depending on external data
-- files, such as image files. See the documentation of t'GI.Gio.Structs.Resource.Resource' for details.
-- In this case, 'GI.Gtk.Objects.Picture.pictureNewForResource' and 'GI.Gtk.Objects.Picture.pictureSetResource'
-- should be used.
-- 
-- = CSS nodes
-- 
-- GtkPicture has a single CSS node with the name picture.

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

module GI.Gtk.Objects.Picture
    ( 

-- * Exported types
    Picture(..)                             ,
    IsPicture                               ,
    toPicture                               ,
    noPicture                               ,


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

#if defined(ENABLE_OVERLOADING)
    ResolvePictureMethod                    ,
#endif


-- ** getAlternativeText #method:getAlternativeText#

#if defined(ENABLE_OVERLOADING)
    PictureGetAlternativeTextMethodInfo     ,
#endif
    pictureGetAlternativeText               ,


-- ** getCanShrink #method:getCanShrink#

#if defined(ENABLE_OVERLOADING)
    PictureGetCanShrinkMethodInfo           ,
#endif
    pictureGetCanShrink                     ,


-- ** getFile #method:getFile#

#if defined(ENABLE_OVERLOADING)
    PictureGetFileMethodInfo                ,
#endif
    pictureGetFile                          ,


-- ** getKeepAspectRatio #method:getKeepAspectRatio#

#if defined(ENABLE_OVERLOADING)
    PictureGetKeepAspectRatioMethodInfo     ,
#endif
    pictureGetKeepAspectRatio               ,


-- ** getPaintable #method:getPaintable#

#if defined(ENABLE_OVERLOADING)
    PictureGetPaintableMethodInfo           ,
#endif
    pictureGetPaintable                     ,


-- ** new #method:new#

    pictureNew                              ,


-- ** newForFile #method:newForFile#

    pictureNewForFile                       ,


-- ** newForFilename #method:newForFilename#

    pictureNewForFilename                   ,


-- ** newForPaintable #method:newForPaintable#

    pictureNewForPaintable                  ,


-- ** newForPixbuf #method:newForPixbuf#

    pictureNewForPixbuf                     ,


-- ** newForResource #method:newForResource#

    pictureNewForResource                   ,


-- ** setAlternativeText #method:setAlternativeText#

#if defined(ENABLE_OVERLOADING)
    PictureSetAlternativeTextMethodInfo     ,
#endif
    pictureSetAlternativeText               ,


-- ** setCanShrink #method:setCanShrink#

#if defined(ENABLE_OVERLOADING)
    PictureSetCanShrinkMethodInfo           ,
#endif
    pictureSetCanShrink                     ,


-- ** setFile #method:setFile#

#if defined(ENABLE_OVERLOADING)
    PictureSetFileMethodInfo                ,
#endif
    pictureSetFile                          ,


-- ** setFilename #method:setFilename#

#if defined(ENABLE_OVERLOADING)
    PictureSetFilenameMethodInfo            ,
#endif
    pictureSetFilename                      ,


-- ** setKeepAspectRatio #method:setKeepAspectRatio#

#if defined(ENABLE_OVERLOADING)
    PictureSetKeepAspectRatioMethodInfo     ,
#endif
    pictureSetKeepAspectRatio               ,


-- ** setPaintable #method:setPaintable#

#if defined(ENABLE_OVERLOADING)
    PictureSetPaintableMethodInfo           ,
#endif
    pictureSetPaintable                     ,


-- ** setPixbuf #method:setPixbuf#

#if defined(ENABLE_OVERLOADING)
    PictureSetPixbufMethodInfo              ,
#endif
    pictureSetPixbuf                        ,


-- ** setResource #method:setResource#

#if defined(ENABLE_OVERLOADING)
    PictureSetResourceMethodInfo            ,
#endif
    pictureSetResource                      ,




 -- * Properties
-- ** alternativeText #attr:alternativeText#
-- | The alternative textual description for the picture.

#if defined(ENABLE_OVERLOADING)
    PictureAlternativeTextPropertyInfo      ,
#endif
    clearPictureAlternativeText             ,
    constructPictureAlternativeText         ,
    getPictureAlternativeText               ,
#if defined(ENABLE_OVERLOADING)
    pictureAlternativeText                  ,
#endif
    setPictureAlternativeText               ,


-- ** canShrink #attr:canShrink#
-- | If the t'GI.Gtk.Objects.Picture.Picture' can be made smaller than the self it contains.

#if defined(ENABLE_OVERLOADING)
    PictureCanShrinkPropertyInfo            ,
#endif
    constructPictureCanShrink               ,
    getPictureCanShrink                     ,
#if defined(ENABLE_OVERLOADING)
    pictureCanShrink                        ,
#endif
    setPictureCanShrink                     ,


-- ** file #attr:file#
-- | The t'GI.Gio.Interfaces.File.File' that is displayed or 'P.Nothing' if none.

#if defined(ENABLE_OVERLOADING)
    PictureFilePropertyInfo                 ,
#endif
    clearPictureFile                        ,
    constructPictureFile                    ,
    getPictureFile                          ,
#if defined(ENABLE_OVERLOADING)
    pictureFile                             ,
#endif
    setPictureFile                          ,


-- ** keepAspectRatio #attr:keepAspectRatio#
-- | Whether the GtkPicture will render its contents trying to preserve the aspect
-- ratio of the contents.

#if defined(ENABLE_OVERLOADING)
    PictureKeepAspectRatioPropertyInfo      ,
#endif
    constructPictureKeepAspectRatio         ,
    getPictureKeepAspectRatio               ,
#if defined(ENABLE_OVERLOADING)
    pictureKeepAspectRatio                  ,
#endif
    setPictureKeepAspectRatio               ,


-- ** paintable #attr:paintable#
-- | The t'GI.Gdk.Interfaces.Paintable.Paintable' to be displayed by this t'GI.Gtk.Objects.Picture.Picture'.

#if defined(ENABLE_OVERLOADING)
    PicturePaintablePropertyInfo            ,
#endif
    clearPicturePaintable                   ,
    constructPicturePaintable               ,
    getPicturePaintable                     ,
#if defined(ENABLE_OVERLOADING)
    picturePaintable                        ,
#endif
    setPicturePaintable                     ,




    ) where

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

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

import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Interfaces.File as Gio.File
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

instance GObject Picture where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_picture_get_type
    

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

-- | Type class for types which can be safely cast to `Picture`, for instance with `toPicture`.
class (GObject o, O.IsDescendantOf Picture o) => IsPicture o
instance (GObject o, O.IsDescendantOf Picture o) => IsPicture o

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `Picture`.
noPicture :: Maybe Picture
noPicture :: Maybe Picture
noPicture = Maybe Picture
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolvePictureMethod (t :: Symbol) (o :: *) :: * where
    ResolvePictureMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolvePictureMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolvePictureMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolvePictureMethod "addAccelerator" o = Gtk.Widget.WidgetAddAcceleratorMethodInfo
    ResolvePictureMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolvePictureMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolvePictureMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolvePictureMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolvePictureMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolvePictureMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePictureMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePictureMethod "canActivateAccel" o = Gtk.Widget.WidgetCanActivateAccelMethodInfo
    ResolvePictureMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolvePictureMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolvePictureMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolvePictureMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolvePictureMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolvePictureMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolvePictureMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolvePictureMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolvePictureMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolvePictureMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolvePictureMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolvePictureMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolvePictureMethod "destroy" o = Gtk.Widget.WidgetDestroyMethodInfo
    ResolvePictureMethod "destroyed" o = Gtk.Widget.WidgetDestroyedMethodInfo
    ResolvePictureMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolvePictureMethod "dragBegin" o = Gtk.Widget.WidgetDragBeginMethodInfo
    ResolvePictureMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolvePictureMethod "dragDestAddImageTargets" o = Gtk.Widget.WidgetDragDestAddImageTargetsMethodInfo
    ResolvePictureMethod "dragDestAddTextTargets" o = Gtk.Widget.WidgetDragDestAddTextTargetsMethodInfo
    ResolvePictureMethod "dragDestAddUriTargets" o = Gtk.Widget.WidgetDragDestAddUriTargetsMethodInfo
    ResolvePictureMethod "dragDestFindTarget" o = Gtk.Widget.WidgetDragDestFindTargetMethodInfo
    ResolvePictureMethod "dragDestGetTargetList" o = Gtk.Widget.WidgetDragDestGetTargetListMethodInfo
    ResolvePictureMethod "dragDestGetTrackMotion" o = Gtk.Widget.WidgetDragDestGetTrackMotionMethodInfo
    ResolvePictureMethod "dragDestSet" o = Gtk.Widget.WidgetDragDestSetMethodInfo
    ResolvePictureMethod "dragDestSetTargetList" o = Gtk.Widget.WidgetDragDestSetTargetListMethodInfo
    ResolvePictureMethod "dragDestSetTrackMotion" o = Gtk.Widget.WidgetDragDestSetTrackMotionMethodInfo
    ResolvePictureMethod "dragDestUnset" o = Gtk.Widget.WidgetDragDestUnsetMethodInfo
    ResolvePictureMethod "dragGetData" o = Gtk.Widget.WidgetDragGetDataMethodInfo
    ResolvePictureMethod "dragHighlight" o = Gtk.Widget.WidgetDragHighlightMethodInfo
    ResolvePictureMethod "dragSourceAddImageTargets" o = Gtk.Widget.WidgetDragSourceAddImageTargetsMethodInfo
    ResolvePictureMethod "dragSourceAddTextTargets" o = Gtk.Widget.WidgetDragSourceAddTextTargetsMethodInfo
    ResolvePictureMethod "dragSourceAddUriTargets" o = Gtk.Widget.WidgetDragSourceAddUriTargetsMethodInfo
    ResolvePictureMethod "dragSourceGetTargetList" o = Gtk.Widget.WidgetDragSourceGetTargetListMethodInfo
    ResolvePictureMethod "dragSourceSet" o = Gtk.Widget.WidgetDragSourceSetMethodInfo
    ResolvePictureMethod "dragSourceSetIconGicon" o = Gtk.Widget.WidgetDragSourceSetIconGiconMethodInfo
    ResolvePictureMethod "dragSourceSetIconName" o = Gtk.Widget.WidgetDragSourceSetIconNameMethodInfo
    ResolvePictureMethod "dragSourceSetIconPaintable" o = Gtk.Widget.WidgetDragSourceSetIconPaintableMethodInfo
    ResolvePictureMethod "dragSourceSetTargetList" o = Gtk.Widget.WidgetDragSourceSetTargetListMethodInfo
    ResolvePictureMethod "dragSourceUnset" o = Gtk.Widget.WidgetDragSourceUnsetMethodInfo
    ResolvePictureMethod "dragUnhighlight" o = Gtk.Widget.WidgetDragUnhighlightMethodInfo
    ResolvePictureMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolvePictureMethod "event" o = Gtk.Widget.WidgetEventMethodInfo
    ResolvePictureMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePictureMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePictureMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePictureMethod "grabAdd" o = Gtk.Widget.WidgetGrabAddMethodInfo
    ResolvePictureMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolvePictureMethod "grabRemove" o = Gtk.Widget.WidgetGrabRemoveMethodInfo
    ResolvePictureMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolvePictureMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolvePictureMethod "hasGrab" o = Gtk.Widget.WidgetHasGrabMethodInfo
    ResolvePictureMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolvePictureMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolvePictureMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolvePictureMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolvePictureMethod "inputShapeCombineRegion" o = Gtk.Widget.WidgetInputShapeCombineRegionMethodInfo
    ResolvePictureMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolvePictureMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolvePictureMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolvePictureMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolvePictureMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolvePictureMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePictureMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolvePictureMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolvePictureMethod "isToplevel" o = Gtk.Widget.WidgetIsToplevelMethodInfo
    ResolvePictureMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolvePictureMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolvePictureMethod "listAccelClosures" o = Gtk.Widget.WidgetListAccelClosuresMethodInfo
    ResolvePictureMethod "listActionPrefixes" o = Gtk.Widget.WidgetListActionPrefixesMethodInfo
    ResolvePictureMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolvePictureMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolvePictureMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolvePictureMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolvePictureMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePictureMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePictureMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolvePictureMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolvePictureMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolvePictureMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolvePictureMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolvePictureMethod "queueComputeExpand" o = Gtk.Widget.WidgetQueueComputeExpandMethodInfo
    ResolvePictureMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolvePictureMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolvePictureMethod "queueResizeNoRedraw" o = Gtk.Widget.WidgetQueueResizeNoRedrawMethodInfo
    ResolvePictureMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolvePictureMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePictureMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePictureMethod "registerSurface" o = Gtk.Widget.WidgetRegisterSurfaceMethodInfo
    ResolvePictureMethod "removeAccelerator" o = Gtk.Widget.WidgetRemoveAcceleratorMethodInfo
    ResolvePictureMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolvePictureMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolvePictureMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolvePictureMethod "resetStyle" o = Gtk.Widget.WidgetResetStyleMethodInfo
    ResolvePictureMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePictureMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolvePictureMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolvePictureMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolvePictureMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePictureMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePictureMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePictureMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolvePictureMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolvePictureMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolvePictureMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolvePictureMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolvePictureMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePictureMethod "unregisterSurface" o = Gtk.Widget.WidgetUnregisterSurfaceMethodInfo
    ResolvePictureMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolvePictureMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePictureMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolvePictureMethod "getActionGroup" o = Gtk.Widget.WidgetGetActionGroupMethodInfo
    ResolvePictureMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolvePictureMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolvePictureMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolvePictureMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolvePictureMethod "getAlternativeText" o = PictureGetAlternativeTextMethodInfo
    ResolvePictureMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolvePictureMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolvePictureMethod "getCanShrink" o = PictureGetCanShrinkMethodInfo
    ResolvePictureMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolvePictureMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolvePictureMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolvePictureMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolvePictureMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePictureMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolvePictureMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolvePictureMethod "getFile" o = PictureGetFileMethodInfo
    ResolvePictureMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolvePictureMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolvePictureMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolvePictureMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolvePictureMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolvePictureMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolvePictureMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolvePictureMethod "getHasSurface" o = Gtk.Widget.WidgetGetHasSurfaceMethodInfo
    ResolvePictureMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolvePictureMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolvePictureMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolvePictureMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolvePictureMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolvePictureMethod "getKeepAspectRatio" o = PictureGetKeepAspectRatioMethodInfo
    ResolvePictureMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolvePictureMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolvePictureMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolvePictureMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolvePictureMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolvePictureMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolvePictureMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolvePictureMethod "getModifierMask" o = Gtk.Widget.WidgetGetModifierMaskMethodInfo
    ResolvePictureMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolvePictureMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolvePictureMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolvePictureMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolvePictureMethod "getPaintable" o = PictureGetPaintableMethodInfo
    ResolvePictureMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolvePictureMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolvePictureMethod "getPath" o = Gtk.Widget.WidgetGetPathMethodInfo
    ResolvePictureMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolvePictureMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolvePictureMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolvePictureMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePictureMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePictureMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolvePictureMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolvePictureMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolvePictureMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolvePictureMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolvePictureMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolvePictureMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolvePictureMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolvePictureMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolvePictureMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolvePictureMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolvePictureMethod "getSurface" o = Gtk.Widget.WidgetGetSurfaceMethodInfo
    ResolvePictureMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolvePictureMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolvePictureMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolvePictureMethod "getTooltipWindow" o = Gtk.Widget.WidgetGetTooltipWindowMethodInfo
    ResolvePictureMethod "getToplevel" o = Gtk.Widget.WidgetGetToplevelMethodInfo
    ResolvePictureMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolvePictureMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolvePictureMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolvePictureMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolvePictureMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolvePictureMethod "setAccelPath" o = Gtk.Widget.WidgetSetAccelPathMethodInfo
    ResolvePictureMethod "setAlternativeText" o = PictureSetAlternativeTextMethodInfo
    ResolvePictureMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolvePictureMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolvePictureMethod "setCanShrink" o = PictureSetCanShrinkMethodInfo
    ResolvePictureMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolvePictureMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolvePictureMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolvePictureMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolvePictureMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePictureMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePictureMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolvePictureMethod "setFile" o = PictureSetFileMethodInfo
    ResolvePictureMethod "setFilename" o = PictureSetFilenameMethodInfo
    ResolvePictureMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolvePictureMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolvePictureMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolvePictureMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolvePictureMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolvePictureMethod "setHasSurface" o = Gtk.Widget.WidgetSetHasSurfaceMethodInfo
    ResolvePictureMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolvePictureMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolvePictureMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolvePictureMethod "setKeepAspectRatio" o = PictureSetKeepAspectRatioMethodInfo
    ResolvePictureMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolvePictureMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolvePictureMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolvePictureMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolvePictureMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolvePictureMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolvePictureMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolvePictureMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolvePictureMethod "setPaintable" o = PictureSetPaintableMethodInfo
    ResolvePictureMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolvePictureMethod "setPixbuf" o = PictureSetPixbufMethodInfo
    ResolvePictureMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePictureMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolvePictureMethod "setResource" o = PictureSetResourceMethodInfo
    ResolvePictureMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolvePictureMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolvePictureMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolvePictureMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolvePictureMethod "setSurface" o = Gtk.Widget.WidgetSetSurfaceMethodInfo
    ResolvePictureMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolvePictureMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolvePictureMethod "setTooltipWindow" o = Gtk.Widget.WidgetSetTooltipWindowMethodInfo
    ResolvePictureMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolvePictureMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolvePictureMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolvePictureMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolvePictureMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "alternative-text"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@alternative-text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' picture #alternativeText
-- @
getPictureAlternativeText :: (MonadIO m, IsPicture o) => o -> m (Maybe T.Text)
getPictureAlternativeText :: o -> m (Maybe Text)
getPictureAlternativeText obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "alternative-text"

-- | Set the value of the “@alternative-text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' picture [ #alternativeText 'Data.GI.Base.Attributes.:=' value ]
-- @
setPictureAlternativeText :: (MonadIO m, IsPicture o) => o -> T.Text -> m ()
setPictureAlternativeText :: o -> Text -> m ()
setPictureAlternativeText obj :: o
obj val :: Text
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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "alternative-text" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@alternative-text@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPictureAlternativeText :: (IsPicture o) => T.Text -> IO (GValueConstruct o)
constructPictureAlternativeText :: Text -> IO (GValueConstruct o)
constructPictureAlternativeText val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "alternative-text" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Set the value of the “@alternative-text@” 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' #alternativeText
-- @
clearPictureAlternativeText :: (MonadIO m, IsPicture o) => o -> m ()
clearPictureAlternativeText :: o -> m ()
clearPictureAlternativeText obj :: 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "alternative-text" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data PictureAlternativeTextPropertyInfo
instance AttrInfo PictureAlternativeTextPropertyInfo where
    type AttrAllowedOps PictureAlternativeTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PictureAlternativeTextPropertyInfo = IsPicture
    type AttrSetTypeConstraint PictureAlternativeTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint PictureAlternativeTextPropertyInfo = (~) T.Text
    type AttrTransferType PictureAlternativeTextPropertyInfo = T.Text
    type AttrGetType PictureAlternativeTextPropertyInfo = (Maybe T.Text)
    type AttrLabel PictureAlternativeTextPropertyInfo = "alternative-text"
    type AttrOrigin PictureAlternativeTextPropertyInfo = Picture
    attrGet = getPictureAlternativeText
    attrSet = setPictureAlternativeText
    attrTransfer _ v = do
        return v
    attrConstruct = constructPictureAlternativeText
    attrClear = clearPictureAlternativeText
#endif

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

-- | Get the value of the “@can-shrink@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' picture #canShrink
-- @
getPictureCanShrink :: (MonadIO m, IsPicture o) => o -> m Bool
getPictureCanShrink :: o -> m Bool
getPictureCanShrink obj :: 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 "can-shrink"

-- | Set the value of the “@can-shrink@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' picture [ #canShrink 'Data.GI.Base.Attributes.:=' value ]
-- @
setPictureCanShrink :: (MonadIO m, IsPicture o) => o -> Bool -> m ()
setPictureCanShrink :: o -> Bool -> m ()
setPictureCanShrink obj :: o
obj val :: 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 "can-shrink" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@can-shrink@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPictureCanShrink :: (IsPicture o) => Bool -> IO (GValueConstruct o)
constructPictureCanShrink :: Bool -> IO (GValueConstruct o)
constructPictureCanShrink val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "can-shrink" Bool
val

#if defined(ENABLE_OVERLOADING)
data PictureCanShrinkPropertyInfo
instance AttrInfo PictureCanShrinkPropertyInfo where
    type AttrAllowedOps PictureCanShrinkPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PictureCanShrinkPropertyInfo = IsPicture
    type AttrSetTypeConstraint PictureCanShrinkPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PictureCanShrinkPropertyInfo = (~) Bool
    type AttrTransferType PictureCanShrinkPropertyInfo = Bool
    type AttrGetType PictureCanShrinkPropertyInfo = Bool
    type AttrLabel PictureCanShrinkPropertyInfo = "can-shrink"
    type AttrOrigin PictureCanShrinkPropertyInfo = Picture
    attrGet = getPictureCanShrink
    attrSet = setPictureCanShrink
    attrTransfer _ v = do
        return v
    attrConstruct = constructPictureCanShrink
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@file@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' picture [ #file 'Data.GI.Base.Attributes.:=' value ]
-- @
setPictureFile :: (MonadIO m, IsPicture o, Gio.File.IsFile a) => o -> a -> m ()
setPictureFile :: o -> a -> m ()
setPictureFile obj :: o
obj val :: 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 "file" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@file@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPictureFile :: (IsPicture o, Gio.File.IsFile a) => a -> IO (GValueConstruct o)
constructPictureFile :: a -> IO (GValueConstruct o)
constructPictureFile val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "file" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Set the value of the “@file@” 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' #file
-- @
clearPictureFile :: (MonadIO m, IsPicture o) => o -> m ()
clearPictureFile :: o -> m ()
clearPictureFile obj :: 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 File -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "file" (Maybe File
forall a. Maybe a
Nothing :: Maybe Gio.File.File)

#if defined(ENABLE_OVERLOADING)
data PictureFilePropertyInfo
instance AttrInfo PictureFilePropertyInfo where
    type AttrAllowedOps PictureFilePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PictureFilePropertyInfo = IsPicture
    type AttrSetTypeConstraint PictureFilePropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint PictureFilePropertyInfo = Gio.File.IsFile
    type AttrTransferType PictureFilePropertyInfo = Gio.File.File
    type AttrGetType PictureFilePropertyInfo = (Maybe Gio.File.File)
    type AttrLabel PictureFilePropertyInfo = "file"
    type AttrOrigin PictureFilePropertyInfo = Picture
    attrGet = getPictureFile
    attrSet = setPictureFile
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructPictureFile
    attrClear = clearPictureFile
#endif

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

-- | Get the value of the “@keep-aspect-ratio@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' picture #keepAspectRatio
-- @
getPictureKeepAspectRatio :: (MonadIO m, IsPicture o) => o -> m Bool
getPictureKeepAspectRatio :: o -> m Bool
getPictureKeepAspectRatio obj :: 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 "keep-aspect-ratio"

-- | Set the value of the “@keep-aspect-ratio@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' picture [ #keepAspectRatio 'Data.GI.Base.Attributes.:=' value ]
-- @
setPictureKeepAspectRatio :: (MonadIO m, IsPicture o) => o -> Bool -> m ()
setPictureKeepAspectRatio :: o -> Bool -> m ()
setPictureKeepAspectRatio obj :: o
obj val :: 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 "keep-aspect-ratio" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@keep-aspect-ratio@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPictureKeepAspectRatio :: (IsPicture o) => Bool -> IO (GValueConstruct o)
constructPictureKeepAspectRatio :: Bool -> IO (GValueConstruct o)
constructPictureKeepAspectRatio val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "keep-aspect-ratio" Bool
val

#if defined(ENABLE_OVERLOADING)
data PictureKeepAspectRatioPropertyInfo
instance AttrInfo PictureKeepAspectRatioPropertyInfo where
    type AttrAllowedOps PictureKeepAspectRatioPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PictureKeepAspectRatioPropertyInfo = IsPicture
    type AttrSetTypeConstraint PictureKeepAspectRatioPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PictureKeepAspectRatioPropertyInfo = (~) Bool
    type AttrTransferType PictureKeepAspectRatioPropertyInfo = Bool
    type AttrGetType PictureKeepAspectRatioPropertyInfo = Bool
    type AttrLabel PictureKeepAspectRatioPropertyInfo = "keep-aspect-ratio"
    type AttrOrigin PictureKeepAspectRatioPropertyInfo = Picture
    attrGet = getPictureKeepAspectRatio
    attrSet = setPictureKeepAspectRatio
    attrTransfer _ v = do
        return v
    attrConstruct = constructPictureKeepAspectRatio
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@paintable@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' picture [ #paintable 'Data.GI.Base.Attributes.:=' value ]
-- @
setPicturePaintable :: (MonadIO m, IsPicture o, Gdk.Paintable.IsPaintable a) => o -> a -> m ()
setPicturePaintable :: o -> a -> m ()
setPicturePaintable obj :: o
obj val :: 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 "paintable" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@paintable@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPicturePaintable :: (IsPicture o, Gdk.Paintable.IsPaintable a) => a -> IO (GValueConstruct o)
constructPicturePaintable :: a -> IO (GValueConstruct o)
constructPicturePaintable val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "paintable" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Set the value of the “@paintable@” 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' #paintable
-- @
clearPicturePaintable :: (MonadIO m, IsPicture o) => o -> m ()
clearPicturePaintable :: o -> m ()
clearPicturePaintable obj :: 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 Paintable -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "paintable" (Maybe Paintable
forall a. Maybe a
Nothing :: Maybe Gdk.Paintable.Paintable)

#if defined(ENABLE_OVERLOADING)
data PicturePaintablePropertyInfo
instance AttrInfo PicturePaintablePropertyInfo where
    type AttrAllowedOps PicturePaintablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PicturePaintablePropertyInfo = IsPicture
    type AttrSetTypeConstraint PicturePaintablePropertyInfo = Gdk.Paintable.IsPaintable
    type AttrTransferTypeConstraint PicturePaintablePropertyInfo = Gdk.Paintable.IsPaintable
    type AttrTransferType PicturePaintablePropertyInfo = Gdk.Paintable.Paintable
    type AttrGetType PicturePaintablePropertyInfo = (Maybe Gdk.Paintable.Paintable)
    type AttrLabel PicturePaintablePropertyInfo = "paintable"
    type AttrOrigin PicturePaintablePropertyInfo = Picture
    attrGet = getPicturePaintable
    attrSet = setPicturePaintable
    attrTransfer _ v = do
        unsafeCastTo Gdk.Paintable.Paintable v
    attrConstruct = constructPicturePaintable
    attrClear = clearPicturePaintable
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Picture
type instance O.AttributeList Picture = PictureAttributeList
type PictureAttributeList = ('[ '("alternativeText", PictureAlternativeTextPropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canShrink", PictureCanShrinkPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("expand", Gtk.Widget.WidgetExpandPropertyInfo), '("file", PictureFilePropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("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), '("isFocus", Gtk.Widget.WidgetIsFocusPropertyInfo), '("keepAspectRatio", PictureKeepAspectRatioPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("margin", Gtk.Widget.WidgetMarginPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("paintable", PicturePaintablePropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("surface", Gtk.Widget.WidgetSurfacePropertyInfo), '("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)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
pictureAlternativeText :: AttrLabelProxy "alternativeText"
pictureAlternativeText = AttrLabelProxy

pictureCanShrink :: AttrLabelProxy "canShrink"
pictureCanShrink = AttrLabelProxy

pictureFile :: AttrLabelProxy "file"
pictureFile = AttrLabelProxy

pictureKeepAspectRatio :: AttrLabelProxy "keepAspectRatio"
pictureKeepAspectRatio = AttrLabelProxy

picturePaintable :: AttrLabelProxy "paintable"
picturePaintable = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Picture = PictureSignalList
type PictureSignalList = ('[ '("accelClosuresChanged", Gtk.Widget.WidgetAccelClosuresChangedSignalInfo), '("canActivateAccel", Gtk.Widget.WidgetCanActivateAccelSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("dragBegin", Gtk.Widget.WidgetDragBeginSignalInfo), '("dragDataDelete", Gtk.Widget.WidgetDragDataDeleteSignalInfo), '("dragDataGet", Gtk.Widget.WidgetDragDataGetSignalInfo), '("dragDataReceived", Gtk.Widget.WidgetDragDataReceivedSignalInfo), '("dragDrop", Gtk.Widget.WidgetDragDropSignalInfo), '("dragEnd", Gtk.Widget.WidgetDragEndSignalInfo), '("dragFailed", Gtk.Widget.WidgetDragFailedSignalInfo), '("dragLeave", Gtk.Widget.WidgetDragLeaveSignalInfo), '("dragMotion", Gtk.Widget.WidgetDragMotionSignalInfo), '("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), '("popupMenu", Gtk.Widget.WidgetPopupMenuSignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("sizeAllocate", Gtk.Widget.WidgetSizeAllocateSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("styleUpdated", Gtk.Widget.WidgetStyleUpdatedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

-- method Picture::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Picture" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_new" gtk_picture_new :: 
    IO (Ptr Picture)

-- | Creates a new empty t'GI.Gtk.Objects.Picture.Picture' widget.
pictureNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Picture
    -- ^ __Returns:__ a newly created t'GI.Gtk.Objects.Picture.Picture' widget.
pictureNew :: m Picture
pictureNew  = IO Picture -> m Picture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Picture -> m Picture) -> IO Picture -> m Picture
forall a b. (a -> b) -> a -> b
$ do
    Ptr Picture
result <- IO (Ptr Picture)
gtk_picture_new
    Text -> Ptr Picture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "pictureNew" Ptr Picture
result
    Picture
result' <- ((ManagedPtr Picture -> Picture) -> Ptr Picture -> IO Picture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Picture -> Picture
Picture) Ptr Picture
result
    Picture -> IO Picture
forall (m :: * -> *) a. Monad m => a -> m a
return Picture
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Picture::new_for_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Picture" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_new_for_file" gtk_picture_new_for_file :: 
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO (Ptr Picture)

-- | Creates a new t'GI.Gtk.Objects.Picture.Picture' displaying the given /@file@/. If the file
-- isn’t found or can’t be loaded, the resulting t'GI.Gtk.Objects.Picture.Picture' be empty.
-- 
-- If you need to detect failures to load the file, use
-- @/gdk_texture_new_for_file()/@ to load the file yourself, then create
-- the t'GI.Gtk.Objects.Picture.Picture' from the texture.
pictureNewForFile ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    Maybe (a)
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> m Picture
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Picture.Picture'
pictureNewForFile :: Maybe a -> m Picture
pictureNewForFile file :: Maybe a
file = IO Picture -> m Picture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Picture -> m Picture) -> IO Picture -> m Picture
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
maybeFile <- case Maybe a
file of
        Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just jFile :: a
jFile -> do
            Ptr File
jFile' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jFile
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jFile'
    Ptr Picture
result <- Ptr File -> IO (Ptr Picture)
gtk_picture_new_for_file Ptr File
maybeFile
    Text -> Ptr Picture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "pictureNewForFile" Ptr Picture
result
    Picture
result' <- ((ManagedPtr Picture -> Picture) -> Ptr Picture -> IO Picture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Picture -> Picture
Picture) Ptr Picture
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
file a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Picture -> IO Picture
forall (m :: * -> *) a. Monad m => a -> m a
return Picture
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Picture::new_for_filename
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a filename" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Picture" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_new_for_filename" gtk_picture_new_for_filename :: 
    CString ->                              -- filename : TBasicType TFileName
    IO (Ptr Picture)

-- | Creates a new t'GI.Gtk.Objects.Picture.Picture' displaying the file /@filename@/.
-- 
-- This is a utility function that calls 'GI.Gtk.Objects.Picture.pictureNewForFile'.
-- See that function for details.
pictureNewForFilename ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe ([Char])
    -- ^ /@filename@/: a filename
    -> m Picture
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Picture.Picture'
pictureNewForFilename :: Maybe String -> m Picture
pictureNewForFilename filename :: Maybe String
filename = IO Picture -> m Picture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Picture -> m Picture) -> IO Picture -> m Picture
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeFilename <- case Maybe String
filename of
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jFilename :: String
jFilename -> do
            Ptr CChar
jFilename' <- String -> IO (Ptr CChar)
stringToCString String
jFilename
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jFilename'
    Ptr Picture
result <- Ptr CChar -> IO (Ptr Picture)
gtk_picture_new_for_filename Ptr CChar
maybeFilename
    Text -> Ptr Picture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "pictureNewForFilename" Ptr Picture
result
    Picture
result' <- ((ManagedPtr Picture -> Picture) -> Ptr Picture -> IO Picture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Picture -> Picture
Picture) Ptr Picture
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeFilename
    Picture -> IO Picture
forall (m :: * -> *) a. Monad m => a -> m a
return Picture
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Picture::new_for_paintable
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Paintable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPaintable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Picture" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_new_for_paintable" gtk_picture_new_for_paintable :: 
    Ptr Gdk.Paintable.Paintable ->          -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    IO (Ptr Picture)

-- | Creates a new t'GI.Gtk.Objects.Picture.Picture' displaying /@paintable@/.
-- 
-- The t'GI.Gtk.Objects.Picture.Picture' will track changes to the /@paintable@/ and update
-- its size and contents in response to it.
pictureNewForPaintable ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Paintable.IsPaintable a) =>
    Maybe (a)
    -- ^ /@paintable@/: a t'GI.Gdk.Interfaces.Paintable.Paintable', or 'P.Nothing'
    -> m Picture
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Picture.Picture'
pictureNewForPaintable :: Maybe a -> m Picture
pictureNewForPaintable paintable :: Maybe a
paintable = IO Picture -> m Picture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Picture -> m Picture) -> IO Picture -> m Picture
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paintable
maybePaintable <- case Maybe a
paintable of
        Nothing -> Ptr Paintable -> IO (Ptr Paintable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Paintable
forall a. Ptr a
nullPtr
        Just jPaintable :: a
jPaintable -> do
            Ptr Paintable
jPaintable' <- a -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jPaintable
            Ptr Paintable -> IO (Ptr Paintable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Paintable
jPaintable'
    Ptr Picture
result <- Ptr Paintable -> IO (Ptr Picture)
gtk_picture_new_for_paintable Ptr Paintable
maybePaintable
    Text -> Ptr Picture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "pictureNewForPaintable" Ptr Picture
result
    Picture
result' <- ((ManagedPtr Picture -> Picture) -> Ptr Picture -> IO Picture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Picture -> Picture
Picture) Ptr Picture
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
paintable a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Picture -> IO Picture
forall (m :: * -> *) a. Monad m => a -> m a
return Picture
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Picture::new_for_pixbuf
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "pixbuf"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbuf, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Picture" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_new_for_pixbuf" gtk_picture_new_for_pixbuf :: 
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- pixbuf : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    IO (Ptr Picture)

-- | Creates a new t'GI.Gtk.Objects.Picture.Picture' displaying /@pixbuf@/.
-- 
-- This is a utility function that calls 'GI.Gtk.Objects.Picture.pictureNewForPaintable',
-- See that function for details.
-- 
-- The pixbuf must not be modified after passing it to this function.
pictureNewForPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, GdkPixbuf.Pixbuf.IsPixbuf a) =>
    Maybe (a)
    -- ^ /@pixbuf@/: a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf', or 'P.Nothing'
    -> m Picture
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Picture.Picture'
pictureNewForPixbuf :: Maybe a -> m Picture
pictureNewForPixbuf pixbuf :: Maybe a
pixbuf = IO Picture -> m Picture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Picture -> m Picture) -> IO Picture -> m Picture
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pixbuf
maybePixbuf <- case Maybe a
pixbuf of
        Nothing -> Ptr Pixbuf -> IO (Ptr Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
forall a. Ptr a
nullPtr
        Just jPixbuf :: a
jPixbuf -> do
            Ptr Pixbuf
jPixbuf' <- a -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jPixbuf
            Ptr Pixbuf -> IO (Ptr Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
jPixbuf'
    Ptr Picture
result <- Ptr Pixbuf -> IO (Ptr Picture)
gtk_picture_new_for_pixbuf Ptr Pixbuf
maybePixbuf
    Text -> Ptr Picture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "pictureNewForPixbuf" Ptr Picture
result
    Picture
result' <- ((ManagedPtr Picture -> Picture) -> Ptr Picture -> IO Picture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Picture -> Picture
Picture) Ptr Picture
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
pixbuf a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Picture -> IO Picture
forall (m :: * -> *) a. Monad m => a -> m a
return Picture
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Picture::new_for_resource
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "resource_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "resource path to play back"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Picture" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_new_for_resource" gtk_picture_new_for_resource :: 
    CString ->                              -- resource_path : TBasicType TUTF8
    IO (Ptr Picture)

-- | Creates a new t'GI.Gtk.Objects.Picture.Picture' displaying the file /@filename@/.
-- 
-- This is a utility function that calls 'GI.Gtk.Objects.Picture.pictureNewForFile'.
-- See that function for details.
pictureNewForResource ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@resourcePath@/: resource path to play back
    -> m Picture
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Picture.Picture'
pictureNewForResource :: Maybe Text -> m Picture
pictureNewForResource resourcePath :: Maybe Text
resourcePath = IO Picture -> m Picture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Picture -> m Picture) -> IO Picture -> m Picture
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeResourcePath <- case Maybe Text
resourcePath of
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jResourcePath :: Text
jResourcePath -> do
            Ptr CChar
jResourcePath' <- Text -> IO (Ptr CChar)
textToCString Text
jResourcePath
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jResourcePath'
    Ptr Picture
result <- Ptr CChar -> IO (Ptr Picture)
gtk_picture_new_for_resource Ptr CChar
maybeResourcePath
    Text -> Ptr Picture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "pictureNewForResource" Ptr Picture
result
    Picture
result' <- ((ManagedPtr Picture -> Picture) -> Ptr Picture -> IO Picture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Picture -> Picture
Picture) Ptr Picture
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeResourcePath
    Picture -> IO Picture
forall (m :: * -> *) a. Monad m => a -> m a
return Picture
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_picture_get_alternative_text" gtk_picture_get_alternative_text :: 
    Ptr Picture ->                          -- self : TInterface (Name {namespace = "Gtk", name = "Picture"})
    IO CString

-- | Gets the alternative textual description of the picture or returns 'P.Nothing' if
-- the picture cannot be described textually.
pictureGetAlternativeText ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the alternative textual description
    --     of /@self@/.
pictureGetAlternativeText :: a -> m (Maybe Text)
pictureGetAlternativeText self :: a
self = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
result <- Ptr Picture -> IO (Ptr CChar)
gtk_picture_get_alternative_text Ptr Picture
self'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data PictureGetAlternativeTextMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsPicture a) => O.MethodInfo PictureGetAlternativeTextMethodInfo a signature where
    overloadedMethod = pictureGetAlternativeText

#endif

-- method Picture::get_can_shrink
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Picture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPicture" , 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_picture_get_can_shrink" gtk_picture_get_can_shrink :: 
    Ptr Picture ->                          -- self : TInterface (Name {namespace = "Gtk", name = "Picture"})
    IO CInt

-- | Gets the value set via 'GI.Gtk.Objects.Picture.pictureSetCanShrink'.
pictureGetCanShrink ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the picture can be made smaller than its contents
pictureGetCanShrink :: a -> m Bool
pictureGetCanShrink self :: 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 Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Picture -> IO CInt
gtk_picture_get_can_shrink Ptr Picture
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 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 PictureGetCanShrinkMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPicture a) => O.MethodInfo PictureGetCanShrinkMethodInfo a signature where
    overloadedMethod = pictureGetCanShrink

#endif

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

foreign import ccall "gtk_picture_get_file" gtk_picture_get_file :: 
    Ptr Picture ->                          -- self : TInterface (Name {namespace = "Gtk", name = "Picture"})
    IO (Ptr Gio.File.File)

-- | Gets the t'GI.Gio.Interfaces.File.File' currently displayed if /@self@/ is displaying a file.
-- If /@self@/ is not displaying a file, for example when 'GI.Gtk.Objects.Picture.pictureSetPaintable'
-- was used, then 'P.Nothing' is returned.
pictureGetFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ The t'GI.Gio.Interfaces.File.File' displayed by /@self@/.
pictureGetFile :: a -> m (Maybe File)
pictureGetFile self :: a
self = IO (Maybe File) -> m (Maybe File)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
result <- Ptr Picture -> IO (Ptr File)
gtk_picture_get_file Ptr Picture
self'
    Maybe File
maybeResult <- Ptr File -> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr File
result ((Ptr File -> IO File) -> IO (Maybe File))
-> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr File
result' -> do
        File
result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
        File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe File -> IO (Maybe File)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
maybeResult

#if defined(ENABLE_OVERLOADING)
data PictureGetFileMethodInfo
instance (signature ~ (m (Maybe Gio.File.File)), MonadIO m, IsPicture a) => O.MethodInfo PictureGetFileMethodInfo a signature where
    overloadedMethod = pictureGetFile

#endif

-- method Picture::get_keep_aspect_ratio
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Picture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPicture" , 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_picture_get_keep_aspect_ratio" gtk_picture_get_keep_aspect_ratio :: 
    Ptr Picture ->                          -- self : TInterface (Name {namespace = "Gtk", name = "Picture"})
    IO CInt

-- | Gets the value set via 'GI.Gtk.Objects.Picture.pictureSetKeepAspectRatio'.
pictureGetKeepAspectRatio ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the self tries to keep the contents\' aspect ratio
pictureGetKeepAspectRatio :: a -> m Bool
pictureGetKeepAspectRatio self :: 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 Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Picture -> IO CInt
gtk_picture_get_keep_aspect_ratio Ptr Picture
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 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 PictureGetKeepAspectRatioMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPicture a) => O.MethodInfo PictureGetKeepAspectRatioMethodInfo a signature where
    overloadedMethod = pictureGetKeepAspectRatio

#endif

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

foreign import ccall "gtk_picture_get_paintable" gtk_picture_get_paintable :: 
    Ptr Picture ->                          -- self : TInterface (Name {namespace = "Gtk", name = "Picture"})
    IO (Ptr Gdk.Paintable.Paintable)

-- | Gets the t'GI.Gdk.Interfaces.Paintable.Paintable' being displayed by the t'GI.Gtk.Objects.Picture.Picture'.
pictureGetPaintable ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> m (Maybe Gdk.Paintable.Paintable)
    -- ^ __Returns:__ the displayed paintable, or 'P.Nothing' if
    --   the picture is empty
pictureGetPaintable :: a -> m (Maybe Paintable)
pictureGetPaintable self :: a
self = IO (Maybe Paintable) -> m (Maybe Paintable)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Paintable) -> m (Maybe Paintable))
-> IO (Maybe Paintable) -> m (Maybe Paintable)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Paintable
result <- Ptr Picture -> IO (Ptr Paintable)
gtk_picture_get_paintable Ptr Picture
self'
    Maybe Paintable
maybeResult <- Ptr Paintable
-> (Ptr Paintable -> IO Paintable) -> IO (Maybe Paintable)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Paintable
result ((Ptr Paintable -> IO Paintable) -> IO (Maybe Paintable))
-> (Ptr Paintable -> IO Paintable) -> IO (Maybe Paintable)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Paintable
result' -> do
        Paintable
result'' <- ((ManagedPtr Paintable -> Paintable)
-> Ptr Paintable -> IO Paintable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Paintable -> Paintable
Gdk.Paintable.Paintable) Ptr Paintable
result'
        Paintable -> IO Paintable
forall (m :: * -> *) a. Monad m => a -> m a
return Paintable
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Paintable -> IO (Maybe Paintable)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Paintable
maybeResult

#if defined(ENABLE_OVERLOADING)
data PictureGetPaintableMethodInfo
instance (signature ~ (m (Maybe Gdk.Paintable.Paintable)), MonadIO m, IsPicture a) => O.MethodInfo PictureGetPaintableMethodInfo a signature where
    overloadedMethod = pictureGetPaintable

#endif

-- method Picture::set_alternative_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Picture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPicture" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alternative_text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a textual description of the contents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_set_alternative_text" gtk_picture_set_alternative_text :: 
    Ptr Picture ->                          -- self : TInterface (Name {namespace = "Gtk", name = "Picture"})
    CString ->                              -- alternative_text : TBasicType TUTF8
    IO ()

-- | Sets an alternative textual description for the picture contents.
-- It is equivalent to the \"alt\" attribute for images on websites.
-- 
-- This text will be made available to accessibility tools.
-- 
-- If the picture cannot be described textually, set this property to 'P.Nothing'.
pictureSetAlternativeText ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> Maybe (T.Text)
    -- ^ /@alternativeText@/: a textual description of the contents
    -> m ()
pictureSetAlternativeText :: a -> Maybe Text -> m ()
pictureSetAlternativeText self :: a
self alternativeText :: Maybe Text
alternativeText = 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 Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
maybeAlternativeText <- case Maybe Text
alternativeText of
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jAlternativeText :: Text
jAlternativeText -> do
            Ptr CChar
jAlternativeText' <- Text -> IO (Ptr CChar)
textToCString Text
jAlternativeText
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jAlternativeText'
    Ptr Picture -> Ptr CChar -> IO ()
gtk_picture_set_alternative_text Ptr Picture
self' Ptr CChar
maybeAlternativeText
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeAlternativeText
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PictureSetAlternativeTextMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsPicture a) => O.MethodInfo PictureSetAlternativeTextMethodInfo a signature where
    overloadedMethod = pictureSetAlternativeText

#endif

-- method Picture::set_can_shrink
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Picture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPicture" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "can_shrink"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "if @self can be made smaller than its contents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | If set to 'P.True', the /@self@/ can be made smaller than its contents.
-- The contents will then be scaled down when rendering.
-- 
-- If you want to still force a minimum size manually, consider using
-- 'GI.Gtk.Objects.Widget.widgetSetSizeRequest'.
-- 
-- Also of note is that a similar function for growing does not exist
-- because the grow behavior can be controlled via
-- 'GI.Gtk.Objects.Widget.widgetSetHalign' and 'GI.Gtk.Objects.Widget.widgetSetValign'.
pictureSetCanShrink ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> Bool
    -- ^ /@canShrink@/: if /@self@/ can be made smaller than its contents
    -> m ()
pictureSetCanShrink :: a -> Bool -> m ()
pictureSetCanShrink self :: a
self canShrink :: Bool
canShrink = 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 Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let canShrink' :: CInt
canShrink' = (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
canShrink
    Ptr Picture -> CInt -> IO ()
gtk_picture_set_can_shrink Ptr Picture
self' CInt
canShrink'
    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 PictureSetCanShrinkMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsPicture a) => O.MethodInfo PictureSetCanShrinkMethodInfo a signature where
    overloadedMethod = pictureSetCanShrink

#endif

-- method Picture::set_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Picture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPicture" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a %GFile or %NULL" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_set_file" gtk_picture_set_file :: 
    Ptr Picture ->                          -- self : TInterface (Name {namespace = "Gtk", name = "Picture"})
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO ()

-- | Makes /@self@/ load and display /@file@/.
-- 
-- See 'GI.Gtk.Objects.Picture.pictureNewForFile' for details.
pictureSetFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a, Gio.File.IsFile b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> Maybe (b)
    -- ^ /@file@/: a @/GFile/@ or 'P.Nothing'
    -> m ()
pictureSetFile :: a -> Maybe b -> m ()
pictureSetFile self :: a
self file :: Maybe b
file = 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 Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
maybeFile <- case Maybe b
file of
        Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just jFile :: b
jFile -> do
            Ptr File
jFile' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFile
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jFile'
    Ptr Picture -> Ptr File -> IO ()
gtk_picture_set_file Ptr Picture
self' Ptr File
maybeFile
    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
file b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PictureSetFileMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsPicture a, Gio.File.IsFile b) => O.MethodInfo PictureSetFileMethodInfo a signature where
    overloadedMethod = pictureSetFile

#endif

-- method Picture::set_filename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Picture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPicture" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the filename to play"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_set_filename" gtk_picture_set_filename :: 
    Ptr Picture ->                          -- self : TInterface (Name {namespace = "Gtk", name = "Picture"})
    CString ->                              -- filename : TBasicType TUTF8
    IO ()

-- | Makes /@self@/ load and display the given /@filename@/.
-- 
-- This is a utility function that calls 'GI.Gtk.Objects.Picture.pictureSetFile'.
pictureSetFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> Maybe (T.Text)
    -- ^ /@filename@/: the filename to play
    -> m ()
pictureSetFilename :: a -> Maybe Text -> m ()
pictureSetFilename self :: a
self filename :: Maybe Text
filename = 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 Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
maybeFilename <- case Maybe Text
filename of
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jFilename :: Text
jFilename -> do
            Ptr CChar
jFilename' <- Text -> IO (Ptr CChar)
textToCString Text
jFilename
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jFilename'
    Ptr Picture -> Ptr CChar -> IO ()
gtk_picture_set_filename Ptr Picture
self' Ptr CChar
maybeFilename
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeFilename
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PictureSetFilenameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsPicture a) => O.MethodInfo PictureSetFilenameMethodInfo a signature where
    overloadedMethod = pictureSetFilename

#endif

-- method Picture::set_keep_aspect_ratio
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Picture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPicture" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keep_aspect_ratio"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to keep aspect ratio"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | If set to 'P.True', the /@self@/ will render its contents according to
-- their aspect ratio. That means that empty space may show up at the
-- top\/bottom or left\/right of /@self@/.
-- 
-- If set to 'P.False' or if the contents provide no aspect ratio, the
-- contents will be stretched over the picture\'s whole area.
pictureSetKeepAspectRatio ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> Bool
    -- ^ /@keepAspectRatio@/: whether to keep aspect ratio
    -> m ()
pictureSetKeepAspectRatio :: a -> Bool -> m ()
pictureSetKeepAspectRatio self :: a
self keepAspectRatio :: Bool
keepAspectRatio = 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 Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let keepAspectRatio' :: CInt
keepAspectRatio' = (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
keepAspectRatio
    Ptr Picture -> CInt -> IO ()
gtk_picture_set_keep_aspect_ratio Ptr Picture
self' CInt
keepAspectRatio'
    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 PictureSetKeepAspectRatioMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsPicture a) => O.MethodInfo PictureSetKeepAspectRatioMethodInfo a signature where
    overloadedMethod = pictureSetKeepAspectRatio

#endif

-- method Picture::set_paintable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Picture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPicture" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Paintable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPaintable or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_set_paintable" gtk_picture_set_paintable :: 
    Ptr Picture ->                          -- self : TInterface (Name {namespace = "Gtk", name = "Picture"})
    Ptr Gdk.Paintable.Paintable ->          -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    IO ()

-- | Makes /@self@/ display the given /@paintable@/. If /@paintable@/ is 'P.Nothing',
-- nothing will be displayed.
-- 
-- See 'GI.Gtk.Objects.Picture.pictureNewForPaintable' for details.
pictureSetPaintable ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a, Gdk.Paintable.IsPaintable b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> Maybe (b)
    -- ^ /@paintable@/: a t'GI.Gdk.Interfaces.Paintable.Paintable' or 'P.Nothing'
    -> m ()
pictureSetPaintable :: a -> Maybe b -> m ()
pictureSetPaintable self :: a
self paintable :: Maybe b
paintable = 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 Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Paintable
maybePaintable <- case Maybe b
paintable of
        Nothing -> Ptr Paintable -> IO (Ptr Paintable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Paintable
forall a. Ptr a
nullPtr
        Just jPaintable :: b
jPaintable -> do
            Ptr Paintable
jPaintable' <- b -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPaintable
            Ptr Paintable -> IO (Ptr Paintable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Paintable
jPaintable'
    Ptr Picture -> Ptr Paintable -> IO ()
gtk_picture_set_paintable Ptr Picture
self' Ptr Paintable
maybePaintable
    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
paintable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PictureSetPaintableMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsPicture a, Gdk.Paintable.IsPaintable b) => O.MethodInfo PictureSetPaintableMethodInfo a signature where
    overloadedMethod = pictureSetPaintable

#endif

-- method Picture::set_pixbuf
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Picture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPicture" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixbuf"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbuf or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_set_pixbuf" gtk_picture_set_pixbuf :: 
    Ptr Picture ->                          -- self : TInterface (Name {namespace = "Gtk", name = "Picture"})
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- pixbuf : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    IO ()

-- | See 'GI.Gtk.Objects.Picture.pictureNewForPixbuf' for details.
-- 
-- This is a utility function that calls 'GI.Gtk.Objects.Picture.pictureSetPaintable',
pictureSetPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a, GdkPixbuf.Pixbuf.IsPixbuf b) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> Maybe (b)
    -- ^ /@pixbuf@/: a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' or 'P.Nothing'
    -> m ()
pictureSetPixbuf :: a -> Maybe b -> m ()
pictureSetPixbuf self :: a
self pixbuf :: Maybe b
pixbuf = 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 Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Pixbuf
maybePixbuf <- case Maybe b
pixbuf of
        Nothing -> Ptr Pixbuf -> IO (Ptr Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
forall a. Ptr a
nullPtr
        Just jPixbuf :: b
jPixbuf -> do
            Ptr Pixbuf
jPixbuf' <- b -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPixbuf
            Ptr Pixbuf -> IO (Ptr Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
jPixbuf'
    Ptr Picture -> Ptr Pixbuf -> IO ()
gtk_picture_set_pixbuf Ptr Picture
self' Ptr Pixbuf
maybePixbuf
    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
pixbuf b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PictureSetPixbufMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsPicture a, GdkPixbuf.Pixbuf.IsPixbuf b) => O.MethodInfo PictureSetPixbufMethodInfo a signature where
    overloadedMethod = pictureSetPixbuf

#endif

-- method Picture::set_resource
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Picture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPicture" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "resource_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the resource to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_picture_set_resource" gtk_picture_set_resource :: 
    Ptr Picture ->                          -- self : TInterface (Name {namespace = "Gtk", name = "Picture"})
    CString ->                              -- resource_path : TBasicType TUTF8
    IO ()

-- | Makes /@self@/ load and display the resource at the given
-- /@resourcePath@/.
-- 
-- This is a utility function that calls 'GI.Gtk.Objects.Picture.pictureSetFile',
pictureSetResource ::
    (B.CallStack.HasCallStack, MonadIO m, IsPicture a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.Picture.Picture'
    -> Maybe (T.Text)
    -- ^ /@resourcePath@/: the resource to set
    -> m ()
pictureSetResource :: a -> Maybe Text -> m ()
pictureSetResource self :: a
self resourcePath :: Maybe Text
resourcePath = 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 Picture
self' <- a -> IO (Ptr Picture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CChar
maybeResourcePath <- case Maybe Text
resourcePath of
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jResourcePath :: Text
jResourcePath -> do
            Ptr CChar
jResourcePath' <- Text -> IO (Ptr CChar)
textToCString Text
jResourcePath
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jResourcePath'
    Ptr Picture -> Ptr CChar -> IO ()
gtk_picture_set_resource Ptr Picture
self' Ptr CChar
maybeResourcePath
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeResourcePath
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PictureSetResourceMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsPicture a) => O.MethodInfo PictureSetResourceMethodInfo a signature where
    overloadedMethod = pictureSetResource

#endif