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





  drawWindowRaise,
  drawWindowLower,
  drawWindowRegisterDnd,
  drawWindowBeginPaintRect,



  drawWindowEndPaint,
  drawWindowInvalidateRect,




  drawWindowFreezeUpdates,
  drawWindowThawUpdates,
  drawWindowProcessUpdates,

  drawWindowSetAcceptFocus,





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



  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.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)
{-# LINE 192 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
-- | 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)
{-# LINE 289 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
-- | 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)
{-# LINE 356 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
-- | 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)
{-# LINE 491 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
-- | 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)
{-# LINE 609 "./Graphics/UI/Gtk/Gdk/DrawWindow.chs" #-}
-- | 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_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_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_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_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_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))