#  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: Visual.pm 7540 2006-12-21 21:04:18Z gawrilow $


package Modules::common;

sub prepare_visual_objects {
   my @args=@_;
   for (my $i=0; $i<=$#args; ++$i) {
      if (is_object($args[$i])) {
	 my $attached=$args[$i]->attached;
	 if (@{$attached}) {
	    splice @args, $i+1, 0, @$attached;
	    @$attached=();
	 }
	 if (instanceof Visual::Container($args[$i])) {
	    $args[$i]->propagate_defaults;
	    splice @args, $i, 1, @{$args[$i]->elements};
	    redo;
	 }
      }
   }
   @args;
}

# Viewer, VisualObject, ...  =>
sub visualize_with($@) {
   my $viewer_pkg=shift;
   my $viewer;
   foreach my $vis (@_) {
      my $title=defined($vis->Title) ? $vis->Title : $vis->Name;
      $viewer=$viewer_pkg->new_drawing($title);
      foreach my $obj (prepare_visual_objects($vis)) {
	 if (is_object($obj)) {
	    $viewer->draw($obj);
	 } elsif (@$obj) {
	    my $method=$viewer->can("draw", $obj->[0], undef)
	    or die "no matching method ", ref($viewer), "::draw(", ref($obj->[0]), ")\n";
	    foreach my $elem (@$obj) {
	       $method->($viewer,$elem);
	    }
	 }
      }
   }
   $viewer;
}

sub start_deferred_visualizer {
   my ($pkg, $title)=@_;
   my $viewer=($main::scope->deferred->{$pkg} ||= $pkg->new);
   $viewer->new_drawing($title);
}

