Prima::ImageViewer - standard image, icon, and bitmap viewer class.

#
#  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.
#
#  Created by:
#     Anton Berezin  <tobez@tobez.org>
#     Dmitry Karasik <dk@plab.ku.dk> 
#
#  $Id$
#
use strict;
use Prima::ScrollWidget;

package Prima::ImageViewer;
use vars qw(@ISA);
@ISA = qw( Prima::ScrollWidget);

sub profile_default
{
	my $def = $_[0]-> SUPER::profile_default;
	my %prf = (
		image        => undef,
		imageFile    => undef,
		zoom         => 1,
		zoomPrecision=> 100,
		alignment    => ta::Left,
		valignment   => ta::Bottom,
		quality      => 1,
	);
	@$def{keys %prf} = values %prf;
	return $def;
}

sub profile_check_in
{
	my ( $self, $p, $default) = @_;
	$self-> SUPER::profile_check_in( $p, $default);
	if ( defined $p-> {imageFile} && !defined $p-> {image})
	{
		$p-> {image} = Prima::Image-> create;
		delete $p-> {image} unless $p-> {image}-> load($p-> {imageFile});
	}
}


sub init
{
	my $self = shift;
	for ( qw( image ImageFile))
		{ $self-> {$_} = undef; }
	for ( qw( alignment quality valignment imageX imageY))
		{ $self-> {$_} = 0; }
	for ( qw( zoom integralScreen integralImage))
		{ $self-> {$_} = 1; }
	$self-> {zoomPrecision} = 10;
	my %profile = $self-> SUPER::init(@_);
	$self-> { imageFile}     = $profile{ imageFile};
	for ( qw( image zoomPrecision zoom alignment valignment quality)) {
		$self-> $_($profile{$_});
	}
	return %profile;
}


sub on_paint
{
	my ( $self, $canvas) = @_;
	my @size   = $self-> size;
	my $bw     = $self-> {borderWidth};

	unless ( $self-> {image}) {
		$canvas-> rect3d( 
			0, 0, $size[0]-1, $size[1]-1, $bw, 
			$self-> dark3DColor, $self-> light3DColor, $self-> backColor
		);
		return 1;
	}

	$canvas-> rect3d( 
		0, 0, $size[0]-1, $size[1]-1, $bw, 
		$self-> dark3DColor, $self-> light3DColor
	) if $bw;

	my @r = $self-> get_active_area( 0, @size);
	$canvas-> clipRect( @r);
	$canvas-> translate( @r[0,1]);
	my $imY  = $self-> {imageY};
	my $imX  = $self-> {imageX};
	my $z = $self-> {zoom};
	my $imYz = int($imY * $z);
	my $imXz = int($imX * $z);
	my $winY = $r[3] - $r[1];
	my $winX = $r[2] - $r[0];
	my $deltaY = ($imYz - $winY - $self-> {deltaY} > 0) ? $imYz - $winY - $self-> {deltaY}:0;
	my ($xa,$ya) = ($self-> {alignment}, $self-> {valignment});
	my ($iS, $iI) = ($self-> {integralScreen}, $self-> {integralImage});
	my ( $atx, $aty, $xDest, $yDest);

	if ( $imYz < $winY) {
		if ( $ya == ta::Top) {
			$aty = $winY - $imYz;
		} elsif ( $ya != ta::Bottom) {
			$aty = int(($winY - $imYz)/2 + .5);
		} else {
			$aty = 0;
		}
		$canvas-> clear( 0, 0, $winX-1, $aty-1) if $aty > 0;
		$canvas-> clear( 0, $aty + $imYz, $winX-1, $winY-1) if $aty + $imYz < $winY;
		$yDest = 0;
	} else {
		$aty   = -($deltaY % $iS);
		$yDest = ($deltaY + $aty) / $iS * $iI;
		$imYz = int(($winY - $aty + $iS - 1) / $iS) * $iS;
		$imY = $imYz / $iS * $iI;
	}

	if ( $imXz < $winX) {
		if ( $xa == ta::Right) {
			$atx = $winX - $imXz;
		} elsif ( $xa != ta::Left) {
			$atx = int(($winX - $imXz)/2 + .5);
		} else {
			$atx = 0;
		}
		$canvas-> clear( 0, $aty, $atx - 1, $aty + $imYz - 1) if $atx > 0;
		$canvas-> clear( $atx + $imXz, $aty, $winX - 1, $aty + $imYz - 1) if $atx + $imXz < $winX;
		$xDest = 0;
	} else {
		$atx   = -($self-> {deltaX} % $iS);
		$xDest = ($self-> {deltaX} + $atx) / $iS * $iI;
		$imXz = int(($winX - $atx + $iS - 1) / $iS) * $iS;
		$imX = $imXz / $iS * $iI;
	}

	$canvas-> clear( $atx, $aty, $atx + $imXz, $aty + $imYz) if $self-> {icon};

	return $canvas-> put_image_indirect(
		$self-> {image},
		$atx, $aty,
		$xDest, $yDest,
		$imXz, $imYz, $imX, $imY,
		rop::CopyPut
	);
}

