{-# LINE 2 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) DrawWindow
--
-- Author : Axel Simon
--
-- Created: 5 November 2002
--
-- Copyright (C) 2002-2005 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- A 'DrawWindow' is a rectangular region on the screen.
--
module Graphics.UI.Gtk.Gdk.DrawWindow (
-- A 'DrawWindow' is used to implement high-level objects such as 'Widget' and
-- 'Window' on the Gtk+ level.
--
-- Most widgets draws its content into a 'DrawWindow', in particular
-- 'DrawingArea' is nothing but a widget that contains a 'DrawWindow'.
-- This object derives from 'Drawable' which defines the basic drawing
-- primitives.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Drawable'
-- | +----DrawWindow
-- @
--

-- * Types
  DrawWindow,
  DrawWindowClass,
  castToDrawWindow, gTypeDrawWindow,
  WindowState(..),
  NativeWindowId,
  toNativeWindowId,
  fromNativeWindowId,
-- * Methods
  drawWindowGetState,
  drawWindowScroll,

  drawWindowClear,
  drawWindowClearArea,
  drawWindowClearAreaExpose,

  drawWindowRaise,
  drawWindowLower,
  drawWindowRegisterDnd,
  drawWindowBeginPaintRect,

  drawWindowBeginPaintRegion,

  drawWindowEndPaint,
  drawWindowInvalidateRect,

  drawWindowInvalidateRegion,
  drawWindowGetUpdateArea,

  drawWindowFreezeUpdates,
  drawWindowThawUpdates,
  drawWindowProcessUpdates,

  drawWindowSetAcceptFocus,


  drawWindowShapeCombineMask,
  drawWindowShapeCombineRegion,

  drawWindowSetChildShapes,
  drawWindowMergeChildShapes,
  drawWindowGetPointer,
  drawWindowGetPointerPos,
  drawWindowGetOrigin,
  drawWindowSetCursor,

  drawWindowForeignNew,

  drawWindowGetDefaultRootWindow,

  drawWindowGetWidth,
  drawWindowGetHeight,

  ) where

import Control.Monad (liftM)
import Data.Maybe (fromMaybe)

import System.Glib.FFI
import System.Glib.Flags (toFlags)
import Graphics.UI.Gtk.Types
{-# LINE 107 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
import Graphics.UI.Gtk.Gdk.Enums
{-# LINE 108 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}

import Graphics.UI.Gtk.Gdk.Region
{-# LINE 110 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}

import Graphics.UI.Gtk.Gdk.Cursor
{-# LINE 112 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
import Graphics.UI.Gtk.General.Structs


{-# LINE 115 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}

-- | Gets the bitwise OR of the currently active drawWindow state flags, from
-- the 'WindowState' enumeration.
--
drawWindowGetState :: DrawWindowClass self => self
 -> IO [WindowState] -- ^ returns @DrawWindow@ flags
drawWindowGetState :: forall self. DrawWindowClass self => self -> IO [WindowState]
drawWindowGetState self
self =
  (CInt -> [WindowState]) -> IO CInt -> IO [WindowState]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> [WindowState]
forall a. Flags a => Int -> [a]
toFlags (Int -> [WindowState]) -> (CInt -> Int) -> CInt -> [WindowState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO [WindowState]) -> IO CInt -> IO [WindowState]
forall a b. (a -> b) -> a -> b
$
  (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO CInt) -> IO CInt)
-> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO CInt
gdk_window_get_state Ptr DrawWindow
argPtr1)
{-# LINE 124 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)

-- | Scroll the contents of @DrawWindow@.
--
-- * Scroll both, pixels and children, by the given amount.
-- @DrawWindow@ itself does not move. Portions of the window that the
-- scroll operation brings inm from offscreen areas are invalidated. The
-- invalidated region may be bigger than what would strictly be necessary. (For
-- X11, a minimum area will be invalidated if the window has no subwindows, or
-- if the edges of the window's parent do not extend beyond the edges of the
-- drawWindow. In other cases, a multi-step process is used to scroll the window
-- which may produce temporary visual artifacts and unnecessary invalidations.)
--
drawWindowScroll :: DrawWindowClass self => self
 -> Int -- ^ @dx@ - Amount to scroll in the X direction
 -> Int -- ^ @dy@ - Amount to scroll in the Y direction
 -> IO ()
drawWindowScroll :: forall self. DrawWindowClass self => self -> Int -> Int -> IO ()
drawWindowScroll self
self Int
dx Int
dy =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> CInt -> CInt -> IO ()
gdk_window_scroll Ptr DrawWindow
argPtr1 CInt
arg2 CInt
arg3)
{-# LINE 143 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dx)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dy)


-- | Clears an entire @DrawWindow@ to the background color or background pixmap.
--
-- Removed in Gtk3.
drawWindowClear :: DrawWindowClass self => self -> IO ()
drawWindowClear :: forall self. DrawWindowClass self => self -> IO ()
drawWindowClear self
self =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO ()
gdk_window_clear Ptr DrawWindow
argPtr1)
{-# LINE 154 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)

-- | Clears an area of @DrawWindow@ to the background color or background pixmap.
--
-- Removed in Gtk3.
drawWindowClearArea :: DrawWindowClass self => self
 -> Int -- ^ @x@ - x coordinate of rectangle to clear
 -> Int -- ^ @y@ - y coordinate of rectangle to clear
 -> Int -- ^ @width@ - width of rectangle to clear
 -> Int -- ^ @height@ - height of rectangle to clear
 -> IO ()
drawWindowClearArea :: forall self.
DrawWindowClass self =>
self -> Int -> Int -> Int -> Int -> IO ()
drawWindowClearArea self
self Int
x Int
y Int
width Int
height =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> CInt -> CInt -> CInt -> CInt -> IO ()
gdk_window_clear_area Ptr DrawWindow
argPtr1 CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5)
{-# LINE 167 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

-- | Like 'drawWindowClearArea', but also generates an expose event for the
-- cleared area.
--
-- Removed in Gtk3.
drawWindowClearAreaExpose :: DrawWindowClass self => self
 -> Int -- ^ @x@ - x coordinate of rectangle to clear
 -> Int -- ^ @y@ - y coordinate of rectangle to clear
 -> Int -- ^ @width@ - width of rectangle to clear
 -> Int -- ^ @height@ - height of rectangle to clear
 -> IO ()
drawWindowClearAreaExpose :: forall self.
DrawWindowClass self =>
self -> Int -> Int -> Int -> Int -> IO ()
drawWindowClearAreaExpose self
self Int
x Int
y Int
width Int
height =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> CInt -> CInt -> CInt -> CInt -> IO ()
gdk_window_clear_area_e Ptr DrawWindow
argPtr1 CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5)
{-# LINE 185 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)


-- | Raises @DrawWindow@ to the top of the Z-order (stacking order), so that other
-- drawWindows with the same parent drawWindow appear below @DrawWindow@. This is true
-- whether or not the drawWindows are visible.
--
-- If @DrawWindow@ is a toplevel, the window manager may choose to deny the
-- request to move the drawWindow in the Z-order, 'drawWindowRaise' only requests the
-- restack, does not guarantee it.
--
drawWindowRaise :: DrawWindowClass self => self -> IO ()
drawWindowRaise :: forall self. DrawWindowClass self => self -> IO ()
drawWindowRaise self
self =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO ()
gdk_window_raise Ptr DrawWindow
argPtr1)
{-# LINE 203 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)

-- | Lowers @DrawWindow@ to the bottom of the Z-order (stacking order), so that
-- other windows with the same parent window appear above @DrawWindow@. This is
-- true whether or not the other windows are visible.
--
-- If @DrawWindow@ is a toplevel, the window manager may choose to deny the
-- request to move the drawWindow in the Z-order, 'drawWindowLower' only
-- requests the restack, does not guarantee it.
--
-- Note that a widget is raised automatically when it is mapped, thus you
-- need to call 'drawWindowLower' after
        -- 'Graphics.UI.Gtk.Abstract.Widget.widgetShow' if the window should
-- not appear above other windows.
--
drawWindowLower :: DrawWindowClass self => self -> IO ()
drawWindowLower :: forall self. DrawWindowClass self => self -> IO ()
drawWindowLower self
self =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO ()
gdk_window_lower Ptr DrawWindow
argPtr1)
{-# LINE 221 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)

-- | Registers a drawWindow as a potential drop destination.
--
drawWindowRegisterDnd :: DrawWindowClass self => self -> IO ()
drawWindowRegisterDnd :: forall self. DrawWindowClass self => self -> IO ()
drawWindowRegisterDnd self
self =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO ()
gdk_window_register_dnd Ptr DrawWindow
argPtr1)
{-# LINE 228 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)

-- | A convenience wrapper around 'drawWindowBeginPaintRegion' which creates a
-- rectangular region for you.
--
-- * See 'drawWindowBeginPaintRegion' for details.
--
drawWindowBeginPaintRect :: DrawWindowClass self => self
 -> Rectangle -- ^ @rectangle@ - rectangle you intend to draw to
 -> IO ()
drawWindowBeginPaintRect :: forall self. DrawWindowClass self => self -> Rectangle -> IO ()
drawWindowBeginPaintRect self
self Rectangle
rectangle = Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rectangle ((Ptr Rectangle -> IO ()) -> IO ())
-> (Ptr Rectangle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
rectPtr ->
  (\(DrawWindow ForeignPtr DrawWindow
arg1) Ptr ()
arg2 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> Ptr () -> IO ()
gdk_window_begin_paint_rect Ptr DrawWindow
argPtr1 Ptr ()
arg2) (self -> DrawWindow
forall o. DrawWindowClass o => o -> DrawWindow
toDrawWindow self
self) (Ptr Rectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
rectPtr)


-- | Indicate that you are beginning the process of redrawing @region@.
--
-- * A
-- backing store (offscreen buffer) large enough to contain @region@ will be
-- created. The backing store will be initialized with the background color or
-- background pixmap for @DrawWindow@. Then, all drawing operations performed on
-- @DrawWindow@ will be diverted to the backing store. When you call
-- 'drawWindowEndPaint', the backing store will be copied to @DrawWindow@, making it
-- visible onscreen. Only the part of @DrawWindow@ contained in @region@ will be
-- modified; that is, drawing operations are clipped to @region@.
--
-- The net result of all this is to remove flicker, because the user sees
-- the finished product appear all at once when you call 'drawWindowEndPaint'. If
-- you draw to @DrawWindow@ directly without calling 'drawWindowBeginPaintRegion', the
-- user may see flicker as individual drawing operations are performed in
-- sequence. The clipping and background-initializing features of
-- 'drawWindowBeginPaintRegion' are conveniences for the programmer, so you can
-- avoid doing that work yourself.
--
-- When using GTK+, the widget system automatically places calls to
-- 'drawWindowBeginPaintRegion' and 'drawWindowEndPaint' around emissions of the
-- @expose_event@ signal. That is, if you\'re writing an expose event handler,
-- you can assume that the exposed area in 'eventRegion' has already been
-- cleared to the window background, is already set as the clip region, and
-- already has a backing store. Therefore in most cases, application code need
-- not call 'drawWindowBeginPaintRegion'. (You can disable the automatic calls
-- around expose events on a widget-by-widget basis by calling
-- 'widgetSetDoubleBuffered'.)
--
-- If you call this function multiple times before calling the matching
-- 'drawWindowEndPaint', the backing stores are pushed onto a stack.
-- 'drawWindowEndPaint' copies the topmost backing store onscreen, subtracts the
-- topmost region from all other regions in the stack, and pops the stack. All
-- drawing operations affect only the topmost backing store in the stack. One
-- matching call to 'drawWindowEndPaint' is required for each call to
-- 'drawWindowBeginPaintRegion'.
--
-- Removed in Gtk3.
drawWindowBeginPaintRegion :: DrawWindowClass self => self
 -> Region -- ^ @region@ - region you intend to draw to
 -> IO ()
drawWindowBeginPaintRegion :: forall self. DrawWindowClass self => self -> Region -> IO ()
drawWindowBeginPaintRegion self
self Region
region =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) (Region ForeignPtr Region
arg2) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg2 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr2 ->Ptr DrawWindow -> Ptr Region -> IO ()
gdk_window_begin_paint_region Ptr DrawWindow
argPtr1 Ptr Region
argPtr2)
{-# LINE 285 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     Region
region


-- | Signal that drawing has finished.
--
-- * Indicates that the backing store created by the most recent call to
-- 'drawWindowBeginPaintRegion' should be copied onscreen and deleted, leaving the
-- next-most-recent backing store or no backing store at all as the active
-- paint region. See 'drawWindowBeginPaintRegion' for full details. It is an error
-- to call this function without a matching 'drawWindowBeginPaintRegion' first.
--
drawWindowEndPaint :: DrawWindowClass self => self -> IO ()
drawWindowEndPaint :: forall self. DrawWindowClass self => self -> IO ()
drawWindowEndPaint self
self =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO ()
gdk_window_end_paint Ptr DrawWindow
argPtr1)
{-# LINE 300 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)

-- | A convenience wrapper around 'drawWindowInvalidateRegion' which invalidates a
-- rectangular region. See 'drawWindowInvalidateRegion' for details.
--
drawWindowInvalidateRect :: DrawWindowClass self => self
 -> Rectangle -- ^ @rect@ - rectangle to invalidate
 -> Bool -- ^ @invalidateChildren@ - whether to also invalidate
                      -- child drawWindows
 -> IO ()
drawWindowInvalidateRect :: forall self.
DrawWindowClass self =>
self -> Rectangle -> Bool -> IO ()
drawWindowInvalidateRect self
self Rectangle
rect Bool
invalidateChildren =
  Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rect ((Ptr Rectangle -> IO ()) -> IO ())
-> (Ptr Rectangle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
rectPtr ->
  (\(DrawWindow ForeignPtr DrawWindow
arg1) Ptr ()
arg2 CInt
arg3 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> Ptr () -> CInt -> IO ()
gdk_window_invalidate_rect Ptr DrawWindow
argPtr1 Ptr ()
arg2 CInt
arg3)
{-# LINE 313 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     (Ptr Rectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
rectPtr)
     (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
invalidateChildren)


-- | Adds @region@ to the update area for @DrawWindow@. The update area is the
-- region that needs to be redrawn, or \"dirty region.\". During the
-- next idle period of the main look, an expose even for this region
-- will be created. An application would normally redraw
-- the contents of @DrawWindow@ in response to those expose events.
--
-- The @invalidateChildren@ parameter controls whether the region of each
-- child drawWindow that intersects @region@ will also be invalidated. If @False@,
-- then the update area for child drawWindows will remain unaffected.
--
drawWindowInvalidateRegion :: DrawWindowClass self => self
 -> Region -- ^ @region@ - a "Region"
 -> Bool -- ^ @invalidateChildren@ - @True@ to also invalidate child
                   -- drawWindows
 -> IO ()
drawWindowInvalidateRegion :: forall self.
DrawWindowClass self =>
self -> Region -> Bool -> IO ()
drawWindowInvalidateRegion self
self Region
region Bool
invalidateChildren =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) (Region ForeignPtr Region
arg2) CInt
arg3 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg2 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr2 ->Ptr DrawWindow -> Ptr Region -> CInt -> IO ()
gdk_window_invalidate_region Ptr DrawWindow
argPtr1 Ptr Region
argPtr2 CInt
arg3)
{-# LINE 335 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     Region
region
     (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
invalidateChildren)



-- | Ask for the dirty region of this window.
--
-- * Transfers ownership of the update area from @DrawWindow@ to the caller of the
-- function. That is, after calling this function, @DrawWindow@ will no longer have
-- an invalid\/dirty region; the update area is removed from @DrawWindow@ and
-- handed to you. If this window has no update area, 'drawWindowGetUpdateArea' returns 'Nothing'.
--
-- Removed in Gtk3.
drawWindowGetUpdateArea :: DrawWindowClass self => self
 -> IO (Maybe Region) -- ^ returns the update area for @DrawWindow@
drawWindowGetUpdateArea :: forall self. DrawWindowClass self => self -> IO (Maybe Region)
drawWindowGetUpdateArea self
self = do
  Ptr Region
reg <- (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow
-> (Ptr DrawWindow -> IO (Ptr Region)) -> IO (Ptr Region)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO (Ptr Region)) -> IO (Ptr Region))
-> (Ptr DrawWindow -> IO (Ptr Region)) -> IO (Ptr Region)
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO (Ptr Region)
gdk_window_get_update_area Ptr DrawWindow
argPtr1) (self -> DrawWindow
forall o. DrawWindowClass o => o -> DrawWindow
toDrawWindow self
self)
  if Ptr Region
regPtr Region -> Ptr Region -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr Region
forall a. Ptr a
nullPtr then Maybe Region -> IO (Maybe Region)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Region
forall a. Maybe a
Nothing else (Region -> Maybe Region) -> IO Region -> IO (Maybe Region)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Region -> Maybe Region
forall a. a -> Maybe a
Just (Ptr Region -> IO Region
makeNewRegion Ptr Region
reg)


-- | Temporarily freezes a drawWindow such that it won\'t receive expose events.
-- * The drawWindow will begin receiving expose events again when
-- 'drawWindowThawUpdates'
-- is called. If 'drawWindowFreezeUpdates' has been called more than once,
-- 'drawWindowThawUpdates' must be called an equal number of times to begin
-- processing exposes.
--
drawWindowFreezeUpdates :: DrawWindowClass self => self -> IO ()
drawWindowFreezeUpdates :: forall self. DrawWindowClass self => self -> IO ()
drawWindowFreezeUpdates self
self =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO ()
gdk_window_freeze_updates Ptr DrawWindow
argPtr1)
{-# LINE 366 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)

-- | Thaws a drawWindow frozen with 'drawWindowFreezeUpdates'.
--
drawWindowThawUpdates :: DrawWindowClass self => self -> IO ()
drawWindowThawUpdates :: forall self. DrawWindowClass self => self -> IO ()
drawWindowThawUpdates self
self =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO ()
gdk_window_thaw_updates Ptr DrawWindow
argPtr1)
{-# LINE 373 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)

-- | Sends one or more expose events to @DrawWindow@.
--
-- * The areas in each expose
-- event will cover the entire update area for the window (see
-- 'drawWindowInvalidateRegion' for details). Normally Gtk calls
-- 'drawWindowProcessUpdates' on your behalf, so there's no need to call this
-- function unless you want to force expose events to be delivered immediately
-- and synchronously (vs. the usual case, where Gtk delivers them in an idle
-- handler). Occasionally this is useful to produce nicer scrolling behavior,
-- for example.
--
drawWindowProcessUpdates :: DrawWindowClass self => self
 -> Bool -- ^ @updateChildren@ - whether to also process updates for child
          -- drawWindows
 -> IO ()
drawWindowProcessUpdates :: forall self. DrawWindowClass self => self -> Bool -> IO ()
drawWindowProcessUpdates self
self Bool
updateChildren =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) CInt
arg2 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> CInt -> IO ()
gdk_window_process_updates Ptr DrawWindow
argPtr1 CInt
arg2)
{-# LINE 392 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
updateChildren)


-- | Setting @acceptFocus@ to @False@ hints the desktop environment that the
-- window doesn\'t want to receive input focus.
--
-- On X, it is the responsibility of the drawWindow manager to interpret this
-- hint. ICCCM-compliant drawWindow manager usually respect it.
--
-- * Available since Gdk version 2.4
--
drawWindowSetAcceptFocus :: DrawWindowClass self => self
 -> Bool -- ^ @acceptFocus@ - @True@ if the drawWindow should receive input focus
 -> IO ()
drawWindowSetAcceptFocus :: forall self. DrawWindowClass self => self -> Bool -> IO ()
drawWindowSetAcceptFocus self
self Bool
acceptFocus =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) CInt
arg2 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> CInt -> IO ()
gdk_window_set_accept_focus Ptr DrawWindow
argPtr1 CInt
arg2)
{-# LINE 409 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
acceptFocus)



