{-# LANGUAGE ScopedTypeVariables #-}

{-# LINE 2 "./Graphics/UI/Gtk/Gdk/Region.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Region
--
-- Author : Axel Simon
--
-- Created: 22 September 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.
--
-- TODO
--
-- The Span functions and callbacks are not implemented since retrieving
-- a set of rectangles and working on them within Haskell seems to be easier.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- A set of rectangles describing areas to be redrawn.
--
-- * Regions consist of a set of non-overlapping rectangles. They are used to
-- specify the area of a window which needs updating.
--
-- This module is empty when built with Gtk3 because Pixmap has been
-- removed.
module Graphics.UI.Gtk.Gdk.Region (

  makeNewRegion,
  Region(Region),
  regionNew,
  FillRule(..),
  regionPolygon,
  regionCopy,
  regionRectangle,
  regionGetClipbox,
  regionGetRectangles,
  regionEmpty,
  regionEqual,
  regionPointIn,
  OverlapType(..),
  regionRectIn,
  regionOffset,
  regionShrink,
  regionUnionWithRect,
  regionIntersect,
  regionUnion,
  regionSubtract,
  regionXor

  ) where



import Control.Monad (liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.General.Structs (Point, Rectangle(..))


{-# LINE 72 "./Graphics/UI/Gtk/Gdk/Region.chs" #-}

newtype Region = Region (ForeignPtr (Region))
{-# LINE 74 "./Graphics/UI/Gtk/Gdk/Region.chs" #-}

instance Show Region where
  show :: Region -> String
show Region
r = [Rectangle] -> String
forall a. Show a => a -> String
show (IO [Rectangle] -> [Rectangle]
forall a. IO a -> a
unsafePerformIO (Region -> IO [Rectangle]
regionGetRectangles Region
r))

-- Construct a region from a pointer.
--
makeNewRegion :: Ptr Region -> IO Region
makeNewRegion :: Ptr Region -> IO Region
makeNewRegion Ptr Region
rPtr = do
  ForeignPtr Region
region <- Ptr Region -> FinalizerPtr Region -> IO (ForeignPtr Region)
forall a. Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)
newForeignPtr Ptr Region
rPtr FinalizerPtr Region
region_destroy
  Region -> IO Region
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Region -> Region
Region ForeignPtr Region
region)

foreign import ccall unsafe "&gdk_region_destroy"
  region_destroy :: FinalizerPtr Region

-- | Specify how to interpret a polygon.
--
-- * The flag determines what happens if a polygon has overlapping areas.
--
data FillRule = EvenOddRule
              | WindingRule
              deriving (Int -> FillRule
FillRule -> Int
FillRule -> [FillRule]
FillRule -> FillRule
FillRule -> FillRule -> [FillRule]
FillRule -> FillRule -> FillRule -> [FillRule]
(FillRule -> FillRule)
-> (FillRule -> FillRule)
-> (Int -> FillRule)
-> (FillRule -> Int)
-> (FillRule -> [FillRule])
-> (FillRule -> FillRule -> [FillRule])
-> (FillRule -> FillRule -> [FillRule])
-> (FillRule -> FillRule -> FillRule -> [FillRule])
-> Enum FillRule
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: FillRule -> FillRule
succ :: FillRule -> FillRule
$cpred :: FillRule -> FillRule
pred :: FillRule -> FillRule
$ctoEnum :: Int -> FillRule
toEnum :: Int -> FillRule
$cfromEnum :: FillRule -> Int
fromEnum :: FillRule -> Int
$cenumFrom :: FillRule -> [FillRule]
enumFrom :: FillRule -> [FillRule]
$cenumFromThen :: FillRule -> FillRule -> [FillRule]
enumFromThen :: FillRule -> FillRule -> [FillRule]
$cenumFromTo :: FillRule -> FillRule -> [FillRule]
enumFromTo :: FillRule -> FillRule -> [FillRule]
$cenumFromThenTo :: FillRule -> FillRule -> FillRule -> [FillRule]
enumFromThenTo :: FillRule -> FillRule -> FillRule -> [FillRule]
Enum)

{-# LINE 93 "./Graphics/UI/Gtk/Gdk/Region.chs" #-}

-- | How a rectangle is contained in a 'Region'.
--
data OverlapType = OverlapRectangleIn
                 | OverlapRectangleOut
                 | OverlapRectanglePart
                 deriving (Enum)

{-# LINE 97 "./Graphics/UI/Gtk/Gdk/Region.chs" #-}

-- | Create an empty region.
--
regionNew :: IO Region
regionNew = do
  rPtr <- gdk_region_new
{-# LINE 103 "./Graphics/UI/Gtk/Gdk/Region.chs" #-}
  makeNewRegion rPtr

-- | Convert a polygon into a 'Region'.
--
regionPolygon :: [Point] -> FillRule -> IO Region
regionPolygon :: [Point] -> FillRule -> IO Region
regionPolygon [Point]
points FillRule
rule =
  [CInt] -> (Ptr CInt -> IO Region) -> IO Region
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((Point -> [CInt]) -> [Point] -> [CInt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
x,Int
y) -> [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]) [Point]
points) ((Ptr CInt -> IO Region) -> IO Region)
-> (Ptr CInt -> IO Region) -> IO Region
forall a b. (a -> b) -> a -> b
$
  \(Ptr CInt
aPtr :: Ptr (CInt)) -> do
    Ptr Region
rPtr <- Ptr () -> CInt -> CInt -> IO (Ptr Region)
gdk_region_polygon (Ptr CInt -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
aPtr)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Point] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point]
points)) ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> CInt) -> (FillRule -> Int) -> FillRule -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FillRule -> Int
forall a. Enum a => a -> Int
fromEnum) FillRule
rule)
    Ptr Region -> IO Region
