#!/usr/bin/perl
# create BASIC for the TRS-80 Color Computer
# using full-length variables, loops, ifs, switches, subroutines, and more
# Jerry Stratton hoboes.com/coco
#1.0.0
#1.1.0 ELSEIF
#1.2.0 SWITCH ON

use POSIX qw(ceil);
use constant LINE_NUMBER => 0;
use constant LINE_CODE => 1;
use constant BLANK_BEFORE => 2;
use constant BLANK_AFTER => 3;
use constant MAJOR_VERSION => 1;
use constant MINOR_VERSION => 0;
use constant REVISION_VERSION => 0;

#defaults for Color Computer
$screenWidth = 32;
$seconds = 460;
$variableCharacters = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
$reservedWords = '(AS|FN|GO|IF|ON|OR|TO)';

#defaults for superBASIC
$labelFormat = '[A-Za-z][A-Za-z0-9_]+';
$variableFormat = '%' . $labelFormat . '[%\$]';
$constantFormat = '!' . $labelFormat . '%';
$lineIncrement = 10;
$basicIncludes = "$ENV{'HOME'}/.basic";
$version = join('.', (MAJOR_VERSION, MINOR_VERSION, REVISION_VERSION));

#read command-line arguments
while ($option = shift @ARGV) {
	if ($option eq '--help') {
		help();
	} elsif ($option eq '--switch') {
		$preprocessorSwitches[$#preprocessorSwitches+1] = shift;
	} elsif ($option eq '--variables') {
		$displayVariables = 1;
	} elsif ($option eq '--version') {
		print "$version\n";
		exit();
	} else {
		$files[$#files+1] = $option;
	}
}
@ARGV = @files;

#phase 1: collect lines for this program
@rawLines = collectLines('main', ARGV);

#phase 2: organize main code, data sets, and subroutines
($mainCode, $dataSets, $subroutines, $constants) = organizeLines(@rawLines);
@mainCode = @$mainCode;
@dataSets = @$dataSets;
%subroutines = %$subroutines;
%constants = %$constants;

#phase 3: expand superBASIC into CoCo code and number lines
$lineNumber = $lineIncrement;
($lineNumber, $linesOfBASIC) = expandLines('main', $lineNumber, @mainCode);
@linesOfBASIC = @$linesOfBASIC;

#first line does not get a blank before
$linesOfBASIC[0][BLANK_BEFORE] = 0 if $#linesOfBASIC > -1;

#add END statement
$linesOfBASIC[$#linesOfBASIC+1] = [$lineNumber, 'END', 1];
$lineNumber += 1;

#expand subroutines and add them to the main code
if (%subroutines) {
	$lineNumber += 1;
	$lineNumber = ceil($lineNumber/1000)*1000;
	foreach my $subroutine (sort keys %subroutines) {
		$lineNumber = ceil($lineNumber/100)*100;
		my $lines = $subroutines{$subroutine};
		my @lines = @$lines;
		$subroutineAddresses{$subroutine} = $lineNumber;
		my($newLineNumber, $newLines) = expandLines('main', $lineNumber, @$lines);
		$lineNumber = $newLineNumber;
		my @newLines = @$newLines;
		$newLines[0][BLANK_BEFORE] = 1;
		$newLines[1][BLANK_BEFORE] = 0;
		@linesOfBASIC = (@linesOfBASIC, @newLines);

		$linesOfBASIC[$#linesOfBASIC+1] = [$lineNumber, 'RETURN'];
		$lineNumber += 1;
	}
}

#expand data sets and add them to the main code
if (@dataSets) {
	$lineNumber += 1;
	$lineNumber = ceil($lineNumber/1000)*1000;
	foreach my $dataSet (@dataSets) {
		$lineNumber = ceil($lineNumber/100)*100;
		my @data = ();
		while (@$dataSet[0] =~ /^#/) {
			$data[$#data+1] = shift @$dataSet;
		}
		my $dataLine = '';
		foreach my $datum (@$dataSet) {
			if (!$dataLine) {
				$dataLine = "DATA $datum";
			} elsif (length("$lineNumber $dataLine,$datum") <= $screenWidth) {
				$dataLine .= ",$datum";
			} else {
				$data[$#data+1] = $dataLine;
				$dataLine = "DATA $datum";
			}
		}
		$data[$#data+1] = $dataLine if $dataLine;
		my($newLineNumber, $newLines) = expandLines('main', $lineNumber, @data);
		$lineNumber = $newLineNumber;
		my @newLines = @$newLines;
		$newLines[0][BLANK_BEFORE] = 1;
		@linesOfBASIC = (@linesOfBASIC, @newLines);
	}
}

#display information about this program's conversion
if ($displayVariables) {
	if (%variables) {
		print "VARIABLES:\n";
		foreach my $variable (sort keys %variables) {
			print "$variable:\t$variables{$variable}\n";
		}
	}

	if (%subroutineAddresses) {
		print "\n";
		print "SUBROUTINES:\n";
		foreach my $subroutine (sort keys %subroutineAddresses) {
			print "$subroutine:\t$subroutineAddresses{$subroutine}\n";
		}
	}

	if (%switches) {
		print "\n";
		print "SWITCHES:\n";
		foreach my $switch (sort keys %switches) {
			print "$switch:\t$switches{$switch}\n";
		}
	}

#phase 4: replace GOSUB line numbers and produce code
} else {
	my $previousBlankAfter;
	my $previousLineNumber;
	foreach my $lineData (@linesOfBASIC) {
		my($lineNumber, $lineCode, $blankBefore, $blankAfter) = @$lineData;
		print "\n" if $blankBefore && !$previousBlankAfter;

		#check for bugs in superbasic
		die("$lineNumber is not greater than $previousLineNumber ($lineCode)") if $lineNumber <= $previousLineNumber;
		my $lineJump = $lineNumber-$previousLineNumber;
		$lineJump = 10 if $lineJump < 10 && (int($previousLineNumber/10) != $previousLineNumber/10);
		print STDERR "$lineNumber is not expected after $previousLineNumber\n" if $lineJump != 1 && $lineJump != 10 && int($lineNumber/100) != $lineNumber/100;

		#check for potential typo in variable names
		foreach my $variable (values %variables) {
			my $unfinishedVariable = substr($variable, 0, -1);
			print STDERR "Possible typo: $unfinishedVariable in BASIC line $lineNumber $lineCode\n" if $lineCode =~ /$unfinishedVariable/i;
		}

		#convert GOSUBs from subroutine name to line number
		while ($lineCode =~ /GOSUB ([0-9]+, ){0,}([A-Z_]+)/) {
			my $subroutine = $2;
			my $address = $subroutineAddresses{$subroutine};
			die("No address for subroutine $subroutine") if !$address;
			$lineCode =~ s/GOSUB (([0-9]+, ?){0,})$subroutine/GOSUB $1$address/;
		}
		print "$lineNumber $lineCode\n";
		$previousLineNumber = $lineNumber;
		print "\n" if $blankAfter;
		$previousBlankAfter = $blankAfter;
	}
}

#collect only lines that matter
sub collectLines {
	my $scope = shift;
	my $handle = shift;

	my @rawLines;
	my $inCOMMENT;
	while (<$handle>) {
		chomp;
		s/^[ \t]+//;
		s/[ \t]+$//;

		#one-line comments
		next if /^\/\//;
		next if /^\/\*.*\*\/$/;

		#multiline comments and switches
		if ($inCOMMENT) {
			if (/\*\/$/) {
				$inCOMMENT = 0;
			}
			next;
		} elsif (/^\/\*/) {
			$inCOMMENT = 1;
			next;
		} elsif (/^#IFDEF (.+)$/i) {
			my $switch = $1;
			my @conditionalLines = collectLines('ifdef', $handle);
			@rawLines = (@rawLines, @conditionalLines) if grep(/^$switch$/, @preprocessorSwitches);
			$switches{$switch}++;
		} elsif (/^#ENDIFDEF$/i) {
			die("ENDIFDEF without IFDEF at $_") if $scope ne 'ifdef';
			return @rawLines;
		} elsif (/^#INCLUDE (.+)$/i) {
			my $includeFile = $1;
			$includeFile = "$basicIncludes/$includeFile" if !-f $includeFile;
			die("Unknown file $includeFile") if !-f $includeFile;
			die("Unable to open $includeFile") if !open($includeHandle, "<$includeFile");
			@rawLines = (@rawLines, collectLines('include', $includeHandle));
			next;
		} else {
			$rawLines[$#rawLines+1] = $_;
		}
	}
	die('Dangling preprocessor conditional inclusion') if $scope eq 'ifdef';
	return @rawLines;
}

#collect subroutines and DATA sections for placing at end of code
#data lines will be in order of appearance
#subroutines will be in alphabetical order
sub organizeLines {
	my $inDATA;
	my $inSUB;
	my @dataLines;
	my $maxDataLines;
	my $countConstant;
	my %constants;
	my @dataSets;
	my $subroutine;
	my @subroutineLines;
	my %subroutines;
	local @mainLines;

	foreach (@_) {
		s/($variableFormat)\+\+/$1=$1+1/g;
		s/($variableFormat)\-\-/$1=$1-1/g;
		s/($variableFormat) *([+*\/-])\= *([^:]+)/$1=$1$2$3/g;
		s/($variableFormat)/&variables($1)/ge;

		if (/^ENDDATA$/i) {
			die("Not in a DATA section at line $_\n") if !$inDATA;
			$inDATA = 0;
			$dataSets[$#dataSets+1] = [@dataLines];
			$constants{'!DATASETS%'}++;
			if ($countConstant) {
				$countConstant = uc($countConstant);
				die("Constant $countConstant already in use; $dataLines[0]") if $constants{$countConstant};
				$constants{$countConstant} = $#dataLines;
			}
			@dataLines = ();
		} elsif ($inDATA) {
			$dataLines[$#dataLines+1] = $_;
			die("DATA line $_ exceeds maximum of $maxDataLines") if $maxDataLines && $maxDataLines < grep(/^[^#]/, @dataLines);
		} elsif (/^DATA( +maxlines +([1-9][0-9]*))?( ($constantFormat))?$/i) {
			$inDATA = 1;
			$maxDataLines = $2;
			$countConstant = $4;
			my @remarks = getChunkRemarks();
			@dataLines = (@dataLines, @remarks);
		} elsif (/^SUB ($labelFormat)$/i) {
			die("Already in a subroutine at line $_\n") if $inSUB;
			$inSUB = 1;
			$subroutine = $1;
			die("Duplicate subroutine name $subroutine at line $_") if $subroutines{$subroutine};
			my @remarks = getChunkRemarks();
			@remarks = ("# " . nameToRemark($subroutine)) if !@remarks;
			@subroutineLines = (@subroutineLines, @remarks);
		} elsif (/^ENDSUB$/i) {
			die("Not in a subroutine at line $_\n") if !$inSUB;
			$inSUB = 0;
			$subroutines{uc($subroutine)} = [@subroutineLines];
			@subroutineLines = ();
		} elsif ($inSUB) {
			$subroutineLines[$#subroutineLines+1] = $_;
		} else {
			$mainLines[$#mainLines+1] = $_;
		}
	}
	#zero-base data set count
	$constants{'!DATASETS%'}--;

	die("Dangling data set; still waiting on ENDDATA") if $inDATA;
	die("Dangling subroutine; still waiting on ENDSUB") if $inSUB;

	return \@mainLines, \@dataSets, \%subroutines, \%constants;
}

#go back and get the remarks that are in front of DATA statements and subroutines
sub getChunkRemarks {
	my @remarks = ();
	while (@mainLines && $mainLines[$#mainLines] =~ /^#/) {
		$remarks[$#remarks+1] = $mainLines[$#mainLines];
		$#mainLines--;
	}
	return reverse @remarks;
}

#add numbers to each line, expand built-in macros, and convert blocks to BASIC
sub expandLines {
	my $endBlock = shift;
	my $lineNumber = shift;
	my @rawLines = @_;
	my @numberedLines;
	my $combineLines = 1;

	while ($#rawLines >= 0) {
		my $line = shift @rawLines;

		#uppercase everything
		$line =~ s/^(.*)$/\U$1\Q/;
		#lowercase marked items
		$line =~ s/\\\^L(((?!\\\^[LQ]).)+)\\\^Q/\L$1\Q/g;
		$line =~ s/\\\^L([A-Z])/\L$1\Q/g;

		#dynamic constants
		$line =~ s/($constantFormat)/&constants($1)/gei;

		my($newLineNumber, $newLines, $rawLines);
		if ($line =~ /^#(.*)/) {
			($newLineNumber, $newLines) = expandRemark($lineNumber, $1);
		} elsif ($line =~ /^IF \((.+)\) THEN$/) {
			($newLineNumber, $newLines, $rawLines) = constructIf($lineNumber, $1, @rawLines);
		} elsif ($line =~ /^LOOP( WHILE \((.+)\))?$/) {
			($newLineNumber, $newLines, $rawLines) = constructLoop($lineNumber, $2, @rawLines);
		} elsif ($line =~ /^SWITCH$/) {
			($newLineNumber, $newLines, $rawLines) = constructSwitch($lineNumber, @rawLines);
		} elsif ($endBlock ne 'main' && $line =~ /$endBlock/) {
			return $lineNumber, \@numberedLines, \@rawLines, $line, $combineLines;
		} elsif ($line =~ /^PAUSE *([0-9.]+)?$/) {
			my $pauseLine;
			if ($1) {
				my $counter = int($1 * $seconds);
				$pauseLine = "FOR I=1 TO $counter:NEXT I" if $counter;
			} else {
				$pauseLine = 'A$=INKEY$:IF A$ = "" THEN ' . $lineNumber;
				$combineLines = 0;
			}
			@numberedLines[$#numberedLines+1] = [$lineNumber, $pauseLine] if $pauseLine;
			$lineNumber += $lineIncrement;
			next;
		} elsif ($line =~ /^WRAP(-CENTER)? (.+)$/) {
			my $centered = $1;
			my $wrappableText = $2;
			($newLineNumber, $newLines) = wrapToScreen($lineNumber, $wrappableText, '', 'PRINT "', '"', $centered);
			$lineNumber = $newLineNumber;
			@numberedLines = (@numberedLines, @$newLines);
			next;
		} elsif ($line ne '') {
			$numberedLines[$#numberedLines+1] = [$lineNumber, $line] if $line;
			$lineNumber += $lineIncrement;
			$combineLines = $combineLines && !lineContainsJoinBlocker($line);
			next;
		} else {
			#this is an empty line
			next;
		}

		$lineNumber = $newLineNumber;
		@numberedLines = addBlock($newLines, @numberedLines);
		@rawLines = @$rawLines if $rawLines;
		$combineLines = 0;

		#remarks at the end of a non-remark block should not have a blank before
		#$rawLines is only set for real blocks, not for remark blocks
		$numberedLines[$#numberedLines][BLANK_BEFORE] = 0 if $numberedLines[$#numberedLines][LINE_CODE] =~ /^REM / && $rawLines;
	}

	die("Dangling block in code; expecting $endBlock") if $endBlock ne 'main';

	return $lineNumber, \@numberedLines;
}

#add new block code to existing code
sub addBlock {
	my $newLines = shift;
	my @lines = @_;
	my $lineIndex = $#lines+1;
	my @lines = (@lines, @$newLines);

	#don't insert a blank line if this block is only one-line long, or if blanking has already been handled
	return @lines if $#$newLines <= 0 || $lines[$lineIndex][BLANK_BEFORE];

	#insert a blank line before any remarks in front of this line
	if ($lines[$lineIndex-1][LINE_CODE] =~ /^REM /) {
		$lineIndex--;
		while ($lineIndex > -1 && $lines[$lineIndex][LINE_CODE] =~ /^REM /) {
			$lineIndex--;
		}
		$lineIndex++;
	}

	$lines[$lineIndex][BLANK_BEFORE] = 1;
	$lines[$#lines][BLANK_AFTER] = 1;
	return @lines;
}

#expand remark macro
sub expandRemark {
	my $lineNumber = shift;
	my $remark = shift;
	$remark =~ s/^[# ]+//;
	my @newLines;
	if ($remark) {
		my($newLineNumber, $newLines) = wrapToScreen($lineNumber, $remark, 'REM ');
		$lineNumber = $newLineNumber;
		@newLines = @$newLines;
	}

	$newLines[0][BLANK_BEFORE] = 1;
	return $lineNumber, \@newLines;
}

#wrap text for remarks and printing
sub wrapToScreen {
	my $lineNumber = shift;
	my $fullText = shift;
	my $prefix = shift;
	my $afterPrefix = shift;
	my $afterLine = shift;
	my $centered = shift;

	my @numberedLines;
	my $semicolonEnd = $afterPrefix =~ /^PRINT/ && $fullText =~ s/;$//;

	while ($fullText) {
		my $start = "$lineNumber $prefix";
		my $textWidth = $screenWidth-length($start);
		my $subText;

		if (length($fullText) <= $textWidth) {
			$subText = $fullText;
			$fullText = '';
			$afterLine .= ';' if $semicolonEnd;
		} else {
			my $spaceLocation = $textWidth+1;
			while ($spaceLocation && substr($fullText, $spaceLocation, 1) =~ /^[A-Za-z0-9'.\/]$/) {
				$spaceLocation--;
			}
			$spaceLocation = $textWidth if $spaceLocation == 0;
			$subText = substr($fullText, 0, $spaceLocation);
			my $choppedCharacter = substr($fullText, $spaceLocation, 1);
			$choppedCharacter = '' if $choppedCharacter =~ /^[ ,]$/;
			if ($spaceLocation < $textWidth) {
				$subText .= $choppedCharacter;
				$choppedCharacter = '';
			}
			$fullText = $choppedCharacter . substr($fullText, $spaceLocation+1);
			$fullText =~ s/^ +//;
		}

		$subText = ' ' x (($screenWidth-length($subText))/2) . $subText if $centered && length($subText)<($screenWidth-1);
		$numberedLines[$#numberedLines+1] = [$lineNumber, "$prefix$afterPrefix$subText$afterLine"];
		$lineNumber++;
	}
	$lineNumber = ceil($lineNumber/$lineIncrement)*$lineIncrement;

	return $lineNumber, \@numberedLines;
}

#construct IF/ELSE blocks
sub constructIf {
	my $lineNumber = shift;
	my $condition = shift;
	my @rawLines = @_;

	my $endIf = '^(ELSE|ENDIF)$';

	my $startLineNumber = $lineNumber;
	my @numberedLines = ([$lineNumber, "IF $condition THEN "]);
	$lineNumber += $lineIncrement;

	my @newLines;
	my $elseLineNumber;
	my $previousCombinable = 1;
	my $firstLineJumpNeeded;
	my $elseSkipNeeded;
	while () {
		#collect statements until next ELSE or ENDIF
		my($newLineNumber, $newLines, $rawLines, $endLine, $combinedBlock) = expandLines($endIf, $lineNumber, @rawLines);
		@newLines = @$newLines;
		@rawLines = @$rawLines;
		$lineNumber = $newLineNumber;

		#construct combined lines
		if ($combinedBlock) {
			my @savedLines = @newLines;
			my $firstLine = shift @newLines;
			if ($previousCombinable) {
				my $openingText = $numberedLines[$#numberedLines][LINE_CODE];
				$openingText .= ' ELSE ' if $elseLineNumber;
				$openingText .= @$firstLine[LINE_CODE];
				my($newLineNumber, $combinedLine) = combineLines($startLineNumber, $openingText, @newLines);
				if ($newLineNumber < 0) {
					$combinedBlock = 0;
					@newLines = @savedLines;
				} else {
					$lineNumber = $newLineNumber;
					@numberedLines = ($combinedLine);
				}
			} else {
				my $openingText = @$firstLine[LINE_CODE];
				my($newLineNumber, $combinedLine) = combineLines($elseLineNumber, $openingText, @newLines);
				if ($newLineNumber < 0) {
					$combinedBlock = 0;
					@newLines = @savedLines;
				} else {
					$lineNumber = $newLineNumber;
					@numberedLines[$#numberedLines+1] = $combinedLine;
				}
			}
		}

		#construct per-line version
		if (!$combinedBlock) {
			if ($elseLineNumber) {
				$numberedLines[0][LINE_CODE] .= ":GOTO $lineNumber" if $previousCombinable;
			} else {
				@numberedLines[$#numberedLines] = [$startLineNumber, "IF NOT ($condition) THEN "];
				$firstLineJumpNeeded = 1;
			}
			foreach my $numberedLine (@newLines) {
				my($number, $code, $before, $after) = @$numberedLine;
				$numberedLines[$#numberedLines+1] = [$number, $code, $before, $after];
			}
			if (!$elseLineNumber) {
				$numberedLines[$#numberedLines+1] = [$lineNumber, "GOTO "];
				$elseSkipNeeded = $#numberedLines;
				$lineNumber += $lineIncrement;
			}
		}

		$previousCombinable = $combinedBlock;
		last if $endLine eq 'ENDIF';
		$elseLineNumber = $lineNumber;
		$endIf = '^ENDIF$';
	}

	#remove the last GOTO line if there was no ELSE section and the IF was not combinable
	if (!$elseLineNumber && !$previousCombinable) {
		$#numberedLines--;
		$lineNumber -= $lineIncrement;
		$elseSkipNeeded = 0;
	}
	my $endLineNumber = $lineNumber;
	$endLineNumber = $elseLineNumber if $elseLineNumber;
	$numberedLines[0][LINE_CODE] .= $endLineNumber if $firstLineJumpNeeded;
	$numberedLines[$elseSkipNeeded][LINE_CODE] .= $lineNumber if $elseSkipNeeded;

	return $lineNumber, \@numberedLines, \@rawLines;
}

#construct LOOP WHILE/ENDLOOP UNLESS blocks
sub constructLoop {
	my $lineNumber = shift;
	my $startCondition = shift;
	my @rawLines = @_;

	my @numberedLines;
	my $endLoop = '^ENDLOOP( UNLESS \(([^#]+)\))?$';

	#remember start line
	my $startLineNumber = $lineNumber;

	#collect loop
	if ($startCondition) {
		@numberedLines = ([$lineNumber, "IF NOT ($startCondition) THEN "]);
		$lineNumber += $lineIncrement;
	}
	my($newLineNumber, $newLines, $rawLines, $endLine, $combinedBlock) = expandLines($endLoop, $lineNumber, @rawLines);
	my @newLines = @$newLines;
	@rawLines = @$rawLines;
	my @breaks;

	#construct combined loop
	if ($combinedBlock) {
		my @savedLines = @newLines;
		my $firstLine = shift @newLines;
		my $openingText = @$firstLine[LINE_CODE];
		$openingText = "IF $startCondition THEN $openingText" if $startCondition;
		my($newLineNumber, $combinedLine) = combineLines($startLineNumber, $openingText, @newLines);
		if ($newLineNumber < 0) {
			$combinedBlock = 0;
			@newLines = @savedLines;
		} else {
			$lineNumber = $newLineNumber;
			@numberedLines = ($combinedLine);
		}
	}

	#construct per-line loop
	if (!$combinedBlock) {
		foreach my $numberedLine (@newLines) {
			my($number, $code, $before, $after) = @$numberedLine;
			#BREAK IF should have canceled combinedBlock, so should only appear here
			if ($code =~ /^BREAK IF \((.+)\)$/) {
				$code = "IF $1 THEN ";
				$breaks[$#breaks+1] = $#numberedLines+1;
			} elsif ($code =~ /^CONTINUE$/) {
				$code = "GOTO $startLineNumber";
			}
			$numberedLines[$#numberedLines+1] = [$number, $code, $before, $after];
		}
		$lineNumber = $newLineNumber;
	}

	#handle endloop unless
	my $loopLine;
	$endLine =~ m/$endLoop/;
	my $endCondition = $2;
	if ($endCondition) {
		$loopLine = "IF $endCondition THEN $startLineNumber";
	} else {
		$loopLine = "GOTO $startLineNumber";
	}
	if ($combinedBlock) {
		$numberedLines[$#numberedLines][LINE_CODE] .= ":$loopLine";
	} else {
		$numberedLines[$#numberedLines+1] = [$lineNumber, $loopLine];
		$lineNumber += $lineIncrement;
		$numberedLines[0][LINE_CODE] .= $lineNumber if $startCondition;
	}

	#fill out breaks
	foreach my $breakLocation (@breaks) {
		$numberedLines[$breakLocation][LINE_CODE] .= $lineNumber;
	}

	return $lineNumber, \@numberedLines, \@rawLines;
}

sub constructSwitch {
	my $lineNumber = shift;
	my @rawLines = @_;

	my @numberedLines;
	my $caseFormat = 'CASE ?\(([^#]+)\) *(#.+)?';
	my $endSwitch = '^' . $caseFormat . '$';
	my $previousCondition;
	my $previousRemark;
	my @breaks;
	while () {
		#construct remark
		if ($previousRemark) {
			my($newLineNumber, $newLines) = expandRemark($lineNumber, $previousRemark);
			my @newLines = @$newLines;
			$lineNumber = $newLineNumber;
			@numberedLines = (@numberedLines, @newLines);
		}

		my $caseStartLine = $lineNumber;
		$lineNumber += $lineIncrement if $previousCondition && $previousCondition ne 'DEFAULT';
		my($newLineNumber, $newLines, $rawLines, $endLine, $combinedBlock) = expandLines($endSwitch, $lineNumber, @rawLines);
		@newLines = @$newLines;
		@rawLines = @$rawLines;
		$lineNumber = $newLineNumber;

		die('CASE must be first line after SWITCH') if !$previousCondition && $#newLines >= 0;

		#save condition and remark
		$endLine =~ /^$caseFormat$/;
		my $condition = $1;
		my $remark = $2;

		if ($previousCondition) {
			die("DEFAULT must be final CASE in SWITCH ($condition found after $previousCondition)") if $previousCondition eq 'DEFAULT' && $endLine ne 'ENDSWITCH';

			#save break if exists
			my $breakNeeded = 0;
			if ($newLines[$#newLines][LINE_CODE] eq 'BREAK') {
				$breakNeeded = 1;
				$newLines[$#newLines][LINE_CODE] = 'GOTO ';
			}
			foreach my $line (@newLines) {
				die("BREAK must be last line of CASE in CASE($previousCondition)") if @$line[LINE_CODE] eq 'BREAK';
			}

			#construct combined lines
			if ($combinedBlock) {
				my @savedLines = @newLines;
				my $openingText = "IF $previousCondition THEN " if $previousCondition ne 'DEFAULT';
				my $firstLine = shift @newLines;
				$openingText .= @$firstLine[LINE_CODE];
				my($newLineNumber, $combinedLine) = combineLines($caseStartLine, $openingText, @newLines);
				if ($newLineNumber < 0) {
					$combinedBlock = 0;
					@newLines = @savedLines;
				} else {
					$lineNumber = $newLineNumber;
					@numberedLines = (@numberedLines, $combinedLine);
				}
			}

			#construct per-line version
			if (!$combinedBlock) {
				@numberedLines[$#numberedLines+1] = [$caseStartLine, "IF NOT ($previousCondition) THEN $lineNumber"] if $previousCondition ne 'DEFAULT';
				foreach my $numberedLine (@newLines) {
					my($number, $code, $before, $after) = @$numberedLine;
					$numberedLines[$#numberedLines+1] = [$number, $code, $before, $after];
				}
			}
			$breaks[$#breaks+1] = $#numberedLines if $breakNeeded;
		}

		last if $endLine eq 'ENDSWITCH';
		$previousCondition = $condition;
		$previousRemark = $remark;
		$endSwitch = '^' . "(ENDSWITCH|$caseFormat)" . '$';
	}
	foreach my $breakLocation (@breaks) {
		$numberedLines[$breakLocation][LINE_CODE] .= $lineNumber;
	}
	$numberedLines[$#numberedLines][BLANK_AFTER] = 1;
	return $lineNumber, \@numberedLines, \@rawLines;
}

#create one-liner if possible
sub combineLines {
	my $lineNumber = shift;
	my $lineText = shift;
	my @newLines = @_;

	foreach my $line (@newLines) {
		$lineText .= ":" . @$line[LINE_CODE];
	}
	if (length("$lineNumber $lineText") > 255) {
		return -1, -1;
	} else {
		my $line = [$lineNumber, $lineText];
		$lineNumber += $lineIncrement;
		return $lineNumber, $line;
	}
}

#convert a subroutine name to a remark
sub nameToRemark {
	my $name = shift;
	#return $name;
	$name =~ s/_/ /g;
	$name =~ s/([a-z])([A-Z])/$1 $2/g;
	$name =~ s/([a-z])([0-9])/$1 $2/gi;
	$name =~ s/([0-9])([a-z])/$1 $2/gi;
	return $name;
}

#handle superBASIC constants
sub constants {
	my $constant = shift;

	return $constants{$constant} if $constants{$constant};
	return $constant;
}

#handle matching and creating superBASIC variable names to BASIC variable names
sub variables {
	local $variable = shift;

	return $twoCharacterVariables{$variable} if $twoCharacterVariables{$variable};

	#attempt to get two-character variable from letters/numbers in $variable
	my $validCharacters = substr($variable, 1, -1);
	my $newVariable = '';

	#try first character plus first capitalized character
	if ($validCharacters =~ /^(.).*([A-Z])/) {
		$newVariable = validNewVariable("$1$2");
		return $newVariable if $newVariable;
	}

	#try first character plus first character after an underscore
	if ($validCharacters =~ /^(.)[^_]*_(.)/) {
		$newVariable = validNewVariable("$1$2");
		return $newVariable if $newVariable;
	}

	#try looping through characters of long variable
	$validCharacters =~ s/_//g;
	$newVariable = loopForVariable($validCharacters);
	return $newVariable if $newVariable;

	#just do something
	$newVariable = loopForVariable($variableCharacters);
	return $newVariable if $newVariable;

	#give up
	die("Cannot create BASIC variable for $variable; nothing available") if !$newVariable;
}

#create a new BASIC variable from superBASIC variable name
sub loopForVariable {
	my $characterSet = shift;
	my $firstCharacter = 0;
	my $secondCharacter = 1;
	my $newVariable = validNewVariable(substr($characterSet, 0, 2));
	while (!$newVariable) {
		if ($secondCharacter >= length($characterSet)-1) {
			$firstCharacter++;
			last if $firstCharacter >= length($characterSet)-2;
			$secondCharacter = $firstCharacter+1;
		} else {
			$secondCharacter ++;
		}
		$newVariable = substr($characterSet, $firstCharacter, 1) . substr($characterSet, $secondCharacter, 1);
		$newVariable = validNewVariable($newVariable);
	}

	return $newVariable;
}

#check validity of BASIC variable names
sub validNewVariable {
	my $twoCharacterVariable = shift;
	$twoCharacterVariable = uc($twoCharacterVariable);

	#variable must begin with a letter
	return 0 if $twoCharacterVariable !~ /^[A-Z]/;
	#variable cannot be a reserved word
	return 0 if $twoCharacterVariable =~ /^$reservedWords$/;

	$twoCharacterVariable .= '$' if $variable =~ /\$$/;

	#variable already exists
	return 0 if $variables{$twoCharacterVariable};

	#it's good, save it
	$twoCharacterVariables{$variable} = $twoCharacterVariable;
	$variables{$twoCharacterVariable} = $variable;

	return $twoCharacterVariable;
}

#remember, there are no GOTOs in the original code, so no need to block based on them
sub lineContainsJoinBlocker {
	my $line = shift;
	#get rid of everything inside of quotes, they don't matter
	$line =~ s/"[^"]*"//g;
	#If there are any quotes left, that means there were an odd number of quotes.
	die("Unclosed strings not allowed inside of code blocks: $line") if $line =~ /"/;

	#IF statements block one-liners, because they would block every line after them when combined
	return 1 if $line =~ /IF/;
	#Remarks make everything after them a remark
	return 1 if $line =~ /REM/;
	return 1 if $line =~ /'/;
	return 1 if $line =~ /CONTINUE/;
	return 0;
}

sub help {
	print "$0 <filename> [--switch <switch>] [--variables] [--help]\n";
	print "Convert superBASIC code into Color Computer code.\n";
	print "Version: $version\n";
	print "\n";
	print "--help:\tdisplay this help\n";
	print "--switch <switch>:\tset switch to true for use with #IFDEF\n";
	print "--variables:\tdisplay variables, subroutines, and switches\n";
	print "--version:\tdisplay version\n";
	print "\n";
	print "Variables:\n";
	print "%ABC123_\$:\tstring variable\n";
	print "%ABC123_%:\tnumeric variable\n";
	print "%ABC123_%++/--:\tincrement/decrement variable\n";
	print "%ABC123_%+=/*=/-=//=:\tadd to, multiply by, subtract from, divide into variable\n";
	print "\n";
	print "Statements:\n";
	print "IF (condition) THEN:\tstart IF block\n";
	print "ELSE:\tinverse portion of IF block\n";
	print "ENDIF:\tend IF block\n";
	print "LOOP:\tstart loop; also LOOP WHILE (condition)\n";
	print "CONTINUE:\tgo to start of current loop\n";
	print "BREAK IF (condition):\texit LOOP\n";
	print "ENDLOOP:\tend loop; also ENDLOOP UNLESS (condition)\n";
	print "SUB name:\tstart subroutine\n";
	print "ENDSUB:\tend SUB\n";
	print "SWITCH:\tstart a series of CASEs\n";
	print "CASE (condition):\ta CASE inside of a SWITCH\n";
	print "CASE (DEFAULT):\ta CASE that applies to every case that reaches it\n";
	print "BREAK:\texit SWITCH\n";
	print "ENDSWITCH:\tend a series of CASEs\n";
	print "\n";
	print "Macros:\n";
	print "DATA [maxlines ##] [!counter%]:\tbegin series of DATA lines wrapped to screen\n";
	print "ENDDATA:\tend a DATA series\n";
	print "!DATASETS%:\tthe number of data/enddata sections\n";
	print "PAUSE[ seconds]:\tpause for that many seconds or until key pressed\n";
	print "WRAP <text>:\twrap text for PRINTs; also WRAP-CENTER\n";
	print "#:\twrap REMARK; #remark can be appended to CASE\n";
	print "\\^L:\tforce the next letter to be lower-case on the CoCo\n";
	print "\\^L…\\^Q:\tforce enclosed letters to lower-case on the CoCo\n";
	print "\n";
	print "Preprocessor:\n";
	print "//:\tcomment lines not included in BASIC\n";
	print "/* … */:\tcomment block not included in BASIC\n";
	print "#IFDEF <switch>:\tstart block of code only for particular switch\n";
	print "#ENDIFDEF:\tend block of switch-only code\n";
	print "#INCLUDE <file>:\tinclude text from file; must be local or in $basicIncludes\n";

	exit;
}
