canvas_demo/canvas-primitives.pl

package CanvasPrimitives;
use strict;
use Gnome2::Canvas;
use Gtk2::Gdk::Keysyms;
use Glib qw(TRUE FALSE);
use constant M_PI => 3.141529;

sub zoom_changed {
	my ($adj, $canvas) = @_;
	$canvas->set_pixels_per_unit ($adj->value);
}

my $dragging = FALSE;
my ($x, $y);

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

	# set item_[xy] to the event x,y position in the parent's
	# item-relative coordinates
	my ($item_x, $item_y) = $item->parent->w2i ($event->coords);

	if ($event->type eq 'button-press') {
		if ($event->button == 1) {
			if ($event->state >= 'shift-mask') {
				$item->destroy;
			} else {
				$x = $item_x;
				$y = $item_y;

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

				$dragging = TRUE;
			}
		} elsif ($event->button == 2) {
			if ($event->state >= 'shift-mask') {
				$item->lower_to_bottom;
			} else {
				$item->lower (1);
			}
		} elsif ($event->button == 3) {
			if ($event->state >= 'shift-mask') {
				$item->raise_to_top;
			} else {
				$item->raise (1);
			}
		}

	} elsif ($event->type eq 'motion-notify') {
		if ($dragging && $event->state >= 'button1-mask') {
			my $new_x = $item_x;
			my $new_y = $item_y;

			$item->move ($new_x - $x, $new_y - $y);
			$x = $new_x;
			$y = $new_y;
		}

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

	return FALSE;
}

sub setup_item {
	my $item = shift;
	$item->signal_connect (event => \&item_event);
}

sub setup_heading {
	my ($root, $text, $pos) = @_;
	Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Text',
				   text => 'text',
				   x => (($pos % 3) * 200 + 100),
				   y => (($pos / 3) * 150 + 5),
				   font => 'Sans 12',
				   anchor => 'n', #GTK_ANCHOR_N,
				   fill_color => 'black');
}

sub setup_divisions {
	my $root = shift;

	my $group = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Group',
	                                       x => 0.0, y => 0.0);
	setup_item ($group);

	Gnome2::Canvas::Item->new ($group,
				   'Gnome2::Canvas::Rect',
				   x1 => 0.0,
				   y1 => 0.0,
				   x2 => 600.0,
				   y2 => 450.0,
				   outline_color => 'black',
				   width_units => 4.0);

	Gnome2::Canvas::Item->new ($group,
				   'Gnome2::Canvas::Line',
		                   points => [0.0, 150.0, 600.0, 150.0],
				   fill_color => 'black',
				   width_units => 4.0);

	Gnome2::Canvas::Item->new ($group,
				   'Gnome2::Canvas::Line',
		                   points => [0.0, 300.0, 600.0, 300.0],
				   fill_color => 'black',
				   width_units => 4.0);

	Gnome2::Canvas::Item->new ($group,
				   'Gnome2::Canvas::Line',
		                   points => [200.0, 0.0, 200.0, 450.0],
				   fill_color => 'black',
				   width_units => 4.0);

	Gnome2::Canvas::Item->new ($group,
				   'Gnome2::Canvas::Line',
		                   points => [400.0, 0.0, 400.0, 450.0],
				   fill_color => 'black',
				   width_units => 4.0);

	setup_heading ($group, "Rectangles", 0);
	setup_heading ($group, "Ellipses", 1);
	setup_heading ($group, "Texts", 2);
	setup_heading ($group, "Images", 3);
	setup_heading ($group, "Lines", 4);
	setup_heading ($group, "Curves", 5);
	setup_heading ($group, "Arcs", 6);
	setup_heading ($group, "Polygons", 7);
	setup_heading ($group, "Widgets", 8);
}

my $gray50_width = 2;
my $gray50_height = 2;
my $gray50_bits = pack "CC", 0x02, 0x01;

