{-# 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#g: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 [resize]("GI.Gtk.Objects.DrawingArea#g:signal:resize") 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/
-- >
-- >static 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);
-- >}
-- >
-- >int
-- >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);
-- >  return 0;
-- >}
-- 
-- 
-- 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 '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][gdk4-Cairo-Interaction] page
-- and the cairo documentation.
-- 
-- To receive mouse events on a drawing area, you will need to use
-- event controllers. 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.
-- 
-- 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                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [actionSetEnabled]("GI.Gtk.Objects.Widget#g:method:actionSetEnabled"), [activate]("GI.Gtk.Objects.Widget#g:method:activate"), [activateAction]("GI.Gtk.Objects.Widget#g:method:activateAction"), [activateDefault]("GI.Gtk.Objects.Widget#g:method:activateDefault"), [addController]("GI.Gtk.Objects.Widget#g:method:addController"), [addCssClass]("GI.Gtk.Objects.Widget#g:method:addCssClass"), [addMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:addMnemonicLabel"), [addTickCallback]("GI.Gtk.Objects.Widget#g:method:addTickCallback"), [allocate]("GI.Gtk.Objects.Widget#g:method:allocate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [childFocus]("GI.Gtk.Objects.Widget#g:method:childFocus"), [computeBounds]("GI.Gtk.Objects.Widget#g:method:computeBounds"), [computeExpand]("GI.Gtk.Objects.Widget#g:method:computeExpand"), [computePoint]("GI.Gtk.Objects.Widget#g:method:computePoint"), [computeTransform]("GI.Gtk.Objects.Widget#g:method:computeTransform"), [contains]("GI.Gtk.Objects.Widget#g:method:contains"), [createPangoContext]("GI.Gtk.Objects.Widget#g:method:createPangoContext"), [createPangoLayout]("GI.Gtk.Objects.Widget#g:method:createPangoLayout"), [dragCheckThreshold]("GI.Gtk.Objects.Widget#g:method:dragCheckThreshold"), [errorBell]("GI.Gtk.Objects.Widget#g:method:errorBell"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [grabFocus]("GI.Gtk.Objects.Widget#g:method:grabFocus"), [hasCssClass]("GI.Gtk.Objects.Widget#g:method:hasCssClass"), [hasDefault]("GI.Gtk.Objects.Widget#g:method:hasDefault"), [hasFocus]("GI.Gtk.Objects.Widget#g:method:hasFocus"), [hasVisibleFocus]("GI.Gtk.Objects.Widget#g:method:hasVisibleFocus"), [hide]("GI.Gtk.Objects.Widget#g:method:hide"), [inDestruction]("GI.Gtk.Objects.Widget#g:method:inDestruction"), [initTemplate]("GI.Gtk.Objects.Widget#g:method:initTemplate"), [insertActionGroup]("GI.Gtk.Objects.Widget#g:method:insertActionGroup"), [insertAfter]("GI.Gtk.Objects.Widget#g:method:insertAfter"), [insertBefore]("GI.Gtk.Objects.Widget#g:method:insertBefore"), [isAncestor]("GI.Gtk.Objects.Widget#g:method:isAncestor"), [isDrawable]("GI.Gtk.Objects.Widget#g:method:isDrawable"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isFocus]("GI.Gtk.Objects.Widget#g:method:isFocus"), [isSensitive]("GI.Gtk.Objects.Widget#g:method:isSensitive"), [isVisible]("GI.Gtk.Objects.Widget#g:method:isVisible"), [keynavFailed]("GI.Gtk.Objects.Widget#g:method:keynavFailed"), [listMnemonicLabels]("GI.Gtk.Objects.Widget#g:method:listMnemonicLabels"), [map]("GI.Gtk.Objects.Widget#g:method:map"), [measure]("GI.Gtk.Objects.Widget#g:method:measure"), [mnemonicActivate]("GI.Gtk.Objects.Widget#g:method:mnemonicActivate"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [observeChildren]("GI.Gtk.Objects.Widget#g:method:observeChildren"), [observeControllers]("GI.Gtk.Objects.Widget#g:method:observeControllers"), [pick]("GI.Gtk.Objects.Widget#g:method:pick"), [queueAllocate]("GI.Gtk.Objects.Widget#g:method:queueAllocate"), [queueDraw]("GI.Gtk.Objects.Widget#g:method:queueDraw"), [queueResize]("GI.Gtk.Objects.Widget#g:method:queueResize"), [realize]("GI.Gtk.Objects.Widget#g:method:realize"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeController]("GI.Gtk.Objects.Widget#g:method:removeController"), [removeCssClass]("GI.Gtk.Objects.Widget#g:method:removeCssClass"), [removeMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:removeMnemonicLabel"), [removeTickCallback]("GI.Gtk.Objects.Widget#g:method:removeTickCallback"), [resetProperty]("GI.Gtk.Interfaces.Accessible#g:method:resetProperty"), [resetRelation]("GI.Gtk.Interfaces.Accessible#g:method:resetRelation"), [resetState]("GI.Gtk.Interfaces.Accessible#g:method:resetState"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [shouldLayout]("GI.Gtk.Objects.Widget#g:method:shouldLayout"), [show]("GI.Gtk.Objects.Widget#g:method:show"), [sizeAllocate]("GI.Gtk.Objects.Widget#g:method:sizeAllocate"), [snapshotChild]("GI.Gtk.Objects.Widget#g:method:snapshotChild"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [translateCoordinates]("GI.Gtk.Objects.Widget#g:method:translateCoordinates"), [triggerTooltipQuery]("GI.Gtk.Objects.Widget#g:method:triggerTooltipQuery"), [unmap]("GI.Gtk.Objects.Widget#g:method:unmap"), [unparent]("GI.Gtk.Objects.Widget#g:method:unparent"), [unrealize]("GI.Gtk.Objects.Widget#g:method:unrealize"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unsetStateFlags]("GI.Gtk.Objects.Widget#g:method:unsetStateFlags"), [updateProperty]("GI.Gtk.Interfaces.Accessible#g:method:updateProperty"), [updateRelation]("GI.Gtk.Interfaces.Accessible#g:method:updateRelation"), [updateState]("GI.Gtk.Interfaces.Accessible#g:method:updateState"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAccessibleRole]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleRole"), [getAllocatedBaseline]("GI.Gtk.Objects.Widget#g:method:getAllocatedBaseline"), [getAllocatedHeight]("GI.Gtk.Objects.Widget#g:method:getAllocatedHeight"), [getAllocatedWidth]("GI.Gtk.Objects.Widget#g:method:getAllocatedWidth"), [getAllocation]("GI.Gtk.Objects.Widget#g:method:getAllocation"), [getAncestor]("GI.Gtk.Objects.Widget#g:method:getAncestor"), [getBuildableId]("GI.Gtk.Interfaces.Buildable#g:method:getBuildableId"), [getCanFocus]("GI.Gtk.Objects.Widget#g:method:getCanFocus"), [getCanTarget]("GI.Gtk.Objects.Widget#g:method:getCanTarget"), [getChildVisible]("GI.Gtk.Objects.Widget#g:method:getChildVisible"), [getClipboard]("GI.Gtk.Objects.Widget#g:method:getClipboard"), [getContentHeight]("GI.Gtk.Objects.DrawingArea#g:method:getContentHeight"), [getContentWidth]("GI.Gtk.Objects.DrawingArea#g:method:getContentWidth"), [getCssClasses]("GI.Gtk.Objects.Widget#g:method:getCssClasses"), [getCssName]("GI.Gtk.Objects.Widget#g:method:getCssName"), [getCursor]("GI.Gtk.Objects.Widget#g:method:getCursor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDirection]("GI.Gtk.Objects.Widget#g:method:getDirection"), [getDisplay]("GI.Gtk.Objects.Widget#g:method:getDisplay"), [getFirstChild]("GI.Gtk.Objects.Widget#g:method:getFirstChild"), [getFocusChild]("GI.Gtk.Objects.Widget#g:method:getFocusChild"), [getFocusOnClick]("GI.Gtk.Objects.Widget#g:method:getFocusOnClick"), [getFocusable]("GI.Gtk.Objects.Widget#g:method:getFocusable"), [getFontMap]("GI.Gtk.Objects.Widget#g:method:getFontMap"), [getFontOptions]("GI.Gtk.Objects.Widget#g:method:getFontOptions"), [getFrameClock]("GI.Gtk.Objects.Widget#g:method:getFrameClock"), [getHalign]("GI.Gtk.Objects.Widget#g:method:getHalign"), [getHasTooltip]("GI.Gtk.Objects.Widget#g:method:getHasTooltip"), [getHeight]("GI.Gtk.Objects.Widget#g:method:getHeight"), [getHexpand]("GI.Gtk.Objects.Widget#g:method:getHexpand"), [getHexpandSet]("GI.Gtk.Objects.Widget#g:method:getHexpandSet"), [getLastChild]("GI.Gtk.Objects.Widget#g:method:getLastChild"), [getLayoutManager]("GI.Gtk.Objects.Widget#g:method:getLayoutManager"), [getMapped]("GI.Gtk.Objects.Widget#g:method:getMapped"), [getMarginBottom]("GI.Gtk.Objects.Widget#g:method:getMarginBottom"), [getMarginEnd]("GI.Gtk.Objects.Widget#g:method:getMarginEnd"), [getMarginStart]("GI.Gtk.Objects.Widget#g:method:getMarginStart"), [getMarginTop]("GI.Gtk.Objects.Widget#g:method:getMarginTop"), [getName]("GI.Gtk.Objects.Widget#g:method:getName"), [getNative]("GI.Gtk.Objects.Widget#g:method:getNative"), [getNextSibling]("GI.Gtk.Objects.Widget#g:method:getNextSibling"), [getOpacity]("GI.Gtk.Objects.Widget#g:method:getOpacity"), [getOverflow]("GI.Gtk.Objects.Widget#g:method:getOverflow"), [getPangoContext]("GI.Gtk.Objects.Widget#g:method:getPangoContext"), [getParent]("GI.Gtk.Objects.Widget#g:method:getParent"), [getPreferredSize]("GI.Gtk.Objects.Widget#g:method:getPreferredSize"), [getPrevSibling]("GI.Gtk.Objects.Widget#g:method:getPrevSibling"), [getPrimaryClipboard]("GI.Gtk.Objects.Widget#g:method:getPrimaryClipboard"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRealized]("GI.Gtk.Objects.Widget#g:method:getRealized"), [getReceivesDefault]("GI.Gtk.Objects.Widget#g:method:getReceivesDefault"), [getRequestMode]("GI.Gtk.Objects.Widget#g:method:getRequestMode"), [getRoot]("GI.Gtk.Objects.Widget#g:method:getRoot"), [getScaleFactor]("GI.Gtk.Objects.Widget#g:method:getScaleFactor"), [getSensitive]("GI.Gtk.Objects.Widget#g:method:getSensitive"), [getSettings]("GI.Gtk.Objects.Widget#g:method:getSettings"), [getSize]("GI.Gtk.Objects.Widget#g:method:getSize"), [getSizeRequest]("GI.Gtk.Objects.Widget#g:method:getSizeRequest"), [getStateFlags]("GI.Gtk.Objects.Widget#g:method:getStateFlags"), [getStyleContext]("GI.Gtk.Objects.Widget#g:method:getStyleContext"), [getTemplateChild]("GI.Gtk.Objects.Widget#g:method:getTemplateChild"), [getTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:getTooltipMarkup"), [getTooltipText]("GI.Gtk.Objects.Widget#g:method:getTooltipText"), [getValign]("GI.Gtk.Objects.Widget#g:method:getValign"), [getVexpand]("GI.Gtk.Objects.Widget#g:method:getVexpand"), [getVexpandSet]("GI.Gtk.Objects.Widget#g:method:getVexpandSet"), [getVisible]("GI.Gtk.Objects.Widget#g:method:getVisible"), [getWidth]("GI.Gtk.Objects.Widget#g:method:getWidth").
-- 
-- ==== Setters
-- [setCanFocus]("GI.Gtk.Objects.Widget#g:method:setCanFocus"), [setCanTarget]("GI.Gtk.Objects.Widget#g:method:setCanTarget"), [setChildVisible]("GI.Gtk.Objects.Widget#g:method:setChildVisible"), [setContentHeight]("GI.Gtk.Objects.DrawingArea#g:method:setContentHeight"), [setContentWidth]("GI.Gtk.Objects.DrawingArea#g:method:setContentWidth"), [setCssClasses]("GI.Gtk.Objects.Widget#g:method:setCssClasses"), [setCursor]("GI.Gtk.Objects.Widget#g:method:setCursor"), [setCursorFromName]("GI.Gtk.Objects.Widget#g:method:setCursorFromName"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDirection]("GI.Gtk.Objects.Widget#g:method:setDirection"), [setDrawFunc]("GI.Gtk.Objects.DrawingArea#g:method:setDrawFunc"), [setFocusChild]("GI.Gtk.Objects.Widget#g:method:setFocusChild"), [setFocusOnClick]("GI.Gtk.Objects.Widget#g:method:setFocusOnClick"), [setFocusable]("GI.Gtk.Objects.Widget#g:method:setFocusable"), [setFontMap]("GI.Gtk.Objects.Widget#g:method:setFontMap"), [setFontOptions]("GI.Gtk.Objects.Widget#g:method:setFontOptions"), [setHalign]("GI.Gtk.Objects.Widget#g:method:setHalign"), [setHasTooltip]("GI.Gtk.Objects.Widget#g:method:setHasTooltip"), [setHexpand]("GI.Gtk.Objects.Widget#g:method:setHexpand"), [setHexpandSet]("GI.Gtk.Objects.Widget#g:method:setHexpandSet"), [setLayoutManager]("GI.Gtk.Objects.Widget#g:method:setLayoutManager"), [setMarginBottom]("GI.Gtk.Objects.Widget#g:method:setMarginBottom"), [setMarginEnd]("GI.Gtk.Objects.Widget#g:method:setMarginEnd"), [setMarginStart]("GI.Gtk.Objects.Widget#g:method:setMarginStart"), [setMarginTop]("GI.Gtk.Objects.Widget#g:method:setMarginTop"), [setName]("GI.Gtk.Objects.Widget#g:method:setName"), [setOpacity]("GI.Gtk.Objects.Widget#g:method:setOpacity"), [setOverflow]("GI.Gtk.Objects.Widget#g:method:setOverflow"), [setParent]("GI.Gtk.Objects.Widget#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setReceivesDefault]("GI.Gtk.Objects.Widget#g:method:setReceivesDefault"), [setSensitive]("GI.Gtk.Objects.Widget#g:method:setSensitive"), [setSizeRequest]("GI.Gtk.Objects.Widget#g:method:setSizeRequest"), [setStateFlags]("GI.Gtk.Objects.Widget#g:method:setStateFlags"), [setTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:setTooltipMarkup"), [setTooltipText]("GI.Gtk.Objects.Widget#g:method:setTooltipText"), [setValign]("GI.Gtk.Objects.Widget#g:method:setValign"), [setVexpand]("GI.Gtk.Objects.Widget#g:method:setVexpand"), [setVexpandSet]("GI.Gtk.Objects.Widget#g:method:setVexpandSet"), [setVisible]("GI.Gtk.Objects.Widget#g:method:setVisible").

#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              ,




 -- * Signals


-- ** resize #signal:resize#

    C_DrawingAreaResizeCallback             ,
    DrawingAreaResizeCallback               ,
#if defined(ENABLE_OVERLOADING)
    DrawingAreaResizeSignalInfo             ,
#endif
    afterDrawingAreaResize                  ,
    genClosure_DrawingAreaResize            ,
    mk_DrawingAreaResizeCallback            ,
    noDrawingAreaResizeCallback             ,
    onDrawingAreaResize                     ,
    wrap_DrawingAreaResizeCallback          ,




    ) where

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

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

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.Accessible as Gtk.Accessible
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

-- | Memory-managed wrapper type.
newtype DrawingArea = DrawingArea (SP.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)

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

foreign import ccall "gtk_drawing_area_get_type"
    c_gtk_drawing_area_get_type :: IO B.Types.GType

instance B.Types.TypedObject DrawingArea where
    glibType :: IO GType
glibType = IO GType
c_gtk_drawing_area_get_type

instance B.Types.GObject DrawingArea

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

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

-- | Cast to `DrawingArea`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toDrawingArea :: (MIO.MonadIO m, IsDrawingArea o) => o -> m DrawingArea
toDrawingArea :: forall (m :: * -> *) o.
(MonadIO m, IsDrawingArea o) =>
o -> m DrawingArea
toDrawingArea = IO DrawingArea -> m DrawingArea
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr DrawingArea -> DrawingArea
DrawingArea

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDrawingAreaMethod (t :: Symbol) (o :: *) :: * where
    ResolveDrawingAreaMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveDrawingAreaMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveDrawingAreaMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveDrawingAreaMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveDrawingAreaMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveDrawingAreaMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    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 "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 "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveDrawingAreaMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveDrawingAreaMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveDrawingAreaMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveDrawingAreaMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveDrawingAreaMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDrawingAreaMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDrawingAreaMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDrawingAreaMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveDrawingAreaMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveDrawingAreaMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveDrawingAreaMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    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 "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 "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveDrawingAreaMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    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 "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveDrawingAreaMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveDrawingAreaMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveDrawingAreaMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveDrawingAreaMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveDrawingAreaMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDrawingAreaMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDrawingAreaMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveDrawingAreaMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveDrawingAreaMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveDrawingAreaMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveDrawingAreaMethod "resetProperty" o = Gtk.Accessible.AccessibleResetPropertyMethodInfo
    ResolveDrawingAreaMethod "resetRelation" o = Gtk.Accessible.AccessibleResetRelationMethodInfo
    ResolveDrawingAreaMethod "resetState" o = Gtk.Accessible.AccessibleResetStateMethodInfo
    ResolveDrawingAreaMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDrawingAreaMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    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 "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveDrawingAreaMethod "updateProperty" o = Gtk.Accessible.AccessibleUpdatePropertyMethodInfo
    ResolveDrawingAreaMethod "updateRelation" o = Gtk.Accessible.AccessibleUpdateRelationMethodInfo
    ResolveDrawingAreaMethod "updateState" o = Gtk.Accessible.AccessibleUpdateStateMethodInfo
    ResolveDrawingAreaMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDrawingAreaMethod "getAccessibleRole" o = Gtk.Accessible.AccessibleGetAccessibleRoleMethodInfo
    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 "getBuildableId" o = Gtk.Buildable.BuildableGetBuildableIdMethodInfo
    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 "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveDrawingAreaMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    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 "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    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 "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveDrawingAreaMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveDrawingAreaMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveDrawingAreaMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    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 "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveDrawingAreaMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    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 "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 "getSize" o = Gtk.Widget.WidgetGetSizeMethodInfo
    ResolveDrawingAreaMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveDrawingAreaMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveDrawingAreaMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveDrawingAreaMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveDrawingAreaMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveDrawingAreaMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    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 "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 "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    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 "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveDrawingAreaMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveDrawingAreaMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveDrawingAreaMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    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 "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveDrawingAreaMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    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.OverloadedMethod 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

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

#endif

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

#endif

-- signal DrawingArea::resize
-- | The [resize](#g:signal:resize) signal is emitted once when the widget is realized, and
-- then each time the widget is changed while realized. This is useful
-- in order to keep state up to date with the widget size, like for
-- instance a backing surface.
type DrawingAreaResizeCallback =
    Int32
    -- ^ /@width@/: the width of the viewport
    -> Int32
    -- ^ /@height@/: the height of the viewport
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `DrawingAreaResizeCallback`@.
noDrawingAreaResizeCallback :: Maybe DrawingAreaResizeCallback
noDrawingAreaResizeCallback :: Maybe DrawingAreaResizeCallback
noDrawingAreaResizeCallback = Maybe DrawingAreaResizeCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_DrawingAreaResizeCallback =
    Ptr () ->                               -- object
    Int32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_DrawingAreaResizeCallback`.
foreign import ccall "wrapper"
    mk_DrawingAreaResizeCallback :: C_DrawingAreaResizeCallback -> IO (FunPtr C_DrawingAreaResizeCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_DrawingAreaResize :: MonadIO m => DrawingAreaResizeCallback -> m (GClosure C_DrawingAreaResizeCallback)
genClosure_DrawingAreaResize :: forall (m :: * -> *).
MonadIO m =>
DrawingAreaResizeCallback
-> m (GClosure C_DrawingAreaResizeCallback)
genClosure_DrawingAreaResize DrawingAreaResizeCallback
cb = IO (GClosure C_DrawingAreaResizeCallback)
-> m (GClosure C_DrawingAreaResizeCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DrawingAreaResizeCallback)
 -> m (GClosure C_DrawingAreaResizeCallback))
-> IO (GClosure C_DrawingAreaResizeCallback)
-> m (GClosure C_DrawingAreaResizeCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DrawingAreaResizeCallback
cb' = DrawingAreaResizeCallback -> C_DrawingAreaResizeCallback
wrap_DrawingAreaResizeCallback DrawingAreaResizeCallback
cb
    C_DrawingAreaResizeCallback
-> IO (FunPtr C_DrawingAreaResizeCallback)
mk_DrawingAreaResizeCallback C_DrawingAreaResizeCallback
cb' IO (FunPtr C_DrawingAreaResizeCallback)
-> (FunPtr C_DrawingAreaResizeCallback
    -> IO (GClosure C_DrawingAreaResizeCallback))
-> IO (GClosure C_DrawingAreaResizeCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DrawingAreaResizeCallback
-> IO (GClosure C_DrawingAreaResizeCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DrawingAreaResizeCallback` into a `C_DrawingAreaResizeCallback`.
wrap_DrawingAreaResizeCallback ::
    DrawingAreaResizeCallback ->
    C_DrawingAreaResizeCallback
wrap_DrawingAreaResizeCallback :: DrawingAreaResizeCallback -> C_DrawingAreaResizeCallback
wrap_DrawingAreaResizeCallback DrawingAreaResizeCallback
_cb Ptr ()
_ Int32
width Int32
height Ptr ()
_ = do
    DrawingAreaResizeCallback
_cb  Int32
width Int32
height


-- | Connect a signal handler for the [resize](#signal:resize) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' drawingArea #resize callback
-- @
-- 
-- 
onDrawingAreaResize :: (IsDrawingArea a, MonadIO m) => a -> DrawingAreaResizeCallback -> m SignalHandlerId
onDrawingAreaResize :: forall a (m :: * -> *).
(IsDrawingArea a, MonadIO m) =>
a -> DrawingAreaResizeCallback -> m SignalHandlerId
onDrawingAreaResize a
obj DrawingAreaResizeCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DrawingAreaResizeCallback
cb' = DrawingAreaResizeCallback -> C_DrawingAreaResizeCallback
wrap_DrawingAreaResizeCallback DrawingAreaResizeCallback
cb
    FunPtr C_DrawingAreaResizeCallback
cb'' <- C_DrawingAreaResizeCallback
-> IO (FunPtr C_DrawingAreaResizeCallback)
mk_DrawingAreaResizeCallback C_DrawingAreaResizeCallback
cb'
    a
-> Text
-> FunPtr C_DrawingAreaResizeCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"resize" FunPtr C_DrawingAreaResizeCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [resize](#signal:resize) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' drawingArea #resize callback
-- @
-- 
-- 
afterDrawingAreaResize :: (IsDrawingArea a, MonadIO m) => a -> DrawingAreaResizeCallback -> m SignalHandlerId
afterDrawingAreaResize :: forall a (m :: * -> *).
(IsDrawingArea a, MonadIO m) =>
a -> DrawingAreaResizeCallback -> m SignalHandlerId
afterDrawingAreaResize a
obj DrawingAreaResizeCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DrawingAreaResizeCallback
cb' = DrawingAreaResizeCallback -> C_DrawingAreaResizeCallback
wrap_DrawingAreaResizeCallback DrawingAreaResizeCallback
cb
    FunPtr C_DrawingAreaResizeCallback
cb'' <- C_DrawingAreaResizeCallback
-> IO (FunPtr C_DrawingAreaResizeCallback)
mk_DrawingAreaResizeCallback C_DrawingAreaResizeCallback
cb'
    a
-> Text
-> FunPtr C_DrawingAreaResizeCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"resize" FunPtr C_DrawingAreaResizeCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DrawingAreaResizeSignalInfo
instance SignalInfo DrawingAreaResizeSignalInfo where
    type HaskellCallbackType DrawingAreaResizeSignalInfo = DrawingAreaResizeCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DrawingAreaResizeCallback cb
        cb'' <- mk_DrawingAreaResizeCallback cb'
        connectSignalFunPtr obj "resize" cb'' connectMode detail

#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 :: forall (m :: * -> *) o.
(MonadIO m, IsDrawingArea o) =>
o -> m Int32
getDrawingAreaContentHeight o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"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 :: forall (m :: * -> *) o.
(MonadIO m, IsDrawingArea o) =>
o -> Int32 -> m ()
setDrawingAreaContentHeight o
obj Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"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, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructDrawingAreaContentHeight :: forall o (m :: * -> *).
(IsDrawingArea o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructDrawingAreaContentHeight Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"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 :: forall (m :: * -> *) o.
(MonadIO m, IsDrawingArea o) =>
o -> m Int32
getDrawingAreaContentWidth o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"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 :: forall (m :: * -> *) o.
(MonadIO m, IsDrawingArea o) =>
o -> Int32 -> m ()
setDrawingAreaContentWidth o
obj Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"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, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructDrawingAreaContentWidth :: forall o (m :: * -> *).
(IsDrawingArea o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructDrawingAreaContentWidth Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"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 = ('[ '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("contentHeight", DrawingAreaContentHeightPropertyInfo), '("contentWidth", DrawingAreaContentWidthPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("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), '("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 = ('[ '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("resize", DrawingAreaResizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => 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 Text
"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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrawingArea a) =>
a -> m Int32
drawingAreaGetContentHeight 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.OverloadedMethod DrawingAreaGetContentHeightMethodInfo a signature where
    overloadedMethod = drawingAreaGetContentHeight

instance O.OverloadedMethodInfo DrawingAreaGetContentHeightMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.DrawingArea.drawingAreaGetContentHeight",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-DrawingArea.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrawingArea a) =>
a -> m Int32
drawingAreaGetContentWidth 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.OverloadedMethod DrawingAreaGetContentWidthMethodInfo a signature where
    overloadedMethod = drawingAreaGetContentWidth

instance O.OverloadedMethodInfo DrawingAreaGetContentWidthMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.DrawingArea.drawingAreaGetContentWidth",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-DrawingArea.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrawingArea a) =>
a -> Int32 -> m ()
drawingAreaSetContentHeight a
self 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.OverloadedMethod DrawingAreaSetContentHeightMethodInfo a signature where
    overloadedMethod = drawingAreaSetContentHeight

instance O.OverloadedMethodInfo DrawingAreaSetContentHeightMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.DrawingArea.drawingAreaSetContentHeight",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-DrawingArea.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrawingArea a) =>
a -> Int32 -> m ()
drawingAreaSetContentWidth a
self 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.OverloadedMethod DrawingAreaSetContentWidthMethodInfo a signature where
    overloadedMethod = drawingAreaSetContentWidth

instance O.OverloadedMethodInfo DrawingAreaSetContentWidthMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.DrawingArea.drawingAreaSetContentWidth",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-DrawingArea.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrawingArea a) =>
a -> Maybe DrawingAreaDrawFunc -> m ()
drawingAreaSetDrawFunc a
self 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
        Maybe DrawingAreaDrawFunc
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 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 ())
SP.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.OverloadedMethod DrawingAreaSetDrawFuncMethodInfo a signature where
    overloadedMethod = drawingAreaSetDrawFunc

instance O.OverloadedMethodInfo DrawingAreaSetDrawFuncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gtk.Objects.DrawingArea.drawingAreaSetDrawFunc",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gtk-4.0.4/docs/GI-Gtk-Objects-DrawingArea.html#v:drawingAreaSetDrawFunc"
        }


#endif