'Tiny Basic interpreter.  Just enough functionality to play Star Trek.

constant c_maxlines = 10000, c_maxvars = 26

visible num             ' lex: current number found
visible textp           ' lex: next character position in thelin (0 based)
visible thech           ' lex: current character
visible thelin          ' lex: line being lex'ed
visible tok             ' lex: current token
visible toktype         ' lex: type of tok: "ident", "string", "number", "punct"
visible curline         ' number of the current line, can be 0 if direct mode
visible pgm = []        ' program code stored here; pgm[0] used for direct mode
visible errors          ' errors in lexing/parsing
visible need_colon      ' is a colon required?
visible tracing = false
visible vars = []       ' program variables, a-z stored here
visible atarry = []     ' the @ array
visible forlimit = []   ' limit in for loops
visible forline = []    ' for line start; so next can find it
visible forpos  = []    ' for line textp; so next can find it
visible forvar = []     ' for index variable
visible gsp = 0         ' gosub stack index
visible gstackln = []   ' gosub line stack
visible gstacktp = []   ' gosub textp stack

newstmt()
if sizeof(args) > 1 then
    toktype = "string"; tok = chr(34) + args[1]
    loadstmt()
    tok = "run"; docmd()
else
    help()
endif
do
  errors = false
  write("N7 TB>")
  pgm[0] = rln()
  if pgm[0] <> "" then
    initlex(0)
    if toktype = "number" then
      validlinenum()
      if not errors then
        pgm[num] = mid(pgm[0], textp, len(pgm[0]) - textp)
      endif
    else
      docmd()
    endif
  endif
loop

function docmd()
  do
    if tracing and left(tok, 1) <> ":" then
        wln(curline + " " + tok + " " + thech + thelin)
    endif
    need_colon = true
    select tok
      case "bye", "quit"; nexttok(); end
      case "end", "stop"; nexttok(); return
      case "clear";       nexttok(); clearvars(); return
      case "help";        nexttok(); help();      return
      case "list";        nexttok(); liststmt();  return
      case "load", "old"; nexttok(); loadstmt();  return
      case "new";         nexttok(); newstmt();   return
      case "run";         nexttok(); runstmt()
      case "save";        nexttok(); savestmt();  return
      case "tron";        nexttok(); tracing = true
      case "troff";       nexttok(); tracing = false
      case "cls";         nexttok(); cls
      case "for";         nexttok(); forstmt()
      case "gosub";       nexttok(); gosubstmt()
      case "goto";        nexttok(); gotostmt()
      case "if";          nexttok(); ifstmt()
      case "input";       nexttok(); inputstmt()
      case "next";        nexttok(); nextstmt()
      case "print", "?";  nexttok(); printstmt()
      case "return";      nexttok(); returnstmt()
      case "@";           nexttok(); arrassn()
      case ":", ""        ' handled below
      default
        if tok = "let" then nexttok()
        if toktype = "ident" then
          assign()
        else
          wln("Unknown token: " + tok + " : at line: " + curline + " Col: " + textp + " : " + thelin)
          return
        endif
    endsel
    if errors then return
    if tok = "" then
      while tok = ""
        if curline = 0 or curline >= c_maxlines then
          return
        endif
        curline = find_next_line(curline + 1)
        if curline = 0 then
          return
        endif
        initlex(curline)
        if errors then return
      wend
    elseif tok = ":" then nexttok()
    elseif need_colon and not accept(":") then
      wln(": expected but found: " + tok)
      return
    endif
  loop
endfunc

function help()
   wln("ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ Tiny Basic (N7) ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿")
   wln("³ bye, clear, cls, end/stop, help, list, load/save, new, run, tron/off³Û")
   wln("³ for <var> = <expr1> to <expr2> ... next <var>                       ³Û")
   wln("³ gosub <expr> ... return                                             ³Û")
   wln("³ goto <expr>                                                         ³Û")
   wln("³ if <expr> then <statement>                                          ³Û")
   wln("³ input [prompt,] <var>                                               ³Û")
   wln("³ <var>=<expr>                                                        ³Û")
   wln("³ print <expr|string>[,<expr|string>][;]                              ³Û")
   wln("³ rem <anystring>  or ' <anystring>                                   ³Û")
   wln("³ Operators; ^, * / \ mod + - < <= > >= = <>, not, and, or            ³Û")
   wln("³ Integer variables a..z, and array @(expr)                           ³Û")
   wln("³ Functions: abs(expr), asc(ch), rnd(expr), sgn(expr)                 ³Û")
   wln("ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ")
   wln("  ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß")
endfunc

function assign()
  var = getvarindex(); nexttok()
  expect("=")
  vars[var] = expression(0)
  if tracing then
    wln("*** " + chr(var + asc("a")) + " = " + vars[var])
  endif
endfunc

function arrassn()   ' array assignment: @(expr) = expr
  atndx = parenexpr()
  if tok <> "=" then
    errors = true
  else
    nexttok()     ' skip the "="
    n = expression(0)
    atarry[atndx] = n
    if tracing then
      wln("arrassn")
      wln("*** @(" + atndx + ") = " + n)
    endif
  endif
endfunc

function forstmt()   ' for i = expr to expr
  var = getvarindex()
  assign()
  ' vars(var) has the value; var has the number value of the variable in 0..25
  forndx = var
  forvar[forndx] = vars[var]
  if tok <> "to" then
    wln("For: Expecting 'to', found: " + tok); errors = true
  else
    nexttok()
    n = expression(0)
    forlimit[forndx] = n
    ' need to store iter, limit, line, and col
    forline[forndx] = curline
    if tok = "" then
      forpos[forndx] = textp
    else
      forpos[forndx] = textp - 2
    endif
  endif
endfunc

function gosubstmt()   ' for gosub; save the line and column
  gsp = gsp + 1
  gstackln[gsp] = curline
  gstacktp[gsp] = textp

  gotostmt()
endfunc

function gotostmt()
  num = expression(0)
  validlinenum()
  initlex(num)
endfunc

function ifstmt()
  need_colon = false
  if expression(0) = 0 then
    skiptoeol()
  else
    accept("then")
    if toktype = "number" then
      gotostmt()
    endif
  endif
endfunc

function inputstmt()   ' "input" [string ","] var
  if toktype = "string" then
    write(mid(tok, 1, len(tok) - 1))
    nexttok()
    expect(",")
  else
    write("? ")
  endif
  var = getvarindex(); nexttok()
  st = rln()
  if st = "" then
    st = "0"
  endif
  if left(st, 1) >= "0" and left(st, 1) <= "9" then
    vars[var] = int(st)
  else
    vars[var] = asc(st)
  endif
endfunc

function liststmt()
  for i = 1 to c_maxlines
    if key(pgm, i) then
      wln(i + " " + pgm[i])
    endif
  next
  wln("")
endfunc

function loadstmt()
  newstmt()
  filename = getfilename("Load")
  if filename = "" then
    return
  endif
  if not exists(filename) then
    wln("File not found: " + filename)
    errors = true
    return
  endif
  f = openfile(filename)
  n = 0
  do
    s = frln(f)
    if s = unset then
      if pgm[n] = "" then free pgm[n]
      break
    endif
    pgm[0] = s
    initlex(0)
    if toktype = "number" and num > 0 and num <= c_maxlines then
      n = num
    else
      n = n + 1; textp = 0
    endif
    pgm[n] = mid(pgm[0], textp, len(pgm[0]) - textp)
  loop
  free file f
  curline = 0
endfunc

function newstmt()
  clearvars()
  clear pgm
endfunc

function nextstmt()
  ' tok needs to have the variable
  forndx = getvarindex()
  forvar[forndx] = forvar[forndx] + 1
  vars[forndx] = forvar[forndx]
  if forvar[forndx] <= forlimit[forndx] then
    curline = forline[forndx]
    textp   = forpos[forndx]
    initlex2()
  else
    nexttok() ' skip the ident for now
  endif
