ppmtolss16

   1 #!/usr/bin/perl
   2 ## $Id$
   3 ## -----------------------------------------------------------------------
   4 ##
   5 ##   Copyright 2004 H. Peter Anvin - All Rights Reserved
   6 ##
   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.
  12 ##
  13 ## -----------------------------------------------------------------------
  14
  15 ##
  16 ## ppmtolss16
  17 ##
  18 ## Convert a PNM file with max 16 colors to a simple RLE-based format:
  19 ##
  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)
  24 ##
  25 ## Then, a sequence of nybbles:
  26 ##
  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,
  31 ##     littleendian, +17
  32 ##
  33 ## The nybble sequences are on a per-row basis; runs may not extend
  34 ## across rows and odd-nybble rows are zero-padded.
  35 ##
  36 ## At the start of row, the "previous pixel" is assumed to be zero.
  37 ##
  38 ## Usage:
  39 ##
  40 ##      ppmtolss16 [#rrggbb=i ...] < input.ppm > output.rle
  41 ##
  42 ## Command line options of the form #rrggbb=i indicate that
  43 ## the color #rrggbb (hex) should be assigned index i (decimal)
  44 ##
  45
  46 eval { use bytes; };
  47 eval { binmode STDIN; };
  48 eval { binmode STDOUT; };
  49
  50 $magic = 0x1413f33d;
  51
  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.)
  57 sub get_token() {
  58     my($token, $ch);
  59     my($ch);
  60
  61     do {
  62         $ch = getc(STDIN);
  63         return undef if ( !defined($ch) ); # EOF
  64         if ( $ch eq '#' ) {
  65             do {
  66                 $ch = getc(STDIN);
  67                 return undef if ( !defined($ch) );
  68             } while ( $ch ne "\n" );
  69         }
  70     } while ( $ch =~ /^[ \t\n\v\f\r]$/ );
  71
  72     $token = $ch;
  73     while ( 1 ) {
  74         $ch = getc(STDIN);
  75         last if ( $ch =~ /^[ \t\n\v\f\r\#]$/ );
  76         $token .= $ch;
  77     }
  78     if ( $ch eq '#' ) {
  79         do {
  80             $ch = getc(STDIN);
  81         } while ( defined($ch) && $ch ne "\n" );
  82     }
  83     return $token;
  84 }
  85
  86 # Get a token, and make sure it is numeric (and exists)
  87 sub get_numeric_token() {
  88     my($token) = get_token();
  89
  90     if ( $token !~ /^[0-9]+$/ ) {
  91         print STDERR "Format error on input\n";
  92         exit 1;
  93     }
  94
  95     return $token + 0;
  96 }
  97
  98 # Must be called before each pixel row is read
  99 sub start_new_row() {
 100     $getrgb_leftover_bit_cnt = 0;
 101     $getrgb_leftover_bit_val = 0;
 102 }
 103
 104 # Get a single RGB token depending on the PNM type
 105 sub getrgb($) {
 106     my($form) = @_;
 107     my($rgb,$r,$g,$b);
 108
 109     if ( $form == 6 ) {
 110         # Raw PPM, most common
 111         return undef unless ( read(STDIN,$rgb,3) == 3 );
 112         return unpack("CCC", $rgb);
 113     } elsif ( $form == 3 ) {
 114         # Plain PPM
 115         $r = get_numeric_token();
 116         $g = get_numeric_token();
 117         $b = get_numeric_token();
 118         return ($r,$g,$b);
 119     } elsif  ( $form == 5 ) {
 120         # Raw PGM
 121         return undef unless ( read(STDIN,$rgb,1) == 1 );
 122         $r = unpack("C", $rgb);
 123         return ($r,$r,$r);
 124     } elsif ( $form == 2 ) {
 125         # Plain PGM
 126         $r = get_numeric_token();
 127         return ($r,$r,$r);
 128     } elsif ( $form == 4 ) {
 129         # Raw PBM
 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;
 134         }
 135         $r = ( $getrgb_leftover_bit_val & 0x80 ) ? 0x00 : 0xff;
 136         $getrgb_leftover_bit_val <<= 1;
 137         $getrgb_leftover_bit_cnt--;
 138
 139         return ($r,$r,$r);
 140     } elsif ( $form == 1 ) {
 141         # Plain PBM
 142         my($ch);
 143
 144         do {
 145             $ch = getc(STDIN);
 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
 149             if ( $ch eq '#' ) {
 150                 do {
 151                     $ch = getc(STDIN);
 152                     return undef if ( !defined($ch) );
 153                 } while ( $ch ne "\n" );
 154             }
 155         } while ( $ch =~ /^[ \t\n\v\f\r]$/ );
 156         return undef;
 157     } else {
 158         die "Internal error: unknown format: $form\n";
 159     }
 160 }
 161
 162 sub rgbconvert($$$$) {
 163     my($r,$g,$b,$maxmult) = @_;
 164     my($rgb);
 165
 166     $r = int($r*$maxmult);
 167     $g = int($g*$maxmult);
 168     $b = int($b*$maxmult);
 169     $rgb = pack("CCC", $r, $g, $b);
 170     return $rgb;
 171 }
 172
 173 foreach $arg ( @ARGV ) {
 174     if ( $arg =~ /^\#([0-9a-f])([0-9a-f])([0-9a-f])=([0-9]+)$/i ) {
 175         $r = hex($1) << 4;
 176         $g = hex($2) << 4;
 177         $b = hex($3) << 4;
 178         $i = $4 + 0;
 179     } elsif ( $arg =~ /^\#([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})=([0-9]+)$/i ) {
 180         $r = hex($1);
 181         $g = hex($2);
 182         $b = hex($3);
 183         $i = $4 + 0;
 184     } elsif ( $arg =~ /^\#([0-9a-f]{3})([0-9a-f]{3})([0-9a-f]{3})=([0-9]+)$/i ) {
 185         $r = hex($1) >> 4;
 186         $g = hex($2) >> 4;
 187         $b = hex($3) >> 4;
 188         $i = $4 + 0;
 189     } elsif ( $arg =~ /^\#([0-9a-f]{4})([0-9a-f]{4})([0-9a-f]{4})=([0-9]+)$/i ) {
 190         $r = hex($1) >> 8;
 191         $g = hex($2) >> 8;
 192         $b = hex($3) >> 8;
 193         $i = $4 + 0;
 194     } else {
 195         print STDERR "$0: Unknown argument: $arg\n";
 196         next;
 197     }
 198
 199     if ( $i > 15 ) {
 200         print STDERR "$0: Color index out of range: $arg\n";
 201         next;
 202     }
 203
 204     $rgb = rgbconvert($r, $g, $b, 64/256);
 205
 206     if ( defined($index_forced{$i}) ) {
 207         print STDERR "$0: More than one color index $i\n";
 208         exit(1);
 209     }
 210     $index_forced{$i} = $rgb;
 211     $force_index{$rgb} = $i;
 212 }
 213
 214 $form = get_token();
 215 die "$0: stdin is not a PNM file" if ( $form !~ /^P([1-6])$/ );
 216 $form = $1+0;
 217
 218 $xsize = get_numeric_token();
 219 $ysize = get_numeric_token();
 220 if ( $form == 1 || $form == 4 ) {
 221     $maxcol = 255;              # Internal convention
 222 } else {
 223     $maxcol = get_numeric_token();
 224 }
 225 $maxmult = 64/($maxcol+1);      # Equal buckets conversion
 226
 227 @data = ();
 228
 229 for ( $y = 0 ; $y < $ysize ; $y++ ) {
 230     start_new_row();
 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}++;
 237         push(@data, $rgb);
 238     }
 239 }
 240
 241 # Sort list of colors according to freqency
 242 @colors = sort { $color_count{$b} <=> $color_count{$a} } keys(%color_count);
 243
 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.
 248
 249 sub by_intensity() {
 250     my($ra,$ga,$ba) = unpack("CCC", $a);
 251     my($rb,$gb,$bb) = unpack("CCC", $b);
 252
 253     my($ia) = $ra*0.299 + $ga*0.587 + $ba*0.114;
 254     my($ib) = $rb*0.299 + $gb*0.587 + $bb*0.114;
 255
 256     return ( $ia <=> $ib ) if ( $ia != $ib );
 257
 258     # If same, sort based on RGB components,
 259     # with highest priority given to G, then R, then B.
 260
 261     return ( $ga <=> $gb ) if ( $ga != $gb );
 262     return ( $ra <=> $rb ) if ( $ra != $rb );
 263     return ( $ba <=> $bb );
 264 }
 265
 266 @icolors = sort by_intensity @colors;
 267
 268 # Insert forced colors into "final" array
 269 @colors = (undef) x 16;
 270 foreach $rgb ( keys(%force_index) ) {
 271     $i = $force_index{$rgb};
 272     $colors[$i] = $rgb;
 273     $color_index{$rgb} = $i;
 274 }
 275
 276 undef %force_index;
 277
 278 # Insert remaining colors in the remaining slots,
 279 # in luminosity-sorted order
 280 $nix = 0;
 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;
 289     }
 290 }
 291
 292 while ( scalar(@icolors) ) {
 293     $rgb = shift @icolors;
 294     $lost++ if ( !defined($color_index{$rgb}) );
 295 }
 296
 297 if ( $lost ) {
 298     printf STDERR
 299         "$0: Warning: color palette truncated (%d colors ignored)\n", $lost;
 300 }
 301
 302 undef @icolors;
 303
 304 # Output header
 305 print pack("Vvv", $magic, $xsize, $ysize);
 306
 307 # Output color map
 308 for ( $i = 0 ; $i < 16 ; $i++ ) {
 309     if ( defined($colors[$i]) ) {
 310         print $colors[$i];
 311     } else {
 312         # Padding for unused color entries
 313         print pack("CCC", 63*$i/15, 63*$i/15, 63*$i/15);
 314     }
 315 }
 316
 317 sub output_nybble($) {
 318     my($ny) = @_;
 319
 320     if ( !defined($ny) ) {
 321         if ( defined($nybble_tmp) ) {
 322             $ny = 0;            # Force the last byte out
 323         } else {
 324             return;
 325         }
 326     }
 327
 328     $ny = $ny & 0x0F;
 329
 330     if ( defined($nybble_tmp) ) {
 331         $ny = ($ny << 4) | $nybble_tmp;
 332         print chr($ny);
 333         $bytes++;
 334         undef $nybble_tmp;
 335     } else {
 336         $nybble_tmp = $ny;
 337     }
 338 }
 339
 340 sub output_run($$$) {
 341     my($last,$this,$run) = @_;
 342
 343     if ( $this != $last ) {
 344         output_nybble($this);
 345         $run--;
 346     }
 347     while ( $run ) {
 348         if ( $run >= 16 ) {
 349             output_nybble($this);
 350             output_nybble(0);
 351             if ( $run > 271 ) {
 352                 $erun = 255;
 353                 $run -= 271;
 354             } else {
 355                 $erun = $run-16;
 356                 $run = 0;
 357             }
 358             output_nybble($erun);
 359             output_nybble($erun >> 4);
 360         } else {
 361             output_nybble($this);
 362             output_nybble($run);
 363             $run = 0;
 364         }
 365     }
 366 }
 367
 368 $bytes  = 0;
 369 undef $nybble_tmp;
 370
 371 for ( $y = 0 ; $y < $ysize ; $y++ ) {
 372     $last = $prev = 0;
 373     $run = 0;
 374     for ( $x = 0 ; $x < $xsize ; $x++ ) {
 375         $rgb = shift(@data);
 376         $i   = $color_index{$rgb} + 0;
 377         if ( $i == $last ) {
 378             $run++;
 379         } else {
 380             output_run($prev, $last, $run);
 381             $prev = $last;
 382             $last = $i;
 383             $run  = 1;
 384         }
 385     }
 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
 389 }
 390
 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;
 395
 396
 397
 398