← Back to branch summary

~ubuntu-branches/ubuntu/lucid/pdl/lucid

« back to all changes in this revision

Viewing changes to t/picrgb.pl

  • Committer: Bazaar Package Importer
  • Author(s): Ben Gertzfield
  • Date: 2002-04-08 18:47:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020408184716-0hf64dc96kin3htp
Tags: upstream-2.3.2
Import upstream version 2.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/picrgb.pl
 
1
# we need tests with index shuffling once vaffines are fixed
 
2
 
 
3
sub ok {
 
4
        my $no = shift ;
 
5
        my $result = shift ;
 
6
        print "not " unless $result ;
 
7
        print "ok $no\n" ;
 
8
}
 
9
 
 
10
sub approx {
 
11
        my($a,$b,$mdiff) = @_;
 
12
        $mdiff = 0.01 unless defined($mdiff);
 
13
        $c = abs($a-$b);
 
14
        $d = max($c);
 
15
        $d < $mdiff;
 
16
}
 
17
 
 
18
sub rpic_unlink {
 
19
  my $file = shift;
 
20
  my $pdl = rpic($file);
 
21
  unlink $file;
 
22
  return $pdl;
 
23
}
 
24
 
 
25
use PDL;
 
26
use PDL::IO::Pic;
 
27
use PDL::Dbg;
 
28
 
 
29
# private fix
 
30
$ENV{PATH} .= ":$ENV{HOME}/perl/netpbm/bin" if `hostname` =~ /mbcsg1/;
 
31
$PDL::debug = 0;
 
32
$PDL::Debug = 0;
 
33
$iform = 'PNMRAW'; # change to PNMASCII to use ASCII PNM intermediate
 
34
                   # output format
 
35
 
 
36
#              [FORMAT, extension, ushort-divisor,
 
37
#               only RGB/no RGB/any (1/-1/0), mxdiff]
 
38
#  no test of PCX format because seems to be severely brain damaged
 
39
@formats = (['PNM','pnm',1,0,0.01],['GIF','gif',256,0,1.01],
 
40
               ['TIFF','tif',1,0,0.01],['Sun Raster','rast',256,0,0.01],
 
41
               ['IFF','iff',256,1,0.01],['SGI','rgb',1,1,0.01]);
 
42
 
 
43
$ntests = 2 * @formats;
 
44
print("1..$ntests\n");
 
45
 
 
46
$im1 = ushort pdl [[[0,0,0],[256,65535,256],[0,0,0]],
 
47
                   [[256,256,256],[256,256,256],[256,256,256]],
 
48
                   [[2560,65535,2560],[256,2560,2560],[65535,65534,65535]]];
 
49
$im2 = byte ($im1/256);
 
50
 
 
51
if ($PDL::debug){
 
52
   print $im1;
 
53
   print $im2;
 
54
}
 
55
 
 
56
$n = 1;
 
57
foreach $form (@formats) {
 
58
    print " ** testing $form->[0] format **\n";
 
59
 
 
60
    wpic ($im1,"tushort.$form->[1]",{IFORM => $iform});
 
61
    wpic ($im2,"tbyte.$form->[1]",{IFORM => $iform});
 
62
 
 
63
    $in1 = rpic_unlink("tushort.$form->[1]");
 
64
    $in2 = rpic_unlink("tbyte.$form->[1]");
 
65
 
 
66
    $comp = $im1 / $form->[2];
 
67
    ok($n++,approx($comp,$in1,$form->[4]));
 
68
    ok($n++,approx($im2,$in2));
 
69
 
 
70
    if ($PDL::debug) {
 
71
      print $in1->px;
 
72
      print $in2->px;
 
73
    }
 
74
}