From e6a05dbef707dc10e546ef8fef8fc2a8b7d805bf Mon Sep 17 00:00:00 2001 From: cvs2svn Date: Mon, 24 Jan 2005 15:46:33 +0000 Subject: This commit was manufactured by cvs2svn to create branch 'POSTSCRIPT'. --- Perl/t/Images.t | 212 -------------------------------------------------------- 1 file changed, 212 deletions(-) delete mode 100644 Perl/t/Images.t (limited to 'Perl/t/Images.t') diff --git a/Perl/t/Images.t b/Perl/t/Images.t deleted file mode 100644 index 99111c5..0000000 --- a/Perl/t/Images.t +++ /dev/null @@ -1,212 +0,0 @@ -#!/usr/bin/perl -w - -# -# $Id: Images.t,v 1.5 2004-05-12 12:33:33 mertz Exp $ -# Author: Christophe Mertz -# - -# testing all the -tile, -image, -mask, -fillpattern, -linepattern widget and items options - -# this script can be used with an optionnal argument, an integer giving -# the delay in seconds during which the graphic updates will be displayed -# this is usefull for visual inspection! - -BEGIN { - if (!eval q{ -# use Test::More qw(no_plan); - use Test::More tests => 36; - 1; - }) { - print "# tests only work properly with installed Test::More module\n"; - print "1..1\n"; - print "ok 1\n"; - exit; - } - if (!eval q{ - use Tk::Zinc; - 1; - }) { - print "unable to load Tk::Zinc"; - print "1..1\n"; - print "ok 1\n"; - exit; - } - if (!eval q{ - $mw = MainWindow->new(); - 1; - }) { - print "# tests only work properly when it is possible to create a mainwindow in your env\n"; - print "1..1\n"; - print "ok 1\n"; - exit; - } -} - - -$zinc = $mw->Zinc(-render => 0, - -width => 400, -height => 400)->pack; - -like ($zinc, qr/^Tk::Zinc=HASH/ , "zinc has been created"); - -#### creating different images, bitmaps and pixmaps... -my $photoMickey = $zinc->Photo('mickey.gif', -file => Tk->findINC("demos/images/mickey.gif")); -like ($photoMickey, qr/^Tk::Photo=HASH/ , "creating a Tk::Photo with a .gif"); - -my $bitmap = $zinc->Bitmap('file.xbm', -file => Tk->findINC("file.xbm")); -like ($bitmap, qr/^Tk::Bitmap=HASH/ , "creating a Tk::Bitmap with a .xbm"); - -my $xpm = $zinc->Photo('QuitPB.xpm', -file => Tk->findINC("demos/images/QuitPB.xpm")); -like ($xpm, qr/^Tk::Photo=HASH/ , "creating a Tk::Photo with a .xpm"); - -#### tiling Tk::Zinc -$zinc->configure(-tile => $xpm); -if ($Tk::VERSION < 804) { - is ($zinc->cget(-tile), "QuitPB.xpm", "verifying Tk::Zinc -tile option value"); -} else { - is ($zinc->cget(-tile), $xpm, "verifying Tk::Zinc -tile option value"); -} - -&wait ("-tile of Tk::Zinc with QuitPB.xpm"); - -$zinc->configure(-tile => $photoMickey); -if ($Tk::VERSION < 804) { - is ($zinc->cget(-tile), "mickey.gif", "verifying Tk::Zinc -tile option value"); -} else { - is ($zinc->cget(-tile), $photoMickey, "verifying Tk::Zinc -tile option value"); -} -&wait ("-tile of Tk::Zinc with mickey.gif"); - -# modifying the Tk::Photo to see if the Tk::Zinc -tile changes -$photoMickey->read( Tk->findINC("demos/images/earth.gif") ); -&wait ("-tile of Tk::Zinc should display the earth VISUAL INSPECTION!"); sleep 1; -# going back to the "real" mickey -$photoMickey->read( Tk->findINC("demos/images/mickey.gif") ); -&wait ("-tile of Tk::Zinc should display mickey again VISUAL INSPECTION!"); sleep 1; - -$zinc->configure(-tile => ""); -if ($Tk::VERSION < 804) { - is ($zinc->cget(-tile), "", "removing Tk::Zinc -tile"); -} else { - is ($zinc->cget(-tile), undef, "removing Tk::Zinc -tile"); -} -&wait ("-tile of Tk::Zinc with nothing"); - - - -#### rectangle item -my $rect1 = $zinc->add('rectangle', 1, [10,10,190,190], -filled => 1); - - -$zinc->itemconfigure($rect1, -tile => $xpm); -is ($zinc->itemcget($rect1, -tile), "QuitPB.xpm", "verifying rectangle -tile option value"); -&wait ("-tile of rectangle with QuitPB.xpm"); - -$zinc->itemconfigure($rect1, -tile => $photoMickey); -is ($zinc->itemcget($rect1, -tile), "mickey.gif", "verifying rectangle -tile option value"); -&wait ("-tile of rectangle with mickey"); - -# modifying the Tk::Photo to see if the rectangle -tile changes -$photoMickey->read( Tk->findINC("demos/images/earth.gif") ); -&wait ("-tile of rectangle should display the earth VISUAL INSPECTION!"); sleep 1; -# going back to the "real" mickey -$photoMickey->read( Tk->findINC("demos/images/mickey.gif") ); -&wait ("-tile of rectangle should display mickey again VISUAL INSPECTION!"); sleep 1; - - -$zinc->itemconfigure($rect1, -tile => ""); -is ($zinc->itemcget($rect1, -tile), "", "removing rectangle -tile"); -&wait ("-tile of rectangle with nothing"); - -TODO: { - local $TODO = "because it makes Tk::Zinc dying" if 1; - - # the next line makes Tk::Zinc (v3.29x) dying... so I comment it out the 3 next lines - # $zinc->itemconfigure($rect1, -fillpattern => $bitmap); - # is ($zinc->itemcget($rect1, -fillpattern), $bitmap, "verifying rectangle -fillpattern option value as a Tk::Bitmap"); - # &wait ("displaying a rectangle with -fillpattern as a Tk::Bitmap"); -} - -$zinc->itemconfigure($rect1, -fillpattern => 'AlphaStipple3'); -is ($zinc->itemcget($rect1, -fillpattern), 'AlphaStipple3', "verifying rectangle -fillpattern option value"); -&wait ("-fillpattern of rectangle with 'AlphaStipple3'"); - -$zinc->itemconfigure($rect1, -fillpattern => ""); -is ($zinc->itemcget($rect1, -fillpattern), "", "removing rectangle -fillpattern"); -&wait ("-fillpattern of rectangle with nothing"); - - -$zinc->itemconfigure($rect1, -filled => 0,-linepattern => 'AlphaStipple3', -linecolor => "red"); -is ($zinc->itemcget($rect1, -linepattern), 'AlphaStipple3', "verifying rectangle -linepattern option value"); -&wait ("-linepattern of rectangle with 'AlphaStipple3'"); - -$zinc->itemconfigure($rect1, -linepattern => ""); -is ($zinc->itemcget($rect1, -linepattern), "", "removing rectangle -linepattern"); -&wait ("-linepattern of rectangle with nothing"); - -$zinc->remove($rect1); - -##### icon item -my $icon1 = $zinc->add('icon', 1, -position => [20,100], -image => $photoMickey); -&wait ("displaying an icon"); - -$zinc->remove($icon1); - -my $icon2 = $zinc->add('icon', 1, -position => [40,100]); - -SKIP: { - skip "with Tk::Zinc < 3.295", 4 if ($Tk::Zinc::VERSION < 3.295); - - $zinc->itemconfigure($icon2, -image => $bitmap); - - &wait ("displaying an icon with -image as a Tk::Bitmap"); - is ($zinc->itemcget($icon2, -image), 'file.xbm', "verifying icon -image option value as file.xbm"); - $zinc->itemconfigure($icon2, -image => ""); - - $zinc->itemconfigure($icon2, -image => '@'.Tk->findINC("openfile.xbm")); - is ($zinc->itemcget($icon2, -image), '@'.Tk->findINC("openfile.xbm"),"verifying icon -image option value as @/path/openfile.xbm"); - &wait ("displaying an icon with -image as a \@filename.xbm"); -} -$zinc->remove($icon2); - -my $icon3 = $zinc->add('icon', 1, -position => [60,100], -mask => '@'.Tk->findINC("openfolder.xbm"), - -color => "red"); -is ($zinc->itemcget($icon3, -mask), '@'.Tk->findINC("openfolder.xbm"),"verifying icon -mask option value as \@/path/openfolder.xbm"); -&wait ("displaying an icon with -mask as a \@filename.xbm"); - -$zinc->itemconfigure($icon3, -image => ""); -is ($zinc->itemcget($icon3, -image), "", "removing icon -image"); - -TODO: { - local $TODO = "because it makes Tk::Zinc dying" if 1; - - # the next line makes Tk::Zinc (v3.29x) dying... so I comment it out the 3 next lines - # $zinc->itemconfigure($icon3, -mask => $bitmap); - # is ($zinc->itemcget($icon3, -mask), $bitmap, "verifying icon -mask option value as a Tk::Bitmap"); - # &wait ("displaying an icon with -mask as a Tk::Bitmap"); -} - -$zinc->remove($icon3); - -# We should also test that changing the content of a Tk::Photo should change the display of an icon - - - -sub wait { - $zinc->update; - ok (1, $_[0]); - - my $delay = $ARGV[0]; - if (defined $delay) { - $zinc->update; - if ($delay =~ /^\d+$/) { - sleep $delay; - } else { - sleep 1; - } - } - -} - - - -diag("############## Images test"); -- cgit v1.1