Codebase list libcairo-perl / fresh-snapshots/main examples / mime-unique-id.pl
fresh-snapshots/main

Tree @fresh-snapshots/main (Download .tar.gz)

mime-unique-id.pl @fresh-snapshots/mainraw · history · blame

#! /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,
	};


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($surface->MIME_TYPE_UNIQUE_ID, PNG_FILENAME);

	$surface->set_mime_data($surface->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($surface->MIME_TYPE_JPEG, $data);
	if ($surface->status() ne 'success')
		{
		say $surface->status();
		die;
		}

	$surface->set_mime_data($surface->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($surface->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;