#!/usr/bin/perl -w
use strict;
use warnings;
use Goo::Canvas;
use Gtk2 '-init';
use Glib qw(TRUE FALSE);
my $window = Gtk2::Window->new('toplevel');
$window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
$window->set_default_size(680, 600);
my $vbox = Gtk2::VBox->new;
$vbox->set_border_width(4);
$vbox->show;
my $hbox = Gtk2::HBox->new(FALSE, 4);
$vbox->pack_start($hbox, FALSE, FALSE, 0);
$hbox->show;
$window->add($vbox);
my $swin = Gtk2::ScrolledWindow->new;
$swin->set_shadow_type('in');
$vbox->pack_start($swin, 1, 1, 0);
my $cwidth = 1000;
my $cheight = 1000;
my $canvas = Goo::Canvas->new();
$canvas->set_size_request(600, 450); # minimum size on screen
$canvas->set_bounds(0, 0, $cwidth, $cheight); # scrollregion
$swin->add($canvas);
my $root = $canvas->get_root_item();
$canvas->signal_connect('button-press-event',
\&on_can_button_press);
$canvas->signal_connect (event => \&event_handler);
my $g = Goo::Canvas::Group->new($root);
$g->translate(310,300);
my $button = Gtk2::Button->new ('Draw');
$button->signal_connect (clicked => \&clicked );
$hbox->pack_start($button, FALSE, FALSE, 10);
$button->show();
$window->show_all();
Gtk2->main;
sub clicked {
my $cur_lab = $button->get_label();
#print "$cur_lab\n";
if($cur_lab eq 'Draw'){
$button->set_label('Clear');
print "Starting action\n";
&draw();
}elsif($cur_lab eq 'Clear'){
$button->set_label('Draw');
print "Stopping action\n";
&clear;
}
}
sub draw{
my $markup = "<span font_family ='Arial '
foreground = '#000000'
size = '18000'
weight = 'bold'> Remove items with right click or clear button
+</span>";
my $text = Goo::Canvas::Text->new(
$root,
$markup,
10 , 10 , -1, #-1 means a single line, no space constraint
'nw',
'use markup' => 1,
);
# item = Goo::Canvas::Ellipse->new ($parent, $center_x, $center_y,
+
# $radius_x, $radius_y, ...)
my $e0 = Goo::Canvas::Ellipse->new(
$g, 0, 0,300, 225,
'stroke-color' => 'black',
'line-width' => 2,
'fill-color-rgba' => 0xffb3f111,
'title' => 'foo',
);
my $e1 = Goo::Canvas::Ellipse->new(
$g, 100, 100,300, 225,
'stroke-color' => 'black',
'line-width' => 2,
'fill-color-rgba' => 0x3cb3f111,
);
print 'g ',$g->get_n_children,"\n";
print 'root ',$root->get_n_children,"\n";
print $g->find_child ($e0),"\n";
print $g->find_child ($e1),"\n";
return 1;
}
sub clear{
#dosn't work, the number seems to shift as you remove
# $g->remove_child(0);
# $g->remove_child(1);
#works
# $g->remove_child(1);
# $g->remove_child(0);
#works
for(1..$g->get_n_children){
$g->remove_child(0);
}
# or you can remove the group from root
# works
#$root->remove_child(0);
return 1;
}
sub on_can_button_press {
my ( $widget, $event ) = @_;
# print $widget ,' ',$event->type,"\n";
my ($x,$y) = ($event->x,$event->y);
print "$x $y\n";
return TRUE;
}
$canvas->signal_connect (event => \&event_handler);
sub event_handler{
my ( $widget, $event ) = @_;
# print $widget ,' ',$event->type,"\n";
#remove items with right click
if ($event->type eq "button-press" && $event->button == 3){
my ($x,$y) = ($event->x,$event->y);
print "right click\n";
my $item = $canvas->get_item_at($x,$y,TRUE);
# check for click on empty space
if( ! defined $item ){return 1}
my $parent = $item->get_parent;
print "$parent\n";
my $num = $parent->find_child ($item);
print "$num\n";
$parent->remove_child($num);
return 0;
}
if ( $event->type eq "button-release" ) {
return 0;
}
if ( $event->type eq "focus-change" ) {
return 0;
}
if ( $event->type eq "expose" ) {
return 0;
}
Gtk2->main_iteration while Gtk2->events_pending;
return 0;
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.