-- | Applies a shape mask to window. Pixels in window corresponding to set
-- bits in the mask will be visible; pixels in window corresponding to
-- unset bits in the mask will be transparent. This gives a non-rectangular
-- window.
--
-- * If @mask@ is @Nothing@, the shape mask will be unset, and the x\/y parameters
-- are not used. The @mask@ must be a bitmap, that is, a 'Pixmap' of depth
-- one.
--
-- * On the X11 platform, this uses an X server extension which is widely
-- available on most common platforms, but not available on very old
-- X servers, and occasionally the implementation will be buggy.
-- On servers without the shape extension, this function will do nothing.
-- On the Win32 platform the functionality is always present.
--
-- * This function works on both toplevel and child windows.
--
drawWindowShapeCombineMask :: DrawWindowClass self => self
 -> Maybe Pixmap -- ^ @mask@ - region of drawWindow to be non-transparent
 -> Int -- ^ @offsetX@ - X position of @shapeRegion@ in @DrawWindow@
                   -- coordinates
 -> Int -- ^ @offsetY@ - Y position of @shapeRegion@ in @DrawWindow@
                   -- coordinates
 -> IO ()
drawWindowShapeCombineMask :: forall self.
DrawWindowClass self =>
self -> Maybe Pixmap -> Int -> Int -> IO ()
drawWindowShapeCombineMask self
self (Just (Pixmap ForeignPtr Pixmap
mask)) Int
offsetX Int
offsetY =
  ForeignPtr Pixmap -> (Ptr Pixmap -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixmap
mask ((Ptr Pixmap -> IO ()) -> IO ()) -> (Ptr Pixmap -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixmap
maskPtr ->
  (\(DrawWindow ForeignPtr DrawWindow
arg1) Ptr ()
arg2 CInt
arg3 CInt
arg4 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> Ptr () -> CInt -> CInt -> IO ()
gdk_window_shape_combine_mask Ptr DrawWindow
argPtr1 Ptr ()
arg2 CInt
arg3 CInt
arg4)
{-# LINE 441 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     (Ptr Pixmap -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Pixmap
maskPtr)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetX)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetY)
drawWindowShapeCombineMask self
self Maybe Pixmap
Nothing Int
offsetX Int
offsetY =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) Ptr ()
arg2 CInt
arg3 CInt
arg4 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> Ptr () -> CInt -> CInt -> IO ()
gdk_window_shape_combine_mask Ptr DrawWindow
argPtr1 Ptr ()
arg2 CInt
arg3 CInt
arg4)
{-# LINE 447 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     Ptr ()
forall a. Ptr a
nullPtr
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetX)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetY)



