The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
=pod 

=head1 NAME

examples/grip.pl - Screen and widget grabbing example

=head1 FEATURES

Provided two standalone tests.

The "grip test" copies a graphic content of a widget onto a monochrome
bitmap, thus testing the widget representation on a monochrome display.
This test is useful together with a L<launch> example, that allows execution
of several Prima examples in one task space.

The "grab test" copies the selected region of a screen.
Tests the correct implementation of apc_application_get_bitmap() function,
especially on paletted displays.

=cut

use strict;
use warnings;
use Prima;
use Prima::ImageViewer;
use Prima::Application;
use Prima::RubberBand;
use Prima::Drawable::Subcanvas;

package Generic;

sub xordraw
{
	my ($self, $new_rect) = @_;
	$::application-> rubberband( $new_rect ?
		( rect => [$self-> {capx},$self-> {capy}, $self-> {dx},$self-> {dy}]) :
		( destroy => 1 )
	);
}

my $w = Prima::MainWindow-> create(
	size => [ 200, 200],
	menuItems => [
		[ "~Grip" => sub {
			my $self = $_[0];
			$self-> capture( 1);
			$self-> pointer( cr::Move);
			$self-> { cap} = 1;
		}],
		[ "G~rab" => sub {
			my $self = $_[0];
			$self-> capture( 1);
			$self-> { cap} = 2;
		}],
	],
	onMouseDown => sub {
		my ( $self, $btn, $mod, $x, $y) = @_;
		return unless defined $self-> {cap};
		return unless $self-> {cap} == 2;
		return unless $btn == mb::Left;
		$self-> {cap} = 3;
		($self-> {capx},$self-> {capy}) = $self-> client_to_screen( $x, $y);
		($self-> {dx},$self-> {dy}) = ($self-> {capx},$self-> {capy});
		xordraw( $self, 1);
	},
	onMouseMove => sub {
		my ( $self, $mod, $x, $y) = @_;
		return unless defined $self-> {cap};
		return unless $self-> {cap} == 3;
		my @od = ($self-> {dx},$self-> {dy});
		($self-> {dx},$self-> {dy}) = $self-> client_to_screen( $x, $y);
		xordraw( $self, 1);
	},
	onMouseUp => sub {
		my ( $self, $btn, $mod, $x, $y) = @_;
		return unless defined $self-> { cap};
		my $cap = $self-> { cap};
		$self-> { cap} = undef;
		$self-> capture(0);
		if ( $cap == 1) {
			$self-> pointer( cr::Default);
			my $v = $::application-> get_widget_from_point( $self-> client_to_screen( $x, $y));
			return unless $v;
			$self-> IV-> image( $v->screenshot );
		} elsif ( $cap == 3) {
			($self-> {dx},$self-> {dy}) = $self-> client_to_screen( $x, $y);
			xordraw( $self);
			my ( $xl, $yl) = (abs($self-> {dx} - $self-> {capx}), abs($self-> {dy} - $self-> {capy}));
			$x = $self-> {capx} > $self-> {dx} ? $self-> {dx} : $self-> {capx};
			$y = $self-> {capy} > $self-> {dy} ? $self-> {dy} : $self-> {capy};
			my $i = $::application-> get_image( $x, $y, $xl, $yl);
			$self-> IV-> image( $i);
		}
	},
);

$w-> insert( ImageViewer =>
	pack    => { expand => 1, fill => 'both' },
	name    => 'IV',
	valignment  => ta::Center,
	alignment   => ta::Center,
	quality => 1,
);

print "don't run this by itself, run launch.pl then run grip.pl and some other example. Then 'grip' or 'grap' that other example\n";

run Prima;