Tiny Basic interpreter in Oxygen Basic - updated: 05 Mar 2024 7:05 am: More O2-like idioms, e.g., taking advantage of O2 features.
'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
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:
'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
Quote from: Charles Pegge on March 06, 2024, 01:08:15 AMHello 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! :)
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.
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
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 :)
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 ???
ahh this older version work
@Charles ..so i must use latest to compile with new SELECT case
right ?
'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
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.
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
OK Charles
select without selector(variable ) looking little bit un-natural
but i am fine with that ;)
QuoteWinDynDialogs examples
well that is fine for users which use Dialogs i guess
i even don't know that there are some problems .
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
Quote from: Frank Brübach on March 06, 2024, 06:28:52 PMHey 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:
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:
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