sub setup_rectangles {
	my $root = shift;

	setup_item (Gnome2::Canvas::Item->new ($root,
					       'Gnome2::Canvas::Rect',
					       x1 => 20.0,
					       y1 => 30.0,
					       x2 => 70.0,
					       y2 => 60.0,
					       outline_color => 'red',
					       width_pixels => 8));

	if ($root->canvas->aa) {
		setup_item (Gnome2::Canvas::Item->new ($root,
					   'Gnome2::Canvas::Rect',
					   x1 => 90.0,
					   y1 => 40.0,
					   x2 => 180.0,
					   y2 => 100.0,
					   fill_color_rgba => 0x3cb37180,
					   outline_color => 'black',
					   width_units => 4.0));
	} else {
		my $stipple = Gtk2::Gdk::Bitmap->create_from_data
			(undef, $gray50_bits, $gray50_width, $gray50_height);
		setup_item (Gnome2::Canvas::Item->new ($root,
					'Gnome2::Canvas::Rect',
					x1 => 90.0,
					y1 => 40.0,
					x2 => 180.0,
					y2 => 100.0,
					fill_color => "mediumseagreen",
					fill_stipple => $stipple,
					outline_color => "black",
					width_units => 4.0));
	}

	setup_item (Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Rect',
					       x1 => 10.0,
					       y1 => 80.0,
					       x2 => 80.0,
					       y2 => 140.0,
					       fill_color => 'steelblue'));
}

sub setup_ellipses {
	my $root = shift;

	setup_item (Gnome2::Canvas::Item->new ($root,
					   'Gnome2::Canvas::Ellipse',
					   "x1", 220.0,
					   "y1", 30.0,
					   "x2", 270.0,
					   "y2", 60.0,
					   "outline_color", "goldenrod",
					   "width_pixels", 8));

	setup_item (Gnome2::Canvas::Item->new ($root,
					   'Gnome2::Canvas::Ellipse',
					   "x1", 290.0,
					   "y1", 40.0,
					   "x2", 380.0,
					   "y2", 100.0,
					   "fill_color", "wheat",
					   "outline_color", "midnightblue",
					   "width_units", 4.0));

	if ($root->canvas->aa) {
		setup_item (Gnome2::Canvas::Item->new ($root,
						   'Gnome2::Canvas::Ellipse',
						   "x1", 210.0,
						   "y1", 80.0,
						   "x2", 280.0,
						   "y2", 140.0,
						   "fill_color_rgba", 0x5f9ea080,
						   "outline_color", "black",
						   "width_pixels", 0));
	} else {
		my $stipple = Gtk2::Gdk::Bitmap->create_from_data
			(undef, $gray50_bits, $gray50_width, $gray50_height);
		setup_item (Gnome2::Canvas::Item->new ($root,
						   'Gnome2::Canvas::Ellipse',
						   "x1", 210.0,
						   "y1", 80.0,
						   "x2", 280.0,
						   "y2", 140.0,
						   "fill_color", "cadetblue",
						   "fill_stipple", $stipple,
						   "outline_color", "black",
						   "width_pixels", 0));
	}
}

sub make_anchor {
	my ($root, $x, $y) = @_;

	my $group = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Group',
					       x => $x,
					       y => $y);
	setup_item ($group);

	Gnome2::Canvas::Item->new ($group, 'Gnome2::Canvas::Rect',
				   x1 => -2.0,
				   y1 => -2.0,
				   x2 => 2.0,
				   y2 => 2.0,
				   outline_color => "black",
				   width_pixels => 0);

	return $group;
}

sub setup_texts {
	my $root = shift;

	if ($root->canvas->aa) {
		Gnome2::Canvas::Item->new (make_anchor ($root, 420.0, 20.0),
				       'Gnome2::Canvas::Text',
				       "text", "Anchor NW",
				       "x", 0.0,
				       "y", 0.0,
				       "font", "Sans Bold 24",
				       "anchor", 'GTK_ANCHOR_NW',
				       "fill_color_rgba", 0x0000ff80);
	} else {
		my $stipple = Gtk2::Gdk::Bitmap->create_from_data
			(undef, $gray50_bits, $gray50_width, $gray50_height);
		Gnome2::Canvas::Item->new (make_anchor ($root, 420.0, 20.0),
				       'Gnome2::Canvas::Text',
				       "text", "Anchor NW",
				       "x", 0.0,
				       "y", 0.0,
				       "font", "Sans Bold 24",
				       "anchor", 'GTK_ANCHOR_NW',
				       "fill_color", "blue",
				       "fill_stipple", $stipple);
	}

	Gnome2::Canvas::Item->new (make_anchor ($root, 470.0, 75.0),
			       'Gnome2::Canvas::Text',
			       "text", "Anchor center\nJustify center\nMultiline text",
			       "x", 0.0,
			       "y", 0.0,
			       "font", "monospace bold 14",
			       "anchor", 'GTK_ANCHOR_CENTER',
			       "justification", 'GTK_JUSTIFY_CENTER',
			       "fill_color", "firebrick");

	Gnome2::Canvas::Item->new (make_anchor ($root, 590.0, 140.0),
			       'Gnome2::Canvas::Text',
			       "text", "Clipped text\nClipped text\nClipped text\nClipped text\nClipped text\nClipped text",
			       "x", 0.0,
			       "y", 0.0,
			       "font", "Sans 12",
			       "anchor", 'GTK_ANCHOR_SE',
			       "clip", TRUE,
			       "clip_width", 50.0,
			       "clip_height", 55.0,
			       "x_offset", 10.0,
			       "fill_color", "darkgreen");
}

