#  Copyright (c) 1997-2004
#  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: Visual.pm,v 1.14 2004/11/10 10:55:32 gawrilow Exp $

package Visual;

###############################################################################
sub plain_attached {
   my $attached;
   for (my $i=0; $i<=$#_; ++$i) {
      if (is_object($_[$i]) && @{$attached=$_[$i]->attached}) {
	 splice @_, $i+1, 0, @$attached;
	 $i+=@$attached;
	 @$attached=();
      }
   }
}
###############################################################################
#
#  the central dispatching function
#
sub show {
   my $title=shift;
   &plain_attached;
   $title ||= $_[0]->Name;

   my ($method, $obj);

   if (@_==1) {
      eval {
	 if (ref($_[0]) eq "ARRAY") {
	    return undef if !@{$_[0]};
	    # should be a homogeneous array of drawables - resolve only once
	    $method=Poly::Overload::Global::draw($_[0]->[0]);
	    my $vis=method_owner($method)->new_drawing($title);
	    foreach $obj (@{$_[0]}) {
	       &$method($vis, $obj, undef);
	    }

	 } else {
	    # a single object to draw - can use the overloading directly
	    $method=Poly::Overload::Global::draw(@_);
	    &$method(method_owner($method)->new_drawing($title), @_);
	 }
      };
      if ($@) {
	 if ($@ =~ /no matching overloaded instance of Poly::Overload::Global::draw/) {
	    die "do not know how to visualize ", ref($_[0]) eq "ARRAY" ? ref($_[0]->[0]) : ref($_[0]),
		"\nprobably you should install some missing visualization packages\n";
	 }
	 if ($@ =~ /Undefined subroutine &Poly::Overload::Global::draw/) {
	    die "cannot visualize anything: no visualization packages installed\n";
	 }
	 die $@;
      }

   } else {
      # several drawable objects:
      # first obtain all viable visualizers, even if not preferred
      $obj=$_[0];
      my @methods;
      if (defined (my $list=resolve Poly::Overload "Poly::Overload::Global::draw",
		                                   ref($obj) eq "ARRAY" ? $obj->[0] : $obj, undef)) {
	 # must try all visualizers in the preference order until find such a one
	 # that can cope with all drawable objects
       TRY:
	 foreach my $sub (is_ARRAY($list) ? Poly::Label::get_items($list) : ($list)) {
	    $method=&$sub;
	    @methods=($method);
	    my $vis=method_owner($method);
	    foreach $obj (@_[1..$#_]) {
	       if (my $method_next=$vis->can("draw", ref($obj) eq "ARRAY" ? $obj->[0] : $obj, undef)) {
		  push @methods, $method_next;
	       } else {
		  @methods=();
		  next TRY;
	       }
	    }
	    last;
	 }
      }
      if (@methods) {
	 my $vis=method_owner($methods[0])->new_drawing($title);
	 foreach my $method (@methods) {
	    if (ref($_[0]) eq "ARRAY") {
	       foreach $obj (@{ +shift }) {
		  &$method($vis, $obj, undef);
	       }
	    } else {
	       &$method($vis, shift, undef);
	    }
	 }
      } else {
	 local $Carp::CarpLevel=$Carp::CarpLevel+1;
	 croak( "do not know how to visualize (",
		join(", ", map { ref($_) eq "ARRAY" ? "ARRAY<".ref($_->[0]).">" : ref($_) || $_ } @_), ") together" );
      }
   }
}

############################################################################
#  useful regex for parsing the styles

# $1=!fill $2=NAME $3="R G B" $4=R $5=G $6=B
my $color_re=qr{(?: \b(?: solid | (border) )\s+)? (?: \b([a-zA-Z]\w+) | ((\d+) \s+ (\d+) \s+ (\d+)) )}x;

my %RGBtxt;

sub loadRGBtxt {
   die "color list rgb.txt not found, can't use symbolic color names\n"
      unless $Visual::Color::RGBtxt_path;
   open my $RGB, $Visual::Color::RGBtxt_path
      or die "can't parse color list $Visual::Color::RGBtxt_path: $!\n";
   local $/="\n";
   local ($_, $1, $2);
   while (<$RGB>) {
      next if /^\s* (?: ! | $ )/x;
      if (/^ \s* (\d+) \s+ (\d+) \s+ (\d+) \s+ ([a-zA-Z]\w+ (?:\s+ [a-zA-Z]\w+)*) \s* $/x) {
	 $RGBtxt{$4}=[ "$1 $2 $3", $1, $2, $3 ];
      }
   }
}

# => (!fill, "R G B", R, G, B)
sub parse_color {
   my $color=shift;
   if ($color =~ $color_re) {
      if ($2) {
	 loadRGBtxt unless keys %RGBtxt;
	 my $list=$RGBtxt{$2};
	 $list ? ($1, @$list) : ();
      } else {
	 ($1, $3, $4, $5, $6)
      }
   } else {
      ()
   }
}

# $1=linewidth
declare $thickness_re=qr{\bthickness \s+ ([.\d]+)}x;

declare $hidden_re=qr{\bhidden\b};

###############################################################################
#
#  Basic visual object
#
package Visual::Object;

use Struct (
   [ new => '%' ],
   '$Name',
   [ '@attached' => '##' ],
);

sub check_points {
   my ($name, $pts)=@_;
   if (is_object($pts) && $pts->isa("Visual::Embedding")
       || is_array($pts)) {
      $pts;
   } else {
      local $Carp::CarpLevel=$Carp::CarpLevel+1;
      croak( "$name neither an array nor a Visual::Embedding" );
   }
}

sub unify_labels {
   my ($name, $labels)=@_;
   if (defined $labels) {
      if (is_code($labels) || is_array($labels) || $labels eq "hidden") {
	 $labels
      } else {
	 split_labels($labels)
      }
   } else {
      sub { shift }
   }
}

sub unify_decor {
   my ($name, $decor)=@_;
   is_code($decor)
   ?  $decor :
   is_array($decor)
   ?  sub { $decor->[$_[0]] } :
   is_hash($decor)
   ?  sub { $decor->{$_[0]} }
   :  $decor
}

sub clone {
   my $src=shift;
   my $self=bless [ @$src ], ref($src);
   while (my ($key, $value)=splice @_, 0, 2) {
      $self->$key=$value;
   }
   $self;
}

###############################################################################
#
#  helper classes implementing lazy execution of various visualization related tasks
#
package Visual::Embedding;

sub new {
   my $class=shift;
   bless [ @_ ], $class;
}

sub unbless { $_[0] }

use overload 'bool' => sub { 1 },
             '==' => \&refcmp,
             '!=' => sub { !&refcmp };

package Visual::LazyEmbedding;

sub push {
   my $class=ref($_[0]);
   $_[0]->unbless;
   push @{$_[0]}, @_[1..$#_];
   bless $_[0], $class;
}

use overload '@{}' => "compute";

1

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