#!/usr/bin/perl -w
=head1 NAME
create_and_autolayout - Create a 'Graph' object by clicking/dragging and let Graph::Layout::Aesthetic do the layout.
=cut
use strict;
use warnings;
use Tk;
require Tk::GraphItems::Circle;
require Tk::GraphItems::Connector;
use Graph 0.70 ;
use Graph::Layout::Aesthetic::Topology;
use Graph::Layout::Aesthetic;
package main;
my $mw = tkinit();
# our Graph has to be refvertexed to use
# Tk::GraphItems::Circle instances for the nodes
my $graph = Graph->new( refvertexed => 1 );
my $scrolled_can = $mw -> Scrolled('Canvas',
-width => 500,
-height => 500,
-scrollregion =>[0,0,500,500],
)->pack(-fill => 'both',
-expand => 1);
# for use with Tk::GraphItems we have to extract the
# 'real' canvas out of the Scrolled widget :
my $can = $scrolled_can->Subwidget('scrolled');
my $text =<<'TEXT'
Mouse bindings:
Shift-Button-1 create a new vertex here
Shift-Button3 delete this vertex
Button1-move drag this vertex
Control-Button1 select/unselect this vertex
Control-Button1 if another vertex is selected:
create an edge from the selected
vertex to this one or delete the
edge if it is present.
Control-D delete all vertices
TEXT
;
$can-> createText(20,20,
-font => ['Courier',10],
-text => $text,
-anchor => 'nw',
);
init_bindings($can);
my $repeat;
my $stop_button;
my ($temp,$centrip,$rep,$min_len)=(10,1,10000,0.01);
my $f1 = $mw->Frame()->pack;
my @frames= map {$f1->Frame()->pack(-side=>'left');} (0..2);
$frames[0]->Label(-text=>$_)->pack for ('temperature',
'centripetal',
'node_repulsion',
'min_edge_length');
$frames[1]->Entry(-textvariable=>$_)->pack for (\$temp,
\$centrip,
\$rep,
\$min_len);
{
my $aglo;
$frames[2]->Button(-text=>'start',
-width=>20,
-command=>sub{
$aglo = convert($graph);
set_aglo_coords($aglo,$graph);
if ($repeat){$repeat ->cancel}
$repeat = $mw->repeat(100,sub{iterate($aglo,$graph)})
}
)->pack;
$frames[2]->Button(-text=>'continue',
-width=>20,
-command=>sub{
set_aglo_coords($aglo,$graph);
if ($repeat){$repeat ->cancel}
$repeat = $mw->repeat(100,sub{iterate($aglo,$graph)})
}
)->pack;
$stop_button = $frames[2]->Button(-text => 'stop',
-width => 20,
-command => \&stop_cb,
)->pack;
}#end scope of $g, $aglo
MainLoop;
sub stop_cb{
if ($repeat){$repeat ->cancel;
undef $repeat;
}
my @bb = $scrolled_can->bbox('all');
$scrolled_can->configure(-scrollregion => \@bb);
}
sub iterate{
my ($aglo,$g) = @_;
$aglo->_gloss(0);
$aglo->coordinates_to_graph( $g,
pos_attribute => ["x_end", "y_end"]);
}
sub convert{
my $topo = Graph::Layout::Aesthetic::Topology->from_graph($_[0]);
my $aglo = Graph::Layout::Aesthetic->new($topo);
$aglo->add_force(node_repulsion => $rep);
$aglo->add_force(min_edge_length => $min_len);
$aglo->add_force("Centripetal", => $centrip);
$aglo->init_gloss($temp,0.0001,1000,0);
return $aglo;
}
sub set_aglo_coords{
my ($aglo,$graph) = @_;
for my $v($graph->vertices){
my $id = $graph->get_vertex_attribute($v,'layout_id');
$aglo->coordinates($id,$v->get_coords);
}
}
# create Tk::GraphItems bindings for the canvas instance
sub init_bindings{
my ($can) = @_;
# create a dummy node on our canvas to call bind_class with.
# A call of 'bind_class' on this 'Circle' instance installs
# a binding which will be valid for every 'Circle' item
# on the same canvas.
my $node = Tk::GraphItems::Circle->new(canvas => $can,
'x' => 0,
'y' => 0
);
# Deleting a node:
$node->bind_class("<Shift-Button-3>",
sub {
my $item = shift;
$graph->delete_vertex($item);
}
);
# Adding and removing edges:
my ($selected, $old_colour);
$node->bind_class("<Control-Button-1>",
sub { my $item = shift;
if ( !$selected ) {
$selected = $item;
$old_colour = $item->colour;
$item -> colour('red');
} elsif ( $selected == $item ) {
$item -> colour($old_colour);
$selected = undef;
} else {
toggle_edge( $selected,$item );
$selected -> colour($old_colour);
$selected = undef;
}
}
);
# A Tk-binding to create new nodes:
$can->Tk::bind("<Shift-Button-1>", sub {
my $e = $can->XEvent;
my ($wx, $wy)=($e->x, $e->y);
my $x = $can->canvasx($wx);
my $y = $can->canvasy($wy);
new_node( $can,$x,$y);
} );
my $mw = $can->MainWindow;
$mw->bind('<Control-d>',\&delete_all_vertices);
}# end init_bindings
sub new_node{
# Create a new Circle instance and use it as vertex in
# our Graph. The Circle will be destroyed when its vertex
# gets deleted.
my ( $can,$x,$y ) = @_;
# my $v = Tk::GraphItems::Circle->new(canvas => $can,
my $v = ColoredCircle->new(canvas => $can,
colour => 'green',
size => 20,
'x' => $x,
'y' => $y);
$graph->add_vertex($v);
$graph->set_vertex_attribute($v,$_,0)for qw/x_end y_end/;
# yes, I know! the following line is a dirty trick and it should
# *never* be done that way!
$v->set_coords(\$graph->[2][4]{$v}[2]{x_end},\$graph->[2][4]{$v}[2]{y_end});
$graph->set_vertex_attribute($v,'x_end',$x);
$graph->set_vertex_attribute($v,'y_end',$y);
return $v;
}
sub new_edge{
# Create a Connector with 'autodestroy' set to true so we don't
# need to 'detach' it to have it destroyed.
my ( $source,$target) = @_;
my $conn = Tk::GraphItems::Connector->new( source => $source,
target => $target,
autodestroy => 1,
);
# create a new edge in the Graph and store our new Connector in
# the edges attribute data. That way the Connector will be destroyed
# when its edge gets deleted.
$graph->add_edge( $source , $target);
$graph->set_edge_attribute($source, $target, 'Connector', $conn);
}
sub toggle_edge{
my ( $source,$target ) = @_;
if ($graph->has_edge( $source, $target )){
$graph->delete_edge( $source, $target );
}else{
new_edge( $source, $target );
}
}
sub delete_all_vertices{
$stop_button->Invoke;
$graph->delete_vertices($graph->vertices);
}