endfunc

' "print" [[#num "," ] expr { "," [#num ","] expr }] [","] {";" stmt} eol
' expr can also be a literal string
function printstmt()
  printnl = true
  while tok <> ":" and tok <> "" and tok <> "else"
    printnl = true
    printwidth = 0
    if accept("#") then
      if num <= 0 then
        wln("Expecting a print width, found: " + tok)
        return
      endif
      printwidth = num
      nexttok()
      if not accept(",") then
        wln("Expecting a ',', found: " + tok)
        return
      endif
    endif

    if toktype = "string" then
      junk = mid(tok, 1, len(tok) - 1)
      nexttok()
    else
      n = expression(0)
      junk = str(n)
    endif
    printwidth = printwidth - len(junk)
    if printwidth <= 0 then
      write(junk)
    else
      write(space(printwidth) + junk)
    endif

    if accept(",") or accept(";") then
      printnl = false
    else break
  wend

  if printnl then wln("")
endfunc

function returnstmt() ' return from a subroutine
  curline = gstackln[gsp]
  textp   = gstacktp[gsp]
  gsp = gsp - 1
  initlex2()
endfunc

function runstmt()
  clearvars()
  n = find_next_line(1)
  if n then initlex(n)
endfunc

function savestmt()
  filename = getfilename("Save")
  if filename = "" then return
  f = createfile(filename)
  for i = 1 to c_maxlines
    if key(pgm, i) then
      wln file f, i + " " + pgm[i]
    endif
  next
  free file f
endfunc

function getfilename(action)
  if toktype = "string" then
    filename = mid(tok, 1, len(tok) - 1)
  else
    write(action + ": ")
    filename = rln()
  endif
  if filename <> "" then
    if instr(filename, ".") = -1 then filename = filename + ".bas"
  endif
  return filename
endfunc

function validlinenum()
  if num <= 0 or num > c_maxlines then
    wln("Line number out of range")
    errors = true
  endif
endfunc

function clearvars()
  for i = 0 to c_maxvars
    vars[i] = 0
  next

  gsp = 0
endfunc

function parenexpr()
  expect("(")
  n = expression(0)
  expect(")")
  return n
endfunc

