#!/usr/bin/perl -w

# convert ppm to LKR

$colors = 0;
$i=0;
foreach (@ARGV){ # go through the command line arguments
    if(m/-o/i){ $ofile = $ARGV[$i+1]; }
    if(m/-i/i){ $ifile = $ARGV[$i+1]; }
    $i++;
}
($ifile && $ofile) ||    # both must be defined
    die "Usage: ppm2lkr.pl -i infile -o outfile\n";
open(INPUT, "$ifile")
    || die "Couldn't open $ifile for reading.\n";
open(OUTPUT, ">$ofile")
    || die "Couldn't open $ofile for writing.\n";

$all = join("",<INPUT>);
 
close(INPUT);

@data = split(/\s+/, $all);   #split into non-whitespace tokens
$format = shift @data;
$width = shift @data;
$height = shift @data;
$maxval = shift @data;
$maxval <= 256 ||
    die "PPM input file uses a maxval greater than 256 and is incompatible.\n";
($lr, $lg, $lb)=(-1,-1,-1); # guaranteed never to matter
$last = "";
$last_ct = 0;
$N_FLAG = 0;
for $i (1 .. ($height*$width)) {
    ($r,$g,$b, @data) = @data;
    $RGB = "$r:$g:$b";
    unless($colors{$RGB}){ #unless we've seen it before...
	$colors{$RGB} = ++$colors;
	   $colors <= 16
	       || die "PPM input file uses more than 16 distinct colors!\n";
    }

  #"$r:$g:$b"
    if($i > 1){ #past the boundary condition
	if($RGB eq $last){
	        #in a run
	    $last_ct++;
	    if($last_ct == 16){
		    #we have maxed a run
		push(@working, 16);
		push(@working, $RGB);
		$last_ct=0;
	    } # if (last_ct == 16)
	}else{
	        #just hit a color boundary
	        # pack the last one, start a new count
	    push(@working, $last_ct);
	    push(@working, $last);
	    $last_ct=1; #start counting on this new color
	} # if we hit a color boundary
    }else{ #very first pixel
	$last_ct = 1; #nothing else special needs to happen
    } #end internal processing loop
    $last = $RGB;  # we need to know for next time
} # end for all pixels
push (@working, $last_ct);  #the last one! just push it!
push (@working, $last);

#pack the color table into the file
%codes = reverse(%colors); #1-to-1, this is ok!
for $i (0 .. 15){
    if ($codes{$i} && $codes{$i} =~ m/^(\d+):(\d+):(\d+)$/) {
	$buf=pack("H3", $1, $2, $3);
    }
    else{
	$buf=pack("H3", 0, 0, 0);
    }
    print OUTPUT $buf;
}

#we're done dumping the color table
while(@working){
    # range of 4-bits covers 0-15, whereas values from 1-16
    $run = shift(@working)-1;
    $color = $colors{shift(@working)};
    $buf = pack ("H2", $run, $color);
    print OUTPUT $buf;
}
