#  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: PostscriptGraph.pm 7495 2006-12-11 11:03:05Z gawrilow $

no integer;

package Postscript::Graph;

use Struct (
   [ '@ISA' => 'Postscript::PointSet' ],
   '$directed',
);

sub new {
   my $self=&_new;
   my ($labelwidth)=$self->init;
   $self->marginLeft=$self->marginRight=
      ($avg_char_width * $fontsize*$labelwidth + $text_spacing)/2 + $line_width;
   $self->marginTop=$self->marginBottom=
      ($fontsize                               + $text_spacing)/2 + $line_width;
   $self->directed=$self->source->Directed;
   $self;
}

sub draw_edge {
   my ($self, $edge)=@_;
   my ($s, $t)=$edge->incident_nodes;
   #   my $label=$Graph->get_edge_label($edge);
   my $rgb="0 0 0";
   my $lw=$line_width;
   my $style=$self->source->EdgeStyle;
   $style=$style->($edge) if is_code($style);
   if ($style =~ $Visual::hidden_re) {
      return "";
   }
   if ($style =~ $Visual::thickness_re) {
      $lw*=$1;
   }
   my $color=$self->source->EdgeColor;
   $color=$color->($edge) if is_code($color);
   if (my @color=Visual::parse_color($color)) {
      $rgb=RGB2float(@color[2..4]);
   }
   return "$rgb $lw ".join(" ", @{$self->coords->[$s]})." ".join(" ", @{$self->coords->[$t]}) ." edge\n";
}

sub node_decorations {
   my ($self, $node)=@_;
   my $rgb="1 1 1";
   my $bw=$line_width;
   my $fill="true";
   my $style=$self->source->NodeStyle;
   $style=$style->($node) if is_code($style);
   if ($style =~ $Visual::hidden_re) {
      return ();
   }
   if ($style =~ $Visual::thickness_re) {
      $bw*=$1;
   }
   my $color=$self->source->NodeColor;
   $color=$color->($node) if is_code($color);
   if (my @color=Visual::parse_color($color)) {
      $rgb=RGB2float(@color[2..4]);
      $fill="false" if $color[0];
   }
   return ("$rgb $fill $bw", "(".($self->source->NodeLabels ? $self->source->NodeLabels->($node) : " ").")");
}

sub draw_node {
   my ($self, $node)=@_;
   my @dec=$self->node_decorations($node);
   return @dec ? join(" ", @dec, @{$self->coords->[$node]}) ." CenteredLabel\n" : "";
}

sub draw {
   my ($self, $page)=@_;
   foreach my $p (@{$self->coords}) {
      @$p=$page->transform(@$p);
   }

   my $Graph=$self->source;
   my $nodes=@{$self->coords};

   local $"=" ";	# for any case ...
   $page->code .= "/edge /" . ($self->directed ? "dir_edge" : "undir_edge") . " load def\n";
   for (my $edge=$Graph->edges(); $edge; ++$edge) {
      $page->code .= $self->draw_edge($edge);
   }
   for (my $n=0; $n<$nodes; ++$n) {
      $page->code .= $self->draw_node($n);
   }
}

my $common_procs=<<"-----";
/text_spacing $text_spacing def
/labelheight $fontsize text_spacing add def

% create rectangular path of size width*labelheight
% centered at the current position
% width ->
/box {
   dup 2 div neg labelheight 2 div neg rmoveto
   0 labelheight rlineto
   0 rlineto
   0 labelheight neg rlineto
   closepath
} bind def

% draw the colored box with black border (if fill=true) or the white box with colored border (if fill=false)
% centered at (x,y)
% r g b fill borderwidth width x y ->
/BorderedBox {
   gsave
   newpath moveto box setlinewidth
   { setrgbcolor gsave fill grestore 0 setgray } % fill=true
   { 1 setgray gsave fill grestore setrgbcolor } % fill=false
   ifelse
   stroke
   grestore
} bind def
-----

my $dir_procs=<<"-----";
/arrowheadlength $arrowheadlength def
/arrowheadwidth $arrowheadwidth def

