#!/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__