bin/xyzimage.pl
author Axel Jacobs <axel@jaloxa.eu>
Tue, 28 Jun 2011 22:23:00 +0100
changeset 30 a853d5280041
parent 26 a9f74601ca3c
permissions -rwxr-xr-x
Minor fiddling with objpict_test.

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