| author | Axel Jacobs <axel@jaloxa.eu> |
| Mon, 14 Apr 2014 22:20:45 +0100 | |
| changeset 72 | 9516e69e0be3 |
| parent 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; |
|
|
26
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
9 |
|
| 8 | 10 |
use File::Temp qw/ tempdir /; |
11 |
use File::Basename; |
|
12 |
||
|
26
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
13 |
my @xiargs = (); # Options for ximage |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
14 |
my $popt = ''; # Display primaries (as string) |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
15 |
if( $ENV{DISPLAY_PRIMARIES} ) {
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
16 |
$popt = "-p $ENV{DISPLAY_PRIMARIES}";
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
17 |
} |
| 8 | 18 |
|
|
26
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
19 |
while( $#ARGV ) {
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
20 |
$_ = shift @ARGV; |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
21 |
if( m/-ge\w*/ or m/-di\w*/ or m/-g$/ or m/-c/ or m/-e/ ) {
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
22 |
# The following options all require one qualifier and are passed |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
23 |
# straight on to ximage: |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
24 |
# -geometry (an X11 thing, e.g. 800x600+50+50) |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
25 |
# -di display (an X11 thing) |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
26 |
# -c number of colours |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
27 |
# -g gamma |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
28 |
# -e exposure compensation |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
29 |
push( @xiargs, $_, shift @ARGV ) or |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
30 |
die( "Missing qualifier for $_ option.\n" ); |
| 8 | 31 |
|
|
26
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
32 |
} elsif( m/=[\S]{3,}/ or m/o\w{1,}/ ) {
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
33 |
# The qualifier to the -o option is glued to the option. |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
34 |
# Passed straight to ximage: |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
35 |
# -ospec print spec to STDOUT (defaults to -ood) |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
36 |
# =geometry (alternative invocation to -geometry) |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
37 |
push( @xiargs, $_ ); |
| 8 | 38 |
|
|
26
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
39 |
} elsif( m/-b/ or m/-d/ or m/-m/ or m/-f/ or m/-s/ ) {
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
40 |
# The following switches are passed straight to ximage: |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
41 |
# -b black and white output |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
42 |
# -d no color dithering |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
43 |
# -m monochrome output |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
44 |
# -f fast redraw on (-F to turn it off) |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
45 |
# -s display multiple picture sequentially |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
46 |
push( @xiargs, $_ ); |
| 8 | 47 |
|
|
26
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
48 |
} elsif( m/-p/ ) {
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
49 |
# The following option requires eight float qualifiers: |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
50 |
# -p display primaries |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
51 |
my @popts = ('-p');
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
52 |
for( my $i=0 ; $i<=7 ; $i++ ) {
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
53 |
if( $#ARGV <= 0 ) {
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
54 |
die("Missing qualifier for -p option: Need eight.\n");
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
55 |
} |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
56 |
push( @popts, shift @ARGV ); |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
57 |
} |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
58 |
$popt = join( ' ', @popts ); |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
59 |
} elsif( m/^-/ ) {
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
60 |
die( "Unknown option: $_\n" ); |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
61 |
} else {
|
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
62 |
# The remaining command-line args are file names. |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
63 |
last; |
| 8 | 64 |
} |
65 |
} |
|
66 |
my $xiarg = join(' ', @xiargs);
|
|
67 |
||
68 |
my $td = tempdir( CLEANUP => 0 ); |
|
69 |
if ($#ARGV < 0) {
|
|
70 |
# Input is from STDIN: Capture to file |
|
71 |
open(FH, ">$td/stdin.rad"); |
|
72 |
while (<>) {
|
|
73 |
print FH; |
|
74 |
} |
|
75 |
close FH; |
|
76 |
# Pretend stdin.rad was passed as a filename |
|
77 |
@ARGV = ("$td/stdin.rad");
|
|
78 |
} |
|
79 |
||
80 |
my @files; |
|
81 |
foreach (@ARGV) {
|
|
|
26
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
82 |
my ($name, $path, $suffix) = fileparse($_); |
|
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
83 |
my $cmd = "ra_xyze -r -u $popt $_ $td/$name"; |
| 8 | 84 |
system("$cmd") == 0 or
|
|
26
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
85 |
die("Error running ra_xyze -r on file $_\n");
|
| 8 | 86 |
push(@files, "$td/$name"); |
87 |
} |
|
88 |
||
|
26
a9f74601ca3c
xyzimage seems to work now. Upped status to 2.
Axel Jacobs <axel@jaloxa.eu>
parents:
14
diff
changeset
|
89 |
system "ximage $xiarg " . join(' ', @files);
|
| 8 | 90 |
|
|
14
b1e2580a0ca7
Set status of all existing Perl scripts to 1.
Axel Jacobs <axel@jaloxa.eu>
parents:
8
diff
changeset
|
91 |
#EOF |