#!/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;
$window->add($vbox);
my $swin = Gtk2::ScrolledWindow->new;
$swin->set_shadow_type('in');
$vbox->pack_start($swin, 1, 1, 0);
my $canvas = Goo::Canvas->new();
$canvas->set_size_request(600, 450);
$canvas->set_bounds(0, 0, 1000, 1000);
$swin->add($canvas);
my $root = $canvas->get_root_item();
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, "Hello World", 300, 300, -1, 'center',
'font' => 'Sans 24',
);
$text->rotate(45, 300, 300);
# Create PNG
+
my $sb = Gtk2::Button->new_with_label('Write PNG and JPG');
+
$vbox->pack_start($sb, FALSE, FALSE, 0);
+
$sb->show;
+
$sb->signal_connect("clicked", \&write_png_clicked, $canvas);
+
$window->show_all();
Gtk2->main;
sub write_png_clicked {
my ($but, $canvas) = @_;
print "Write PNG...\n";
my $surface = Cairo::ImageSurface->create ('rgb24', 1000, 1000);
# also argb32 is available
# my $surface = Cairo::ImageSurface->create ('argb32', 1000, 1000);
my $cr = Cairo::Context->create($surface);
# make a background rectangle filled white so saved file looks same
+as screen
# otherwise a black background may appear, it's like pdf, if it isn'
+t
# drawn , it will be a black background, It won't automagically pick
+ up
# a white background on a canvas
$cr->rectangle( 0, 0, 1000, 1000 );
$cr->set_source_rgb( 1, 1, 1 );
$cr->fill;
$canvas->render($cr, undef, 1);
# this works, but see below for way to use pixbuf and jpg
# my $status = $surface->write_to_png ("$0.png");
# print "$status\n";
my $loader = Gtk2::Gdk::PixbufLoader->new;
$surface->write_to_png_stream (sub {
my ($closure, $data) = @_;
$loader->write($data);
});
$loader->close;
my $pixbuf = $loader->get_pixbuf;
print $pixbuf->get_bits_per_sample(),"\n";
print $pixbuf->get_colorspace(),"\n";
$pixbuf->save ("$0.png", 'png');
print "done png\n";
$pixbuf->save ("$0.jpg", 'jpeg', quality => 100);
print "done jpg\n";
return TRUE;
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.