#!/usr/bin/perl -w use strict; use warnings; use Goo::Canvas; use Gtk2 '-init'; use Glib qw(TRUE FALSE); # slower than Gnome2::Canvas with long drags my $draw_flag = 0; my %lines; # way to store multiple continuous lines my $count = 0; my $window = Gtk2::Window->new('toplevel'); $window->signal_connect('delete_event' => sub { Gtk2->main_quit; }); $window->set_default_size(640, 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 = 4000; my $cheight = 2000; my $canvas = Goo::Canvas->new(); $canvas->set_size_request(900, 600); # size on screen $canvas->set_bounds(0, 0, $cwidth, $cheight); # scrollregion $swin->add($canvas); my $root = $canvas->get_root_item(); ##################################################### # if you want to underlay an image my $im = Gtk2::Gdk::Pixbuf->new_from_file("USA.gif"); my $w = $im->get_width; my $h = $im->get_height; my $image = Goo::Canvas::Image->new( $root, $im, 0, 0, 'width' => $w, 'height' => $h); ###################################################### $canvas->signal_connect (event => \&event_handler); # Zoom my $z = Gtk2::Label->new("Zoom:"); $hbox->pack_start($z, FALSE, FALSE, 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, FALSE, FALSE, 10); $sb->show; # Create PDF my $bpdf = Gtk2::Button->new_with_label('Write PDF'); $hbox->pack_start($bpdf, FALSE, FALSE, 0); $bpdf->show; $bpdf->signal_connect("clicked", \&write_pdf_clicked, $canvas); $window->show_all(); Gtk2->main; 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" ) { $draw_flag = 1; #start a new line curve $count++; my ($x,$y) = ($event->x,$event->y); # print "$x $y\n"; $lines{$count}{'points'} = [$x/$scale,$y/$scale,$x/$scale,$y/$scale]; #need at least 2 points my $points = Goo::Canvas::Points->new($lines{$count}{'points'}); $lines{$count}{'line'} = Goo::Canvas::Polyline->new( $root, FALSE, undef, # points need to be set after creation 'stroke-color' => 'black', 'line-width' => 3, ); #setting after line creation, sets the 'points' property by name $lines{$count}{'line'}->set(points => $points); } if ( $event->type eq "button-release" ) { $draw_flag = 0; } if ( $event->type eq "focus-change" ) { return 0; } if ( $event->type eq "expose" ) { return 0; } if($draw_flag){ #left with motion-notify if ( $event->type eq "motion-notify"){ my ($x,$y) = ($event->x,$event->y); # print "$x $y\n"; push @{$lines{$count}{'points'}},$x/$scale,$y/$scale; my $points = Goo::Canvas::Points->new( $lines{$count}{'points'} ); $lines{$count}{'line'}->set(points => $points); } } Gtk2->main_iteration while Gtk2->events_pending; return 1; } sub write_pdf_clicked { my ($but, $canvas) = @_; print "Write PDF...\n"; my $scale = $adj->get_value; print "scale->$scale\n"; my $surface = Cairo::PdfSurface->create("$0-$scale.pdf", $scale*$cwidth, $scale*$cheight); my $cr = Cairo::Context->create($surface); # needed to save scaled version $cr->scale($scale, $scale); $canvas->render($cr, undef, 1); $cr->show_page; print "done\n"; return TRUE; } sub zoom_changed { my ($adj, $canvas) = @_; $canvas->set_scale($adj->get_value); }