ports//math/polymake/work/polymake-2.3/modules/common/perllib/Povray.pm

#  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: Povray.pm 7476 2006-11-28 17:16:30Z gawrilow $

use strict;
use JavaView;

################################################################################
#
# A povray file
#
package Povray::File;

use Struct (
   [ '@ISA' => 'JavaView::File' ],
   '$min_extent',
   '$max_extent',
);

sub header
{
   my ($self) = @_;
   my $who=$ENV{USER};
   my $when=localtime();
   my $title=$self->title;
   if (!length($title)) {
      $title="unnamed";
   }
   my $text = "/*\n  This povray file was created using polymake.\n  It may be rendered using the following command:\n\n";
   $text .= "  >povray +Iinput.pov +Ooutput.tga $main::InstallTop/povray/polypov.ini\n*/\n";
   $text .= "#include \"$main::InstallTop/povray/polymake-scene2.pov\"\n\n";

   my $point = $self->min_extent;
   $point =~ s/ /,/g;
   $text .= "#declare MIN_EXTENT = <$point>;\n";
   $point = $self->max_extent;
   $point =~ s/ /,/g;
   $text .= "#declare MAX_EXTENT = <$point>;\n";
   $text .= "#declare ORIGIN     = MIN_EXTENT + (MAX_EXTENT-MIN_EXTENT)/2;\n";
   $text .= "#declare SCALE      = 1/vlength((MAX_EXTENT-MIN_EXTENT)/2);\n\n";
   return $text;
}

sub trailer { "" }

sub toString
{
   my ($self) = @_;
   my @min_extent = split(/\s+/, $self->geometries->[0]->{min_extent});
   my @max_extent = split(/\s+/, $self->geometries->[0]->{max_extent});
   foreach my $geometry (@{$self->geometries}) {
      my @act_min_extent = split(/\s+/, $geometry->{min_extent});
      for my $i (0..$#act_min_extent) {
	 assign_min($min_extent[$i], $act_min_extent[$i]);
      }
      my @act_max_extent = split(/\s+/, $geometry->{max_extent});
      for my $i (0..$#act_max_extent) {
	 assign_max($max_extent[$i], $act_max_extent[$i]);
      }
   }
   $self->min_extent = join(" ",@min_extent);
   $self->max_extent = join(" ",@max_extent);
   $self->SUPER::toString;
}

##############################################################################################
#
#  Basis class for all graphical objects handled by povray
#
package Povray::geometry;

sub new
{
   my $class = shift;
   my $self = { @_ };
   bless $self, $class;
   $self->initialize;
   return $self;
}

sub initialize
{
   my $self=shift;
   if (exists $self->{name}) {
      $self->{name}="geometry";
   }
   $self->{name} =~ s|[ .,;{}/-]|_|g;
   $self->{name} =~ s/\#/nr/g;
   $self->{name} =~ s/^(?=\d)/n_/;
   if (! exists $self->{points}) {
      croak( ref($self), "::initialize: parameter 'points' missing" );
   }
   if (!exists $self->{center}) {
      $self->{center} = "0 0 0";
   }

   if (! exists $self->{pointSet_dim}) {
      croak( ref($self), "::initialize: parameter 'pointSet_dim' missing" );
   }
   $self->{pointSet_point_flag} ||= "show";

   if (! exists $self->{points_thickness}) {
      $self->{points_thickness}=$Povray::points_thickness;
   }
   $self->{points_thickness} *= 0.015;

   $self->{pointSet_thicknesses_flag} ||= exists $self->{points_thicknesses_list} ? "show" : "hide";
}

sub header
{
   my ($self)=@_;
   my $attr=" name=\"$self->{name}\"";
   if (defined $self->{visibleFlag}) {
      $attr .= " visible=\"$self->{visibleFlag}\"";
   }
   return <<".";
.
}

sub trailer
{
   my ($self)=@_;
   return "" if($self->{visibleFlag} eq "hide");

   my @color = split(" ",$self->{points_color});
   map { $_ /= 255 } @color;
   my $points_color = "pigment { color rgb <".join(",",@color)."> }";   
   
   my $text ="";
   if(!($self->{pointSet_point_flag} eq "hide")) {
     $text .= <<".";
object {
  vertices_of_$self->{name}
  texture { T_Polytope_nodes $points_color}
  translate -ORIGIN
  scale SCALE
}
.
   }
   return $text . <<".";
//$self->{name} ---END
.
}


