|
16
|
1 |
#!/usr/bin/perl
|
|
|
2 |
|
|
|
3 |
use strict;
|
|
|
4 |
use warnings;
|
|
|
5 |
|
|
|
6 |
my $script = "falsecolor";
|
|
|
7 |
my $csh = "../orig/falsecolor.csh";
|
|
|
8 |
my $perl = "../bin/falsecolor.perl";
|
|
|
9 |
print "script: $script\n";
|
|
|
10 |
|
|
|
11 |
use File::Temp qw/ tempdir /;
|
|
|
12 |
my $tmpdir = tempdir( CLEANUP => 0 );
|
|
|
13 |
print "temp dir: $tmpdir\n";
|
|
|
14 |
|
|
|
15 |
my $img = "data/images/street-rgbe_rle_400x400.hdr";
|
|
|
16 |
|
|
|
17 |
my @options = (
|
|
|
18 |
"-ip $img",
|
|
|
19 |
"-ip $img -l cd/m2", # Label now defaults to cd/m2, not nits.
|
|
|
20 |
"-i $img -p $img -l cd/m2",
|
|
|
21 |
"-ip $img -cl -l cd/m2",
|
|
|
22 |
"-ip $img -n 10 -l cd/m2",
|
|
|
23 |
"-ip $img -s 2000 -l cd/m2",
|
|
|
24 |
"-ip $img -lw 200 -lh 300 -l cd/m2", # scale is slightly higher now.
|
|
|
25 |
);
|
|
|
26 |
|
|
|
27 |
# Run old CSH and new Perl script with different options,
|
|
|
28 |
# compare the resulting images.
|
|
|
29 |
my $index = 0;
|
|
|
30 |
my $opt;
|
|
|
31 |
foreach $opt (@options) {
|
|
|
32 |
my $cshout = "$tmpdir/${script}_csh$index.hdr";
|
|
|
33 |
my $cshcmd = "$script.csh $opt > $cshout";
|
|
|
34 |
print " $cshcmd\n";
|
|
|
35 |
system "csh ../orig/$cshcmd";
|
|
|
36 |
|
|
|
37 |
my $perlout = "$tmpdir/${script}_perl$index.hdr";
|
|
|
38 |
my $perlcmd = "$script.pl $opt > $perlout";
|
|
|
39 |
print " $perlcmd\n";
|
|
|
40 |
system "perl ../bin/$perlcmd";
|
|
|
41 |
|
|
|
42 |
my $diffimg = "$tmpdir/${script}_diff$index.hdr";
|
|
|
43 |
my $uval = &compare_images("$cshout", "$perlout", "$diffimg");
|
|
|
44 |
if( $uval > 0 ) {
|
|
|
45 |
print " Error: Diff image $diffimg contains $uval unique values (should be one).\n";
|
|
|
46 |
system "ximage $diffimg";
|
|
|
47 |
} else {
|
|
|
48 |
print " Ok: Images $cshout and $perlout are identical.\n";
|
|
|
49 |
}
|
|
|
50 |
}
|
|
|
51 |
print "temp dir $tmpdir not removed. Please remove manually.\n";
|
|
|
52 |
|
|
|
53 |
sub compare_images() {
|
|
|
54 |
my $in1 = shift;
|
|
|
55 |
my $in2 = shift;
|
|
|
56 |
my $out = shift;
|
|
|
57 |
|
|
|
58 |
my $cmd = "pcomb $in1 -s -1 $in2 > $out";
|
|
|
59 |
print " $cmd\n";
|
|
|
60 |
system "$cmd";
|
|
|
61 |
my $unique = `pvalue -h -H -d -u $out`;
|
|
|
62 |
my $unique_cnt = scalar( split( '\n', $unique ) );
|
|
|
63 |
|
|
|
64 |
return $unique_cnt;
|
|
|
65 |
}
|
|
|
66 |
|
|
|
67 |
#EOF
|