CAD::Drawing::IO::PostScript - PostScript output methods

  (1) GNU General Public License
    (found at http://www.gnu.org/copyleft/gpl.html)
  (2) Artistic License
    (found at http://www.perl.com/pub/language/misc/Artistic.html)

  CAD::Drawing
  CAD::Drawing::IO
  PostScript::Simple

  $fact = check_type($filename, $type);

  load();

  $drw->save($filename, \%opts);

  PostScript::Simple::setpscolor();

package CAD::Drawing::IO::PostScript;
our $VERSION = '0.03';

use CAD::Drawing;
use CAD::Drawing::Defined;
use PostScript::Simple;


use strict;
use Carp;
########################################################################

########################################################################
# the following are required to be a disc I/O plugin:
our $can_save_type = "ps";

sub check_type {
	my ($filename, $type) = @_;
	if(defined($type)) {
		($type eq "ps") && return("ps");
		return();
	}
	elsif($filename =~ m/\.e?ps$/) {
		return("ps");
	}
	return();
} # end subroutine check_type definition

########################################################################

sub load {
	croak("cannot yet load postscript!");
} # end subroutine load definition
########################################################################

sub save {
	my $self = shift;
	my($filename, $opt) = @_;
	my %opts;
	my $accuracy = 1; # digits of accuracy with which to bother
	my $sp = 30;
	(ref($opt) eq "HASH") && (%opts = %$opt);
	my $outobj;
	if($filename =~ m/\.eps/) {
		# implies eps fit
		my @ext = $self->OrthExtents($opt);
		my ($x, $y) = map({$_->[1] - $_->[0]} @ext);
		$sp = 0;
		# print "eps will be $x by $y\n";
		my $obj = PostScript::Simple->new(
					eps    => 1,
					xsize  => $x,
					ysize  => $y,
					colour => 1,
					);
		$opts{readymadeobject} = $obj;
	}
	unless($opts{"readymadeobject"} ) {
		$outobj = new PostScript::Simple(
						landscape => 1,
						eps => 0,
						papersize => "Letter",
						colour => 1,
						);
		$outobj->newpage;
	}
	else {
		$outobj = $opts{"readymadeobject"};
	}

	# now can get the size from the object and use it to set the scale of
	# things
	my(@fitsize) = ($$outobj{bbx2}, $$outobj{bby2});
#   print "got size:  @fitsize\n";
 	my(@bound) = ([0,0], [@fitsize]);
	my $drw = $self;  # default is to smash $self
	
	# FIXME: why did I have this here?
	# my $worklist = $drw->select_addr();
	
	unless($opts{"noclone"}) {
		$drw = CAD::Drawing->new;
		# passing original opts allows selective save
		$self->GroupClone($drw, $opt);	
		}
	####################################################################
	# Setup border
	my @border;
	if(ref($opts{"border"}) eq "ARRAY") {
#		@border = ( [@sp] , [$fitsize[0]-$sp[0] , $fitsize[1]-$sp[1] ]);
		@border = @{$opts{"border"}};
		}
	elsif(defined($opts{"border"})) {
		my $num = $opts{"border"};
		@border = ([$num,$num], [-$num,-$num]);
		}
	else {
		@border = ([$sp, $sp], [-$sp, -$sp]);
		}
	####################################################################
	# Perform fit
# 	$outobj->line(0,0, @fitsize);
	my $scaling = $drw->fit_to_bound([@bound], [@border], 
							{"center" =>[$fitsize[0] / 2, $fitsize[1]/2 ] , %opts} );
	####################################################################
	if($opts{show_border} ) {
		$drw->addrec( 
				[ 
					[
					$bound[0][0] + $border[0][0] / 2 , 
					$bound[0][1] + $border[0][1] / 2
					],
					[
					$bound[1][0] + $border[1][0] / 2  , 
					$bound[1][1] + $border[1][1] / 2
					]
				]
			);
	} # end if show border
	# now must draw all of the resultant geometry
	my $filledopt = 0;
	if($opts{"filled"}) {
		# FIXME:  need some way to make this selective?
		$filledopt = $opts{filled};
		}
	my $font_choice = "Helvetica";
	$opts{font} && ($font_choice = $opts{font});
	# NOTE NOTE NOTE NOTE NOTE NOTE:not using $self here!
	my %ps_data = (
		psobj => $outobj,
		font => $font_choice,
		filled => $filledopt,
		accuracy => $accuracy,
		);

	our %ps_functions;
	$drw->outloop(\%ps_functions, \%ps_data);
	$opts{show} && ($drw->show(hang => 1));
	return($outobj->output($filename));
} # end subroutine save definition
########################################################################

sub PostScript::Simple::setpscolor {
	my $self = shift;
	my($ac_color) = @_;
	my %no = map( { $_ => 1} 0, 7, 256);
	$no{$ac_color} && return();
	my $ps_color = $aci2rgb[$ac_color];
	$self->setcolour(@$ps_color);
} # end subroutine PostScript::Simple::setpscolor definition
########################################################################

our %ps_functions = (
	before => sub {
		my ($obj, $data) = @_;
		my $ps = $data->{psobj};
		$ps->setpscolor($obj->{color});
		defined($obj->{linewidth}) && $ps->setlinewidth($obj->{linewidth});
	},
	after => sub {
		my ($obj, $data) = @_;
		my $ps = $data->{psobj};
		$ps->setpscolor(255);
		defined($obj->{linewidth}) && $ps->setlinewidth(1);
	},
	lines => sub {
		my ($line, $data) = @_;
		my $ps = $data->{psobj};
		my $acc = $data->{accuracy};
		my @pspts = map({@{$line->{pts}[$_]}[0,1]} 0,1);
		$ps->line(map({sprintf("%0.${acc}f", $_)} @pspts));
	},
	plines => sub {
		my ($pline, $data) = @_;
		my $ps = $data->{psobj};
		my $filled = $data->{filled};
		my $acc = $data->{accuracy};
		my @points = map({@{$_}[0,1]} @{$pline->{pts}});
		foreach my $point (@points) {
			$point = sprintf("%0.${acc}f", $point);
		}
		$pline->{closed} && (push(@points, @points[0,1]));
# 		$pline->{closed} && print "closed polyline\n";
# 		print "points:\n\t", join("\n\t", map({join(",", @{$pline->{pts}})}));
		$ps->polygon({filled => $filled}, @points);
	},
	circles => sub {
		my ($circ, $data) = @_;
		my $ps = $data->{psobj};
		my $filled = $data->{filled};
		my $acc = $data->{accuracy};
		my @pt = map({sprintf("%0.${acc}f", $_)} @{$circ->{pt}}[0,1]);
		my $rad = sprintf("%0.${acc}f",  $circ->{rad});
		$ps->circle({filled=>$filled},  @pt, $rad);
	},
	# points are a fake circle:
	points => sub {
		my ($circ, $data) = @_;
		my $ps = $data->{psobj};
		my $filled = $data->{filled};
		my $acc = $data->{accuracy};
		my @pt = map({sprintf("%0.${acc}f", $_)} @{$circ->{pt}}[0,1]);
		# XXX this is SO lame!
		my $rad = 0.01;
		$ps->circle({filled=>$filled},  @pt, $rad);
	},
	arcs => sub {
		my ($arc, $data) = @_;
		my $ps = $data->{psobj};
		my $acc = $data->{accuracy};
		my @pt = map({sprintf("%0.${acc}f", $_)} @{$arc->{pt}}[0,1]);
		my $rad = sprintf("%0.${acc}f",  $arc->{rad});
		my @angs = map({sprintf("%0.0f", $_ * 180 / $pi)} @{$arc->{angs}});
		$ps->arc(@pt, $rad, @angs);
	},
	texts => sub {
		my ($text, $data) = @_;
		my $ps = $data->{psobj};
		my $acc = $data->{accuracy};
		my @pt = map({sprintf("%0.${acc}f", $_)} @{$text->{pt}}[0,1]);
		my $font = $text->{font} ? $text->{font} : $data->{font};
		$ps->setfont($font, $text->{height});
		my @call = (@pt, $text->{string});
		# XXX no rotation support
		my %options;
		if($text->{angle}) {
			$options{rotate} = $text->{angle} * 180 / $pi;
		}
		$text->{align} and ($options{align} = $text->{align});
		$text->{valign} and ($options{valign} = $text->{valign});
		%options and unshift(@call, \%options);
		$ps->text(@call);
	},
);

1;