Code:
#!/usr/bin/perl
use warnings;
use strict;
use Glib qw/TRUE FALSE/;
use Gtk2 -init;
# the basic drawing area. It's failing is that
# it is emphemeral... it disappears if scrolled
# out of view, or is obscured then re-exposed,
# as in a minimize - restore window manager event.
# It is simple, and useful for simple non-scrolled
# drawings.
# gtk2 pixmaps (on linux ?) have a current limit
# of short unsigned INT , highest pixels is
# 32767 is (8bit int max) -1
# xsize exagerated for demonstration puposes
my $xsize = 9000; # maxsize = 32767
my $ysize = 100;
my $area;
my %allocated_colors;
my ($x0,$y0,$x1,$y1,$width,) = (0,0,0,0);
# Create the window
my $window = new Gtk2::Window ( "toplevel" );
$window->signal_connect ("delete_event", sub { Gtk2->main_quit; });
$window->set_border_width (10);
$window->set_size_request(640,480);
$window->set_position('center');
my $vbox = Gtk2::VBox->new( 0, 0 );
$window->add($vbox);
$vbox->set_border_width(2);
my $hbox = Gtk2::HBox->new( 0, 0 );
$vbox->pack_start($hbox,1,1,0);
$hbox->set_size_request(320,240);
$hbox->set_border_width(2);
my $hbox1 = Gtk2::HBox->new( 0, 0 );
$vbox->pack_start($hbox1,0,0,0);
$hbox1->set_border_width(2);
my $button1 = Gtk2::Button->new('Draw');
$hbox1->pack_start( $button1, FALSE, FALSE, 2);
$button1->signal_connect( clicked => sub{ start_drawing($area) } );
my $button2 = Gtk2::Button->new('Quit');
$hbox1->pack_start( $button2, FALSE, FALSE, 2);
$button2->signal_connect( clicked => sub{ exit; });
my $button3 = Gtk2::Button->new('Save');
$hbox1->pack_start( $button3, FALSE, FALSE, 2);
$button3->signal_connect( clicked => \&save_it);
my $scwin = Gtk2::ScrolledWindow->new();
my $ha1 = $scwin->get_hadjustment;
$scwin->set_policy('always','never');
# you would think we could add the DrawingArea directing
# to the scrolled window, so we need a viewport
# typical warning
# Gtk-WARNING **: gtk_scrolled_window_add(): cannot add non
# scrollable widget use gtk_scrolled_window_add_with_viewport()
# we create a viewport, so we can identify it by name $vp
my $vp = Gtk2::Viewport->new (undef,undef);
$scwin->add($vp);
$hbox->pack_start($scwin,1,1,0);
# Create the drawing area.
$area = new Gtk2::DrawingArea;
$area->size ($xsize, $ysize);
$vp->add($area);
$area->set_events ([qw/exposure-mask
leave-notify-mask
button-press-mask
pointer-motion-mask
pointer-motion-hint-mask/]);
$area->signal_connect (button_press_event => \&button_press_event);
$window->show_all;
Gtk2->main;
###########################################
sub get_color {
my ($colormap, $name) = @_;
my $ret;
if ($ret = $allocated_colors{$name}) {
return $ret;
}
my $color = Gtk2::Gdk::Color->parse($name);
$colormap->alloc_color($color,TRUE,TRUE);
$allocated_colors{$name} = $color;
return $color;
}
##########################################
sub draw_line {
my($widget,$line,$color) = @_;
# see Gdk::Gdk::Window, Gtk2::Gdk::Drawable, Gtk2::Gdk::GC
my $colormap = $widget->window->get_colormap;
my $gc = $widget->{gc} || new Gtk2::Gdk::GC $widget->window;
$gc->set_foreground(get_color($colormap, $color));
$widget->window->draw_line($gc, @$line);
}
##########################################
# Draw a line in the expose callback
sub start_drawing {
my $area = shift;
&draw_line($area, [200,30, 9000,100], 'blue');
}
###########################################
sub button_press_event {
my $widget = shift; # GtkWidget *widget
my $event = shift; # GdkEventButton *event
if ($event->button == 1) {
print join ' ', $event->coords,"\n";
}
return TRUE;
}
########################################
sub save_it{
my ($width, $height) = $vp->window->get_size();
print "$width $height\n";
# create blank pixbuf to hold the whole viewable area
my $lpixbuf = Gtk2::Gdk::Pixbuf->new ('rgb',
0,
8,
$width,
$height);
$lpixbuf->get_from_drawable ($vp->window,
undef, 0, 0, 0, 0, $width, $height);
#only jpeg and png is supported !!!! it's 'jpeg', not 'jpg'
$lpixbuf->save ("$0-area.jpg", 'jpeg', quality => 100);
return FALSE;
}
########################################