sub plant_flower {
	my ($root, $x, $y, $anchor, $aa) = @_;

	eval {
	my $im = Gtk2::Gdk::Pixbuf->new_from_file("flower.png");
	my $image = Gnome2::Canvas::Item->new ($root,
					       'Gnome2::Canvas::Pixbuf',
					       "pixbuf", $im,
					       "x", $x,
					       "y", $y,
					       "width", $im->get_width,
					       "height", $im->get_height,
  					       "anchor", $anchor,
					       );
	setup_item ($image);
	}
}

sub setup_images {
	my ($root, $aa) = @_;

	eval {
	my $im = Gtk2::Gdk::Pixbuf->new_from_file("toroid.png");
	my $image = Gnome2::Canvas::Item->new ($root,
					       'Gnome2::Canvas::Pixbuf',
					       pixbuf => $im,
					       x      => 100.0,
					       y      => 225.0,
					       width  => $im->get_width,
					       height => $im->get_height,
					       anchor => 'center',
					       );
	setup_item ($image);

	plant_flower ($root,  20.0, 170.0, 'GTK_ANCHOR_NW', $aa);
	plant_flower ($root, 180.0, 170.0, 'GTK_ANCHOR_NE', $aa);
	plant_flower ($root,  20.0, 280.0, 'GTK_ANCHOR_SW', $aa);
	plant_flower ($root, 180.0, 280.0, 'GTK_ANCHOR_SE', $aa);
	}
}

use constant VERTICES => 10;
use constant RADIUS   => 60.0;

sub polish_diamond {
	my $root = shift;

	my $group = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Group',
					       x => 270.0, y => 230.0);
	setup_item ($group);

	my @coords;

	for (my $i = 0; $i < VERTICES; $i++) {
		my $a = 2.0 * M_PI * $i / VERTICES;
		$coords[0] = RADIUS * cos ($a);
		$coords[1] = RADIUS * sin ($a);

		for (my $j = $i + 1; $j < VERTICES; $j++) {
			$a = 2.0 * M_PI * $j / VERTICES;
			$coords[2] = RADIUS * cos ($a);
			$coords[3] = RADIUS * sin ($a);
			Gnome2::Canvas::Item->new ($group,
						   'Gnome2::Canvas::Line',
						   points => \@coords,
						   fill_color => 'black',
						   width_units => 1.0,
						   cap_style => 'round');
		}
	}
}

use constant SCALE => 7.0;

sub make_hilbert {
	my $root = shift;
	my $hilbert = "urdrrulurulldluuruluurdrurddldrrruluurdrurddldrddlulldrdldrrurd";

	my @coords = (340.0, 290.0);
	my @d = split //, $hilbert;
	for (my $i = 0 ; $i < @d ; $i++) {
		if ($d[$i] eq 'u') {
			$coords[2*($i+1)+0] = $coords[2*$i+0];
			$coords[2*($i+1)+1] = $coords[2*$i+1] - SCALE;
		} elsif ($d[$i] eq 'd  ') {
			$coords[2*($i+1)+0] = $coords[2*$i+0];
			$coords[2*($i+1)+1] = $coords[2*$i+1] + SCALE;
		} elsif ($d[$i] eq 'l  ') {
			$coords[2*($i+1)+0] = $coords[2*$i+0] - SCALE;
			$coords[2*($i+1)+1] = $coords[2*$i+1];
		} elsif ($d[$i] eq 'r  ') {
			$coords[2*($i+1)+0] = $coords[2*$i+0] + SCALE;
			$coords[2*($i+1)+1] = $coords[2*$i+1];
		}
	}

	if ($root->canvas->aa) {
		setup_item (Gnome2::Canvas::Item->new ($root,
					'Gnome2::Canvas::Line',
					points => \@coords,
					fill_color_rgba => 0xff000080,
					width_units => 4.0,
					cap_style => 'projecting',
					join_style => 'miter'));
	} else {
		my $stipple = Gtk2::Gdk::Bitmap->create_from_data
			(undef, $gray50_bits, $gray50_width, $gray50_height);
		setup_item (Gnome2::Canvas::Item->new ($root,
					'Gnome2::Canvas::Line',
					points => \@coords,
					fill_color => "red",
					fill_stipple => $stipple,
					width_units => 4.0,
					cap_style => 'projecting',
					join_style => 'miter'));
	}
}

