package CanvasArrowhead;
use strict;
use Glib qw(TRUE FALSE);
use Gnome2::Canvas;

use constant LEFT            => 50.0;
use constant RIGHT           => 350.0;
use constant MIDDLE          => 150.0;
use constant DEFAULT_WIDTH   => 2;
use constant DEFAULT_SHAPE_A => 8;
use constant DEFAULT_SHAPE_B => 10;
use constant DEFAULT_SHAPE_C => 3;


sub set_dimension {
	my ($canvas, $arrow_name, $text_name,
	    $x1, $y1, $x2, $y2, $tx, $ty, $dim) = @_;

	$canvas->{$arrow_name}->set (points => [$x1, $y1, $x2, $y2]);

	$canvas->{$text_name}->set (text => $dim,
	                            x => $tx,
	                            y => $ty);

}

sub move_drag_box {
	my ($item, $x, $y) = @_;

	$item->set (x1 => $x - 5.0,
		    y1 => $y - 5.0,
		    x2 => $x + 5.0,
		    y2 => $y + 5.0);
}

sub set_arrow_shape {
	my $canvas = shift;

	my $width   = $canvas->{width};
	my $shape_a = $canvas->{shape_a};
	my $shape_b = $canvas->{shape_b};
	my $shape_c = $canvas->{shape_c};

	# Big arrow

	$canvas->{big_arrow}->set (width_pixels => 10 * $width,
	                           arrow_shape_a => $shape_a * 10,
	                           arrow_shape_b => $shape_b * 10,
	                           arrow_shape_c => $shape_c * 10);

	# Outline

	my @coords = ();
	$coords[0] = RIGHT - 10 * $shape_a;
	$coords[1] = MIDDLE;
	$coords[2] = RIGHT - 10 * $shape_b;
	$coords[3] = MIDDLE - 10 * ($shape_c + $width / 2.0);
	$coords[4] = RIGHT;
	$coords[5] = MIDDLE;
	$coords[6] = $coords[2];
	$coords[7] = MIDDLE + 10 * ($shape_c + $width / 2.0);
	$coords[8] = $coords[0];
	$coords[9] = $coords[1];
	$canvas->{outline}->set (points => \@coords);

	# Drag boxes

	move_drag_box ($canvas->{width_drag_box},
		       LEFT,
		       MIDDLE - 10 * $width / 2.0);

	move_drag_box ($canvas->{shape_a_drag_box},
		       RIGHT - 10 * $shape_a,
		       MIDDLE);

	move_drag_box ($canvas->{shape_b_c_drag_box},
		       RIGHT - 10 * $shape_b,
		       MIDDLE - 10 * ($shape_c + $width / 2.0));

	# Dimensions

	set_dimension ($canvas, "width_arrow", "width_text",
		       LEFT - 10,
		       MIDDLE - 10 * $width / 2.0,
		       LEFT - 10,
		       MIDDLE + 10 * $width / 2.0,
		       LEFT - 15,
		       MIDDLE,
		       $width);

	set_dimension ($canvas, "shape_a_arrow", "shape_a_text",
		       RIGHT - 10 * $shape_a,
		       MIDDLE + 10 * ($width / 2.0 + $shape_c) + 10,
		       RIGHT,
		       MIDDLE + 10 * ($width / 2.0 + $shape_c) + 10,
		       RIGHT - 10 * $shape_a / 2.0,
		       MIDDLE + 10 * ($width / 2.0 + $shape_c) + 15,
		       $shape_a);

	set_dimension ($canvas, "shape_b_arrow", "shape_b_text",
		       RIGHT - 10 * $shape_b,
		       MIDDLE + 10 * ($width / 2.0 + $shape_c) + 35,
		       RIGHT,
		       MIDDLE + 10 * ($width / 2.0 + $shape_c) + 35,
		       RIGHT - 10 * $shape_b / 2.0,
		       MIDDLE + 10 * ($width / 2.0 + $shape_c) + 40,
		       $shape_b);

	set_dimension ($canvas, "shape_c_arrow", "shape_c_text",
		       RIGHT + 10,
		       MIDDLE - 10 * $width / 2.0,
		       RIGHT + 10,
		       MIDDLE - 10 * ($width / 2.0 + $shape_c),
		       RIGHT + 15,
		       MIDDLE - 10 * ($width / 2.0 + $shape_c / 2.0),
		       $shape_c);

	# Info

	$canvas->{width_info}->set (text => "width: $width");
	$canvas->{shape_a_info}->set (text => "arrow_shape_a: $shape_a");
	$canvas->{shape_b_info}->set (text => "arrow_shape_b: $shape_b");
	$canvas->{shape_c_info}->set (text => "arrow_shape_c: $shape_c");

	# Sample arrows

	$canvas->{sample_1}->set (width_pixels => $width,
	                          arrow_shape_a => $shape_a,
	                          arrow_shape_b => $shape_b,
	                          arrow_shape_c => $shape_c);
	$canvas->{sample_2}->set (width_pixels => $width,
	                          arrow_shape_a => $shape_a,
	                          arrow_shape_b => $shape_b,
	                          arrow_shape_c => $shape_c);
	$canvas->{sample_3}->set (width_pixels => $width,
	                          arrow_shape_a => $shape_a,
	                          arrow_shape_b => $shape_b,
	                          arrow_shape_c => $shape_c);
}

