#!/usr/bin/perl
use strict;
use warnings;
use Gtk2 '-init';
use Goo::Canvas;
use Gtk2::Ex::CrossHair;
use Gtk2::Gdk::Keysyms;


my ($lastx,$lasty)=(0,0);
my $center_set = 0;

my $mw = Gtk2::Window->new('toplevel');
$mw->set_default_size( 400, 300 );
$mw->signal_connect (destroy => sub { Gtk2->main_quit });

my $vbox = Gtk2::VBox->new(0,0);
$mw->add ($vbox);

my $swin = Gtk2::ScrolledWindow->new;
$swin->set_shadow_type('in');
my $ha1  = $swin->get_hadjustment;
my $va1  = $swin->get_vadjustment;

my $canvas = Goo::Canvas->new();
my ($cw,$ch) = (600, 450);
$canvas->set_size_request($cw, $ch);
my($xbound,$ybound) = (1000,1000);
$canvas->set_bounds(0, 0, $xbound, $ybound);
my ($cx,$cy) = ($xbound/2,$ybound/2);
my $root = $canvas->get_root_item();

my $white = Gtk2::Gdk::Color->new (0xFFFF,0xFFFF,0xFFFF);
my $green = Gtk2::Gdk::Color->new (0x0000,0xFFFF,0x0000);
my $black = Gtk2::Gdk::Color->new (0x0000,0x0000,0x0000);

$canvas->modify_base('normal',$black);

$vbox->pack_start ($swin, 1,1,1);
$swin->add($canvas);

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

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

my $adj = Gtk2::Adjustment->new(1, 0.05, 100, 0.05, 0.5, 0.0);
my $sb = Gtk2::SpinButton->new($adj, 0.1, 2);
$adj->signal_connect("value-changed", \&zoom_changed, $canvas);
$sb->set_size_request(60, -1);
$sb->set_editable(0);
$hbox->pack_start($sb, 1, 1, 10);
$sb->show;


#$adj = Gtk2::Adjustment->new( 1.0, 1.0, 31.0, 1.0, 5.0, 0.0 );
#$spinner = Gtk2::SpinButton->new( $adj, 0, 0 );
#$spinner->set_wrap(TRUE);
#$vbox2->pack_start( $spinner, FALSE, TRUE, 0 );




