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