http://qs321.pair.com?node_id=712112
Category: GUI Programming
Author/Contact Info zentara of perlmonks
Description: Crosshairs are a professional looking addition to graphic programs.

I recently tried the Gtk2-Ex-Xor module's crosshair on the Gtk2 canvas type items, (Gnome2::Canvas and Goo::Canvas), and thanks to Kevin Ryde (module author), it now works on them. There was some difficulty because crosshairs typically are written on the low-level gdk window, but the canvases, had their own special windows. Anyways, this shows how to add crosshairs to canvas widgets.

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

# thanks to Kevin Ryde (author of Ex-Xor) for figuring
# out how to make it work on Canvas widgets
# needs the latest  Gtk2-Ex-Xor-2.tar.gz to work

# of interest on the Gnome2::Canvas, is that the low level
# gdkwindow is NOT $canvas->window, it's from it's Layout
# my $gdkwindow = $canvas->bin_window; #needed from Gtk2::Layout   
# that is where the crosshairs are written.

# the Goo::Canvas is even trickier, it's low level window
# is gotten from it's $container->get_children();

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

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

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

my $canvas = Gnome2::Canvas->new_aa();
$canvas->set_size_request(600, 450);
$canvas->set_center_scroll_region(0);

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_bg('normal',$black);

$vbox->pack_start ($swin, 1,1,1);
$canvas->set_size_request(600, 450);

my($xbound,$ybound) = (1000,1000);
$canvas->set_scroll_region (0, 0, $xbound, $ybound);
$swin->add($canvas);

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

# 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.5);
my $sb = Gtk2::SpinButton->new($adj, 0, 2);
$adj->signal_connect("value-changed", \&zoom_changed, $canvas);
$sb->set_size_request(60, -1);
$hbox->pack_start($sb, 0, 0, 10);
$sb->show;

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

$cross->signal_connect (moved => sub {
                          my ($cross, $widget, $x, $y) = @_;
       
     my $ha1  = $swin->get_hadjustment;
     my $va1  = $swin->get_vadjustment;
     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";
                                                   
                          if (defined $x) {
                             my $sx = sprintf("%.0f", $cur_xscr_settin
+g + $x);        
                             my $sy = sprintf("%.0f", $cur_yscr_settin
+g + $y);        
               
   $status->set_markup(
     "<span background='black' foreground='green' size='15000'>X: <i> 
+$sx        </i></span><span background='black' foreground='yellow' si
+ze='15000'>Y: <i> $sy </i></span>"
     );
              } else {
                $status->set_markup("<span background = 'black' foregr
+ound= 'green' size='15000'>                            </span>");

                          }
                        });

$canvas->add_events ('button-press-mask');
 $canvas->signal_connect (button_press_event => sub {
                         my ($canvas, $event) = @_;
                          $cross->start ($event);
                       });

# add some circles to test crosshair accuracy
&fill_canvas();

$mw->show_all;
Gtk2->main;
exit 0;

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

sub fill_canvas{
  my $root = $canvas->root();

  for (my $x = 0; $x <= $xbound; $x += 50) {  
     my $y = $x;

    my $item = Gnome2::Canvas::Item->new($root,
      "Gnome2::Canvas::Ellipse",
       x1 => $x-15,
       y1 => $y-15,
       x2 => $x+15,
       y2 => $y+15,
       fill_color_rgba => 0x3cb3f199 ,
       outline_color=> 'blue'
);
  }
}