The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package TkGraph;

use Tk;
use Tk::Canvas;
use base "Graph::Undirected";
use Graph::Reader::XML;
use strict;
use warnings;

use vars qw($AUTOLOAD %ok_field);

# Authorized attribute fields
for my $attr ( qw(id canvas balloon  color size center velocityx velocityy x y dx dy) ) { $ok_field{$attr}++; } 

sub new {
    my $class = shift;
    my %args = @_;

    my $self = { };
    if (exists $args{'file'}) {
	$self = &read_graph($args{'file'}) ;
    }
    bless $self, $class;


    $self->canvas($args{canvas});

    return $self;
}


sub show_verts {
    my $self = shift;

    my @e = $self->edges;
    while (@e) {
	my ($u, $v) =  (shift @e, shift @e);

	my $id = $self->get_attribute("id", $u, $v);

	my $x1 = $self->get_attribute("x", $u);
	my $y1 = $self->get_attribute("y", $u);

	my $x2 = $self->get_attribute("x", $v);
	my $y2 = $self->get_attribute("y", $v);

	$self->canvas->coords($id,
	    $x1, $y1, 
	    $x2, $y2,
	    );
    }

    foreach my $v ($self->toposort) {
	$self->make_tk_node($v);
	my $id = $self->get_attribute("id", $v);
	my $nx = $self->get_attribute("x", $v);
	my $ny = $self->get_attribute("y", $v);
	my $size = $self->get_attribute("size", $v);

	$self->canvas->coords($id,
	    $nx-($size/2), $ny-($size/2),
	    $nx+($size/2), $ny+($size/2),
	    );
    }


}

sub circular_map {
    my $self = shift;
    $self->circular_map_verts;
    $self->map_edges;
}
sub random_map {
    my $self = shift;
    $self->random_map_verts;
    $self->map_edges;
}

sub circular_map_verts {
    my $self = shift;

    my @nodes = $self->vertices;
    my $gamma= 2* 3.14159 / ($#nodes+1);
    my $rayon = 100; 

    my $x;
    my $y;
    my $i=0;
    foreach my $v (@nodes) {
	$self->make_tk_node($v);
	
	$x = $rayon *cos($gamma * $i) + $rayon*2;
	$y = $rayon *sin($gamma * $i) + $rayon*2;

	$self->set_attribute("x", $v, $x);
	$self->set_attribute("y", $v, $y);
	$i++;
    }
}

sub random_map_verts {
    my $self = shift;

    my @nodes = $self->vertices;

    my $x;
    my $y;

    my $height = $self->canvas->cget(-height) ;
    my $width = $self->canvas->cget(-width) ;
    foreach my $v (@nodes) {
	$self->make_tk_node($v);

	my $minx = $self->get_attribute("size", $v) / 2;
	my $miny = $self->get_attribute("size", $v) / 2;
	my $maxx = $width -$minx;
	my $maxy = $height -$miny;

	$x = rand ($maxx-$minx) + $minx;
	$y = rand ($maxy-$miny) + $miny;

	$self->set_attribute("x", $v, $x);
	$self->set_attribute("y", $v, $y);
    }
    
    
}
sub map_edges {
    my $self = shift;

    #print " " . join("," , caller()) . "\n";
    my @e = $self->edges;
    while (@e) {
	my ($u, $v) =  (shift @e, shift @e);
	$self->make_tk_edge($u, $v);

	my $x1 = $self->get_attribute("x", $u);
	my $x2 = $self->get_attribute("x", $v);
	my $y1 = $self->get_attribute("y", $u);
	my $y2 = $self->get_attribute("y", $v);

	$self->set_attribute("x1", $u, $v, $x1);
	$self->set_attribute("x2", $u, $v, $x2);
	$self->set_attribute("y1", $u, $v, $y1);
	$self->set_attribute("y2", $u, $v, $y2);

    }

}

sub map_verts {
    my $self = shift;

    my $store_x = 30;
    my $store_y = 30;

    foreach my $v ($self->vertices) {
	if ($self->has_attribute("id", $v) ) {
	    # we have already displyd this once... use the id...
	    my $id = $self->get_attribute("id", $v);
	    my $nx = $self->get_attribute("x", $v);
	    my $ny = $self->get_attribute("y", $v);
	    my $size = $self->get_attribute("size", $v);
	
	    my @neighbors = $self->neighbors($v);

	    if (@neighbors) {
		my $degrees_per_neighbor = 360/($#neighbors+1);
    
		foreach (@neighbors) {
		    my $dx = 2 * $size * cos($degrees_per_neighbor);
		    my $dy = 2 * $size * sin($degrees_per_neighbor);
		    $degrees_per_neighbor += $degrees_per_neighbor;
		    $self->set_attribute("x", $_, $nx + $dx);
		    $self->set_attribute("y", $_, $ny + $dy);
		}
	    } else {
		$self->set_attribute("x", $v, $store_x);
		$self->set_attribute("y", $v, $store_y);

		$store_x += (2*$size);
	    }

	} else {
	    # make an oval, set some attrs
	    $self->make_tk_node($v);
	}
    }
}


sub make_tk_edge {
    my $self = shift;
    my $u = shift;
    my $v = shift;

    return 1 if ($self->has_attribute("id", $u, $v));

    my $x1 = 50;
    my $y1 = 40;
    my $x2 = 250;
    my $y2 = 240;
    my $color = "white";

    my $id = $self->canvas->createLine(
	$x1, $y1,
	$x2, $y2,
	-fill => $color,
    );

    $self->set_attribute("id",	   $u, $v, $id);
    $self->set_attribute("color",  $u, $v, $color);
}

sub make_tk_node {
    my $self = shift;
    my $v = shift;

    return 1 if ($self->has_attribute("id", $v));

    my $x = 250;
    my $y = 40;
    my $size = 20;
    my $center = $size/2;
    my $color = "green";

    my $id = $self->canvas->createOval(
	$x - $center, $y - $center,
	$x + $center, $y + $center,
	-fill => $color,
    );


    $self->set_attribute("id",	   $v, $id);
    $self->set_attribute("balloonid",$v, $b);
    $self->set_attribute("x",	   $v, $x);
    $self->set_attribute("y",	   $v, $y);
    $self->set_attribute("size",   $v, $size);
    $self->set_attribute("center", $v, $center);
    $self->set_attribute("color",  $v, $color);
}


sub read_graph {
    my $file = shift;
    
    my $reader = Graph::Reader::XML->new();
    my $graph = $reader->read_graph( $file );

    return $graph;
}

 sub AUTOLOAD {
     my $self = shift;
     my $attr = $AUTOLOAD;
     $attr =~ s/.*:://;
     return unless $attr =~ /[^A-Z]/;  # skip DESTROY and all-cap methods
     warn "invalid attribute method: ->$attr()" unless $ok_field{$attr};
     $self->{uc $attr} = shift if @_;
     return $self->{uc $attr};
}
1;