>From 70c0c58ead7766a5bff22ca8582c274c2963e0a7 Mon Sep 17 00:00:00 2001 From: Raymond S Brand Date: Sat, 31 Oct 2020 10:16:25 -0400 Subject: [PATCH 2/2] 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(-) create mode 100755 examples/mime-unique-id.pl diff --git a/CairoSurface.xs b/CairoSurface.xs index 11468ec..d14caf2 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 = 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(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 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..32ec0ce 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 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}); + } } -- 2.20.1