#
#  Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen
#  All rights reserved.
#
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#
#  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
#  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
#  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
#  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
#  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
#  SUCH DAMAGE.
#
#  $Id$
#
=pod 
=item NAME

An eyes program clone

=item 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 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;