-- | Makes pixels in @DrawWindow@ outside @shapeRegion@ transparent.
--
-- * Makes pixels in @DrawWindow@ outside @shapeRegion@ transparent, so that
-- the window may be nonrectangular.
--
-- If @shapeRegion@ is 'Nothing', the shape will be unset, so the whole
-- 'DrawWindow' will be opaque again. The parameters @offsetX@ and @offsetY@
-- are ignored if @shapeRegion@ is 'Nothing'.
--
-- On the X11 platform, this uses an X server extension which is widely
-- available on most common platforms, but not available on very old X servers,
-- and occasionally the implementation will be buggy. On servers without the
-- shape extension, this function will do nothing.
--
-- This function works on both toplevel and child drawWindows.
--
drawWindowShapeCombineRegion :: DrawWindowClass self => self
 -> Maybe Region -- ^ @shapeRegion@ - region of drawWindow to be non-transparent
 -> Int -- ^ @offsetX@ - X position of @shapeRegion@ in @DrawWindow@
                   -- coordinates
 -> Int -- ^ @offsetY@ - Y position of @shapeRegion@ in @DrawWindow@
                   -- coordinates
 -> IO ()
drawWindowShapeCombineRegion :: forall self.
DrawWindowClass self =>
self -> Maybe Region -> Int -> Int -> IO ()
drawWindowShapeCombineRegion self
self (Just Region
reg) Int
offsetX Int
offsetY =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) (Region ForeignPtr Region
arg2) CInt
arg3 CInt
arg4 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg2 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr2 ->Ptr DrawWindow -> Ptr Region -> CInt -> CInt -> IO ()
gdk_window_shape_combine_region Ptr DrawWindow
argPtr1 Ptr Region
argPtr2 CInt
arg3 CInt
arg4)
{-# LINE 479 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     Region
reg
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetX)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetY)
drawWindowShapeCombineRegion self
self Maybe Region
Nothing Int
offsetX Int
offsetY =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) (Region ForeignPtr Region
arg2) CInt
arg3 CInt
arg4 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg2 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr2 ->Ptr DrawWindow -> Ptr Region -> CInt -> CInt -> IO ()
gdk_window_shape_combine_region Ptr DrawWindow
argPtr1 Ptr Region
argPtr2 CInt
arg3 CInt
arg4)
{-# LINE 485 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)
     (ForeignPtr Region -> Region
Region ForeignPtr Region
forall a. ForeignPtr a
nullForeignPtr)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetX)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetY)


