The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/local/bin/perl -w
# -*- cperl -*-

#
# Author: Slaven Rezic
#
# Copyright (C) 1998,2005,2013 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: srezic@cpan.org
# WWW:  http://www.rezic.de
#

use strict;
use FindBin;
use lib $FindBin::RealBin;

use Test::More;

use File::Compare;
use File::Temp qw(tempfile);
use Getopt::Long;
use Tk;
use Tk::TIFF;

my $top = eval { Tk::MainWindow->new() };
if (!Tk::Exists($top)) {
    plan skip_all => "Cannot create MainWindow: $@";
    CORE::exit(0);
}

my $interactive;
GetOptions("interactive" => \$interactive)
    or die "usage: $0 [-interactive]";

$top->geometry("400x480+10+10");

# XXX test-2channel.tif - does not work yet
my @tiff_files = qw(test-none.tif test-lzw.tif
		    test-packbits.tif test-float.tif);

plan tests => 29;

SKIP: {
    skip "No MIME::Base64 available for string read test", scalar @tiff_files
	if !eval { require MIME::Base64; 1 };

    for my $tiff_file (@tiff_files) {
	my $tiff_path = "$FindBin::RealBin/$tiff_file";

	open my $fh, $tiff_path
	    or die "Can't open $tiff_path: $!";
	binmode $fh;
	my $buf = do {
	    undef $/;
	    <$fh>;
	};

	my $p =	eval { $top->Photo(-data => MIME::Base64::encode_base64($buf)) };
	ok $p && !$@, "string read of $tiff_file"
	    or diag $@;
    }
}

my @photo_defs;
for my $tiff_file (@tiff_files) {
    my $tiff_path = "$FindBin::RealBin/$tiff_file";
    my $p = eval { $top->Photo(-file => $tiff_path) };
    ok $p && !$@, "file read of $tiff_file"
	or diag $@;
    push @photo_defs, { p => $p, label => $tiff_file }
	if $p;
}

{
    Tk::TIFF::setContrastEnhance(1);
    my $p = eval { $top->Photo(-file => "$FindBin::RealBin/test-float.tif") };
    ok $p && !$@, 'contrast enhanced float tiff'
	or diag $@;
    push @photo_defs, { p => $p, label => 'test-float.tif (contrastEnhance=1)' }
	if $p;
}

{
    $top->packPropagate(0);
    my $image_l = $top->Label->pack(-expand => 1);
    my $label_l = $top->Label->pack(-fill => 'x');
    my $cont;
    if ($interactive) {
	$top->Button(-text => 'Continue',
		     -command => sub { $cont++ },
		    )->pack;
    }
    for my $i (0 .. $#photo_defs) {
	my($p, $label) = @{$photo_defs[$i]}{qw(p label)};
	$image_l->configure(-image => $p);
	$label_l->configure(-text => $label);
	$top->update;
	if ($interactive) {
	    $top->waitVariable(\$cont);
	} else {
	    $top->tk_sleep(0.5);
	}
    }
}

for my $photo_def (@photo_defs) {
    my($p, $label) = @{$photo_def}{qw(p label)};

    my($tmp1fh,$tmp1file) = tempfile(UNLINK => 1, SUFFIX => "_1.tiff")
	or die "Can't create temporary file: $!";
    $p->write($tmp1file);
    ok -s $tmp1file, "tiff file $label written";

    my $p2 = $top->Photo(-file => $tmp1file);
    ok $p2, 'tiff file re-read';

    my($tmp2fh,$tmp2file) = tempfile(UNLINK => 1, SUFFIX => "_2.tiff")
	or die "Can't create temporary file: $!";
    $p2->write($tmp2file);
    ok compare($tmp1file, $tmp2file) == 0, 'Comparison of both files';

    my($tmp3fh, $tmp3file) = tempfile(UNLINK => 1, SUFFIX => "_3.tiff")
	or die "Can't create temporary file: $!";
    $p2->write($tmp3file, '-format' => ['tiff', -compression => 'lzw']);
    ok -s $tmp3file, 'write lzw tiff';
}

# REPO BEGIN
# REPO NAME tk_sleep /home/e/eserte/work/srezic-repository 
# REPO MD5 2fc80d814604255bbd30931e137bafa4

sub Tk::Widget::tk_sleep {
    my($top, $s) = @_;
    my $sleep_dummy = 0;
    $top->after($s*1000,
                sub { $sleep_dummy++ });
    $top->waitVariable(\$sleep_dummy)
	unless $sleep_dummy;
}
# REPO END