[perl-cairo] Add Perl bindings for Cairo surface mime type setting/getting and get extents
- From: Torsten Schönfeld <tsch src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [perl-cairo] Add Perl bindings for Cairo surface mime type setting/getting and get extents
- Date: Sun, 8 Nov 2020 21:01:30 +0000 (UTC)
commit e3cbdc98c0d7e06d6b22ac0824ee3b3bf00227e9
Author: Raymond S Brand <rsbx acm org>
Date: Sat Oct 31 10:16:25 2020 -0400
Add Perl bindings for Cairo surface mime type setting/getting and get extents
Also add an example to exercise the new bindings.
CairoSurface.xs | 59 ++++++++++
MANIFEST | 1 +
examples/mime-unique-id.pl | 281 +++++++++++++++++++++++++++++++++++++++++++++
lib/Cairo.pm | 22 ++++
t/CairoSurface.t | 38 +++++-
5 files changed, 399 insertions(+), 2 deletions(-)
---
diff --git a/CairoSurface.xs b/CairoSurface.xs
index 11468ec..5780b79 100644
--- a/CairoSurface.xs
+++ b/CairoSurface.xs
@@ -295,6 +295,14 @@ read_func_marshaller (void *closure,
/* -------------------------------------------------------------------------- */
+static void
+data_destroy (void *data)
+{
+ SvREFCNT_dec ((SV *) data);
+}
+
+/* -------------------------------------------------------------------------- */
+
MODULE = Cairo::Surface PACKAGE = Cairo::Surface PREFIX = cairo_surface_
void DESTROY (cairo_surface_t * surface);
@@ -374,6 +382,41 @@ cairo_content_t cairo_surface_get_content (cairo_surface_t *surface);
#endif
+#if CAIRO_VERSION >= CAIRO_VERSION_ENCODE(1, 10, 0)
+
+# cairo_status_t cairo_surface_set_mime_data (cairo_surface_t *surface, const char *mime_type, const
unsigned char *data, unsigned long length, cairo_destroy_func_t destroy, void *closure);
+cairo_status_t
+cairo_surface_set_mime_data (cairo_surface_t *surface, const char *mime_type, SV *data);
+ PREINIT:
+ const unsigned char *mime_data;
+ unsigned long length;
+ CODE:
+ SvREFCNT_inc (data);
+ mime_data = (const unsigned char *) SvPV(data, length);
+ RETVAL = cairo_surface_set_mime_data (surface, mime_type, mime_data, length, data_destroy, data);
+ OUTPUT:
+ RETVAL
+
+# void cairo_surface_get_mime_data (cairo_surface_t *surface, const char *mime_type, const unsigned char
**data, unsigned long *length);
+SV *
+cairo_surface_get_mime_data (cairo_surface_t *surface, const char *mime_type);
+ PREINIT:
+ const unsigned char *data;
+ unsigned long length;
+ CODE:
+ cairo_surface_get_mime_data (surface, mime_type, &data, &length);
+ RETVAL = newSVpvn ((const char *) data, length);
+ OUTPUT:
+ RETVAL
+
+#endif
+
+#if CAIRO_VERSION >= CAIRO_VERSION_ENCODE(1, 12, 0)
+
+cairo_bool_t cairo_surface_supports_mime_type (cairo_surface_t *surface, const char *mime_type);
+
+#endif
+
#ifdef CAIRO_HAS_PNG_FUNCTIONS
cairo_status_t cairo_surface_write_to_png (cairo_surface_t *surface, const char *filename);
@@ -765,6 +808,22 @@ cairo_recording_surface_create (class, cairo_content_t content, cairo_rectangle_
void cairo_recording_surface_ink_extents (cairo_surface_t *surface, OUTLIST double x0, OUTLIST double y0,
OUTLIST double width, OUTLIST double height);
+#if CAIRO_VERSION >= CAIRO_VERSION_ENCODE(1, 12, 0)
+
+# cairo_bool_t cairo_recording_surface_get_extents (cairo_surface_t *surface, cairo_rectangle_t *extents);
+cairo_rectangle_t *
+cairo_recording_surface_get_extents (cairo_surface_t *surface)
+ PREINIT:
+ cairo_bool_t status;
+ cairo_rectangle_t rect;
+ CODE:
+ status = cairo_recording_surface_get_extents (surface, &rect);
+ RETVAL = status ? &rect : NULL;
+ OUTPUT:
+ RETVAL
+
+#endif
+
#endif
# --------------------------------------------------------------------------- #
diff --git a/MANIFEST b/MANIFEST
index 83b5019..a76ca7c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -13,6 +13,7 @@ ChangeLog.pre-git
doctypes
examples/freetype-font.pl
examples/glyph-text.pl
+examples/mime-unique-id.pl
examples/png-streams.pl
examples/png/bevels.pl
examples/png/caps_joins.pl
diff --git a/examples/mime-unique-id.pl b/examples/mime-unique-id.pl
new file mode 100755
index 0000000..131ddbf
--- /dev/null
+++ b/examples/mime-unique-id.pl
@@ -0,0 +1,281 @@
+#! /usr/bin/perl
+
+# Adapted and translated to Perl from the test/mime-unique-id.c file in the
+# Cairo (version 1.17.3) source repository.
+
+# Check that source surfaces with same CAIRO_MIME_TYPE_UNIQUE_ID are
+# embedded only once in PDF/PS.
+#
+# To exercise all the surface embedding code in PDF, four types of
+# source surfaces are painted on each page, each with its own UNIQUE_ID:
+# - an image surface
+# - a recording surface with a jpeg mime attached
+# - a bounded recording surface
+# - an unbounded recording surface.
+#
+# Four pages are generated. Each source is clipped starting with the
+# smallest area on the first page increasing to the unclipped size on
+# the last page. This is to ensure the output does not embed the
+# source clipped to a smaller size than used on subsequent pages.
+
+
+use strict;
+use warnings;
+use Cairo;
+
+use Fcntl;
+
+use feature 'say';
+
+use constant
+ {
+ NUM_PAGES => 4,
+ WIDTH => 275,
+ HEIGHT => 275,
+ RECORDING_SIZE => 800,
+ TILE_SIZE => 40,
+ PNG_FILENAME => 'romedalen.png',
+ JPG_FILENAME => 'romedalen.jpg',
+ OUTPUT_FILENAME => 'mime-unique-id.perl.pdf',
+ M_PI => 3.1415926,
+ CAIRO_MIME_TYPE_JPEG => 'image/jpeg',
+ CAIRO_MIME_TYPE_UNIQUE_ID => 'application/x-cairo.uuid',
+ };
+
+
+sub create_image_surface
+ {
+ my $surface = Cairo::ImageSurface->create_from_png(PNG_FILENAME);
+ my $status = $surface->status();
+ if ($status ne 'success')
+ {
+ say $surface->status();
+ die;
+ }
+
+ $surface->set_mime_data(CAIRO_MIME_TYPE_UNIQUE_ID, PNG_FILENAME);
+
+ $surface->set_mime_data(CAIRO_MIME_TYPE_UNIQUE_ID, 'image');
+
+ return $surface;
+ }
+
+
+sub create_recording_surface_with_mime_jpg
+ {
+ my $surface = Cairo::RecordingSurface->create('alpha', {x => 0, y => 0, width => 1, height => 1});
+ if ($surface->status() ne 'success')
+ {
+ say $surface->status();
+ die;
+ }
+
+ my ($FH, $want, $data);
+ unless (sysopen($FH, JPG_FILENAME, O_RDONLY|O_BINARY))
+ {
+ die;
+ }
+ $want = -s $FH;
+ $data = '';
+ while (1)
+ {
+ my $rc = sysread($FH, $data, $want, length($data));
+ die unless defined $rc;
+ last if $rc == 0;
+ $want -= $rc;
+ last if $want <= 0;
+ }
+ close($FH);
+
+ $surface->set_mime_data(CAIRO_MIME_TYPE_JPEG, $data);
+ if ($surface->status() ne 'success')
+ {
+ say $surface->status();
+ die;
+ }
+
+ $surface->set_mime_data(CAIRO_MIME_TYPE_UNIQUE_ID, 'jpeg');
+ if ($surface->status() ne 'success')
+ {
+ say $surface->status();
+ die;
+ }
+
+ return $surface;
+ }
+
+
+sub draw_tile
+ {
+ my ($cr) = @_;
+
+ $cr->move_to(10+5, 10);
+ $cr->arc(10, 10, 5, 0, 2*M_PI);
+ $cr->close_path();
+ $cr->set_source_rgb(1, 0, 0);
+ $cr->fill();
+
+ $cr->move_to(30, 10-10*0.43);
+ $cr->line_to(25, 10+10*0.43);
+ $cr->line_to(35, 10+10*0.43);
+ $cr->close_path();
+ $cr->set_source_rgb(0, 1, 0);
+ $cr->fill();
+
+ $cr->rectangle(5, 25, 10, 10);
+ $cr->set_source_rgb(0, 0, 0);
+ $cr->fill();
+
+ $cr->save();
+ $cr->translate(30, 30);
+ $cr->rotate(M_PI/4.0);
+ $cr->rectangle(-5, -5, 10, 10);
+ $cr->set_source_rgb(1, 0, 1);
+ $cr->fill();
+ $cr->restore();
+ }
+
+
+sub create_recording_surface
+ {
+ my ($bounded) = @_;
+
+ my ($surface, $start, $size);
+
+ if ($bounded)
+ {
+ $surface = Cairo::RecordingSurface->create('alpha', {x => 0, y => 0, width => RECORDING_SIZE,
height => RECORDING_SIZE});
+ ($start, $size) = (0, RECORDING_SIZE);
+ }
+ else
+ {
+ $surface = Cairo::RecordingSurface->create('alpha', undef);
+ ($start, $size) = (RECORDING_SIZE/2, RECORDING_SIZE*2);
+ }
+
+ # Draw each tile instead of creating a cairo pattern to make size
+ # of the emitted recording as large as possible.
+
+ my ($cr) = Cairo::Context->create($surface);
+ $cr->set_source_rgb(1, 1, 0);
+ $cr->paint();
+ my $ctm = $cr->get_matrix();
+ for (my $y = $start; $y < $size; $y += TILE_SIZE)
+ {
+ for (my $x = $start; $x < $size; $x += TILE_SIZE)
+ {
+ draw_tile($cr);
+ $cr->translate(TILE_SIZE, 0);
+ }
+ $ctm->translate(0, TILE_SIZE);
+ $cr->set_matrix($ctm);
+ }
+ $cr = undef;
+
+ $surface->set_mime_data(CAIRO_MIME_TYPE_UNIQUE_ID, $bounded ? 'recording bounded' : 'recording
unbounded');
+ if ($surface->status() ne 'success')
+ {
+ say $surface->status();
+ die;
+ }
+
+ return $surface;
+ }
+
+# Draw @source scaled to fit @rect and clipped to a rectangle
+# @clip_margin units smaller on each side. @rect will be stroked
+# with a solid line and the clip rect stroked with a dashed line.
+
+sub draw_surface
+ {
+ my ($cr, $source, $rect, $clip_margin) = @_;
+ my ($width, $height);
+
+ my $type = $source->get_type();
+ if ($type eq 'image')
+ {
+ $width = $source->get_width();
+ $height = $source->get_height();
+ }
+ elsif (defined(my $extents = $source->get_extents()))
+ {
+ $width = $$extents{width};
+ $height = $$extents{height};
+ }
+ else
+ {
+ $width = RECORDING_SIZE;
+ $height = RECORDING_SIZE;
+ }
+
+ $cr->save();
+ $cr->rectangle($$rect{x}, $$rect{y}, $$rect{width}, $$rect{height});
+ $cr->stroke();
+ $cr->rectangle($$rect{x}+$clip_margin, $$rect{y}+$clip_margin, $$rect{width}-$clip_margin*2,
$$rect{height}-$clip_margin*2);
+ $cr->set_dash(0, 2, 2);
+ $cr->stroke_preserve();
+ $cr->clip();
+
+ $cr->translate($$rect{x}, $$rect{y});
+ $cr->scale($$rect{width}/$width, $$rect{height}/$height);
+ $cr->set_source_surface($source, 0, 0);
+ $cr->paint();
+
+ $cr->restore();
+ }
+
+
+sub draw_pages
+ {
+ my ($surface) = @_;
+
+ my $cr = Cairo::Context->create($surface);
+
+ # Draw the image and recording surface on each page. The sources
+ # are clipped starting with a small clip area on the first page
+ # and increasing to the source size on last page to ensure the
+ # embedded source is not clipped to the area used on the first
+ # page.
+ #
+ # The sources are created each time they are used to ensure
+ # CAIRO_MIME_TYPE_UNIQUE_ID is tested.
+
+ for (my $i=0; $i<NUM_PAGES; $i++)
+ {
+ my $clip_margin = (NUM_PAGES-$i-1)*5;
+
+ my $source = create_image_surface();
+ draw_surface($cr, $source, {x => 25, y => 25, width => 100, height => 100,}, $clip_margin);
+ $source = undef;
+
+ $source = create_recording_surface_with_mime_jpg();
+ draw_surface($cr, $source, {x => 150, y => 25, width => 100, height => 100,}, $clip_margin);
+ $source = undef;
+
+ $source = create_recording_surface(1);
+ draw_surface($cr, $source, {x => 25, y => 150, width => 100, height => 100,}, $clip_margin);
+ $source = undef;
+
+ $source = create_recording_surface(0);
+ draw_surface($cr, $source, {x => 150, y => 150, width => 100, height => 100,}, $clip_margin);
+ $source = undef; # REQUIRED!
+
+ $cr->show_page();
+ }
+
+ $cr = undef;
+ }
+
+
+
+
+my $surface = Cairo::PdfSurface->create(OUTPUT_FILENAME, WIDTH, HEIGHT);
+if ($surface->status() ne 'success')
+ {
+ say $surface->status();
+ die;
+ }
+draw_pages($surface);
+$surface->finish();
+
+0;
diff --git a/lib/Cairo.pm b/lib/Cairo.pm
index c98a247..197bb9a 100644
--- a/lib/Cairo.pm
+++ b/lib/Cairo.pm
@@ -1369,6 +1369,20 @@ For hysterical reasons, you can also use the following syntax:
=item $type = $surface->get_type [1.2]
+=item $surface->set_mime_data ($mime_type, $mime_data) [1.10]
+
+=item $mime_data = $surface->get_mime_data ($mime_type) [1.10]
+
+=item $bool = $surface->supports_mime_type ($mime_type) [1.12]
+
+=over
+
+=item $mime_type: string
+
+=item $mime_data: binary data string
+
+=back
+
=item $status = $surface->copy_page [1.6]
=over
@@ -1695,6 +1709,14 @@ For hysterical reasons, you can also use the following syntax:
=item ($x0, $y0, $width, $height) = $surface->ink_extents [1.10]
+=item $extents_ref = $surface->get_extents [1.12]
+
+=over
+
+=item $extents_ref: I<Cairo::Rectangle> reference
+
+=back
+
=back
=cut
diff --git a/t/CairoSurface.t b/t/CairoSurface.t
index c48f1cf..4fb8b34 100644
--- a/t/CairoSurface.t
+++ b/t/CairoSurface.t
@@ -12,7 +12,7 @@ use warnings;
use Config; # for byteorder
-use Test::More tests => 89;
+use Test::More tests => 96;
use constant IMG_WIDTH => 256;
use constant IMG_HEIGHT => 256;
@@ -268,6 +268,29 @@ SKIP: {
like (Cairo::PdfSurface->version_to_string('1-4'), qr/1\.4/);
}
+ SKIP: {
+ skip 'new stuff', 3
+ unless Cairo::VERSION >= Cairo::VERSION_ENCODE (1, 10, 0);
+
+ my $mime_data = 'mime data for {set,get}_mime_data';
+ is ($surf->set_mime_data('image/jpeg', $mime_data), 'success');
+
+ my $recovered_mime_data = $surf->get_mime_data('unset mime type');
+ is ($recovered_mime_data, undef);
+
+ $recovered_mime_data = $surf->get_mime_data('image/jpeg');
+ is ($recovered_mime_data, $mime_data);
+ }
+
+ SKIP: {
+ skip 'new stuff', 2
+ unless Cairo::VERSION >= Cairo::VERSION_ENCODE (1, 12, 0);
+
+ is ($surf->supports_mime_type('image/jpeg'), 1);
+ is ($surf->supports_mime_type('unsupported mime type'), 0);
+
+ }
+
SKIP: {
skip 'new stuff', 1
unless Cairo::VERSION >= Cairo::VERSION_ENCODE (1, 16, 0);
@@ -392,7 +415,7 @@ SKIP: {
}
SKIP: {
- skip 'svg surface', 5
+ skip 'recording surface', 7
unless Cairo::HAS_RECORDING_SURFACE;
my $surf = Cairo::RecordingSurface->create (
@@ -411,4 +434,15 @@ SKIP: {
$surf = Cairo::RecordingSurface->create ('color', undef);
isa_ok ($surf, 'Cairo::RecordingSurface');
isa_ok ($surf, 'Cairo::Surface');
+
+ SKIP: {
+ skip 'get_extents', 2
+ unless Cairo::VERSION >= Cairo::VERSION_ENCODE (1, 12, 0);
+
+ $surf = Cairo::RecordingSurface->create ('color', undef);
+ is ($surf->get_extents(), undef);
+
+ $surf = Cairo::RecordingSurface->create ('color', {x => 5, y => 10, width => 15, height =>
20});
+ is_deeply ($surf->get_extents(), {x => 5, y => 10, width => 15, height => 20});
+ }
}
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
