1=pod
2
3=head1 NAME
4
5examples/iv.pl - A image viewer program
6
7=head1 FEATURES
8
9Demonstrates usage of Prima image subsystem, in particular:
10
11=over 4
12
13=item *
14
15Standard open dialog. Note it's behavior with the multi-frame images.
16
17=item *
18
19Standard save dialog. Note the graphic filters usage.
20
21=item *
22
23Image conversion routines.
24
25=item *
26
27Standard L<Prima::ImageViewer> class.
28
29=back
30
31Test the correct implementation of the internal image paint routines,
32in particular on the paletted displays and the representation of 1-bit
33images/icons with non-BW palette.
34
35Note the mouse wheel interaction.
36
37=cut
38
39use strict;
40use warnings;
41use Prima qw(ImageViewer Dialog::ImageDialog MsgBox);
42use Prima::Application name => "IV";
43
44my $ico = Prima::Icon-> create;
45$ico = 0 unless $ico-> load( 'hand.gif');
46
47
48my $winCount  = 1;
49
50my %iv_prf = (
51	origin => [ 0, 0],
52	growMode => gm::Client,
53	quality => 1,
54	name    => 'IV',
55	valignment  => ta::Middle,
56	alignment   => ta::Center,
57	onMouseDown => \&iv_mousedown,
58	onMouseUp   => \&iv_mouseup,
59	onMouseMove => \&iv_mousemove,
60	onMouseWheel => \&iv_mousewheel,
61);
62
63sub status
64{
65	my $iv = $_[0]-> IV;
66	my $img = $iv-> image;
67	my $str;
68	if ( $img) {
69		$str = $iv-> {fileName};
70		$str =~ s/([^\\\/]*)$/$1/;
71		$str = sprintf("%s (%dx%dx%d bpp)", $1,
72			$img-> width, $img-> height, $img-> type & im::BPP);
73	} else {
74		$str = '.Untitled';
75	}
76	$_[0]-> text( $str);
77	$::application-> name( $str);
78}
79
80
81sub menuadd
82{
83	unless ( $_[0]-> IV-> {menuadded}) {
84		$_[0]-> {omenuID} = 'P';
85		$_[0]-> {conversion} = ict::Optimized;
86		$_[0]-> menu-> insert(
87		[
88			[ 'Reopen' => 'Ctrl+R' => '^R'       => \&freopen],
89			[ '~New window...' => 'Ctrl+N' => '^N'       => \&fnewopen],
90			[],
91			[ '~Save'  => 'F2'     => 'F2'       => \&fsave],
92			[ 'Save As...'                       => \&fsaveas],
93		],
94		'file', 1
95		);
96		$_[0]-> menu-> insert(
97			[
98			['~Edit' => [
99				['~Copy' => 'Ctrl+Ins' => km::Ctrl|kb::Insert , sub {
100					$::application-> Clipboard-> image($_[0]-> IV-> image)
101				}],
102				['~Paste' => 'Shift+Ins' => km::Shift|kb::Insert , sub {
103					my $i = $::application-> Clipboard-> image;
104					$_[0]-> IV-> image( $i) if $i;
105					status($_[0]);
106				}],
107			]],
108			['~Image' => [
109				[ '~Convert to'=> [
110					['~Monochrome' => sub {icvt($_[0],im::Mono)}],
111					['~16 colors' => sub {icvt($_[0],im::bpp4)}],
112					['~256 colors' => sub {icvt($_[0],im::bpp8)}],
113					['~Grayscale' => sub {icvt($_[0],im::bpp8|im::GrayScale)}],
114					['~RGB' => sub {icvt($_[0],im::RGB)}],
115					['~Long' => sub {icvt($_[0],im::Long)}],
116					[],
117					['(N' => '~No halftoning' => sub {setconv(@_)}],
118					['O' => '~Ordered' => sub {setconv(@_)}],
119					['E' => '~Error diffusion' => sub {setconv(@_)}],
120					[')*P' => 'O~ptimized' => sub {setconv(@_)}],
121				]],
122				['~Zoom' => [
123					['~Normal ( 100%)' => 'Ctrl+Z' => '^Z' => sub{$_[0]-> IV-> zoom(1.0)}],
124					['~Best fit' => 'Ctrl+Shift+Z' => km::Shift|km::Ctrl|ord('z') => sub { $_[0]->IV->apply_auto_zoom } ],
125					[],
126					['@abfit' => '~Auto best fit' => sub{ $_[0]->IV->autoZoom($_[2]) }],
127					[],
128					['25%' => sub{$_[0]-> IV-> zoom(0.25)}],
129					['50%' => sub{$_[0]-> IV-> zoom(0.5)}],
130					['75%' => sub{$_[0]-> IV-> zoom(0.75)}],
131					['150%' => sub{$_[0]-> IV-> zoom(1.5)}],
132					['200%' => sub{$_[0]-> IV-> zoom(2)}],
133					['300%' => sub{$_[0]-> IV-> zoom(3)}],
134					['400%' => sub{$_[0]-> IV-> zoom(4)}],
135					['600%' => sub{$_[0]-> IV-> zoom(6)}],
136					['1600%' => sub{$_[0]-> IV-> zoom(16)}],
137					[],
138					['~Increase' => '+' => '+' => sub{$_[0]-> IV-> zoom( $_[0]-> IV-> zoom * 1.1)}],
139					['~Decrease' => '-' => '-' => sub{$_[0]-> IV-> zoom( $_[0]-> IV-> zoom / 1.1)}],
140				]],
141				['~Info' => 'Alt+F1' => '@F1' => \&iinfo],
142			]],
143			],
144			'', 1,
145		);
146		$_[0]-> IV-> {menuadded}++;
147	}
148}
149
150my $imgdlg;
151sub create_image_dialog
152{
153	return $imgdlg if $imgdlg;
154	$imgdlg  = Prima::Dialog::ImageOpenDialog-> create();
155}
156
157sub fdopen
158{
159	my $self = $_[0]-> IV;
160
161	my $dlg = create_image_dialog( $self);
162	my $i   = $dlg-> load( progressViewer => $self);
163
164	if ( $i) {
165		menuadd( $_[0]);
166		$self-> image( $i);
167		$self-> {fileName} = $dlg-> fileName;
168		status( $_[0]);
169	}
170}
171
172sub freopen
173{
174	my $self = $_[0]-> IV;
175	my $i = Prima::Image-> new;
176	$self-> watch_load_progress( $i);
177	if ( $i-> load( $self-> {fileName}, loadExtras => 1)) {
178		$self-> image( $i);
179		status( $_[0]);
180		message( $i->{extras}->{truncated} ) if defined $i->{extras}->{truncated};
181	} else {
182		message("Cannot reload ". $self-> {fileName}. ":$@");
183	}
184	$self-> unwatch_load_progress(0);
185}
186
187sub newwindow
188{
189	my ( $self, $filename, $i) = @_;
190	my $w = Prima::Window-> create(
191		onDestroy => \&iv_destroy,
192		menuItems => $self-> menuItems,
193		onMouseWheel => sub { iv_mousewheel( shift-> IV, @_)},
194		size         => [ $i-> width + 50, $i-> height + 50],
195	);
196	$winCount++;
197	$w-> insert( ImageViewer =>
198		size   => [ $w-> size],
199		%iv_prf,
200	);
201	$w-> IV-> image( $i);
202	$w-> IV-> {fileName} = $filename;
203	$w-> {omenuID} = $self-> {omenuID};
204	$w->IV->{menuadded} = 1;
205	$w->{conversion} = ict::Optimized;
206	$w-> select;
207	status($w);
208}
209
210sub fnewopen
211{
212	my $self = $_[0]-> IV;
213	my $dlg  = create_image_dialog( $self);
214	my $i    = $dlg-> load;
215
216	newwindow( $_[0], $dlg-> fileName, $i) if $i;
217}
218
219
220sub fload
221{
222	my $self = $_[0]-> IV;
223	my $f = $_[1];
224	my $i = Prima::Image-> new;
225	$self-> watch_load_progress( $i);
226
227	if ( $i-> load( $f, loadExtras => 1)) {
228		menuadd( $_[0]);
229		my @sizes = ( $i-> size, map { $_ * 0.9 } $::application-> size);
230		$self-> owner-> size( map {
231			( $sizes[$_] > $sizes[$_ + 2]) ?  $sizes[$_ + 2] : $sizes[$_]
232		} 0,1);
233		$self-> image( $i);
234		$self-> {fileName} = $f;
235		status( $_[0]);
236		message( $i->{extras}->{truncated} ) if defined $i->{extras}->{truncated};
237	} else {
238		message("Cannot load $f:$@");
239	}
240
241	$self-> unwatch_load_progress(0);
242}
243
244
245sub fsave
246{
247	my $iv = $_[0]-> IV;
248	message('Cannot save '.$iv-> {fileName}. ":$@")
249		unless $iv-> image-> save( $iv-> {fileName});
250}
251
252sub fsaveas
253{
254	my $iv = $_[0]-> IV;
255	my $dlg  = Prima::Dialog::ImageSaveDialog-> create( image => $iv-> image);
256	$iv-> {fileName} = $dlg-> fileName if $dlg-> save( $iv-> image);
257	$dlg-> destroy;
258}
259
260sub setconv
261{
262	my ( $self, $menuID) = @_;
263	return if $self-> {omenuID} eq $menuID;
264	$self-> {omenuID}    = $menuID;
265	$self-> {conversion} = (
266	( $menuID eq 'N') ? ict::None : (
267	( $menuID eq 'O') ? ict::Ordered : (
268	( $menuID eq 'E') ? ict::ErrorDiffusion : ict::Optimized
269	))
270	);
271}
272
273sub icvt
274{
275	my $im = $_[0]-> IV-> image;
276	$im-> set(
277		conversion => $_[0]-> {conversion},
278		type       => $_[1],
279	);
280	status( $_[0]);
281	$_[0]-> IV-> palette( $im-> palette);
282	$_[0]-> IV-> repaint;
283}
284
285
286sub iinfo
287{
288	my $i = $_[0]-> IV-> image;
289	message_box(
290		'',
291		"File: ".$_[0]-> IV-> {fileName}."\n".
292		"Width: ".$i-> width."\nHeight: ".$i-> height."\nBPP:".($i-> type&im::BPP)."\n".
293		"Zoom: ".$_[0]-> IV-> zoom,
294		0
295	);
296}
297
298sub iv_mousedown
299{
300	my ( $self, $btn, $mod, $x, $y) = @_;
301	return if $self-> {drag} || $btn != mb::Right;
302	$self-> {drag}=1;
303	$self-> {x} = $x;
304	$self-> {y} = $y;
305	$self-> {wasdx} = $self-> deltaX;
306	$self-> {wasdy} = $self-> deltaY;
307	$self-> capture(1);
308	$self-> pointer( $ico) if $ico;
309}
310
311sub iv_mouseup
312{
313	my ( $self, $btn, $mod, $x, $y) = @_;
314	return unless $self-> {drag} && $btn == mb::Right;
315	$self-> {drag}=0;
316	$self-> capture(0);
317	$self-> pointer( cr::Default) if $ico;
318}
319
320sub iv_mousemove
321{
322	my ( $self, $mod, $x, $y) = @_;
323	return unless $self-> {drag};
324	my ($dx,$dy) = ($x - $self-> {x}, $y - $self-> {y});
325	$self-> deltas( $self-> {wasdx} - $dx, $self-> {wasdy} + $dy);
326}
327
328sub iv_mousewheel
329{
330	my ( $self, $mod, $x, $y, $z) = @_;
331	$z = (abs($z) > 120) ? int($z/120) : (($z > 0) ? 1 : -1);
332	my $xv = $self-> bring(($mod & km::Shift) ? 'VScroll' : 'HScroll');
333	return unless $xv;
334	$z *= ($mod & km::Ctrl) ? $xv-> pageStep : $xv-> step;
335	if ( $mod & km::Shift) {
336		$self-> deltaX( $self-> deltaX - $z);
337	} else {
338		$self-> deltaY( $self-> deltaY - $z);
339	}
340}
341
342
343sub iv_destroy
344{
345	$winCount--;
346	$::application-> close unless $winCount;
347}
348
349my $w = Prima::Window-> create(
350	size => [ 300, 300],
351	onDestroy => \&iv_destroy,
352	onMouseWheel => sub { iv_mousewheel( shift-> IV, @_)},
353	menuItems => [
354	[ file => '~File' => [
355		[ '~Open' =>  'F3'     => kb::F3     , \&fdopen],
356		[],
357		[ 'E~xit' => 'Alt+X' => '@X' => sub {$::application-> close}],
358	]],
359	],
360);
361
362$w-> insert( ImageViewer =>
363	size   => [ $w-> size],
364	%iv_prf,
365);
366status($w);
367
368if ( @ARGV && $ARGV[0] =~ /^-z(\d+(\.\d*)?)$/) {
369	$w-> IV-> zoom($1);
370	shift @ARGV;
371}
372fload( $w, $ARGV[0]), shift if @ARGV;
373for ( @ARGV) {
374	my $i = Prima::Image-> load($_);
375	message("Cannot load $_:$@"), next unless $i;
376	newwindow( $w, $_, $i);
377}
378
379run Prima;
380
381
382