1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
#!/bin/sh
##############################################################################
# This is essentially a Perl program. We exec the Perl interpreter specifying
# this same file as the Perl program and use the -x option to cause the Perl
# interpreter to skip down to the Perl code. The reason we do this instead of
# just making /usr/bin/perl the script interpreter (instead of /bin/sh) is
# that the user may have multiple Perl interpreters and the one he wants to
# use is properly located in the PATH. The user's choice of Perl interpreter
# may be crucial, such as when the user also has a PERL5LIB environment
# variable and it selects modules that work with only a certain main
# interpreter program.
#
# An alternative some people use is to have /usr/bin/env as the script
# interpreter. We don't do that because we think the existence and
# compatibility of /bin/sh is more reliable.
#
# Note that we aren't concerned about efficiency because the user who needs
# high efficiency can use directly the programs that this program invokes.
#
##############################################################################
exec perl -w -x -S -- "$0" "$@"
#!/usr/bin/perl
use strict;
use Getopt::Long;
use File::Temp;
use IO::Handle;
sub pm_message($) {
STDERR->print("ppmrainbow: $_[0]\n");
}
sub pm_error($) {
pm_message($_[0]);
exit(1);
}
my ($FALSE, $TRUE) = (0,1);
(my $myname = $0) =~ s#\A.*/##;
sub doVersionHack($) {
my ($argvR) = @_;
my $arg1 = $argvR->[0];
if (defined($arg1) && (($arg1 eq "--version") || ($arg1 eq "-version"))) {
my $termStatus = system('pgmramp', '--version');
exit($termStatus == 0 ? 0 : 1);
}
}
##############################################################################
#
# MAINLINE
#
##############################################################################
doVersionHack(\@ARGV);
my ($Twid, $Thgt, $tmpdir, $repeat, $verbose);
# set defaults
$Twid = 600;
$Thgt = 8;
$tmpdir = $ENV{"TMPDIR"} || "/tmp";
$repeat = $TRUE;
$verbose = $FALSE;
GetOptions("width=i" => \$Twid,
"height=i" => \$Thgt,
"tmpdir=s" => \$tmpdir,
"repeat!" => \$repeat,
"verbose!" => \$verbose);
if ($Twid < 1 || $Thgt < 1) {
pm_error("invalid width and/or height");
}
my $verboseCommand = $verbose ? "set -x;" : "";
if (@ARGV < 1) {
pm_error("You must specify at least one color as an argument");
} elsif (@ARGV < 2 && ! $repeat) {
pm_error("With the -norepeat option, you must specify at least two colors " .
"as arguments.");
}
my @colorlist;
@colorlist = @ARGV;
if ($repeat) {
push @colorlist, $ARGV[0];
}
my $ourtmp = File::Temp::tempdir("$tmpdir/ppmrainbowXXXX", UNLINK=>1);
my $widthRemaining;
my $n;
my @outlist;
$n = 0;
$widthRemaining = $Twid;
@outlist = ();
while (@colorlist >= 2) {
my $outfile = sprintf("%s/file.%03u.ppm", $ourtmp, $n);
push(@outlist, $outfile);
my $w = int(($widthRemaining-1)/(@colorlist-1))+1;
my $rc = system("$verboseCommand pgmramp -lr $w $Thgt | " .
"pgmtoppm \"$colorlist[0]-$colorlist[1]\" >$outfile");
if ($rc != 0) {
pm_error("pgmramp|pgmtoppm pipe failed.");
}
$widthRemaining -= $w;
$n++;
shift @colorlist;
}
0 == system qq{$verboseCommand pnmcat -lr @outlist}
or exit 1;
exit 0;
END {
if (@outlist) {
unlink(@outlist);
}
if (defined($ourtmp)) {
rmdir($ourtmp);
}
}
|
