#!/usr/bin/perl
#
# Copyright (C) 2001 Mark Bush
# <Mark.Bush@bushnet.demon.co.uk>
#
# This script will list a BBC BASIC program file.
# If you have any problems or discover tokens not already
# covered or make any alterations to the script, please
# let me know at the above address.
#

use POSIX;

$BASIC = "$ENV{HOME}/lib/basic";
$BASIC = "/usr/local/lib/basic" unless (-f $BASIC);
open(BASIC, $BASIC) || die "Can't read $BASIC: $!\n";
while (<BASIC>)
{
  chomp;
  ($code, $cmd) = split /:/;
  $cmd = toupper($cmd);
  $cmd{$code} = $cmd;
}
close(BASIC);

if (@ARGV)
{
  $FILE = shift;
  open(FILE, $FILE) || die "Can't open $FILE: $!\n";
}
else
{
  *FILE = *STDIN;
}

$byte = -1;
$indent = 0;
while (sysread(FILE, $c, 1))
{
  $byte++;
  if (ord($c) != 0x0d)
  {
    printf "Bad program! Expected 0x0d at byte $byte\n";
    last;
  }
  sysread(FILE, $nh, 1);
  last if (ord($nh) == 0xff);
  sysread(FILE, $nl, 1);
  $lno = ord($nh)*256 + ord($nl);
  sysread(FILE, $len, 1);
  sysread(FILE, $line, ord($len)-4) if (ord($len)>=4);
  @line = split(//, $line);
  $byte += ord($len)-4;
  printf "%6d %s", $lno, ' 'x$indent;
  $outline = "";
  $prev = "";
  $goto = 0;
  $gnum = 0;
  $gval = "";
  $first = 1;
  foreach $code (@line)
  {
    $hex = sprintf("%02x", ord($code));
    if (defined $cmd{$hex})
    {
      $outline .= " " unless ($first);
      $outline .= $cmd{$hex};
      $goto = 1 if ($cmd{$hex} =~ /^(GOTO|GOSUB|RESTORE)$/);
      $outline .= " " unless ($cmd{$hex} =~ /^(PROC|FN)$/);
      $indent += 2 if (($cmd{$hex} =~ /^PROC$/) && ($prev =~ /^DEF$/));
      $indent += 2 if ($cmd{$hex} =~ /^(FOR|REPEAT)$/);
      $indent -= 2 if ($cmd{$hex} =~ /^(NEXT|UNTIL|ENDPROC)$/);
      $prev = $cmd{$hex};
    }
    else
    {
      if ($goto)
      {
	if (ord($code) == 0x3a) # colon - end of cmd
	{
	  $goto = 0;
	  $gnum = 0;
	  $outline .= &decode($gval) if ($gval);
	  $gval = "";
	  $outline .= $code;
	}
	elsif ((ord($code) == 0x2c) || (ord($code) == 0x20)) # comma or space
	{
	  $gnum = 0;
	  $outline .= &decode($gval) if ($gval);
	  $gval = "";
	  $outline .= $code;
	}
	elsif (ord($code) == 0x8d) # start of number
	{
	  $gnum = 1;
	}
	elsif ($gnum)
	{
	  $gval .= sprintf("%02x", ord($code) & 0xbf);
	}
	else
	{
	  $outline .= $code;
	}
      }
      else
      {
	$outline .= $code;
      }
    }
    $first = 0;
  }
  $outline .= &decode($gval) if ($gval);
  printf "%s\n", $outline;
}

close(FILE) if (defined $FILE);

sub decode
{
  my ($code) = @_;
  my (@bit, $bit);
  my ($res) = 0;

  @bit = split(//, $code);
  $res = hex($bit[3]);
  $res += 16*hex($bit[2]);
  $res += 256*hex($bit[5]);
  $res += 4096*hex($bit[4]);
  $res += 16384 if ($bit[1] eq "0");
  $res += 64 if ($bit[0] eq "0");
  $res += 128 if ($bit[0] eq "3");
  $res += 192 if ($bit[0] eq "2");
  return $res;
}