#!f:/opt/perl/bin/perl

########################################################################
#
# program  :  zl
# version  :  @(#)bin zl v1.1 11/15/98
# author   :  Steven Reid (slreid@micron.net)
# purpose  :  To convert ZX81 programs (P files) to HTML
#             (by default) or text (using the "text' option).
#             Currently, zl sends to standard out.
# note     :  You'll probably need to change the first line to
#             the location of your perl executable.
# usage    :  zl {ZX81 Program} [text]
#               or
#             zl {ZX81 Program} [text] > {filename}
#             
#########################################################################

# initialize environment
$|++; # unbuffer output
use strict;

# load packages

# define constants
my @ZX81_CHAR_TABLE = (
  ' ','{1}','{2}','{7}','{4}',
  '{5}','{T}','{E}','{A}','{D}',
  '{S}','"','#','$',':',
  '?','(',')','>','<',
  '=','+','-','*','/',
  ';',',','.','0','1',
  '2','3','4','5','6',
  '7','8','9','A','B',
  'C','D','E','F','G',
  'H','I','J','K','L',
  'M','N','O','P','Q',
  'R','S','T','U','V',
  'W','X','Y','Z','RND',
  'INKEY$','PI','CALL ','ERR MSGS ','DPOKE ',
  'ERROR ','CHAR ',' ','TRACE ','DRAW ',
  'UNDRAW ','PROTECT ','EDIT ','AUTO ','DEF PROC ',
  'END PROC ','','DELETE ','DO ','LOOP ',
  'EXIT ','UNTIL ','WHILE ','WHEN ','INDENT ',
  'RESEQ ','OFF','CURSOR ','DATA ','RESTORE ',
  'READ ','NOSTALGIC ','USER ','*','ON',
  'HOME ','BREAK ','DPEEK ','LINE ','POP ',
  'PUSH ','CLR STACK ','DUP ','ELSE ','END WHEN ',
  '?','?','?','?','?',
  '?','?','?','?','?',
  '?','?','?','?','?',
  '?','?','?','[ ]','{Q}',
  '{W}','{6}','{R}','{8}','{Y}',
  '{E}','{H}','{G}','{F}','["]',
  '[#]','[$]','[:]','[?]','[(]',
  '[)]','[>]','[<]','[=]','[+]',
  '[-]','[*]','[/]','[;]','[,]',
  '[.]','[0]','[1]','[2]','[3]',
  '[4]','[5]','[6]','[7]','[8]',
  '[9]','[A]','[B]','[C]','[D]',
  '[E]','[F]','[G]','[H]','[I]',
  '[J]','[K]','[L]','[M]','[N]',
  '[O]','[P]','[Q]','[R]','[S]',
  '[T]','[U]','[V]','[W]','[X]',
  '[Y]','[Z]','""','AT ','TAB ',
  '?','CODE ','VAL ','LEN ','SIN ',
  'COS ','TAN ','ASN ','ACS ','ATN ',
  'LN ','EXP ','INT ','SQR ','SGN ',
  'ABS ','PEEK ','USR ','STR$ ','CHR$ ',
  'NOT ','**',' OR ',' AND ','<=',
  '>=','<>',' THEN ',' TO ',' STEP ',
  'LPRINT ','LLIST ','STOP ','SLOW ','FAST ',
  'NEW ','SCROLL ','CONT ','DIM ','REM ',
  'FOR ','GOTO ','GOSUB ','INPUT ','LOAD ',
  'LIST ','LET ','PAUSE ','NEXT ','POKE ',
  'PRINT ','PLOT ','RUN ','SAVE ','RAND ',
  'IF ','CLS ','UNPLOT ','CLEAR ','RETURN ',
  'COPY '
);
my $SYSTEM_VARS_START = 16393;
my $PROGRAM_START     = 16509;
my @KEYBOARD = (246, 252, 234, 247, 249, 254, 250, 238, 244, 245, 255, 253, 232, 251, 231, 243,
  242, 230, 248, 233, 235, 236, 237, 239, 240, 241);
my @SHIFT = (117, 218, 222, 223, 192, 217, 224, 219, 221, 220, 227, 225, 228, 229, 226, 216);
my @FUNCTION = (199, 200, 201, 207, 64, 213, 214, 196, 211, 194, 202, 203, 209, 210, 208, 197,
  198, 212, 205, 206, 193, 65, 215, 66);

# define variables
use subs qw(peek newline getchar);
my $in = shift || die "input file required!\n";
my $html = (shift || '') eq 'text' ? 0 : 1;
my $ptr = $PROGRAM_START;	# ZX81 memory pointer
my $cnt = 0;			# line pointer
my $len = 0;			# length of line
my $p   = '';			# program file
my $c   = '';			# char value
my $z   = '';			# temp space

# main loop

