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