|
1 #!/usr/bin/perl |
|
2 # |
|
3 # Display one or more CIE XYZE pictures using ximage |
|
4 # |
|
5 # This is re-write of Greg's xyzimage.csh. |
|
6 |
|
7 use strict; |
|
8 use warnings; |
|
9 #use Getopt::Long qw(:config no_auto_abbrev no_ignore_case require_order |
|
10 # We need auto_abbrev for -display and -geometry. |
|
11 use Getopt::Long qw(:config auto_abbrev no_ignore_case require_order |
|
12 prefix_pattern=(-)); |
|
13 use File::Temp qw/ tempdir /; |
|
14 use File::Basename; |
|
15 |
|
16 my @xiargs; |
|
17 my @popts; |
|
18 print $#ARGV . ": " . join(', ', @ARGV) . "\n"; |
|
19 |
|
20 GetOptions( |
|
21 'g=f' => sub { push(@xiargs, '-g') }, # ximage: -g gamma |
|
22 'c=i' => sub { push(@xiargs, '-c') }, # ximage: -c ncolors |
|
23 'geometry=s' => sub { push(@xiargs, '-c') }, # ximage: -geometry geometry |
|
24 #TODO: deal with =geometry |
|
25 'di=s' => sub { push(@xiargs, '-c') }, # ximage: -di display |
|
26 'e=s' => sub { push(@xiargs, '-e') }, # ximage: -e exposure |
|
27 |
|
28 'p=f{8}' => \@popts, # ra_xyze: -p display_primaries |
|
29 |
|
30 'b' => sub { push(@xiargs, '-b') }, # ximage: -b (black+white) |
|
31 'd' => sub { push(@xiargs, '-d') }, # ximage: -d (no ditering) |
|
32 'm' => sub { push(@xiargs, '-m') }, # ximage: -m (monochrome) |
|
33 'f' => sub { push(@xiargs, '-f') }, # ximage: -f (fast refresh) |
|
34 's' => sub { push(@xiargs, '-s') }, # ximage: -s (sequential) |
|
35 #'o*' => sub { push(@xiargs, '-l') }, # ximage: -ospec |
|
36 |
|
37 ) or die("Error parsing options.\n"); |
|
38 print $#ARGV . ": " . join(', ', @ARGV) . "\n"; |
|
39 |
|
40 # Handle display primaries: |
|
41 # Use -p option, $DISPLAY_PRIMARIES, or nothing (in that order!) |
|
42 #print "popts: $#popts -> " . join(', ', @popts) . "\n"; |
|
43 my $popt = ""; |
|
44 if($#popts != 7) { |
|
45 if($ENV{'DISPLAY_PRIMARIES'}) { |
|
46 #print "DISPLAY_PRIMARIES: $ENV{'DISPLAY_PRIMARIES'}\n"; |
|
47 $popt = '-p ' . $ENV{'DISPLAY_PRIMARIES'}; |
|
48 } |
|
49 } else { |
|
50 unshift(@popts, '-p'); |
|
51 $popt = join(' ', @popts); |
|
52 } |
|
53 print "popt: $popt\n"; |
|
54 |
|
55 my $xiarg = join(' ', @xiargs); |
|
56 print "xiarg: $xiarg\n"; |
|
57 |
|
58 my $td = tempdir( CLEANUP => 0 ); |
|
59 |
|
60 if ($#ARGV < 0) { |
|
61 # Input is from STDIN: Capture to file |
|
62 open(FH, ">$td/stdin.rad"); |
|
63 while (<>) { |
|
64 print FH; |
|
65 } |
|
66 close FH; |
|
67 # Pretend stdin.rad was passed as a filename |
|
68 @ARGV = ("$td/stdin.rad"); |
|
69 } |
|
70 |
|
71 print $#ARGV . ": " . join(', ', @ARGV) . "\n"; |
|
72 |
|
73 my @files; |
|
74 foreach (@ARGV) { |
|
75 my ($name, undef, undef) = fileparse($_); |
|
76 my $cmd = "ra_xyze -r -u $popt $name $td/$name"; |
|
77 print "cmd: $cmd\n"; |
|
78 system("$cmd") == 0 or |
|
79 die("$0: Error running ra_xyze -r on file $_\n. Exit code: $?\n"); |
|
80 push(@files, "$td/$name"); |
|
81 } |
|
82 print "temp dir: $td\n"; |
|
83 |
|
84 system("ximage $xiarg " . join(' ', @files)); |
|
85 |
|
86 #EOF |