#  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: VisualLattice.pm 7533 2006-12-20 23:55:58Z gawrilow $

package Visual::Lattice;

use Struct(
   [ '@ISA' => 'Visual::Graph' ],
   '$top_node',

   # 1, draw arrow,
   # -1, draw arrow in opposite direction
   [ '$ArrowStyle' => '$this->unify_edge_decor(#%)', merge => '$this->merge_edge_decor(#%)' ],

   [ '$Mode' => '"primal"' ],
);

sub prepare_vertex_labels {
   my ($P, $label_prop_name)=@_;
   my $vertex_labels=$P->lookup($label_prop_name);
   my @vertex_labels= defined($vertex_labels) ? split /\s+/, $vertex_labels : ();
   my $n=0;  foreach (@vertex_labels) { s/^_.*/\#$n/; ++$n; }
   return @vertex_labels;
}

# $matching -> HasseDiagram with boolean edge attributes, like MORSE_MATCHING
sub add_matching {
   my ($self, $matching, $decor)=@_;
   my @hd = @$matching;
   shift @hd; pop @hd;
   $hd[0] =~ s/^<//;

   my (%edge_color, %edge_style, %arrow_style);
   my $matched_color=$decor->{EdgeColor};
   my $matched_style=$decor->{EdgeStyle};

   my $n=0;
   foreach (@hd) {
      my ($face, $edges) = m/^\(\{ (.*?) \} \s+ \{ (.*?) \}\)$/x;
      my @edges = $edges =~ m/\( (\d+) \s+ ([01]) \)/gx;
      while (my ($to_node, $matched) = splice @edges, 0, 2) {
	 if ($matched) {
	    $edge_color{"$n $to_node"} = $matched_color if defined $matched_color;
	    $edge_style{"$n $to_node"} = $matched_style if defined $matched_style;
	    $arrow_style{"$n $to_node"} = -1;
	 } else {
	    $arrow_style{"$n $to_node"} = 1;
	 }
      }
      ++$n;
   }

   local_scalar($self->EdgeStyleSymmetric,-1);
   $self->merge( ArrowStyle => \%arrow_style );
   $self->EdgeStyleSymmetric=1;
   $self->merge( defined($matched_color) ? (EdgeColor => \%edge_color) : (),
		 defined($matched_style) ? (EdgeStyle => \%edge_style) : () );
}


sub add_faces {
   my ($self, $full_hd, $faces, $decor)=@_;
   my @hd=@$full_hd;
   splice @hd, 0, 2; splice @hd, -2;	# ignore top and bottom nodes, as well the dim vector and the closing bracket

   my (@node_color, @node_style);
   my $matched_color=$decor->{NodeColor};
   my $matched_style=$decor->{NodeStyle};

   my $select_faces_re=join("|", map { join("\\s+", /\d+/g) } @$faces);
   $select_faces_re=qr/^\(\{\s*(?:$select_faces_re)\s*\}/;

   my $n=1;
   foreach (@hd) {
      if (/$select_faces_re/) {
	 $node_color[$n]=$matched_color if defined $matched_color;
	 $node_style[$n]=$matched_style if defined $matched_style;
      }
      ++$n;
   }

   $self->merge( defined($matched_color) ? (NodeColor => \@node_color) : (),
		 defined($matched_style) ? (NodeStyle => \@node_style) : () );
}


sub add_subcomplex {
   my ($self, $full_hd, $subcomplex, $decor)=@_;
   my @hd=@$full_hd;
   splice @hd, 0, 2; splice @hd, -2;	# ignore top and bottom nodes, as well the dim vector and the closing bracket

   my (@node_color, @node_style);
   my $matched_node_color=$decor->{NodeColor};
   my $matched_node_style=$decor->{NodeStyle};
   my $matched_edge_color=$decor->{EdgeColor};
   my $matched_edge_style=$decor->{EdgeStyle};
   my $matched_color=defined($matched_node_color) ? $matched_node_color : defined($matched_edge_color) ? "" : undef;
   my $matched_style=defined($matched_node_style) ? $matched_node_style : defined($matched_edge_style) ? "" : undef;

   my $select_faces_re;
   if ($decor->{show_filter}) {
      $select_faces_re=join("|", map { join(".*?", map { "\\b$_\\b" } /\d+/g) } @$subcomplex);
      $select_faces_re=qr/^\(\{.*?(?:$select_faces_re)/;
   } else {
      $select_faces_re=join("|", map {
	 my @vert=/\d+/g;
	 my $last=pop @vert;
	 join("", map { "(?:$_(?:\\s+|\\}))?" } @vert) . "(?:$last\\})?"
      } @$subcomplex);
      $select_faces_re=qr/^\(\{\s*(?:$select_faces_re)\s*\{/;
   }

   my $n=1;
   foreach (@hd) {
      if (/$select_faces_re/) {
	 $node_color[$n]=$matched_color;
	 $node_style[$n]=$matched_style;
      }
      ++$n;
   }

   # edge is selected if it starts in a selected node (show_filter) or points to a selected node (!show_filter)
   my $i=$decor->{show_filter} ? 0 : 1;

   $self->merge( defined($matched_node_color) ? (NodeColor => \@node_color) : (),
		 defined($matched_node_style) ? (NodeStyle => \@node_style) : (),
		 defined($matched_edge_color) ? (EdgeColor => sub {
						    		 my $n=($_[0]->incident_nodes)[$i];
								 defined($node_color[$n]) ? $matched_edge_color : undef;
							      }
						) : (),
		 defined($matched_edge_style) ? (EdgeStyle => sub {
						    		 my $n=($_[0]->incident_nodes)[$i];
								 defined($node_style[$n]) ? $matched_edge_style : undef;
							      }
						) :() );
}

declare %decorations=%Visual::Graph::decorations;

1;

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