sub pointSet
{
  my ($self) = @_;
  my $text="";
  my $n_points = scalar(@{$self->{points}});
  my $name = $self->{name};
  $name =~ s/ /_/g;
  $text .= <<".";
#declare points_thickness_${name} = $self->{points_thickness}/SCALE;

#declare vertex_list_${name} = array[$n_points] {
.
  my $k=0;
  foreach (@{$self->{points}}) {
    my $point=$_; chomp $point;
    $text .= "<".(join(",",split(/\s+/,$point))).">";
    ++$k;
    $text .= ",\n" if($k != $n_points);
  }
  $text .= "}\n\n";
  if(!($self->{pointSet_point_flag} eq "hide")) {
    $text .= "#declare vertices_of_${name} = object { union {\n";
    foreach my $i (0..$n_points-1) {
      $text .= "  sphere { vertex_list_${name}[$i],";
      if (exists $self->{points_thicknesses_list}) {
	$text .= " ${$self->{points_thicknesses_list}}[$i]*0.015/SCALE";#$self->{scaling} ";
      } else {
	$text .= " points_thickness_${name} ";
      }
      if (exists $self->{points_colors_list}) {
	my @color = split(" ",${$self->{points_colors_list}}[$i]);
	map { $_ = $_/255 } @color;
	$text .= " texture { T_Polytope_nodes pigment { rgb <".join(",",@color)."> } }";
      }
      $text .= " }\n"
    }
    $text .= "}}\n\n";
  }
  return $text;
}

sub toString
{
   my ($self)=@_;
   return $self->header . $self->pointSet . $self->trailer;
}

##############################################################################################
#
#  Solid 2-d or 3-d body
#
package Povray::solid;
@ISA=qw( Povray::geometry );

sub initialize
{
   my $self=shift;
   $self->SUPER::initialize;
   if (! exists $self->{faces}) {
      croak( ref($self), "::initialize: parameter 'faces; missing\n" );
   }
   $self->{faceSet_face_flag} ||= "show";
   $self->{faceSet_backface_flag} ||= "hide";	# our objects are convex by default
   $self->{faceSet_edge_flag} ||= "show";

   if (! exists $self->{faces_color}) {
      $self->{faces_color}=$Visual::Color::facets;
   }
   if(! exists $self->{edges_thickness} ) {
     $self->{edges_thickness}=$Povray::lines_thickness;
   }
   $self->{lines_thickness} = $self->{edges_thickness}*0.015;

}

sub header
{
  my ($self) = @_;
   return <<".";
//$self->{name} --BEGIN
.
}
sub trailer
{
   my ($self)=@_;
   return "" if($self->{visibleFlag} eq "hide");

   my @color = split(" ",$self->{faces_color});
   map { $_ /= 255 } @color;
   my $faces_color = "pigment { color rgbf <".join(",",@color).",1> }";
   
   @color = split(" ",$self->{points_color});
   map { $_ /= 255 } @color;
   my $points_color = "pigment { color rgb <".join(",",@color)."> }";
   my $text = "";
   if(!($self->{pointSet_point_flag} eq "hide") ) {
     $text .= <<".";
object {
  vertices_of_$self->{name}
  texture { T_Polytope_nodes $points_color}
  translate -ORIGIN
  scale SCALE
}
.
   }
   if(!($self->{faceSet_edge_flag} eq "hide") ) {
     $text .= <<".";
object {
  edges_$self->{name}
  texture { T_Polytope_wires }
  translate -ORIGIN
  scale SCALE
}
.
   }
   if(!($self->{faceSet_face_flag} eq "hide") ) {
     $text .= <<".";
object {
  faces_$self->{name}
  texture { T_Polytope_solid $faces_color}
  translate -ORIGIN
  scale SCALE
}
.
   }
   $text .= <<".";
//$self->{name} ---END
.
   return $text;
}

