/usr/local/CPAN/NetworkInfo-Discovery/NetworkInfo/Discovery/Tk.pm

• package NetworkInfo::Discovery::Tk
  • new
  • show_verts
  • circular_map
  • random_map
  • circular_map_verts
  • random_map_verts
  • map_edges
  • make_tk_edge
  • make_tk_node
  • AUTOLOAD
• EOF

package NetworkInfo::Discovery::Tk;

use Tk;
use Tk::Canvas;
use NetworkInfo::Discovery::Register;
use base "NetworkInfo::Discovery::Register";

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 $proto = shift;
    my %args = @_;

    my $class = ref($proto) || $proto;

    my $self  = {
    };

    bless ($self, $class);

    $self->{'canvas'} = $args{canvas} if (exists $args{canvas});
    $self->{'file'} = $args{file} if (exists $args{file});
    $self->{'autosave'} = $args{autosave} if (exists $args{autosave});

    if ($self->file && -r $self->file) {
	$self = $self->read_register( );
	bless ($self, $class);
    }


    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,
#	    );
#    }

    for (my $i = 0 ; $i < @{$self->{interfaces}} ; $i++) {
	$self->make_tk_node($i);

	my $id = $self->{interfaces}->[$i]->{"id"};
	my $nx = $self->{interfaces}->[$i]->{"x"};
	my $ny = $self->{interfaces}->[$i]->{"y"};
	my $size=$self->{interfaces}->[$i]->{"size"};

	$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->dump_us();
#    $self->map_edges;
}
sub random_map {
    my $self = shift;
    $self->random_map_verts;
#    $self->map_edges;
}

sub circular_map_verts {
    my $self = shift;

    my $gamma= 2* 3.14159 / (@{$self->{interfaces}});
    my $rayon = 100; 

    for (my $i = 0 ; $i < @{$self->{interfaces}} ; $i++) {
	$self->make_tk_node($i);
	
	my $x = $rayon *cos($gamma * $i) + $rayon*2;
	my $y = $rayon *sin($gamma * $i) + $rayon*2;

	$self->{interfaces}->[$i]->{"x"} = $x;
	$self->{interfaces}->[$i]->{"y"} = $y;
    }
}

sub random_map_verts {
    my $self = shift;

    my $x;
    my $y;

    my $height = $self->canvas->cget(-height) ;
    my $width = $self->canvas->cget(-width) ;
    for (my $i = 0 ; $i < @{$self->{interfaces}} ; $i++) {
	$self->make_tk_node($i);

	my $minx = $self->{interfaces}->[$i]->{"size"} / 2;
	my $miny = $self->{interfaces}->[$i]->{"size"} / 2;
	my $maxx = $width -$minx;
	my $maxy = $height -$miny;

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

	$self->{interfaces}->[$i]->{"x"} = $x;
	$self->{interfaces}->[$i]->{"y"} = $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 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 $index = shift;

    return 1 if (exists $self->{interfaces}->[$index]->{id});

    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->{interfaces}->[$index]->{"id"} =$id;
    $self->{interfaces}->[$index]->{"balloonid"} = $b;
    $self->{interfaces}->[$index]->{"x"} = $x;
    $self->{interfaces}->[$index]->{"y"} = $y;
    $self->{interfaces}->[$index]->{"size"} = $size;
    $self->{interfaces}->[$index]->{"center"} = $center;
    $self->{interfaces}->[$index]->{"color"} =$color;
}


 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->{lc $attr} = shift if @_;
     return $self->{lc $attr};
}
1;