sub highlight_box {
	my ($item, $event) = @_;

	if ($event->type eq 'enter-notify') {
		$item->set (fill_color => 'red');

	} elsif ($event->type eq 'leave-notify') {
		$item->set (fill_color => undef)
			unless $event->state & 'button1-mask';

	} elsif ($event->type eq 'button-press') {
		$item->grab ([qw/pointer-motion-mask button-release-mask/],
		             Gtk2::Gdk::Cursor->new ('fleur'),
		             $event->time);

	} elsif ($event->type eq 'button-release') {
		$item->ungrab ($event->time);
	}

	return FALSE;
}

sub create_drag_box {
	my ($root, $box_name, $callback) = @_;
	my $box = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Rect',
					     fill_color => undef,
					     outline_color => 'black',
					     width_pixels => 0);
	$box->signal_connect (event => \&highlight_box);
	$box->signal_connect (event => $callback);

	$root->canvas->{$box_name} = $box;
}

sub width_event {
	my ($item, $event) = @_;

	return FALSE
		if (($event->type ne 'motion-notify') || 
		    !($event->state >= 'button1-mask'));

	my $width = (MIDDLE - $event->y) / 5;
	return FALSE
		if $width < 0;

	$item->canvas->{width} = $width;
	set_arrow_shape ($item->canvas);

	return FALSE;
}

sub shape_a_event {
	my ($item, $event) = @_;

	return FALSE
		if (($event->type ne 'motion-notify') || 
		    !($event->state >= 'button1-mask'));

	my $shape_a = (RIGHT - $event->x) / 10;
	return FALSE if (($shape_a < 0) || ($shape_a > 30));

	$item->canvas->{shape_a} = $shape_a;
	set_arrow_shape ($item->canvas);

	return FALSE;
}

sub shape_b_c_event {
	my ($item, $event) = @_;

	return FALSE
		if (($event->type ne 'motion-notify') || 
		    !($event->state >= 'button1-mask'));

	my $change = FALSE;

	my $shape_b = (RIGHT - $event->x) / 10;
	if (($shape_b >= 0) && ($shape_b <= 30)) {
		$item->canvas->{shape_b} = $shape_b;
		$change = TRUE;
	}

	my $width = $item->canvas->{width};
	my $shape_c = ((MIDDLE - 5 * $width) - $event->y) / 10;
	if ($shape_c >= 0) {
		$item->canvas->{shape_c} = $shape_c;
		$change = TRUE;
	}

	set_arrow_shape ($item->canvas)
		if $change;

	return FALSE;
}

sub create_dimension {
	my ($root, $arrow_name, $text_name, $anchor) = @_;

	my $item = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Line',
					      fill_color => 'black',
					      first_arrowhead => TRUE,
					      last_arrowhead => TRUE,
					      arrow_shape_a => 5.0,
					      arrow_shape_b => 5.0,
					      arrow_shape_c => 3.0);
	$root->canvas->{$arrow_name} = $item;

	$item = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Text',
					   fill_color => 'black',
					   font => 'Sans 12',
					   anchor => $anchor);
	$root->canvas->{$text_name} = $item;
}

