Tiny Basic interpreter in Oxygen Basic

[Ed Davis]

Tiny Basic interpreter in Oxygen Basic - updated: 05 Mar 2024  7:05 am: More O2-like idioms, e.g., taking advantage of O2 features.

Code Select Expand

'Tiny Basic interpreter in Oxygen Basic. Uses long as base type. By Ed Davis.
#lookahead
uses console
indexbase 0

Declare Sub ExitProcess Lib "kernel32.dll" (ByVal uExitCode As Long)
Declare Function GetCommandLine Lib "kernel32.dll" Alias "GetCommandLineA" () as char*

const long c_maxlines = 1000, c_maxvars = 26, c_at_max = 1500, c_g_stack = 100
string c_tab = chr(9), c_squote = chr(39), c_dquote = chr(34)
global as long c_default=0, c_ident=1, c_number=2, c_string=3, c_punct=4

global as string pgm[c_maxlines]    ' program stored here
global as long vars[c_maxvars]      ' variable store
global as long gstackln[c_g_stack]  ' gosub line stack
global as long gstacktp[c_g_stack]  ' gosub textp stack
global as long gsp                  ' gosub stack index
global as long atarry[c_at_max]     ' the @ array
global as long forvar[c_maxvars]
global as long forlimit[c_maxvars]
global as long forline[c_maxvars]
global as long forpos[c_maxvars]

global as string tok                ' current token
global as string thelin, thech      ' current program line, current character
global as long curline, textp       ' position in current line
global as long num                  ' last number read by scanner
global as long toktype, errors, tracing
global as long hi_index             ' highest used index in pgm

call main

sub main
  dim string command = getarg()
  call newstmt  ' resets gsp, hi_index
  if command <> "" then
    pgm[0] = "run " + c_dquote + command + c_dquote
    call initlex(0)
    call docmd
  else
    call help
  end if
  do
    errors = False
    print "tb> ": pgm[0] = rtrim(input())
    if pgm[0] <> "" then
      call initlex(0)
      if toktype <> c_number then
        call docmd
      else
        if validlinenum then
          dim as long n, i, deleted

          deleted = False
          n = findline(num) ' see function for details

          if n < 0 then     ' replace line
              n = abs(n)
              ' if just a number, delete that line
              if textp > len(pgm[0]) then
                for i = n to hi_index - 1
                  pgm[i] = pgm[i + 1]
                next i
                hi_index -= 1
                deleted = True
              end if
          elseif n > 0 then ' insert line
              for i = hi_index + 1 to n step -1
                  pgm[i] = pgm[i - 1]
              next i
              hi_index += 1
          else              ' append
              hi_index += 1
              n = hi_index
          end if

          if not deleted then pgm[n] = pgm[0]
        end if
      end if
    end if
  loop
end sub

function getarg() as string ' skip over program name and return any arguments
  string st = ltrim(rtrim(GetCommandLine()))
  int p = instr(st, " ")    ' space delimiter?
  if p < 1 then return ""   ' nope no arguments
  return ltrim(mid(st, p + 1))   ' everything after the program name
end function

sub docmd   ' main command loop
  dim as long need_colon
  do while not errors
    if tracing and left(tok, 1) <> ":" then print idxtoline(curline) + " " + tok + thech + mid(thelin, textp) + cr
    need_colon = False

    if     tok = "bye" or tok = "quit" then: call nexttok: ExitProcess(2)
    elseif tok = "end" or tok = "stop" then: call nexttok: exit sub
    elseif tok = "load" or tok = "old" then: call nexttok: call loadstmt: exit sub
    elseif tok = "new"         then: call nexttok: call newstmt:  exit sub
    elseif tok = "gosub"       then: call nexttok: call gosubstmt
    elseif tok = "goto"        then: call nexttok: call gotostmt
    elseif tok = "if"          then: call nexttok: call ifstmt
    elseif tok = "next"        then: call nexttok: call nextstmt    ' colon checked in rtn
    elseif tok = "return"      then: call nexttok: call returnstmt  ' colon checked in rtn
    elseif tok = "run"         then: call nexttok: call runstmt
    elseif tok = "clear"       then: call nexttok: call clearstmt  :need_colon = True
    elseif tok = "cls"         then: call nexttok: cls             :need_colon = True
    elseif tok = "for"         then: call nexttok: call forstmt    :need_colon = True
    elseif tok = "help"        then: call nexttok: call help       :need_colon = True
    elseif tok = "input"       then: call nexttok: call inputstmt  :need_colon = True
    elseif tok = "list"        then: call nexttok: call liststmt   :need_colon = True
    elseif tok = "print" or tok = "?" then: call nexttok: call printstmt  :need_colon = True
    elseif tok = "save"        then: call nexttok: call savestmt   :need_colon = True
    elseif tok = "troff"       then: call nexttok: tracing = False :need_colon = True
    elseif tok = "tron"        then: call nexttok: tracing = True  :need_colon = True
    elseif tok = ":" or tok = "" then: call nexttok
    else: if tok = "let" then call nexttok
        if toktype = c_ident then
          call assign
        elseif tok = "@" then
          call nexttok: call arrassn
        else
          print "Unknown token '"; tok; "' at line:"; idxtoline(curline); " Col:"; textp; " : "; thelin: errors = True
        end if
    end if

    if tok = "" then
      while tok = "" and not errors
        if curline = 0 or curline >= hi_index then
          errors = True
        else
          call initlex(curline + 1)
        end if
      wend
    elseif need_colon and not accept(":") then
      print ": expected but found: " + tok + cr: errors = True
    end if
  loop
end sub

sub help  ' I get by with a little help from my friends!
   print "Tiny Basic (O2)"                                                        + cr
   print ""                                                                       + cr
   print "  bye, clear, cls, end/stop, help, list, load/save, new, run, tron/off" + cr
   print "  for <var> = <expr1> to <expr2> ... next <var>                       " + cr
   print "  gosub <expr> ... return                                             " + cr
   print "  goto <expr>                                                         " + cr
   print "  if <expr> then <statement>                                          " + cr
   print "  input [prompt,] <var>                                               " + cr
   print "  <var>=<expr>                                                        " + cr
   print "  print <expr|string>[,<expr|string>][;]                              " + cr
   print "  rem <anystring>  or ' <anystring>                                   " + cr
   print "  Operators: ^, * / \ mod + - < <= > >= = <>, not, and, or            " + cr
   print "  Integer variables a..z, and array @(expr)                           " + cr
   print "  Functions: abs(expr), asc(ch), rnd(expr), sgn(expr)                 " + cr
   print ""                                                                       + cr
end sub

sub assign  ' ident = expr
  dim as long xvar
  xvar = getvarindex: call nexttok
  call expect("=")
  vars[xvar] = expression(0)
  if tracing then print "*** " + chr(xvar + asc("a")) + " = " + vars[xvar] + cr
end sub

sub arrassn   ' array assignment: @(expr) = expr
  dim as long atndx
  atndx = parenexpr
  call expect("=")
  atarry[atndx] = expression(0)
  if tracing then print "*** @(" + atndx + ") = " + atarry[atndx] + cr
end sub

sub clearstmt ' clear all variables
  dim as long i
  for i = 1 to c_maxvars
    vars[i] = 0
  next i
  for i = 0 to c_at_max
    atarry[i] = 0
  next i
  gsp = 0
end sub

sub forstmt   ' for i = expr to expr
  dim as long xvar, forndx

  xvar = getvarindex
  call assign
  ' vars[xvar] has the value; xvar has the number value of the variable in 0..25
  forndx = xvar
  forvar[forndx] = vars[xvar]
  if tok <> "to" then
    print "For: Expecting 'to', found:" + tok + cr: errors = True
  else
    call nexttok
    forlimit[forndx] = expression(0)
    ' need to store iter, limit, line, and col
    forline[forndx] = curline
    if tok = "" then forpos[forndx] = textp else forpos[forndx] = textp - 1
  end if
end sub

sub gosubstmt   ' gosub expr: for gosub: save the line and column
  gsp += 1
  num = expression(0)
  gstackln[gsp] = curline
  if tok = "" then gstacktp[gsp] = textp else gstacktp[gsp] = textp - 1
  call go(num, "gosub")
end sub

sub gotostmt  ' goto expr
  num = expression(0)
  call go(num, "goto")
end sub

sub ifstmt  ' if expr [then] {stmt} {: stmt}
  if expression(0) = 0 then call skiptoeol: exit sub
  if tok = "then" then call nexttok
  if toktype = c_number then call gotostmt
end sub

sub inputstmt   ' "input" [string ","] xvar
  dim as long xvar
  dim as string st
  if toktype = c_string then
    print mid(tok, 2)
    call nexttok
    call expect(",")
  else
    print "? "
  end if
  xvar = getvarindex: call nexttok
  st = rtrim(input())
  if st = "" then st = "0"
  if (left(st, 1) >= "0" and left(st, 1) <= "9") or left(st, 1) = "-" then
    vars[xvar] = val(st)
  else
    vars[xvar] = asc(st)
  end if
end sub

sub liststmt  ' show the current program
  dim as long i
  for i = 1 to hi_index
    print pgm[i] + cr
  next i
  print
end sub

sub loadstmt  ' load ["string"]
  dim as string filename, src, s
  dim as long start, pos

  filename = getfilename("Load")
  if filename = "" then exit sub
  call newstmt
  getfile(filename, src)
  if len(src) = 0 then return

  start = 1
  do
    pos = instr(start, src, chr(13))
    if pos <= 0 then exit do
    hi_index += 1
    pgm[hi_index] = mid(src, start, pos - start)
    start = pos + 1
    if mid(src, start, 1) = chr(10) then start += 1
  loop
  ' handle unterminated lines
  if start <= len(src) then
    hi_index += 1
    pgm[hi_index] = mid(src, start)
  end if

  curline = 1
end sub

sub newstmt ' clears program and variable store
  dim as long i
  call clearstmt
  for i = 1 to c_maxlines
    pgm[i] = ""
  next i
  hi_index = 0
end sub

sub nextstmt  ' next ident - ident is required
  dim as long forndx

  ' 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]
    call initlex2
  else
    call nexttok ' skip the ident for now
    if tok <> "" and tok <> ":" then
      print "Next: expected ':' before statement, but found:" + tok + cr: errors = True
    end if
  end if
end sub

' "print" [[#num "," ] expr { "," [#num ","] expr }] [","] {":" stmt} eol
' expr can also be a literal string
sub printstmt
  dim as long printnl, printwidth, n
  dim as string junk

  printnl = True
  do while tok <> ":" and tok <> "" and tok <> "else"
    printnl = True
    printwidth = 0
    if accept("#") then
      if num <= 0 then print "Expecting a print width, found:" + tok + cr: exit sub
      printwidth = num
      call nexttok
      if not accept(",") then print "Print: Expecting a ',', found:" + tok + cr: exit sub
    end if

    if toktype = c_string then
      junk = mid(tok, 2)
      call nexttok
    elseif toktype = c_ident and tok = "chr" and thech = "" then
        textp += 1 ' consume
        call nexttok      ' get (
        n = parenexpr
        junk = chr(n)
    else
      n = expression(0)
      junk = ltrim(str(n))
    end if
    printwidth = printwidth - len(junk)
    if printwidth <= 0 then print junk: else print space(printwidth) + junk

    if accept(",") or accept(";") then printnl = False else exit do
  loop

  if printnl then print cr
end sub

sub returnstmt ' exit from a subroutine
  curline = gstackln[gsp]
  textp   = gstacktp[gsp]
  gsp -= 1
  call initlex2
  if tok <> "" and tok <> ":" then
    print "Return: expected ':' before statement, but found:" + tok + cr: errors = True
  end if
end sub

sub runstmt ' run ["string"]
  call clearstmt
  if toktype = c_string then call loadstmt
  call initlex(1)
end sub

sub savestmt ' save ["string"]
  long i
  string filename, buf

  filename = getfilename("Save")
  if filename = "" then exit sub

  buf = ""
  for i = 1 to hi_Index
    if pgm[i] <> "" then buf += pgm[i] + cr
  next i
  putfile(filename, buf)
end sub

sub go(n as long, s as string)  ' transfer control to line n
  dim as long i

  if validlinenum then
    i = findline(n)
    if i < 0 then
      call initlex(abs(i))
    else
      print s + " target not found: " + n + cr: errors = True
    end if
  end if
end sub

' find the goal line
' found exact match, return -i
' found first greater, return i
' else goal is > all,  0
function findline(goal as long) as long
    dim as long lo, hi, closest, i, aline

    aline = idxtoline(hi_index)
    if toktype = c_number and goal > aline then return 0

    lo = 1
    hi = hi_index

    while lo <= hi
        i = lo + int((hi - lo) \ 2)
        aline = idxtoline(i)
        if aline = goal then
            return -i
        elseif aline < goal then
            closest = i
            lo = i + 1
        else
            hi = i - 1
        end if
    wend

    i = closest + 1
    while i <= hi_index
        call initlex(i)
        if aline < goal then
            i += 1
        else
            closest = i
            exit while
        end if
    wend

    return closest
end function

function getfilename(action as string) as string  ' if tok is a string use it, otherwise, prompt
  dim as string filename
  if toktype = c_string then
    filename = mid(tok, 2)
    call nexttok
  else
    print action + ": "
    filename = rtrim(input())
  end if
  if filename <> "" then
    if instr(filename, ".") = 0 then filename = filename + ".bas"
  end if
  return filename
end function

function validlinenum() as long ' make sure line number is in range
  if num <= 0 then print "Line number out of range" + cr: errors = True: return False
  return True
end function

function random(long n) as long
  static long seed = 123456789

  seed = seed * 8121 + 28411
  return (seed & 2147483647) mod n
end function

function parenexpr() as long
  long n
  call expect("("): if errors then return 0
  n = expression(0)
  call expect(")")
  return n
end function