-- | Sets the shape mask of @DrawWindow@ to the union of shape masks for all
-- children of @DrawWindow@, ignoring the shape mask of @DrawWindow@ itself. Contrast
-- with 'drawWindowMergeChildShapes' which includes the shape mask of @DrawWindow@ in
-- the masks to be merged.
--
drawWindowSetChildShapes :: DrawWindowClass self => self -> IO ()
drawWindowSetChildShapes :: forall self. DrawWindowClass self => self -> IO ()
drawWindowSetChildShapes self
self =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO ()
gdk_window_set_child_shapes Ptr DrawWindow
argPtr1)
{-# LINE 499 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)

-- | Merges the shape masks for any child drawWindows into the shape mask for
-- @DrawWindow@. i.e. the union of all masks for @DrawWindow@ and its children will
-- become the new mask for @DrawWindow@. See 'drawWindowShapeCombineMask'.
--
-- This function is distinct from 'drawWindowSetChildShapes' because it includes
-- @DrawWindow@'s shape mask in the set of shapes to be merged.
--
drawWindowMergeChildShapes :: DrawWindowClass self => self -> IO ()
drawWindowMergeChildShapes :: forall self. DrawWindowClass self => self -> IO ()
drawWindowMergeChildShapes self
self =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO ()
gdk_window_merge_child_shapes Ptr DrawWindow
argPtr1)
{-# LINE 511 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
     (toDrawWindow self)

-- Superseded by 'drawWindowGetPointerPos', won't be removed.
-- Obtains the current pointer position and modifier state.
--
-- * The position is
-- given in coordinates relative to the given window.
--
-- * The return value is @Just (same, x, y, mod)@ where @same@ is @True@
-- if the passed in window is the window over which the mouse currently
-- resides.
--
-- * The return value is @Nothing@ if the mouse cursor is over a different
-- application.
--
drawWindowGetPointer :: DrawWindowClass self => self
 -> IO (Maybe (Bool, Int, Int, [Modifier]))
drawWindowGetPointer :: forall self.
DrawWindowClass self =>
self -> IO (Maybe (Bool, Int, Int, [Modifier]))
drawWindowGetPointer self
self =
  (Ptr CInt -> IO (Maybe (Bool, Int, Int, [Modifier])))
-> IO (Maybe (Bool, Int, Int, [Modifier]))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Bool, Int, Int, [Modifier])))
 -> IO (Maybe (Bool, Int, Int, [Modifier])))