sub faceSet
{
   my ($self) = @_;
   my $text="";
   my $name = $self->{name};
   $text .= "#declare lines_thickness_${name} = $self->{lines_thickness}/SCALE;\n";
   if(!($self->{faceSet_face_flag} eq "hide")) {
     $text .= <<".";
#declare faces_${name} = object { union {
.
     my $i = 0;
     foreach (@{$self->{faces}}) {
       s/^\s*\{?\s*(.*)\s*\}?\s*$/$1/;
       my @vertices = split(/\s+/,$_);
       my $polygon_size = scalar(@vertices)+1;
       $text .= "  polygon { $polygon_size";
       map { $text .= ", vertex_list_${name}[$_] "} @vertices;
       $text .= ", vertex_list_${name}[$vertices[0]]";
       if(exists $self->{faces_colors_list}) {
	 my @color = split(" ",${$self->{faces_colors_list}}[$i]);
	 map { $_ = $_/255 } @color;
	 $text .= " texture { Myglass pigment { rgb <".join(",",@color).", 1> } }";
       }
       $text .= " }\n";
       ++$i;
     }
     $text .= "}}\n\n";
   }
   # add cylinders for edges
   if(!($self->{faceSet_edge_flag} eq "hide")) {
     $text .= "#declare edges_${name} = object { union {\n";
     foreach (@{$self->{faces}}) {
       s/^\s*\{?\s*(.*)\s*\}?\s*$/$1/;
       my @vertices = split(/\s+/,$_);
       for(my $i=0; $i <= $#vertices-1; ++$i) {
	 $text .= "  capsule ( vertex_list_${name}[$vertices[$i]], vertex_list_${name}[".$vertices[$i+1]."], lines_thickness_${name} )\n";
       }
       $text .= "  capsule ( vertex_list_${name}[$vertices[0]], vertex_list_${name}[".$vertices[$#vertices]."], lines_thickness_${name} )\n";
     }
     $text .= "}}\n\n";
   }
   return $text;
}

sub toString
{
   my ($self) = @_;
   return $self->header . $self->pointSet . $self->faceSet . $self->trailer;
}

##############################################################################################
#
#  Wire model (e.g. a graph)
#
package Povray::wire;
@ISA=qw( Povray::geometry );

sub initialize
{
   my $self=shift;
   $self->SUPER::initialize;
   if (! exists $self->{lines}) {
      croak( ref($self), "::initialize: parameter 'lines' missing" );
   }
   $self->{lineSet_line_flag} ||= "show";
   $self->{lineSet_arrow_flag} ||= "hide";

   if (! exists $self->{lines_thickness}) {
     $self->{lines_thickness}=$Povray::lines_thickness;
   }
   $self->{lines_thickness} *= 0.015;

   $self->{lineSet_thicknesses_flag} ||= exists $self->{lines_thicknesses_list} ? "show" : "hide";

   if (! exists $self->{lines_color}) {
      $self->{lines_color}=$Visual::Color::edges;
   }
}

sub lineSet
{
   my ($self)=@_;
   my $name = $self->{name};
   $name =~ s/ /_/g;
   my $text="";
   $text .= "#declare lines_thickness_${name} = $self->{lines_thickness}/SCALE;\n";
   if(!($self->{lineSet_line_flag} eq "hide")) {
     $text .= "#declare lines_${name} = object { union {\n";
     my $i = 0;
     foreach (@{$self->{lines}}) {
       my ($from,$to) = split(/\s+/);
       if($self->{lineSet_arrow_flag} eq "hide") {
	 $text .= "  object { capsule (vertex_list_${name}[$from], vertex_list_${name}[$to], lines_thickness_${name} )";
	 if (exists $self->{lines_colors_list}) {
	   my @color = split(" ",${$self->{lines_colors_list}}[$i]);
	   map { $_ = $_/255 } @color;
	   $text .= " texture { T_Polytope_wires pigment { rgb <".join(",",@color)."> } }";
	 }
	 $text .= "}\n";
       } else { #draw arrows
	 $text .= "  arrow(vertex_list_${name}[$from], vertex_list_${name}[$to], lines_thickness_${name}, $headLength, $headWidth)\n";
       }
       ++$i;
     }
     $text .= "}}\n\n";
   }
   return $text;
}

sub trailer
{
   my ($self)=@_;
   return "" if($self->{visibleFlag} eq "hide");

   my @color = split(" ",$self->{lines_color});
   map { $_ /= 255 } @color;
   my $lines_color = "pigment { color rgb <".join(",",@color)."> }";   

   @color = split(" ",$self->{points_color});
   map { $_ /= 255 } @color;
   my $points_color = "pigment { color rgb <".join(",",@color)."> }";   

   my $text ="";
   if(!($self->{pointSet_point_flag} eq "hide")) {
     $text .= <<".";
object {
  vertices_of_$self->{name}
  texture { T_Polytope_nodes $points_color}
  translate -ORIGIN
  scale SCALE
}
.
   }
   if(!($self->{lineSet_line_flag} eq "hide")) {
     $text .= <<".";
object {
  lines_$self->{name}
  texture { T_Polytope_wires $lines_color}
  translate -ORIGIN
  scale SCALE
}
.
   }
   return $text . <<".";
//$self->{name} ---END
.
}

sub toString
{
   my ($self)=@_;
   return $self->header . $self->pointSet . $self->lineSet . $self->trailer;
}


1

# Local Variables:
# c-basic-offset:3
# End:
syntax highlighted by Code2HTML, v. 0.9.1