#
#  the central dispatching function
#
sub visualize($) {
   my $first=shift;
   return $first if defined wantarray;

   my @args=prepare_visual_objects($first);

   my $title=defined($first->Title) ? $first->Title : $first->Name;
   my ($method, $obj);

   if (@args==1) {
      eval {
	 if (is_object($args[0])) {
	    # a single object to draw - can use the overloading directly
	    $method=Poly::Overload::Global::draw($args[0]);
	    $method->(start_deferred_visualizer(method_owner($method),$title), $args[0]);
	 } else {
	    return undef if !@{$args[0]};
	    # should be a homogeneous array of drawables - resolve only once
	    $method=Poly::Overload::Global::draw($args[0]->[0]);
	    my $vis=start_deferred_visualizer(method_owner($method),$title);
	    foreach $obj (@{$args[0]}) {
	       $method->($vis, $obj, undef);
	    }
	 }
      };
      if ($@) {
	 if ($@ =~ /no matching overloaded instance of Poly::Overload::Global::draw/) {
	    die "do not know how to visualize ", ref($args[0]) eq "ARRAY" ? ref($args[0]->[0]) : ref($args[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=$args[0];
      my @methods;
      if (defined (my $list=resolve Poly::Overload "Poly::Overload::Global::draw",
		                                   is_object($obj) ? $obj : $obj->[0], 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::Preference::Label::get_items($list) : ($list)) {
	    $method=&$sub;
	    @methods=($method);
	    my $vis=method_owner($method);
	    foreach $obj (@args[1..$#args]) {
	       if (my $method_next=$vis->can("draw", is_object($obj) ? $obj : $obj->[0], undef)) {
		  push @methods, $method_next;
	       } else {
		  @methods=();
		  next TRY;
	       }
	    }
	    last;
	 }
      }
      if (@methods) {
	 my $vis=start_deferred_visualizer(method_owner($methods[0]),$title);
	 foreach $obj (@args) {
	    $method=shift @methods;
	    foreach my $elem (is_object($obj) ? ($obj) : @$obj) {
	       $method->($vis, $elem, undef);
	    }
	 }
      } else {
	 croak( "do not know how to visualize (",
		join(", ", map { ref($_) eq "ARRAY" ? "ARRAY<".ref($_->[0]).">" : ref($_) || $_ } @args), ") together" );
      }
   }
}

############################################################################

#  the common part of explicit visualization functions
#  Visual::Object, { options }, "Package" =>

sub visualize_explicit {
   my ($opts, $Package)=splice @_, -2;
   my $to_file=$opts->{File};
   my $viewer;

   if (defined($to_file)) {
      my $file_package="$Package\::File::Writer";
      if ($to_file eq "AUTO") {
	 $viewer=Visual::FileWriter::Auto->new($file_package);
      } else {
	 if (@_>1 && ! $file_package->multiple) {
	    my $caller_sub=(caller(1))[3];
	    $caller_sub=~s/.*::([^:]+)$/$1/;
	    $caller_sub=~s/^__(\w+)__OV__.*/$1/;
	    die << ".";
The file format for $Package does not support multiple independent scenes.
If you really want to create several pictures, you should either specify
File => "AUTO", or call $caller_sub with each object (and different file names)
separately.

If you intended to put the objects together in one drawing instead,
bundle them with compose() like this:  $caller_sub(compose(VISUAL1, VISUAL2, ...))
.
	 }
	 if ($to_file !~ /^[-&|]/ && $to_file !~ /\.\w+$/) {
	    $to_file.=$file_package->suffix;
	 }
	 $viewer=$file_package->new($to_file);
      }
   } else {
      $viewer="$Package\::Viewer"->new;
   }

   visualize_with($viewer, @_)->proceed;
   () # empty return value
}


package Visual;

############################################################################
#  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 $transparency_re=qr{\btransparency \s+ ([.\d]+)}x;

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

sub hsv2rgb {
  my ($h, $s, $v) = @_;
  my ($i, $f, $p, $q, $t,$r,$g,$b);
  if ($s == 0) {
    $r = $b = $g = $v;
  } else {
    $h /= 60;
    $i = int $h;
    $f = $h - $i;
    $p = $v * (1 - $s);
    $q = $v * (1 - $s * $f);
    $t = $v * (1 - $s * (1 - $f));
  SWITCH: {
      if ($i == 0) {
	$r = $v;
	$g = $t;
	$b = $p;
	last SWITCH;
      }
      if ($i == 1) {
	$r = $q;
	$g = $v;
	$b = $p;
	last SWITCH;
      }
      if ($i == 2) {
	$r = $p;
	$g = $v;
	$b = $t;
	last SWITCH;
      }
      if ($i == 3) {
	$r = $p;
	$g = $q;
	$b = $v;
	last SWITCH;
      }
      if ($i == 4) {
	$r = $t;
	$g = $p;
	$b = $v;
	last SWITCH;
      }
      $r = $v;
      $g = $p;
      $b = $q;
    } 
  }
  return ($r, $g, $b);
}

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

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

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

sub unify_labels {
   my ($name, $labels)=@_;
   if (defined $labels) {
      if (is_code($labels)) {
	 $labels
      } elsif (is_array($labels)) {
	 sub { $labels->[shift] }
      } elsif ($labels eq "hidden") {
	 undef
      } else {
	 $labels=split_labels($labels);
	 sub { $labels->[shift] }
      }
   } 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 merge_decor : method {
   my ($self, $attr, $new_decor)=@_;
   my $base_decor=$self->$attr;
   $new_decor=unify_decor($attr, $new_decor);
   if (ref($new_decor)) {
      if (ref($base_decor)) {
	 $self->$attr = sub { $new_decor->($_[0]) || $base_decor->($_[0]) };
      } elsif ($base_decor) {
	 $self->$attr = sub { $new_decor->($_[0]) || $base_decor };
      } else {
	 $self->$attr = $new_decor;
      }
   } elsif (ref($base_decor)) {
      $self->$attr = sub { $base_decor->($_[0]) || $new_decor };
   } else {
      $self->$attr = $new_decor;
   }
}

sub clone {
   my $src=shift;
   my $self=bless [ @$src ], ref($src);
   while (my ($key, $value)=splice @_, 0, 2) {
      $self->$key=$value;
   }
   $self;
}
###############################################################################
#
#  Container for several visualization objects - to be derived from
#
package Visual::Container;

use Struct (
   [ new => '%@' ],
   [ '@ISA' => 'Visual::Object' ],
   [ '@elements' => '@' ],
   '%defaults',
);

sub propagate_defaults {
   my $self=shift;
   while (my ($name, $val)=each %{$self->defaults}) {
      my $applied;
      foreach my $c (@{$self->elements}) {
	 my $obj=is_object($c) ? $c : $c->[0];
	 if (my $access_method=UNIVERSAL::can($obj,$name)) {
	    my $filter=Struct::get_field_filter($access_method);
	    foreach my $vis ($c==$obj ? ($obj) : @$c) {
	       if (Struct::is_default($access_method->($vis))) {
		  if ($filter) {
		     $val=$filter->($name,$val);
		     undef $filter;
		  }
		  $access_method->($vis)=$val;
	       }
	    }
	    $applied=1;
	 } elsif (instanceof Container($obj)) {
	    foreach my $vis ($c==$obj ? ($obj) : @$c) {
	       $vis->defaults->{$name} ||= $val;
	    }
	 }
      }
      croak( "default attribute $name is not applicable to any element of the ", ref($self) ) unless $applied;
   }
}

###############################################################################
package Visual::Embedding;

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

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


sub push {
   my $self=shift;
   defuse_magic($self);
   push @$self, @_;
}

sub splice {
   my ($self, $at)=splice @_, 0, 2;
   defuse_magic($self);
   splice @$self, $at, 0, @_;
}

###########################################################################################
#
#  Direct writing to a file without starting a GUI
#

package Visual::FileWriter;

sub import {
   (undef, my %params)=@_;
   my $pkg=caller;
   my ($top_pkg)= $pkg =~ /^([^:]+)/;
   my $suffix=$params{suffix} or croak( "default file suffix not specified" );
   my $multiple=$params{multiple};
   my $symtab=get_pkg($pkg);
   define_function($symtab, "graphics", \&self);
   define_function($symtab, "proceed", \&proceed);
   define_function($symtab, "suffix", sub { $suffix });
   define_function($symtab, "multiple", sub { $multiple });
   no strict 'refs';
   @{"$pkg\::ISA"}=( "$top_pkg\::File", "$top_pkg\::Viewer" );
}

sub self : method { shift }

sub proceed : method { shift->print_it; }

###########################################################################################
#
#  Generator of file names
#

package Visual::FileWriter::Auto;

use Struct (
   [ new => '$' ],
   [ '$Package' => '#1' ],
   [ '$viewer' => 'undef' ],
);

sub new_drawing {
   my ($self, $title)=@_;
   if ($self->viewer) {
      # write previous file
      $self->viewer->proceed;
   }
   # eliminate dangerous characters in the file name
   (my $filename=$title) =~ s|[ /.]|_|g;
   $filename .= $self->Package->suffix;
   print STDERR "writing to file $filename\n" if $Switches::v;
   ($self->viewer=$self->Package->new($filename))->new_drawing($title);
}

1


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