{-# 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.DrawingArea.DrawingArea' widget is used for creating custom user interface
-- elements. It’s essentially a blank widget; you can draw on it. After
-- creating a drawing area, the application may want to connect to:
-- 
-- * The [realize]("GI.Gtk.Objects.Widget#signal:realize") signal to take any necessary actions
-- when the widget is instantiated on a particular display.
-- (Create GDK resources in response to this signal.)
-- * The [sizeAllocate]("GI.Gtk.Objects.Widget#signal:sizeAllocate") signal to take any necessary
-- actions when the widget changes size.
-- * Call 'GI.Gtk.Objects.DrawingArea.drawingAreaSetDrawFunc' to handle redrawing the
-- contents of the widget.
-- 
-- 
-- The following code portion demonstrates using a drawing
-- area to display a circle in the normal widget foreground
-- color.
-- 
-- == Simple GtkDrawingArea usage
-- 
-- 
-- === /C code/
-- >
-- >void
-- >draw_function (GtkDrawingArea *area, cairo_t *cr,
-- >               int width, int height,
-- >               gpointer data)
-- >{
-- >  GdkRGBA color;
-- >  GtkStyleContext *context;
-- >
-- >  context = gtk_widget_get_style_context (GTK_WIDGET (area));
-- >
-- >  cairo_arc (cr,
-- >             width / 2.0, height / 2.0,
-- >             MIN (width, height) / 2.0,
-- >             0, 2 * G_PI);
-- >
-- >  gtk_style_context_get_color (context,
-- >                               &color);
-- >  gdk_cairo_set_source_rgba (cr, &color);
-- >
-- >  cairo_fill (cr);
-- >}
-- >
-- >void main (int argc, char **argv)
-- >{
-- >  gtk_init ();
-- >
-- >  GtkWidget *area = gtk_drawing_area_new ();
-- >  gtk_drawing_area_set_content_width (GTK_DRAWING_AREA (area), 100);
-- >  gtk_drawing_area_set_content_height (GTK_DRAWING_AREA (area), 100);
-- >  gtk_drawing_area_set_draw_func (GTK_DRAWING_AREA (area),
-- >                                  draw_function,
-- >                                  NULL, NULL);
-- >
-- >}
-- 
-- 
-- The draw function is normally called when a drawing area first comes
-- onscreen, or when it’s covered by another window and then uncovered.
-- You can also force a redraw by adding to the “damage region” of the
-- drawing area’s window using @/gtk_widget_queue_draw_region()/@,
-- @/gtk_widget_queue_draw_area()/@ or 'GI.Gtk.Objects.Widget.widgetQueueDraw'.
-- This will cause the drawing area to call the draw function again.
-- 
-- The available routines for drawing are documented on the
-- [GDK Drawing Primitives][gdk3-Cairo-Interaction] page
-- and the cairo documentation.
-- 
-- To receive mouse events on a drawing area, you will need to enable
-- them with @/gtk_widget_add_events()/@. To receive keyboard events, you
-- will need to set the “can-focus” property on the drawing area, and you
-- should probably draw some user-visible indication that the drawing
-- area is focused. Use 'GI.Gtk.Objects.Widget.widgetHasFocus' in your expose event
-- handler to decide whether to draw the focus indicator. See
-- 'GI.Gtk.Functions.renderFocus' for one way to draw focus.
-- 
-- If you need more complex control over your widget, you should consider
-- creating your own t'GI.Gtk.Objects.Widget.Widget' subclass.

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

module GI.Gtk.Objects.DrawingArea
    ( 

-- * Exported types
    DrawingArea(..)                         ,
    IsDrawingArea                           ,
    toDrawingArea                           ,
    noDrawingArea                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDrawingAreaMethod                ,
#endif


-- ** getContentHeight #method:getContentHeight#

#if defined(ENABLE_OVERLOADING)
    DrawingAreaGetContentHeightMethodInfo   ,
#endif
    drawingAreaGetContentHeight             ,


-- ** getContentWidth #method:getContentWidth#

#if defined(ENABLE_OVERLOADING)
    DrawingAreaGetContentWidthMethodInfo    ,
#endif
    drawingAreaGetContentWidth              ,


-- ** new #method:new#

    drawingAreaNew                          ,


-- ** setContentHeight #method:setContentHeight#

#if defined(ENABLE_OVERLOADING)
    DrawingAreaSetContentHeightMethodInfo   ,
#endif
    drawingAreaSetContentHeight             ,


-- ** setContentWidth #method:setContentWidth#

#if defined(ENABLE_OVERLOADING)
    DrawingAreaSetContentWidthMethodInfo    ,
#endif
    drawingAreaSetContentWidth              ,


-- ** setDrawFunc #method:setDrawFunc#

#if defined(ENABLE_OVERLOADING)
    DrawingAreaSetDrawFuncMethodInfo        ,
#endif
    drawingAreaSetDrawFunc                  ,




 -- * Properties
-- ** contentHeight #attr:contentHeight#
-- | The content height. See 'GI.Gtk.Objects.DrawingArea.drawingAreaSetContentHeight' for details.

#if defined(ENABLE_OVERLOADING)
    DrawingAreaContentHeightPropertyInfo    ,
#endif
    constructDrawingAreaContentHeight       ,
#if defined(ENABLE_OVERLOADING)
    drawingAreaContentHeight                ,
#endif
    getDrawingAreaContentHeight             ,
    setDrawingAreaContentHeight             ,


-- ** contentWidth #attr:contentWidth#
-- | The content width. See 'GI.Gtk.Objects.DrawingArea.drawingAreaSetContentWidth' for details.

#if defined(ENABLE_OVERLOADING)
    DrawingAreaContentWidthPropertyInfo     ,
#endif
    constructDrawingAreaContentWidth        ,
#if defined(ENABLE_OVERLOADING)
    drawingAreaContentWidth                 ,
#endif
    getDrawingAreaContentWidth              ,
    setDrawingAreaContentWidth              ,




    ) 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.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
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 DrawingArea = DrawingArea (ManagedPtr DrawingArea)
    deriving (DrawingArea -> DrawingArea -> Bool
(DrawingArea -> DrawingArea -> Bool)
-> (DrawingArea -> DrawingArea -> Bool) -> Eq DrawingArea
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DrawingArea -> DrawingArea -> Bool
$c/= :: DrawingArea -> DrawingArea -> Bool
== :: DrawingArea -> DrawingArea -> Bool
$c== :: DrawingArea -> DrawingArea -> Bool
Eq)
foreign import ccall "gtk_drawing_area_get_type"
    c_gtk_drawing_area_get_type :: IO GType

instance GObject DrawingArea where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_drawing_area_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `DrawingArea`.
noDrawingArea :: Maybe DrawingArea
noDrawingArea :: Maybe DrawingArea
noDrawingArea = Maybe DrawingArea
forall a. Maybe a
Nothing

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

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

#endif

-- VVV Prop "content-height"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@content-height@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' drawingArea #contentHeight
-- @
getDrawingAreaContentHeight :: (MonadIO m, IsDrawingArea o) => o -> m Int32
getDrawingAreaContentHeight :: o -> m Int32
getDrawingAreaContentHeight obj :: o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj "content-height"

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

-- | Construct a `GValueConstruct` with valid value for the “@content-height@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDrawingAreaContentHeight :: (IsDrawingArea o) => Int32 -> IO (GValueConstruct o)
constructDrawingAreaContentHeight :: Int32 -> IO (GValueConstruct o)
constructDrawingAreaContentHeight val :: Int32
val = String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 "content-height" Int32
val

#if defined(ENABLE_OVERLOADING)
data DrawingAreaContentHeightPropertyInfo
instance AttrInfo DrawingAreaContentHeightPropertyInfo where
    type AttrAllowedOps DrawingAreaContentHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DrawingAreaContentHeightPropertyInfo = IsDrawingArea
    type AttrSetTypeConstraint DrawingAreaContentHeightPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint DrawingAreaContentHeightPropertyInfo = (~) Int32
    type AttrTransferType DrawingAreaContentHeightPropertyInfo = Int32
    type AttrGetType DrawingAreaContentHeightPropertyInfo = Int32
    type AttrLabel DrawingAreaContentHeightPropertyInfo = "content-height"
    type AttrOrigin DrawingAreaContentHeightPropertyInfo = DrawingArea
    attrGet = getDrawingAreaContentHeight
    attrSet = setDrawingAreaContentHeight
    attrTransfer _ v = do
        return v
    attrConstruct = constructDrawingAreaContentHeight
    attrClear = undefined
#endif

-- VVV Prop "content-width"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@content-width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' drawingArea #contentWidth
-- @
getDrawingAreaContentWidth :: (MonadIO m, IsDrawingArea o) => o -> m Int32
getDrawingAreaContentWidth :: o -> m Int32
getDrawingAreaContentWidth obj :: o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj "content-width"

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

-- | Construct a `GValueConstruct` with valid value for the “@content-width@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDrawingAreaContentWidth :: (IsDrawingArea o) => Int32 -> IO (GValueConstruct o)
constructDrawingAreaContentWidth :: Int32 -> IO (GValueConstruct o)
constructDrawingAreaContentWidth val :: Int32
val = String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 "content-width" Int32
val

#if defined(ENABLE_OVERLOADING)
data DrawingAreaContentWidthPropertyInfo
instance AttrInfo DrawingAreaContentWidthPropertyInfo where
    type AttrAllowedOps DrawingAreaContentWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DrawingAreaContentWidthPropertyInfo = IsDrawingArea
    type AttrSetTypeConstraint DrawingAreaContentWidthPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint DrawingAreaContentWidthPropertyInfo = (~) Int32
    type AttrTransferType DrawingAreaContentWidthPropertyInfo = Int32
    type AttrGetType DrawingAreaContentWidthPropertyInfo = Int32
    type AttrLabel DrawingAreaContentWidthPropertyInfo = "content-width"
    type AttrOrigin DrawingAreaContentWidthPropertyInfo = DrawingArea
    attrGet = getDrawingAreaContentWidth
    attrSet = setDrawingAreaContentWidth
    attrTransfer _ v = do
        return v
    attrConstruct = constructDrawingAreaContentWidth
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DrawingArea
type instance O.AttributeList DrawingArea = DrawingAreaAttributeList
type DrawingAreaAttributeList = ('[ '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("contentHeight", DrawingAreaContentHeightPropertyInfo), '("contentWidth", DrawingAreaContentWidthPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("expand", Gtk.Widget.WidgetExpandPropertyInfo), '("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), '("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), '("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)
drawingAreaContentHeight :: AttrLabelProxy "contentHeight"
drawingAreaContentHeight = AttrLabelProxy

drawingAreaContentWidth :: AttrLabelProxy "contentWidth"
drawingAreaContentWidth = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DrawingArea = DrawingAreaSignalList
type DrawingAreaSignalList = ('[ '("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 DrawingArea::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "DrawingArea" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drawing_area_new" gtk_drawing_area_new :: 
    IO (Ptr DrawingArea)

-- | Creates a new drawing area.
drawingAreaNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m DrawingArea
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.DrawingArea.DrawingArea'
drawingAreaNew :: m DrawingArea
drawingAreaNew  = IO DrawingArea -> m DrawingArea
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DrawingArea -> m DrawingArea)
-> IO DrawingArea -> m DrawingArea
forall a b. (a -> b) -> a -> b
$ do
    Ptr DrawingArea
result <- IO (Ptr DrawingArea)
gtk_drawing_area_new
    Text -> Ptr DrawingArea -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "drawingAreaNew" Ptr DrawingArea
result
    DrawingArea
result' <- ((ManagedPtr DrawingArea -> DrawingArea)
-> Ptr DrawingArea -> IO DrawingArea
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DrawingArea -> DrawingArea
DrawingArea) Ptr DrawingArea
result
    DrawingArea -> IO DrawingArea
forall (m :: * -> *) a. Monad m => a -> m a
return DrawingArea
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_drawing_area_get_content_height" gtk_drawing_area_get_content_height :: 
    Ptr DrawingArea ->                      -- self : TInterface (Name {namespace = "Gtk", name = "DrawingArea"})
    IO Int32

-- | Retrieves the value previously set via 'GI.Gtk.Objects.DrawingArea.drawingAreaSetContentHeight'.
drawingAreaGetContentHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrawingArea a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DrawingArea.DrawingArea'
    -> m Int32
    -- ^ __Returns:__ The height requested for content of the drawing area
drawingAreaGetContentHeight :: a -> m Int32
drawingAreaGetContentHeight self :: a
self = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr DrawingArea
self' <- a -> IO (Ptr DrawingArea)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr DrawingArea -> IO Int32
gtk_drawing_area_get_content_height Ptr DrawingArea
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DrawingAreaGetContentHeightMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsDrawingArea a) => O.MethodInfo DrawingAreaGetContentHeightMethodInfo a signature where
    overloadedMethod = drawingAreaGetContentHeight

#endif

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

foreign import ccall "gtk_drawing_area_get_content_width" gtk_drawing_area_get_content_width :: 
    Ptr DrawingArea ->                      -- self : TInterface (Name {namespace = "Gtk", name = "DrawingArea"})
    IO Int32

-- | Retrieves the value previously set via 'GI.Gtk.Objects.DrawingArea.drawingAreaSetContentWidth'.
drawingAreaGetContentWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrawingArea a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DrawingArea.DrawingArea'
    -> m Int32
    -- ^ __Returns:__ The width requested for content of the drawing area
drawingAreaGetContentWidth :: a -> m Int32
drawingAreaGetContentWidth self :: a
self = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr DrawingArea
self' <- a -> IO (Ptr DrawingArea)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr DrawingArea -> IO Int32
gtk_drawing_area_get_content_width Ptr DrawingArea
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DrawingAreaGetContentWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsDrawingArea a) => O.MethodInfo DrawingAreaGetContentWidthMethodInfo a signature where
    overloadedMethod = drawingAreaGetContentWidth

