File Coverage

lib/Kite/XML2PS.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

#========================================================================
# Kite::XML2PS
#
# DESCRIPTION
#   Perl module to convert a curve definition from OpenKite XML format
#   to PostScript, with automatic page tiling and registration mark
#   control.
#
# AUTHORS
#   Simon Stapleton  wrote the original xml2ps.pl
#   utility which performs the XML -> PostScript conversion.
#
#   Andy Wardley  re-packaged it into a module for
#   integration into the Kite bundle.
#
# COPYRIGHT
#   Copyright (C) 2000 Simon Stapleton, Andy Wardley.  All Rights Reserved.
#
#   This module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
#
# VERSION
#   $Id: XML2PS.pm,v 1.3 2000/10/17 12:19:28 abw Exp $
#
#========================================================================

package Kite::XML2PS;

require 5.004;

use strict;
use Kite::Base;
use Kite::XML::Parser;

use base qw( Kite::Base );
use vars qw( $VERSION $ERROR $DEBUG $PARAMS );

$VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
$DEBUG   = 0 unless defined $DEBUG;
$ERROR   = '';

# define parameters for this class, used by Kite::Base init() method
$PARAMS = {
    FILENAME => undef,
    TITLE    => '',
    REGMARKS => 1,
    BORDER   => 5,
    MAP      => 1,
};


#------------------------------------------------------------------------
# init($config)
#
# Initialisation method called by the base class new() constructor
# method.  Calls the base class init() to set any parameters from the
# $PARAMS hash and then calls process_file() to process the XML
# file to generate internal PATH and IMAGE definitions.
#------------------------------------------------------------------------

sub init {
    my ($self, $config) = @_;

    # call base class to read config params
    $self->SUPER::init($config)
	|| return undef;

    # process file
    $self->process_file()
	|| return undef;

    # OK
    return $self;
}


#------------------------------------------------------------------------
# process_file()
# process_file($filename)
#
# Processes the file specified as a parameter, or set internally as
# the FILENAME item, reading the XML contained therein and generating
# internal PATH and IMAGE definitions which can be retrieved via the
# path() and image() methods (handled automatically by the base class
# AUTOLOAD method).
#------------------------------------------------------------------------

sub process_file {
    my $self = shift;
    my $file = @_ ? shift : $self->{ FILENAME };
    my ($parser, $doc);

    return $self->error('no filename specified')
	unless defined $file;

    # parse XML file, trapping any errors thrown via die()
    $parser = Kite::XML::Parser->new();
    eval {
	$doc = $parser->parsefile($file);
    };
    return $self->error($@)
	if $@;

    my $path  = 'newpath ';
    my $image = '';
    my ($x, $y, $xt, $yt, $angle, $anglet);

    $self->{ KITE } = $doc;
    $self->{ TITLE } ||= $doc->title();

    # generate PS for each kite part
    foreach my $part (@{ $doc->part() })
    {
	$xt = $part->layout->x() || 0;
	$yt = $part->layout->y() || 0;
	$anglet = $part->layout->angle || 0;

	$image .= "gsave $xt mm $yt mm translate $anglet rotate ";
	$path  .= "$xt mm $yt mm translate $anglet rotate ";

	# add path segments as a series of PS moveto/lineto ops
	foreach my $curve (@{ $part->markup->curve })
	{
	    $image .= "gsave ";

	    my $linetype = $curve->linetype || "normal";

	    if ($linetype eq 'normal') {
		$image .= "0.5 setlinewidth ";
	    }
	    elsif ($linetype eq 'heavy') {
		$image .= "0.75 setlinewidth ";
	    }
	    elsif ($linetype eq "light") {
		$image .= "0.25 setlinewidth ";
	    }
	    elsif ($linetype eq "dotted") {
		$image .= "0.55 setlinewidth [3 5 1 5] 0 setdash ";
	    }

	    my $incurve = undef;

	    foreach my $point (@{ $curve->point })
	    {
		$x = $point->x;
		$y = $point->y;

		if (defined $incurve)
		{
		    $image .= "$x mm $y mm lineto ";
		    $path  .= "$x mm $y mm lineto ";
		}
		else
		{
		    $image .= "newpath $x mm $y mm moveto ";
		    $path  .= "$x mm $y mm moveto ";
		    $incurve = 1;
		}
	    }

	    # add text using PS pathtext function
	    foreach my $text (@{ $curve->text || [] })
	    {
		my $font = $text->font || "Helvetica";
		my $size = $text->size || "6";
		$text = $text->char;
		for ($text) {	# remove leading and trailing whitespace
		    s/^\s*//;
		    s/\s*$//;
		}
		$image  .= "gsave /$font findfont $size mm scalefont setfont ";
		$image  .= "($text) 0 pathtext grestore ";
	    }
	    $image .= "stroke grestore ";
	}

	# add transformations
	$path  .= "$anglet neg rotate $xt neg mm $yt neg mm translate ";
	$image .= "grestore ";
    }

    # save image and path definitions internally and return happy
    $self->{ IMAGE } = $image;
    $self->{ PATH  } = $path;

    return 1;
}


#------------------------------------------------------------------------
# doc()
#
# Generate a complete PostScript document to print the kite parts,
# with automatic multiple page tiling (page-size independant),
# registration marks and many other glorious features.  Returns the
# generated PostScript as a string.
#------------------------------------------------------------------------

sub doc {
    my $self = shift;

    require Kite::PScript::Defs;
    require Template;

    my $doc = $self->ps_template();
    my $template = Template->new( POST_CHOMP => 1);
    my $vars = {
	defs => bless { }, 'Kite::PScript::Defs',
    };
    my @keys = qw( kite title regmarks border map image path );
    @$vars{ @keys } = @$self{ map { uc } @keys };

    my $out = '';
    $template->process(\$doc, $vars, \$out)
	|| return $self->error($template->error());
    return $out;
}

#------------------------------------------------------------------------
# ps_template()
#
# Returns a Template Toolkit template for generating the PostScript.
#------------------------------------------------------------------------

sub ps_template {
    return <<'EOF';
[% USE fix = format('%.2f') -%]
%!PS-Adobe-3.0
[% IF title %]
%%Title: [% title %]
[% END %]
%%EndComments

[% defs.mm %]
[% defs.lines %]
[% defs.cross %]
[% defs.dot %]
[% defs.circle %]
[% defs.crop %]

/border [% border %] mm def
[% defs.clip +%]
[% regmarks ? defs.reg : defs.noreg +%]
[% defs.tiles +%]
[% defs.tilemap +%]
[% defs.pathtext %]

% define image, path and page procedures for tiling
/tileimage {
  [% image %]
} def

/tilepath {
  [% path %]
} def

/tilepage {
  regmarks
[% IF title %]
  /Times-Roman findfont 24 scalefont setfont
  clipblx 3 mm add clipbly 3 mm add moveto
  ([% title %]) show
[% END %]
[% "  tilemap\n" IF map %]
} def

tilepath tiles
[% defs.dotiles %]

EOF
}

1;

__END__