sub on_keydown
{
	my ( $self, $code, $key, $mod) = @_;

	return unless grep { $key == $_ } (
		kb::Left, kb::Right, kb::Down, kb::Up
	);

	my $xstep = int($self-> width  / 5) || 1;
	my $ystep = int($self-> height / 5) || 1;

	my ( $dx, $dy) = $self-> deltas;

	$dx += $xstep if $key == kb::Right;
	$dx -= $xstep if $key == kb::Left;
	$dy += $ystep if $key == kb::Down;
	$dy -= $ystep if $key == kb::Up;

	$self-> deltas( $dx, $dy);
}

sub set_alignment
{
	$_[0]-> {alignment} = $_[1];
	$_[0]-> repaint;
}

sub set_valignment
{
	$_[0]-> {valignment} = $_[1];
	$_[0]-> repaint;
}

my @cubic_palette;

sub set_image
{
	my ( $self, $img) = @_;
	unless ( defined $img) {
		$self-> {imageX} = $self-> {imageY} = 0;
		$self-> limits(0,0);
		$self-> palette([]);
		$self-> repaint if defined $self-> {image};
		$self-> {image} = $img;
		return;
	}

	$self-> {image} = $img;
	my ( $x, $y) = ($img-> width, $img-> height);
	$self-> {imageX} = $x;
	$self-> {imageY} = $y;
	$x *= $self-> {zoom};
	$y *= $self-> {zoom};
	$self-> {icon}   = $img-> isa('Prima::Icon');
	$self-> {bitmap} = $img-> isa('Prima::DeviceBitmap');
	$self-> limits($x,$y);
	if ( $self-> {quality}) {
		my $do_cubic;

		if ( $self-> {bitmap}) {
			$do_cubic = not($img-> monochrome) && $::application-> get_bpp > 8;
		} else {
			$do_cubic = ( $img-> type & im::BPP) > 8;
		}

		if ( $do_cubic) {
			my $depth = $self-> get_bpp;
			if (($depth > 2) && ($depth <= 8)) {
				unless ( scalar @cubic_palette) {
					my ( $r, $g, $b) = (6, 6, 6);
					@cubic_palette = ((0) x 648);
					for ( $b = 0; $b < 6; $b++) {
						for ( $g = 0; $g < 6; $g++) {
							for ( $r = 0; $r < 6; $r++) {
								my $ix = $b + $g * 6 + $r * 36;
								@cubic_palette[ $ix, $ix + 1, $ix + 2] = 
									map {$_*51} ($b,$g,$r); 
				}}}}
				$self-> palette( \@cubic_palette);
			}
		} else {
			$self-> palette( $img-> palette);
		}
	}
	$self-> repaint;
}

