Added the rest of the files
authorAxel Jacobs <axel@jaloxa.eu>
Sun, 10 Apr 2011 19:00:53 +0100
changeset 8 9ed02f081b72
parent 7 f0aa5e41ede2
child 9 4957533b96f7
Added the rest of the files
bin/pdelta.pl
bin/phisto.pl
bin/raddepend.pl
bin/ran2tiff.pl
bin/rlux.pl
bin/xyzimage.pl
man/man1/xyzimage.1
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/pdelta.pl	Sun Apr 10 19:00:53 2011 +0100
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+#
+# Compute 1976 CIE Lab deltaE* between two Radiance pictures
+#
+# This is a re-write of Greg's pdelta.csh script
+
+use strict;
+use warnings;
+use File::Temp qw/ tempdir /;
+
+if($#ARGV != 1) {
+	print "Usage: $0 pic1.hdr pic2.hdr > output.hdr";
+	exit(1);
+}
+
+my $cielab = 'sq(x):x*x;';
+$cielab .= 'Ls(Yi):if(Yi/Yw-.01,116*(Yi/Yw)^(1/3)-16,903.3*Yi/Yw);';
+$cielab .= 'as(Xi,Yi,Zi):500*((Xi/Xw)^(1/3)-(Yi/Yw)^(1/3));';
+$cielab .= 'bs(Xi,Yi,Zi):200*((Yi/Yw)^(1/3)-(Zi/Zw)^(1/3));';
+$cielab .= 'dE(X1,Y1,Z1,X2,Y2,Z2):sqrt(sq(Ls(Y1)-Ls(Y2))+sq(as(X1,Y1,Z1)';
+$cielab .= '-as(X2,Y2,Z2))+sq(bs(X1,Y1,Z1)-bs(X2,Y2,Z2)))';
+
+# The following is for Radiance RGB -> XYZ
+my $rgb2xyz = 'X(R,G,B):92.03*R+57.98*G+28.99*B;';
+$rgb2xyz .= 'Y(R,G,B):47.45*R+119.9*G+11.6*B;';
+$rgb2xyz .= 'Z(R,G,B):4.31*R+21.99*G+152.7*B';
+
+# The following is for sRGB -> XYZ
+my $f1 = "$ARGV[0]";
+my $inp1 = 'x1=ri(1);y1=gi(1);z1=bi(1)';
+my $f2 = "$ARGV[1]";
+my $inp2 = 'x2=ri(2);y2=gi(2);z2=bi(2)';
+
+# Make sure both images are in XYZE format
+`getinfo < $f1 | grep '^FORMAT=32-bit_rle_xyze'`;
+# Exit status: 0 if no error (string is found -> image is in XYZE format)
+if( $? != 0 ) {
+	$inp1 = 'x1=X(ri(1),gi(1),bi(1));';
+	$inp1 .= 'y1=Y(ri(1),gi(1),bi(1));';
+	$inp1 .= 'z1=Z(ri(1),gi(1),bi(1))';
+}
+
+`getinfo < $f2 | grep '^FORMAT=32-bit_rle_xyze'`;
+if( $? != 0 ) {
+	$inp2 = 'x2=X(ri(2),gi(2),bi(2));';
+	$inp2 .= 'y2=Y(ri(2),gi(2),bi(2));';
+	$inp2 .= 'z2=Z(ri(2),gi(2),bi(2))';
+}
+
+my $td = tempdir( CLEANUP => 1 );
+my $tempf = "$td/tf.hdr";
+
+system "pfilt -1 -x 128 -y 128 -p 1 $f1 | pvalue -o -h -H -d > $tempf";
+my @wht = split(/\s+/, `total -u $tempf`);
+my $avg = `rcalc -e '\$1=\$2' $tempf | total -m`;
+chomp $avg;
+
+my $cmd = "pcomb -e '$cielab' -e '$rgb2xyz' ";
+$cmd .= "-e 'Yw:179*3*$avg; Xw:$wht[0]*Yw/$wht[1]; Zw:$wht[2]*Yw/$wht[1]' ";
+$cmd .= "-e '$inp1' -e '$inp2' -e 'lo=dE(x1,y1,z1,x2,y2,z2)' ";
+$cmd .= "-o $f1 -o $f2";
+
+system $cmd;
+
+#EOF
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/phisto.pl	Sun Apr 10 19:00:53 2011 +0100
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+#
+# Compute foveal histogram for picture set
+#
+# This is a re-write of Greg's phisto.csh with no functionality
+# added or removed.
+#
+# Axel, Oct 2010
+
+use strict;
+use warnings;
+
+use File::Temp qw/ tempdir /;
+my $td = tempdir( CLEANUP => 1 );
+
+if ($#ARGV < 0) {
+	# Input is from STDIN: Capture to file
+	open(FH, ">$td/stdin.rad");
+	while (<>) {
+		print FH;
+	}
+	close FH;
+	# Pretend stdin.rad was passed as a filename
+	@ARGV = ("$td/stdin.rad");
+}
+
+my $tf = "$td/phisto.dat";
+open(FH, ">$tf") or
+		die("$0: Unable to write to temporary file $tf\n");
+close(FH);
+
+foreach (@ARGV) {
+	system("pfilt -1 -x 128 -y 128 -p 1 $_ |pvalue -o -h -H -d -b >> $tf") == 0
+			or die("$0: Error running pfilt|pvalue on file $_\n");
+}
+
+# Get log10 of upper and lower image luminance
+my $Lmin = `total -l $tf | rcalc -e 'L=\$1*179;\$1=if(L-1e-7,log10(L)-.01,-7)'`;
+chomp($Lmin);
+my $Lmax = `total -u $tf | rcalc -e '\$1=log10(\$1*179)+.01'`;
+chomp($Lmax);
+
+# Output to STDOUT histogram data of log10(luminance)
+my $cmd = "rcalc -e 'L=\$1*179;cond=L-1e-7;\$1=log10(L)' $tf";
+$cmd .= " |histo $Lmin $Lmax 100";
+system("$cmd");
+
+#EOF
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/raddepend.pl	Sun Apr 10 19:00:53 2011 +0100
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+#
+# Find scene dependencies in this directory
+#
+# This a re-write of Greg's raddepend.csh.
+# Scene dependencies are now parsed recursively with the fs tree.
+#
+# This (like the old CSH script) relies on the file's atime and
+# will not work if the partition is mounted with the noatime option,
+# or if the file system does not store the files' access time.
+#
+# not-a-bug: https://bugs.launchpad.net/ubuntu/+bug/490500
+# LINUX file systems are now defaulting to relative atime (relatime) which
+# updates the atime only if the previous atime update is older than
+# the mtime or ctime update.
+# This effectively renders this script (as well as the old raddepend.csh)
+# useless on a LINUX system, unless the fs is mounted with strictatime:
+# $ sudo mount -o remount,strictatime /home
+#
+# Axel, Oct 2010
+
+use strict;
+use warnings;
+
+use File::Find qw/ find /;
+use File::Basename;
+
+# Use path from the first scene file.
+#TODO: Use all args, not just first one.
+die("$0: Need at least one scene file.\n") unless ($#ARGV >= 0);
+my (undef, $dir, undef) = fileparse($ARGV[0]);
+
+#TODO: Make this a new -t option
+#system("touch -m `find . -type f`");
+#sleep (2);
+
+# Get atimes of all files in this dir and all subdirs.
+system("sync");
+my %atimes0;   # atimes before genbbox command
+my %atimes1;   # atimes after genbbox command
+find(sub {$atimes0{$File::Find::name} = (stat())[8] if -f;}, $dir);
+
+my $cmd = 'getbbox -w ' . join(' ', @ARGV) . ' >/dev/null';
+my $exstat = system("$cmd");
+
+# Use exit status of genbbox command
+exit $exstat unless ($exstat == 0);
+
+system("sync");
+sleep(1);   # atime resolution is 1 second.
+
+# Compare the atimes before and after genbbox was run
+find(sub {$atimes1{$File::Find::name} = (stat())[8] if -f;}, $dir);
+my @touched = ();
+while(my ($key, $value) = each(%atimes0)) {
+	push(@touched, $key) if ($value < $atimes1{$key});
+}
+
+# @touched should contain at least the file(s) we were called with.
+# Exit with error if @touched is empty.
+die("$0: Could not determine scene dependencies.\n") unless ($#touched > 0);
+#TODO: Print hint with strictatime mount option
+
+foreach my $file (@touched) {
+	# Remove all ARGV files from @touched list to ensure output is
+	# identical to that of the old raddepend.csh script
+	print "$file\n" unless grep($_ eq $file, @ARGV);
+}
+
+#EOF
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/ran2tiff.pl	Sun Apr 10 19:00:53 2011 +0100
@@ -0,0 +1,125 @@
+#!/usr/bin/perl
+
+# Convert Radiance animation frames to TIFF output
+#
+# This is a re-write of Greg's ran2tiff.csh
+#
+# Axel, Oct 2010
+
+use strict;
+use warnings;
+
+use File::Basename;
+
+my $histosiz = 200;
+my $histof = '';      # Histogram file (-H)
+my $fwt = 0.9;        # Frame weight (-W)
+my $outdir = '';      # Output directory for TIFFs (-D)
+my @pcopts = ();      # Options passed through to pcond
+my @tfopts = ();      # Options passed through to ra_tiff
+
+if ($#ARGV < 0) {
+	@ARGV = ('DUMMY');
+}
+
+# Process options for pcond and ra_tiff
+while (@ARGV) {
+	$_ = $ARGV[0];
+	if (m/-W/) {   # Weight of each frame
+		$pfwt = $ARGV[1];
+		shift @ARGV;
+	} elsif (m/-H/) {   # Histogram file
+		$histof = "$ARGV[1]";
+		shift @ARGV;
+	} elsif (m/-D/) {   # Output directory for TIFFs
+		die("$0: Directory $ARGV[1] does not exist.\n")
+				unless (-d "$ARGV[1]");
+		$outdir = "$argv[1]";
+		shift @ARGV;
+	} elsif ((m/-h\w+/) or (m/-a\w+/) or   # human, acuity
+			(m/-v\w+/) or (m/-s\w+/) or    # veiling glare, contrast sensitiviy
+			(m/-c\w+/) or (m/-l\w+/)) {    # mesopic, linear response
+		push(@pcopts, $_);
+	} elsif ((m/-u/) or (m/-d/) or (m/-f/)) {
+		# Lmax of device, dynamic range of device, macbeth.cal file
+		push(@pcopts, $_, $ARGV[1]);
+		shift @ARGV;
+	} elsif (m/-p/) {   # pcond -p (primaries)
+		push(@pcopts, '-p');
+		for (my $i=0; $i<6, $i++) {
+			push(@pcopts, $ARGV[1]);
+			shift @ARGV;
+		}
+	} elsif ((m/-z/) or (m/-b/) or (m/-w/)) {
+		# LZW-compression, 8-bit greyscale, 16-bit
+		push(@tfopts, $_);
+	} elsif (m/-g/) {
+		push(@tfopts, '-g', $_);   # Gamma value for ra_tiff
+		shift @ARGV;
+	} elsif (m/^-/) {
+		die("$0: Bad option: $_\n");
+	} else {
+		last;
+	}
+	shift @ARGV;
+}
+
+die("$0: Need at least two frames.\n") unless ($#ARGV >= 1);
+#echo Usage: "$0 [-W prev_frame_wt][-H histo][-D dir][pcond opts][ra_tiff opts] frame1 frame2 .."
+
+my $td = tempdir( CLEANPU => 1 );
+
+# Get shrunken image luminances
+foreach (@ARGV) {
+	my ($name, undef, undef) = fileparse($_);
+	my $datf = "$td/$name.dat";
+	my $cmd = "pfilt -1 -x 128 -y 128 -p 1 \"$_\"";
+	$cmd .= " |pvalue -o -h -H -b -df";
+	$cmd .= " |rcalc -if1 -e 'L=\$1*179;cond=L-1e-7;\$1=log10(L)' > $datf";
+	system("$cmd");
+}
+
+# Get Min. and Max. log values
+my $Lmin = `cat $td/*.dat | total -l | rcalc -e '\$1=\$1-.01'`;
+chomp($Lmin);
+my $Lmax = `cat $td/*.dat | total -u | rcalc -e '\$1=\$1+.01'`;
+chomp($Lmax);
+
+if ($histof) {
+	if (-r $histof) then
+		# Fix min/max and translate histogram
+		set Lmin=`sed -n '1p' $histof | rcalc -e 'min(a,b):if(a-b,b,a);$1=min($1,'"$Lmin)"`
+		set Lmax=`sed -n '$p' $histof | rcalc -e 'max(a,b):if(a-b,a,b);$1=max($1,'"$Lmax)"`
+		tabfunc -i hfunc < $histof > $td/oldhist.cal
+		cnt $histosiz \
+			| rcalc -e "L10=$Lmin+($Lmax-$Lmin)/$histosiz"'*($1+.5)' \
+				-f $td/oldhist.cal -e '$1=L10;$2=hfunc(L10)' \
+			> $td/oldhisto.dat
+	endif
+}
+
+foreach ($ARGV) {
+	#inp = $_
+	set datf="$inp:t"
+	set datf="$td/$datf:r.dat"
+	set outp="$inp:t"
+	set outp="$outdir$outp:r.tif"
+	endif
+	histo $Lmin $Lmax $histosiz < $datf > $td/newhisto.dat
+	if (-f $td/oldhisto.dat) then
+		rlam $td/newhisto.dat $td/oldhisto.dat \
+			| rcalc -e '$1=$1;$2=$2+$4*'$pfwt \
+			> $td/histo.dat
+	else
+		mv $td/{new,}histo.dat
+	endif
+	pcond $pcopts -I $inp:q < $td/histo.dat \
+		| ra_tiff $tfopts - $outp:q
+	mv $td/{,old}histo.dat
+}
+
+if ($?histof) then
+	cp -f $td/oldhisto.dat $histof
+endif
+
+#EOF
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/rlux.pl	Sun Apr 10 19:00:53 2011 +0100
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+#
+# Compute illuminance from ray origin and direction
+#
+# This is re-write of Greg's rlux.csh
+
+use strict;
+use warnings;
+
+if($#ARGV < 0) {
+	print "Usage: $0 [rtrace args] octree";
+	exit(1);
+}
+
+my $args = join(' ', @ARGV);
+my $cmd = "rtrace -i+ -dv- -h- -x 1 $args";
+$cmd .= " | rcalc -e '$1=47.4*$1+120*$2+11.6*$3' -u";
+system "$cmd";
+
+#EOF
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/xyzimage.pl	Sun Apr 10 19:00:53 2011 +0100
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+#
+# Display one or more CIE XYZE pictures using ximage
+#
+# This is re-write of Greg's xyzimage.csh.
+
+use strict;
+use warnings;
+#use Getopt::Long qw(:config no_auto_abbrev no_ignore_case require_order
+# We need auto_abbrev for -display and -geometry.
+use Getopt::Long qw(:config auto_abbrev no_ignore_case require_order
+		prefix_pattern=(-));
+use File::Temp qw/ tempdir /;
+use File::Basename;
+
+my @xiargs;
+my @popts;
+print $#ARGV . ": " . join(', ', @ARGV) . "\n";
+
+GetOptions(
+	'g=f'         => sub { push(@xiargs, '-g') }, # ximage: -g gamma
+	'c=i'         => sub { push(@xiargs, '-c') }, # ximage: -c ncolors
+	'geometry=s'  => sub { push(@xiargs, '-c') }, # ximage: -geometry geometry
+	#TODO: deal with =geometry
+	'di=s'        => sub { push(@xiargs, '-c') }, # ximage: -di display
+	'e=s'         => sub { push(@xiargs, '-e') }, # ximage: -e exposure
+
+	'p=f{8}'        => \@popts, # ra_xyze: -p display_primaries
+
+	'b'           => sub { push(@xiargs, '-b') }, # ximage: -b (black+white)
+	'd'           => sub { push(@xiargs, '-d') }, # ximage: -d (no ditering)
+	'm'           => sub { push(@xiargs, '-m') }, # ximage: -m (monochrome)
+	'f'           => sub { push(@xiargs, '-f') }, # ximage: -f (fast refresh)
+	's'           => sub { push(@xiargs, '-s') }, # ximage: -s (sequential)
+	#'o*'          => sub { push(@xiargs, '-l') }, # ximage: -ospec
+
+) or die("Error parsing options.\n");
+print $#ARGV . ": " . join(', ', @ARGV) . "\n";
+
+# Handle display primaries:
+# Use -p option, $DISPLAY_PRIMARIES, or nothing (in that order!)
+#print "popts: $#popts -> " . join(', ', @popts) . "\n";
+my $popt = "";
+if($#popts != 7) {
+	if($ENV{'DISPLAY_PRIMARIES'}) {
+		#print "DISPLAY_PRIMARIES: $ENV{'DISPLAY_PRIMARIES'}\n";
+		$popt = '-p ' . $ENV{'DISPLAY_PRIMARIES'};
+	}
+} else {
+	unshift(@popts, '-p');
+	$popt = join(' ', @popts);
+}
+print "popt: $popt\n";
+
+my $xiarg = join(' ', @xiargs);
+print "xiarg: $xiarg\n";
+
+my $td = tempdir( CLEANUP => 0 );
+
+if ($#ARGV < 0) {
+	# Input is from STDIN: Capture to file
+	open(FH, ">$td/stdin.rad");
+	while (<>) {
+		print FH;
+	}
+	close FH;
+	# Pretend stdin.rad was passed as a filename
+	@ARGV = ("$td/stdin.rad");
+}
+
+print $#ARGV . ": " . join(', ', @ARGV) . "\n";
+
+my @files;
+foreach (@ARGV) {
+	my ($name, undef, undef) = fileparse($_);
+	my $cmd = "ra_xyze -r -u $popt $name $td/$name";
+	print "cmd: $cmd\n";
+	system("$cmd") == 0 or
+			die("$0: Error running ra_xyze -r on file $_\n. Exit code: $?\n");
+	push(@files, "$td/$name");
+}
+print "temp dir: $td\n";
+
+system("ximage $xiarg " . join(' ',  @files));
+
+#EOF
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/man/man1/xyzimage.1	Sun Apr 10 19:00:53 2011 +0100
@@ -0,0 +1,68 @@
+.\" RCSid goes here.
+.TH "XYZIMAGE" "1" "16/01/2011" "RADIANCE" ""
+.SH "NAME"
+xyzimage \- display one or more RADIANCE XYZE pictures using ximage.
+.SH "SYNOPSIS"
+.B xyzimage
+[
+.B \=geometry | \-geometry geometry
+][
+.B "\-display display"
+][
+.B "\-c ncolors"
+][
+.B \-d
+][
+.B \-b
+][
+.B \-m
+][
+.B "\-g gamma"
+][
+.B \-f
+][
+.B "\-e spec
+][
+.BI \-o spec
+][
+.B \-s
+][
+.B "\-p xr yr xg yg xb yb xw yw"
+]
+.B "picture .."
+.SH "DESCRIPTION"
+.I xyzimage
+displays one or more RADIANCE XYZE images and displays them on an X server.
+This is done by calling 
+.I ximage(1).
+Since ximage can only handle pictures in RADIANCE RGBE
+format, but not those in XYZE format, it first converts them to RGBE by calling
+.I ra_xyze(1) \-r.
+
+The 
+.I \-geometry,
+( or
+.I =geometry
+),
+.I "\-di, \-c, \-e, \-d, \-b, \-m, \-g, \-f, \-s,"
+and
+.I \-o
+options are passed straight on to
+.I ximage.
+Please see
+.I ximage(1)
+for details.
+
+If the DISPLAY_PRIMARIES environmental variable is set, those primaries are passed to
+.I ra_xyze.
+They may be re\-defined with the
+.I \-p
+option. See 
+.I ra_xyze(1)
+for details.
+.SH "ENVIRONMENT"
+DISPLAY_GAMMA		the default gamma correction value
+
+DISPLAY_PRIMARIES	the default display primaries
+.SH "SEE ALSO"
+ra_xyze(1), ximage(1)