Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Goo::Canvas Waypoint marker w zoom/save to svg and pdf

by zentara (Archbishop)
on Jun 04, 2008 at 18:46 UTC ( [id://690211]=sourcecode: print w/replies, xml ) Need Help??
Category: Gui Programming
Author/Contact Info zentara
Description: You can load an image, and make waypoints. Zoom and save to svg or pdf. (I don't know if it's a bug on my system, but it won't save a loaded svg map as svg (the waypoints show up but the svg map is all black), but will save to pdf just fine. Add an image of your choice and uncomment the section for loading it. I just start with a rectangle for this demo. For best results with an image, use a huge image and scale the canvas down after loading it, so the resolution stays good when zooming. I have 1, but it's 3 megs, so I won't base64encode it into the script. :-)
#!/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);
}

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://690211]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (6)
As of 2024-04-23 21:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found