#  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: