#!/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(" "); $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_value,"\n"; if (defined $x) { my $sx = sprintf("%.0f", $cur_xscr_setting + $x); my $sy = sprintf("%.0f", $cur_yscr_setting + $y); $status->set_markup( "X: $sx Y: $sy " ); } else { $status->set_markup(" "); } }); $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' ); } }