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 + |