File Coverage

blib/lib/Gtk2/Ex/GraphViz.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

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);
	my $white = $im->colorAllocate(255,0,0);
	my $eventbox = $self->{eventbox};
	my @children = $eventbox->get_children;
	foreach my $child (@children) {
		$eventbox->remove($child);
	}
	my $spline  = $polyline->toSpline();
	$im->polydraw($spline, $white);
	my $loader = Gtk2::Gdk::PixbufLoader->new;
	$loader->write ($im->png);
	$loader->close;
	my $image = Gtk2::Image->new_from_pixbuf($loader->get_pixbuf);
	$eventbox->add($image);
	$eventbox->show_all;
	$self->{HIGHLIGHTED} = 1;
}

sub _co_linear {
	my ($p1, $p2, $a) = @_;
	my ($x1, $y1) = @$p1;
	my ($x2, $y2) = @$p2;
	my ($xa, $ya) = @$a;
	return FALSE if ($x1 >	$xa && $x2 >  $xa);
	return FALSE if ($x1 <	$xa && $x2 <  $xa);
	return FALSE if ($y1 >	$ya && $y2 >  $ya);
	return FALSE if ($y1 <	$ya && $y2 <  $ya);
	if (abs($x1-$x2) < 5) {
		return TRUE if abs($x1-$xa) < 5;
		return FALSE; #else
	}
	if (abs($y1-$y2) < 5) {
		return TRUE if abs($y1-$ya) < 5;
		return FALSE; #else
	}
	return FALSE if $y1 == $ya;

	return TRUE if (
		abs(($x1-$x2)/($y1-$y2) - ($x1-$xa)/($y1-$ya)) < 1
	);
	return FALSE;
}

sub _check_on_edge {
	my ($self, $x, $y) = @_;
	my $edges = $self->{edge}->{edges};
	my $edgename;
	foreach my $key (keys %$edges) {
		if (_check_on_polyline($edges->{$key}, [$x, $y])) {
			$edgename = $key;
			last;
		}
	}
	if ($edgename) {
		$self->_highlight_edge($edges->{$edgename});
		&{$self->{signals}->{'mouse-enter-edge'}}($self, $x, $y, $edgename)
			if $self->{signals}->{'mouse-enter-edge'};
		return TRUE;
	} else {
		if ($self->{HIGHLIGHTED}) {
			my $eventbox = $self->{eventbox};
			my @children = $eventbox->get_children;
			foreach my $child (@children) {
				$eventbox->remove($child);
			}
			my $loader = Gtk2::Gdk::PixbufLoader->new;
			$loader->write ($self->{pngimage}->png);
			$loader->close;
			my $image = Gtk2::Image->new_from_pixbuf($loader->get_pixbuf);
			$eventbox->add($image);
			$eventbox->show_all;
			&{$self->{signals}->{'mouse-exit-edge'}}($self, $x, $y)
				if $self->{signals}->{'mouse-exit-edge'};
		}
		$self->{HIGHLIGHTED} = 0;
		return FALSE;
	}
}

sub _check_on_polyline {
	my ($polyline, $p) = @_;
	foreach my $i (0..$#{@$polyline}-1) {
		return TRUE	if _co_linear($polyline->[$i], $polyline->[$i+1], $p);
	}
	return FALSE;
}

sub _check_inside_node {
	my ($self, $x, $y) = @_;
	my $nodename;
	my $nodeshape;
	my $polygons = $self->{node}->{polygons};
	foreach my $key (%$polygons) {
		if ($polygons->{$key} && $polygons->{$key}->isinside([$x,$y])) {
			$nodename = $key;
			$nodeshape = 'polygon';
			last;
		}
	}
	my $ellipses = $self->{node}->{ellipses};
	foreach my $key (keys %$ellipses) {
		if (_inside_ellipse(@{$ellipses->{$key}}, $x, $y)){
			$nodename = $key;
			$nodeshape = 'ellipse';
			last;
		}
	}

	if ($nodename) {
		$self->_highlight_polygon($polygons->{$nodename}->{points})
			if $nodeshape eq 'polygon';
		$self->_highlight_ellipse($ellipses->{$nodename})
			if $nodeshape eq 'ellipse';
		&{$self->{signals}->{'mouse-enter-node'}}($self, $x, $y, $nodename)
			if $self->{signals}->{'mouse-enter-node'};
		return TRUE;
	} else {
		if ($self->{HIGHLIGHTED}) {
			my $eventbox = $self->{eventbox};
			my @children = $eventbox->get_children;
			foreach my $child (@children) {
				$eventbox->remove($child);
			}
			my $loader = Gtk2::Gdk::PixbufLoader->new;
			$loader->write ($self->{pngimage}->png);
			$loader->close;
			my $image = Gtk2::Image->new_from_pixbuf($loader->get_pixbuf);
			$eventbox->add($image);
			$eventbox->show_all;
			&{$self->{signals}->{'mouse-exit-node'}}($self, $x, $y)
				if $self->{signals}->{'mouse-exit-node'};
		}
		$self->{HIGHLIGHTED} = 0;
		return FALSE;
	}
}

