#!/usr/bin/perl
## $Id$
## -----------------------------------------------------------------------
##   
##   Copyright 2001 H. Peter Anvin - All Rights Reserved
##
##   This program is free software; you can redistribute it and/or modify
##   it under the terms of the GNU General Public License as published by
##   the Free Software Foundation, Inc., 675 Mass Ave, Cambridge MA 02139,
##   USA; either version 2 of the License, or (at your option) any later
##   version; incorporated herein by reference.
##
## -----------------------------------------------------------------------

##
## ppmtolss16
##
## Convert a "raw" PPM file with max 16 colors to a simple RLE-based format:
##
## uint32 0x1413f33d    ; magic (littleendian)
## uint16 xsize		; littleendian
## uint16 ysize		; littleendian
## 16 x uint8 r,g,b	; color map, in 6-bit format (each byte is 0..63)
##
## Then, a sequence of nybbles:
##
## N	... if N is != previous pixel, one pixel of color N
## ... otherwise run sequence follows ...
## M    ... if M > 0 then run length is M+1
## ... otherwise run sequence is encoded in two nybbles,
##     littleendian, +17
##
## The nybble sequences are on a per-row basis; runs may not extend
## across rows and odd-nybble rows are zero-padded.
##
## At the start of row, the "previous pixel" is assumed to be zero.
##
## BUG: This program does not handle comments in the header, nor
## "plain" ppm format.
##
## Usage:
##
##	ppmtorle16 [#rrggbb=i ...] < input.ppm > output.rle
##
## Command line options of the form #rrggbb=i indicate that
## the color #rrggbb (hex) should be assigned index i (decimal)
##

$magic = 0x1413f33d;

sub rgbconvert($$) {
    my($rgb,$maxmult) = @_;
    my($r,$g,$b);

    ($r, $g, $b) = unpack("CCC", $rgb);
    $r = int($r*$maxmult);
    $g = int($g*$maxmult);
    $b = int($b*$maxmult);
    $rgb = pack("CCC", $r, $g, $b);
    return $rgb;
}

foreach $arg ( @ARGV ) {
    if ( $arg =~ /^\#([0-9a-f])([0-9a-f])([0-9a-f])=([0-9]+)$/i ) {
	$r = hex($1) << 4;
	$g = hex($2) << 4;
	$b = hex($3) << 4;
	$i = $4 + 0;
    } elsif ( $arg =~ /^\#([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})=([0-9]+)$/i ) {
	$r = hex($1);
	$g = hex($2);
	$b = hex($3);
	$i = $4 + 0;
    } elsif ( $arg =~ /^\#([0-9a-f]{3})([0-9a-f]{3})([0-9a-f]{3})=([0-9]+)$/i ) {
	$r = hex($1) >> 4;
	$g = hex($2) >> 4;
	$b = hex($3) >> 4;
	$i = $4 + 0;
    } elsif ( $arg =~ /^\#([0-9a-f]{4})([0-9a-f]{4})([0-9a-f]{4})=([0-9]+)$/i ) {
	$r = hex($1) >> 8;
	$g = hex($2) >> 8;
	$b = hex($3) >> 8;
	$i = $4 + 0;
    } else {
	print STDERR "$0: Unknown argument: $arg\n";
	next;
    }

    if ( $i > 15 ) {
	print STDERR "$0: Color index out of range: $arg\n";
	next;
    }

    $rgb = rgbconvert(pack("CCC", $r, $g, $b), 64/256);

    if ( defined($index_forced{$i}) ) {
	print STDERR "$0: More than one color index $i\n";
	exit(1);
    }
    $index_forced{$i} = $rgb;
    $force_index{$rgb} = $i;
}

$form = <STDIN>;
die "$0: stdin is not a raw PPM file" if ( $form ne "P6\n" );
$sizes = <STDIN>;
chomp $sizes;
if ( $sizes !~ /^([0-9]+)\s+([0-9]+)\s*$/ ) {
    die "$0: Input format error 1\n";
}
$xsize = $1 + 0;
$ysize = $2 + 0;
$maxcol = <STDIN>;
$maxmult = 64/($maxcol+1); 	# Equal buckets conversion
chomp $maxcol;
if ( $maxcol !~ /^([0-9]+)\s*$/ ) {
    die "$0: Input format error 2\n";
}
$maxcol = $1 + 0;

@data = ();

for ( $y = 0 ; $y < $ysize ; $y++ ) {
    for ( $x = 0 ; $x < $xsize ; $x++ ) {
	die "$0: Premature EOF at ($x,$y) of ($xsize,$ysize)\n"
	    if ( read(STDIN, $rgb, 3) != 3 );
	# Convert to 6-bit representation
	$rgb = rgbconvert($rgb, $maxmult);
	$color_count{$rgb}++;
	push(@data, $rgb);
    }
}

