Added IES photometry files for testing.
#!/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 File::Temp qw/ tempdir /;
use File::Basename;
my @xiargs = (); # Options for ximage
my $popt = ''; # Display primaries (as string)
if( $ENV{DISPLAY_PRIMARIES} ) {
$popt = "-p $ENV{DISPLAY_PRIMARIES}";
}
while( $#ARGV ) {
$_ = shift @ARGV;
if( m/-ge\w*/ or m/-di\w*/ or m/-g$/ or m/-c/ or m/-e/ ) {
# The following options all require one qualifier and are passed
# straight on to ximage:
# -geometry (an X11 thing, e.g. 800x600+50+50)
# -di display (an X11 thing)
# -c number of colours
# -g gamma
# -e exposure compensation
push( @xiargs, $_, shift @ARGV ) or
die( "Missing qualifier for $_ option.\n" );
} elsif( m/=[\S]{3,}/ or m/o\w{1,}/ ) {
# The qualifier to the -o option is glued to the option.
# Passed straight to ximage:
# -ospec print spec to STDOUT (defaults to -ood)
# =geometry (alternative invocation to -geometry)
push( @xiargs, $_ );
} elsif( m/-b/ or m/-d/ or m/-m/ or m/-f/ or m/-s/ ) {
# The following switches are passed straight to ximage:
# -b black and white output
# -d no color dithering
# -m monochrome output
# -f fast redraw on (-F to turn it off)
# -s display multiple picture sequentially
push( @xiargs, $_ );
} elsif( m/-p/ ) {
# The following option requires eight float qualifiers:
# -p display primaries
my @popts = ('-p');
for( my $i=0 ; $i<=7 ; $i++ ) {
if( $#ARGV <= 0 ) {
die("Missing qualifier for -p option: Need eight.\n");
}
push( @popts, shift @ARGV );
}
$popt = join( ' ', @popts );
} elsif( m/^-/ ) {
die( "Unknown option: $_\n" );
} else {
# The remaining command-line args are file names.
last;
}
}
my $xiarg = join(' ', @xiargs);
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");
}
my @files;
foreach (@ARGV) {
my ($name, $path, $suffix) = fileparse($_);
my $cmd = "ra_xyze -r -u $popt $_ $td/$name";
system("$cmd") == 0 or
die("Error running ra_xyze -r on file $_\n");
push(@files, "$td/$name");
}
system "ximage $xiarg " . join(' ', @files);
#EOF