# crosshair status labels
my $status = Gtk2::Label->new;
$status->set_markup("<span background = 'black' foreground= 'green' si
+ze='15000'>                            </span>");
$hbox->pack_start ($status, 1,1,1);

# crosshair center point label
my $center = Gtk2::Label->new;
$center->set_markup("<span background = 'lightblue' foreground= 'red' 
+size='15000'>Zoom Center: $lastx $lasty </span>");
$hbox->pack_end ($center, 1,1,1);


my $cross = Gtk2::Ex::CrossHair->new (widget => $canvas,
                                     # foreground => '#00ff00',
                                      foreground => $green,
                                   );

$cross->signal_connect (moved => sub {
                          my ($cross, $widget, $x, $y) = @_;
                          #print "@_\n";
     
     my $cur_xscr_setting = $ha1->get_value;
     my $cur_yscr_setting = $va1->get_value;
     my $scale = $adj->get_value;
#     print "xvalue-> ",$ha1->get_value,' ',"yvalue-> ",$va1->get_valu
+e,"\n";
                                                   
          if (defined $x) {
             my $sx = sprintf("%.0f", $cur_xscr_setting + $x);        
             my $sy = sprintf("%.0f", $cur_yscr_setting + $y);        
           
      $status->set_markup(
     "<span background='black' foreground='green' size='15000'>X: <i> 
+$sx    </i></span><span background='black' foreground='yellow' size='
+15000'>Y: <i> $sy </i></span>"
       );
        
      if( ! $center_set ){
         $lastx = sprintf("%.0f",$sx/$scale);
         $lasty = sprintf("%.0f",$sy/$scale);
        }    
        
        } else {
     $status->set_markup(
     "<span background = 'black' foreground= 'green' size='15000'>    
+                        </span>");
      }
    });


$canvas->add_events ('button-press-mask');

$canvas->signal_connect (button_press_event => sub {
                         my ($canvas, $event) = @_;
                         $cross->start ($event);
 
                         #needed to take keyboard grab from zoom contr
+ol
                         $canvas->grab_focus($root);
                       });

$canvas->signal_connect_after('key_press_event', \&on_key_press);
#$canvas->signal_connect_after('key_release_event', \&on_key_press);


#fixes runaway zoom
#$canvas->signal_connect (event => \&event_handler);

$canvas->can_focus(1);
$canvas->grab_focus($root);

&fill_canvas();

# to adjust zoom after window resize
$mw->signal_connect(event_after => \&event_after); 

$mw->show_all;

Gtk2->main;
exit 0;

sub zoom_changed {
    my ($adj, $canvas) = @_;
    $canvas->set_scale($adj->get_value);
#    $canvas->scroll_to (0,0);   

     my $cur_xscr_setting = $ha1->get_value;
     my $cur_yscr_setting = $va1->get_value;
#     print "xvalue-> ",$ha1->get_value,' ',"yvalue-> ",$va1->get_valu
+e,"\n";
my $scale = $adj->get_value;
my $dx = $lastx;
my $dy = $lasty;

# works to 0,0   
#$canvas->scroll_to( 0 , 0 ); 

#center
#$canvas->scroll_to( $cx - $cw/(2*$scale) , $cy  - $ch/(2*$scale)  );

# works to position $dx and $dy at 0,0   
#$canvas->scroll_to( $dx , $dy ); 

#adds to center
#$canvas->scroll_to( $dx + $cx - $cw/(2*$scale), $dy + $cy - $ch/(2*$s
+cale) );   

#works 
$canvas->scroll_to( $dx - $cw/(2*$scale), $dy - $ch/(2*$scale)   );   

return 0;
}

sub fill_canvas{
for (my $x = 0; $x <= $xbound; $x += 50) {  
     my $y = $x;
 
    my $e1 = Goo::Canvas::Ellipse->new(
         $root, $x, $y, 30, 30,
         'stroke-color' => 'blue',
         'line-width' => 2,
         'fill-color-rgba' => 0x3cb3f199,
    );

    my $markup = "<span foreground= 'white' size='15000'>$x</span>";

   my $t1 = Goo::Canvas::Text->new(
             $root, 
             $markup,
             $x ,$y , -1, 
             'w',
             use_markup=>1,
         );
  }
}

sub event_after {
  my ($mw, $event) = @_;

 my $rect = $canvas->allocation;
 $cw = $rect->width;
 $ch = $rect->height;

 return 0;
}

sub on_key_press {
    # print "@_\n";
     my ( $canvas, $event ) = @_;
     print $event->type,"\n";

    if ( $event->keyval == $Gtk2::Gdk::Keysyms{m} ) {
       $center->set_markup("<span background = 'lightblue' foreground=
+ 'red' size='15000'>Zoom Center: $lastx $lasty </span>");
       $center_set = 1;
    }  


    if ( $event->keyval == $Gtk2::Gdk::Keysyms{n} ) {
       $lastx = 0; $lasty = 0;
       $center->set_markup("<span background = 'lightblue' foreground=
+ 'red' size='15000'>Zoom Center: $lastx $lasty </span>");
       $center_set = 0;
    }  


return 0;
}

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

     my $scale = $adj->get_value;
     # print "scale->$scale\n"; 

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

    if ( $event->type eq "button-release" ) {
    
    }


    if ( $event->type eq "focus-change" ) {
        return 0;
    }
    
    if ( $event->type eq "expose" ) {
        return 0;
    }

Gtk2->main_iteration while Gtk2->events_pending;      
return 1;

}
[download]