|
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 |