#!/usr/bin/perl
use warnings;
use strict;
use Glib qw/TRUE FALSE/;
use Gtk2 -init;
# this improvement adds a static pixmap backing
# to the DrawingArea, but notice what happens when
# you resize the mainwindow or/then save the jpg.
# gtk2 pixmaps (on linux ?) have a current limit
# of short unsigned INT , highest pixels is
# 32767 is (8bit int max) -1
my $xsize = 2400; # maxsize = 32767
my $ysize = 100;
my $pixmap = undef;
my $gc = undef;
my $colormap = undef;
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($pixmap) });
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 Viewable');
$hbox1->pack_start( $button3, FALSE, FALSE, 2);
$button3->signal_connect( clicked => \&save_it);
my $button4 = Gtk2::Button->new('Save All');
$hbox1->pack_start( $button4, FALSE, FALSE, 2);
$button4->signal_connect( clicked => \&save_all);
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
my $vp = Gtk2::Viewport->new (undef,undef);
$scwin->add($vp);
$hbox->pack_start($scwin,1,1,0);
# Create the drawing area.
my $area = new Gtk2::DrawingArea; #don't confuse with Gtk2::Drawable
$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);
# Signals used to handle backing pixmap
$window->show_all;
# must be done after $window is visible
# manually add the pixmap as a 1 time addition
# notice what happens when you resize the mainwindow
$pixmap = Gtk2::Gdk::Pixmap->new(
$area->window,
$area->allocation->width,
$area->allocation->height, -1
);
$pixmap->draw_rectangle(
$area->style->white_gc, # or black_gc
TRUE,
0, 0,
$area->allocation->width,
$area->allocation->height
);
$gc = Gtk2::Gdk::GC->new( $pixmap );
$colormap = $pixmap->get_colormap;
# set a default foreground
$gc->set_foreground( get_color( $colormap, 'red' ) );
$area->window->set_back_pixmap ($pixmap,0);
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->get_colormap;
my $gc = $widget->{gc} || new Gtk2::Gdk::GC $widget;
$gc->set_foreground(get_color($colormap, $color));
$widget->draw_line($gc, @$line);
}
##########################################
sub draw_rect {
my($widget,$coords,$color) = @_;
# see Gdk::Gdk::Window, Gtk2::Gdk::Drawable, Gtk2::Gdk::GC
my $colormap = $widget->get_colormap;
my $gc = $widget->{gc} || new Gtk2::Gdk::GC $widget;
$gc->set_foreground(get_color($colormap, $color));
$widget->draw_rectangle($gc,1, @$coords);
}
#########################################
sub draw_poly {
my($widget,$points,$color) = @_;
# see Gdk::Gdk::Window, Gtk2::Gdk::Drawable, Gtk2::Gdk::GC
my $colormap = $widget->get_colormap;
my $gc = $widget->{gc} || new Gtk2::Gdk::GC $widget;
$gc->set_foreground(get_color($colormap, $color));
$widget->draw_polygon($gc,1, @$points);
}
##########################################
# Draw a line in the expose callback
sub start_drawing {
my $pixmap = shift;
&draw_line($pixmap, [200,30, 30,100], 'blue');
&draw_poly($pixmap, [10,10,20,20,10,30],'green');
&draw_rect($pixmap, [100,100,100,130],'pink');
&draw_ptext($pixmap);
#without this line the screen won't be updated until a screen action
$area->queue_draw;
}
#########################################
sub draw_ptext{
my($widget) = @_;
# see Gdk::Gdk::Window, Gtk2::Gdk::Drawable, Gtk2::Gdk::GC
my $drawable = $widget;
my $gc = new Gtk2::Gdk::GC ($drawable);
my $pango_layout = $area->create_pango_layout("");
my $font_desc = Gtk2::Pango::FontDescription->from_string("Arial Bold 14");
$pango_layout->set_font_description($font_desc);
$pango_layout->set_markup ("Label with Tango Pango
markup");
$drawable->draw_layout($gc,200,100, $pango_layout);
my $ts = time;
$pango_layout->set_markup("Exact time:\n$ts");
$drawable->draw_layout($gc,200,200, $pango_layout);
$ts = time;
$pango_layout->set_markup("Exact time:\n$ts");
$drawable->draw_layout($gc,300,300, $pango_layout);
# test out of view writing
$drawable->draw_layout($gc,2000,300, $pango_layout);
# $area->queue_draw;
}
###########################################
sub button_press_event {
my $widget = shift; # GtkWidget *widget
my $event = shift; # GdkEventButton *event
if ($event->button == 1) {
#draw_brush ($widget, $event->coords);
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;
}
########################################
sub save_all{
my ($width, $height) = $pixmap->get_size();
print "$width $height\n";
# create blank pixbuf to hold the whole pixmap
my $lpixbuf = Gtk2::Gdk::Pixbuf->new ('rgb',
0,
8,
$width,
$height);
$lpixbuf->get_from_drawable ($pixmap,
undef, 0, 0, 0, 0, $width, $height);
#only jpeg and png is supported !!!! it's 'jpeg', not 'jpg'
$lpixbuf->save ("$0-all.jpg", 'jpeg', quality => 100);
return FALSE;
}
#####################################