sub set_image_file
{
	my ($self,$file,$img) = @_;
	$img = Prima::Image-> create;
	return unless $img-> load($file);
	$self-> {imageFile} = $file;
	$self-> image($img);
}

sub set_quality
{
	my ( $self, $quality) = @_;
	return if $quality == $self-> {quality};
	$self-> {quality} = $quality;
	return unless defined $self-> {image};
	$self-> palette( $quality ? $self-> {image}-> palette : []);
	$self-> repaint;
}

sub zoom_round
{
	my ( $self, $zoom) = @_;
	$zoom = 100 if $zoom > 100;
	$zoom = 0.01 if $zoom <= 0.01;

	my $mul = $self-> {zoomPrecision};
	my $dv = int( $mul * ( $zoom - int( $zoom)) + 0.5);
	$dv-- if ($dv % 2) and ( $dv % 5);
	return int($zoom) + $dv / $mul;
}

sub set_zoom
{
	my ( $self, $zoom) = @_;

	$zoom = 100 if $zoom > 100;
	$zoom = 0.01 if $zoom < 0.01;

	my $mul = $self-> {zoomPrecision};
	my $dv = int( $mul * ( $zoom - int( $zoom)) + 0.5);
	$dv-- if ($dv % 2) and ( $dv % 5);
	$zoom = int($zoom) + $dv / $mul;
	$dv = 0 if $dv >= $mul;
	my ($r,$n,$m) = (1,$mul,$dv);
	while(1) {
		$r = $m % $n;
		last unless $r;
		($m,$n) = ($n,$r);
	}
	return if $zoom == $self-> {zoom};

	$self-> {zoom} = $zoom;
	$self-> {integralScreen} = int( $mul / $n) * int( $zoom) + int( $dv / $n);
	$self-> {integralImage}  = int( $mul / $n);

	return unless defined $self-> {image};
	my ( $x, $y) = ($self-> {image}-> width, $self-> {image}-> height);
	$x *= $self-> {zoom};
	$y *= $self-> {zoom};

	$self-> limits($x,$y);
	$self-> repaint;
	$self-> {hScrollBar}-> set_steps( $zoom, $zoom * 10) if $self-> {hScroll};
	$self-> {vScrollBar}-> set_steps( $zoom, $zoom * 10) if $self-> {vScroll};
}

sub set_zoom_precision
{
	my ( $self, $zp) = @_;

	$zp = 10 if $zp < 10;
	return if $zp == $self-> {zoomPrecision};

	$self-> {zoomPrecision} = $zp;
	$self-> zoom( $self-> {zoom});
}

sub screen2point
{
	my $self = shift;
	my @ret = ();
	my ( $i, $wx, $wy, $z, $dx, $dy, $ha, $va) =
		@{$self}{qw(indents winX winY zoom deltaX deltaY alignment valignment)};

	my $maxy = ( $wy < $self-> {limitY}) ? $self-> {limitY} - $wy : 0;
	unless ( $maxy) {
		if ( $va == ta::Top) {
			$maxy += $self-> {imageY} * $z - $wy;
		} elsif ( $va != ta::Bottom) {
			$maxy += ( $self-> {imageY} * $z - $wy) / 2;
		}
	}
	my $maxx = 0;
	if ( $wx > $self-> {limitX}) {
		if ( $ha == ta::Right) {
			$maxx += $self-> {imageX} * $z - $wx;
		} elsif ( $ha != ta::Left) {
			$maxx += ( $self-> {imageX} * $z - $wx) / 2;
		}
	}

	while ( scalar @_) {
		my ( $x, $y) = ( shift, shift);
		$x += $dx - $$i[0];
		$y += $maxy - $dy - $$i[1];
		$x += $maxx;
		push @ret, $x / $z, $y / $z;
	}
	return @ret;
}

