#!/usr/bin/perl
use warnings;
use strict;
use Gnome2::Canvas;
use Glib qw(TRUE FALSE);

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_ellipses {
        my $root = shift;
        
        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", 0x3cb371
+80,
                                           "outline_color", "black",
                                           "width_pixels", 0));
        
        setup_item (Gnome2::Canvas::Item->new ($root,
                           'Gnome2::Canvas::Ellipse',
                           "x1", 310.0,
                           "y1", 80.0,
                           "x2", 380.0,
                           "y2", 140.0,
                           "fill_color_rgba", 0xb3713c80,
                           "outline_color", "black",
                           "width_pixels", 0));

       setup_item (Gnome2::Canvas::Item->new ($root,
                           'Gnome2::Canvas::Ellipse',
                           "x1", 210.0,
                           "y1", 180.0,
                           "x2", 280.0,
                           "y2", 240.0,
                           "fill_color_rgba", 0x5f9ea080,
                           "outline_color", "black",
                           "width_pixels", 0));


      setup_item (Gnome2::Canvas::Item->new ($root,
                          'Gnome2::Canvas::Ellipse',
                           "x1", 310.0,
                           "y1", 180.0,
                           "x2", 380.0,
                           "y2", 240.0,
                           "fill_color_rgba", 0xff9ea080,
                           "outline_color", "black",
                           "width_pixels", 0));

}


sub create {
        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 

        my $canvas = Gnome2::Canvas->new_aa;

        my $white = Gtk2::Gdk::Color->new (0xFFFF,0xFFFF,0xFFFF);
        $canvas->modify_bg('normal',$white);

        $canvas->set_center_scroll_region (FALSE);

        # Setup canvas items 

        my $root = $canvas->root;

        setup_ellipses ($root);

        # 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;
}


Gtk2->init;

my $mw = Gtk2::Window->new;

$mw->signal_connect (delete_event => sub { Gtk2->main_quit; 1 });

$mw->add( create() );

$mw->show;

Gtk2->main;
[download]