# Copyright (c) 1997-2006
# Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
# http://www.math.tu-berlin.de/polymake, mailto:polymake@math.tu-berlin.de
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any
# later version: http://www.gnu.org/licenses/gpl.txt.
#
# 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. See the
# GNU General Public License for more details.
#-----------------------------------------------------------------------------
# $Project: polymake $$Id: Postscript.pm 7495 2006-12-11 11:03:05Z gawrilow $
no integer;
package Postscript;
# the average ratio of the glyph weight and height
declare $avg_char_width=0.7;
################################################################################
# useful small utilities
sub draw_poly_line {
my $first=shift;
if (is_array($first)) {
" newpath @$first moveto " . join(" ", map { "@$_ lineto" } @_) . " "
} else {
" newpath $first moveto " . join(" ", map { "$_ lineto" } @_) . " "
}
}
################################################################################
#
# an abstract base class for various drawables (Graph, Polygon, Gale, etc.)
#
package Postscript::Element;
use Struct (
[ '$marginLeft' => 'undef' ],
[ '$marginRight' => 'undef' ],
[ '$marginBottom' => 'undef' ],
[ '$marginTop' => 'undef' ],
[ '$minX' => 'undef' ],
[ '$maxX' => 'undef' ],
[ '$minY' => 'undef' ],
[ '$maxY' => 'undef' ],
[ '$locked' => '1' ], # the scale for X and Y dimensions must be the same
);
################################################################################
package Postscript::Page;
use Struct (
[ new => '$' ],
[ '@ISA' => 'Postscript::Element' ],
[ '$locked' => '0' ],
'$scaleX',
'$scaleY',
[ '$canvas_width' => '$Wpaper-2*$Wmargin' ],
[ '$canvas_height' => '$Hpaper-2*$Hmargin' ],
[ '$title' => '#1' ],
'%procsets',
'$setup',
'%dict',
'$code',
'@elements',
);
# real world coordinates => PostScript sheet coordinates
sub transform {
no integer;
my $self=shift;
my @xy=( $self->scaleX * ($_[0] - $self->minX) + $self->marginLeft,
$self->scaleY * ($_[1] - $self->minY) + $self->marginBottom );
wantarray ? @xy : "@xy"
}
sub finish {
no integer;
my ($self)=@_;
return unless @{$self->elements};
foreach my $e (@{$self->elements}) {
assign_max($self->marginLeft, $e->marginLeft);
assign_max($self->marginRight, $e->marginRight);
assign_max($self->marginTop, $e->marginTop);
assign_max($self->marginBottom, $e->marginBottom);
assign_min($self->minX, $e->minX);
assign_max($self->maxX, $e->maxX);
assign_min($self->minY, $e->minY);
assign_max($self->maxY, $e->maxY);
$self->locked ||= $e->locked;
}
$self->scaleX= $self->maxX == $self->minX
? 0
: ($self->canvas_width - $self->marginLeft - $self->marginRight) /
($self->maxX - $self->minX);
$self->scaleY= $self->maxY == $self->minY
? 0
: ($self->canvas_height - $self->marginTop - $self->marginBottom) /
($self->maxY - $self->minY);
if ($self->locked) {
if ($self->scaleX and !$self->scaleY || $self->scaleX <= $self->scaleY) {
$self->scaleY=$self->scaleX;
$self->canvas_height= $self->scaleY*($self->maxY-$self->minY) +
$self->marginBottom + $self->marginTop;
} else {
$self->scaleX=$self->scaleY;
$self->canvas_width= $self->scaleX*($self->maxX-$self->minX) +
$self->marginLeft + $self->marginRight;
}
} else {
if (!$self->scaleX) {
$self->canvas_width= $self->marginLeft + $self->marginRight;
}
if (!$self->scaleY) {
$self->canvas_height= $self->marginBottom + $self->marginTop;
}
}
$self->marginLeft += $Wmargin;
$self->marginBottom += $Hmargin;
foreach my $e (@{$self->elements}) {
$e->draw($self);
}
@{$self->elements}=();
}
sub print_it {
my ($self, $file, $ord)=@_;
my @bb=( $Wmargin, $Hmargin,
$Wmargin+$self->canvas_width, $Hmargin+$self->canvas_height );
my $title=$self->title;
print $file <<".";
%%Page: $title $ord
%%PageBoundingBox: @bb
%%BeginPageSetup
/$fontname $fontsize selectfont
$line_width setlinewidth
0 setgray
.
print $file $self->setup;
my $dictsize=keys %{$self->dict};
if ($dictsize) {
print $file "$dictsize dict begin\n",
map { "/$_ " . $self->dict->{$_} . " def\n" } keys %{$self->dict};
}
my $code=$self->code;
print $file <<".";
%%EndPageSetup
$code
showpage
.
print $file "end\n" if $dictsize;
}
###########################################################################
package Postscript::File;
use Struct (
[ new => '$' ],
[ '$workfile' => '#1' ],
'$title',
'@pages',
'%procsets', # 'name' => 'text'
'@procset_names', # 'name'
);
sub encode_text {
if ($_[0] =~ /\s/ || /^\d*$/ || /^\(/) {
$_[0]="($_[0])";
}
}
sub finish_page {
my ($self)=@_;
return unless @{$self->pages};
my $page=$self->pages->[-1];
$page->finish;
if (length(my $t=$page->title)) {
encode_text($t);
$page->title=$t;
$self->title ||= $t;
} else {
$page->title=scalar(@{$self->pages});
}
while (my ($name, $code)=each %{$page->procsets}) {
$self->procsets->{$name} ||= do {
push @{$self->procset_names}, $name;
$code
}
}
%{$page->procsets}=();
}
sub new_page {
my $self=shift;
finish_page($self);
push @{$self->pages}, new Postscript::Page(@_);
}
sub print_it {
my ($self)=@_;
finish_page($self);
open my $file, ">".$self->workfile
or croak( "can't create working file ", $self->workfile, ": $!\n" );
my $n_pages=@{$self->pages};
my $title=$self->title;
print $file <<".";
%!PS-Adobe-3.0
%%Creator: polymake
%%Title: $title
%%Pages: $n_pages
%%BoundingBox: (atend)
.
if (my $declare_procsets=join("%%+", map { " procset $_ 0\n" } @{$self->procset_names})) {
print $file "%%DocumentSuppliedResources: $declare_procsets";
}
print $file <<".";
%%EndComments
%%BeginProlog
.
foreach my $pn (@{$self->procset_names}) {
my $ps=$self->procsets->{$pn};
print $file <<".";
%%BeginResource: procset $pn 0
$ps
%%EndResource
.
}
print $file <<".";
%%EndProlog
.
my $ord=1;
my ($bbw, $bbh)=(0, 0);
foreach my $p (@{$self->pages}) {
assign_max($bbw, $p->canvas_width);
assign_max($bbh, $p->canvas_height);
$p->print_it($file, $ord++);
}
$bbw += $Wmargin;
$bbh += $Hmargin;
print $file <<".";
%%Trailer
%%BoundingBox: $Wmargin $Hmargin $bbw $bbh
%%EOF
.
close $file;
}
###########################################################################
#
# Drawing of some graphical primitives defined in modules::common
#
package Postscript::PointSet;
use Struct (
[ new => '$' ],
[ '@ISA' => 'Postscript::Element' ],
[ '$source' => '#1' ],
'@coords',
'@radius',
);
sub init {
no integer;
my $self=shift;
my $P=$self->source;
@{$self->coords} = map { [ ( /\S+/g )[0,1] ] } @{$P->Vertices}; # chop the z coordinate if any
($self->minX, $self->minY)=($self->maxX, $self->maxY)=@{$self->coords->[0]};
my $last_point=$#{$self->coords};
my ($labelwidth, $max_radius);
if (my $get_style=$P->VertexStyle) {
if (is_code($get_style)) {
@{$self->radius}=map {
my $s=$get_style->($_);
if ($s =~ $Visual::thickness_re) {
assign_max($max_radius,$point_radius*$1/2);
$point_radius*$1/2;
} else {
$s !~ $Visual::hidden_re && $point_radius;
}
} 0..$last_point;
} else {
if ($get_style =~ $Visual::thickness_re) {
$max_radius=$point_radius*$1/2;
} elsif ($get_style !~ $Visual::hidden_re) {
$max_radius=$point_radius;
}
}
} else {
$max_radius=$point_radius;
}
if (defined($max_radius) && !@{$self->radius}) {
@{$self->radius}=($max_radius) x ($last_point+1);
}
foreach my $coord (@{$self->coords}) {
assign_min_max($self->minX, $self->maxX, $coord->[0]);
assign_min_max($self->minY, $self->maxY, $coord->[1]);
}
if ($P->VertexLabels) {
map { assign_max($labelwidth, length($P->VertexLabels->($_))) } 0..$#{$self->coords};
}
return ($labelwidth, $max_radius);
}
sub new {
my $self=&_new;
my ($labelwidth, $max_radius)=$self->init;
$self->marginLeft=$self->marginRight=
max($max_radius, ($avg_char_width * $fontsize*$labelwidth)/2) + $text_spacing/2;
$self->marginBottom= $max_radius + $text_spacing/2;
$self->marginTop=$self->marginBottom + $fontsize + $text_spacing;
$self;
}
sub draw_points {
my ($self, $page)=@_;
my $P=$self->source;
my $get_color=$P->VertexColor;
my @color;
if (!is_code($get_color)) {
@color=Visual::parse_color($get_color);
undef $get_color;
}
if (!@color) {
@color=Visual::parse_color($Visual::Color::vertices);
}
my $default_color=join(" ", RGB2float(@color[2..4]));
for (my ($p, $last_point)=(0, $#{$self->coords}); $p<=$last_point; ++$p) {
my $r=$self->radius->[$p] or next;
$page->code .= ($get_color && (@color=Visual::parse_color($get_color->($p))) ? RGB2float(@color[2..4]) : $default_color) .
" $r (" . ($P->VertexLabels ? $P->VertexLabels->($p) : " ") . ") " . join(" ", @{$self->coords->[$p]}) . " Point\n";
}
}
sub draw_lines { }
sub draw {
my ($self, $page)=@_;
foreach my $p (@{$self->coords}) {
@$p=$page->transform(@$p);
}
$self->draw_lines($page);
$self->draw_points($page) if @{$self->radius};
}
###########################################################################
package Postscript::Polygon;
use Struct [ '@ISA' => 'Postscript::PointSet' ];
sub draw_facet {
my ($facet_color, $facet_style, $edge_color, $edge_style, $points)=@_;
my $fill=1;
if (my @color=Visual::parse_color($facet_color)) {
$facet_color=RGB2float(@color[2..4]);
$fill=!$color[0];
}
if ($facet_style =~ $Visual::hidden_re) {
$fill=0;
}
if (my @color=Visual::parse_color($edge_color)) {
$edge_color=RGB2float(@color[2..4]);
} elsif (!$fill) {
$edge_color=$facet_color;
}
my $lw;
if ($edge_style =~ $Visual::hidden_re) {
$lw=0;
} elsif ($edge_style =~ $Visual::thickness_re) {
$lw=$1*$line_width;
} elsif ($line_width != 1) {
$lw=$line_width;
}
my $gsave=($lw || !defined($lw) && $edge_color) && "gsave";
my $code=$gsave . draw_poly_line(@$points) . "closepath\n";
if ($fill) {
$code .= <<".";
gsave $facet_color setrgbcolor eofill grestore
.
}
if (!defined($lw) || $lw) {
if ($edge_color) {
$code .= "$edge_color setrgbcolor ";
}
if ($lw) {
$code .= "$lw setlinewidth ";
}
$code .= "stroke\n";
}
$code .= $gsave && "grestore\n";
}
sub draw_lines {
my ($self, $page)=@_;
my $P=$self->source;
my $facet=$P->Facet;
$page->code .= draw_facet( (map { $P->$_ } qw( FacetColor FacetStyle EdgeColor EdgeStyle )),
$facet ? subset($self->coords, $facet =~ /\d+/g)
: $self->coords);
}
###########################################################################
package Postscript::Polygons;
use Struct [ '@ISA' => 'Postscript::Polygon' ];
sub draw_lines {
my ($self, $page)=@_;
my $P=$self->source;
my $i=0;
foreach my $polygon (@{$P->Polygons}) {
$page->code .= Postscript::Polygon::draw_facet( (map { my $decor=$P->$_; is_code($decor) ? $decor->($i) : $decor }
qw( FacetColor FacetStyle EdgeColor EdgeStyle )),
subset($self->coords, $polygon->Facet =~ /\d+/g));
++$i;
}
}
###########################################################################
package Postscript::Page;
my $pointset_procs=<<'.';
% R G B raduis (label) x y ->
/Point {
gsave translate
dup stringwidth pop 2 div neg 2 index text_spacing add moveto show
newpath 0 0 3 -1 roll 0 360 arc
gsave setrgbcolor fill grestore stroke
grestore
} def
.
sub addPointSet {
my ($self, $elem)=@_;
$self->title ||= $elem->source->name;
push @{$self->elements}, $elem;
$self->procsets->{'Common::pointset'}=$pointset_procs;
$self->dict->{text_spacing}=$text_spacing;
}
1
# Local Variables:
# c-basic-offset:3
# End:
syntax highlighted by Code2HTML, v. 0.9.1