#!/usr/bin/perl
use warnings;
use strict;
use Cairo;
use Gtk2 '-init';
use Glib qw(TRUE FALSE);

my ( $width, $height ) = ( 400, 200 );
my $window = Gtk2::Window->new( 'toplevel' );

my $surface  = create_image();

$window->signal_connect( 'delete_event' => sub { Gtk2->main_quit; } );


my $drawable = Gtk2::DrawingArea->new;

$drawable->size( $width, $height );
$drawable->signal_connect(
   'expose_event' => \&on_expose_event,
   $surface
);

$window->add( $drawable );
$window->show_all;
Gtk2->main;

sub create_image {

   my $surface = Cairo::ImageSurface->create( 'argb32', $width, $heigh
+t );
   my $cr = Cairo::Context->create( $surface );

# make a background rectangle filled white
    $cr->rectangle( 0, 0, 400, 400 );
    $cr->set_source_rgb( 1, 1, 1 );
    $cr->fill;

   $cr->set_source_rgb( 0, 0, 0 );
   $cr->select_font_face( "Sans", 'normal', 'normal' );
   $cr->set_font_size( 40.0 );
   $cr->move_to( 10, 50 );
   $cr->show_text( "Disziplin ist Macht." );

   $cr->fill;
   $cr->show_page;
   
   return $surface;
}

sub on_expose_event {
   my ( $widget, $event, $surface ) = @_;
   my $cr = Gtk2::Gdk::Cairo::Context->create( $widget->window );
   $cr->set_source_surface( $surface, 0, 0 );
   $cr->paint;
  
#   $surface->write_to_png ("$0.png");

   $cr->show_page;


# primitive attempts to get png stream

#  my $output='';
#  $surface->write_to_png_stream (sub {
#   my ($closure, $data) = @_;
#   $output .= $data;
#   });

# my $loader = Gtk2::Gdk::PixbufLoader->new;
# $loader->write($output);
# $loader->close;
# my $pixbuf = $loader->get_pixbuf;
#my $img_orig = Gtk2::Image->new_from_pixbuf($pixbuf);    

#A minor style note.  Instead of above:
#You can do this:  #Torsten Schoenfield

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');
$pixbuf->save ("$0.jpg", 'jpeg', quality => 100);
  
   return FALSE;
}

__END__

>
> The perl API is pretty much the same; $imagesurface->get_data() retu
+rns
> you a scalar holding the image data.  If you ensure that the cairo i
+mage
> surface is created in cairo's RGB24 format, you can use the data
> directly with Gtk2::Gdk::Pixbuf like this:
>
>
>      my $width = $surface->get_width;
>      my $height = $surface->get_height;
>      my $stride = $surface->get_stride;
>      my $data = $surface->get_data;
>
>      my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data ($data, 'rgb', FA
+LSE,
> 8, $wudth, $height, $stride);
>
>      my $image = Gtk2::Image->new_from_pixbuf ($pixbuf);
>
Also I try this way, but it seems weird, the window is black.
the document of  gdk_pixbuf_new_from_data says "only RGB images with 8
bits per sample are supported", is it the reason?
Any way, thanks again for the help.


--
Best Regards,
Ye Wenbin
_______________________________________________
gtk-perl-list mailing list
gtk-perl-list@gnome.org
http://mail.gnome.org/mailman/listinfo/gtk-perl-list
[download]

Actually, I'm not playing with GUI. I just want to create a command line program. It still helps, especially this sentence: "Gtk2::Gdk::Pixmap IS a drawable".

I also found that using Cairo only is enough for me, as Cairo has function cairo_image_surface_create_for_data, which allows to create cairo surface from packed scalar. However I have some other problems:

1: I create the scalar using $data .= pack 'CCCC',255,$value,$value,$value; where $value is int from 0 to 255, and Cairo surface is created in argb32 format. I got a picture with good outlook, but all points are in yellow color.

2: When I added all my data to $data and went to create the surface, it caused a segfault. However, if only half data are added to $data, it won't fault. Why?

code segfaults sometimes......Why?

I can't say without seeing some code, and you may be better off asking on the Perl/Gtk2 maillist, but they will want a simple example also.

Try to use the latest version of Cairo, and look at the examples. For example, regarding your yellow problem, the module's /examples/png subdir shows a stars.pl example, which shows setting color by

 $cr->set_source_rgb (0, 0, 0);
[download]

to set the color,

and the perldoc shows 2 ways, 1 with an alpha layer

$cr->set_source_rgb ($red, $green, $blue)
           $red: double
           $green: double
           $blue: double
[download]

for rgb32 you get an alpha layer

 $cr->set_source_rgba ($red, $green, $blue, $alpha)
           $red: double
           $green: double
           $blue: double
           $alpha: double
[download]

Now your setting $data with

$data .= pack 'CCCC',255,$value,$value,$value; where $value is int from 0 to 255

dosn't seem to to be doing what is needed to set the stroke color....you almost appear to have the alpha setting (255) at the wrong end of the list, and additionally I'm not sure pack 'CCCC' is the right pack option.

---

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh