view release on metacpan or  search on metacpan

lib/Gtk2/Ex/GraphViz.pm  view on Meta::CPAN

package Gtk2::Ex::GraphViz;

our $VERSION = '0.01';

use strict;
use warnings;
use Glib qw(TRUE FALSE);
use Data::Dumper;
use GraphViz;
use Gtk2;
use XML::Simple;
use Math::Geometry::Planar;
use GD;
use GD::Polyline;
use Carp;

sub new {
	my ($class, $graph) = @_;
	my $self  = {};
	bless ($self, $class);
	$self->_set_graph($graph);
	return $self;
}

sub get_widget {
	my ($self) = @_;
	my $vbox = Gtk2::VBox->new(FALSE, 0);
	$vbox->pack_start ($self->{eventbox}, FALSE, FALSE, 0);
	my $hbox = Gtk2::HBox->new(FALSE, 0);
	$hbox->pack_start ($vbox, FALSE, FALSE, 0);
	return $hbox;
}

sub signal_connect {
	my ($self, $signal, $callback) = @_;
	my $allowedsignals = [
		'mouse-enter-node',
		'mouse-exit-node',
		'mouse-enter-edge',
		'mouse-exit-edge',
	];
	my %hash = map { $_ => 1 } @$allowedsignals;
	unless ($hash{$signal}) {
		my $str = "Warning !! No such signal $signal. Allowed signals are\n";
		$str .= join "\n", @$allowedsignals;
		warn $str."\n";
	}		
	$self->{signals}->{$signal} = $callback;
}

sub _set_graph {
	my ($self, $graph) = @_;
	my $pngimage = GD::Image->newFromPngData($graph->as_png);
	my $svgdata = XMLin($graph->as_svg);
	my (@bounds) = split ' ', $svgdata->{viewBox};
	my $width  = $bounds[2] - $bounds[0];
	my $height = $bounds[3] - $bounds[3];
	$self->{pngimage} = $pngimage;
	$self->{svgdata} = $svgdata;
	$self->{node}->{polygons} = _extract_node_polygons($svgdata);
	$self->{node}->{ellipses} = _extract_node_ellipses($svgdata);
	$self->{edge}->{edges}    = _extract_edge_coords($svgdata);
	my $loader = Gtk2::Gdk::PixbufLoader->new;
	$loader->write ($pngimage->png);
	$loader->close;
	my $image = Gtk2::Image->new_from_pixbuf($loader->get_pixbuf);

	my $eventbox = Gtk2::EventBox->new;
	$eventbox->add($image);

	my ($ratiox, $ratioy);
	$eventbox->signal_connect('realize' => 
		sub {
			my @imageallocatedsize = $image->allocation->values;
			$ratiox = $imageallocatedsize[2]/$width;
			$ratioy = $imageallocatedsize[2]/$width;
			$self->{ratiox} = $ratiox;
			$self->{ratioy} = $ratioy;
		}
	);
	$eventbox->add_events ('pointer-motion-mask');
	$eventbox->signal_connect ('motion-notify-event' => 
		sub {
			my ($widget, $event) = @_;
			#my $r = $self->{eventbox}->allocation;
			#print $r->x."  ".$r->y."  ".$r->width."  ".$r->height." \n";
			my ($x, $y) = ($event->x, $event->y);
			$x = int($x/$ratiox);
			$y = int($y/$ratioy);
			return if $self->_check_inside_node($x, $y);
			return if $self->_check_on_edge($x, $y);
		}
	);
	$self->{eventbox} = $eventbox;
}


sub _inside_ellipse {
	my ($x0, $y0, $a, $b, $x, $y) = @_;
	return TRUE if
		($b*$b*($x-$x0)*($x-$x0) + $a*$a*($y-$y0)*($y-$y0) <= $a*$a*$b*$b);
	return FALSE;
}

sub _highlight_edge {
	my ($self, $line) = @_;
	my $polyline = new GD::Polyline;
	my ($ratiox, $ratioy) = ($self->{ratiox}, $self->{ratioy});
	foreach my $bit (@$line) {
		$polyline->addPt($bit->[0]*$ratiox, $bit->[1]*$ratioy);
	}
	my $im = $self->{pngimage}->clone;	
	$im->setThickness(3);