# Sort list of colors according to freqency
@colors = sort { $color_count{$b} <=> $color_count{$a} } keys(%color_count);

# Now we have our pick of colors.  Sort according to intensity;
# this is more or less an ugly hack to cover for the fact that
# using PPM as input doesn't let the user set the color map,
# which the user really needs to be able to do.

sub by_intensity() {
    my($ra,$ga,$ba) = unpack("CCC", $a);
    my($rb,$gb,$bb) = unpack("CCC", $b);

    my($ia) = $ra*0.299 + $ga*0.587 + $ba*0.114;
    my($ib) = $rb*0.299 + $gb*0.587 + $bb*0.114;

    return ( $ia <=> $ib ) if ( $ia != $ib );

    # If same, sort based on RGB components,
    # with highest priority given to G, then R, then B.
    
    return ( $ga <=> $gb ) if ( $ga != $gb );
    return ( $ra <=> $rb ) if ( $ra != $rb );
    return ( $ba <=> $bb );
}

@icolors = sort by_intensity @colors;

# Insert forced colors into "final" array
@colors = (undef) x 16;
foreach $rgb ( keys(%force_index) ) {
    $i = $force_index{$rgb};
    $colors[$i] = $rgb;
    $color_index{$rgb} = $i;
}

undef %force_index;

# Insert remaining colors in the remaining slots,
# in luminosity-sorted order
$nix = 0;
while ( scalar(@icolors) ) {
    # Advance to the next free slot
    $nix++ while ( defined($colors[$nix]) && $nix < 16 );
    last if ( $nix >= 16 );
    $rgb = shift @icolors;
    if ( !defined($color_index{$rgb}) ) {
	$colors[$nix] = $rgb;
	$color_index{$rgb} = $nix;
    }
}

while ( scalar(@icolors) ) {
    $rgb = shift @icolors;
    $lost++ if ( !defined($color_index{$rgb}) );
}

if ( $lost ) {
    printf STDERR
	"$0: Warning: color palette truncated (%d colors ignored)\n", $lost;
}

undef @icolors;

# Output header
print pack("Vvv", $magic, $xsize, $ysize);

# Output color map
for ( $i = 0 ; $i < 16 ; $i++ ) {
    if ( defined($colors[$i]) ) {
	print $colors[$i];
    } else {
	# Padding for unused color entries
	print pack("CCC", 63*$i/15, 63*$i/15, 63*$i/15);
    }
}

sub output_nybble($) {
    my($ny) = @_;

    if ( !defined($ny) ) {
	if ( defined($nybble_tmp) ) {
	    $ny = 0;		# Force the last byte out
	} else {
	    return;
	}
    }

    $ny = $ny & 0x0F;

    if ( defined($nybble_tmp) ) {
	$ny = ($ny << 4) | $nybble_tmp;
	print chr($ny);
	$bytes++;
	undef $nybble_tmp;
    } else {
	$nybble_tmp = $ny;
    }
}

sub output_run($$$) {
    my($last,$this,$run) = @_;

    if ( $this != $last ) {
	output_nybble($this);
	$run--;
    }
    while ( $run ) {
	if ( $run >= 16 ) {
	    output_nybble($this);
	    output_nybble(0);
	    if ( $run > 271 ) {
		$erun = 255;
		$run -= 271;
	    } else {
		$erun = $run-16;
		$run = 0;
	    }
	    output_nybble($erun);
	    output_nybble($erun >> 4);
	} else {
	    output_nybble($this);
	    output_nybble($run);
	    $run = 0;
	}
    }
}
    
$bytes  = 0;
undef $nybble_tmp;

for ( $y = 0 ; $y < $ysize ; $y++ ) {
    $last = $prev = 0;
    $run = 0;
    for ( $x = 0 ; $x < $xsize ; $x++ ) {
	$rgb = shift(@data);
	$i   = $color_index{$rgb} + 0;
	if ( $i == $last ) {
	    $run++;
	} else {
	    output_run($prev, $last, $run);
	    $prev = $last;
	    $last = $i;
	    $run  = 1;
	}
    }
    # Output final datum for row; we're always at least one pixel behind
    output_run($prev, $last, $run);
    output_nybble(undef);	# Flush row
}

$pixels = $xsize * $ysize;
$size = ($pixels+1)/2;
printf STDERR "%d pixels, %d bytes, (%2.2f%% compression)\n",
    $pixels, $bytes, 100*($size-$bytes)/$size;