-> (Ptr CInt -> IO (Maybe (Bool, Int, Int, [Modifier])))
-> IO (Maybe (Bool, Int, Int, [Modifier]))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
xPtr -> (Ptr CInt -> IO (Maybe (Bool, Int, Int, [Modifier])))
-> IO (Maybe (Bool, Int, Int, [Modifier]))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Bool, Int, Int, [Modifier])))
 -> IO (Maybe (Bool, Int, Int, [Modifier])))
-> (Ptr CInt -> IO (Maybe (Bool, Int, Int, [Modifier])))
-> IO (Maybe (Bool, Int, Int, [Modifier]))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
yPtr -> (Ptr CInt -> IO (Maybe (Bool, Int, Int, [Modifier])))
-> IO (Maybe (Bool, Int, Int, [Modifier]))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Bool, Int, Int, [Modifier])))
 -> IO (Maybe (Bool, Int, Int, [Modifier])))
-> (Ptr CInt -> IO (Maybe (Bool, Int, Int, [Modifier])))
-> IO (Maybe (Bool, Int, Int, [Modifier]))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
mPtr -> do
  Ptr DrawWindow
winPtr <- (\(DrawWindow ForeignPtr DrawWindow
arg1) Ptr CInt
arg2 Ptr CInt
arg3 Ptr CInt
arg4 -> ForeignPtr DrawWindow
-> (Ptr DrawWindow -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow))
-> (Ptr DrawWindow -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow
-> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO (Ptr DrawWindow)
gdk_window_get_pointer Ptr DrawWindow
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3 Ptr CInt
arg4) (self -> DrawWindow
forall o. DrawWindowClass o => o -> DrawWindow
toDrawWindow self
self)
     Ptr CInt
