=pod

=head1 NAME

examples/eyes.pl - An eyes program clone

=head1 FEATURES

A well-known eyes written in Prima toolkit.
Demostrates the usage of a shape-extension and a
determination of its support on a system.

Note the menu hide feature - it's activation (^M)
tests a correct implementation of a Prima
shape-extension interface.

=cut

use strict;
use warnings;
use Prima;
use Prima::Application name => 'Eyes';


my $eye  = 0.45;
my $ball = 0.06;

my $revcolors = 0;
my $canshape  = $::application-> get_system_value( sv::ShapeExtension);

sub reshape
{
	my $x = $_[0];
	my @sz = $x-> size;
	my $nope = $sz[0] < 5 || $sz[1] < 5;
	for (0,1) {
	$sz[$_] = 5 if $sz[$_] < 5;
	}
	my $i = Prima::Image-> create(
		width  => $sz[0],
		height => $sz[1],
		type   => im::BW,
	);
	$i-> begin_paint;
	$i-> color( cl::White);
	$i-> backColor( cl::Black);
	$i-> clear;
	my $minSz = ( $sz[0] < $sz[1]) ? $sz[0] : $sz[1];
	my @eye = ( $sz[0] * $eye, $sz[1] * $eye * 2);
	$i-> lineWidth(( $minSz < 220) ? $minSz / 20 : 11);
	$i-> ellipse( $sz[0] * 0.25, $sz[1]/2, @eye);
	$i-> fill_ellipse( $sz[0]*0.25, $sz[1]/2, @eye);
	$i-> ellipse( $sz[0]*0.75, $sz[1]/2, @eye);
	$i-> fill_ellipse( $sz[0]*0.75, $sz[1]/2, @eye);
	$i-> end_paint;
	$x-> shape( $i) unless $nope;
	return $i;
}

my $m;

my $x = Prima::MainWindow-> create(
	visible  => 0,
	buffered  => 1,
	color     => cl::Black,
	backColor => cl::White,
	menuItems => [
		['~Options' => [
			["~Reverse colors" => sub {
				my ( $self, $mit) = @_;
				$revcolors = $revcolors ? 0 : 1;
				$self-> menu-> text( $mit,
					$revcolors ? "~Normal colors" : "~Reverse colors");
				$self-> color( $revcolors ? cl::White : cl::Black);
				$self-> backColor( $revcolors ? cl::Black : cl::White);
			}],
			['~Remove menu' => 'Ctrl+M' => '^M' => sub {
				if ( $_[0]-> menu) {
					$m = $_[0]-> menu;
					$_[0]-> menu-> selected(0);
				} else {
					$m-> selected(1);
				}
			}],
			[],
			["E~xit" => 'Alt+X' => '@X' => sub { $::application-> close }],
		]],
	],
	size     => [ 200, 300],
	name     => 'Eyes',
	onSize   => sub {
		reshape( $_[0]) if $canshape;
	},
	onPaint  => sub {
		my ( $self, $canvas) = @_;
		my @sz = $self-> size;
		$canvas-> clear;
		my $minSz = ( $sz[0] < $sz[1]) ? $sz[0] : $sz[1];
		$canvas-> lineWidth(( $minSz < 220) ? $minSz / 20 : 11);
		my @cc = ( $sz[0]* 0.25, $sz[1]/2);
		my @eye = ( $sz[0] * $eye, $sz[1] * $eye * 2);
		my @pp = $self-> pointerPos;
		for ( 0..1) {
			$canvas-> translate( @cc);
			$canvas-> ellipse( 0, 0, @eye);
			my @dd = ( $pp[0] - $cc[0], $pp[1] - $cc[1]);
			my $angle = atan2( $dd[1], $dd[0]);
			my ( $sin, $cos) = ( sin($angle), cos( $angle));
			my $h = sqrt(
				($eye[1]*$cos) * ($eye[1]*$cos) +
				($eye[0]*$sin) * ($eye[0]*$sin)
			);
			my @da = ( $eye[0] * $eye[1] * $cos / $h, $eye[0] * $eye[1] * $sin / $h);
			my $dp = sqrt( $dd[0] * $dd[0] + $dd[1] * $dd[1]);
			my $db = sqrt( $da[0] * $da[0] + $da[1] * $da[1]) * 0.36;
			my @e = ( $db < $dp) ? ( $db * $cos, $db * $sin) : @dd;
			$canvas-> fill_ellipse( @e, $sz[0]* $ball, $sz[1]* $ball * 2);
			$cc[0] += $sz[0] / 2;
		}
	},
);

$x-> icon( reshape( $x));

my @pp = $x-> pointerPos;

$x-> insert( Timer =>
	timeout => 100,
	onTick => sub {
		my @pxp = $x-> pointerPos;
		return if $pxp[0] == $pp[0] && $pxp[1] == $pp[1];
		$x-> repaint;
		@pp = @pxp;
	})-> start;
$x-> show;
$x-> select;

run Prima;