% draw edge (arrow) from (x1,y1) to (x2,y2)
% r g b linewidth x1 y1 x2 y2 ->
/dir_edge {
   gsave
   8 dict begin
   /y2 exch def
   /x2 exch def
   /y1 exch def
   /x1 exch def
   /dx x2 x1 sub def
   /dy y2 y1 sub def
   /arrowlength dx dx mul dy dy mul add sqrt def
   /angle dy dx atan def
   setlinewidth setrgbcolor
   x1 y1 translate
   angle rotate
   0 0 moveto arrowlength 0 lineto stroke
   arrowlength arrowheadlength sub arrowheadwidth 2 div moveto 
   arrowlength 0 lineto
   arrowlength arrowheadlength sub arrowheadwidth 2 div neg lineto
   closepath fill
   end
   grestore
} def
-----

my $undir_procs=<<"-----";
% draw edge from (x1,y1) to (x2,y2)
% r g b linewidth x1 y1 x2 y2 ->
/undir_edge {
   gsave newpath moveto lineto setlinewidth setrgbcolor stroke grestore
} bind def
-----

my $graph_procs=<<"-----";
% draw a boxed label with center (x,y) and appropriate width
% R G B fill borderwidth (label) x y ->
/CenteredLabel {
   gsave
   4 dict begin
   /y exch def
   /x exch def
   dup stringwidth pop /lw exch def
   /label exch def
   lw text_spacing add x y BorderedBox
   x lw 2 div sub y $fontsize 0.3 mul sub moveto
   label show
   end
   grestore
} def
-----

###########################################################################
package Postscript::Lattice;

use Struct (
   [ '@ISA' => 'Postscript::Graph' ],
   [ '$locked' => '0' ],
   '%sorted',
);

sub new {
   my $self=&_new;
   my $Graph=$self->source;
   $self->directed = $Graph->ArrowStyle;
   my @label_width=map {
      ($avg_char_width * $fontsize * length($Graph->NodeLabels->($_)) + $text_spacing)*(1+$face_spacing);
   } 0..$Graph->get_number_nodes-1;
   $label_width[0]=$Wpaper-2*$Wmargin;

   my $embedding=$Graph->Coord;
   if (is_object($embedding)) {
      # expecting Visual::Embedding("hd_embedder", "LATTICE_SECTION", params...) here
      $embedding->splice(2, [ "@label_width\n" ], $Graph->Mode, undef);
   }
   @{$self->coords}=map { [ split ] } @$embedding;

   my $style=$Graph->NodeStyle;
   foreach my $n (0..$#label_width) {
      if (!is_code($style) || $style->($n) !~ $Visual::hidden_re) {
	 my ($x, $y)=@{$self->coords->[$n]};
	 assign_min($self->minX, $x-$label_width[$n]/2);
	 assign_max($self->maxX, $x+$label_width[$n]/2);
	 assign_min_max($self->minY, $self->maxY, $y);
      }
   }

   $self->marginTop=$self->marginBottom= 0.5*$fontsize + 0.5*$text_spacing + $line_width;
   $self->marginLeft=$self->marginRight= 0.5*$text_spacing + $line_width;
   $self;
}

sub draw_node {
   my ($self, $node)=@_;
   my ($x, $y)=@{$self->coords->[$node]};
   if (my @decor=$self->node_decorations($node)) {
      unshift @decor, $x;
      push @{$self->sorted->{$y}}, \@decor;
   }
   return "";	# will produce PostScript code later
}

sub draw_edge {
   my ($self, $edge)=@_;
   my $rgb="0 0 0";
   my $lw=$line_width;
   my $style=$self->source->EdgeStyle;
   $style=$style->($edge) if is_code($style);
   if ($style =~ $Visual::hidden_re) {
      return "";
   }
   if ($style =~ $Visual::thickness_re) {
      $lw*=$1;
   }
   my $color=$self->source->EdgeColor;
   $color=$color->($edge) if is_code($color);
   if (my @color=Visual::parse_color($color)) {
      $rgb=RGB2float(@color[2..4]);
   }
   my $arrow_style=$self->source->ArrowStyle;
   $arrow_style=$arrow_style->($edge) if is_code($arrow_style);
   my ($s,$t);
   if ($arrow_style>0) {
      ($s,$t)=$edge->incident_nodes;
   } else {
      ($t,$s)=$edge->incident_nodes;
   }
   return "$rgb $lw @{$self->coords->[$s]} @{$self->coords->[$t]} edge\n";
}