makeNewRegion Ptr Region
rPtr

-- | Copy a 'Region'.
--
regionCopy :: Region -> IO Region
regionCopy :: Region -> IO Region
regionCopy Region
r = do
  Ptr Region
rPtr <- (\(Region ForeignPtr Region
arg1) -> ForeignPtr Region
-> (Ptr Region -> IO (Ptr Region)) -> IO (Ptr Region)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO (Ptr Region)) -> IO (Ptr Region))
-> (Ptr Region -> IO (Ptr Region)) -> IO (Ptr Region)
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr1 ->Ptr Region -> IO (Ptr Region)
gdk_region_copy Ptr Region
argPtr1) Region
r
  Ptr Region -> IO Region
makeNewRegion Ptr Region
rPtr

-- | Convert a rectangle to a 'Region'.
--
regionRectangle :: Rectangle -> IO Region
regionRectangle :: Rectangle -> IO Region
regionRectangle Rectangle
rect = Rectangle -> (Ptr Rectangle -> IO Region) -> IO Region
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rect ((Ptr Rectangle -> IO Region) -> IO Region)
-> (Ptr Rectangle -> IO Region) -> IO Region
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
rectPtr -> do
  Ptr Region
regPtr <- Ptr () -> IO (Ptr Region)
gdk_region_rectangle (Ptr Rectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
rectPtr)
  Ptr Region -> IO Region
makeNewRegion Ptr Region
regPtr

-- | Smallest rectangle including the
-- 'Region'.
--
regionGetClipbox :: Region -> IO Rectangle
regionGetClipbox :: Region -> IO Rectangle
regionGetClipbox Region
r = (Ptr Rectangle -> IO Rectangle) -> IO Rectangle
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Rectangle -> IO Rectangle) -> IO Rectangle)
-> (Ptr Rectangle -> IO Rectangle) -> IO Rectangle
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
rPtr -> do
  (\(Region ForeignPtr Region
arg1) Ptr ()
arg2 -> ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr1 ->Ptr Region -> Ptr () -> IO ()
gdk_region_get_clipbox Ptr Region
argPtr1 Ptr ()
arg2) Region
r (Ptr Rectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
rPtr)
  Ptr Rectangle -> IO Rectangle
