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