#endif

-- method DrawingArea::set_content_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DrawingArea" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDrawingArea" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the height of 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_drawing_area_set_content_height" gtk_drawing_area_set_content_height :: 
    Ptr DrawingArea ->                      -- self : TInterface (Name {namespace = "Gtk", name = "DrawingArea"})
    Int32 ->                                -- height : TBasicType TInt
    IO ()

-- | Sets the desired height of the contents of the drawing area. Note that
-- because widgets may be allocated larger sizes than they requested, it is
-- possible that the actual height passed to your draw function is larger
-- than the height set here. You can use 'GI.Gtk.Objects.Widget.widgetSetValign' to avoid
-- that.
-- 
-- If the height is set to 0 (the default), the drawing area may disappear.
drawingAreaSetContentHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrawingArea a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DrawingArea.DrawingArea'
    -> Int32
    -- ^ /@height@/: the height of contents
    -> m ()
drawingAreaSetContentHeight :: a -> Int32 -> m ()
drawingAreaSetContentHeight self :: a
self height :: Int32
height = 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 DrawingArea
self' <- a -> IO (Ptr DrawingArea)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr DrawingArea -> Int32 -> IO ()
gtk_drawing_area_set_content_height Ptr DrawingArea
self' Int32
height
    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 DrawingAreaSetContentHeightMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsDrawingArea a) => O.MethodInfo DrawingAreaSetContentHeightMethodInfo a signature where
    overloadedMethod = drawingAreaSetContentHeight