forall a. Storable a => Ptr a -> IO a
peek Ptr Rectangle
rPtr

-- | Turn the 'Region' into its rectangles.
--
-- A 'Region' is a set of horizontal bands. Each band consists of one or more
-- rectangles of the same height. No rectangles in a band touch.
--
regionGetRectangles :: Region -> IO [Rectangle]
regionGetRectangles :: Region -> IO [Rectangle]
regionGetRectangles Region
region =
  (Ptr (Ptr Rectangle) -> IO [Rectangle]) -> IO [Rectangle]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr Rectangle) -> IO [Rectangle]) -> IO [Rectangle])
-> (Ptr (Ptr Rectangle) -> IO [Rectangle]) -> IO [Rectangle]
forall a b. (a -> b) -> a -> b
$ \(Ptr (Ptr Rectangle)
rectPtrPtr :: Ptr (Ptr Rectangle)) ->
  (Ptr CInt -> IO [Rectangle]) -> IO [Rectangle]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO [Rectangle]) -> IO [Rectangle])
-> (Ptr CInt -> IO [Rectangle]) -> IO [Rectangle]
forall a b. (a -> b) -> a -> b
$ \(Ptr CInt
iPtr :: Ptr (CInt)) -> do
    (\(Region ForeignPtr Region
arg1) Ptr (Ptr ())
arg2 Ptr CInt
arg3 -> ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr1 ->Ptr Region -> Ptr (Ptr ()) -> Ptr CInt -> IO ()
gdk_region_get_rectangles Ptr Region
argPtr1 Ptr (Ptr ())
arg2 Ptr CInt
arg3) Region
region (Ptr (Ptr Rectangle) -> Ptr (Ptr ())
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr Rectangle)
rectPtrPtr) Ptr CInt
iPtr
    CInt
size <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
iPtr
    Ptr Rectangle
rectPtr <- Ptr (Ptr Rectangle) -> IO (Ptr Rectangle)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Rectangle)
rectPtrPtr
    [Rectangle]
rects <- Int -> Ptr Rectangle -> IO [Rectangle]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
size) Ptr Rectangle
rectPtr
    Ptr () -> IO ()
g_free (Ptr Rectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
rectPtr)
    [Rectangle] -> IO [Rectangle]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Rectangle]
rects

-- | Test if a 'Region' is empty.
--
regionEmpty :: Region -> IO Bool
regionEmpty :: Region -> IO Bool
regionEmpty Region
r = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ (\(Region ForeignPtr Region
arg1) -> ForeignPtr Region -> (Ptr Region -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO CInt) -> IO CInt)
-> (Ptr Region -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr1 ->Ptr Region -> IO CInt
gdk_region_empty Ptr Region
argPtr1) Region
r