sub point2screen
{
	my $self = shift;
	my @ret = ();
	my ( $i, $wx, $wy, $z, $dx, $dy, $ha, $va) =
		@{$self}{qw(indents winX winY zoom deltaX deltaY alignment valignment)};
	my $maxy = ( $wy < $self-> {limitY}) ? $self-> {limitY} - $wy : 0;
	unless ( $maxy) {
		if ( $va == ta::Top) {
			$maxy += $self-> {imageY} * $z - $wy;
		} elsif ( $va != ta::Bottom) {
			$maxy += ( $self-> {imageY} * $z - $wy) / 2;
		}
	}
	
	my $maxx = 0;
	if ( $wx > $self-> {limitX}) {
		if ( $ha == ta::Right) {
			$maxx += $self-> {imageX} * $z - $wx;
		} elsif ( $ha != ta::Left) {
			$maxx += ( $self-> {imageX} * $z - $wx) / 2;
		}
	}

	while ( scalar @_) {
		my ( $x, $y) = ( $z * shift, $z * shift);
		$x -= $maxx + $self-> {deltaX} - $$i[0];
		$y -= $maxy - $self-> {deltaY} - $$i[1];
		push @ret, $x, $y;
	}
	return @ret;
}

sub alignment    {($#_)?($_[0]-> set_alignment(    $_[1]))               :return $_[0]-> {alignment}    }
sub valignment   {($#_)?($_[0]-> set_valignment(    $_[1]))              :return $_[0]-> {valignment}   }
sub image        {($#_)?$_[0]-> set_image($_[1]):return $_[0]-> {image} }
sub imageFile    {($#_)?$_[0]-> set_image_file($_[1]):return $_[0]-> {imageFile}}
sub zoom         {($#_)?$_[0]-> set_zoom($_[1]):return $_[0]-> {zoom}}
sub zoomPrecision{($#_)?$_[0]-> set_zoom_precision($_[1]):return $_[0]-> {zoomPrecision}}
sub quality      {($#_)?$_[0]-> set_quality($_[1]):return $_[0]-> {quality}}

sub PreviewImage_HeaderReady
{ 
	my ( $self, $image) = @_;
	my $db;
	eval {
		$db = Prima::DeviceBitmap-> new(
			width    => $image-> width,
			height   => $image-> height,
		);
	};
	return unless $db;

	$self-> image($db);
        $self-> image-> backColor(0);
        $self-> image-> clear;
	$self-> {__preview_image} = 1;
}

sub PreviewImage_DataReady
{ 
	my ( $self, $image, $x, $y, $w, $h) = @_;
	return unless $self-> {__preview_image};

	# do not update if DataReady covers the whole image at once
	return if $y == 0 and $h == $image-> height;

	$self-> image-> put_image_indirect( $image, $x, $y, $x, $y, $w, $h, $w, $h, rop::CopyPut);
	my @r = $self-> point2screen( $x, $y, $x + $w, $y + $h);
	$self-> invalidate_rect( @r[0,1], map { int($_ + 1) } @r[2,3] );
	$self-> update_view;
}

sub watch_load_progress
{
	my ( $self, $image) = @_;

	$self-> unwatch_load_progress(0);

	my @ids =
		$image-> add_notification( 'HeaderReady', \&PreviewImage_HeaderReady, $self),
		$image-> add_notification( 'DataReady',   \&PreviewImage_DataReady,   $self)
		;
	$self-> {__watch_notifications} = [ @ids ];
}

sub unwatch_load_progress
{
	my ( $self, $clear_image) = @_;

	return unless $self-> {__watch_notifications};

	if ( $self-> {image}) {
		$self-> {image}-> remove_notification($_) 
			for @{ $self-> {__watch_notifications} };
	}
	delete $self-> {__watch_notifications};

	$clear_image = 1 unless defined $clear_image;
	if ( $self-> {__preview_image}) {
		$self-> image( undef) if $clear_image;
		delete $self-> {__preview_image};
	}
}

1;

__DATA__