#!/usr/bin/perl -w
# $Id: faum-fixppm.in,v 1.2 2005/04/07 13:41:29 sistsigw Exp $
# Script transforms ppm files into the format needed by the FAUmachine pattern
# matcher. Also does some "nicing" of the files, so editing by hand becomes
# easier. Overwrites original file.

use strict;
use Getopt::Long ;

### Global Variable
my $color = "-1";
my $pointer = 0;
#
### Functions
sub fix($$){
	my ($ppm, $ppmnew) = @_;

	open(IN, "$ppm") or die "Could not open $ppm for reading: $!\n";
	open(OUT, ">$ppmnew") or die "Could not open $ppmnew for writing $!\n";

	my $in_pixmap = 0;
	my ($width, $height, $colors) = (0,0,0);
	my ($current_width, $current_height) = (0, 0);
	while (defined (my $line = <IN>)) {
		chomp $line;
		if (($line eq "P3")
			or ($line =~ m/^#/)
			or ($line =~ m/^\s*$/)){
			next ;
		}
		if ($line =~ m/^\s*([0-9]+)\s+([0-9]+)\s*$/) {
			$width = $1;
			$height = $2;
			print STDERR "   width = $width, height = $height\n";
			next;
		}
		if ($line =~ m/^\s*([0-9]+)\s*$/) {
			$colors = $1;
			$in_pixmap = 1;
			while (defined ($line = <IN>) and
				not ($line =~ m/^\s*(?:[0-9]+\s+)*[0-9]+\s*$/)) {
			}
			if ($color ne "-1") {
				if ($color =~ m/^\d+\s+\d+\s+\d+$/) {
					my ($r, $g, $b) = split (/\s+/, $color);
					my $hex = sprintf("0x%x%x%x", $r, $g, $b);
					$color = hex($hex);
				} elsif ($color =~ m/^[0-9a-fA-F]+$/){
					$color = hex("0x$color");
				}
			} elsif ($pointer){
				$line =~ s/^\s+//;
				$line =~ s/\s+$//;
				my ($r, $g, $b) = split (/\s+/, $line); # top left pixel
				my $hex = sprintf("0x%x%x%x", $r, $g, $b);
				$color = hex($hex);
			}
			print OUT "P3\n# ignore $color\n$width $height\n256\n";
		}
		if ($in_pixmap and ($line =~ m/^\s*(?:[0-9]+\s+)*[0-9]+\s*$/)) {
			$line =~ s/^\s+//;
			$line =~ s/\s+$//;
			my @tmp = split (/\s+/, $line);
			my $cnt = 0;
			while (@tmp) {
				printf OUT "% 4d", shift @tmp;
				$cnt++;
				if (not $cnt%3) {
					$current_width++;
					if ($current_width == $width) {
						$cnt = 0;
						print OUT "\n";
						$current_height++;
						$current_width = 0;
					} else {
						print OUT " ";
					}
				}
			}
			next;
		}
		print STDERR "format error!\n";
	}
	close(IN);
	close(OUT);
}
sub copy($$) {
    my ($from, $to) = @_ ;
    local (*FROM, *TO) ;
	chomp ($from, $to);
    open(FROM, "$from") or die "Could not open $from for reading: $!\n" ; 
    open(TO, ">$to") or die "Could not open $to for writing: $!\n" ;
    while(defined (my $line = <FROM>)) { print TO $line ; }
    close(FROM) ;
    close(TO) ;
}
sub help() {
	print STDERR "\n   Pass a ppm-file as argument.\n\n" 
		. "   This file will be transformed into the format\n"
		. "   understood by the FAUmachine pattern matcher.\n\n"
		. "   ***************************************************\n"
		. "   *** The original file __will__ be overwritten!! ***\n"
		. "   ***************************************************\n\n"
		. "   Possible options:\n"
		. "   --help, -h        prints this help.\n"
		. "   --ignorecolor=<color>, -i  Prints header-line to ignore a color.\n"
		. "                     (Use to ignore a background color for pointers.)\n"
		. "                     Parameter is a color.\n"
		. "                     The following formats are accepted:\n"
		. "                     <#> <#> <#>  Three space separated decimals\n"
		. "                                  giving the red/green/blue values\n"
		. "                                  (same order as appears in ppm -file).\n"
		. "                     <######>     Hexadecimal number not containing spaces\n"
		. "                                  For same red/green/blue values.\n"
		. "                     <#>          Decimal number taken as is.\n"
		. " --pointer, -p  file describes a pointer pattern. Set ignore\n"
		. "                color to color of top left pixel.\n";
	exit(1);
}
## MAIN
{
my $help = 0;
my $ret = Getopt::Long::GetOptions(
	"--ignorecolor|i=s" => \$color,
	"--help|h" => \$help,
	"--pointer|p" => \$pointer,
);

if (($color ne "-1")
	and ($color !~ m/^\d+$/)
	and ($color !~ m/^\d+\s+\d+\s+\d+$/)
	and ($color !~ m/^[0-9a-fA-F]+$/)){
	print STDERR "Illegal format for ignore-color parameter!\n";
	$help = 1;
}
if (($ret != 1) or $help) {
	help();
}
(@ARGV == 1) or help();
my $ppm = $ARGV[0];
my $ppmnew = "$ppm.new";
fix($ppm, $ppmnew);
copy($ppmnew, $ppm);
unlink($ppmnew) or die "Could not unlink $ppmnew: $!\n";
}