-- | Compares two 'Region's for equality.
--
regionEqual :: Region -> Region -> IO Bool
regionEqual :: Region -> Region -> IO Bool
regionEqual Region
r1 Region
r2 = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ (\(Region ForeignPtr Region
arg1) (Region ForeignPtr Region
arg2) -> ForeignPtr Region -> (Ptr Region -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO CInt) -> IO CInt)
-> (Ptr Region -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr1 ->ForeignPtr Region -> (Ptr Region -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg2 ((Ptr Region -> IO CInt) -> IO CInt)
-> (Ptr Region -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr2 ->Ptr Region -> Ptr Region -> IO CInt
gdk_region_equal Ptr Region
argPtr1 Ptr Region
argPtr2) Region
r1 Region
r2

-- | Checks if a point it is within a region.
--
regionPointIn :: Region -> Point -> IO Bool
regionPointIn :: Region -> Point -> IO Bool
regionPointIn Region
r (Int
x,Int
y) = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Region ForeignPtr Region
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr Region -> (Ptr Region -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO CInt) -> IO CInt)
-> (Ptr Region -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr1 ->Ptr Region -> CInt -> CInt -> IO CInt
gdk_region_point_in Ptr Region
argPtr1 CInt
arg2 CInt
arg3) Region
r (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)

-- | Check if a rectangle is within a region.
--
regionRectIn :: Region -> Rectangle -> IO OverlapType
regionRectIn :: Region -> Rectangle -> IO OverlapType
regionRectIn Region
reg Rectangle
rect = (CInt -> OverlapType) -> IO CInt -> IO OverlapType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> OverlapType
forall a. Enum a => Int -> a
toEnum(Int -> OverlapType) -> (CInt -> Int) -> CInt -> OverlapType
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 OverlapType) -> IO CInt -> IO OverlapType
forall a b. (a -> b) -> a -> b
$ Rectangle -> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
rect ((Ptr Rectangle -> IO CInt) -> IO CInt)
-> (Ptr Rectangle -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$
  \Ptr Rectangle
rPtr -> (\(Region ForeignPtr Region
arg1) Ptr ()
arg2 -> ForeignPtr Region -> (Ptr Region -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO CInt) -> IO CInt)
-> (Ptr Region -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr1 ->Ptr Region -> Ptr () -> IO CInt
gdk_region_rect_in Ptr Region
argPtr1 Ptr ()
arg2) Region
reg (Ptr Rectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
rPtr)

-- | Move a region.
--
regionOffset :: Region -> Int -> Int -> IO ()
regionOffset :: Region -> Int -> Int -> IO ()
regionOffset Region
r Int
dx Int
dy =
  (\(Region ForeignPtr Region
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr1 ->Ptr Region -> CInt -> CInt -> IO ()
gdk_region_offset Ptr Region
argPtr1 CInt
arg2 CInt
arg3) Region
r (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)

-- | Move a region.
--
-- * Positive values shrink the region, negative values expand it.
--
regionShrink :: Region -> Int -> Int -> IO ()
regionShrink :: Region -> Int -> Int -> IO ()
regionShrink Region
r Int
dx Int
dy =
  (\(Region ForeignPtr Region
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr1 ->Ptr Region -> CInt -> CInt -> IO ()
gdk_region_shrink Ptr Region
argPtr1 CInt
arg2 CInt
arg3) Region
r (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)

-- | Updates the region to include the rectangle.
--
regionUnionWithRect :: Region -> Rectangle -> IO ()
regionUnionWithRect :: Region -> Rectangle -> IO ()
regionUnionWithRect Region
reg Rectangle
rect = 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
rPtr ->
  (\(Region ForeignPtr Region
arg1) Ptr ()
arg2 -> ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr1 ->Ptr Region -> Ptr () -> IO ()
gdk_region_union_with_rect Ptr Region
argPtr1 Ptr ()
arg2) Region
reg (Ptr Rectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
rPtr)

-- | Intersects one region with another.
--
-- * Changes @reg1@ to include the common areas of @reg1@
-- and @reg2@.
--
regionIntersect :: Region -> Region -> IO ()
regionIntersect :: Region -> Region -> IO ()
regionIntersect Region
reg1 Region
reg2 = (\(Region ForeignPtr Region
arg1) (Region ForeignPtr Region
arg2) -> ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
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 Region -> Ptr Region -> IO ()
gdk_region_intersect Ptr Region
argPtr1 Ptr Region
argPtr2) Region
reg1 Region
reg2

-- | Unions one region with another.
--
-- * Changes @reg1@ to include @reg1@ and @reg2@.
--
regionUnion :: Region -> Region -> IO ()
regionUnion :: Region -> Region -> IO ()
regionUnion Region
reg1 Region
reg2 = (\(Region ForeignPtr Region
arg1) (Region ForeignPtr Region
arg2) -> ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
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 Region -> Ptr Region -> IO ()
gdk_region_union Ptr Region
argPtr1 Ptr Region
argPtr2) Region
reg1 Region
reg2

-- | Removes pars of a 'Region'.
--
-- * Reduces the region @reg1@ so that is does not include any areas
-- of @reg2@.
--
regionSubtract :: Region -> Region -> IO ()
regionSubtract :: Region -> Region -> IO ()
regionSubtract Region
reg1 Region
reg2 = (\(Region ForeignPtr Region
arg1) (Region ForeignPtr Region
arg2) -> ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
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 Region -> Ptr Region -> IO ()
gdk_region_subtract Ptr Region
argPtr1 Ptr Region
argPtr2) Region
reg1 Region
reg2

-- | XORs two 'Region's.
--
-- * The exclusive or of two regions contains all areas which were not
-- overlapping. In other words, it is the union of the regions minus
-- their intersections.
--
regionXor :: Region -> Region -> IO ()
regionXor :: Region -> Region -> IO ()
regionXor Region
reg1 Region
reg2 = (\(Region ForeignPtr Region
arg1) (Region ForeignPtr Region
arg2) -> ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg1 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
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 Region -> Ptr Region -> IO ()
gdk_region_xor Ptr Region
argPtr1 Ptr Region
argPtr2) Region
reg1 Region
reg2

foreign import ccall unsafe "gdk_region_new"
  gdk_region_new :: (IO (Ptr Region))

foreign import ccall unsafe "gdk_region_polygon"
  gdk_region_polygon :: ((Ptr ()) -> (CInt -> (CInt -> (IO (Ptr Region)))))

foreign import ccall unsafe "gdk_region_copy"
  gdk_region_copy :: ((Ptr Region) -> (IO (Ptr Region)))

foreign import ccall unsafe "gdk_region_rectangle"
  gdk_region_rectangle :: ((Ptr ()) -> (IO (Ptr Region)))

foreign import ccall unsafe "gdk_region_get_clipbox"
  gdk_region_get_clipbox :: ((Ptr Region) -> ((Ptr ()) -> (IO ())))

foreign import ccall unsafe "gdk_region_get_rectangles"
  gdk_region_get_rectangles :: ((Ptr Region) -> ((Ptr (Ptr ())) -> ((Ptr CInt) -> (IO ()))))

foreign import ccall unsafe "g_free"
  g_free :: ((Ptr ()) -> (IO ()))

foreign import ccall unsafe "gdk_region_empty"
  gdk_region_empty :: ((Ptr Region) -> (IO CInt))

foreign import ccall unsafe "gdk_region_equal"
  gdk_region_equal :: ((Ptr Region) -> ((Ptr Region) -> (IO CInt)))

foreign import ccall unsafe "gdk_region_point_in"
  gdk_region_point_in :: ((Ptr Region) -> (CInt -> (CInt -> (IO CInt))))

foreign import ccall unsafe "gdk_region_rect_in"
  gdk_region_rect_in :: ((Ptr Region) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall unsafe "gdk_region_offset"
  gdk_region_offset :: ((Ptr Region) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall unsafe "gdk_region_shrink"
  gdk_region_shrink :: ((Ptr Region) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall unsafe "gdk_region_union_with_rect"
  gdk_region_union_with_rect :: ((Ptr Region) -> ((Ptr ()) -> (IO ())))

foreign import ccall unsafe "gdk_region_intersect"
  gdk_region_intersect :: ((Ptr Region) -> ((Ptr Region) -> (IO ())))

foreign import ccall unsafe "gdk_region_union"
  gdk_region_union :: ((Ptr Region) -> ((Ptr Region) -> (IO ())))

foreign import ccall unsafe "gdk_region_subtract"
  gdk_region_subtract :: ((Ptr Region) -> ((Ptr Region) -> (IO ())))

foreign import ccall unsafe "gdk_region_xor"
  gdk_region_xor :: ((Ptr Region) -> ((Ptr Region) -> (IO ())))