sub create_info {
	my ($root, $info_name, $x, $y) = @_;
	my $item = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Text',
					      x => $x,
					      y => $y,
					      fill_color => 'black',
					      font => 'Sans 14',
					      anchor => 'GTK_ANCHOR_NW');
	$root->canvas->{$info_name} = $item;
}

sub create_sample_arrow {
	my ($root, $sample_name, $x1, $y1, $x2, $y2) = @_;

	my $item = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Line',
					      points => [$x1, $y1, $x2, $y2],
					      fill_color => 'black',
					      first_arrowhead => TRUE,
					      last_arrowhead => TRUE);
	$root->canvas->{$sample_name} = $item;
}

sub create {
	my $vbox = Gtk2::VBox->new (FALSE, 4);
	$vbox->set_border_width (4);
	$vbox->show;

	my $w = Gtk2::Label->new ("This demo allows you to edit arrowhead shapes.  Drag the little boxes\n"
		. "to change the shape of the line and its arrowhead.  You can see the\n"
		. "arrows at their normal scale on the right hand side of the window.");
	$vbox->pack_start ($w, FALSE, FALSE, 0);
	$w->show;

	$w = Gtk2::Alignment->new (0.5, 0.5, 0.0, 0.0);
	$vbox->pack_start ($w, TRUE, TRUE, 0);
	$w->show;

	my $frame = Gtk2::Frame->new;
	$frame->set_shadow_type ('in');
	$w->add ($frame);
	$frame->show;

	my $canvas = Gnome2::Canvas->new;
	$canvas->set_size_request (500, 350);
	$canvas->set_scroll_region (0, 0, 500, 350);
	$frame->add ($canvas);
	$canvas->show;

	my $root = $canvas->root;

	$canvas->{width} = DEFAULT_WIDTH;
	$canvas->{shape_a} = DEFAULT_SHAPE_A;
	$canvas->{shape_b} = DEFAULT_SHAPE_B;
	$canvas->{shape_c} = DEFAULT_SHAPE_C;

	# Big arrow

	my $item = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Line',
				      points => [LEFT, MIDDLE,
				                 RIGHT, MIDDLE],
				      fill_color => 'mediumseagreen',
				      width_pixels => DEFAULT_WIDTH * 10,
				      last_arrowhead => TRUE);
	$canvas->{big_arrow} = $item;

	# Arrow outline

	$item = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Line',
				      fill_color => 'black',
				      width_pixels => 2,
				      cap_style => 'round',
				      join_style => 'round');
	$canvas->{outline} = $item;

	# Drag boxes

	create_drag_box ($root, "width_drag_box", \&width_event);
	create_drag_box ($root, "shape_a_drag_box", \&shape_a_event);
	create_drag_box ($root, "shape_b_c_drag_box", \&shape_b_c_event);

	# Dimensions

	create_dimension ($root, "width_arrow", "width_text", 'e');
	create_dimension ($root, "shape_a_arrow", "shape_a_text", 'n');
	create_dimension ($root, "shape_b_arrow", "shape_b_text", 'n');
	create_dimension ($root, "shape_c_arrow", "shape_c_text", 'w');

	# Info

	create_info ($root, "width_info", LEFT, 260);
	create_info ($root, "shape_a_info", LEFT, 280);
	create_info ($root, "shape_b_info", LEFT, 300);
	create_info ($root, "shape_c_info", LEFT, 320);

	# Division line

	Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Line',
	                           points => [RIGHT + 50, 0,
	                                      RIGHT + 50, 1000],
	                           fill_color => 'black',
	                           width_pixels => 2);

	# Sample arrows

	create_sample_arrow ($root, "sample_1", RIGHT + 100, 30, RIGHT + 100, MIDDLE - 30);
	create_sample_arrow ($root, "sample_2", RIGHT + 70, MIDDLE, RIGHT + 130, MIDDLE);
	create_sample_arrow ($root, "sample_3", RIGHT + 70, MIDDLE + 30, RIGHT + 130, MIDDLE + 120);

	# Done!
	
	set_arrow_shape ($canvas);

	return $vbox;
}

1;