#!/usr/bin/perl
# run the Rainbow checksum against a BASIC text file
# requires decb to tokenize the BASIC
# Jerry Stratton http://www.hoboes.com/Mimsy/hacks/coco/

use File::Temp qw/tempfile/;
use Term::ANSIColor;

$good = color 'green';
$bad = color 'red';
$clear = color 'reset';

while ($option = shift) {
	if ($option eq '--debug') {
		$debug = 1;
	} elsif ($option eq '--help') {
		help();
	} elsif ($option eq '--rcheck') {
		$useOriginalRcheck = 1;
	} elsif ($option eq '--shift') {
		$sum = shift;
	} elsif ($option eq '--verbose') {
		$verbose = 1;
	} elsif ($option =~ /^[1-9][0-9]*$/) {
		$bareCheckpointFound=1 if $#ARGV > -1;
		if ($bareCheckpointFound) {
			$highestLine = $option if $option > $highestLine;
			$checksumLines{$option} = -1;
		} else {
			$checksumLines{'END'} = $option;
		}
	} elsif ($option =~ /^([1-9][0-9]*):([0-9A-F]+)$/i) {
		$checksumLines{$1} = uc($2);
		$highestLine = $1 if $1 > $highestLine;
	} elsif ($option =~ /^:([0-9A-F]+)$/i) {
		$checksumLines{'END'} = uc($1);
	} elsif (!$basicFile && -f $option) {
		$basicFile = $option;
	} else {
		help("Unknown option $option");
	}
}

help("No input file provided.") if !$basicFile;

# first, tokenize the BASIC file
($tokenHandle, $tokenFile) = tempfile(UNLINK=>1);
`/usr/local/bin/decb copy -b -t "$basicFile" "$tokenFile"`;
print `hexdump -C $tokenFile` if $debug;

# then read the tokenized file
# character zero marks the end of a line, and thus also the beginning of a line
open $codeHandle, $tokenFile or die("Can't open $tokenFile: $!");
$code = do { local $/; <$codeHandle> };
close $codeHandle;

# finally, loop through the tokenized code and add up each character
$counter = -2;
while ($counter < length($code)) {
	$counter++;
	#will be zero when $counter is -1
	$character = substr($code, $counter, 1);
	$addend = ord($character);

	#line numbers need to be handled specially
	#character 0 marks the end of a line
	if ($addend == 0) {
		#advance beyond address of next line to this line's line number
		$counter += 3;
		#calculate line number
		my $linePartOne = ord(substr($code, $counter, 1));
		my $linePartTwo = ord(substr($code, $counter+1, 1));
		$line = $linePartOne*16*16 + $linePartTwo;

		#use the tokenized line number for the checksum
		$addend = $linePartOne + $linePartTwo;

		#advance past the line number
		$counter +=1;
	}

	if ($previousLine ne "" && ($verbose || $checksumLines{$previousLine}) && $line != $previousLine) {
		$expectedSum = $checksumLines{$previousLine};
		print "$previousLine:\t";
		showChecksum($expectedSum);
	}

	$sum += $addend;

	$previousLine = $line if $counter < length($code);
}

if (!%checksumLines || (%checksumLines && $previousLine > $highestLine)) {
	print "END:\t";
	showChecksum($checksumLines{'END'});
} elsif (%checksumLines && $previousLine < $highestLine) {
	print "END:\tNot finished\n";
}

sub showChecksum {
	my $expectedSum = shift;

	my $checksum = checksum();
	if ($useOriginalRcheck) {
		if ($expectedSum eq "" || $expectedSum eq "-1") {
			print $checksum;
		} elsif ($checksum eq $expectedSum) {
			print "$good$checksum$clear";
		} else {
			print "$bad$checksum ($expectedSum)$clear";
		}
		print "\n";
		return;
	}

	$checksum -= $accumulatedError;
	$checksum += 256 while $checksum < 0;

	if ($expectedSum == -1 || $expectedSum eq "")  {
		print $checksum;
	} elsif ($checksum == $expectedSum) {
		print "$good$checksum$clear";
		$previousError = 0;
	} elsif ($checksum != $expectedSum) {
		print "$bad$checksum\t";
		my $offBy = $checksum-$expectedSum;
		$offBy += 256 if $offBy < 0;
		my $offInverse = $offBy-256;
		$accumulatedError += $offBy if !$bareCheckpointFound;
		print $offBy, " (", $offInverse, ")";
		if ($offInverse == -16) {
			print "; possibly a dash where there should be an =?";
		} elsif ($offInverse == -18) {
			print "; possibly a 4 where there should be an F?";
		} elsif ($offBy == 120) {
			print "; possibly a comma where there should be a less than?";
		} elsif ($offBy == 31) {
			print"; possibly an O that should be a zero?";
		} elsif ($offInverse == -31) {
			print"; possibly a zero that should be an O?";
		} elsif ($offInverse == -32) {
			print "; possibly a missing space somewhere?";
		} elsif ($offInverse % 32 == 0) {
			print "; possibly missing spaces or lower case where there should be uppercase?";
		} elsif ($offInverse == -$previousError) {
			print "; possibly previous error was a typo?";
		} elsif ($offBy > 32 && $offBy < 91) {
			print "; possibly an extra ‘", chr($offBy), "’ character?";
		} elsif (-$offInverse > 32 && -$offInverse < 91) {
			print "; possibly a missing ‘", chr(-$offInverse), "’ character?";
		}
		$previousError = $offBy;
		print $clear;
	}
	print "\n";
}

sub help {
	my $message = shift;

	print "$0 [--debug] [--help] [--rcheck] <BASIC file to checksum> [<line numbers to report>]\n";
	print "\t--debug: show hexdump of BASIC file\n";
	print "\t--rcheck: use the original rcheck algorithm instead of rcheck+\n";
	print "\t--shift <x>: shift all checksums by x\n";
	print "\t--verbose: show checksum for all line numbers\n";
	print "\t[xxx]: print a checksum at line xxx\n";
	print "\t[xxx:yyy]: verify checksum yyy at line xxx\n";
	print "\t[:yyy]: verify checksum yyy at end of code\n";

	print "$message\n" if $message;
	exit;
}

sub checksum {
	if ($useOriginalRcheck) {
		return sprintf('%04X', $counter - 1);
	} else {
		return $sum%256;
	}
}
