#!/usr/bin/perl -w
# Copyright 2008, 2009, 2010 Kevin Ryde
# This file is part of Gtk2-Ex-Xor.
#
# Gtk2-Ex-Xor is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Gtk2-Ex-Xor is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along
# with Gtk2-Ex-Xor. If not, see <http://www.gnu.org/licenses/>.
# Usage: perl lasso-screenshot.pl [outputfile.png]
#
# Draw a sample lasso and write it to the given output file in PNG format.
# The default output file is /tmp/lasso-screenshot.png.
use strict;
use warnings;
use FindBin;
use Gtk2 '-init';
use POSIX;
use Math::Trig qw(:pi
cartesian_to_cylindrical
cylindrical_to_cartesian);
use Gtk2::Ex::Lasso;
use Gtk2::Ex::WidgetBits;
use constant { WIDTH => 200,
HEIGHT => 100,
LX => 40,
LY => 10,
RX => 160,
RY => 70,
};
# PNG spec 11.3.4.2 suggests RFC822 (or rather RFC1123) for CreationTime
use constant STRFTIME_FORMAT_RFC822 => '%a, %d %b %Y %H:%M:%S %z';
my $progname = $FindBin::Script; # basename part
print "progname '$progname'\n";
my $output_filename = (@ARGV >= 1 ? $ARGV[0]
: '/tmp/lasso-screenshot.png');
my $toplevel = Gtk2::Window->new('toplevel');
$toplevel->signal_connect (destroy => sub { Gtk2->main_quit });
my $area = Gtk2::DrawingArea->new;
$toplevel->add ($area);
$area->set_size_request (WIDTH, HEIGHT);
$area->modify_fg ('normal', Gtk2::Gdk::Color->parse ('white'));
$area->modify_bg ('normal', Gtk2::Gdk::Color->parse ('black'));
my $lasso = Gtk2::Ex::Lasso->new (widget => $area,
foreground => 'white',
cursor => 'invisible');
# |\
# | \
# +------+ \
# | + 0,0 at arrow pointy end
# +------| /
# | /
# |/
#
my @points = (0,0,
-8,-7,
-8,-1,
-17,-1,
-17,2,
-8,2,
-8,7,
0,0);
for (my $i = 0; $i < @points; $i += 2) {
($points[$i], $points[$i+1]) = rotate_135 ($points[$i], $points[$i+1]);
$points[$i] += RX;
$points[$i+1] += RY;
}
# return $x,$y rotated by 135 degrees around the origin 0,0
sub rotate_135 {
my ($x, $y) = @_;
my ($rho, $theta, undef) = cartesian_to_cylindrical ($x, $y, 0);
$theta -= 0.75 * Math::Trig::pi();
($x, $y, undef) = cylindrical_to_cartesian ($rho, $theta, 0);
return (round($x), round($y));
}
sub round {
my ($x) = @_;
return POSIX::floor ($x + 0.5);
}
$area->signal_connect
(expose_event => sub {
my ($area, $event) = @_;
my $window = $area->window;
my $gc = $area->get_style->fg_gc ('normal');
$window->draw_polygon ($gc, 1, @points);
return 0; # propagate event
});
my $id;
$area->signal_connect
(expose_event => sub {
Gtk2::Ex::WidgetBits::warp_pointer ($area, LX, LY);
$lasso->start ();
$id = $lasso->signal_connect (moved => \&save);
Gtk2::Ex::WidgetBits::warp_pointer ($area, RX, RY);
return 0; # propagate event
});
sub save {
my $window = $area->window;
my ($width, $height) = $window->get_size;
my $pixbuf = Gtk2::Gdk::Pixbuf->get_from_drawable ($window,
undef, # colormap
0,0, 0,0,
$width, $height);
$pixbuf->save
($output_filename, 'png',
'tEXt::Title' => 'Lasso Screenshot',
'tEXt::Author' => 'Kevin Ryde',
'tEXt::Copyright' => 'Copyright 2008, 2009, 2010 Kevin Ryde',
'tEXt::Creation Time' => POSIX::strftime (STRFTIME_FORMAT_RFC822,
localtime(time)),
'tEXt::Description' => "A sample screenshot of a Gtk2::Ex::Lasso display",
'tEXt::Software' => "Generated by $progname",
'tEXt::Homepage' => 'http://user42.tuxfamily.org/gtk2-ex-xor/index.html',
# must be last or gtk 2.18 botches the text keys
compression => 9,
);
print "wrote $output_filename\n";
$lasso->signal_handler_disconnect ($id);
Glib::Timeout->add (2000, sub {
$lasso->abort ();
Gtk2->main_quit;
return 0; # Glib::SOURCE_REMOVE, stop timer
});
}
$toplevel->show_all;
Gtk2->main;
exit 0