sub draw {
   my ($self, $page)=@_;
   &Postscript::Graph::draw;

   my $code="[\n";
   while (my ($y, $list)=each %{$self->sorted}) {

      my @sorted_by_x=sort { $list->[$a]->[0] <=> $list->[$b]->[0] } 0..$#$list;
      my $min_gap=$Wpaper;
      foreach my $i (1..$#sorted_by_x-1) {
	 assign_min($min_gap, $list->[$sorted_by_x[$i]]->[0] - $list->[$sorted_by_x[$i-1]]->[0]);
	 assign_min($min_gap, $list->[$sorted_by_x[$i+1]]->[0] - $list->[$sorted_by_x[$i]]->[0]);
      }

      $code .= "  [ $y $min_gap\n" .
               join("", map { my $i=$_;
			      "    [" . join(" ", map { $list->[$_]->[$i] } @sorted_by_x) . "]\n"
			    } 0..$#{$list->[0]}) .
	       "  ]\n";
   }
   $code .= "] draw_nodes\n";
   $page->code .= $code;
   $page->dict->{face_spacing}=1+$face_spacing;
}

my $lattice_procs=<<"-----";
/min { 2 copy gt { exch } if pop } bind def
/max { 2 copy lt { exch } if pop } bind def

% [ [ y gap [ x ] [ R G B fill borderwidth ] [ label ] ] ... ] ->
/draw_nodes {
   7 dict begin
   /label 0 def  /RGB 0 def  /x 0 def  /gap 0 def  /y 0 def
   /font_scale 1 def  /i 0 def

   % find the minimal text scale suitable for all layers
   dup
   {
      dup 1 get
      % param_array, layer_array, gap ->
      0 2 index 4 get
      % param_array, layer_array, gap, 0, label_array ->
      dup length 1 eq { pop pop labelheight } { { stringwidth pop text_spacing add max } forall } ifelse  % find max label width
      % param_array, layer_array, gap, max_width ->
      2 copy face_spacing mul div dup font_scale lt { /font_scale exch store } { pop } ifelse  % if does not fit in the gap, then scale the text down
      exch pop 1 exch put  % store the max width in the gap slot
   } forall

   % draw the layers
   {
      aload pop
      /label exch store  /RGB exch store  /x exch store  /gap exch store  /y exch store
      0 1 label length 1 sub {
         /i exch store
         RGB i 5 mul 5 getinterval aload pop  gap font_scale mul  x i get y  BorderedBox
         x i get y moveto
         gsave
         font_scale font_scale scale
         label i get dup stringwidth pop -2 div $fontsize -0.3 mul rmoveto show
         grestore
      } for
   } forall
   end
} def
-----

###########################################################################
package Postscript::Page;

sub addGraph {
   my ($self, $Graph)=@_;
   $self->title ||= $Graph->Name;
   return if $Graph->Hidden;

   push @{$self->elements}, new Postscript::Graph($Graph);

   $self->procsets->{'Graph::common'}=$common_procs;
   $self->procsets->{'Graph::graph'}=$graph_procs;
   if ($Graph->Directed) {
      $self->procsets->{'Graph::directed'}=$dir_procs;
   } else {
      $self->procsets->{'Graph::undirected'}=$undir_procs;
   }
   $self->dict->{edge}="null";
}

sub addLattice {
   my ($self, $Lattice)=@_;
   $self->title ||= $Lattice->Name;
   return if $Lattice->Hidden;

   push @{$self->elements}, new Postscript::Lattice($Lattice);

   %{$self->procsets}=( 'Graph::common'=>$common_procs,  'Graph::lattice'=>$lattice_procs);
   if($Lattice->ArrowStyle) {
     $self->procsets->{'Graph::directed'}=$dir_procs;
   } else {
     $self->procsets->{'Graph::undirected'}=$undir_procs;
   }
   $self->dict->{edge}="null";
}

1

# Local Variables:
# c-basic-offset:3
# End: