in reply to Re^2: geoTiff Application Building
in thread geoTiff Application Building

The cool thing about Gtk2 is it is designed properly.... most widgets have an eventbox built-in. A word of caution about pixel-zooming...... it will not save as zoomed, unless you grab a screenshot. 
#!/usr/bin/perl
use warnings;
use strict;
use Gtk2 '-init';
use Gnome2::Canvas;

my $window = Gtk2::Window->new;
$window ->signal_connect( 'destroy' => \&delete_event );

my $canvas = Gnome2::Canvas->new();
$canvas->set_size_request(256,256);
$canvas->set_scroll_region(0,0,256,256);
my $root = $canvas->root();

my $item = Gnome2::Canvas::Item->new($root,
"Gnome2::Canvas::Ellipse",
x1 => 0,
y1 => 0,
x2 => 200,
y2 => 180,
fill_color=>"red",
outline_color=>"black"
);

$item->signal_connect(event=>sub {print "I got an event!\n"; });

$canvas->signal_connect (event => \&event_handler);
$window->add ($canvas);
$window->show_all;

Gtk2->main;
###########################################################3

sub event_handler{
     my ( $widget, $event ) = @_;
     print $widget ,' ',$event->type,"\n";

    if ( $event->type eq "button-press" ) {
        print 'x->',$event->x,'  ','y->',$event->y,"\n";
    }    
}

sub delete_event {
Gtk2->main_quit;
return 0;
}

[download]
I'm not really a human, but I play one on earth CandyGram for Mongo

Replies are listed 'Best First'.
Re^4: geoTiff Application Building
by deadpickle (Pilgrim) on May 31, 2008 at 20:27 UTC
    I have encountered a small problem when zooming. It seems that when you double click to drop a point it is not exactly where the mouse pointer is, it is off slightly. when you zoom in it gets worse. When you zoom closer it drops the point far to the right and vise versa when you zoom out. maybe someone can see why that is?
    #Draggability of window
my $adj = Gtk2::Adjustment->new (1.00, 0.05, 5.00, 0.05, 0.50, 0.50);
my $dragger = Gtk2::Ex::Dragger->new( widget => $scwin,
    hadjustment => $scwin->get_hadjustment,
    vadjustment => $scwin->get_vadjustment,
    #update_policy => 'continous',
    #cursor => 'hand1'
    );

#Setup zooming
my $zoom = Gtk2::Label->new ("Zoom:");
$table->attach_defaults($zoom, 0, 1, 1, 2);
$adj->signal_connect (value_changed => \&zoom_changed, $canvas);
$zoom = Gtk2::SpinButton->new ($adj, 0.0, 2);
$zoom->set_size_request (50, -1);
$table->attach_defaults($zoom, 1, 2, 1, 2);

#handle the events
$canvas->signal_connect (event => \&event_handler);

$window->show_all;

