The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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