# 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: PostscriptGale.pm 7426 2006-09-06 22:36:22Z gawrilow $
no integer;
package Postscript::Gale;
use Math::Trig;
###########################################################################
# for both dimensions 1 and 2
my $common_procs = <<".";
% color x y ->
/Circle {
newpath
$point_radius 0 360 arc
dup 0 gt
% white
{
gsave 1 setgray fill grestore stroke
pop
} {
1 add 0.5 mul setgray % -1 => black, 0 => 50% grey
fill
0 setgray
} ifelse
} bind def
% [ colors ] x y ->
/Points {
gsave
translate
dup length 1 eq
{
0 get 0 0 Circle % lone circle
} {
dup length 360 exch div % angle between centers
exch { $point_radius 0 Circle dup rotate } forall
pop
} ifelse
grestore
} bind def
% string ->
/Label {
gsave
1 setgray 3.5 setlinewidth 1 setlinecap 1 setlinejoin
dup false charpath stroke
grestore show
} bind def
/min { 2 copy gt { exch } if pop } bind def
/max { 2 copy lt { exch } if pop } bind def
% x y string -> x' y'
/Loop {
3 dict begin
/label exch def /y exch def /x exch def
0 x y Circle
x $text_spacing sub y $point_radius add $text_spacing add moveto
label show
label stringwidth pop $point_radius 5 mul max x add y
end
} def
.
###########################################################################
# for dimension 1 only
my $dim1_procs = <<".";
% angle ->
/Arrow {
gsave
rotate
0 0 moveto
big_radius 0 lineto stroke
big_radius arrow_length sub arrow_radius sub 0 arrow_radius arrow_angle neg arrow_angle arc
big_radius 0 lineto
closepath fill
grestore
} def
% << x_out y_out x_in y_in >> label ->
/ArrowLabel {
exch begin
x_out x_in ge
{ % right side
dup stringwidth pop dup x_out add
% ... width x_right
big_radius le { x_out y_out moveto pop } { neg x_in add y_in moveto } ifelse
} { % left side
dup stringwidth pop neg x_out add
% ... x_left
dup big_radius ge { y_out moveto } { pop x_in y_in moveto } ifelse
} ifelse
show
end
} def
.
###########################################################################
sub loop_box_height() { 6*$point_radius + $fontsize + $text_spacing }
###########################################################################
use Struct (
[ new => '$' ],
[ '@ISA' => 'Postscript::Element' ],
[ '$locked' => '0' ],
[ '$Gale' => '#1' ],
'$big_radius',
);
sub new {
my $self=&_new;
my $G=$self->Gale;
my $dim=$G->dim;
$self->marginLeft=$self->marginRight=$self->marginBottom=2*$point_radius;
$self->marginTop=$self->marginBottom + $fontsize + $text_spacing;
$self->marginTop += loop_box_height + $Hmargin/2 if @{$G->loops};
if ($dim==1) {
$self->big_radius= min( $Wpaper-2*$Wmargin, $Hpaper-2*$Hmargin )/2;
$self->marginBottom += $Hmargin + 2*$self->big_radius;
}
foreach my $p (values %{$G->different_x_y}) {
my ($x, $y)=@{$G->points->[$p->[0]]};
assign_min_max($self->minX, $self->maxX, $x);
assign_min_max($self->minY, $self->maxY, $y) if $dim==2;
}
$self->minY=$self->maxY=0 if $dim==1;
return $self;
}
###########################################################################
sub labels {
my $G=shift;
$G->VertexLabels
? (map { $G->VertexLabels->($_) } @_)
: ()
}
sub draw {
my ($self, $page)=@_;
my $G=$self->Gale;
my $dim=$G->dim;
my @affine_coords;
my $code="";
if ($dim==2) {
# transform to visible coordinates
foreach my $p (values %{$G->different_x_y}) {
my $coord=$page->transform(@{$G->points->[$p->[0]]});
$affine_coords[$_]=$coord for @$p;
}
# connect the pairs of vertices of the same color with dashed lines
$code .= "gsave [1 4] 0 setdash 0.5 setgray\n";
foreach my $color ($G->whites, $G->blacks) {
my @bunches=keys %$color;
foreach my $i (0 .. $#bunches-1) {
my $start=$affine_coords[$G->different_x_y->{$bunches[$i]}->[0]];
foreach my $j ($i+1 .. $#bunches) {
my $end=$affine_coords[$G->different_x_y->{$bunches[$j]}->[0]];
$code .= "newpath $start moveto $end lineto stroke\n";
}
}
}
$code .= "grestore\n";
# for each facet find a triple of b/w points not belonging to it and connect them with a solid line
$code .= draw_poly_line(@affine_coords[@$_]) . "stroke\n" for @{$G->gale_lines};
} else { # dim==1
foreach my $p (values %{$G->different_angles}) {
my ($x)=@{$G->points->[$p->[0]]};
$x = $page->marginLeft + $page->scaleX * ($x - $page->minX);
$affine_coords[$_]="$x y1" for @$p;
}
# draw a big circle
$code .= <<".";
gsave
left_edge right_edge add 2 div big_radius $Hmargin add translate
newpath 0 0 big_radius 0 360 arc stroke
.
# draw the arrows and the labels
while (my ($angle, $p)=each %{$G->different_angles}) {
my ($sin, $cos) = (sin($angle), cos($angle));
# label box corner outside the big circle
my $x_out = ($self->big_radius + $text_spacing) * $cos;
my $y_out = ($self->big_radius + $text_spacing) * $sin;
# alternative label box corner inside the big circle (near the point of an arrow wing)
my $x_in_off = -$arrowheadlength/2;
my $y_in_off = $arrowheadwidth/2 + $text_spacing;
$y_in_off = -$y_in_off if $sin*$cos < 0;
my $x_in = ($self->big_radius + $x_in_off) * $cos - $y_in_off * $sin;
my $y_in = ($self->big_radius + $x_in_off) * $sin + $y_in_off * $cos;
if ($angle<0) {
$y_out -= $fontsize; $y_in -= $fontsize;
}
my $a=rad2deg($angle);
my $label = join(",", labels($G, @$p));
$code .= <<".";
$a Arrow
<< /x_out $x_out /y_out $y_out /x_in $x_in /y_in $y_in >> ($label) ArrowLabel
.
}
# draw a single horizontal line above
$code .= <<".";
grestore
left_edge y1 moveto right_edge y1 lineto stroke
.
}
# draw the points as bunches of black and/or white circles
foreach my $p (values %{$G->different_x_y}) {
my $coord=$affine_coords[$p->[0]];
$code .= "[ " . join(" ", @{$G->colors}[@$p]) . " ] $coord Points\n";
my $x_off = -$text_spacing;
my $y_off = $point_radius + $text_spacing;
$x_off -= $point_radius if $#$p>0;
$y_off += $point_radius if $#$p>1;
my $label = join(",", labels($G, @$p));
$code .= "$coord moveto $x_off $y_off rmoveto ($label) Label\n\n";
}
# draw the loop points in a separate box at the top of the page
if (@{$G->loops}) {
my $h_box = loop_box_height;
my $y_box = $page->canvas_height + $Hmargin/2;
my $x_loops = $page->marginLeft + 4*$point_radius;
my $y_loops = $y_box + 4*$point_radius;
$code .=
"$x_loops $y_loops\n" .
join("", map { "($_) Loop\n" } labels($G, @{$G->loops})) .
<<".";
pop $Wmargin sub $point_radius sub
$Wmargin exch $y_box exch $h_box rectstroke
.
}
$page->code .= $code;
if ($dim == 1) {
my $d=$arrowheadlength * $arrowheaddent;
$page->dict->{arrow_length}=$arrowheadlength * (1-$arrowheaddent);
$page->dict->{arrow_radius}=($arrowheadwidth**2 / (8 * $d)) + $d/2;
$page->dict->{arrow_angle}=rad2deg(atan($arrowheadwidth * $d / ($arrowheadwidth**2 /4 - $d**2)));
$page->dict->{big_radius}=$self->big_radius;
$page->dict->{left_edge}=$Wmargin;
$page->dict->{right_edge}=$Wpaper - $Wmargin;
$page->dict->{y1}=2*($Hmargin+$self->big_radius);
}
}
###########################################################################
package Postscript::Page;
sub addGale {
my ($self, $Gale)=@_;
$self->title ||= "Gale diagram of " . $Gale->Name;
push @{$self->elements}, new Postscript::Gale($Gale);
$self->procsets->{'Gale::common'}=$common_procs;
if ($Gale->dim == 1) {
$self->procsets->{'Gale::dim1'}=$dim1_procs;
}
}
1;
# Local Variables:
# c-basic-offset:3
# End:
syntax highlighted by Code2HTML, v. 0.9.1