#endif

-- method DrawingArea::set_content_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DrawingArea" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDrawingArea" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the width of 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_drawing_area_set_content_width" gtk_drawing_area_set_content_width :: 
    Ptr DrawingArea ->                      -- self : TInterface (Name {namespace = "Gtk", name = "DrawingArea"})
    Int32 ->                                -- width : TBasicType TInt
    IO ()

-- | Sets the desired width of the contents of the drawing area. Note that
-- because widgets may be allocated larger sizes than they requested, it is
-- possible that the actual width passed to your draw function is larger
-- than the width set here. You can use 'GI.Gtk.Objects.Widget.widgetSetHalign' to avoid
-- that.
-- 
-- If the width is set to 0 (the default), the drawing area may disappear.
drawingAreaSetContentWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrawingArea a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DrawingArea.DrawingArea'
    -> Int32
    -- ^ /@width@/: the width of contents
    -> m ()
drawingAreaSetContentWidth :: a -> Int32 -> m ()
drawingAreaSetContentWidth self :: a
self width :: Int32
width = 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 DrawingArea
self' <- a -> IO (Ptr DrawingArea)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr DrawingArea -> Int32 -> IO ()
gtk_drawing_area_set_content_width Ptr DrawingArea
self' Int32
width
    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 DrawingAreaSetContentWidthMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsDrawingArea a) => O.MethodInfo DrawingAreaSetContentWidthMethodInfo a signature where
    overloadedMethod = drawingAreaSetContentWidth

#endif

-- method DrawingArea::set_draw_func
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DrawingArea" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDrawingArea" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "draw_func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "DrawingAreaDrawFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback that lets you draw\n    the drawing area's contents"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @draw_func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drawing_area_set_draw_func" gtk_drawing_area_set_draw_func :: 
    Ptr DrawingArea ->                      -- self : TInterface (Name {namespace = "Gtk", name = "DrawingArea"})
    FunPtr Gtk.Callbacks.C_DrawingAreaDrawFunc -> -- draw_func : TInterface (Name {namespace = "Gtk", name = "DrawingAreaDrawFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Setting a draw function is the main thing you want to do when using a drawing
-- area. It is called whenever GTK needs to draw the contents of the drawing area
-- to the screen.
-- 
-- The draw function will be called during the drawing stage of GTK. In the
-- drawing stage it is not allowed to change properties of any GTK widgets or call
-- any functions that would cause any properties to be changed.
-- You should restrict yourself exclusively to drawing your contents in the draw
-- function.
-- 
-- If what you are drawing does change, call 'GI.Gtk.Objects.Widget.widgetQueueDraw' on the
-- drawing area. This will cause a redraw and will call /@drawFunc@/ again.
drawingAreaSetDrawFunc ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrawingArea a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DrawingArea.DrawingArea'
    -> Maybe (Gtk.Callbacks.DrawingAreaDrawFunc)
    -- ^ /@drawFunc@/: callback that lets you draw
    --     the drawing area\'s contents
    -> m ()
drawingAreaSetDrawFunc :: a -> Maybe DrawingAreaDrawFunc -> m ()
drawingAreaSetDrawFunc self :: a
self drawFunc :: Maybe DrawingAreaDrawFunc
drawFunc = 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 DrawingArea
self' <- a -> IO (Ptr DrawingArea)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    FunPtr C_DrawingAreaDrawFunc
maybeDrawFunc <- case Maybe DrawingAreaDrawFunc
drawFunc of
        Nothing -> FunPtr C_DrawingAreaDrawFunc -> IO (FunPtr C_DrawingAreaDrawFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_DrawingAreaDrawFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jDrawFunc :: DrawingAreaDrawFunc
jDrawFunc -> do
            FunPtr C_DrawingAreaDrawFunc
jDrawFunc' <- C_DrawingAreaDrawFunc -> IO (FunPtr C_DrawingAreaDrawFunc)
Gtk.Callbacks.mk_DrawingAreaDrawFunc (Maybe (Ptr (FunPtr C_DrawingAreaDrawFunc))
-> DrawingAreaDrawFunc_WithClosures -> C_DrawingAreaDrawFunc
Gtk.Callbacks.wrap_DrawingAreaDrawFunc Maybe (Ptr (FunPtr C_DrawingAreaDrawFunc))
forall a. Maybe a
Nothing (DrawingAreaDrawFunc -> DrawingAreaDrawFunc_WithClosures
Gtk.Callbacks.drop_closures_DrawingAreaDrawFunc DrawingAreaDrawFunc
jDrawFunc))
            FunPtr C_DrawingAreaDrawFunc -> IO (FunPtr C_DrawingAreaDrawFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_DrawingAreaDrawFunc
jDrawFunc'
    let userData :: Ptr ()
userData = FunPtr C_DrawingAreaDrawFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_DrawingAreaDrawFunc
maybeDrawFunc
    let destroy :: FunPtr (Ptr a -> IO ())
destroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr DrawingArea
-> FunPtr C_DrawingAreaDrawFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gtk_drawing_area_set_draw_func Ptr DrawingArea
self' FunPtr C_DrawingAreaDrawFunc
maybeDrawFunc Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroy
    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 DrawingAreaSetDrawFuncMethodInfo
instance (signature ~ (Maybe (Gtk.Callbacks.DrawingAreaDrawFunc) -> m ()), MonadIO m, IsDrawingArea a) => O.MethodInfo DrawingAreaSetDrawFuncMethodInfo a signature where
    overloadedMethod = drawingAreaSetDrawFunc

#endif