|
8
|
1 |
#!/usr/bin/perl
|
|
|
2 |
#
|
|
|
3 |
# Compute 1976 CIE Lab deltaE* between two Radiance pictures
|
|
|
4 |
#
|
|
|
5 |
# This is a re-write of Greg's pdelta.csh script
|
|
|
6 |
|
|
|
7 |
use strict;
|
|
|
8 |
use warnings;
|
|
|
9 |
use File::Temp qw/ tempdir /;
|
|
|
10 |
|
|
|
11 |
if($#ARGV != 1) {
|
|
|
12 |
print "Usage: $0 pic1.hdr pic2.hdr > output.hdr";
|
|
|
13 |
exit(1);
|
|
|
14 |
}
|
|
|
15 |
|
|
|
16 |
my $cielab = 'sq(x):x*x;';
|
|
|
17 |
$cielab .= 'Ls(Yi):if(Yi/Yw-.01,116*(Yi/Yw)^(1/3)-16,903.3*Yi/Yw);';
|
|
|
18 |
$cielab .= 'as(Xi,Yi,Zi):500*((Xi/Xw)^(1/3)-(Yi/Yw)^(1/3));';
|
|
|
19 |
$cielab .= 'bs(Xi,Yi,Zi):200*((Yi/Yw)^(1/3)-(Zi/Zw)^(1/3));';
|
|
|
20 |
$cielab .= 'dE(X1,Y1,Z1,X2,Y2,Z2):sqrt(sq(Ls(Y1)-Ls(Y2))+sq(as(X1,Y1,Z1)';
|
|
|
21 |
$cielab .= '-as(X2,Y2,Z2))+sq(bs(X1,Y1,Z1)-bs(X2,Y2,Z2)))';
|
|
|
22 |
|
|
|
23 |
# The following is for Radiance RGB -> XYZ
|
|
|
24 |
my $rgb2xyz = 'X(R,G,B):92.03*R+57.98*G+28.99*B;';
|
|
|
25 |
$rgb2xyz .= 'Y(R,G,B):47.45*R+119.9*G+11.6*B;';
|
|
|
26 |
$rgb2xyz .= 'Z(R,G,B):4.31*R+21.99*G+152.7*B';
|
|
|
27 |
|
|
|
28 |
# The following is for sRGB -> XYZ
|
|
|
29 |
my $f1 = "$ARGV[0]";
|
|
|
30 |
my $inp1 = 'x1=ri(1);y1=gi(1);z1=bi(1)';
|
|
|
31 |
my $f2 = "$ARGV[1]";
|
|
|
32 |
my $inp2 = 'x2=ri(2);y2=gi(2);z2=bi(2)';
|
|
|
33 |
|
|
|
34 |
# Make sure both images are in XYZE format
|
|
|
35 |
`getinfo < $f1 | grep '^FORMAT=32-bit_rle_xyze'`;
|
|
|
36 |
# Exit status: 0 if no error (string is found -> image is in XYZE format)
|
|
|
37 |
if( $? != 0 ) {
|
|
|
38 |
$inp1 = 'x1=X(ri(1),gi(1),bi(1));';
|
|
|
39 |
$inp1 .= 'y1=Y(ri(1),gi(1),bi(1));';
|
|
|
40 |
$inp1 .= 'z1=Z(ri(1),gi(1),bi(1))';
|
|
|
41 |
}
|
|
|
42 |
|
|
|
43 |
`getinfo < $f2 | grep '^FORMAT=32-bit_rle_xyze'`;
|
|
|
44 |
if( $? != 0 ) {
|
|
|
45 |
$inp2 = 'x2=X(ri(2),gi(2),bi(2));';
|
|
|
46 |
$inp2 .= 'y2=Y(ri(2),gi(2),bi(2));';
|
|
|
47 |
$inp2 .= 'z2=Z(ri(2),gi(2),bi(2))';
|
|
|
48 |
}
|
|
|
49 |
|
|
|
50 |
my $td = tempdir( CLEANUP => 1 );
|
|
|
51 |
my $tempf = "$td/tf.hdr";
|
|
|
52 |
|
|
|
53 |
system "pfilt -1 -x 128 -y 128 -p 1 $f1 | pvalue -o -h -H -d > $tempf";
|
|
|
54 |
my @wht = split(/\s+/, `total -u $tempf`);
|
|
|
55 |
my $avg = `rcalc -e '\$1=\$2' $tempf | total -m`;
|
|
|
56 |
chomp $avg;
|
|
|
57 |
|
|
|
58 |
my $cmd = "pcomb -e '$cielab' -e '$rgb2xyz' ";
|
|
|
59 |
$cmd .= "-e 'Yw:179*3*$avg; Xw:$wht[0]*Yw/$wht[1]; Zw:$wht[2]*Yw/$wht[1]' ";
|
|
|
60 |
$cmd .= "-e '$inp1' -e '$inp2' -e 'lo=dE(x1,y1,z1,x2,y2,z2)' ";
|
|
|
61 |
$cmd .= "-o $f1 -o $f2";
|
|
|
62 |
|
|
|
63 |
system $cmd;
|
|
|
64 |
|
|
|
65 |
#EOF |