1=pod
2
3=head1 NAME
4
5examples/eyes.pl - An eyes program clone
6
7=head1 FEATURES
8
9A well-known eyes written in Prima toolkit.
10Demostrates the usage of a shape-extension and a
11determination of its support on a system.
12
13Note the menu hide feature - it's activation (^M)
14tests a correct implementation of a Prima
15shape-extension interface.
16
17=cut
18
19use strict;
20use warnings;
21use Prima;
22use Prima::Application name => 'Eyes';
23
24
25my $eye  = 0.45;
26my $ball = 0.06;
27
28my $revcolors = 0;
29my $canshape  = $::application-> get_system_value( sv::ShapeExtension);
30
31sub reshape
32{
33	my $x = $_[0];
34	my @sz = $x-> size;
35	my $nope = $sz[0] < 5 || $sz[1] < 5;
36	for (0,1) {
37	$sz[$_] = 5 if $sz[$_] < 5;
38	}
39	my $i = Prima::Image-> create(
40		width  => $sz[0],
41		height => $sz[1],
42		type   => im::BW,
43	);
44	$i-> begin_paint;
45	$i-> color( cl::White);
46	$i-> backColor( cl::Black);
47	$i-> clear;
48	my $minSz = ( $sz[0] < $sz[1]) ? $sz[0] : $sz[1];
49	my @eye = ( $sz[0] * $eye, $sz[1] * $eye * 2);
50	$i-> lineWidth(( $minSz < 220) ? $minSz / 20 : 11);
51	$i-> ellipse( $sz[0] * 0.25, $sz[1]/2, @eye);
52	$i-> fill_ellipse( $sz[0]*0.25, $sz[1]/2, @eye);
53	$i-> ellipse( $sz[0]*0.75, $sz[1]/2, @eye);
54	$i-> fill_ellipse( $sz[0]*0.75, $sz[1]/2, @eye);
55	$i-> end_paint;
56	$x-> shape( $i) unless $nope;
57	return $i;
58}
59
60my $m;
61
62my $x = Prima::MainWindow-> create(
63	visible  => 0,
64	buffered  => 1,
65	color     => cl::Black,
66	backColor => cl::White,
67	menuItems => [
68		['~Options' => [
69			["~Reverse colors" => sub {
70				my ( $self, $mit) = @_;
71				$revcolors = $revcolors ? 0 : 1;
72				$self-> menu-> text( $mit,
73					$revcolors ? "~Normal colors" : "~Reverse colors");
74				$self-> color( $revcolors ? cl::White : cl::Black);
75				$self-> backColor( $revcolors ? cl::Black : cl::White);
76			}],
77			['~Remove menu' => 'Ctrl+M' => '^M' => sub {
78				if ( $_[0]-> menu) {
79					$m = $_[0]-> menu;
80					$_[0]-> menu-> selected(0);
81				} else {
82					$m-> selected(1);
83				}
84			}],
85			[],
86			["E~xit" => 'Alt+X' => '@X' => sub { $::application-> close }],
87		]],
88	],
89	size     => [ 200, 300],
90	name     => 'Eyes',
91	onSize   => sub {
92		reshape( $_[0]) if $canshape;
93	},
94	onPaint  => sub {
95		my ( $self, $canvas) = @_;
96		my @sz = $self-> size;
97		$canvas-> clear;
98		my $minSz = ( $sz[0] < $sz[1]) ? $sz[0] : $sz[1];
99		$canvas-> lineWidth(( $minSz < 220) ? $minSz / 20 : 11);
100		my @cc = ( $sz[0]* 0.25, $sz[1]/2);
101		my @eye = ( $sz[0] * $eye, $sz[1] * $eye * 2);
102		my @pp = $self-> pointerPos;
103		for ( 0..1) {
104			$canvas-> translate( @cc);
105			$canvas-> ellipse( 0, 0, @eye);
106			my @dd = ( $pp[0] - $cc[0], $pp[1] - $cc[1]);
107			my $angle = atan2( $dd[1], $dd[0]);
108			my ( $sin, $cos) = ( sin($angle), cos( $angle));
109			my $h = sqrt(
110				($eye[1]*$cos) * ($eye[1]*$cos) +
111				($eye[0]*$sin) * ($eye[0]*$sin)
112			);
113			my @da = ( $eye[0] * $eye[1] * $cos / $h, $eye[0] * $eye[1] * $sin / $h);
114			my $dp = sqrt( $dd[0] * $dd[0] + $dd[1] * $dd[1]);
115			my $db = sqrt( $da[0] * $da[0] + $da[1] * $da[1]) * 0.36;
116			my @e = ( $db < $dp) ? ( $db * $cos, $db * $sin) : @dd;
117			$canvas-> fill_ellipse( @e, $sz[0]* $ball, $sz[1]* $ball * 2);
118			$cc[0] += $sz[0] / 2;
119		}
120	},
121);
122
123$x-> icon( reshape( $x));
124
125my @pp = $x-> pointerPos;
126
127$x-> insert( Timer =>
128	timeout => 100,
129	onTick => sub {
130		my @pxp = $x-> pointerPos;
131		return if $pxp[0] == $pp[0] && $pxp[1] == $pp[1];
132		$x-> repaint;
133		@pp = @pxp;
134	})-> start;
135$x-> show;
136$x-> select;
137
138run Prima;
139