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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
# 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 tapprox {
my($a,$b,$mdiff) = @_;
$mdiff = 0.01 unless defined($mdiff);
$c = abs($a-$b);
$d = max($c);
$d < $mdiff;
}
sub rpnm_unlink {
my $file = shift;
my $pdl = rpnm($file);
unlink $file;
return $pdl;
}
use PDL::LiteF;
use PDL::IO::Pnm;
use PDL::Dbg;
$PDL::debug = $PDL::debug = 0;
$PDL::debug = 1 if defined($ARGV[0]) && $ARGV[0] =~ /-v/;
# [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]);
$ntests = 2 * 3 * @formats ;
print("1..$ntests\n");
$im1 = pdl([[0,65535,0], [256,256,256], [65535,256,65535]])->ushort;
$im2 = byte($im1/256);
# make the resulting file at least 12 byte long
# otherwise we run into a problem when reading the magic (Fix!)
$im3 = byte [[0,0,255,255,12,13],[1,4,5,6,11,124],
[100,0,0,0,10,10],[2,1,0,1,0,14],[2,1,0,1,0,14],
[2,1,0,1,0,14]];
if ($PDL::debug) {
print $im1;
$im1->px;
print $im2;
$im2->px;
print $im3>0;
$im3->px;
}
# for some reason the pnmtotiff converter coredumps when trying
# to do the conversion for the ushort data, haven't yet tried to
# figure out why
$n = 1;
for $raw (0,1) {
foreach $form (@formats) {
print " ** testing $form->[0] format **\n";
wpnm ($im1,"tushort.$form->[1]",'PGM',$raw)
unless $form->[0] eq 'TIFF';
wpnm ($im2,"tbyte.$form->[1]",'PGM',$raw);
wpnm ($im3,"tbin.$form->[1]",'PBM',$raw);
$in1 = rpnm_unlink("tushort.$form->[1]") unless $form->[0] eq 'TIFF';
$in2 = rpnm_unlink("tbyte.$form->[1]");
$in3 = rpnm_unlink("tbin.$form->[1]");
if ($form->[0] ne 'TIFF') {
$scale = ($form->[3] ? $im1->dummy(0,3) : $im1);
$comp = $scale / $form->[2];
ok($n++,tapprox($comp,$in1,$form->[4]));
}
$comp = ($form->[3] ? $im2->dummy(0,3) : $im2);
ok($n++,tapprox($comp,$in2));
$comp = ($form->[3] ? ($im3->dummy(0,3)>0)*255 : ($im3 > 0));
$comp = $comp->ushort*65535 if $form->[0] eq 'SGI'; # yet another format quirk
ok($n++,tapprox($comp,$in3));
if ($PDL::debug) {
print $in1->px unless $form->[0] eq 'TIFF';
print $in2->px;
print $in3->px;
}
}
}
|
