lss16toppm

   1 #!/usr/bin/perl
   2 #
   3 # Convert an LSS-16 image to PPM
   4 #
   5 # Usage:
   6 #
   7 #       lss16toppm [-map] < file.lss > file.ppm
   8 #
   9 # The -map causes the color map to be output on stderr.
  10 #
  11
  12 $map = 0;
  13 foreach $arg ( @ARGV ) {
  14     if ( $arg eq '-map' ) {
  15         $map = 1;
  16     } else {
  17         print STDERR "$0: Unknown option: $arg\n";
  18         exit 127;
  19     }
  20 }
  21
  22 if ( read(STDIN, $header, 56) != 56 ) {
  23     print STDERR "$0: Short file\n";
  24     exit 1;
  25 }
  26
  27 ($magic, $xsize, $ysize, @colorset) = unpack("Vvvc48", $header);
  28
  29 if ( $magic != 0x1413f33d ) {
  30     print STDERR "$0: Invalid file format\n";
  31     exit 1;
  32 }
  33
  34 %color = ();
  35 for ( $i = 0 ; $i < 16 ; $i++ ) {
  36     $r = int((shift @colorset) * 255 / 63 + 0.5);
  37     $g = int((shift @colorset) * 255 / 63 + 0.5);
  38     $b = int((shift @colorset) * 255 / 63 + 0.5);
  39
  40     $color{$i} = pack("ccc", $r, $g, $b);
  41
  42     if ( $map ) {
  43         printf STDERR "#%02x%02x%02x=%d\n", $r, $g, $b, $i;
  44     }
  45 }
  46
  47 sub get_nybble() {
  48     my($ch,$n);
  49     if ( defined($nybble_buf) ) {
  50         $n = $nybble_buf;
  51         undef $nybble_buf;
  52     } else {
  53         if ( read(STDIN, $ch, 1) != 1 ) {
  54             print STDERR "$0: Short read on input (file corrupt)\n";
  55             exit 1;
  56         }
  57         $ch = ord($ch);
  58         $nybble_buf = $ch >> 4;
  59         $n = $ch & 0xF;
  60     }
  61     return $n;
  62 }
  63
  64 print "P6\n";
  65 print "$xsize $ysize\n";
  66 print "255\n";
  67
  68 for ( $y = 0 ; $y < $ysize ; $y++ ) {
  69     $x = 0;
  70     $last = 0;
  71     undef $nybble_buf;          # Nybble buffer starts clear on each line
  72     while ( $x < $xsize ) {
  73         $n = get_nybble();
  74
  75         if ( $n != $last ) {
  76             print $color{$n};
  77             $last = $n;
  78             $x++;
  79         } else {
  80             $c = get_nybble();
  81             if ( $c == 0 ) {
  82                 # Double-nybble run
  83                 $c = get_nybble();
  84                 $c += get_nybble() << 4;
  85                 $c += 16;
  86             }
  87             # Truncate overlong runs
  88             $c = $xsize-$x if ( $c > $xsize-$x );
  89             # Output run
  90             while ( $c ) {
  91                 print $color{$n};
  92                 $c--;
  93                 $x++;
  94             }
  95         }
  96     }
  97 }