function expression(minprec as long) as long
  long n, n2

  ' handle numeric operands - numbers and unary operators
  if 0 then: ' to allow elseif
  elseif toktype = c_number then: n = num: call nexttok
  elseif tok = "("   then: n =  parenexpr
  elseif tok = "not" then: call nexttok: n = (expression(3) = 0)
  elseif tok = "abs" then: call nexttok: n = abs(parenexpr)
  elseif tok = "asc" then: call nexttok: call expect("("): n = asc(mid(tok, 2, 1)): call nexttok: call expect(")")
  elseif tok = "rnd" or tok = "irnd" then: call nexttok: n = parenexpr(): n = random(n) + 1
  elseif tok = "sgn" then: call nexttok: n = sgn(parenexpr)
  elseif toktype = c_ident then: n = vars[getvarindex]: call nexttok
  elseif tok = "@"   then: call nexttok: n = parenexpr: n = atarry[n]
  elseif tok = "-"   then: call nexttok: n = -expression(7)
  elseif tok = "+"   then: call nexttok: n =  expression(7)
  else: print "(" + idxtoline(curline) + ") syntax error: expecting an operand, found: " + tok + cr: errors = True: return 0
  end if

  do  ' while binary operator and precedence of tok >= minprec
    if 0 then: ' to allow elseif
    elseif minprec <= 1 and tok = "or"  then: call nexttok: n2 = expression(2): n = n or n2
    elseif minprec <= 2 and tok = "and" then: call nexttok: n2 = expression(3): n = n and n2
    elseif minprec <= 4 and tok = "="   then: call nexttok: n = abs(n = expression(5))
    elseif minprec <= 4 and tok = "<"   then: call nexttok: n = abs(n < expression(5))
    elseif minprec <= 4 and tok = ">"   then: call nexttok: n = abs(n > expression(5))
    elseif minprec <= 4 and tok = "<>"  then: call nexttok: n = abs(n <> expression(5))
    elseif minprec <= 4 and tok = "<="  then: call nexttok: n = abs(n <= expression(5))
    elseif minprec <= 4 and tok = ">="  then: call nexttok: n = abs(n >= expression(5))
    elseif minprec <= 5 and tok = "+"   then: call nexttok: n += expression(6)
    elseif minprec <= 5 and tok = "-"   then: call nexttok: n -= expression(6)
    elseif minprec <= 6 and tok = "*"   then: call nexttok: n = n * expression(7)
    elseif minprec <= 6 and (tok = "/" or tok = "\") then: call nexttok: n = (n \ expression(7))
    elseif minprec <= 6 and tok = "mod" then: call nexttok: n = (n mod expression(7))
    elseif minprec <= 8 and tok = "^"   then: call nexttok: n = (n ^ expression(9))
    else: exit do
    end if
  loop

  return n
end function

function getvarindex() as long ' return the index in var store, in 0..25
  if toktype <> c_ident then print "(" + idxtoline(curline) + ") Not a variable:" + tok + cr: return True
  return asc(left(tok, 1)) - asc("a")
end function

sub expect(s as string)
  if not accept(s) then
    print "(" + idxtoline(curline) + ") expecting " + s + " but found " + tok + " =>" + pgm[curline] + cr: errors = True
  end if
end sub

function accept(s as string) as long
  if tok = s then call nexttok: return True else return False
end function

sub initlex(n as long)  ' if not line 0, skip the line number
  curline = n: textp = 1
  call initlex2
  if n <> 0 and toktype = c_number then call nexttok
end sub

sub initlex2  ' entry point to continue where we left off
  thelin = pgm[curline]
  call nexttok
end sub

sub nexttok
  tok = "": toktype = c_default: thech = ""
  do while textp <= len(thelin)
    thech = mid(thelin, textp, 1)
    select case toktype
      case c_default
        if 0 then '
        elseif thech <= " " then:     rem just skip space, cf, lf
        elseif isalpha(thech) then:   toktype = c_ident
        elseif isdigit(thech) then:   toktype = c_number
        elseif ispunct(thech) then:   toktype = c_punct
        elseif thech = c_dquote then: toktype = c_string
        elseif thech = c_squote then: call skiptoeol: exit sub
        else: print "(" + idxtoline(curline) + "," + textp + ") " + "What>" + tok + "< " + thelin + cr: errors = True: exit sub
        end if
      case c_ident:  if not isalpha(thech) then exit do
      case c_number: if not isdigit(thech) then exit do
      case c_string: if thech = c_dquote then textp += 1: exit sub
      case c_punct
        if (tok = "<" and (thech = ">" or thech = "=")) or (tok = ">" and thech = "=") then
          tok += thech
          textp += 1
        end if
        exit sub
    end select
    if toktype <> c_default then tok += thech
    textp += 1
  loop
  if toktype = c_number then num = val(tok)
  if toktype = c_string then print "String not terminated" + cr: errors = True
  if toktype = c_ident then
    tok = lcase(tok)
    if tok = "rem" then call skiptoeol
  end if
end sub

sub skiptoeol
  tok = "": toktype = c_default
  textp = len(thelin) + 1
end sub

function isdigit(c as string) as bool {return (c >= "0" and c <= "9") or (c = ".")}
function isalpha(c as string) as bool {return (c >= "a" and c <= "z") or (c >= "A" and c <= "Z")}
function ispunct(c as string) as bool {return instr(",#()*+-/:;<=>?@\^", c) > 0}

function idxtoline(n as long)  as long ' return the line number at line n
  dim as string s
  dim as long p
  s = ltrim(pgm[n])
  p = instr(s, " ")
  if p <= 0 then return val(s) else return val(left(s, p - 1))
end function


[Charles Pegge]

Hello Ed, Thanks for your update.

I have tested the extended case syntax with TinyBasic. Here is your code with case blocks instead of elseifs:

Code Select Expand

'Tiny Basic interpreter in Oxygen Basic. Uses long as base type. By Ed Davis.
#lookahead
uses console
indexbase 0

Declare Sub ExitProcess Lib "kernel32.dll" (ByVal uExitCode As Long)
Declare Function GetCommandLine Lib "kernel32.dll" Alias "GetCommandLineA" () as char*

const long c_maxlines = 1000, c_maxvars = 26, c_at_max = 1500, c_g_stack = 100
string c_tab = chr(9), c_squote = chr(39), c_dquote = chr(34)
global as long c_default=0, c_ident=1, c_number=2, c_string=3, c_punct=4

global as string pgm[c_maxlines]    ' program stored here
global as long vars[c_maxvars]      ' variable store
global as long gstackln[c_g_stack]  ' gosub line stack
global as long gstacktp[c_g_stack]  ' gosub textp stack
global as long gsp                  ' gosub stack index
global as long atarry[c_at_max]     ' the @ array
global as long forvar[c_maxvars]
global as long forlimit[c_maxvars]
global as long forline[c_maxvars]
global as long forpos[c_maxvars]

global as string tok                ' current token
global as string thelin, thech      ' current program line, current character
global as long curline, textp       ' position in current line
global as long num                  ' last number read by scanner
global as long toktype, errors, tracing
global as long hi_index             ' highest used index in pgm

call main

sub main
  dim string command = getarg()
  call newstmt  ' resets gsp, hi_index
  if command <> "" then
    pgm[0] = "run " + c_dquote + command + c_dquote
    call initlex(0)
    call docmd
  else
    call help
  end if
  do
    errors = False
    print "tb> ": pgm[0] = rtrim(input())
    if pgm[0] <> "" then
      call initlex(0)
      if toktype <> c_number then
        call docmd
      else
        if validlinenum then
          dim as long n, i, deleted

          deleted = False
          n = findline(num) ' see function for details

          if n < 0 then     ' replace line
              n = abs(n)
              ' if just a number, delete that line
              if textp > len(pgm[0]) then
                for i = n to hi_index - 1
                  pgm[i] = pgm[i + 1]
                next i
                hi_index -= 1
                deleted = True
              end if
          elseif n > 0 then ' insert line
              for i = hi_index + 1 to n step -1
                  pgm[i] = pgm[i - 1]
              next i
              hi_index += 1
          else              ' append
              hi_index += 1
              n = hi_index
          end if

          if not deleted then pgm[n] = pgm[0]
        end if
      end if
    end if
  loop
end sub

function getarg() as string ' skip over program name and return any arguments
  string st = ltrim(rtrim(GetCommandLine()))
  int p = instr(st, " ")    ' space delimiter?
  if p < 1 then return ""   ' nope no arguments
  return ltrim(mid(st, p + 1))   ' everything after the program name
end function

sub docmd   ' main command loop
  dim as long need_colon
  do while not errors
    if tracing and left(tok, 1) <> ":" then print idxtoline(curline) + " " + tok + thech + mid(thelin, textp) + cr
    need_colon = False
    select
    case tok = "bye" or tok = "quit" : call nexttok: ExitProcess(2)
    case tok = "end" or tok = "stop" : call nexttok: exit sub
    case tok = "load" or tok = "old" : call nexttok: call loadstmt: exit sub
    case tok = "new"         : call nexttok: call newstmt:  exit sub
    case tok = "gosub"       : call nexttok: call gosubstmt
    case tok = "goto"        : call nexttok: call gotostmt
    case tok = "if"          : call nexttok: call ifstmt
    case tok = "next"        : call nexttok: call nextstmt    ' colon checked in rtn
    case tok = "return"      : call nexttok: call returnstmt  ' colon checked in rtn
    case tok = "run"         : call nexttok: call runstmt
    case tok = "clear"       : call nexttok: call clearstmt  :need_colon = True
    case tok = "cls"         : call nexttok: cls             :need_colon = True
    case tok = "for"         : call nexttok: call forstmt    :need_colon = True
    case tok = "help"        : call nexttok: call help       :need_colon = True
    case tok = "input"       : call nexttok: call inputstmt  :need_colon = True
    case tok = "list"        : call nexttok: call liststmt   :need_colon = True
    case tok = "print" or tok = "?" : call nexttok: call printstmt  :need_colon = True
    case tok = "save"        : call nexttok: call savestmt   :need_colon = True
    case tok = "troff"       : call nexttok: tracing = False :need_colon = True
    case tok = "tron"        : call nexttok: tracing = True  :need_colon = True
    case tok = ":" or tok = "" : call nexttok
    case else
        if tok = "let" then call nexttok
        if toktype = c_ident then
          call assign
        elseif tok = "@" then
          call nexttok: call arrassn
        else
          print "Unknown token '"; tok; "' at line:"; idxtoline(curline); " Col:"; textp; " : "; thelin: errors = True
        end if
    end select

    if tok = "" then
      while tok = "" and not errors
        if curline = 0 or curline >= hi_index then
          errors = True
        else
          call initlex(curline + 1)
        end if
      wend
    elseif need_colon and not accept(":") then
      print ": expected but found: " + tok + cr: errors = True
    end if
  loop
end sub

sub help  ' I get by with a little help from my friends!
   print "Tiny Basic (O2)"                                                        + cr
   print ""                                                                       + cr
   print "  bye, clear, cls, end/stop, help, list, load/save, new, run, tron/off" + cr
   print "  for <var> = <expr1> to <expr2> ... next <var>                       " + cr
   print "  gosub <expr> ... return                                             " + cr
   print "  goto <expr>                                                         " + cr
   print "  if <expr> then <statement>                                          " + cr
   print "  input [prompt,] <var>                                               " + cr
   print "  <var>=<expr>                                                        " + cr
   print "  print <expr|string>[,<expr|string>][;]                              " + cr
   print "  rem <anystring>  or ' <anystring>                                   " + cr
   print "  Operators: ^, * / \ mod + - < <= > >= = <>, not, and, or            " + cr
   print "  Integer variables a..z, and array @(expr)                           " + cr
   print "  Functions: abs(expr), asc(ch), rnd(expr), sgn(expr)                 " + cr
   print ""                                                                       + cr
end sub

sub assign  ' ident = expr
  dim as long xvar
  xvar = getvarindex: call nexttok
  call expect("=")
  vars[xvar] = expression(0)
  if tracing then print "*** " + chr(xvar + asc("a")) + " = " + vars[xvar] + cr
end sub

sub arrassn   ' array assignment: @(expr) = expr
  dim as long atndx
  atndx = parenexpr
  call expect("=")
  atarry[atndx] = expression(0)
  if tracing then print "*** @(" + atndx + ") = " + atarry[atndx] + cr
end sub

sub clearstmt ' clear all variables
  dim as long i
  for i = 1 to c_maxvars
    vars[i] = 0
  next i
  for i = 0 to c_at_max
    atarry[i] = 0
  next i
  gsp = 0
end sub

sub forstmt   ' for i = expr to expr
  dim as long xvar, forndx

  xvar = getvarindex
  call assign
  ' vars[xvar] has the value; xvar has the number value of the variable in 0..25
  forndx = xvar
  forvar[forndx] = vars[xvar]
  if tok <> "to" then
    print "For: Expecting 'to', found:" + tok + cr: errors = True
  else
    call nexttok
    forlimit[forndx] = expression(0)
    ' need to store iter, limit, line, and col
    forline[forndx] = curline
    if tok = "" then forpos[forndx] = textp else forpos[forndx] = textp - 1
  end if
end sub

sub gosubstmt   ' gosub expr: for gosub: save the line and column
  gsp += 1
  num = expression(0)
  gstackln[gsp] = curline
  if tok = "" then gstacktp[gsp] = textp else gstacktp[gsp] = textp - 1
  call go(num, "gosub")
end sub

sub gotostmt  ' goto expr
  num = expression(0)
  call go(num, "goto")
end sub

sub ifstmt  ' if expr [then] {stmt} {: stmt}
  if expression(0) = 0 then call skiptoeol: exit sub
  if tok = "then" then call nexttok
  if toktype = c_number then call gotostmt
end sub

sub inputstmt   ' "input" [string ","] xvar
  dim as long xvar
  dim as string st
  if toktype = c_string then
    print mid(tok, 2)
    call nexttok
    call expect(",")
  else
    print "? "
  end if
  xvar = getvarindex: call nexttok
  st = rtrim(input())
  if st = "" then st = "0"
  if (left(st, 1) >= "0" and left(st, 1) <= "9") or left(st, 1) = "-" then
    vars[xvar] = val(st)
  else
    vars[xvar] = asc(st)
  end if
end sub

sub liststmt  ' show the current program
  dim as long i
  for i = 1 to hi_index
    print pgm[i] + cr
  next i
  print
end sub

sub loadstmt  ' load ["string"]
  dim as string filename, src, s
  dim as long start, pos

  filename = getfilename("Load")
  if filename = "" then exit sub
  call newstmt
  getfile(filename, src)
  if len(src) = 0 then return

  start = 1
  do
    pos = instr(start, src, chr(13))
    if pos <= 0 then exit do
    hi_index += 1
    pgm[hi_index] = mid(src, start, pos - start)
    start = pos + 1
    if mid(src, start, 1) = chr(10) then start += 1
  loop
  ' handle unterminated lines
  if start <= len(src) then
    hi_index += 1
    pgm[hi_index] = mid(src, start)
  end if

  curline = 1
end sub

sub newstmt ' clears program and variable store
  dim as long i
  call clearstmt
  for i = 1 to c_maxlines
    pgm[i] = ""
  next i
  hi_index = 0
end sub

sub nextstmt  ' next ident - ident is required
  dim as long forndx

  ' 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]
    call initlex2
  else
    call nexttok ' skip the ident for now
    if tok <> "" and tok <> ":" then
      print "Next: expected ':' before statement, but found:" + tok + cr: errors = True
    end if
  end if
end sub

' "print" [[#num "," ] expr { "," [#num ","] expr }] [","] {":" stmt} eol
' expr can also be a literal string
sub printstmt
  dim as long printnl, printwidth, n
  dim as string junk

  printnl = True
  do while tok <> ":" and tok <> "" and tok <> "else"
    printnl = True
    printwidth = 0
    if accept("#") then
      if num <= 0 then print "Expecting a print width, found:" + tok + cr: exit sub
      printwidth = num
      call nexttok
      if not accept(",") then print "Print: Expecting a ',', found:" + tok + cr: exit sub
    end if

    if toktype = c_string then
      junk = mid(tok, 2)
      call nexttok
    elseif toktype = c_ident and tok = "chr" and thech = "" then
        textp += 1 ' consume
        call nexttok      ' get (
        n = parenexpr
        junk = chr(n)
    else
      n = expression(0)
      junk = ltrim(str(n))
    end if
    printwidth = printwidth - len(junk)
    if printwidth <= 0 then print junk: else print space(printwidth) + junk

    if accept(",") or accept(";") then printnl = False else exit do
  loop

  if printnl then print cr
end sub

sub returnstmt ' exit from a subroutine
  curline = gstackln[gsp]
  textp   = gstacktp[gsp]
  gsp -= 1
  call initlex2
  if tok <> "" and tok <> ":" then
    print "Return: expected ':' before statement, but found:" + tok + cr: errors = True
  end if
end sub

sub runstmt ' run ["string"]
  call clearstmt
  if toktype = c_string then call loadstmt
  call initlex(1)
end sub

sub savestmt ' save ["string"]
  long i
  string filename, buf

  filename = getfilename("Save")
  if filename = "" then exit sub

  buf = ""
  for i = 1 to hi_Index
    if pgm[i] <> "" then buf += pgm[i] + cr
  next i
  putfile(filename, buf)
end sub

sub go(n as long, s as string)  ' transfer control to line n
  dim as long i

  if validlinenum then
    i = findline(n)
    if i < 0 then
      call initlex(abs(i))
    else
      print s + " target not found: " + n + cr: errors = True
    end if
  end if
end sub

' find the goal line
' found exact match, return -i
' found first greater, return i
' else goal is > all,  0
function findline(goal as long) as long
    dim as long lo, hi, closest, i, aline

    aline = idxtoline(hi_index)
    if toktype = c_number and goal > aline then return 0

    lo = 1
    hi = hi_index

    while lo <= hi
        i = lo + int((hi - lo) \ 2)
        aline = idxtoline(i)
        if aline = goal then
            return -i
        elseif aline < goal then
            closest = i
            lo = i + 1
        else
            hi = i - 1
        end if
    wend

    i = closest + 1
    while i <= hi_index
        call initlex(i)
        if aline < goal then
            i += 1
        else
            closest = i
            exit while
        end if
    wend

    return closest
end function

function getfilename(action as string) as string  ' if tok is a string use it, otherwise, prompt
  dim as string filename
  if toktype = c_string then
    filename = mid(tok, 2)
    call nexttok
  else
    print action + ": "
    filename = rtrim(input())
  end if
  if filename <> "" then
    if instr(filename, ".") = 0 then filename = filename + ".bas"
  end if
  return filename
end function

function validlinenum() as long ' make sure line number is in range
  if num <= 0 then print "Line number out of range" + cr: errors = True: return False
  return True
end function

function random(long n) as long
  static long seed = 123456789

  seed = seed * 8121 + 28411
  return (seed & 2147483647) mod n
end function

function parenexpr() as long
  long n
  call expect("("): if errors then return 0
  n = expression(0)
  call expect(")")
  return n
end function

function expression(minprec as long) as long
  long n, n2

  ' handle numeric operands - numbers and unary operators
  select
  case toktype = c_number : n = num: call nexttok
  case tok = "("   : n =  parenexpr
  case tok = "not" : call nexttok: n = (expression(3) = 0)
  case tok = "abs" : call nexttok: n = abs(parenexpr)
  case tok = "asc" : call nexttok: call expect("("): n = asc(mid(tok, 2, 1)): call nexttok: call expect(")")
  case tok = "rnd" or tok = "irnd" : call nexttok: n = parenexpr(): n = random(n) + 1
  case tok = "sgn" : call nexttok: n = sgn(parenexpr)
  case toktype = c_ident : n = vars[getvarindex]: call nexttok
  case tok = "@"   : call nexttok: n = parenexpr: n = atarry[n]
  case tok = "-"   : call nexttok: n = -expression(7)
  case tok = "+"   : call nexttok: n =  expression(7)
  case else : print "(" + idxtoline(curline) + ") syntax error: expecting an operand, found: " + tok + cr: errors = True: return 0
  end select

  do  ' while binary operator and precedence of tok >= minprec
    select
    case minprec <= 1 and tok = "or"  : call nexttok: n2 = expression(2): n = n or n2
    case minprec <= 2 and tok = "and" : call nexttok: n2 = expression(3): n = n and n2
    case minprec <= 4 and tok = "="   : call nexttok: n = abs(n = expression(5))
    case minprec <= 4 and tok = "<"   : call nexttok: n = abs(n < expression(5))
    case minprec <= 4 and tok = ">"   : call nexttok: n = abs(n > expression(5))
    case minprec <= 4 and tok = "<>"  : call nexttok: n = abs(n <> expression(5))
    case minprec <= 4 and tok = "<="  : call nexttok: n = abs(n <= expression(5))
    case minprec <= 4 and tok = ">="  : call nexttok: n = abs(n >= expression(5))
    case minprec <= 5 and tok = "+"   : call nexttok: n += expression(6)
    case minprec <= 5 and tok = "-"   : call nexttok: n -= expression(6)
    case minprec <= 6 and tok = "*"   : call nexttok: n = n * expression(7)
    case minprec <= 6 and (tok = "/" or tok = "\") : call nexttok: n = (n \ expression(7))
    case minprec <= 6 and tok = "mod" : call nexttok: n = (n mod expression(7))
    case minprec <= 8 and tok = "^"   : call nexttok: n = (n ^ expression(9))
    case else : exit do
    end select
  loop

  return n
end function

function getvarindex() as long ' return the index in var store, in 0..25
  if toktype <> c_ident then print "(" + idxtoline(curline) + ") Not a variable:" + tok + cr: return True
  return asc(left(tok, 1)) - asc("a")
end function

sub expect(s as string)
  if not accept(s) then
    print "(" + idxtoline(curline) + ") expecting " + s + " but found " + tok + " =>" + pgm[curline] + cr: errors = True
  end if
end sub

function accept(s as string) as long
  if tok = s then call nexttok: return True else return False
end function

sub initlex(n as long)  ' if not line 0, skip the line number
  curline = n: textp = 1
  call initlex2
  if n <> 0 and toktype = c_number then call nexttok
end sub

sub initlex2  ' entry point to continue where we left off
  thelin = pgm[curline]
  call nexttok
end sub

sub nexttok
  tok = "": toktype = c_default: thech = ""
  do while textp <= len(thelin)
    thech = mid(thelin, textp, 1)
    select case toktype
      case c_default
        if 0 then '
        elseif thech <= " " then:     rem just skip space, cf, lf
        elseif isalpha(thech) then:   toktype = c_ident
        elseif isdigit(thech) then:   toktype = c_number
        elseif ispunct(thech) then:   toktype = c_punct
        elseif thech = c_dquote then: toktype = c_string
        elseif thech = c_squote then: call skiptoeol: exit sub
        else: print "(" + idxtoline(curline) + "," + textp + ") " + "What>" + tok + "< " + thelin + cr: errors = True: exit sub
        end if
      case c_ident:  if not isalpha(thech) then exit do
      case c_number: if not isdigit(thech) then exit do
      case c_string: if thech = c_dquote then textp += 1: exit sub
      case c_punct
        if (tok = "<" and (thech = ">" or thech = "=")) or (tok = ">" and thech = "=") then
          tok += thech
          textp += 1
        end if
        exit sub
    end select
    if toktype <> c_default then tok += thech
    textp += 1
  loop
  if toktype = c_number then num = val(tok)
  if toktype = c_string then print "String not terminated" + cr: errors = True
  if toktype = c_ident then
    tok = lcase(tok)
    if tok = "rem" then call skiptoeol
  end if
end sub

sub skiptoeol
  tok = "": toktype = c_default
  textp = len(thelin) + 1
end sub

function isdigit(c as string) as bool {return (c >= "0" and c <= "9") or (c = ".")}
function isalpha(c as string) as bool {return (c >= "a" and c <= "z") or (c >= "A" and c <= "Z")}
function ispunct(c as string) as bool {return instr(",#()*+-/:;<=>?@\^", c) > 0}

function idxtoline(n as long)  as long ' return the line number at line n
  dim as string s
  dim as long p
  s = ltrim(pgm[n])
  p = instr(s, " ")
  if p <= 0 then return val(s) else return val(left(s, p - 1))
end function


Update:
https://github.com/Charles-Pegge/OxygenBasic/blob/master/OxygenBasic.zip
https://github.com/Charles-Pegge/OxygenBasic/blob/master/OxygenBasic.zip

[Ed Davis]

Hello Ed, Thanks for your update.

I have tested the extended case syntax with TinyBasic. Here is your code with case blocks instead of elseifs:

Very, very cool!
Thanks for the update!  Will get it and give it a go!
I'm very happy!

[Charles Pegge]

It was a good idea, Ed   I am sure to make use of it in the o2 source code.

It is also possible to combine the two modalities in the same case block. It really organizes the code. Here is a candidate for underscore line continuations. most of the cases are testing for ascii values, but a flag sk is also tested with the new syntax, instead of making an additional 'if' statement.

Code Select Expand

procedure LineCont(sys *p)
==========================
'_' underscore
byte bt at p
int sk 'in-comment flag
if bt[1]>32
  exit procedure
endif
do
  @bt++
  ascn=bt 'next byte
  select ascn
  case 0         : exit do
  case sk>0      : 'skip comment
  case 65 to 90  : ascn+=32 : exit do 'to lower case
  case 33 to 255 : exit do
  case 10,13     : sk=0
  case ct1,ct2   : sk=1 'start comment
  end select
end do
end procedure


[Frank Brübach]

Hey ed thx for your tiny Interpreter...

How does IT Work? Do you have a simple example Here?

How to use Input command with a simple calculation?

Long a, b, c
A=5 : b=42 : c=a*b

For example

Your Help File is good but too short in my eyes.. perhaps you can send an example when your starting tiny Basic and an Option would be good too Like Option q quit R repeat Something Like this one

Good Luck for more ideas

[Zlatko Vid]

Hey Frank

I try to compile latest code in older 0.6.0
and not work

I try code from Ed repo from github
that code compile but simply crush on any entered
so i don't get it

i can bet that i compile older version and run it but now not 

[Zlatko Vid]

ahh this older version work

@Charles ..so i must use latest to compile with new SELECT case
right ?

Code Select Expand

'Tiny Basic interpreter in Oxygen Basic. Ed Davis.
'this version 02 compile and work in o2 v 0.6.0

#lookahead
uses console
indexbase 0

Declare Sub ExitProcess Lib "kernel32.dll" (ByVal uExitCode As Long)

const long True = -1, False = 0, c_maxlines = 1000, c_maxvars = 26, c_at_max = 500, c_g_stack = 100
string c_tab = chr(9), c_squote = chr(39), c_dquote = chr(34)
global as long c_default=0, c_ident=1, c_number=2, c_string=3, c_punct=4
c_default = 0: c_ident = 1: c_number = 2: c_string = 3: c_punct = 4

global as string pgm[c_maxlines]    ' program stored here
global as double vars[c_maxvars]    ' variable store
global as long gstackln[c_g_stack]  ' gosub line stack
global as long gstacktp[c_g_stack]  ' gosub textp stack
global as long gsp                  ' gosub stack index
global as double atarry[c_at_max]   ' the @ array
global as long forvar[c_maxvars]
global as long forlimit[c_maxvars]
global as long forline[c_maxvars]
global as long forpos[c_maxvars]

global as string tok                ' current token
global as string thelin, thech      ' current program line, current character
global as long curline, textp       ' position in current line
global as double num                ' last number read by scanner
global as long toktype, errors, tracing
global as long hi_index             ' highest used index in pgm

call main

sub main
  call newstmt  ' resets gsp, hi_index
'  if command <> "" then
'    pgm(0) = "run " + c_dquote + command + c_dquote
'    call initlex(0)
'    call docmd
'  else
'    call help
'  end if
  call help
  do
    errors = False
    print "tb> ": pgm[0] = rtrim(input())
    if pgm[0] <> "" then
      call initlex(0)
      if toktype <> c_number then
        call docmd
      else
        if validlinenum then
          dim as long n, i, deleted

          deleted = False
          n = findline(num) ' see function for details

          if n < 0 then     ' replace line
              n = abs(n)
              ' if just a number, delete that line
              if textp > len(pgm[0]) then
                for i = n to hi_index - 1
                  pgm[i] = pgm[i + 1]
                next i
                hi_index = hi_index - 1
                deleted = True
              end if
          elseif n > 0 then ' insert line
              for i = hi_index + 1 to n step -1
                  pgm[i] = pgm[i - 1]
              next i
              hi_index = hi_index + 1
          else              ' append
              hi_index = hi_index + 1
              n = hi_index
          end if

          if not deleted then pgm[n] = pgm[0]
        end if
      end if
    end if
  loop
end sub

sub docmd
  dim as long need_colon
  do while not errors
    'print "docmd tok: " + tok + cr
    if tracing and left(tok, 1) <> ":" then print idxtoline(curline) + " " + tok + thech + mid(thelin, textp) + cr
    need_colon = False
    if accept("bye") or accept("quit") then
      ExitProcess(2)
    elseif accept("end") or accept("stop") then
      exit sub
    elseif accept("load") or accept("old") then
      call loadstmt: exit sub
    elseif accept("new") then
      call newstmt:  exit sub
    elseif accept("gosub") then
      call gosubstmt
    elseif accept("goto") then
      call gotostmt
    elseif accept("if") then
      call ifstmt
    elseif accept("next") then
      call nextstmt    ' colon checked in rtn
    elseif accept("return") then
      call returnstmt  ' colon checked in rtn
    elseif accept("run") then
      call runstmt
    elseif accept("clear") then
      call clearstmt  :need_colon = True
    elseif accept("cls") then
      cls             :need_colon = True
    elseif accept("for") then
      call forstmt    :need_colon = True
    elseif accept("help") then
      call help       :need_colon = True
    elseif accept("input") then
      call inputstmt  :need_colon = True
    elseif accept("list") then
      call liststmt   :need_colon = True
    elseif accept("print") or accept("?") then
      call printstmt  :need_colon = True
    elseif accept("save") then
      call savestmt   :need_colon = True
    elseif accept("troff") then
      tracing = False :need_colon = True
    elseif accept("tron") then
      tracing = True  :need_colon = True
    elseif accept(":") or tok = "" then
      rem nothing
    else
        'print "docmd else" + cr
        if tok = "let" then call nexttok
        if toktype = c_ident then
          call assign
        elseif tok = "@" then
          call nexttok: call arrassn
        else
          print "Unknown token '" + tok + "' at line:" + idxtoline(curline) + " Col:" + textp + " : " + thelin + cr: errors = True
        end if
    end if
    'print "docmd after select" + cr

    if tok = "" then
      while tok = "" and not errors
        if curline = 0 or curline >= hi_index then
          errors = True
        else
          call initlex(curline + 1)
        end if
      wend
    elseif need_colon and not accept(":") then
      print ": expected but found: " + tok + cr: errors = True
    end if
  loop
end sub

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

sub assign  ' ident = expr
  dim as long xvar
  'print "assign, tok: " + tok + cr
  xvar = getvarindex: call nexttok
  call expect("=")
  'print "assign, expr: " + tok + cr
  vars[xvar] = expression(0)
  if tracing then print "*** " + chr(xvar + asc("a")) + " = " + vars[xvar] + cr
end sub

sub arrassn   ' array assignment: @(expr) = expr
  dim as long atndx
  atndx = parenexpr
  call expect("=")
  atarry[atndx] = expression(0)
  if tracing then print "*** @(" + atndx + ") = " + atarry[atndx] + cr
end sub

sub clearstmt ' clear all variables
  dim as long i
  for i = 1 to c_maxvars
    vars[i] = 0
  next i
  for i = 0 to c_at_max
    atarry[i] = 0
  next i
  gsp = 0
end sub

sub forstmt   ' for i = expr to expr
  dim as long xvar, forndx

  xvar = getvarindex
  call assign
  ' vars[xvar] has the value; xvar has the number value of the variable in 0..25
  forndx = xvar
  forvar[forndx] = vars[xvar]
  if tok <> "to" then
    print "For: Expecting 'to', found:" + tok + cr: errors = True
  else
    call nexttok
    forlimit[forndx] = expression(0)
    ' need to store iter, limit, line, and col
    forline[forndx] = curline
    if tok = "" then forpos[forndx] = textp else forpos[forndx] = textp - 1
  end if
end sub

sub gosubstmt   ' gosub expr: for gosub: save the line and column
  gsp = gsp + 1
  num = expression(0)
  gstackln[gsp] = curline
  if tok = "" then gstacktp[gsp] = textp else gstacktp[gsp] = textp - 1
  call go(num, "gosub")
end sub

sub gotostmt  ' goto expr
  num = expression(0)
  call go(num, "goto")
end sub

sub ifstmt  ' if expr then {stmt} {: stmt}
  if expression(0) = 0 then call skiptoeol: exit sub
  if tok = "then" then call nexttok
  if toktype = c_number then call gotostmt
end sub

sub inputstmt   ' "input" [string ","] xvar
  dim as long xvar
  dim as string st
  if toktype = c_string then
    print mid(tok, 2)
    call nexttok
    call expect(",")
  else
    print "? "
  end if
  xvar = getvarindex: call nexttok
  st = rtrim(input())
  if st = "" then st = "0"
  if (left(st, 1) >= "0" and left(st, 1) <= "9") or left(st, 1) = "-" then
    vars[xvar] = val(st)
  else
    vars[xvar] = asc(st)
  end if
end sub

sub liststmt
  dim as long i
  for i = 1 to hi_index
    print pgm[i] + cr
  next i
  print
end sub

sub loadstmt  ' load ["string"]
  dim as string filename, src, s
  dim as long flen, i

  filename = getfilename("Load")
  if filename = "" then exit sub
  call newstmt
  getfile(filename, src)
  flen = len(src)
  if flen = 0 then return

  s = ""
  i = 1
  while i <= flen
    if mid(src, i, 1) = chr(13) then
      hi_index = hi_index + 1
      pgm[hi_index] = s
      s = ""
      if (i < flen) and (mid(src, i + 1, 1) = chr(10)) then i = i + 1
    else
      s = s + mid(src, i, 1)
    end if
    i = i + 1
  wend
  curline = 1
end sub

sub newstmt ' clears program and variable store
  dim as long i
  call clearstmt
  for i = 1 to c_maxlines
    pgm[i] = ""
  next i
  hi_index = 0
end sub

sub nextstmt  ' next ident - ident is required
  dim as long forndx

  ' 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]
    call initlex2
  else
    call nexttok ' skip the ident for now
    if tok <> "" and tok <> ":" then
      print "Next: expected ':' before statement, but found:" + tok + cr: errors = True
    end if
  end if
end sub

' "print" [[#num "," ] expr { "," [#num ","] expr }] [","] {":" stmt} eol
' expr can also be a literal string
sub printstmt
  dim as long printnl, printwidth, n
  dim as string junk

  printnl = True
  do while tok <> ":" and tok <> "" and tok <> "else"
    printnl = True
    printwidth = 0
    if accept("#") then
      if num <= 0 then print "Expecting a print width, found:" + tok + cr: exit sub
      printwidth = num
      call nexttok
      if not accept(",") then print "Print: Expecting a ',', found:" + tok + cr: exit sub
    end if

    if toktype = c_string then
      junk = mid(tok, 2)
      call nexttok
    elseif toktype = c_ident and tok = "chr" and thech = "" then
        textp = textp + 1 ' consume
        call nexttok      ' get (
        n = parenexpr
        junk = chr(n)
    else
      n = expression(0)
      junk = ltrim(str(n))
    end if
    printwidth = printwidth - len(junk)
    if printwidth <= 0 then print junk: else print space(printwidth) + junk

    if accept(",") or accept(";") then printnl = False else exit do
  loop

  if printnl then print cr
end sub

sub returnstmt ' exit from a subroutine
  curline = gstackln[gsp]
  textp   = gstacktp[gsp]
  gsp = gsp - 1
  call initlex2
  if tok <> "" and tok <> ":" then
    print "Return: expected ':' before statement, but found:" + tok + cr: errors = True
  end if
end sub

sub runstmt ' run ["string"]
  call clearstmt
  if toktype = c_string then call loadstmt
  call initlex(1)
end sub

sub savestmt ' save ["string"]
'  dim as long i
'  dim as string filename
'
'  filename = getfilename("Save")
'  if filename = "" then exit sub
'  open filename for output as #1
'  for i = 1 to hi_Index
'    if pgm[i] <> "" then print #1, pgm[i]
'  next i
'  close #1
end sub

sub go(n as long, s as string)  ' transfer control to line n
  dim as long i

  if validlinenum then
    i = findline(n)
    if i < 0 then
      call initlex(abs(i))
    else
      print s + " target not found: " + n + cr: errors = True
    end if
  end if
end sub

' find the goal line
' found exact match, return -i
' found first greater, return i
' else goal is > all,  0
function findline(goal as long) as long
    dim as long lo, hi, closest, i, aline

    aline = idxtoline(hi_index)
    if toktype = c_number and goal > aline then return 0

    lo = 1
    hi = hi_index

    while lo <= hi
        i = lo + int((hi - lo) \ 2)
        aline = idxtoline(i)
        if aline = goal then
            return -i
        elseif aline < goal then
            closest = i
            lo = i + 1
        else
            hi = i - 1
        end if
    wend

    i = closest + 1
    while i <= hi_index
        call initlex(i)
        if aline < goal then
            i = i + 1
        else
            closest = i
            exit while
        end if
    wend

    return closest
end function

function getfilename(action as string) as string
  dim as string filename
  if toktype = c_string then
    filename = mid(tok, 2)
  else
    print action + ": "
    filename = rtrim(input())
  end if
  if filename <> "" then
    if instr(filename, ".") = 0 then filename = filename + ".bas"
  end if
  return filename
end function

function validlinenum() as long
  if num <= 0 then print "Line number out of range" + cr: errors = True: return False
  return True
end function

function random(long n) as long
  static long seed = 123456789
  long r
                                ': print "seed: " + seed + cr
  seed = seed * 8121 + 28411    ': print "seed after *: " + seed + cr
  r = seed & 2147483647         ': print "r after &: " + r + cr
  r = r mod n                   ': print "r after " + r + " mod " + n + " : " + r + cr
  return r
end function

function parenexpr() as double
  double n
  call expect("("): if errors then return 0
  n = expression(0)
  call expect(")")
  return n
end function

function expression(minprec as long) as double
  double n, n2, long x, y

  ' handle numeric operands - numbers and unary operators
  if 0 then: ' to allow elseif
  elseif toktype = c_number then: n = num: call nexttok
  elseif tok = "("   then: n =  parenexpr
  elseif tok = "not" then: call nexttok: n = (expression(3) = 0)
  elseif tok = "abs" then: call nexttok: n = abs(parenexpr)
  elseif tok = "asc" then: call nexttok: call expect("("): n = asc(mid(tok, 2, 1)): call nexttok: call expect(")")
  elseif tok = "rnd" or tok = "irnd" then: call nexttok: n2 = parenexpr(): n = random(n2) + 1
  elseif tok = "sgn" then: call nexttok: n = sgn(parenexpr)
  elseif toktype = c_ident then: n = vars[getvarindex]: call nexttok
  elseif tok = "@"   then: call nexttok: n2 = parenexpr: n = atarry[n2]
  elseif tok = "-"   then: call nexttok: n = -expression(7)
  elseif tok = "+"   then: call nexttok: n =  expression(7)
  else: print "(" + idxtoline(curline) + ") syntax error: expecting an operand, found: " + tok + cr: errors = True: return 0
  end if

  do  ' while binary operator and precedence of tok >= minprec
    if 0 then: ' to allow elseif
    elseif minprec <= 1 and tok = "or"  then: call nexttok: x = trunc(n): y = trunc(expression(2)): n = abs(x or y)
    elseif minprec <= 2 and tok = "and" then: call nexttok: x = trunc(n): y = trunc(expression(3)): n = abs(x and y)
    elseif minprec <= 4 and tok = "="   then: call nexttok: n = abs(n = expression(5))
    elseif minprec <= 4 and tok = "<"   then: call nexttok: n = abs(n < expression(5))
    elseif minprec <= 4 and tok = ">"   then: call nexttok: n = abs(n > expression(5))
    elseif minprec <= 4 and tok = "<>"  then: call nexttok: n = abs(n <> expression(5))
    elseif minprec <= 4 and tok = "<="  then: call nexttok: n = abs(n <= expression(5))
    elseif minprec <= 4 and tok = ">="  then: call nexttok: n = abs(n >= expression(5))
    elseif minprec <= 5 and tok = "+"   then: call nexttok: n = n + expression(6)
    elseif minprec <= 5 and tok = "-"   then: call nexttok: n = n - expression(6)
    elseif minprec <= 6 and tok = "*"   then: call nexttok: n = n * expression(7)
    elseif minprec <= 6 and (tok = "/" or tok = "\") then: call nexttok: n = trunc(n \ expression(7))
    elseif minprec <= 6 and tok = "mod" then: call nexttok: n = trunc(n mod expression(7))
    elseif minprec <= 8 and tok = "^"   then: call nexttok: n = (n ^ expression(9))
    else: exit do
    end if
  loop

  return n
end function

function getvarindex() as long ' return the index in var store, in 0..25
  if toktype <> c_ident then print "(" + idxtoline(curline) + ") Not a variable:" + tok + cr: return True
  return asc(left(tok, 1)) - asc("a")
end function

sub expect(s as string)
  if not accept(s) then
    print "(" + idxtoline(curline) + ") expecting " + s + " but found " + tok + " =>" + pgm[curline] + cr: errors = True
  end if
end sub

function accept(s as string) as long
  if tok = s then call nexttok: return True else return False
end function

sub initlex(n as long)  ' if not line 0, skip the line number
  curline = n: textp = 1
  call initlex2
  if n <> 0 and toktype = c_number then call nexttok
end sub

sub initlex2  ' entry point to continue where we left off
  thelin = pgm[curline]
  call nexttok
end sub

sub nexttok
  tok = "": toktype = c_default: thech = ""
  do while textp <= len(thelin)
    thech = mid(thelin, textp, 1)
    select case toktype
      case c_default
        if 0 then '
        elseif thech <= " " then:                      rem just skip space, cf, lf
        elseif isalpha(thech) then:                    toktype = c_ident
        elseif isdigit(thech) then:                    toktype = c_number
        elseif instr(",#()*+-/:;<=>?@\^", thech) then: toktype = c_punct
        elseif thech = c_dquote then:                  toktype = c_string
        elseif thech = c_squote then:                  call skiptoeol: exit sub
        else: print "(" + idxtoline(curline) + "," + textp + ") " + "What>" + tok + "< " + thelin + cr: errors = True: exit sub
        end if
      case c_ident:  if not isalpha(thech) then exit do
      case c_number: if not isdigit(thech) then exit do
      case c_string: if thech = c_dquote then textp = textp + 1: exit sub
      case c_punct
        if (tok = "<" and (thech = ">" or thech = "=")) or (tok = ">" and thech = "=") then
          tok = tok + thech
          textp = textp + 1
        end if
        exit sub
    end select
    if toktype <> c_default then tok = tok + thech
    textp = textp + 1
  loop
  if toktype = c_number then num = val(tok)
  if toktype = c_string then print "String not terminated" + cr: errors = True
  if toktype = c_ident then
    tok = lcase(tok)
    if tok = "rem" then call skiptoeol
  end if
end sub

sub skiptoeol
  tok = "": toktype = c_default
  textp = len(thelin) + 1
end sub

function isalpha(c as string) as int
  return (c >= "a" and c <= "z") or (c >= "A" and c <= "Z")
end function

function isdigit(c as string) as int
  return (c >= "0" and c <= "9") or (c = ".")
end function

function idxtoline(n as long)  as long ' return the line number at line n
  dim as string s
  dim as long p
  s = ltrim(pgm[n])
  p = instr(s, " ")
  if p <= 0 then return val(s) else return val(left(s, p - 1))
end function


[Charles Pegge]

Yes Aurel,

The new feature we are discussing is shown below

But I am working on an issue with one of the WinDynDialogs examples, which should be resolved by tomorrow'
s upload.

Code Select Expand

    select
    case tok = "bye" or tok = "quit" : call nexttok: ExitProcess(2)
    case tok = "end" or tok = "stop" : call nexttok: exit sub
    case tok = "load" or tok = "old" : call nexttok: call loadstmt: exit sub
    case tok = "new"         : call nexttok: call newstmt:  exit sub
    case tok = "gosub"       : call nexttok: call gosubstmt
    case tok = "goto"        : call nexttok: call gotostmt
    case tok = "if"          : call nexttok: call ifstmt
    case tok = "next"        : call nexttok: call nextstmt    ' colon checked in rtn
    case tok = "return"      : call nexttok: call returnstmt  ' colon checked in rtn
    case tok = "run"         : call nexttok: call runstmt
    case tok = "clear"       : call nexttok: call clearstmt  :need_colon = True
    case tok = "cls"         : call nexttok: cls             :need_colon = True
    case tok = "for"         : call nexttok: call forstmt    :need_colon = True
    case tok = "help"        : call nexttok: call help       :need_colon = True
    case tok = "input"       : call nexttok: call inputstmt  :need_colon = True
    case tok = "list"        : call nexttok: call liststmt   :need_colon = True
    case tok = "print" or tok = "?" : call nexttok: call printstmt  :need_colon = True
    case tok = "save"        : call nexttok: call savestmt   :need_colon = True
    case tok = "troff"       : call nexttok: tracing = False :need_colon = True
    case tok = "tron"        : call nexttok: tracing = True  :need_colon = True
    case tok = ":" or tok = "" : call nexttok
    case else
        if tok = "let" then call nexttok
        if toktype = c_ident then
          call assign
        elseif tok = "@" then
          call nexttok: call arrassn
        else
          print "Unknown token '"; tok; "' at line:"; idxtoline(curline); " Col:"; textp; " : "; thelin: errors = True
        end if
    end select


[Zlatko Vid]

OK Charles

select without selector(variable ) looking little bit un-natural
but i am fine with that 

WinDynDialogs examples

well that is fine for users which use Dialogs i guess
i even don't know that there are some problems .

[Frank Brübach]

I have Just tested tiny Interpreter again

Only Input command I dont know to handle

I have added for me three Options q quit, r repeat, h Help

[Ed Davis]

Hey ed thx for your tiny Interpreter...

How does IT Work? Do you have a simple example Here?

How to use Input command with a simple calculation?

Long a, b, c
A=5 : b=42 : c=a*b

For example

Your Help File is good but too short in my eyes.. perhaps you can send an example when your starting tiny Basic and an Option would be good too Like Option q quit R repeat Something Like this one

Good Luck for more ideas

Tiny Basic

This version of Tiny Basic is integer only.  There is another version that uses real numbers.

If you type in one of Tiny Basic's commands, without a line number, it simply performs the command.

For example:

print "hello world"

Will display the famous line.

for i = 1 to 10: print "i is: "; i: next i

Will display 1 .. 10 on successive lines.  ":" is the line separator.

If you type a Tiny Basic command preceded by a line number, that command is added to the program.
For instance:

10 print "hello"
20 print "world"

Will add these to lines to the program.

list

Will show the current program.

run

Will run the current program.

save

Will save the current program.

load "foo"

Will load "foo.bas" into Tiny Basic.  It is assumed foo.bas is a valid Tiny Basic program, e.g., it contains line number in consecutive order.

Commands:
bye/quit: exits to the OS
clear:    set variables to 0
cls:      clears the screen
end/stop: halts the running program
help:     displays help screen
list:     displays currently stored program
load ["name[.bas]"] loads a program into memory
save ["name[.bas]"] saves the current program
new:      removes the current program from memory
run ["name[.bas]"] runs the loaded program, or, if a name is given, loads and runs that program
tron      turns tracing on
troff     turns tracing off
for <var> = <expr1> to <expr2> ... next <var>: a for loop
gosub <expr> ... return
goto <expr>
if <expr> then <statement>
input [prompt,] <var>
<var>=<expr>
print <expr|string>[,<expr|string>][;]
rem <anystring>  or ' <anystring>
Operators: ^, * / \ mod + - < <= > >= = <>, not, and, or
Integer variables a..z
array @:  @(5) = 23: i = 4: @(i) = 42:  @(@(i)) = @(5)
Available Functions: abs(expr), asc(ch), rnd(expr), sgn(expr)

Sample session.
tb> i = 3
tb> ? i
3
tb> @(i) = 20
tb> ? @(i)
20
tb> @(@(i)) = 42
tb> ? @(20)
42
tb>

Two non trivial Tiny Basic programs:

MineSweeper:

Code Select Expand

1 ' PROGRAM: Minesweeper for Tiny Basic, by Marcus
2 ' ===========================================================================
3 m = 15 ' Number of mines (difficulty).
4 for i = 0 to 99 : @(i) = 10 : @(100 + i) = 0 : next i ' Clear map.
5 gosub 110: print "Dig at" : gosub 30 ' Display map, input initial dig.
6 gosub 80 ' Generate map with m mines, make pos x, y safe.
7 s = 0 : f = m ' Set game state s to 0 and unused flags f to number of mines.
8 gosub 140 ' Dig at x, y.
10 ' Game loop =================================================================
11 gosub 110 ' Display map.
12 print "Flags left: "; : print f
13 input "Action (d = dig, f = add/remove flag, q = quit, c = cheat): ", a
14 if a = asc("d") then gosub 40
15 if a = asc("f") then gosub 50
16 if a = asc("c") then gosub 70
17 if a = asc("q") then s = -1
18 if s = 0 then goto 10 ' Loop.
20 gosub 100
21 if s < 0 then print "Bye bye!"
22 if s = 1 then print "ALL MINES MARKED, YOU SUCCEEDED!"
23 if s = 2 then print "BOOM, YOU FAILED!"
24 print
25 end
30 ' SUB: Input valid coordinates to x, y =====================================
31 input "  X (0-9): ", x : if x < 0 or x > 9 then goto 31
32 input "  Y (0-9): ", y : if y < 0 or y > 9 then goto 32
33 return
40 ' SUB: Dig action ==========================================================
41 print "Dig at" : gosub 30 : gosub 180 ' Get coords and convert to index p.
42 if @(100 + p) then print : print : print "You can't dig there!" : return
43 if @(p) = 11 then s = 2 : return
44 gosub 140 : return
50 ' SUB: Add remove flag action ==============================================
51 print "Add or remove flag at" : gosub 30 : gosub 180
52 if @(100 + p) = 3 then @(100 + p) = 0 : f = f + 1 : return
53 if f = 0 then print : print "You're out of flags!" : return
54 if @(100 + p) > 0 then print : print "You can't place a flag there!" : return
55 f = f - 1 : @(100 + p) = 3
56 ' Change game state to completed but restore if any mine is not flagged.
57 s = 1 : for y = 0 to 9: for x = 0 to 9
58  if @(y*10 + x) = 11 and not @(100 + y*10 + x) = 3 then s = 0
59 next x : next y
60 return
70 ' SUB: Cheat action ========================================================
71 gosub 100 : return
80 ' SUB: Init map with m mines, make position x, y "a zero" ==================
81 a = x : b  = y : c = 0
82 for y = 0 to 9 : for x = 0 to 9
83  if x < a - 1 or x > a + 1 or y < b - 1 or y > b + 1 then @(100 + c) = y*10 + x : c = c + 1
84 next x : next y
85 for i = 1 to m
86  j = rnd(c) : p = @(100 + j) : gosub 190 : @(y*10 + x) = 11 : c = c - 1
87  for k = j to c - 1 : @(100 + k) = @(100 + k + 1) : next k
88 next i
89 for i = 100 to 199 : @(i) = 0 : next i
90 x = a : y = b : return
100 ' SUB: Display actual map ==================================================
101 print : print " | 0 1 2 3 4 5 6 7 8 9" : print "-+--------------------"
102 for y = 0 to 9 : print y, "| "; : for x = 0 to 9
103  if @(y*10 + x) = 11 then print "* "; : goto 105 ' Mine
104  print "  "; ' Nothing.
105 next x : print : next y : print
106 return
110 ' SUB: Display user view ==================================================
111 print : print " | 0 1 2 3 4 5 6 7 8 9" : print "-+--------------------"
112 for y = 0 to 9 : print y, "| "; : for x = 0 to 9
113  p = y*10 + x : gosub 130
114 next x : print : next y : print
115 return
130 ' SUB: Print map character for position p ==================================
131 if @(100 + p) = 3 then print "F "; : return ' Flag.
132 if @(p) > 9 then print "? "; : return      ' Unexplored.
133 if @(p) = 0 then print "  "; : return      ' Empty.
134 print @(p), " "; : return                  ' Close to a mine.
140 ' SUB: Update visibility at x, y ===========================================
141 gosub 180 : if p < 0 then return
142 if @(100 + p) > 0 then return
143 @(100 + p) = 1
144 d = 1 : for i = 0 to 99
145  if @(100 + i) = 1 then d = 0 : p = i : gosub 150
146 next i
147 if d = 0 goto 144
148 return
150 ' SUB: Reveal position p and possibly mark more positions to be checked ====
151 @(100 + p) = 2 : z = p
152 gosub 200
153 @(z) = r
154 if r > 0 then return
155 p = z : gosub 190 : g = x : h = y
156 for v = h - 1 to h + 1 : for u = g - 1 to g + 1
157  x = u : y = v : gosub 180 : if p >= 0 and @(100 + p) = 0 then @(100 + p) = 1
158 next u : next v
159 return
180 ' SUB: Convert coordinates x, y to position p, -1 if invalid ===============
181 if x < 0 or x > 9 or y < 0 or y > 9 then p = -1 : return
182 p = y*10 + x
183 return
190 ' SUB: Convert position p to coordinates x, y, no error checking ===========
191 x = p mod 10 : y = p/10 : return
200 ' SUB: Calculate number of mines nearby p ==================================
201 r = 0 : q = p : gosub 190 : g = x : h = y
202 for v = h - 1 to h + 1 : for u = g - 1 to g + 1
203  x = u : y = v : gosub 180 : if p >= 0 then r = r + (@(p) = 11)
204 next u : next v
205 return

Star Trek:

Code Select Expand

   1 ' StarTrek for TinyBasic
   2 input "do you want instructions? (y or n): ",a: if a = asc("y") then gosub 700
   5 y = 2999: input "Do you want a difficult game? (y or n):", a
  10 print "Stardate 3200:  your mission is ";: if a = asc("y") then y = 999
  15 k = 0: b = 0: d = 30: for i = 0 to 63: j = abs(rnd(99) < 5): b = b + j
  20 m = rnd(y): m = abs((m < 209) + (m < 99) + (m < 49) + (m < 24) + (m < 9) + (m < 2)): k = k + m
  25 @(i) = -100 * m - 10 * j - rnd(8): next i: if (b < 2) + (k < 4) then goto 15
  30 print "to destroy "; k; " Klingons in 30 stardates."
  35 print "there are "; b; " starbases.": gosub 160: c = 0: h = k
  40 u = rnd(8): v = rnd(8): x = rnd(8): y = rnd(8)
  45 for i = 71 to 152: @(i) = 0: next i: @(8 * x + y + 62) = 4: m = abs(@(8 * u + v - 9)): n = m / 100
  50 i = 1: if n then for j = 1 to n: gosub 165: @(j + 134) = 300: @(j + 140) = s: @(j + 146) = t: next j
  55 gosub 175: m = m - 100 * n: i = 2: if m / 10 then gosub 165
  60 m = m - m / 10 * 10: i = 3: if m then for j = 1 to m: gosub 165: next j
  65 gosub 145: gosub 325: if k then goto 95
  70 print : print "Mission accomplished.": if d < 3 then print "Boy, you barely made it."
  75 if d > 5 then print "Good work...": if d > 9 then print "Fantastic!": if d > 13 then print "Unbelievable!"
  80 d = 30 - d: i = h * 100 / d * 10: print h; " Klingons in "; d; " stardates. ("; i; ")"
  85 j = 100 * abs(c = 0) - 5 * c: print c; " casualties incurred. ("; j; ")"
  90 print "your score:",i + j: goto 110
  95 if d < 0 then print "It's too late, the Federation has been conquered.": goto 110
 100 if e >= 0 then goto 120
 105 print "Enterprise destroyed": if h - k > 9 then print "But you were a good man"
 110 y = 987: print : input "Another game? (y or n):", a: if a = asc("y") then goto 5
 115 print "Good bye.": end
 120 input "Captain:", a
 122 if a = asc("g") then goto 180 'Galaxy map
 123 if a = asc("l") then goto 200 'LR. sensor
 121 if a = asc("s") then goto 220 'SR. sensor
 124 if a = asc("p") then goto 260 'Phaser
 125 if a = asc("r") then goto 420 'Report
 126 if a = asc("w") then goto 465 'Warp engine
 127 if a = asc("t") then goto 555 'Torpedo
 128 if a = asc("q") then goto 110 'Quit
 130 print "r=Report       s=SR. Sensor   l=LR. Sensor"
 135 print "g=Galaxy Map   p=Phaser       t=Torpedo"
 140 print "w=Warp Engine  q=Quit     ***Please use one of these commands***": goto 120
 145 for i = x - abs(x > 1) to x + abs(x < 8): for j = y - abs(y > 1) to y + abs(y < 8)
 150 if @(8 * i + j + 62) <> 2 then next j: next i: o = 0: return
 155 if o = 0 then print "Sulu: 'Captain, we are docked at starbase."
 160 e = 4000: f = 10: o = 1: for i = 64 to 70: @(i) = 0: next i: return
 165 s = rnd(8): t = rnd(8): a = 8 * s + t + 62: if @(a) then goto 165
 170 @(a) = i: return
 175 print "Enterprise in q-",#1,u,v," s-",x,y: return
 180 gosub 175: j = 2: gosub 375: if i then goto 120
 185 print " of galaxy map": for i = 0 to 7: print : print #1,i + 1,":",: for j = 0 to 7: m = @(8 * i + j)
 190 print #4,abs(m > 0) * m,: next j: print : next i: print "  ",: for i = 0 to 7: print "  ..",: next i: print
 195 print " ";: for i = 1 to 8: print "   "; i;: next i: print : print : goto 120
 200 gosub 175: j = 3: gosub 375: if i then goto 120
 205 print : for i = u - 1 to u + 1: for j = v - 1 to v + 1: m = 8 * i + j - 9: a = 0
 210 if (i > 0) * (i < 9) * (j > 0) * (j < 9) then a = abs(@(m)): @(m) = a
 215 print #4,a,: next j: print : next i: goto 120
 220 gosub 175: j = 1: gosub 375: if i then goto 120
 225 m = 8 * u + v - 9: @(m) = abs(@(m))
 230 print : for i = 1 to 8: print i;: for j = 1 to 8: m = @(8 * i + j + 62): if m = 0 then print " .",
 235 if m = 1 then print " K",
 240 if m = 2 then print " B",
 245 if m = 3 then print " *",
 250 if m = 4 then print " E",
 255 next j: print : next i: print " ",: for i = 1 to 8: print #2,i,: next i: print : goto 120
 260 j = 4: gosub 375: if i then goto 120
 265 input " energized. units to fire:", a: if a < 1 then goto 120
 270 if a > e then print "Spock: 'we have only "; e; " units.'": goto 120
 275 e = e - a: if n < 1 then print "phaser fired at empty space.": goto 65
 280 a = a / n: for m = 135 to 140: if @(m) = 0 then goto 290
 285 gosub 295: print #3,s," units hit ",: gosub 305
 290 next m: goto 65
 295 if a > 1090 then print "...overloaded..": j = 4: @(67) = 1: a = 9: gosub 375
 300 i = @(m + 6) - x: j= @(m + 12) - y: s = a * 30 / (30 + i * i + j * j) + 1: return
 305 print "Klingon at s-",#1,@(m + 6),@(m + 12),: @(m) = @(m) - s
 310 if @(m) > 0 then print " **damaged**": return
 315 @(m) = 0: i = 8 * u + v - 9: j = @(i) / abs(@(i)): @(i) = @(i) - 100 * j: k = k - 1
 320 i = 8 * @(m + 6) + @(m + 12) + 62: @(i) = 0: n = n - 1: print " ***destroyed***": return
 325 if n = 0 return
 330 print "Klingon attack": if o then print "starbase print tects Enterprise": return
 335 t = 0: for m = 135 to 140: if @(m) = 0 then goto 350
 340 a = (@(m) + rnd(@(m))) / 2: gosub 295: t = t + s: i = @(m + 6): j = @(m + 12)
 345 print #3,s," units hit from Klingon at s-",#1,i,j
 350 next m: e = e - t: if e <= 0 then print "*** bang ***": return
 355 print e; " units of energy left.": if rnd(e / 4) > t return
 360 if @(70) = 0 then @(70) = rnd(t / 50 + 1): j = 7: goto 375
 365 j = rnd(6): @(j + 63) = rnd(t / 99 + 1)+@(j + 63): i = rnd(8) + 1: c = c + i
 370 print "Mc coy: 'sickbay to bridge, we suffered"; i; " casualties."
 375 i = @(j + 63): if j = 1 then print "short range sensor",
 380 if j = 2 then print "Computer display",
 385 if j = 3 then print "Long range sensor",
 390 if j = 4 then print "Phaser",
 395 if j = 5 then print "Warp engine",
 400 if j = 6 then print "Photon torpedo tubes",
 405 if j = 7 then print "Shield",
 410 if i = 0 then return
 415 print " damaged, "; i; " stardates estimated for repair": return
 420 print "status report:": print "stardate",#10,3230 - d: print "time left",#7,d
 425 print "condition     ",: if o then print "docked": goto 445
 430 if n then print "red": goto 445
 435 if e < 999 then print "yellow": goto 445
 440 print "green"
 445 print "position      q-",#1,u,v," s-",x,y: print "energy",#12,e
 450 print "torpedoes",#7,f: print "Klingons left",#3,k: print "starbases",#6,b
 455 for j = 1 to 7: if @(j + 63) then gosub 375
 460 next j: goto 120
 465 j = 5: gosub 375: if i = 0 then print
 470 input "sector distance:", w: if w < 1 then goto 120
 475 if i * (w > 2) then print "Chekov: 'we can try 2 at most, sir.'": goto 470
 480 if w > 91 then w = 91: print "Spock: 'are you sure, Captain?'"
 485 if e < w * w / 2 then print "Scotty: 'sir, we do not have the energy.'": goto 120
 490 gosub 615: if r = 0 then goto 120
 495 d = d - 1: e = e - w * w / 2: @(8 * x + y + 62) = 0
 500 for m = 64 to 70: @(m) = (@(m) - 1) * abs(@(m) > 0): next m
 505 p = 45 * x + 22: g = 45 * y + 22: w = 45 * w: for m = 1 to 8: w = w - r: if w < -22 then goto 525
 510 p = p + s: g = g + t: i = p / 45: j = g / 45: if (i < 1) + (i > 8) + (j < 1) + (j > 8) then goto 530
 515 if @(8 * i + j + 62) = 0 then x = i: y = j: next m
 520 print "**Emergency stop**": print "Spock: 'to err is human.'"
 525 @(8 * x + y + 62) = 4: gosub 175: goto 65
 530 p = u * 72 + p / 5 + w / 5 * s / r - 9: u = p / 72: g = v * 72 + g / 5 + w / 5 * t / r - 9: v = g / 72
 535 if rnd(9) < 2 then print "***Space storm***": t = 100: gosub 360
 540 if (u > 0) * (u < 9) * (v > 0) * (v < 9) then x = (p + 9 - 72 * u) / 9: y = (g + 9 - 72 * v) / 9: goto 45
 545 print "**You wandered outside the galaxy**"
 550 print "On board computer takes over, and saved your life": goto 40
 555 j = 6: gosub 375: if i then goto 120
 560 if f = 0 then print " empty": goto 120
 565 print " loaded": gosub 615: if r = 0 then goto 120
 570 print "torpedo track ",: f = f - 1: p = 45 * x + 22: g = 45 * y + 22: for m = 1 to 8
 575 p = p + s: g = g + t: i = p / 45: j = g / 45: if (i < 1) + (i > 8) + (j < 1) + (j > 8) then goto 585
 580 l = 8 * i + j + 62: w = 8 * u + v - 9: r = @(w) / abs(@(w)): print #1,i,j," ",: goto 585 + 5 * @(l)
 585 next m: print "...missed": goto 65
 590 s = rnd(99) + 280: for m = 135 to 140: if (@(m + 6) = i) * (@(m + 12) = j) then gosub 305
 592 next m: goto 65
 595 b = b - 1: @(l) = 0: @(w) = @(w) - 10 * r: print "starbase destroyed"
 597 print "Spock: 'I often find human behaviour fascinating.'": goto 65
 600 print "hit a star": if rnd(9) < 3 then print "torpedo absorbed": goto 65
 605 @(l) = 0: @(w) = @(w) - r: if rnd(9) < 6 then print "star destroyed": goto 65
 610 t = 300: print "it novas    ***radiation alarm***": gosub 360: goto 65
 615 input "course (0-360):", i: if (i > 360) + (i < 0) then r = 0: return
 620 s = (i + 45) / 90: i = i - s * 90: r = (45 + i * i) / 110 + 45: goto 625 + 5 * abs(s < 4) * s
 625 s = -45: t = i: return
 630 s = i: t = 45: return
 635 s = 45: t = -i: return
 640 s = -i: t = -45: return
 700 print "This is a modified version of Lynn Cochran's STARTREK, as published in the June"
 701 print "1976 issue of SCCS Interface and subsequently modified to run under Palo Alto"
 702 print "Tiny BASIC."
 703 print
 704 print "The game is played in a galaxy of 64 quadrants in an 8x8 array.  Each quadrant"
 705 print "consists of 64 sectors in an 8x8 array.  The objective of the game is to destroy"
 706 print "all Klingon vessels in the galaxy before time expires."
 707 print
 708 print "The available commands are:"
 709 print "  g - to display the galaxy map."
 710 print "  l - to perform a long-range scan."
 711 print "  p - to fire phasers."
 712 print "  r - to print a status report."
 713 print "  s - to perform a short-range scan."
 714 print "  t - to fire photon torpedos."
 715 print "  w - for warp navigation."
 716 print "  q - to quit"
 717 print
 718 input "---More? (y or n): ",a: if a <> asc("y") then return
 719 print
 720 print "Course (for warp navigation) and direction (for torpedo fire) is in degrees from"
 721 print "0 to 360 inclusive - 0 is North, 90 is East, 180 is South, and 270 is West."
 722 print
 723 print "Warp distance is given in sectors.  Each quadrant is 8 sectors, so to move 3"
 724 print "quadrants, enter 24 sectors.  Each warp takes 1 stardate, but longer distances"
 725 print "require more energy."
 726 print
 727 print "Dock at starbases to replenish your energy and torpedos."
 728 print
 729 print "The long-range scan and galaxy maps use a 3-digit number to show the number of"
 730 print "Klingons, number of starbases, and number of stars in a quadrant.  For example,"
 731 print "a value of 103 means 1 Klingon, 0 bases, and 3 stars.  The galaxy map is updated"
 732 print "only when short-range or long-range scans are performed."
 733 print
 734 print "The short range scan shows the position of the Enterprise (E), Klingon ships (K)"
 735 print "starbases (B), and stars (*) within the quadrant."
 736 print
 737 input "---More? (y or n): ",a: if a <> asc("y") then return
 738 print
 739 print "When Klingons fire at you, you could get hit. So, don't try to sit there and"
 740 print "wear them out."
 741 print
 742 print "If you hit a Klingon with your photon torpedo, the Klingon might not get"
 743 print "totally destroyed.  Also, if you hit a star, it might not get effected at all."
 744 print "When a star is destroyed, it might nova and the radiation will hurt you."
 745 print ""
 746 return