#!/usr/bin/perl -w
use strict;
use warnings;
use Goo::Canvas;
use Gtk2 '-init';
use Glib qw(TRUE FALSE);
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 = 1000;
my $cheight = 1000;
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 test a map
# my $im = Gtk2::Gdk::Pixbuf->new_from_file("usa.png");
# my $w = $im->get_width;
# my $h = $im->get_height;
# my $image = Goo::Canvas::Image->new(
# $root, $im, 0, 0,
# 'width' => $w,
# 'height' => $h);
######################################################
my $rect = Goo::Canvas::Rect->new(
$root, 100, 100, 400, 400,
'line-width' => 10,
'radius-x' => 20,
'radius-y' => 10,
'stroke-color' => 'yellow',
'fill-color' => 'red'
);
my $text = Goo::Canvas::Text->new(
$root, "Start Here", 340, 170, -1, 'center',
'font' => 'Sans 24',
"fill-color" => "midnightblue",
);
#$text->rotate(45, 300, 300);
$canvas->signal_connect('button-press-event',
\&on_can_button_press);
my $way_ref = [ 340, 170,
340, 230,
390, 230,
390, 170 ];
push @$way_ref,200,300; # shows pushing works
#my $points = Goo::Canvas::Points->new([100, 100, 200, 200]);
my $points = Goo::Canvas::Points->new($way_ref);
my $line = Goo::Canvas::Polyline->new(
$root, FALSE,
undef, # points need to be set after creation
'stroke-color' => 'black',
'line-width' => 3,
'start-arrow' => TRUE,
'end-arrow' => TRUE,
'arrow-tip-length' => 3,
'arrow-length' => 4,
'arrow-width' => 3.5
);
# setting after line creation, sets the 'points' property by name
$line->set(points => $points);
# 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 SVG
+
my $sbsvg = Gtk2::Button->new_with_label('Write SVG');
+
$hbox->pack_start($sbsvg, FALSE, FALSE, 0);
+
$sbsvg->show;
+
$sbsvg->signal_connect("clicked", \&write_svg_clicked, $canvas);
+
# 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 on_can_button_press {
my ( $widget, $event ) = @_;
# print $widget ,' ',$event->type,"\n";
my ($x,$y) = ($event->x,$event->y);
print "$x $y\n";
my $scale = $adj->get_value;
print "scale->$scale\n";
my $scaled_x = $scale * $x;
my $scaled_y = $scale * $y;
print 'scaled ',$scaled_x,' ',$scaled_y,"\n";
push @$way_ref,$x/$scale,$y/$scale;
# won't work
#$points->set(points => $way_ref); # Points can't be changed
# need to create a new set
my $points = Goo::Canvas::Points->new($way_ref);
#works
$line->set(points => $points);
return TRUE;
}
sub write_svg_clicked {
my ($but, $canvas) = @_;
print "Write SVG...\n";
my $scale = $adj->get_value;
print "scale->$scale\n";
my $surface = Cairo::SvgSurface->create("$0-$scale.svg",
$scale*$cwidth, $scale*$cheight);
my $cr = Cairo::Context->create($surface);
$cr->set_source_rgb( 1, 1, 1 );
$cr->fill;
$cr->set_source_rgb( 0, 0, 0 );
# needed to save scaled version
$cr->scale($scale, $scale);
#print $canvas->get_bounds,"\n";
$canvas->render($cr, undef, 1);
# $canvas->render ($cr, $bounds, $scale)
$cr->show_page;
print $canvas->get_scale,"\n";
print "done\n";
return TRUE;
}
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);
}
|