|
From: Daniel W. <dm...@lu...> - 2013-05-08 21:36:44
|
diffing dir...
Sun Apr 7 19:35:23 BST 2013 Hamish Mackenzie <ham...@go...>
* Add the Gtk 3 "draw" event (uses cairo Render monad). Cairo 1.10 Region functions.
Ignore-this: 18b596a210c8830883d82f3af71ad4ba
hunk ./cairo/Graphics/Rendering/Cairo.hs 246
+#if CAIRO_CHECK_VERSION(1,10,0)
+ -- * Regions
+ , regionCreate
+ , regionCreateRectangle
+ , regionCreateRectangles
+ , regionCopy
+ , regionGetExtents
+ , regionNumRectangles
+ , regionGetRectangle
+ , regionIsEmpty
+ , regionContainsPoint
+ , regionContainsRectangle
+ , regionEqual
+ , regionTranslate
+ , regionIntersect
+ , regionIntersectRectangle
+ , regionSubtract
+ , regionSubtractRectangle
+ , regionUnion
+ , regionUnionRectangle
+ , regionXor
+ , regionXorRectangle
+
+#endif
+
hunk ./cairo/Graphics/Rendering/Cairo.hs 301
+#if CAIRO_CHECK_VERSION(1,10,0)
+ , RectangleInt(..)
+ , RegionOverlap(..)
+ , Region
+#endif
hunk ./cairo/Graphics/Rendering/Cairo.hs 2010
+#if CAIRO_CHECK_VERSION(1,10,0)
+
+-- | Allocates a new empty region object.
+--
+regionCreate :: MonadIO m => m Region
+regionCreate = liftIO $ Internal.regionCreate
+
+-- | Allocates a new region object containing @rectangle@.
+--
+regionCreateRectangle ::
+ MonadIO m =>
+ RectangleInt -- ^ @rectangle@
+ -> m Region
+regionCreateRectangle a = liftIO $ Internal.regionCreateRectangle a
+
+-- | Allocates a new region object containing the union of all given @rects@.
+--
+regionCreateRectangles ::
+ MonadIO m =>
+ [RectangleInt] -- ^ @rects@
+ -> m Region
+regionCreateRectangles a = liftIO $ Internal.regionCreateRectangles a
+
+-- | Allocates a new region object copying the area from @original@.
+--
+regionCopy ::
+ MonadIO m =>
+ Region -- ^ @original@
+ -> m Region
+regionCopy a = liftIO $ Internal.regionCopy a
+
+-- | Gets the bounding rectangle of @region@ as a RectanglInt.
+--
+regionGetExtents ::
+ MonadIO m =>
+ Region -- ^ @region@
+ -> m RectangleInt
+regionGetExtents a = liftIO $ Internal.regionGetExtents a
+
+-- | Returns the number of rectangles contained in @region@.
+--
+regionNumRectangles ::
+ MonadIO m =>
+ Region -- ^ @region@
+ -> m Int
+regionNumRectangles a = liftIO $ Internal.regionNumRectangles a
+
+-- | Gets the @nth@ rectangle from the @region@.
+--
+regionGetRectangle ::
+ MonadIO m =>
+ Region -- ^ @region@
+ -> Int -- ^ @nth@
+ -> m RectangleInt
+regionGetRectangle a n = liftIO $ Internal.regionGetRectangle a n
+
+-- | Checks whether @region@ is empty.
+--
+regionIsEmpty ::
+ MonadIO m =>
+ Region -- ^ @region@
+ -> m Bool
+regionIsEmpty a = liftIO $ Internal.regionIsEmpty a
+
+-- | Checks whether (@x@, @y@) is contained in @region@.
+--
+regionContainsPoint ::
+ MonadIO m =>
+ Region -- ^ @region@
+ -> Int -- ^ @x@
+ -> Int -- ^ @y@
+ -> m Bool
+regionContainsPoint a x y = liftIO $ Internal.regionContainsPoint a x y
+
+-- | Checks whether @rectangle@ is inside, outside or partially contained in @region@.
+--
+regionContainsRectangle ::
+ MonadIO m =>
+ Region -- ^ @region@
+ -> RectangleInt -- ^ @rectangle@
+ -> m RegionOverlap
+regionContainsRectangle a rect = liftIO $ Internal.regionContainsRectangle a rect
+
+-- | Compares whether @region_a@ is equivalent to @region_b@.
+--
+regionEqual ::
+ MonadIO m =>
+ Region -- ^ @region_a@
+ -> Region -- ^ @region_b@
+ -> m Bool
+regionEqual a b = liftIO $ Internal.regionEqual a b
+
+-- | Translates @region@ by (@dx@, @dy@).
+--
+regionTranslate ::
+ MonadIO m =>
+ Region -- ^ @region@
+ -> Int -- ^ @dx@
+ -> Int -- ^ @dy@
+ -> m ()
+regionTranslate a dx dy = liftIO $ Internal.regionTranslate a dx dy
+
+-- | Computes the intersection of @dst@ with @other@ and places the result in @dst@.
+--
+regionIntersect ::
+ MonadIO m =>
+ Region -- ^ @dst@
+ -> Region -- ^ @other@
+ -> m ()
+regionIntersect a b = liftIO $ do
+ status <- Internal.regionIntersect a b
+ unless (status == StatusSuccess) $
+ Internal.statusToString status >>= fail
+
+-- | Computes the intersection of @dst@ with @rectangle@ and places the result in @dst@.
+--
+regionIntersectRectangle ::
+ MonadIO m =>
+ Region -- ^ @dst@
+ -> RectangleInt -- ^ @rectangle@
+ -> m ()
+regionIntersectRectangle a rect = liftIO $ do
+ status <- Internal.regionIntersectRectangle a rect
+ unless (status == StatusSuccess) $
+ Internal.statusToString status >>= fail
+
+-- | Subtracts @other@ from @dst@ and places the result in @dst@.
+--
+regionSubtract ::
+ MonadIO m =>
+ Region -- ^ @dst@
+ -> Region -- ^ @other@
+ -> m ()
+regionSubtract a b = liftIO $ do
+ status <- Internal.regionSubtract a b
+ unless (status == StatusSuccess) $
+ Internal.statusToString status >>= fail
+
+-- | Subtracts @rectangle@ from @dst@ and places the result in @dst@.
+--
+regionSubtractRectangle ::
+ MonadIO m =>
+ Region -- ^ @dst@
+ -> RectangleInt -- ^ @rectangle@
+ -> m ()
+regionSubtractRectangle a rect = liftIO $ do
+ status <- Internal.regionSubtractRectangle a rect
+ unless (status == StatusSuccess) $
+ Internal.statusToString status >>= fail
+
+-- | Computes the union of @dst@ with @other@ and places the result in @dst@.
+--
+regionUnion ::
+ MonadIO m =>
+ Region -- ^ @dst@
+ -> Region -- ^ @other@
+ -> m ()
+regionUnion a b = liftIO $ do
+ status <- Internal.regionUnion a b
+ unless (status == StatusSuccess) $
+ Internal.statusToString status >>= fail
+
+-- | Computes the union of @dst@ with @rectangle@ and places the result in @dst@.
+--
+regionUnionRectangle ::
+ MonadIO m =>
+ Region -- ^ @dst@
+ -> RectangleInt -- ^ @rectangle@
+ -> m ()
+regionUnionRectangle a rect = liftIO $ do
+ status <- Internal.regionUnionRectangle a rect
+ unless (status == StatusSuccess) $
+ Internal.statusToString status >>= fail
+
+-- | Computes the exclusive difference of @dst@ with @other@ and places the result in @dst@.
+-- That is, @dst@ will be set to contain all areas that are either in @dst@ or in @other@, but not in both.
+--
+regionXor ::
+ MonadIO m =>
+ Region -- ^ @dst@
+ -> Region -- ^ @other@
+ -> m ()
+regionXor a b = liftIO $ do
+ status <- Internal.regionXor a b
+ unless (status == StatusSuccess) $
+ Internal.statusToString status >>= fail
+
+-- | Computes the exclusive difference of @dst@ with @rectangle@ and places the result in @dst@.
+-- That is, @dst@ will be set to contain all areas that are either in @dst@ or in @rectangle@, but not in both
+--
+regionXorRectangle ::
+ MonadIO m =>
+ Region -- ^ @dst@
+ -> RectangleInt -- ^ @rectangle@
+ -> m ()
+regionXorRectangle a rect = liftIO $ do
+ status <- Internal.regionXorRectangle a rect
+ unless (status == StatusSuccess) $
+ Internal.statusToString status >>= fail
+
+#endif
+
hunk ./cairo/Graphics/Rendering/Cairo/Internal.hs 32
+ , module Graphics.Rendering.Cairo.Internal.Region
hunk ./cairo/Graphics/Rendering/Cairo/Internal.hs 50
+import Graphics.Rendering.Cairo.Internal.Region
addfile ./cairo/Graphics/Rendering/Cairo/Internal/Region.chs
hunk ./cairo/Graphics/Rendering/Cairo/Internal/Region.chs 1
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.Cairo.Internal.Region
+-- Copyright : (c) Hamish Mackenzie 2013
+-- License : BSD-style (see doc/COPYRIGHT)
+--
+-- Maintainer :
+-- Stability : experimental
+-- Portability : portable
+--
+-- Region functions.
+-----------------------------------------------------------------------------
+
+module Graphics.Rendering.Cairo.Internal.Region where
+
+#if CAIRO_CHECK_VERSION(1,10,0)
+
+{#import Graphics.Rendering.Cairo.Types#}
+
+import Foreign
+import Foreign.C
+
+{#context lib="cairo" prefix="cairo"#}
+
+regionCreateRectangles rects =
+ withArrayLen rects $ \ n ptr ->
+ {#call region_create_rectangles#} ptr (fromIntegral n) >>= mkRegion
+
+{#fun region_create as regionCreate {} -> `Region' mkRegion*#}
+{#fun region_create_rectangle as regionCreateRectangle { `RectangleInt' } -> `Region' mkRegion*#}
+{#fun region_copy as regionCopy { withRegion* `Region' } -> `Region' mkRegion*#}
+{#fun region_destroy as regionDestroy { withRegion* `Region' } -> `()'#}
+{#fun region_reference as regionReference { withRegion* `Region' } -> `()'#}
+{#fun region_status as regionStatus { withRegion* `Region' } -> `Status' cToEnum#}
+{#fun region_get_extents as regionGetExtents { withRegion* `Region', alloca- `RectangleInt' peek* } -> `()'#}
+{#fun region_num_rectangles as regionNumRectangles { withRegion* `Region' } -> `Int' fromIntegral#}
+{#fun region_get_rectangle as regionGetRectangle { withRegion* `Region', fromIntegral `Int', alloca- `RectangleInt' peek* } -> `()'#}
+{#fun region_is_empty as regionIsEmpty { withRegion* `Region' } -> `Bool' cToBool#}
+{#fun region_contains_point as regionContainsPoint { withRegion* `Region', fromIntegral `Int', fromIntegral `Int' } -> `Bool' cToBool#}
+{#fun region_contains_rectangle as regionContainsRectangle { withRegion* `Region', `RectangleInt' } -> `RegionOverlap' cToEnum#}
+{#fun region_equal as regionEqual { withRegion* `Region', withRegion* `Region' } -> `Bool' cToBool#}
+{#fun region_translate as regionTranslate { withRegion* `Region', fromIntegral `Int', fromIntegral `Int' } -> `()'#}
+{#fun region_intersect as regionIntersect { withRegion* `Region', withRegion* `Region' } -> `Status' cToEnum#}
+{#fun region_intersect_rectangle as regionIntersectRectangle { withRegion* `Region', `RectangleInt' } -> `Status' cToEnum#}
+{#fun region_subtract as regionSubtract { withRegion* `Region', withRegion* `Region' } -> `Status' cToEnum#}
+{#fun region_subtract_rectangle as regionSubtractRectangle { withRegion* `Region', `RectangleInt' } -> `Status' cToEnum#}
+{#fun region_union as regionUnion { withRegion* `Region', withRegion* `Region' } -> `Status' cToEnum#}
+{#fun region_union_rectangle as regionUnionRectangle { withRegion* `Region', `RectangleInt' } -> `Status' cToEnum#}
+{#fun region_xor as regionXor { withRegion* `Region', withRegion* `Region' } -> `Status' cToEnum#}
+{#fun region_xor_rectangle as regionXorRectangle { withRegion* `Region', `RectangleInt' } -> `Status' cToEnum#}
+
+#endif
hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 1
+{-# LANGUAGE RecordWildCards #-}
hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 43
+#if CAIRO_CHECK_VERSION(1,10,0)
+ , RectangleInt(..)
+ , RegionOverlap(..)
+ , Region(..), withRegion, mkRegion
+#endif
hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 344
+#if CAIRO_CHECK_VERSION(1,10,0)
+
+{#pointer *rectangle_int_t as RectangleIntPtr -> RectangleInt#}
+
+-- | A data structure for holding a rectangle with integer coordinates.
+data RectangleInt = RectangleInt {
+ x :: Int
+ , y :: Int
+ , width :: Int
+ , height :: Int
+ }
+
+instance Storable RectangleInt where
+ sizeOf _ = {#sizeof rectangle_int_t#}
+ alignment _ = alignment (undefined :: CInt)
+ peek p = do
+ x <- {#get rectangle_int_t->x#} p
+ y <- {#get rectangle_int_t->y#} p
+ width <- {#get rectangle_int_t->width#} p
+ height <- {#get rectangle_int_t->height#} p
+ return $ RectangleInt (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height)
+ poke p (RectangleInt {..}) = do
+ {#set rectangle_int_t->x#} p (fromIntegral x)
+ {#set rectangle_int_t->y#} p (fromIntegral y)
+ {#set rectangle_int_t->width#} p (fromIntegral width)
+ {#set rectangle_int_t->height#} p (fromIntegral height)
+ return ()
+
+-- | Used as the return value for regionContainsRectangle.
+{#enum cairo_region_overlap_t as RegionOverlap {underscoreToCase} deriving(Eq,Show)#}
+
+-- | A Cairo region. Represents a set of integer-aligned rectangles.
+--
+-- It allows set-theoretical operations like regionUnion and regionIntersect to be performed on them.
+{#pointer *region_t as Region foreign newtype#}
+
+withRegion (Region fptr) = withForeignPtr fptr
+
+mkRegion :: Ptr Region -> IO Region
+mkRegion regionPtr = do
+ regionForeignPtr <- newForeignPtr regionDestroy regionPtr
+ return (Region regionForeignPtr)
+
+foreign import ccall unsafe "&cairo_region_destroy"
+ regionDestroy :: FinalizerPtr Region
+
+#endif
+
hunk ./cairo/cairo.cabal 72
+ Graphics.Rendering.Cairo.Internal.Region
hunk ./gtk/Graphics/UI/Gtk/Abstract/Widget.chs 307
+#if GTK_CHECK_VERSION(3,0,0)
+ draw,
+#endif
hunk ./gtk/Graphics/UI/Gtk/Abstract/Widget.chs 504
+#if GTK_CHECK_VERSION(3,0,0)
+import Graphics.Rendering.Cairo.Types (Cairo(..))
+import Graphics.Rendering.Cairo.Internal (Render(..))
+#endif
hunk ./gtk/Graphics/UI/Gtk/Abstract/Widget.chs 2815
+#if GTK_CHECK_VERSION(3,0,0)
+draw :: WidgetClass self => Signal self (Render ())
+draw =
+ Signal (\after model (Render user) ->
+ connect_PTR__NONE "draw" after model (\ptr -> runReaderT user (Cairo ptr)))
+#endif
+
hunk ./gtk/Graphics/UI/Gtk/Cairo.chs 56
+#else
+ renderWithDrawWindow,
hunk ./gtk/Graphics/UI/Gtk/Cairo.chs 90
+import Graphics.UI.Gtk.General.Structs (Rectangle(..))
hunk ./gtk/Graphics/UI/Gtk/Cairo.chs 116
+#if GTK_MAJOR_VERSION >= 3
+-- | Creates a Cairo context for drawing to a 'DrawWindow'.
+--
+-- Removed in Gtk3.
+renderWithDrawWindow :: DrawWindowClass drawWindow =>
+ drawWindow -- ^ @drawWindow@ - a 'DrawWindow'
+ -> Render a -- ^ A newly created Cairo context.
+ -> IO a
+renderWithDrawWindow drawWindow m =
+ bracket (liftM Cairo.Cairo $ {#call unsafe gdk_cairo_create#} (toDrawWindow drawWindow))
+ (\context -> do status <- Cairo.Internal.status context
+ Cairo.Internal.destroy context
+ unless (status == Cairo.StatusSuccess) $
+ fail =<< Cairo.Internal.statusToString status)
+ (\context -> runReaderT (Cairo.Internal.runRender m) context)
+#endif
+
hunk ./gtk/Graphics/UI/Gtk/Cairo.chs 150
+-- | Adds the given region to the current path of the 'Render' context.
+rectangle :: Rectangle -> Render ()
+rectangle rect = Render $ do
+ cr <- ask
+ liftIO $ with rect $ \ rectPtr ->
+ {# call unsafe gdk_cairo_rectangle #}
+ cr
+ (castPtr rectPtr)
+
hunk ./gtk/Graphics/UI/Gtk/Cairo.chs 170
+
+#if GTK_MAJOR_VERSION >= 3
+-- | Adds the given region to the current path of the 'Render' context.
+--
+-- Removed in Gtk3.
+region :: Region -> Render ()
+region region = Render $ do
+ cr <- ask
+ liftIO $ {# call unsafe gdk_cairo_region #}
+ cr
+ region
+
+#endif
+
|