function expression(minprec)
  ' handle numeric operands - numbers and unary operators
  if     toktype = "number" then; n = num; nexttok()
  elseif tok = "("   then; n =  parenexpr()
  elseif tok = "not" then; nexttok(); n = not expression(3)
  elseif tok = "abs" then; nexttok(); n = abs(parenexpr())
  elseif tok = "asc" then; nexttok(); expect("("); n = asc(mid(tok, 1, 1)); nexttok(); expect(")")
  elseif tok = "rnd" or tok = "irnd" then; nexttok(); n = int(rnd() * parenexpr()) + 1
  elseif tok = "sgn" then; nexttok(); n = sgn(parenexpr())
  elseif toktype = "ident" then; n = vars[getvarindex()]; nexttok()
  elseif tok = "@"   then; nexttok(); n = atarry[parenexpr()]
  elseif tok = "-"   then; nexttok(); n = -expression(7)
  elseif tok = "+"   then; nexttok(); n =  expression(7)
  else
    wln("syntax error: expecting an operand, found: " + tok)
    errors = true
    return 0
  endif

  do  ' while binary operator and precedence of tok >= minprec
    if     minprec <= 1 and tok = "or"  then; nexttok(); n2 = expression(2); n = n or n2
    elseif minprec <= 2 and tok = "and" then; nexttok(); n2 = expression(3); n = n and n2
    elseif minprec <= 4 and tok = "="   then; nexttok(); n = n =   expression(5)
    elseif minprec <= 4 and tok = "<"   then; nexttok(); n = n <   expression(5)
    elseif minprec <= 4 and tok = ">"   then; nexttok(); n = n >   expression(5)
    elseif minprec <= 4 and tok = "<>"  then; nexttok(); n = n <>  expression(5)
    elseif minprec <= 4 and tok = "<="  then; nexttok(); n = n <=  expression(5)
    elseif minprec <= 4 and tok = ">="  then; nexttok(); n = n >=  expression(5)
    elseif minprec <= 5 and tok = "+"   then; nexttok(); n = n +   expression(6)
    elseif minprec <= 5 and tok = "-"   then; nexttok(); n = n -   expression(6)
    elseif minprec <= 6 and tok = "*"   then; nexttok(); n = n *   expression(7)
    elseif minprec <= 6 and (tok = "/" or tok = "\") then; nexttok(); n = int(n / expression(7))
    elseif minprec <= 6 and tok = "mod" then; nexttok(); n = n %   expression(7)
    elseif minprec <= 8 and tok = "^"   then; nexttok(); n = int(n ^ expression(9))
    else; break
    endif
  loop

  return n
endfunc

function getvarindex()
  if toktype <> "ident" then
    wln("Not a variable: " + tok)
    errors = true
    return
  endif
  return asc(left(tok, 1)) - asc("a")
endfunc

function expect(s)
  if accept(s) then return true
  wln("(" + curline + ") expecting " + s + " but found " + tok + " =>" + thelin)
  errors = true
  return false
endfunc

function accept(s)
  if tok = s then
    nexttok()
    return true
  endif
  return false
endfunc

function find_next_line(n)
  for i = n to c_maxlines
    if key(pgm, i) then
      return i
    endif
  next
  return 0
endfunc

function initlex(n)
  curline = n; textp = 0
  initlex2()
endfunc

function initlex2()
  need_colon = false
  thelin = pgm[curline]
  thech = " "
  nexttok()
endfunc

function nexttok()
  tok = ""; toktype = ""

  while thech <= " "
    if thech = "" then return
    getch()
  wend

  tok = thech
  select tok
    case chr(34); readstr()             ' double quote
    case "'";     skiptoeol()
    case "#","(",")","*","+",",","-","/",":",";","<","=",">","?","@","\","^"
      toktype = "punct"
      getch()
      if (tok = "<" and (thech = ">" or thech = "=")) or (tok = ">" and thech = "=") then
          tok = tok + thech
          getch()
      endif
    default
      if tok >= "a" and tok <= "z" or tok >= "A" and tok <= "Z" then
        readident()
        if tok = "rem" then
          skiptoeol()
        endif
      elseif tok >= "0" and tok <= "9" then
        readint()
      else
        toktype = ""
        wln("(" + curline + ") " + "What?" + thech + " : " + thelin); errors = true
        getch()
      endif
  endsel
endfunc

function skiptoeol()
  tok = ""; toktype = ""
  textp = len(thelin) + 1
endfunc

' leave the " as the beginning of the string, so it won't get confused with other tokens
' especially in the print routines
function readstr()
  tok = thech; toktype = "string"
  getch()
  while thech <> chr(34)  ' while not a double quote
    if thech = "" then
      wln("String not terminated")
      errors = true
      return
    endif
    tok = tok + thech
    getch()
  wend
  getch()
endfunc

function readint()
  tok = ""; toktype = "number"
  while thech >= "0" and thech <= "9"
    tok = tok + thech
    getch()
  wend
  num = int(tok)
endfunc

function readident()
  tok = ""; toktype = "ident"
  while (thech >= "a" and thech <= "z") or (thech >= "A" and thech <= "Z")
    tok = tok + lower(thech)
    getch()
  wend
endfunc

function getch()
  ' Any more text on this line?
  if textp + 1 > len(thelin) then
    thech = ""
  else
    thech = mid(thelin, textp, 1)
    textp = textp + 1
  endif
endfunc

function space(n)
  s = ""
  while n > 0
    s = s + " "
    n = n - 1
  wend
  return s
endfunc

function sgn(n)
  if n < 0 then
    return -1
  elseif n > 0 then
    return 1
  else
    return 0
  endif
endfunc