| author | Axel Jacobs <axel@jaloxa.eu> |
| Mon, 27 Jun 2011 20:39:10 +0100 | |
| changeset 20 | a29baf51b980 |
| parent 14 | b1e2580a0ca7 |
| child 26 | a9f74601ca3c |
| permissions | -rwxr-xr-x |
| 8 | 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 |
||
|
14
b1e2580a0ca7
Set status of all existing Perl scripts to 1.
Axel Jacobs <axel@jaloxa.eu>
parents:
8
diff
changeset
|
20 |
#TODO: Don't use Getopt. Parse by hand. |
| 8 | 21 |
GetOptions( |
22 |
'g=f' => sub { push(@xiargs, '-g') }, # ximage: -g gamma
|
|
23 |
'c=i' => sub { push(@xiargs, '-c') }, # ximage: -c ncolors
|
|
24 |
'geometry=s' => sub { push(@xiargs, '-c') }, # ximage: -geometry geometry
|
|
25 |
#TODO: deal with =geometry |
|
26 |
'di=s' => sub { push(@xiargs, '-c') }, # ximage: -di display
|
|
27 |
'e=s' => sub { push(@xiargs, '-e') }, # ximage: -e exposure
|
|
28 |
||
29 |
'p=f{8}' => \@popts, # ra_xyze: -p display_primaries
|
|
30 |
||
31 |
'b' => sub { push(@xiargs, '-b') }, # ximage: -b (black+white)
|
|
32 |
'd' => sub { push(@xiargs, '-d') }, # ximage: -d (no ditering)
|
|
33 |
'm' => sub { push(@xiargs, '-m') }, # ximage: -m (monochrome)
|
|
34 |
'f' => sub { push(@xiargs, '-f') }, # ximage: -f (fast refresh)
|
|
35 |
's' => sub { push(@xiargs, '-s') }, # ximage: -s (sequential)
|
|
36 |
#'o*' => sub { push(@xiargs, '-l') }, # ximage: -ospec
|
|
37 |
||
38 |
) or die("Error parsing options.\n");
|
|
39 |
print $#ARGV . ": " . join(', ', @ARGV) . "\n";
|
|
40 |
||
41 |
# Handle display primaries: |
|
42 |
# Use -p option, $DISPLAY_PRIMARIES, or nothing (in that order!) |
|
43 |
#print "popts: $#popts -> " . join(', ', @popts) . "\n";
|
|
44 |
my $popt = ""; |
|
45 |
if($#popts != 7) {
|
|
46 |
if($ENV{'DISPLAY_PRIMARIES'}) {
|
|
47 |
#print "DISPLAY_PRIMARIES: $ENV{'DISPLAY_PRIMARIES'}\n";
|
|
48 |
$popt = '-p ' . $ENV{'DISPLAY_PRIMARIES'};
|
|
49 |
} |
|
50 |
} else {
|
|
51 |
unshift(@popts, '-p'); |
|
52 |
$popt = join(' ', @popts);
|
|
53 |
} |
|
54 |
print "popt: $popt\n"; |
|
55 |
||
56 |
my $xiarg = join(' ', @xiargs);
|
|
57 |
print "xiarg: $xiarg\n"; |
|
58 |
||
59 |
my $td = tempdir( CLEANUP => 0 ); |
|
60 |
||
61 |
if ($#ARGV < 0) {
|
|
62 |
# Input is from STDIN: Capture to file |
|
63 |
open(FH, ">$td/stdin.rad"); |
|
64 |
while (<>) {
|
|
65 |
print FH; |
|
66 |
} |
|
67 |
close FH; |
|
68 |
# Pretend stdin.rad was passed as a filename |
|
69 |
@ARGV = ("$td/stdin.rad");
|
|
70 |
} |
|
71 |
||
72 |
print $#ARGV . ": " . join(', ', @ARGV) . "\n";
|
|
73 |
||
74 |
my @files; |
|
75 |
foreach (@ARGV) {
|
|
76 |
my ($name, undef, undef) = fileparse($_); |
|
77 |
my $cmd = "ra_xyze -r -u $popt $name $td/$name"; |
|
78 |
print "cmd: $cmd\n"; |
|
79 |
system("$cmd") == 0 or
|
|
80 |
die("$0: Error running ra_xyze -r on file $_\n. Exit code: $?\n");
|
|
81 |
push(@files, "$td/$name"); |
|
82 |
} |
|
83 |
print "temp dir: $td\n"; |
|
84 |
||
85 |
system("ximage $xiarg " . join(' ', @files));
|
|
86 |
||
|
14
b1e2580a0ca7
Set status of all existing Perl scripts to 1.
Axel Jacobs <axel@jaloxa.eu>
parents:
8
diff
changeset
|
87 |
#EOF |