colorize-amsb: added.

1 files changed, 284 insertions, 0 deletions

diff --git a/colorize-amsb b/colorize-amsb
new file mode 100755
index 0000000..4d6c616
--- /dev/null
+++ b/colorize-amsb
@@ -0,0 +1,284 @@
+#!/usr/bin/perl -w
+
+# colorize output from listbas... *after* it's been converted to utf8
+# with a8cat, including ANSI codes for reverse/normal video.
+
+($SELF = $0) =~ s,.*/,,;
+
+%colornames = (
+		none => 0,
+		red => 1,
+		green => 2,
+		yellow => 3,
+		blue => 4,
+		purple => 5,
+		cyan => 6,
+);
+
+%colors = (
+		numbers => 'red',
+		commands => 'yellow',
+		functions => 'purple',
+		linenumbers => 'cyan',
+		comments => 'blue',
+		variables => 'none',
+		operators => 'green',
+		strings => 'red',
+);
+
+@commands = qw/
+	END FOR NEXT READ DATA RESTORE LINE INPUT DEFSTR DEFINT DEFDBL DEFSNG
+	OPTION DIM COMMON DEF LET RANDOMIZE GOTO GOSUB RETURN GO RUN IF
+	ELSE THEN STOP CONT RESUME ERROR ON AFTER POKE WAIT MOVE LOAD SAVE
+	VERIFY MERGE PRINT PRINT LIST AUTO DEL TRON TROFF RENUM OPEN CLOSE
+	GET PUT NOTE LOCK UNLOCK KILL NAME GRAPHICS COLOR PLOT FILL SETCOLOR
+	SOUND CLS DOS CLEAR NEW CLOAD CSAVE BASE TO SUB NOT STEP ALL USING
+	RESERVE UPDATE OUTPUT APPEND AT PLM0 PLM2 PLM1 CHR0 CHR1 CHR2 AND
+	OR XOR
+/;
+
+@functions = qw/
+	TAB SPC AT SGN INT ABS FRE POS SQR LOG EXP COS SIN TAN ATN PEEK LEN STR
+	VAL ASC CHR STATUS EOF LEFT RIGHT MID INSTR STRING VARPTR USR SCRN RND
+	TIME INKEY ERR ERL STACK
+/;
+
+$cmdhash{$_}++ for @commands;
+$funchash{$_}++ for @functions;
+
+sub conf_file_name {
+	my $home = $ENV{HOME};
+	if(!defined $home) {
+		warn "$SELF: HOME not set in environment, not reading config file\n";
+		return undef;
+	}
+	return $home . '/.colorize-amsb.conf';
+}
+
+sub read_config {
+	my $file = conf_file_name();
+	return 1 if !defined $file; # caller won't create
+	open my $fh, '<', $file or return 0; # not found, caller will create
+
+	while(<$fh>) {
+		chomp;
+		s/#.*//;
+		next if /^\s*$/;
+		s/^\s*//;
+		s/\s*$//;
+		$_ = lc $_;
+		if(/^([a-z]+)[^a-z]+([a-z]+)*$/) {
+			my($k, $v) = ($1, $2);
+			if(!defined $colors{$k}) {
+				warn "$SELF: $file:$.: unknown color type '$k', ignoring\n";
+			} elsif(!defined $colornames{$v}) {
+				warn "$SELF: $file:$.: unknown color name '$v', ignoring\n";
+			} else {
+				$colors{$k} = $v;
+			}
+		} else {
+			warn "$SELF: $file:$.: malformed line, skipping\n";
+		}
+	}
+
+	close $fh;
+}
+
+sub create_config {
+	my $file = conf_file_name();
+	return unless defined $file;
+	open my $fh, '>', $file or do {
+		warn "$SELF: can't create $file: $!\n";
+		return;
+	};
+
+	my $types = join(" ", sort keys %colors);
+	my $names = join(" ", sort keys %colornames);
+
+	print $fh <<EOF;
+# colorize-amsb.conf
+
+# lines with # are comments. blank lines are ignored.
+
+# each line is "type = color", where valid types are:
+#   $types
+# and valid colors are:
+#   $names
+
+EOF
+
+	for(sort keys %colors) {
+		print $fh '#' . $_ . ' = ' . $colors{$_} . "\n";
+	}
+
+	close $fh;
+}
+
+sub is_cmd {
+	return $cmdhash{$_[0]};
+}
+
+sub is_func {
+	return $funchash{$_[0]};
+}
+
+sub is_punct {
+	for($_[0]) {
+		return 0 if length > 1;
+		return 0 if /[\sA-Za-z0-9]/;
+	}
+	return 1;
+}
+
+sub is_varname {
+	return $_[0] =~ /^[A-Z]/;
+}
+
+sub start_color {
+	my $color = shift;
+	my $colortype = $colors{$color} || die "invalid color type $color\n";
+	my $colornum = $colornames{$colortype};
+	die "invalid color name $color\n" unless defined $colornum;
+	if($colornum) {
+		print "\x1b[3" . $colornum . "m";
+	}
+}
+
+sub end_color {
+	print "\x1b[0m";
+}
+
+sub colorize {
+	my $color = shift;
+	my $text = shift;
+	#warn "color $color, text '$text'\n";
+	start_color($color) if $color;
+	print $text;
+	end_color if $color;
+}
+
+sub colorize_line {
+	my $line = shift;
+
+	# skip initial blank line (or really any blank lines)
+	return unless length $line;
+
+	# split on non-word characters, capturing the delimiters.
+	# spliting this: 10 PRINT "HELLO":A=1.0E+10:END
+	# ...gives this set of tokens:
+	#   10
+	#   <space>
+	#   PRINT
+	#   <space>
+	#   "
+	#   HELLO
+	#   "
+	#   :
+	#   1
+	#   .
+	#   0E
+	#   +
+	#   10
+	#   :
+	#   END
+
+	@toks = (split(/(\W)/, $line));
+
+	# special case the line number
+	my $tok = shift @toks;
+	if($tok =~ /^\d+/) {
+		colorize('linenumbers', $tok);
+	} else {
+		die "$SELF: no line number at line $., not LISTed AMSB?\n";
+	}
+
+	my $lasttok = '';
+	my $lastcolor = 0;
+	my $in_comment = 0;
+	my $in_string = 0;
+
+	# iterate over the rest of the tokens. kinda hairy, sorry.
+	for my $tok (@toks) {
+		my $color = 0;
+
+		if($in_comment || $in_string) {
+			$color = 0;
+			if($in_string && $tok eq '"') {
+				$in_string = 0;
+				$color = 'operators';
+			}
+		} elsif($tok =~ /^REM|!|'/) {
+			start_color('comments'); # rest of line
+			$in_comment = 1;
+		} elsif($tok eq '"') {
+			$color = 'operators';
+			$in_string = 1;
+		} elsif($tok eq '#') {
+			if($lastcolor eq 'variables') {
+				# double-precision variable
+				$color = 'variables';
+			} else {
+				# OPEN #, PRINT #, CLOSE #, etc
+				$color = 'operators';
+			}
+		} elsif($tok eq '%') {
+			# integer variable
+			$color = 'variables';
+		} elsif($tok eq '#' && $lastcolor eq 'variables') {
+			# double-precision variable
+			$color = 'variables';
+		} elsif($tok eq '$') {
+			# $ takes either the functions or variables color
+			$color = $lastcolor;
+		} elsif($tok eq '.') {
+			# decimal point only appears in a number
+			$color = 'numbers';
+		} elsif(($tok eq '-' || $tok eq '+') && $lasttok =~ /^\d+E$/) {
+			# scientific notation (entire number is the same color)
+			$color = 'numbers';
+		} elsif($tok eq '&') {
+			# hex constant operator
+			$color = 'numbers';
+		} elsif($lasttok eq '&') {
+			# hex constant argument
+			$color = 'numbers';
+		} elsif(is_cmd($tok)) {
+			$color = 'commands';
+		} elsif(is_func($tok)) {
+			$color = 'functions';
+		} elsif(is_punct($tok)) {
+			$color = 'operators';
+		} elsif(is_varname($tok)) {
+			$color = 'variables';
+		} else {
+			$color = 'numbers';
+		}
+
+		# if $color == 0, colorize() just prints the token without escape codes.
+		colorize($color, $tok);
+
+		# if we just started a string, set the strings color.
+		if($tok eq '"' && $in_string) {
+			start_color('strings');
+		}
+		$lastcolor = $color;
+		$lasttok = $tok;
+	}
+
+	# don't leave the text color enabled at the end of the line.
+	end_color() if $in_comment || $in_string;
+}
+
+# main()
+binmode(STDIN, ":utf8");
+binmode(STDOUT, ":utf8");
+
+if(!read_config()) {
+	create_config();
+}
+
+while(<>) {
+	chomp;
+	colorize_line($_);
+	print "\n";
+}