sub _highlight_ellipse {
	my ($self, $ellipse) = @_;
	my $eventbox = $self->{eventbox};
	my @children = $eventbox->get_children;
	foreach my $child (@children) {
		$eventbox->remove($child);
	}
	my $im = $self->{pngimage}->clone;
	$im->setThickness(3);
	my $white = $im->colorAllocate(255,0,0);
	my ($ratiox, $ratioy) = ($self->{ratiox}, $self->{ratioy});
	my ($cx, $cy, $w, $h) = @$ellipse;
		$cx = int($cx*$ratiox);
		$cy = int($cy*$ratioy);
		$w  = int( $w*$ratiox);
		$h  = int( $h*$ratioy);
	$im->ellipse($cx,$cy,2*$w,2*$h,$white);
	my $loader = Gtk2::Gdk::PixbufLoader->new;
	$loader->write ($im->png);
	$loader->close;
	my $image = Gtk2::Image->new_from_pixbuf($loader->get_pixbuf);
	$eventbox->add($image);
	$eventbox->show_all;
	$self->{HIGHLIGHTED} = 1;
}

sub _highlight_polygon {
	my ($self, $rect) = @_;
	my $eventbox = $self->{eventbox};
	my @children = $eventbox->get_children;
	foreach my $child (@children) {
		$eventbox->remove($child);
	}
	my $im = $self->{pngimage}->clone;
	$im->setThickness(3);
	my $polygon = GD::Polygon->new;
	my ($ratiox, $ratioy) = ($self->{ratiox}, $self->{ratioy});
	foreach my $point (@$rect) {
		my $x = int($point->[0]*$ratiox);
		my $y = int($point->[1]*$ratioy);
		$polygon->addPt($x, $y);
	}
	my $white = $im->colorAllocate(255,0,0);
	$im->openPolygon($polygon,$white);
	my $loader = Gtk2::Gdk::PixbufLoader->new;
	$loader->write ($im->png);
	$loader->close;
	my $image = Gtk2::Image->new_from_pixbuf($loader->get_pixbuf);
	$eventbox->add($image);
	$eventbox->show_all;
	$self->{HIGHLIGHTED} = 1;
}

sub _extract_node_polygons {
	my ($svgdata) = @_;
	my $shapes = $svgdata->{g}->{g};
	my $result;
	foreach my $key (keys %$shapes) {
		next unless $shapes->{$key}->{class} eq 'node';
		if ($shapes->{$key}->{polygon}) {
			my $str = $shapes->{$key}->{polygon}->{points};
			my @coords = split ' ', $str;
			my @thispoly;
			foreach my $coord (@coords) {
				my ($x, $y) = split ',', $coord;
				push @thispoly, [$x, $y];
			}
			my $polygon = Math::Geometry::Planar->new;
			$polygon->points(\@thispoly);
			$result->{$key} = $polygon;
		}
	}
	return $result;
}

sub _extract_node_ellipses {
	my ($svgdata) = @_;
	my $shapes = $svgdata->{g}->{g};
	my $result;
	foreach my $key (keys %$shapes) {
		next unless $shapes->{$key}->{class} eq 'node';
		if ($shapes->{$key}->{ellipse}) {
			my $ellipse = $shapes->{$key}->{ellipse};
			my @thisellipse;
			push @thisellipse, $ellipse->{cx};
			push @thisellipse, $ellipse->{cy};
			push @thisellipse, $ellipse->{rx};
			push @thisellipse, $ellipse->{ry};
			$result->{$key} = \@thisellipse;
		}
	}
	return $result;
}

sub _extract_edge_coords {
	my ($svgdata) = @_;
	my $shapes = $svgdata->{g}->{g};
	my $result;
	foreach my $key (keys %$shapes) {
		next unless $shapes->{$key}->{class} eq 'edge';
		my $str = $shapes->{$key}->{path}->{d};
		$str =~ s/M/ /;
		$str =~ s/C/ /;
		my @coords = split ' ', $str;
		my @thisline;
		foreach my $coord (@coords) {
			my ($x, $y) = split ',', $coord;
			push @thisline, [$x, $y];
		}
		$result->{$key} = \@thisline;
	}
	return $result;
}

1;

__END__