Games::Go::Dg2TkPs - Perl extension to convert Games::Go::Diagrams to

 my $dg2ps = B<Games::Go::Dg2TkPs-E<gt>new> (options);
 my $canvas = $dg2ps->convertDiagram($diagram);

# $Id: Dg2TkPs.pm 143 2005-06-03 21:05:57Z reid $

#   Dg2TkPs
#
#   Copyright (C) 2005 Reid Augustin reid@hellosix.com
#                      1000 San Mateo Dr.
#                      Menlo Park, CA 94025 USA
#
#   This library is free software; you can redistribute it and/or modify it
#   under the same terms as Perl itself, either Perl version 5.8.5 or, at your
#   option, any later version of Perl 5 you may have available.
#
#   This program is distributed in the hope that it will be useful, but
#   WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
#   or FITNESS FOR A PARTICULAR PURPOSE.
#

use strict;
require 5.001;

package Games::Go::Dg2TkPs;
use Games::Go::Dg2Tk;
use Carp;

our @ISA = qw(Exporter Games::Go::Dg2Tk);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration       use PackageName ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
);

BEGIN {
    our $VERSION = sprintf "1.%03d", '$Revision: 143 $' =~ /(\d+)/;
}

######################################################
#
#       Class Variables
#
#####################################################

######################################################
#
#       Public methods
#
#####################################################

sub comment {
    my ($my, @comments) = @_;

    $my->{comment} = '' unless(exists($my->{comment}));
    $my->{comment} .= join("\n", @comments);
}

sub configure {
    my ($my, %args) = @_;

    if (exists($args{file})) {
        $my->{file} = delete($args{file});
        if (ref($my->{file}) eq 'SCALAR') {
            $my->{filename} = $my->{file};
        } elsif (ref($my->{file}) eq 'ARRAY') {
            $my->{filename} = 'ARRAY';
        } elsif (ref($my->{file}) eq 'GLOB') {
            $my->{filename} = 'GLOB';
        } elsif (ref($my->{file}) =~ m/^IO::/) {
            $my->{filename} = 'IO';
        } else {
            $my->{filename} = $my->{file};
        }
    }
    $my->SUPER::configure(%args);
}

my $pageSetup =
#   "%%PageBoundingBox: 28 28 584 764\n" .
    "\%\%BeginPageSetup\n" .
    "/pagelevel save def\n" .
#   "28 28 584 764 cliptobox\n" .
#   "debugdict begin\n" .
#   "userdict begin" .
    "\%\%EndPageSetup\n";
my $pageTrailer = 
    "\%\%PageTrailer\n" .
#   "end\n" .
#   "end\n" .
    "pagelevel restore\n" .
    "showpage\n";

sub close {
    my ($my) = @_;

    my $nb = $my->notebook;     # get the Dg2Tk notebook object
    # $my->diagrams->[0]->after(1000); # delay
    require IO::File;
    my $fname = $my->{filename} || 'dg2ps.ps';
    my $fd = IO::File->new($fname) or
        die("Error opening $fname: $!\n");
    my $trailer;
    $my->{comment} =~ s/^/%%/;
    $my->{comment} =~ s/\n/\n%%/gs;
    $my->{comment} =~ s/\n%%$/\n/s;
    my $page = 0;
    foreach my $dg (@{$my->diagrams}) {
        $nb->update;                # bring Tk display up to date
        my $ps = $dg->postscript();
        $page++;
        $ps =~ s/^(\%!PS-Adobe-3.0) EPSF-.*?\n/$1\n/;
        $ps =~ s/(\%\%Trailer\b.*)//s;  # remove trailer
        unless (defined($trailer)) {    # first page
            $trailer = $1;
            $ps =~ s/\%\%Pages: 1/\%\%Pages: (atend)/s; # report pages at end
            $ps =~ s/(\%\%EndComments)/$my->{comment}\n$1/s;
        } else {                        # all following pages
            $ps =~ s/.*\%\%EndSetup\b//s;  # remove prologue
        }
        $ps =~ s/\n%%Page: .*?\n/\%\%Page: $page $page\n$pageSetup/so;

        $ps =~ s/\s*\bshowpage\n\n$/\n$pageTrailer/so;
        $fd->print($ps);
        $nb->raise($nb->info('focusnext'));
    }
    $trailer =~ s/\%\%Trailer/\%\%Trailer\n\%\%Pages: $page/gs;
    $fd->print($trailer);       # put trailer back
    close $fd;
}

######################################################
#
#       Private methods
#
#####################################################


1;

__END__