xPtr Ptr CInt
yPtr Ptr CInt
mPtr
  if Ptr DrawWindow
winPtrPtr DrawWindow -> Ptr DrawWindow -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr DrawWindow
forall a. Ptr a
nullPtr then Maybe (Bool, Int, Int, [Modifier])
-> IO (Maybe (Bool, Int, Int, [Modifier]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Bool, Int, Int, [Modifier])
forall a. Maybe a
Nothing else do
  Bool
same <- ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (DrawWindow -> ForeignPtr DrawWindow
unDrawWindow (self -> DrawWindow
forall o. DrawWindowClass o => o -> DrawWindow
toDrawWindow self
self)) ((Ptr DrawWindow -> IO Bool) -> IO Bool)
-> (Ptr DrawWindow -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
dPtr ->
          Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr DrawWindow
winPtrPtr DrawWindow -> Ptr DrawWindow -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr DrawWindow
dPtr)
  CInt
x <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
xPtr
  CInt
y <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
yPtr
  CInt
m <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
mPtr
  Maybe (Bool, Int, Int, [Modifier])
-> IO (Maybe (Bool, Int, Int, [Modifier]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Int, Int, [Modifier]) -> Maybe (Bool, Int, Int, [Modifier])
forall a. a -> Maybe a
Just (Bool
same, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y,
                Int -> [Modifier]
forall a. Flags a => Int -> [a]
toFlags (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
m)))

-- | Obtains the current pointer position and modifier state.
--
-- * The position is
-- given in coordinates relative to the given window.
--
-- * The return value is @(Just win, x, y, mod)@ where @win@ is the
-- window over which the mouse currently resides and @mod@ denotes
-- the keyboard modifiers currently being depressed.
--
-- * The return value is @Nothing@ for the window if the mouse cursor is
-- not over a known window.
--
drawWindowGetPointerPos :: DrawWindowClass self => self
 -> IO (Maybe DrawWindow, Int, Int, [Modifier])
drawWindowGetPointerPos :: forall self.
DrawWindowClass self =>
self -> IO (Maybe DrawWindow, Int, Int, [Modifier])
drawWindowGetPointerPos self
self =
  (Ptr CInt -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
-> IO (Maybe DrawWindow, Int, Int, [Modifier])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
 -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
-> (Ptr CInt -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
-> IO (Maybe DrawWindow, Int, Int, [Modifier])
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
xPtr -> (Ptr CInt -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
-> IO (Maybe DrawWindow, Int, Int, [Modifier])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
 -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
-> (Ptr CInt -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
-> IO (Maybe DrawWindow, Int, Int, [Modifier])
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
yPtr -> (Ptr CInt -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
-> IO (Maybe DrawWindow, Int, Int, [Modifier])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
 -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
-> (Ptr CInt -> IO (Maybe DrawWindow, Int, Int, [Modifier]))
-> IO (Maybe DrawWindow, Int, Int, [Modifier])
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
mPtr -> do
  Ptr DrawWindow
winPtr <- (\(DrawWindow ForeignPtr DrawWindow
arg1) Ptr CInt
arg2 Ptr CInt
arg3 Ptr CInt
arg4 -> ForeignPtr DrawWindow
-> (Ptr DrawWindow -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow))
-> (Ptr DrawWindow -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow
-> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO (Ptr DrawWindow)
gdk_window_get_pointer Ptr DrawWindow
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3 Ptr CInt
arg4) (self -> DrawWindow
forall o. DrawWindowClass o => o -> DrawWindow
toDrawWindow self
self)
     Ptr CInt
xPtr Ptr CInt
yPtr Ptr CInt
mPtr
  CInt
x <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
xPtr
  CInt
y <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
yPtr
  CInt
m <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
mPtr
  Maybe DrawWindow
mWin <- if Ptr DrawWindow
winPtrPtr DrawWindow -> Ptr DrawWindow -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr DrawWindow
forall a. Ptr a
nullPtr then Maybe DrawWindow -> IO (Maybe DrawWindow)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DrawWindow
forall a. Maybe a
Nothing else (DrawWindow -> Maybe DrawWindow)
-> IO DrawWindow -> IO (Maybe DrawWindow)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM DrawWindow -> Maybe DrawWindow
forall a. a -> Maybe a
Just (IO DrawWindow -> IO (Maybe DrawWindow))
-> IO DrawWindow -> IO (Maybe DrawWindow)
forall a b. (a -> b) -> a -> b
$
    (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
-> IO (Ptr DrawWindow) -> IO DrawWindow
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
forall {a}. (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr a)
mkDrawWindow (Ptr DrawWindow -> IO (Ptr DrawWindow)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DrawWindow
winPtr)
  (Maybe DrawWindow, Int, Int, [Modifier])
-> IO (Maybe DrawWindow, Int, Int, [Modifier])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DrawWindow
mWin, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y, Int -> [Modifier]
forall a. Flags a => Int -> [a]
toFlags (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
m))


-- | Obtains the position of a window in screen coordinates.
--
-- You can use this to help convert a position between screen coordinates and
-- local 'DrawWindow' relative coordinates.
--
drawWindowGetOrigin :: DrawWindow
 -> IO (Int, Int) -- ^ @(x, y)@
drawWindowGetOrigin :: DrawWindow -> IO (Int, Int)
drawWindowGetOrigin DrawWindow
self =
  (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
xPtr ->
  (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
yPtr -> do
  (\(DrawWindow ForeignPtr DrawWindow
arg1) Ptr CInt
arg2 Ptr CInt
arg3 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO CInt) -> IO CInt)
-> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> Ptr CInt -> Ptr CInt -> IO CInt
gdk_window_get_origin Ptr DrawWindow
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3)
{-# LINE 578 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
    (toDrawWindow self)
    Ptr CInt
xPtr
    Ptr CInt
yPtr
  CInt
x <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
xPtr
  CInt
y <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
yPtr
  (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y)

-- | Sets the mouse pointer for a 'DrawWindow'.
--
-- Use 'cursorNewForDisplay' or 'cursorNewFromPixmap' to create the cursor.
-- To make the cursor invisible, use 'BlankCursor'. Passing @Nothing@ means
-- that the @DrawWindow@ will use the cursor of its parent @DrawWindow@.
-- Most @DrawWindow@ should use this default.
--
drawWindowSetCursor :: DrawWindow -> Maybe Cursor -> IO ()
drawWindowSetCursor :: DrawWindow -> Maybe Cursor -> IO ()
drawWindowSetCursor DrawWindow
self Maybe Cursor
cursor =
  (\(DrawWindow ForeignPtr DrawWindow
arg1) (Cursor ForeignPtr Cursor
arg2) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->ForeignPtr Cursor -> (Ptr Cursor -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Cursor
arg2 ((Ptr Cursor -> IO ()) -> IO ()) -> (Ptr Cursor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cursor
argPtr2 ->Ptr DrawWindow -> Ptr Cursor -> IO ()
gdk_window_set_cursor Ptr DrawWindow
argPtr1 Ptr Cursor
argPtr2)
{-# LINE 595 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
    self
    (Cursor -> Maybe Cursor -> Cursor
forall a. a -> Maybe a -> a
fromMaybe (ForeignPtr Cursor -> Cursor
Cursor ForeignPtr Cursor
forall a. ForeignPtr a
nullForeignPtr) Maybe Cursor
cursor)


-- | Get the handle to an exising window of the windowing system. The
-- passed-in handle is a reference to a native window, that is, an Xlib XID
-- for X windows and a HWND for Win32.
--
-- Removed in Gtk3.
drawWindowForeignNew :: NativeWindowId -> IO (Maybe DrawWindow)
drawWindowForeignNew :: NativeWindowId -> IO (Maybe DrawWindow)
drawWindowForeignNew NativeWindowId
anid = (IO (Ptr DrawWindow) -> IO DrawWindow)
-> IO (Ptr DrawWindow) -> IO (Maybe DrawWindow)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
-> IO (Ptr DrawWindow) -> IO DrawWindow
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
forall {a}. (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr a)
mkDrawWindow) (IO (Ptr DrawWindow) -> IO (Maybe DrawWindow))
-> IO (Ptr DrawWindow) -> IO (Maybe DrawWindow)
forall a b. (a -> b) -> a -> b
$
  (Ptr DrawWindow -> Ptr DrawWindow)
-> IO (Ptr DrawWindow) -> IO (Ptr DrawWindow)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr DrawWindow -> Ptr DrawWindow
forall a b. Ptr a -> Ptr b
castPtr (IO (Ptr DrawWindow) -> IO (Ptr DrawWindow))
-> IO (Ptr DrawWindow) -> IO (Ptr DrawWindow)
forall a b. (a -> b) -> a -> b
$ CUInt -> IO (Ptr DrawWindow)
gdk_window_foreign_new (NativeWindowId -> CUInt
forall a. Integral a => NativeWindowId -> a
fromNativeWindowId NativeWindowId
anid)


-- | Obtains the root window (parent all other windows are inside) for the default display and screen.
drawWindowGetDefaultRootWindow ::
  IO DrawWindow -- ^ returns the default root window
drawWindowGetDefaultRootWindow :: IO DrawWindow
drawWindowGetDefaultRootWindow =
  (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
-> IO (Ptr DrawWindow) -> IO DrawWindow
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
forall {a}. (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr a)
mkDrawWindow (IO (Ptr DrawWindow) -> IO DrawWindow)
-> IO (Ptr DrawWindow) -> IO DrawWindow
forall a b. (a -> b) -> a -> b
$
  IO (Ptr DrawWindow)
gdk_get_default_root_window
{-# LINE 615 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}


-- | Returns the width of the window.
--
-- On the X11 platform the returned size is the size reported in the
-- most-recently-processed configure event, rather than the current
-- size on the X server.
--
drawWindowGetWidth :: DrawWindow -> IO Int
drawWindowGetWidth :: DrawWindow -> IO Int
drawWindowGetWidth DrawWindow
self =
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO CInt) -> IO CInt)
-> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO CInt
gdk_window_get_width Ptr DrawWindow
argPtr1) (DrawWindow -> DrawWindow
forall o. DrawWindowClass o => o -> DrawWindow
toDrawWindow DrawWindow
self)

-- | Returns the height of the window.
--
-- On the X11 platform the returned size is the size reported in the
-- most-recently-processed configure event, rather than the current
-- size on the X server.
--
drawWindowGetHeight :: DrawWindow -> IO Int
drawWindowGetHeight :: DrawWindow -> IO Int
drawWindowGetHeight DrawWindow
self =
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ (\(DrawWindow ForeignPtr DrawWindow
arg1) -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO CInt) -> IO CInt)
-> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> IO CInt
gdk_window_get_height Ptr DrawWindow
argPtr1) (DrawWindow -> DrawWindow
forall o. DrawWindowClass o => o -> DrawWindow
toDrawWindow DrawWindow
self)

foreign import ccall safe "gdk_window_get_state"
  gdk_window_get_state :: ((Ptr DrawWindow) -> (IO CInt))

foreign import ccall safe "gdk_window_scroll"
  gdk_window_scroll :: ((Ptr DrawWindow) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall safe "gdk_window_clear"
  gdk_window_clear :: ((Ptr DrawWindow) -> (IO ()))

foreign import ccall safe "gdk_window_clear_area"
  gdk_window_clear_area :: ((Ptr DrawWindow) -> (CInt -> (CInt -> (CInt -> (CInt -> (IO ()))))))

foreign import ccall safe "gdk_window_clear_area_e"
  gdk_window_clear_area_e :: ((Ptr DrawWindow) -> (CInt -> (CInt -> (CInt -> (CInt -> (IO ()))))))

foreign import ccall safe "gdk_window_raise"
  gdk_window_raise :: ((Ptr DrawWindow) -> (IO ()))

foreign import ccall safe "gdk_window_lower"
  gdk_window_lower :: ((Ptr DrawWindow) -> (IO ()))

foreign import ccall safe "gdk_window_register_dnd"
  gdk_window_register_dnd :: ((Ptr DrawWindow) -> (IO ()))

foreign import ccall safe "gdk_window_begin_paint_rect"
  gdk_window_begin_paint_rect :: ((Ptr DrawWindow) -> ((Ptr ()) -> (IO ())))

foreign import ccall safe "gdk_window_begin_paint_region"
  gdk_window_begin_paint_region :: ((Ptr DrawWindow) -> ((Ptr Region) -> (IO ())))

foreign import ccall safe "gdk_window_end_paint"
  gdk_window_end_paint :: ((Ptr DrawWindow) -> (IO ()))

foreign import ccall safe "gdk_window_invalidate_rect"
  gdk_window_invalidate_rect :: ((Ptr DrawWindow) -> ((Ptr ()) -> (CInt -> (IO ()))))

foreign import ccall safe "gdk_window_invalidate_region"
  gdk_window_invalidate_region :: ((Ptr DrawWindow) -> ((Ptr Region) -> (CInt -> (IO ()))))

foreign import ccall safe "gdk_window_get_update_area"
  gdk_window_get_update_area :: ((Ptr DrawWindow) -> (IO (Ptr Region)))

foreign import ccall safe "gdk_window_freeze_updates"
  gdk_window_freeze_updates :: ((Ptr DrawWindow) -> (IO ()))

foreign import ccall safe "gdk_window_thaw_updates"
  gdk_window_thaw_updates :: ((Ptr DrawWindow) -> (IO ()))

foreign import ccall safe "gdk_window_process_updates"
  gdk_window_process_updates :: ((Ptr DrawWindow) -> (CInt -> (IO ())))

foreign import ccall safe "gdk_window_set_accept_focus"
  gdk_window_set_accept_focus :: ((Ptr DrawWindow) -> (CInt -> (IO ())))

foreign import ccall safe "gdk_window_shape_combine_mask"
  gdk_window_shape_combine_mask :: ((Ptr DrawWindow) -> ((Ptr ()) -> (CInt -> (CInt -> (IO ())))))

foreign import ccall safe "gdk_window_shape_combine_region"
  gdk_window_shape_combine_region :: ((Ptr DrawWindow) -> ((Ptr Region) -> (CInt -> (CInt -> (IO ())))))

foreign import ccall safe "gdk_window_set_child_shapes"
  gdk_window_set_child_shapes :: ((Ptr DrawWindow) -> (IO ()))

foreign import ccall safe "gdk_window_merge_child_shapes"
  gdk_window_merge_child_shapes :: ((Ptr DrawWindow) -> (IO ()))

foreign import ccall safe "gdk_window_get_pointer"
  gdk_window_get_pointer :: ((Ptr DrawWindow) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO (Ptr DrawWindow))))))

foreign import ccall safe "gdk_window_get_origin"
  gdk_window_get_origin :: ((Ptr DrawWindow) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "gdk_window_set_cursor"
  gdk_window_set_cursor :: ((Ptr DrawWindow) -> ((Ptr Cursor) -> (IO ())))

foreign import ccall safe "gdk_window_foreign_new"
  gdk_window_foreign_new :: (CUInt -> (IO (Ptr DrawWindow)))

foreign import ccall safe "gdk_get_default_root_window"
  gdk_get_default_root_window :: (IO (Ptr DrawWindow))

foreign import ccall safe "gdk_window_get_width"
  gdk_window_get_width :: ((Ptr DrawWindow) -> (IO CInt))

foreign import ccall safe "gdk_window_get_height"
  gdk_window_get_height :: ((Ptr DrawWindow) -> (IO CInt))