#!/usr/bin/perl
# facilitate typing code from The Rainbow magazine by
# unwrapping 32-character lines to longer BASIC lines
# and attempting to do basic error checking along the way
# Jerry Stratton hoboes.com/coco/

use Term::ANSIColor;
$bad = color 'red';
$clear = color 'reset';

#command-line arguments
while ($option = shift @ARGV) {
	if ($option =~ /^--MLDATA$/i) {
		$machineData = 1;
	} elsif ($option =~ /^--customize/i) {
		$customize = 1;
	} elsif ($option =~ /^--help/i) {
		help();
	} elsif ($option =~ /^--regular/i) {
		if ($ARGV[0] =~ /^10|[1-9]/) {
			$evenLines = shift;
		} else {
			$evenLines = 10;
		}
	} elsif ($option =~ /^--warnings/i) {
		$warnings = 1;
	} else {
		$files[$#files+1] = $option;
	}
}
@ARGV = @files;

#loop through BASIC code
while (<>) {
	chomp;
	#ignore blank lines
	next if /^$/;

	#ignore top comments
	next if /^#/ && !defined($previousLineNumber);

	#added code
	if (/^\/\/([0-9]+) (.*)$/) {
		$customLineNumber = $1;
		$customLine = $2;
		die("\nCUSTOM LINE $lineNumber $customLine is out of order\n") if $customLineNumber <= $previousLineNumber;
		print "\n$customLineNumber $customLine" if $customize;
		next;
	}

	#if this is a new BASIC line, get the line number and the code in that line
	($lineNumber, $lineCode) = ($1, $2) if /^([0-9]+) (.*)$/;

	#if this is a new BASIC line, handle the old one and start the new one
	#note it is possible for a 33rd character to be a number followed by a space
	#and if the number is greater than the current line number, the script will
	#incorrectly detect a new line
	if (($lineNumber > $previousLineNumber && $lineCode !~ /^ELSE/) || (!defined($previousLineNumber) && $lineNumber eq "0")) {
		addWarning($lineNumber, "uneven increment: " . ($previousLineNumber+0) . " to $lineNumber") if $evenLines && defined($previousLineNumber) && ($lineNumber != 0 && $lineNumber != $previousLineNumber + $evenLines);
		print "\n" if $outputStarted;

		#errors or warnings on a full BASIC line basis

		#check that line is not too long
		#249 is the maximum that can be typed in initially;
		#but it is possible to get more into a line by editing it
		#longest so far: 255 characters
		die("\nLINE $previousLineNumber WAS $lineLength CHARACTERS LONG\n") if $lineLength > 255;

		#warnings, but not critical
		#lines with more than 249 characters will not be read correctly by xroar as text files
		addWarning($previousLineNumber, "has more than 249 characters ($lineLength)") if $lineLength > 249;
		addWarning($previousLineNumber, "= should be -?: $lineText") if $lineText =~ /(PUT|LINE)\([^-]+\)=\(/;
		addWarning($previousLineNumber, "Mistyped put?: $lineText") if $lineText =~ /(PUT|LINE)\([^-]+\)\(/;

		$noQuotes = $lineText;
		$noQuotes =~ s/"[^"]*"//g;
		$noQuotes =~ s/".*$//;
		$noQuotes =~ s/('|REM).*$//;
		addWarning($previousLineNumber, "has a lowercase character ($1)") if $noQuotes =~ /([a-z])/;

		#check for mismatched parentheses
		$openParenCount = () = $noQuotes =~ /\Q(/g;
		$closeParenCount = () = $noQuotes =~ /\Q)/g;
		die("\nLINE $previousLineNumber HAS MISMATCHED PARENTHESES\n") if $openParenCount != $closeParenCount && $lineCode !~ /^DATA/;

		#commas, semicolons, or quotes instead of colons
		die("\nLINE $previousLineNumber mistyped colon: $lineText\n") if $noQuotes =~ /[,;"][A-Z][A-Z0-9]?=/;

		#missing colon
		die("\nLINE $previousLineNumber missing colon: $lineText\n") if $noQuotes =~ /[0-9][A-Z][A-Z0-9]?\$?=/;

		#illegal and unlikely characters
		die("\nLINE $previousLineNumber has non-CoCo character: $lineText\n") if $lineText =~ s/([^ -z])/$bad->$1<-$clear/g;
		addWarning($previousLineNumber, "has unlikely character $1: $lineText") if $lineText =~ /([^ -Za-z^])/;

		collectLineReferences($previousLineNumber, $lineText);

		$lineLength = 0;
		$previousLineNumber = $lineNumber;
		$lineText = '';

		#is this a standalone DATA line?
		if ($lineCode =~ /^DATA(.*)$/) {
			$inData = 1;
			$dataElements = $1;
		} else {
			$inData = 0;
		}
	} else {
		#has the line number gone down or stayed the same?
		if ($lineNumber) {
			if ($lineNumber <= $previousLineNumber) {
				#if the previous line was exactly 32 characters long,
				#assume this is not actually a new line number but rather the
				#continuation of the previous one
				if ($previousLength != 32 || $lineCode =~ /^DATA /) {
					die("\nLINE $lineNumber COMES AFTER LINE $previousLineNumber: $_\n");
				#add a warning if this is not obviously a continuation of the current line
				} elsif ($lineText !~ /(&H|<)$/) {
					addWarning($previousLineNumber, "Assuming that $_ is a continuation of $lineText");
				}
			} else {
				addWarning($previousLineNumber, "Assuming that $_ is a continuation of $lineText");
			}
		}

		#sublines should be 32 characters
		if ($previousLength != 32) {
			print "\n" if $outputStarted;
			die("\nSUBLINE WAS NOT 32 CHARACTERS LONG in $previousLineNumber\n") if $previousLineNumber ne "";
			die("\nSOMETHING WRONG WITH FIRST LINE: $_\n");
		}
		$dataElements = $_ if $inData;
	}

	#print the line unless looking for warnings only
	if (!$warnings) {
		print;
		$outputStarted = 1;
	}

	$lineText .= $_;

	#these are for errors or warnings on a per-subline basis
	#no subline should be more than 32 characters long
	die("\nSUBLINE $_ LONGER THAN 32 CHARACTERS in $previousLineNumber\n") if length > 32;

	#if DATA elements are machine language codes, all characters should be hex or dec
	die("\nNON-HEX CHARACTER IN DATA SUBLINE $previousLineNumber: $_\n") if $machineData && $inData && $dataElements =~ /[^, 0-9A-F]/i;

	$previousLength = length;
	$lineLength += $previousLength;
	$lineNumber = '';
}
collectLineReferences($previousLineNumber, $lineText);

print "\n" if !$warnings;

if (@warnings) {
	print STDERR "WARNING:\n";
	for $warning (@warnings) {
		print STDERR "\t$warning\n";
	}
}

#verify that all line number references go to a line that exists
%existingLines = map { $_ => 1 } @existingLines;
foreach $lineReference (@lineReferences) {
	($lineNumber, $referenceType, $referencedLine) = @$lineReference;
	if (!exists($existingLines{$referencedLine})) {
		$notice = "$referenceType to non-existent line $referencedLine in $lineNumber";
		if ($referencedLine < $existingsLines[$#existingLines]) {
			print STDERR "$notice\n";
		} else {
			#if the lines are beyond the highest line number, we probably just haven't finished typing the program yet
			$highLineNotices[$#highLineNotices+1] = $notice;
		}
	}
}

if ($#highLineNotices > 0 && !$warnings) {
	print STDERR "\tThere are ", $#highLineNotices+1, " references to non-existent lines higher than the maximum line number.\n";
} elsif ($#highLineNotices >= 0) {
	print STDERR "\t" . join("\n\t", @highLineNotices) . "\n";
}

sub help {
	print "$0 [--mldata] [--help] [--warnings] [filenames]\n";
	print "merge 32-character RAINBOW lines into BASIC program, performing rudimentary error checking.\n";
	print "\t--customize: include customized code (code prepended with //)\n";
	print "\t--regular [1-10]: warn if line is not x greater than previous line\n";
	print "\t--mldata: assume that DATA lines all contain machine code\n";
	print "\t--help: print this help\n";
	print "\t--warnings: do not print code, only print warnings and errors\n";
	exit;
}

sub addWarning {
	my $lineNumber = shift;
	my $warning = shift;

	$warnings[$#warnings+1] = "LINE $lineNumber: $warning";
}

sub collectLineReferences {
	my $lineNumber = shift;
	my $lineText = shift;

	$existingLines[$#existingLines+1] = $lineNumber;
	while ($lineText =~ m/(GO *TO|GO *SUB|THEN) *([0-9]+)/g) {
		$lineReferences[$#lineReferences+1] = [$lineNumber, $1, $2];
	}
}
