#!/usr/bin/perl

# BBC BASIC detokeniser v1.00 (06/13/2000)
# Author: Jim Hawkins
#
# Usage: cat <BBCBASICfile> | bbcbascat

&set_tokens(\%tokens, 0x7f, 'OTHERWISE AND DIV EOR MOD OR ERROR LINE OFF STEP SPC TAB( ELSE THEN');
&set_tokens(\%tokens, 0x8e, 'OPENIN PTR PAGE TIME LOMEM HIMEM ABS ACS ADVAL ASC ASN ATN BGET COS COUNT DEG ERL ERR EVAL EXP EXT FALSE FN GET INKEY INSTR( INT LEN LN LOG NOT OPENUP OPENOUT PI POINT( POS RAD RND SGN SIN SQR TAN TO TRUE USR VAL VPOS CHR$ GET$ INKEY$ LEFT$( MID$( RIGHT$( STR$ STRING$( EOF');
&set_tokens($tokens{chr 0xc6} = {}, 0x8e, 'SUM BEAT');
&set_tokens($tokens{chr 0xc7} = {}, 0x8e, 'APPEND AUTO CRUNCH DELETE EDIT HELP LIST LOAD LVAR NEW OLD RENUMBER SAVE TEXTLOAD TEXTSAVE TWIN TWINO INSTALL');
&set_tokens($tokens{chr 0xc8} = {}, 0x8e, 'CASE CIRCLE FILL ORIGIN POINT RECTANGLE SWAP WHILE WAIT MOUSE QUIT SYS INSTALL LIBRARY TINT ELLIPSE BEATS TEMPO VOICES VOICE STEREO OVERLAY');
&set_tokens(\%tokens, 0xc9, 'WHEN OF ENDCASE ELSE ENDIF ENDWHILE PTR PAGE TIME LOMEM HIMEM SOUND BPUT CALL CHAIN CLEAR CLOSE CLG CLS DATA DEF DIM DRAW END ENDPROC ENVELOPE FOR GOSUB GOTO GCOL IF INPUT LET LOCAL MODE MOVE NEXT ON VDU PLOT PRINT PROC READ REM REPEAT REPORT RESTORE RETURN RUN STOP COLOUR TRACE UNTIL WIDTH OSCLI');

while (&get_line(STDIN, \$line, \$number)) {
  printf "%5i: %s\n", $number, decode_line($line);
}

sub set_tokens {
  my ($hash, $byte, $tokens) = @_;
  for (split ' ', $tokens) {${$hash}{chr $byte++} = $_}
}

sub get_line {
  my ($fh, $line, $number) = @_;
  my ($temp, $nl, $len);

  unless (read $fh, $temp, 4) {
    print STDERR "Error: Premature EOF\n";
    return undef;
  }
  ($nl, $$number, $len) = unpack 'CnC', $temp;

  if ($nl != 0x0d) {
    print STDERR "Error: Newline expected\n";
    return undef;
  }
  if (ord(substr $temp, 1, 1) == 0xff) {
    print STDERR "Warning: Extra crap before EOF\n" if length($temp) > 2;
    return undef;
  }
  if (read($fh, $$line, $len -= 4) != $len) {
    print STDERR "Error: Premature EOF\n";
    return undef;
  }

  return 1;
}

sub decode_line {
  my ($line) = $_[0];
  my ($output, $token_table, $token);
  my ($i, $j, $c);

  while (($c = substr $line, $i++, 1) ne '') {
    if (ord($c) < 0x20) {
      print STDERR "Error: Can't handle control chars\n";
      return undef;
    }

    if ($c eq '"') {
      $j = length($line) unless $j = (index $line, '"', $i--)+1;
      $output .= substr $line, $i, $j-$i;
      $i = $j;
    } else {
      if (ord($c) >= 0x7f) {
        $token = \%tokens;
        while (ref ($token = ${$token_table = $token}{$c})) {
          if (($c = substr $line, $i++, 1) eq '') {
            print STDERR "Error: Premature end of token sequence\n";
            return undef;
          }
        }
        unless ($token) {
          print STDERR "Error: Unrecognised token\n";
          return undef;
        }
        $output .= $token;
        return $output.substr $line, $i if $token eq 'DATA' or $token eq 'REM';
      } else {
        $output .= $c;
      }
    }
  }  

  return $output;
}
