bin/xyzimage.pl
author Axel Jacobs <axel@jaloxa.eu>
Mon, 27 Jun 2011 21:08:08 +0100
changeset 24 c273e54dd38f
parent 14 b1e2580a0ca7
child 26 a9f74601ca3c
permissions -rwxr-xr-x
Upped status of objpict and objview to 3.

#!/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";

#TODO: Don't use Getopt. Parse by hand.
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