ppmtolss16

   1 #!/usr/bin/perl
   2 ## -----------------------------------------------------------------------
   3 ##
   4 ##   Copyright 2004 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+1
  29 ## ... otherwise run sequence is encoded in two nybbles,
  30 ##     littleendian, +17
  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
  45 eval { use bytes; };
  46 eval { binmode STDIN; };
  47 eval { 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.)
  56 sub 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)
  86 sub 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
  98 sub 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
 104 sub 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
 161 sub 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
 172 foreach $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();
 214 die "$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();
 219 if ( $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
 228 for ( $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 ( !defined(@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
 248 sub 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;
 269 foreach $rgb ( keys(%force_index) ) {
 270     $i = $force_index{$rgb};
 271     $colors[$i] = $rgb;
 272     $color_index{$rgb} = $i;
 273 }
 274
 275 undef %force_index;
 276
 277 # Insert remaining colors in the remaining slots,
 278 # in luminosity-sorted order
 279 $nix = 0;
 280 while ( 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
 291 while ( scalar(@icolors) ) {
 292     $rgb = shift @icolors;
 293     $lost++ if ( !defined($color_index{$rgb}) );
 294 }
 295
 296 if ( $lost ) {
 297     printf STDERR
 298         "$0: Warning: color palette truncated (%d colors ignored)\n", $lost;
 299 }
 300
 301 undef @icolors;
 302
 303 # Output header
 304 print pack("Vvv", $magic, $xsize, $ysize);
 305
 306 # Output color map
 307 for ( $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
 316 sub 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
 339 sub 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;
 368 undef $nybble_tmp;
 369
 370 for ( $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;
 392 printf STDERR "%d pixels, %d bytes, (%2.2f%% compression)\n",
 393     $pixels, $bytes, 100*($size-$bytes)/$size;