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: 81transparency.t,v 1.11 2008/07/23 18:52:18 eserte Exp $
# Author: Slaven Rezic
#

use strict;

use GD;
use GD::Convert;

my $mw0;

BEGIN {
    if (!eval q{
	use Test::More;
        use Tk;
	use Tk::Config;
	die "No DISPLAY" if $win_arch eq 'x' && !$ENV{DISPLAY};
	1;
    }) {
	print "1..0 # skip: no Test::More and/or Tk modules\n";
	CORE::exit;
    }
}

BEGIN {
    if (!eval { $mw0 = MainWindow->new; }) {
	print "1..0 # skip: cannot create main Tk window\n";
	diag($@) if $@;
	CORE::exit;
    }
}

use Getopt::Long;

GetOptions("d!" => \$GD::Convert::DEBUG)
    or die "usage: $0 [-d]";

plan tests => 4;

my $images = 4;

my $mw = $mw0->Frame->pack;
my $c = $mw->Canvas(-width => $images*200, -height => 200,
		    -highlightthickness => 0)->pack;

my $im = new GD::Image 200,200;
my $white = $im->colorAllocate(255,255,255);
my $black = $im->colorAllocate(0,0,0);
my $red = $im->colorAllocate(255,0,0);
my $blue = $im->colorAllocate(0,0,255);
$im->rectangle(0,0,99,99,$black);
$im->arc(50,50,95,75,0,360,$blue);
$im->fill(50,50,$red);
$im->transparent($white);

$c->createLine(0,0,$c->cget(-width),$c->cget(-height),-width=>3,-fill=>"blue");
$c->createLine(0,$c->cget(-height),$c->cget(-width),0,-width=>3,-fill=>"blue");

 SKIP: {
     skip("No ppmtogif available, no gif_netpbm check", 1)
	 if !GD::Convert::_can_gif_netpbm();
     
     skip("No -transparent option with ppmtogif, no transparencyhack", 1)
	 if !GD::Convert::_can_gif_netpbm_transparencyhack();

     my $gif = $im->gif_netpbm(-transparencyhack => 1);
     ok($gif =~ /GIF/, "Detected GIF file");
     if (eval 'require MIME::Base64; 1') {
	 my $p4 = $mw->Photo(-data => MIME::Base64::encode_base64($gif));
	 $c->createImage(0,0,-anchor=>"nw", -image => $p4);
     }
 }

 SKIP: {
     skip("No convert (ImageMagick) available, no gif_imagemagick check", 1)
	 if !GD::Convert::_can_gif_imagemagick();
     
     my $gif2 = $im->gif_imagemagick(-transparencyhack => 1);
     ok($gif2 =~ /GIF/, "Detected GIF file");
     if (eval 'require MIME::Base64; 1') {
	 my $p5 = $mw->Photo(-data => MIME::Base64::encode_base64($gif2));
	 $c->createImage(200,0,-anchor=>"nw", -image => $p5);
     }
 }

my $xpm = $im->xpm;
ok($xpm =~ /XPM/, "Detected XPM file");
my $p6 = $mw->Photo(-data => $xpm);
$c->createImage(400,0,-anchor=>"nw", -image => $p6);

 SKIP: {
     skip("No convert (ImageMagick) available, no gif_imagemagick check", 1)
	 if !GD::Convert::_can_gif_imagemagick();

     my $gif3 = $im->gif_imagemagick;
     ok($gif3 =~ /GIF/, "Detected GIF file");
     if (eval 'require MIME::Base64; 1') {
	 my $p7 = $mw->Photo(-data => MIME::Base64::encode_base64($gif3));
	 $c->createImage(600,0,-anchor=>"nw", -image => $p7);
     }
 }

$mw0->Button(-text => "OK", -command => sub { $mw0->destroy })->pack
    if $ENV{PERL_TEST_INTERACTIVE};

if (!$ENV{PERL_TEST_INTERACTIVE}) { $mw0->after(1000, sub { $mw0->destroy }) }

MainLoop;

__END__