3 ## -----------------------------------------------------------------------
5 ## Copyright 2004 H. Peter Anvin - All Rights Reserved
7 ## This program is free software; you can redistribute it and/or modify
8 ## it under the terms of the GNU General Public License as published by
9 ## the Free Software Foundation, Inc., 53 Temple Place Ste 330,
10 ## Boston MA 02111-1307, USA; either version 2 of the License, or
11 ## (at your option) any later version; incorporated herein by reference.
13 ## -----------------------------------------------------------------------
18 ## Convert a PNM file with max 16 colors to a simple RLE-based format:
20 ## uint32 0x1413f33d ; magic (littleendian)
21 ## uint16 xsize ; littleendian
22 ## uint16 ysize ; littleendian
23 ## 16 x uint8 r,g,b ; color map, in 6-bit format (each byte is 0..63)
25 ## Then, a sequence of nybbles:
27 ## N ... if N is != previous pixel, one pixel of color N
28 ## ... otherwise run sequence follows ...
29 ## M ... if M > 0 then run length is M+1
30 ## ... otherwise run sequence is encoded in two nybbles,
33 ## The nybble sequences are on a per-row basis; runs may not extend
34 ## across rows and odd-nybble rows are zero-padded.
36 ## At the start of row, the "previous pixel" is assumed to be zero.
40 ## ppmtolss16 [#rrggbb=i ...] < input.ppm > output.rle
42 ## Command line options of the form #rrggbb=i indicate that
43 ## the color #rrggbb (hex) should be assigned index i (decimal)
47 eval { binmode STDIN; };
48 eval { binmode STDOUT; };
52 # Get a token from the PPM header. Ignore comments and leading
53 # and trailing whitespace, as is required by the spec.
54 # This routine eats exactly one character of trailing whitespace,
55 # unless it is a comment (in which case it eats the comment up
56 # to and including the end of line.)
63 return undef if ( !defined($ch) ); # EOF
67 return undef if ( !defined($ch) );
68 } while ( $ch ne "\n" );
70 } while ( $ch =~ /^[ \t\n\v\f\r]$/ );
75 last if ( $ch =~ /^[ \t\n\v\f\r\#]$/ );
81 } while ( defined($ch) && $ch ne "\n" );
86 # Get a token, and make sure it is numeric (and exists)
87 sub get_numeric_token() {
88 my($token) = get_token();
90 if ( $token !~ /^[0-9]+$/ ) {
91 print STDERR "Format error on input\n";
98 # Must be called before each pixel row is read
100 $getrgb_leftover_bit_cnt = 0;
101 $getrgb_leftover_bit_val = 0;
104 # Get a single RGB token depending on the PNM type
110 # Raw PPM, most common
111 return undef unless ( read(STDIN,$rgb,3) == 3 );
112 return unpack("CCC", $rgb);
113 } elsif ( $form == 3 ) {
115 $r = get_numeric_token();
116 $g = get_numeric_token();
117 $b = get_numeric_token();
119 } elsif ( $form == 5 ) {
121 return undef unless ( read(STDIN,$rgb,1) == 1 );
122 $r = unpack("C", $rgb);
124 } elsif ( $form == 2 ) {
126 $r = get_numeric_token();
128 } elsif ( $form == 4 ) {
130 if ( !$getrgb_leftover_bit_cnt ) {
131 return undef unless ( read(STDIN,$rgb,1) == 1 );
132 $getrgb_leftover_bit_val = unpack("C", $rgb);
133 $getrgb_leftover_bit_cnt = 8;
135 $r = ( $getrgb_leftover_bit_val & 0x80 ) ? 0x00 : 0xff;
136 $getrgb_leftover_bit_val <<= 1;
137 $getrgb_leftover_bit_cnt--;
140 } elsif ( $form == 1 ) {
146 return undef if ( !defined($ch) );
147 return (255,255,255) if ( $ch eq '0' ); # White
148 return (0,0,0) if ( $ch eq '1'); # Black
152 return undef if ( !defined($ch) );
153 } while ( $ch ne "\n" );
155 } while ( $ch =~ /^[ \t\n\v\f\r]$/ );
158 die "Internal error: unknown format: $form\n";
162 sub rgbconvert($$$$) {
163 my($r,$g,$b,$maxmult) = @_;
166 $r = int($r*$maxmult);
167 $g = int($g*$maxmult);
168 $b = int($b*$maxmult);
169 $rgb = pack("CCC", $r, $g, $b);
173 foreach $arg ( @ARGV ) {
174 if ( $arg =~ /^\#([0-9a-f])([0-9a-f])([0-9a-f])=([0-9]+)$/i ) {
179 } elsif ( $arg =~ /^\#([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})=([0-9]+)$/i ) {
184 } elsif ( $arg =~ /^\#([0-9a-f]{3})([0-9a-f]{3})([0-9a-f]{3})=([0-9]+)$/i ) {
189 } elsif ( $arg =~ /^\#([0-9a-f]{4})([0-9a-f]{4})([0-9a-f]{4})=([0-9]+)$/i ) {
195 print STDERR "$0: Unknown argument: $arg\n";
200 print STDERR "$0: Color index out of range: $arg\n";
204 $rgb = rgbconvert($r, $g, $b, 64/256);
206 if ( defined($index_forced{$i}) ) {
207 print STDERR "$0: More than one color index $i\n";
210 $index_forced{$i} = $rgb;
211 $force_index{$rgb} = $i;
215 die "$0: stdin is not a PNM file" if ( $form !~ /^P([1-6])$/ );
218 $xsize = get_numeric_token();
219 $ysize = get_numeric_token();
220 if ( $form == 1 || $form == 4 ) {
221 $maxcol = 255; # Internal convention
223 $maxcol = get_numeric_token();
225 $maxmult = 64/($maxcol+1); # Equal buckets conversion
229 for ( $y = 0 ; $y < $ysize ; $y++ ) {
231 for ( $x = 0 ; $x < $xsize ; $x++ ) {
232 die "$0: Premature EOF at ($x,$y) of ($xsize,$ysize)\n"
233 if ( !defined(@pnmrgb = getrgb($form)) );
234 # Convert to 6-bit representation
235 $rgb = rgbconvert($pnmrgb[0], $pnmrgb[1], $pnmrgb[2], $maxmult);
236 $color_count{$rgb}++;
241 # Sort list of colors according to freqency
242 @colors = sort { $color_count{$b} <=> $color_count{$a} } keys(%color_count);
244 # Now we have our pick of colors. Sort according to intensity;
245 # this is more or less an ugly hack to cover for the fact that
246 # using PPM as input doesn't let the user set the color map,
247 # which the user really needs to be able to do.
250 my($ra,$ga,$ba) = unpack("CCC", $a);
251 my($rb,$gb,$bb) = unpack("CCC", $b);
253 my($ia) = $ra*0.299 + $ga*0.587 + $ba*0.114;
254 my($ib) = $rb*0.299 + $gb*0.587 + $bb*0.114;
256 return ( $ia <=> $ib ) if ( $ia != $ib );
258 # If same, sort based on RGB components,
259 # with highest priority given to G, then R, then B.
261 return ( $ga <=> $gb ) if ( $ga != $gb );
262 return ( $ra <=> $rb ) if ( $ra != $rb );
263 return ( $ba <=> $bb );
266 @icolors = sort by_intensity @colors;
268 # Insert forced colors into "final" array
269 @colors = (undef) x 16;
270 foreach $rgb ( keys(%force_index) ) {
271 $i = $force_index{$rgb};
273 $color_index{$rgb} = $i;
278 # Insert remaining colors in the remaining slots,
279 # in luminosity-sorted order
281 while ( scalar(@icolors) ) {
282 # Advance to the next free slot
283 $nix++ while ( defined($colors[$nix]) && $nix < 16 );
284 last if ( $nix >= 16 );
285 $rgb = shift @icolors;
286 if ( !defined($color_index{$rgb}) ) {
287 $colors[$nix] = $rgb;
288 $color_index{$rgb} = $nix;
292 while ( scalar(@icolors) ) {
293 $rgb = shift @icolors;
294 $lost++ if ( !defined($color_index{$rgb}) );
299 "$0: Warning: color palette truncated (%d colors ignored)\n", $lost;
305 print pack("Vvv", $magic, $xsize, $ysize);
308 for ( $i = 0 ; $i < 16 ; $i++ ) {
309 if ( defined($colors[$i]) ) {
312 # Padding for unused color entries
313 print pack("CCC", 63*$i/15, 63*$i/15, 63*$i/15);
317 sub output_nybble($) {
320 if ( !defined($ny) ) {
321 if ( defined($nybble_tmp) ) {
322 $ny = 0; # Force the last byte out
330 if ( defined($nybble_tmp) ) {
331 $ny = ($ny << 4) | $nybble_tmp;
340 sub output_run($$$) {
341 my($last,$this,$run) = @_;
343 if ( $this != $last ) {
344 output_nybble($this);
349 output_nybble($this);
358 output_nybble($erun);
359 output_nybble($erun >> 4);
361 output_nybble($this);
371 for ( $y = 0 ; $y < $ysize ; $y++ ) {
374 for ( $x = 0 ; $x < $xsize ; $x++ ) {
376 $i = $color_index{$rgb} + 0;
380 output_run($prev, $last, $run);
386 # Output final datum for row; we're always at least one pixel behind
387 output_run($prev, $last, $run);
388 output_nybble(undef); # Flush row
391 $pixels = $xsize * $ysize;
392 $size = ($pixels+1)/2;
393 printf STDERR "%d pixels, %d bytes, (%2.2f%% compression)\n",
394 $pixels, $bytes, 100*($size-$bytes)/$size;