# set up character set
if ($html) {
  for (@KEYBOARD, @SHIFT, @FUNCTION) {
    $ZX81_CHAR_TABLE[$_] = "<B>$ZX81_CHAR_TABLE[$_]</B>";
  }
  $ZX81_CHAR_TABLE[0]   = '&nbsp;';			# ' ';
  $ZX81_CHAR_TABLE[11]  = '&quot;';			# '"';
  $ZX81_CHAR_TABLE[12]  = '&#163;';			# '';
  $ZX81_CHAR_TABLE[18]  = '&gt;';			# '<';
  $ZX81_CHAR_TABLE[19]  = '&lt;';			# '>';
  $ZX81_CHAR_TABLE[128] = '[&nbsp;]';			# '[ ]';
  $ZX81_CHAR_TABLE[139] = '&quot;';			# '["]';
  $ZX81_CHAR_TABLE[140] = '[&#163;]';			# '[]';
  $ZX81_CHAR_TABLE[146] = '[&gt;]';			# '[<]';
  $ZX81_CHAR_TABLE[147] = '[&lt;]';			# '[>]';
  $ZX81_CHAR_TABLE[219] = '<B>&lt;=</B>';		# '<=';
  $ZX81_CHAR_TABLE[220] = '<B>&gt;=</B>';		# '>=';
  $ZX81_CHAR_TABLE[221] = '<B>&lt;&gt;</B>';		# '<>';
  $ZX81_CHAR_TABLE[192] = '<B>&quot;&quot;</B>';	# '""';
}

# open the ZX81 program file
open P, $in or die "can't open file: $in ($!)\n";
binmode P;  # required for DOS, UNIX ignores this

if ($html) {
  print "<HTML>\n<HEAD>\n<TITLE>ZX81 Program: \U$in</TITLE>\n</HEAD>\n",
    qq(<BODY BGCOLOR="#FFFFFF" TEXT="#000000">\n),
    qq(<H1>ZX81 Program: \U$in</H1><HR>\n\n);
} else {
  print "ZX81 Program: \U$in\n";
}

# get system variables
my $sys;
read P, $sys, $PROGRAM_START - $SYSTEM_VARS_START;

my $D_FILE = peek ($sys, 3);
my $VARS   = peek ($sys,  7);
my $E_LINE = peek ($sys, 11);
my $STKBOT = peek ($sys, 17);
my $STKEND = peek ($sys, 19);
if ($html) {
  print <<HTML;
<P><B>SYSTEM VARIABLES</B><P><TT>
PROG&nbsp;&nbsp;: $PROGRAM_START<BR>
D-FILE: $D_FILE<BR>
VARS&nbsp;&nbsp;: $VARS<BR>
E-LINE: $E_LINE<BR>
STKBOT: $STKBOT<BR>
STKEND: $STKEND<BR>
</TT></P><HR><P>
<B>LEGEND</B><P>
<TT>[A]</TT> means INVERSE A<BR>
<TT>{A}</TT> means GRAPHICS A<BR>
<TT><B>PRINT </B></TT> means treat as KEYWORD P<BR>
</P><HR><P>
<B>PROGRAM LISTING</B><BR><TT>
HTML
} else {
  print "\n----- SYSTEM VARIABLES -----\n\n";
  printf "PROG  : %5d\n", $PROGRAM_START;
  printf "D_FILE: %5d\n", $D_FILE;
  printf "VARS  : %5d\n", $VARS;
  printf "E_LINE: %5d\n", $E_LINE;
  printf "STKBOT: %5d\n", $STKBOT;
  printf "STKEND: %5d\n", $STKEND;
  print "\n----- LEGEND -----\n\n";
  print "[A] means  INVERSE A\n";
  print "{A} means GRAPHICS A\n";
  print "# is subsituted for the British pound sign.\n" if $ZX81_CHAR_TABLE[12] eq '#';
  print "\n----- START OF LISTING -----\n";
}

# convert file to text
newline;
while ( $ptr < $D_FILE ) {
  $c = getchar; $ptr++;
  if ($c == 118) {		# end of line
    newline;
  } elsif ( $c == 126 ) {	# hidden number
    read P, $z, 5; $ptr+=5; # $cnt+=5;
  } else {			# print value
    print $ZX81_CHAR_TABLE[$c];
  }
}


if ($html) { print "</TT></P><HR>\n</BODY>\n</HTML>" }
else       { print "\n\n----- END OF LISTING -----\n" }

close P;
# end main
########################################################################
sub peek {
  my ($str, $pos) = @_;
  my $x = unpack 'C', substr $str, $pos,   1;
  my $y = unpack 'C', substr $str, $pos+1, 1;
  return ( $x + 256 * $y );
}
########################################################################
sub newline {
  if ( $ptr >= $D_FILE ) { return }
  my $line = 256 * (getchar) + (getchar);
  read P, $z, 2;
  print qq(<BR><FONT COLOR="#0000FF">) if $html;
  $p = sprintf "\n%4d ", $line; $p =~ s/ /\&nbsp;/gs if $html; print $p;
  print qq(</FONT>) if $html;
  $ptr += 4;
}
########################################################################
sub getchar { return unpack 'C', getc P }
########################################################################
