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

#
# $Id: $
# Author: Slaven Rezic
#

use strict;

use Tk;

BEGIN {
    if (!eval q{
	use Test::More;
	1;
    }) {
	print "1..0 # skip: no Test::More module\n";
	exit;
    }
}

BEGIN { plan tests => 7 }

my $mw = MainWindow->new;

$mw->withdraw;
$mw->geometry("+10+10");
$mw->Message(-text => "Set the icon with iconimage and iconphoto")->pack;
my $icon = $mw->Photo(-format => 'gif',
		      -file => Tk->findINC('Xcamel.gif'));
$mw->iconimage($icon);
$mw->deiconify;
$mw->idletasks;
pass("Set iconimage");

tk_sleep(0.5);

SKIP: {
    skip("iconphoto is not implemented for Windows", 1)
	if $Tk::platform eq 'MSWin32';

    my $icon2 = $mw->Photo(-file => Tk->findINC("icon.gif"));
    $mw->withdraw;
    $mw->iconphoto('-default', $icon2);
    $mw->deiconify;

    my $t = $mw->Toplevel;
    $t->geometry("+100+20");
    $t->Message(-text => "This toplevel should also get the same icon")->pack;

    $mw->idletasks;
    pass("Set iconphoto");
}

{
    my($wrapper_id, $menu_height) = $mw->wrapper;
    ok(defined $wrapper_id, "Wrapper Id <$wrapper_id>");
    ok(defined $menu_height, "Menu height <$menu_height>");
}

if (0) { # capture/release not anymore available in Tk???
 SKIP: {
	skip("wmCapture/Release not implemented for Windows", 1)
	    if $Tk::platform eq 'MSWin32';

	my $t2 = $mw->Toplevel;
	$t2->capture;
	$mw->update;
	$mw->after(100);
	$t2->release;
	pass("wm capture/release ok");
    }
}

{
    is($mw->wmTracing, "", "wmTracing");
    $mw->wmTracing(1);
    is($mw->wmTracing, 1);
    $mw->wmTracing(0);
    is($mw->wmTracing, "");
}

$mw->after(1000,[destroy => $mw]);
MainLoop;

sub tk_sleep {
    my($s) = @_;
    my $sleep_dummy = 0;
    $mw->after($s*1000,
	       sub { $sleep_dummy++ });
    $mw->waitVariable(\$sleep_dummy)
	unless $sleep_dummy;
}

__END__