aboutsummaryrefslogtreecommitdiff
path: root/Perl/t/Images.t
diff options
context:
space:
mode:
Diffstat (limited to 'Perl/t/Images.t')
-rw-r--r--Perl/t/Images.t212
1 files changed, 0 insertions, 212 deletions
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");
generated by cgit v1.1 at 2024-05-18 17:06:47 +0000