1#!/usr/bin/perl 2## ----------------------------------------------------------------------- 3## 4## Copyright 2004-2008 H. Peter Anvin - All Rights Reserved 5## 6## This program is free software; you can redistribute it and/or modify 7## it under the terms of the GNU General Public License as published by 8## the Free Software Foundation, Inc., 53 Temple Place Ste 330, 9## Boston MA 02111-1307, USA; either version 2 of the License, or 10## (at your option) any later version; incorporated herein by reference. 11## 12## ----------------------------------------------------------------------- 13 14## 15## ppmtolss16 16## 17## Convert a PNM file with max 16 colors to a simple RLE-based format: 18## 19## uint32 0x1413f33d ; magic (littleendian) 20## uint16 xsize ; littleendian 21## uint16 ysize ; littleendian 22## 16 x uint8 r,g,b ; color map, in 6-bit format (each byte is 0..63) 23## 24## Then, a sequence of nybbles: 25## 26## N ... if N is != previous pixel, one pixel of color N 27## ... otherwise run sequence follows ... 28## M ... if M > 0 then run length is M 29## ... otherwise run sequence is encoded in two nybbles, 30## littleendian, +16 31## 32## The nybble sequences are on a per-row basis; runs may not extend 33## across rows and odd-nybble rows are zero-padded. 34## 35## At the start of row, the "previous pixel" is assumed to be zero. 36## 37## Usage: 38## 39## ppmtolss16 [#rrggbb=i ...] < input.ppm > output.rle 40## 41## Command line options of the form #rrggbb=i indicate that 42## the color #rrggbb (hex) should be assigned index i (decimal) 43## 44 45eval { use bytes; }; 46eval { binmode STDIN; }; 47eval { binmode STDOUT; }; 48 49$magic = 0x1413f33d; 50 51# Get a token from the PPM header. Ignore comments and leading 52# and trailing whitespace, as is required by the spec. 53# This routine eats exactly one character of trailing whitespace, 54# unless it is a comment (in which case it eats the comment up 55# to and including the end of line.) 56sub get_token() { 57 my($token, $ch); 58 my($ch); 59 60 do { 61 $ch = getc(STDIN); 62 return undef if ( !defined($ch) ); # EOF 63 if ( $ch eq '#' ) { 64 do { 65 $ch = getc(STDIN); 66 return undef if ( !defined($ch) ); 67 } while ( $ch ne "\n" ); 68 } 69 } while ( $ch =~ /^[ \t\n\v\f\r]$/ ); 70 71 $token = $ch; 72 while ( 1 ) { 73 $ch = getc(STDIN); 74 last if ( $ch =~ /^[ \t\n\v\f\r\#]$/ ); 75 $token .= $ch; 76 } 77 if ( $ch eq '#' ) { 78 do { 79 $ch = getc(STDIN); 80 } while ( defined($ch) && $ch ne "\n" ); 81 } 82 return $token; 83} 84 85# Get a token, and make sure it is numeric (and exists) 86sub get_numeric_token() { 87 my($token) = get_token(); 88 89 if ( $token !~ /^[0-9]+$/ ) { 90 print STDERR "Format error on input\n"; 91 exit 1; 92 } 93 94 return $token + 0; 95} 96 97# Must be called before each pixel row is read 98sub start_new_row() { 99 $getrgb_leftover_bit_cnt = 0; 100 $getrgb_leftover_bit_val = 0; 101} 102 103# Get a single RGB token depending on the PNM type 104sub getrgb($) { 105 my($form) = @_; 106 my($rgb,$r,$g,$b); 107 108 if ( $form == 6 ) { 109 # Raw PPM, most common 110 return undef unless ( read(STDIN,$rgb,3) == 3 ); 111 return unpack("CCC", $rgb); 112 } elsif ( $form == 3 ) { 113 # Plain PPM 114 $r = get_numeric_token(); 115 $g = get_numeric_token(); 116 $b = get_numeric_token(); 117 return ($r,$g,$b); 118 } elsif ( $form == 5 ) { 119 # Raw PGM 120 return undef unless ( read(STDIN,$rgb,1) == 1 ); 121 $r = unpack("C", $rgb); 122 return ($r,$r,$r); 123 } elsif ( $form == 2 ) { 124 # Plain PGM 125 $r = get_numeric_token(); 126 return ($r,$r,$r); 127 } elsif ( $form == 4 ) { 128 # Raw PBM 129 if ( !$getrgb_leftover_bit_cnt ) { 130 return undef unless ( read(STDIN,$rgb,1) == 1 ); 131 $getrgb_leftover_bit_val = unpack("C", $rgb); 132 $getrgb_leftover_bit_cnt = 8; 133 } 134 $r = ( $getrgb_leftover_bit_val & 0x80 ) ? 0x00 : 0xff; 135 $getrgb_leftover_bit_val <<= 1; 136 $getrgb_leftover_bit_cnt--; 137 138 return ($r,$r,$r); 139 } elsif ( $form == 1 ) { 140 # Plain PBM 141 my($ch); 142 143 do { 144 $ch = getc(STDIN); 145 return undef if ( !defined($ch) ); 146 return (255,255,255) if ( $ch eq '0' ); # White 147 return (0,0,0) if ( $ch eq '1'); # Black 148 if ( $ch eq '#' ) { 149 do { 150 $ch = getc(STDIN); 151 return undef if ( !defined($ch) ); 152 } while ( $ch ne "\n" ); 153 } 154 } while ( $ch =~ /^[ \t\n\v\f\r]$/ ); 155 return undef; 156 } else { 157 die "Internal error: unknown format: $form\n"; 158 } 159} 160 161sub rgbconvert($$$$) { 162 my($r,$g,$b,$maxmult) = @_; 163 my($rgb); 164 165 $r = int($r*$maxmult); 166 $g = int($g*$maxmult); 167 $b = int($b*$maxmult); 168 $rgb = pack("CCC", $r, $g, $b); 169 return $rgb; 170} 171 172foreach $arg ( @ARGV ) { 173 if ( $arg =~ /^\#([0-9a-f])([0-9a-f])([0-9a-f])=([0-9]+)$/i ) { 174 $r = hex($1) << 4; 175 $g = hex($2) << 4; 176 $b = hex($3) << 4; 177 $i = $4 + 0; 178 } elsif ( $arg =~ /^\#([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})=([0-9]+)$/i ) { 179 $r = hex($1); 180 $g = hex($2); 181 $b = hex($3); 182 $i = $4 + 0; 183 } elsif ( $arg =~ /^\#([0-9a-f]{3})([0-9a-f]{3})([0-9a-f]{3})=([0-9]+)$/i ) { 184 $r = hex($1) >> 4; 185 $g = hex($2) >> 4; 186 $b = hex($3) >> 4; 187 $i = $4 + 0; 188 } elsif ( $arg =~ /^\#([0-9a-f]{4})([0-9a-f]{4})([0-9a-f]{4})=([0-9]+)$/i ) { 189 $r = hex($1) >> 8; 190 $g = hex($2) >> 8; 191 $b = hex($3) >> 8; 192 $i = $4 + 0; 193 } else { 194 print STDERR "$0: Unknown argument: $arg\n"; 195 next; 196 } 197 198 if ( $i > 15 ) { 199 print STDERR "$0: Color index out of range: $arg\n"; 200 next; 201 } 202 203 $rgb = rgbconvert($r, $g, $b, 64/256); 204 205 if ( defined($index_forced{$i}) ) { 206 print STDERR "$0: More than one color index $i\n"; 207 exit(1); 208 } 209 $index_forced{$i} = $rgb; 210 $force_index{$rgb} = $i; 211} 212 213$form = get_token(); 214die "$0: stdin is not a PNM file" if ( $form !~ /^P([1-6])$/ ); 215$form = $1+0; 216 217$xsize = get_numeric_token(); 218$ysize = get_numeric_token(); 219if ( $form == 1 || $form == 4 ) { 220 $maxcol = 255; # Internal convention 221} else { 222 $maxcol = get_numeric_token(); 223} 224$maxmult = 64/($maxcol+1); # Equal buckets conversion 225 226@data = (); 227 228for ( $y = 0 ; $y < $ysize ; $y++ ) { 229 start_new_row(); 230 for ( $x = 0 ; $x < $xsize ; $x++ ) { 231 die "$0: Premature EOF at ($x,$y) of ($xsize,$ysize)\n" 232 if ( !scalar(@pnmrgb = getrgb($form)) ); 233 # Convert to 6-bit representation 234 $rgb = rgbconvert($pnmrgb[0], $pnmrgb[1], $pnmrgb[2], $maxmult); 235 $color_count{$rgb}++; 236 push(@data, $rgb); 237 } 238} 239 240# Sort list of colors according to freqency 241@colors = sort { $color_count{$b} <=> $color_count{$a} } keys(%color_count); 242 243# Now we have our pick of colors. Sort according to intensity; 244# this is more or less an ugly hack to cover for the fact that 245# using PPM as input doesn't let the user set the color map, 246# which the user really needs to be able to do. 247 248sub by_intensity() { 249 my($ra,$ga,$ba) = unpack("CCC", $a); 250 my($rb,$gb,$bb) = unpack("CCC", $b); 251 252 my($ia) = $ra*0.299 + $ga*0.587 + $ba*0.114; 253 my($ib) = $rb*0.299 + $gb*0.587 + $bb*0.114; 254 255 return ( $ia <=> $ib ) if ( $ia != $ib ); 256 257 # If same, sort based on RGB components, 258 # with highest priority given to G, then R, then B. 259 260 return ( $ga <=> $gb ) if ( $ga != $gb ); 261 return ( $ra <=> $rb ) if ( $ra != $rb ); 262 return ( $ba <=> $bb ); 263} 264 265@icolors = sort by_intensity @colors; 266 267# Insert forced colors into "final" array 268@colors = (undef) x 16; 269foreach $rgb ( keys(%force_index) ) { 270 $i = $force_index{$rgb}; 271 $colors[$i] = $rgb; 272 $color_index{$rgb} = $i; 273} 274 275undef %force_index; 276 277# Insert remaining colors in the remaining slots, 278# in luminosity-sorted order 279$nix = 0; 280while ( scalar(@icolors) ) { 281 # Advance to the next free slot 282 $nix++ while ( defined($colors[$nix]) && $nix < 16 ); 283 last if ( $nix >= 16 ); 284 $rgb = shift @icolors; 285 if ( !defined($color_index{$rgb}) ) { 286 $colors[$nix] = $rgb; 287 $color_index{$rgb} = $nix; 288 } 289} 290 291while ( scalar(@icolors) ) { 292 $rgb = shift @icolors; 293 $lost++ if ( !defined($color_index{$rgb}) ); 294} 295 296if ( $lost ) { 297 printf STDERR 298 "$0: Warning: color palette truncated (%d colors ignored)\n", $lost; 299} 300 301undef @icolors; 302 303# Output header 304print pack("Vvv", $magic, $xsize, $ysize); 305 306# Output color map 307for ( $i = 0 ; $i < 16 ; $i++ ) { 308 if ( defined($colors[$i]) ) { 309 print $colors[$i]; 310 } else { 311 # Padding for unused color entries 312 print pack("CCC", 63*$i/15, 63*$i/15, 63*$i/15); 313 } 314} 315 316sub output_nybble($) { 317 my($ny) = @_; 318 319 if ( !defined($ny) ) { 320 if ( defined($nybble_tmp) ) { 321 $ny = 0; # Force the last byte out 322 } else { 323 return; 324 } 325 } 326 327 $ny = $ny & 0x0F; 328 329 if ( defined($nybble_tmp) ) { 330 $ny = ($ny << 4) | $nybble_tmp; 331 print chr($ny); 332 $bytes++; 333 undef $nybble_tmp; 334 } else { 335 $nybble_tmp = $ny; 336 } 337} 338 339sub output_run($$$) { 340 my($last,$this,$run) = @_; 341 342 if ( $this != $last ) { 343 output_nybble($this); 344 $run--; 345 } 346 while ( $run ) { 347 if ( $run >= 16 ) { 348 output_nybble($this); 349 output_nybble(0); 350 if ( $run > 271 ) { 351 $erun = 255; 352 $run -= 271; 353 } else { 354 $erun = $run-16; 355 $run = 0; 356 } 357 output_nybble($erun); 358 output_nybble($erun >> 4); 359 } else { 360 output_nybble($this); 361 output_nybble($run); 362 $run = 0; 363 } 364 } 365} 366 367$bytes = 0; 368undef $nybble_tmp; 369 370for ( $y = 0 ; $y < $ysize ; $y++ ) { 371 $last = $prev = 0; 372 $run = 0; 373 for ( $x = 0 ; $x < $xsize ; $x++ ) { 374 $rgb = shift(@data); 375 $i = $color_index{$rgb} + 0; 376 if ( $i == $last ) { 377 $run++; 378 } else { 379 output_run($prev, $last, $run); 380 $prev = $last; 381 $last = $i; 382 $run = 1; 383 } 384 } 385 # Output final datum for row; we're always at least one pixel behind 386 output_run($prev, $last, $run); 387 output_nybble(undef); # Flush row 388} 389 390$pixels = $xsize * $ysize; 391$size = ($pixels+1)/2; 392printf STDERR "%d pixels, %d bytes, (%2.2f%% compression)\n", 393 $pixels, $bytes, 100*($size-$bytes)/$size; 394