Gtk2->main;
#------------------------------------------------
sub event_handler {
    my ( $widget, $event ) = @_;
    # print $widget ,' ',$event->type,"\n";
    
    #on 2 mouse presses, place waypoint 
    if ( $event->type eq "2button-press" ) {
        print 'x->',$event->x,'  ','y->',$event->y;
        
        #convert UTM to Lat and Long
        my $easting = $ps[0] * $event->x + 0.0 * $event->y + $mtp[3];
        my $northing = (-$ps[1]) * $event->y + 0.0 * $event->x + $mtp[
+4];
        my ($latitude,$longitude)=utm_to_latlon($ellipsoid,$zone,$east
+ing,$northing);
        print " ($latitude, $longitude)\n";
        
        #Drop icon
        my $tgroup = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas
+::Group', x => $event->x, y => $event->y);
        Gnome2::Canvas::Item->new($tgroup, 'Gnome2::Canvas::Ellipse',
            x1 => 0,
            y1 => 0,
            x2 => 10,
            y2 => 10,
            fill_color => 'purple',
            outline_color => 'black');
            $tgroup->raise_to_top();
    }
    
    #on mouse press, pan the window
    if ( $event->type eq "button-press" ) {
        $dragger->start ($event);
    }
}
#------------------------------------------------
sub zoom_changed {
    my ($adj, $canvas) = @_;
    $canvas->set_pixels_per_unit ($adj->value);
}

    [download]
    UPDATE: I am receiving this error: 
    Gdk-CRITICAL **: gdk_property_change: assertion `type != GDK_TARGET_ST
+RING' fail
ed at C:/camelbox/site/lib/Gtk2/Ex/SyncCall.pm line 62.

    [download]
[reply]
[d/l]
[select]
      I mentioned in the previous post, that "pixel zooming" is tricky to handle....it is only a "screen illusion" where the screen pixels are magnfied. Also you must be aware of the "center point of zoom"... it will default to (0,0) ... the upper left corner(accounting for the right-downward shift when zooming). Read perldoc Gnome2::Canvas and search for zoom. Also look at window-to-world and c2w.

      I don't have an example handy, and you might want to ask on the Perl/Gtk2 maillist.

      Before you get too deep into the Gnome2::Canvas, you may want to switch to the Goo::Canvas because it will save better. You can save the whole canvas as svg. Also it's demo shows how to change the center-point of zooming by setting the anchor, ( I don't know if it will work on Gnome2::Canvas)

      I'm not really a human, but I play one on earth CandyGram for Mongo
[reply]
        I C. Its good to know for future development but right now neither saving or zooming are that important right now. Right now I have it so that the user can click and hold to pan, double click to add a waypoint, and when the waypoints are more than one they are connected by a line in sequence. But there are a few more things to do. Right now when there are three waypoints, a line connecting points 1 and 3 making it a circuit but when you add a fourth the previous line stays and then you get two circuits. Its hard to explain so you can get a screenshot here . The line from 3 to 1 should not be there. Any ideas on how to stop this from happening? Also I want the user to be able to remove the waypoints. Is it possible to drop the lines and waypoints into a hash and have canvas draw them after every event? This allows me to manipulate the objects with ease. 
         sub event_handler {
    my ( $widget, $event ) = @_;
    # print $widget ,' ',$event->type,"\n";
    
    #on 2 mouse presses, place waypoint 
    if ( $event->type eq "2button-press" ) {
        print 'x->',$event->x,'  ','y->',$event->y;
        
        #convert UTM to Lat and Long
        my $easting = $ps[0] * $event->x + 0.0 * $event->y + $mtp[3];
        my $northing = (-$ps[1]) * $event->y + 0.0 * $event->x + $mtp[
+4];
        my ($latitude,$longitude)=utm_to_latlon($ellipsoid,$zone,$east
+ing,$northing);
        print " ($latitude, $longitude)\n";
        
        #Drop icon
        my $tgroup = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas
+::Group', x => $event->x, y => $event->y);
        Gnome2::Canvas::Item->new($tgroup, 'Gnome2::Canvas::Ellipse',
            x1 => -7.5,
            y1 => -7.5,
            x2 => 7.5,
            y2 => 7.5,
            fill_color => 'purple',
            outline_color => 'black');
        Gnome2::Canvas::Item->new ($tgroup,
            'Gnome2::Canvas::Text',
            "text", "$count",
            "x", 0.0,
            "y", 0.0,
            "font", "Sans Bold",
            "anchor", 'GTK_ANCHOR_NW',
            "weight", 100,
            "fill_color", 'red',
            "size_points", 20);
        
        
        #add waypoints
        $waypoints{$count } = {'x' => $event->x,'y' => $event->y, 'lat
+' => $latitude, 'long' => $longitude};
        print "size of hash:  " . keys( %waypoints ) . ".\n";
        #foreach my $num (sort keys %waypoints){
        #    print "$num = $waypoints{$num}\n";
        #    foreach my $subkey (sort keys %{$waypoints{$num}}){
        #        print "$subkey = $waypoints{$num}{$subkey}\n";
        #    }
        #}

        
        #draw lines to the waypoints
        if ($count >= 2){
            my @points;
            foreach my $key (sort keys %waypoints){
                foreach my $subkey (sort keys %{$waypoints{$key}}){
                    if ($subkey eq 'x' || $subkey eq 'y'){
                        push(@points, $waypoints{$key}{$subkey});
                        print "$key $subkey = $waypoints{$key}{$subkey
+}\n";
                    }
                    
                }
                
            }
            if ($count >= 3){
                push(@points, $waypoints{1}{'x'});
                push(@points, $waypoints{1}{'y'});
            }
            
            my $lgroup = Gnome2::Canvas::Item->new ($root, 'Gnome2::Ca
+nvas::Group');
            Gnome2::Canvas::Item->new ($lgroup,
                'Gnome2::Canvas::Line',
                points => [@points],
                fill_color => 'black',
                width_units => 4.0);
            
            foreach (@points){
                print $_, "\n";
            }   
        }
        #print $count, "\n";
        $tgroup->raise_to_top();
        $count++;
    }
}

        [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom