File Coverage

lib/Gtk2/Ex/MindMapView.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Gtk2::Ex::MindMapView;

our $VERSION = '0.000001';

use warnings;
use strict;
use Carp;

use Gnome2::Canvas;

use Gtk2::Ex::MindMapView::Graph;
use Gtk2::Ex::MindMapView::Connection;
use Gtk2::Ex::MindMapView::Layout::Balanced;

use POSIX qw(DBL_MAX);

use Glib ':constants';

use Glib::Object::Subclass
    Gnome2::Canvas::,
    properties => [
		   Glib::ParamSpec->string ('connection-arrows', 'arrows',
					    'Type of arrow to display.', 'none', G_PARAM_READWRITE),

		   Glib::ParamSpec->scalar ('connection-color-gdk','connection_color_gdk',
					    'The color of the connection.', G_PARAM_READWRITE),
	       ]
    ;


sub INIT_INSTANCE
{
    my $self = shift(@_);

    $self->{graph} = Gtk2::Ex::MindMapView::Graph->new();

    $self->{signals} = {}; # HoH

    $self->{connections} = {}; # HoA

    $self->{connection_color_gdk} = Gtk2::Gdk::Color->parse('darkblue');

    $self->{connection_arrows} = 'none';

    return $self;
}


sub SET_PROPERTY
{
    my ($self, $pspec, $newval) = @_;

    my $param_name = $pspec->get_name();

    if ($param_name eq 'connection_arrows')
    {
	if (!grep { $_ eq $newval } qw(none one-way two-way))
	{
	    croak "You may only set the connection arrows " .
	          "to: 'none', 'one-way', 'two-way'.\n"
	    }

	$self->{connection_arrows} = $newval;

	return;
    }

    if ($param_name eq 'connection_color_gdk')
    {
	if (!$newval->isa('Gtk2::Gdk::Color'))
	{
	    croak "You may only set the connection color to " .
		  "a Gtk2::Gdk::Color.\n";
	}

	$self->{connection_color_gdk} = $newval;

	return;
    }

    $self->{$param_name} = $newval;

    return;
}


# $view->add_item($item);
# $view->add_item($predecessor_item, $item);

sub add_item
{
    my ($self, $arg1, $arg2) = @_;

    my $predecessor_item = (defined $arg2) ? $arg1 : undef;

    my $item =             (defined $arg2) ? $arg2 : $arg1;

    if (!$item->isa('Gtk2::Ex::MindMapView::Item'))
    {
	croak "You may only add a Gtk2::Ex::MindMapView::Item.\n";
    }

    if ((defined $predecessor_item) &&
	(!$predecessor_item->isa('Gtk2::Ex::MindMapView::Item')))
    {
	croak "You may only add items that have a " .
	      "Gtk2::Ex::MindMapView::Item as predecessor.\n";
    }

    if (!defined $self->{signals}{$item})
    {
	$self->{signals}{$item} =
	    $item->signal_connect('layout'=>sub { $self->layout(); });
    }

    $item->set(graph=>$self->{graph});

    if (!defined $predecessor_item)
    {
	$self->{graph}->add($item);

	return;
    }

    $self->{graph}->add($predecessor_item, $item);

    _add_connection($self, $predecessor_item, $item);
}


# $view->clear();

sub clear
{
    my $self = shift(@_);

    return if (scalar $self->{graph}->num_items() == 0);

    my $root_item = $self->{graph}->get_root();

    my @successors = $self->{graph}->successors($root_item);

    foreach my $successor_item (@successors)
    {
	$self->{graph}->traverse_postorder_edge($root_item,
		 $successor_item, sub { $self->remove_item($_[0], $_[1]); });
    }

    $self->remove_item($root_item);
}


# $view->layout();

sub layout
{
    my $self = shift(@_);

    if (scalar $self->{graph}->num_items())
    {
	my $layout =
	    Gtk2::Ex::MindMapView::Layout::Balanced->new(graph=>$self->{graph});

	$layout->layout();
    }
}


# @predecessors = $view->predecessors($item);

sub predecessors
{
    my ($self, $item) = @_;

    if (!$item->isa('Gtk2::Ex::MindMapView::Item'))
    {
	croak "You may only get the predecessors of a " .
	      "Gtk2::Ex::MindMapView::Item.\n";
    }

    return $self->{graph}->predecessors($item);
}


# $view->remove_item($item);
# $view->remove_item($predecessor_item, $item);

sub remove_item
{
    my ($self, $arg1, $arg2) = @_;

    my $predecessor_item = (defined $arg2) ? $arg1 : undef;

    my $item =             (defined $arg2) ? $arg2 : $arg1;

    if (!$item->isa('Gtk2::Ex::MindMapView::Item'))
    {
	croak "You may only remove a Gtk2::Ex::MindMapView::Item.\n";
    }

    if ((defined $predecessor_item) &&
	(!$predecessor_item->isa('Gtk2::Ex::MindMapView::Item')))
    {
	croak "You may only remove items that have a " .
	      "Gtk2::Ex::MindMapView::Item as predecessor.\n";
    }

    if (scalar $self->{graph}->successors($item))
    {
	croak "You must remove the successors of this item prior " .
	      "to removing this item.\n";
    }

    if (defined $self->{signals}{$item})
    {
	$item->signal_handler_disconnect($self->{signals}{$item});

	delete $self->{signals}{$item};
    }

    if (!defined $predecessor_item)
    {
	$self->{graph}->remove($item);

	$item->destroy();

	return;
    }

    $self->{graph}->remove($predecessor_item, $item);

    if (exists $self->{connections}{$item})
    {
	_remove_connection($self, $predecessor_item, $item);

	if (scalar @{$self->{connections}{$item}} == 0)
	{
	    delete $self->{connections}{$item};
	}
    }

    $item->destroy();
}


# $view->set_root($item);

sub set_root
{
    my ($self, $item) = @_;

    if (!$item->isa('Gtk2::Ex::MindMapView::Item'))
    {
	croak "You may only set the root to a Gtk2::Ex::MindMapView::Item.\n";
    }

    if (!$self->{graph}->has_item($item))
    {
	croak "You may only set the root to a Gtk2::Ex::MindMapView::Item " .
	      "that's been added to the view.\n";
    }

    _clear_connections($self);

    $self->{graph}->set_root($item);

    my @successors = $self->{graph}->successors($item);

    foreach my $successor_item (@successors)
    {
	$self->{graph}->traverse_preorder_edge($item,
	       $successor_item, sub { _add_connection($self, $_[0], $_[1]); });
    }
}


# @successors = $view->successors($item);

sub successors
{
    my ($self, $item) = @_;

    if (!$item->isa('Gtk2::Ex::MindMapView::Item'))
    {
	croak "You may only get the successors of a " .
	      "Gtk2::Ex::MindMapView::Item.\n";
    }

    return $self->{graph}->successors($item);
}


sub _add_connection
{
    my ($self, $predecessor_item, $item) = @_;

    my $connection = Gnome2::Canvas::Item->new($self->root,
			      'Gtk2::Ex::MindMapView::Connection',
			      predecessor_item=>$predecessor_item,
			      item=>$item,
			      arrows=>$self->{connection_arrows},
			      width_pixels=>1,
			      outline_color_gdk=>$self->{connection_color_gdk},
			      fill_color=>'darkblue');

    push @{$self->{connections}{$item}}, $connection;
}


sub _clear_connections
{
    my $self = shift(@_);

    my $root_item = $self->{graph}->get_root();

    my @successors = $self->{graph}->successors($root_item);

    foreach my $successor_item (@successors)
    {
	$self->{graph}->traverse_preorder_edge($root_item,
	     $successor_item, sub { _remove_connection($self, $_[0], $_[1]); });
    }

    $self->{connections} = undef;
}


sub _remove_connection
{
    my ($self, $predecessor_item, $item) = @_;

    my $index = 0;

    my @connections = @{$self->{connections}{$item}};

    foreach my $connection (@connections)
    {
	if ($connection->get('predecessor_item') == $predecessor_item)
	{
	    $connection->disconnect();

	    $connection->destroy();

	    last;
	}

	$index++;
    }

    splice @{$self->{connections}{$item}}, $index, 1;
}


1; # Magic true value required at end of module
__END__