sub setup_lines {
	my $root = shift;

	polish_diamond ($root);
	make_hilbert ($root);

	# Arrow tests

	setup_item (Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Line',
					       "points", [340.0, 170.0,
							  340.0, 230.0,
							  390.0, 230.0,
							  390.0, 170.0],
					       "fill_color", "midnightblue",
					       "width_units", 3.0,
					       "first_arrowhead", TRUE,
					       "last_arrowhead", TRUE,
					       "arrow_shape_a", 8.0,
					       "arrow_shape_b", 12.0,
					       "arrow_shape_c", 4.0));

	setup_item (Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Line',
					       "points", [356.0, 180.0,
							  374.0, 220.0],
					       "fill_color", "blue",
					       "width_pixels", 0,
					       "first_arrowhead", TRUE,
					       "last_arrowhead", TRUE,
					       "arrow_shape_a", 6.0,
					       "arrow_shape_b", 6.0,
					       "arrow_shape_c", 4.0));

	setup_item (Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Line',
					       "points", [356.0, 220.0,
						 	  374.0, 180.0],
					       "fill_color", "blue",
					       "width_pixels", 0,
					       "first_arrowhead", TRUE,
					       "last_arrowhead", TRUE,
					       "arrow_shape_a", 6.0,
					       "arrow_shape_b", 6.0,
					       "arrow_shape_c", 4.0));
}

sub setup_curves {
	my $root = shift;
	my $path_def = Gnome2::Canvas::PathDef->new;
	$path_def->moveto (500.0, 175.0);
	$path_def->curveto (550.0, 175.0, 550.0, 275.0, 500.0, 275.0);	
	my $item = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Bpath',
					      #### can't set this here
					      ####bpath => $path_def,
					      outline_color => "black",
					      width_pixels => 4);
	$item->set_path_def ($path_def);
	setup_item ($item);
}

sub setup_polygons {
	my $root = shift;

	my @points = (210.0, 320.0,
		      210.0, 380.0,
		      260.0, 350.0);
	if ($root->canvas->aa) {
		setup_item (Gnome2::Canvas::Item->new ($root,
					   'Gnome2::Canvas::Polygon',
					   points => \@points,
					   fill_color_rgba => 0x0000ff80,
					   outline_color => 'black'));
	} else {
		my $stipple = Gtk2::Gdk::Bitmap->create_from_data (undef,
				$gray50_bits, $gray50_width, $gray50_height);
		setup_item (Gnome2::Canvas::Item->new ($root,
					   'Gnome2::Canvas::Polygon',
					   points => \@points,
					   fill_color => "blue",
					   fill_stipple => $stipple,
					   outline_color => "black"));
	}

	@points = (270.0, 330.0,
		   270.0, 430.0,
		   390.0, 430.0,
		   390.0, 330.0,
		   310.0, 330.0,
		   310.0, 390.0,
		   350.0, 390.0,
		   350.0, 370.0,
		   330.0, 370.0,
		   330.0, 350.0,
		   370.0, 350.0,
		   370.0, 410.0,
		   290.0, 410.0,
		   290.0, 330.0);
	setup_item (Gnome2::Canvas::Item->new ($root,
					       'Gnome2::Canvas::Polygon',
					       points => \@points,
					       fill_color => 'tan',
					       outline_color => 'black',
					       width_units => 3.0));
}

sub setup_widgets {
	my $group = shift;

	my $w = Gtk2::Button->new ("Hello world!");
	setup_item (Gnome2::Canvas::Item->new ($group,
					       'Gnome2::Canvas::Widget',
					       widget => $w,
					       x => 420.0,
					       y => 330.0,
					       width => 100.0,
					       height => 40.0,
					       anchor => 'nw', #GTK_ANCHOR_NW,
					       size_pixels => FALSE));
	$w->show;
}

sub key_press {
	my ($canvas, $event) = @_;

	my ($x, $y) = $canvas->get_scroll_offsets;

	if ($event->keyval == $Gtk2::Gdk::Keysyms{Up}) {
		$canvas->scroll_to ($x, $y - 20);
	} elsif ($event->keyval == $Gtk2::Gdk::Keysyms{Down}) {
		$canvas->scroll_to ($x, $y + 20);
	} elsif ($event->keyval == $Gtk2::Gdk::Keysyms{Left}) {
		$canvas->scroll_to ($x - 10, $y);
	} elsif ($event->keyval == $Gtk2::Gdk::Keysyms{Right}) {
		$canvas->scroll_to ($x + 10, $y);
	} else {
		return FALSE;
	}

	return TRUE;
}

sub create {
	my $aa = shift;

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

	my $w = Gtk2::Label->new ("Drag an item with button 1.  Click button 2 on an item to lower it,\n"
			. "or button 3 to raise it.  Shift+click with buttons 2 or 3 to send\n"
			. "an item to the bottom or top, respectively.");
	$vbox->pack_start ($w, FALSE, FALSE, 0);
	$w->show;

	my $hbox = Gtk2::HBox->new (FALSE, 4);
	$vbox->pack_start ($hbox, FALSE, FALSE, 0);
	$hbox->show;

	# Create the canvas

	#gtk_widget_push_colormap (gdk_rgb_get_cmap ());
#### FIXME
###	Gtk2::Widget->push_colormap (Gtk2::Gdk::Rgb->get_cmap);
	my $canvas = $aa ? Gnome2::Canvas->new_aa : Gnome2::Canvas->new;

	$canvas->set_center_scroll_region (FALSE);

	# Setup canvas items

	my $root = $canvas->root;

	setup_divisions ($root);
	setup_rectangles ($root);
	setup_ellipses ($root);
  	setup_texts ($root); 
	setup_images ($root, $aa);
	setup_lines ($root);
	setup_polygons ($root);
	setup_curves ($root);
	setup_widgets ($root);

## (this FIXME was in the original C source, too)
## FIXME: we should have a 'rotation' spinbutton too - and fix the acute
##  bugs with that ... 
##if 0
#	{
#		double affine[6];
#
##if 1
#		art_affine_rotate (affine, 15);
##else
#		art_affine_scale (affine, 1.5, 0.7);
##endif
#		gnome_canvas_item_affine_relative (root, affine);
#	}
##endif

### FIXME
####	Gtk2::Widget->pop_colormap;

	# Zoom

	$w = Gtk2::Label->new ("Zoom:");
	$hbox->pack_start ($w, FALSE, FALSE, 0);
	$w->show;

	my $adj = Gtk2::Adjustment->new (1.00, 0.05, 5.00, 0.05, 0.50, 0.50);
	$adj->signal_connect (value_changed => \&zoom_changed, $canvas);
	$w = Gtk2::SpinButton->new ($adj, 0.0, 2);
	$w->set_size_request (50, -1);
	$hbox->pack_start ($w, FALSE, FALSE, 0);
	$w->show;

	# Layout the stuff

	my $table = Gtk2::Table->new (2, 2, FALSE);
	$table->set_row_spacings (4);
	$table->set_col_spacings (4);
	$vbox->pack_start ($table, TRUE, TRUE, 0);
	$table->show;

	my $frame = Gtk2::Frame->new;
	$frame->set_shadow_type ('in');
	$table->attach ($frame,
			0, 1, 0, 1,
			[qw/expand fill shrink/],
			[qw/expand fill shrink/],
			0, 0);
	$frame->show;

	$canvas->set_size_request (600, 450);
	$canvas->set_scroll_region (0, 0, 600, 450);
	$frame->add ($canvas);
	$canvas->show;

	$canvas->signal_connect_after (key_press_event => \&key_press);

	$w = Gtk2::HScrollBar->new ($canvas->get_hadjustment);
	$table->attach ($w,
			0, 1, 1, 2,
			[qw/expand fill shrink/],
			[qw/fill/],
			0, 0);
	$w->show;;

	$w = Gtk2::VScrollBar->new ($canvas->get_vadjustment);
	$table->attach ($w,
			1, 2, 0, 1,
			['fill'],
			[qw/expand fill shrink/],
			0, 0);
	$w->show;

	$canvas->set_flags ('can-focus');
	$canvas->grab_focus;

	return $vbox;
}
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)