[Gtk2hs-commit] (main branch): Add a few Show and Eq instances to Cairo.

[Axel S. <si...@co...>]

Mon Sep 15 17:17:08 EDT 2008  A....@ke...
  * Add a few Show and Eq instances to Cairo.

    hunk ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/Surface.chs 28
    +{#fun surface_get_content          as surfaceGetContent         { withSurface* `Surface' } -> `Content' cToEnum#}
    hunk ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/Surface.chs 34
    -
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 100
    -{#enum status_t as Status {underscoreToCase} deriving(Eq)#}
    +{#enum status_t as Status {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 104
    -{#enum operator_t as Operator {underscoreToCase}#}
    +{#enum operator_t as Operator {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 119
    -{#enum antialias_t as Antialias {underscoreToCase}#}
    +{#enum antialias_t as Antialias {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 141
    -{#enum fill_rule_t as FillRule {underscoreToCase}#}
    +{#enum fill_rule_t as FillRule {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 153
    -{#enum line_cap_t as LineCap {underscoreToCase}#}
    +{#enum line_cap_t as LineCap {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 157
    -{#enum line_join_t as LineJoin {underscoreToCase}#}
    +{#enum line_join_t as LineJoin {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 233
    -{#enum font_slant_t as FontSlant {underscoreToCase}#}
    +{#enum font_slant_t as FontSlant {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 236
    -{#enum font_weight_t as FontWeight {underscoreToCase}#}
    +{#enum font_weight_t as FontWeight {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 257
    -{#enum subpixel_order_t as SubpixelOrder {underscoreToCase}#}
    +{#enum subpixel_order_t as SubpixelOrder {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 297
    -{#enum hint_metrics_t as HintMetrics {underscoreToCase}#}
    +{#enum hint_metrics_t as HintMetrics {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 334
    -{#enum content_t as Content {underscoreToCase}#}
    +{#enum content_t as Content {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 340
    -            deriving (Enum)
    +            deriving (Enum,Show,Eq)
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 343
    -{#enum extend_t as Extend {underscoreToCase}#}
    +{#enum extend_t as Extend {underscoreToCase} deriving(Eq,Show)#}
    hunk ./cairo/Graphics/Rendering/Cairo/Types.chs 346
    -{#enum filter_t as Filter {underscoreToCase}#}
    +{#enum filter_t as Filter {underscoreToCase} deriving(Eq,Show)#}
    hunk ./gtk/Graphics/UI/Gtk/Cairo.chs.pp 49
    +  -- * Using 'Graphics.UI.Gtk.Gdk.Pixbuf.Pixbuf' functions together with Cairo
    +  cairoImageSurfaceFromPixbuf,
    +  pixbufFromImageSurface,
    hunk ./gtk/Graphics/UI/Gtk/Cairo.chs.pp 75
    -import System.Glib.GObject		(constructNewGObject, makeNewGObject)
    +import System.Glib.GObject		(constructNewGObject, makeNewGObject,
    +  objectRef, objectUnref)
    hunk ./gtk/Graphics/UI/Gtk/Cairo.chs.pp 80
    +{#import Graphics.UI.Gtk.Gdk.Pixbuf#} ( pixbufGetHasAlpha, pixbufGetNChannels,
    +  pixbufGetColorSpace, pixbufGetWidth, pixbufGetHeight, pixbufGetRowstride,
    +  Colorspace(..) )
    hunk ./gtk/Graphics/UI/Gtk/Cairo.chs.pp 99
    +-- | Treat a 'Graphics.UI.Gtk.Gdk.Pixbuf.Pixbuf' as an image
    +--   'Graphics..Rendering.Cairo.Surface'.
    +--
    +-- * The image data is shared between the two objects. Note that everytime you
    +--   use 'Graphics.UI.Gtk.Gdk.Pixbuf.Pixbuf' functions on the image, it is
    +--   necessary to tell Cairo that the image data has changed using
    +--   'Graphics..Rendering.Cairo.surfaceMarkDirty' since it might cache certain areas of
    +--   an image.
    +--
    +cairoImageSurfaceFromPixbuf :: Pixbuf -> IO Surface
    +cairoImageSurfaceFromPixbuf pb = do
    +  alpha <- pixbufGetHasAlpha pb
    +  chan <- pixbufGetNChannels pb
    +  cs <- pixbufGetColorSpace pb
    +  width <- pixbufGetWidth pb
    +  height <- pixbufGetHeight pb
    +  stride <- pixbufGetRowstride pb
    +  cairoFormat <- case (alpha, chan, cs) of
    +    (True, 4, ColorspaceRgb) -> return FormatARGB32
    +    (False, 3, ColorspaceRgb) -> return FormatRGB24
    +    (_, 1, _) -> return FormatA8 -- pixbuf doesn't actually do that
    +    _ -> error "cairoImageSurfaceFromPixbuf: cannot create cairo context form given format"
    +  dPtr <- {#call unsafe pixbuf_get_pixels#} pb
    +  sfPtr <- {#call cairo_image_surface_create_for_data#} dPtr
    +    (fromIntegral (fromEnum cairoFormat)) (fromIntegral width)
    +    (fromIntegral height) (fromIntegral stride)
    +  sf <- mkSurface sfPtr
    +  let pbPtr = unsafeForeignPtrToPtr (unPixbuf pb)
    +  objectRef pbPtr
    +  {#call cairo_surface_set_user_data#} sf (castPtr pbPtr)
    +    (castPtr pbPtr) objectUnref
    +  manageSurface sf
    +  return sf
    +  [_$_]
    +-- | Treat an image 'Graphics.Rendering.Cairo.Surface' as a
    +-- 'Graphics.UI.Gtk.Gdk.Pixbuf.Pixbuf'.
    +--
    +-- * The image data is shared between the two objects. Note that everytime you
    +--   use 'Graphics.UI.Gtk.Gdk.Pixbuf.Pixbuf' functions on the image, it is
    +--   necessary to tell Cairo that the image data has changed using
    +--   'Graphics.Rendering.Cairo.surfaceMarkDirty' since it might cache certain
    +--   areas of an image. This function throws an error if the
    +--   'Graphics.Rendering.Cairo.Surface' has any other format than
    +--   'Graphics.Rendering.Cairo.FormatARGB32' or
    +--   'Graphics.Rendering.Cairo.FormatRGB32' since
    +--   'Graphics.UI.Gtk.Gdk.Pixbuf.Pixbuf' can currently only handle these two
    +--   formats.
    +--
    +pixbufFromImageSurface :: Surface -> IO Pixbuf
    +pixbufFromImageSurface sf = do
    +  con <- Cairo.Internal.surfaceGetContent sf
    +  hasAlpha <- case con of
    +    Cairo.Internal.ContentColor -> return False
    +    Cairo.Internal.ContentColorAlpha -> return True
    +    _ -> error ("pixbufFromImageSurface: Pixbufs do not support Cairo format "++show con)    [_$_]
    +  width <- Cairo.Internal.imageSurfaceGetWidth sf
    +  height <- Cairo.Internal.imageSurfaceGetHeight sf
    +  stride <- Cairo.Internal.imageSurfaceGetStride sf
    +  dPtr <- Cairo.Internal.imageSurfaceGetData sf
    +  let (Cairo.Surface sfFPtr) = sf
    +  let sfPtr = unsafeForeignPtrToPtr sfFPtr
    +  Cairo.Internal.surfaceReference sf
    +  fPtrRef <- newIORef nullFunPtr
    +  fPtr <- mkPixbufDestroyNotify $ \_ _ -> do
    +    Cairo.Internal.surfaceDestroy sf
    +    fPtr <- readIORef fPtrRef
    +    freeHaskellFunPtr fPtr
    +  writeIORef fPtrRef fPtr
    +  makeNewGObject mkPixbuf $
    +    {#call unsafe gdk_pixbuf_new_from_data#} dPtr 0 (fromBool hasAlpha)
    +      8 (fromIntegral width) (fromIntegral height) (fromIntegral stride)
    +      fPtr nullPtr
    +
    +{#pointer GdkPixbufDestroyNotify as PixbufDestroyNotify#}
    +
    +foreign import ccall "wrapper" mkPixbufDestroyNotify ::
    +  (Ptr () -> Ptr Surface -> IO ()) -> IO PixbufDestroyNotify
    +