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