4 # |
4 # |
5 # This is re-write of Greg's xyzimage.csh. |
5 # This is re-write of Greg's xyzimage.csh. |
6 |
6 |
7 use strict; |
7 use strict; |
8 use warnings; |
8 use warnings; |
9 #use Getopt::Long qw(:config no_auto_abbrev no_ignore_case require_order |
9 |
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 /; |
10 use File::Temp qw/ tempdir /; |
14 use File::Basename; |
11 use File::Basename; |
15 |
12 |
16 my @xiargs; |
13 my @xiargs = (); # Options for ximage |
17 my @popts; |
14 my $popt = ''; # Display primaries (as string) |
18 print $#ARGV . ": " . join(', ', @ARGV) . "\n"; |
15 if( $ENV{DISPLAY_PRIMARIES} ) { |
|
16 $popt = "-p $ENV{DISPLAY_PRIMARIES}"; |
|
17 } |
19 |
18 |
20 #TODO: Don't use Getopt. Parse by hand. |
19 while( $#ARGV ) { |
21 GetOptions( |
20 $_ = shift @ARGV; |
22 'g=f' => sub { push(@xiargs, '-g') }, # ximage: -g gamma |
21 if( m/-ge\w*/ or m/-di\w*/ or m/-g$/ or m/-c/ or m/-e/ ) { |
23 'c=i' => sub { push(@xiargs, '-c') }, # ximage: -c ncolors |
22 # The following options all require one qualifier and are passed |
24 'geometry=s' => sub { push(@xiargs, '-c') }, # ximage: -geometry geometry |
23 # straight on to ximage: |
25 #TODO: deal with =geometry |
24 # -geometry (an X11 thing, e.g. 800x600+50+50) |
26 'di=s' => sub { push(@xiargs, '-c') }, # ximage: -di display |
25 # -di display (an X11 thing) |
27 'e=s' => sub { push(@xiargs, '-e') }, # ximage: -e exposure |
26 # -c number of colours |
|
27 # -g gamma |
|
28 # -e exposure compensation |
|
29 push( @xiargs, $_, shift @ARGV ) or |
|
30 die( "Missing qualifier for $_ option.\n" ); |
28 |
31 |
29 'p=f{8}' => \@popts, # ra_xyze: -p display_primaries |
32 } elsif( m/=[\S]{3,}/ or m/o\w{1,}/ ) { |
|
33 # The qualifier to the -o option is glued to the option. |
|
34 # Passed straight to ximage: |
|
35 # -ospec print spec to STDOUT (defaults to -ood) |
|
36 # =geometry (alternative invocation to -geometry) |
|
37 push( @xiargs, $_ ); |
30 |
38 |
31 'b' => sub { push(@xiargs, '-b') }, # ximage: -b (black+white) |
39 } elsif( m/-b/ or m/-d/ or m/-m/ or m/-f/ or m/-s/ ) { |
32 'd' => sub { push(@xiargs, '-d') }, # ximage: -d (no ditering) |
40 # The following switches are passed straight to ximage: |
33 'm' => sub { push(@xiargs, '-m') }, # ximage: -m (monochrome) |
41 # -b black and white output |
34 'f' => sub { push(@xiargs, '-f') }, # ximage: -f (fast refresh) |
42 # -d no color dithering |
35 's' => sub { push(@xiargs, '-s') }, # ximage: -s (sequential) |
43 # -m monochrome output |
36 #'o*' => sub { push(@xiargs, '-l') }, # ximage: -ospec |
44 # -f fast redraw on (-F to turn it off) |
|
45 # -s display multiple picture sequentially |
|
46 push( @xiargs, $_ ); |
37 |
47 |
38 ) or die("Error parsing options.\n"); |
48 } elsif( m/-p/ ) { |
39 print $#ARGV . ": " . join(', ', @ARGV) . "\n"; |
49 # The following option requires eight float qualifiers: |
40 |
50 # -p display primaries |
41 # Handle display primaries: |
51 my @popts = ('-p'); |
42 # Use -p option, $DISPLAY_PRIMARIES, or nothing (in that order!) |
52 for( my $i=0 ; $i<=7 ; $i++ ) { |
43 #print "popts: $#popts -> " . join(', ', @popts) . "\n"; |
53 if( $#ARGV <= 0 ) { |
44 my $popt = ""; |
54 die("Missing qualifier for -p option: Need eight.\n"); |
45 if($#popts != 7) { |
55 } |
46 if($ENV{'DISPLAY_PRIMARIES'}) { |
56 push( @popts, shift @ARGV ); |
47 #print "DISPLAY_PRIMARIES: $ENV{'DISPLAY_PRIMARIES'}\n"; |
57 } |
48 $popt = '-p ' . $ENV{'DISPLAY_PRIMARIES'}; |
58 $popt = join( ' ', @popts ); |
|
59 } elsif( m/^-/ ) { |
|
60 die( "Unknown option: $_\n" ); |
|
61 } else { |
|
62 # The remaining command-line args are file names. |
|
63 last; |
49 } |
64 } |
50 } else { |
|
51 unshift(@popts, '-p'); |
|
52 $popt = join(' ', @popts); |
|
53 } |
65 } |
54 print "popt: $popt\n"; |
|
55 |
|
56 my $xiarg = join(' ', @xiargs); |
66 my $xiarg = join(' ', @xiargs); |
57 print "xiarg: $xiarg\n"; |
|
58 |
67 |
59 my $td = tempdir( CLEANUP => 0 ); |
68 my $td = tempdir( CLEANUP => 0 ); |
60 |
|
61 if ($#ARGV < 0) { |
69 if ($#ARGV < 0) { |
62 # Input is from STDIN: Capture to file |
70 # Input is from STDIN: Capture to file |
63 open(FH, ">$td/stdin.rad"); |
71 open(FH, ">$td/stdin.rad"); |
64 while (<>) { |
72 while (<>) { |
65 print FH; |
73 print FH; |
67 close FH; |
75 close FH; |
68 # Pretend stdin.rad was passed as a filename |
76 # Pretend stdin.rad was passed as a filename |
69 @ARGV = ("$td/stdin.rad"); |
77 @ARGV = ("$td/stdin.rad"); |
70 } |
78 } |
71 |
79 |
72 print $#ARGV . ": " . join(', ', @ARGV) . "\n"; |
|
73 |
|
74 my @files; |
80 my @files; |
75 foreach (@ARGV) { |
81 foreach (@ARGV) { |
76 my ($name, undef, undef) = fileparse($_); |
82 my ($name, $path, $suffix) = fileparse($_); |
77 my $cmd = "ra_xyze -r -u $popt $name $td/$name"; |
83 my $cmd = "ra_xyze -r -u $popt $_ $td/$name"; |
78 print "cmd: $cmd\n"; |
|
79 system("$cmd") == 0 or |
84 system("$cmd") == 0 or |
80 die("$0: Error running ra_xyze -r on file $_\n. Exit code: $?\n"); |
85 die("Error running ra_xyze -r on file $_\n"); |
81 push(@files, "$td/$name"); |
86 push(@files, "$td/$name"); |
82 } |
87 } |
83 print "temp dir: $td\n"; |
|
84 |
88 |
85 system("ximage $xiarg " . join(' ', @files)); |
89 system "ximage $xiarg " . join(' ', @files); |
86 |
90 |
87 #EOF |
91 #EOF |