+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: tiny basic as a subroutine (/showthread.php?tid=1865)
Pages:
1
2
RE: tiny basic as a subroutine - James D Jarvis - 07-31-2023
(07-31-2023, 02:08 PM)bplus Wrote: @James D Jarvis do you have any sample / demo programs to go with Tiny Basic? specially an example with chain and merge, you have me curious. I never used either in earlier Basics.
Good ones I wrote? I wrote non-exciting ones to test the merge and chain options, but they were likely boring as mud and almost as useful.
Tinytest.bas
Code: (Select All)
'tinytest
subone=299:'variables and expressions can be used in gosub and goto statements
for x =1 to 10
print x
a=x
if x<5 then gosub subone
next x
goto 400
299 'subone
300 print "less then 5"
return
400 'hello theretinytest2.bas
Code: (Select All)
'Tinytest2
print "well well well"
for n = 1 to a
print n
next ntinytest3.bas
Code: (Select All)
'tinytest3
cls
print aRE: tiny basic as a subroutine - bplus - 07-31-2023
(Scratching head)? Shouldn't there be a merge or chain command somewhere in tinytest.bas (which I assume is lead-off bas program)?
RE: tiny basic as a subroutine - bplus - 07-31-2023
Found it! It was a Minesweeper game by Marcus 105 LOC pretty impressive!
Something to try in our version of Tiny:
Code: (Select All)
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 returnRE: tiny basic as a subroutine - James D Jarvis - 08-01-2023
Latest edit. Very minimal string variable support.
Code: (Select All)
'tiny basic in a subroutine
' vesion 0.2.d.a0123
' a tiny basic interpreter that can run in a qb64 program
'based on code by Ed Davis posted in a facebbok group
'
'it's crude and sloppy and not done yet but it works due to the good work of people before me.
'
'the original tiny basic implmentation this was based on used integer basic and only allowed 26 single letter variables
'altered things (poorly for now) to allow a larger number of variables and floating point numbers.
'there isn't support for string variables for now.
' valid variable names must start with a letter and may contain any mixture of alphanumeric characters and $
'variable names are not case sensistive so Aaa and AAA woudl be the smae variable.
'it's sloppy but A100A woudl be a valid variable name
'
'eventually I'll get string variables into this and some simple graphics, there's some bits of code in here now to get that going
'but it's nowhere near done yet
'
'all output from the interperter will go to current program screen when the interpreter is called
'code will immediatley execute if typed without a line number
'line numbers from 1 to 9999 are valid
'added merge and chain commands. merge <filename> will add code to thecurrent program.
'chain <filename> will replace the currently loaded code. Variables created earlier will be retained.
'
'can now assign string variables (directly or with input statement) and print string varibles but as of yet there is no other string support
'$dynamic
Screen _NewImage(800, 500, 32)
Const true = -1, false = 0, c_maxlines = 9999, c_maxvars = 200, c_at_max = 1000, c_g_stack = 100
Dim Shared As String c_tab, c_squote, c_dquote
c_tab = Chr$(9): c_squote = Chr$(39): c_dquote = Chr$(34)
Dim Shared pgm(c_maxlines) As String ' program stored here
Dim Shared vars(c_maxvars) As Double
Dim Shared var_type(c_maxvars) As String 'not really using this yet
Dim Shared var_name(c_maxvars) As String
Dim Shared var_string(c_maxvars) As String
Dim Shared stringflag As String
Dim Shared i_temp$
Dim Shared pen_x, pen_y As Single
Dim Shared gstackln(c_g_stack) As Integer ' gosub line stack
Dim Shared gstacktp(c_g_stack) As Integer ' gosub textp stack
Dim Shared gsp As Long
Dim Shared atarry(0 To c_at_max) As Double ' the @ array
Dim Shared forvar(c_maxvars) As Integer
Dim Shared forlimit(c_maxvars) As Integer
Dim Shared forline(c_maxvars) As Integer
Dim Shared forpos(c_maxvars) As Integer
Dim Shared As String tok, toktype ' current token, and it's type
Dim Shared As String tok2, toktype2 ' current token, and it's type
Dim Shared As String thelin, thech ' current program line, current character
Dim Shared As Integer curline, textp ' position in current line
Dim Shared num As Single ' last number read by scanner
Dim Shared As Integer errors, tracing, need_colon
Dim Shared dump_array(0 To c_at_max) As Double
declare function accept(s as string)
declare function expression(minprec as double)
declare function getfilename$(action as string)
declare function getvarindex
declare function inputexpression(s as string)
declare function parenexpr&
Dim pl$(1 To 12)
pl$(1) = "cls:a=0"
pl$(2) = "print" + Chr$(34) + "Hello" + Chr$(34)
pl$(3) = "for x = 1 to 10"
pl$(4) = "print x"
pl$(5) = " a = a +x: @(x)=a"
pl$(6) = "next x"
pl$(7) = "print" + Chr$(34) + "Done" + Chr$(34)
pl$(8) = "print a"
pl$(9) = "100 arraydump"
pl$(10) = "200 print " + Chr$(34) + "Type Run to execute the program and Quit to exit" + Chr$(34)
Call tiny_basic("new", pl$())
Cls
Print "Back in main program": Print
Print "Variables assigned in interpreter"
'show the first 10 variables that have been assigned in the interpreter is they have not been cleared
For x = 1 To 10
Print var_name(x), vars(x), var_string(x)
Next x
ReDim pl$(2)
Print
Print "press any key to coniunue": Sleep
pl$(1) = "print " + Chr$(34) + "Type your own program" + Chr$(34) + ":print :help"
Call tiny_basic("run", pl$())
End
Sub tiny_basic (icmd$, pl$())
'icmd$ of "run" will load the program in the array pl$() and immediately execte it. previous vaiables will be retained if they were not cleared earlier.
'icmd$ of "list" will load the prigram in pl$() and list the code in the interpreter
'icmds$ of "new" will load the program in array pl$() and cler any previous variables.
Dim loadlines, prox
loadlines = UBound(pl$)
n = 0
For prox = 1 To loadlines
pgm(0) = pl$(prox)
Call initlex(0)
If toktype = "number" And num > 0 And num <= c_maxlines Then
n = num
Else
n = n + 1: textp = 1
End If
pgm(n) = Mid$(pgm(0), textp)
Next prox
curline = 0
icmd$ = LCase$(icmd$)
Select Case icmd$
Case "run"
tok = "run"
Call docmd
Case "list"
tok = "list"
Call docmd
Case "new"
tok = "run"
clearvars
Call docmd
End Select
If Command$ <> "" Then
toktype = "string": tok = c_dquote + Command$
Call loadstmt
tok = "run": Call docmd
Else
' Call help
End If
Do
errors = false
Line Input "tinyb> ", pgm(0)
If pgm(0) <> "" Then
Call initlex(0)
If toktype = "number" Then
Call validlinenum
If Not errors Then pgm(num) = Mid$(pgm(0), textp)
Else
Call docmd
End If
End If
Loop Until toktype = "exit"
ReDim pgm(0 To c_maxlines) As String
End Sub
Sub mergestmt
'merge another tny basic program file with the one presently loaded
Dim last As Integer
Dim filename As String
last = 0
i = 0
For i = 1 To c_maxlines
If pgm(i) <> "" Then last = i
Next i
If last <= c_maxlines Then
filename = getfilename("Load")
If filename = "" Then Exit Sub
Open filename For Input As #1
n = last + 1
While Not EOF(1)
Line Input #1, pgm(0)
Call initlex(0)
If toktype = "number" And num > 0 And num <= c_maxlines Then
n = num
Else
n = n + 1: textp = 1
End If
pgm(n) = Mid$(pgm(0), textp)
Wend
Close #1
curline = 0
End If
End Sub
Sub chainstmt
'load a new tinybasic file replacing the current, any previously defined variables will be retained
Dim n As Long, filename As String
ReDim pgm(c_maxlines)
filename = getfilename("Load")
If filename = "" Then Exit Sub
Open filename For Input As #1
n = 0
While Not EOF(1)
Line Input #1, pgm(0)
Call initlex(0)
If toktype = "number" And num > 0 And num <= c_maxlines Then
n = num
Else
n = n + 1: textp = 1
End If
pgm(n) = Mid$(pgm(0), textp)
Wend
Close #1
curline = 0
End Sub
Sub docmd
Do
If tracing And Left$(tok, 1) <> ":" Then Print curline; tok; thech; Mid$(thelin, textp)
need_colon = true
Select Case tok
Case "bye", "quit": Call nexttok: toktype = "exit": Exit Sub
Case "end", "stop": Call nexttok: Exit Sub
Case "clear": Call nexttok: Call clearvars: Exit Sub
Case "help": Call nexttok: Call help: Exit Sub
Case "list": Call nexttok: Call liststmt: Exit Sub
Case "load", "old": Call nexttok: Call loadstmt: Exit Sub
Case "merge": Call nexttok: Call mergestmt: Exit Sub
Case "chain": Call nexttok: Call chainstmt: Exit Sub
Case "new": Call nexttok: Call newstmt: Exit Sub
Case "run": Call nexttok: Call runstmt
Case "save": Call nexttok: Call savestmt: Exit Sub
Case "tron": Call nexttok: tracing = true
Case "troff": Call nexttok: tracing = false
Case "cls": Call nexttok: Cls
Case "for": Call nexttok: Call forstmt
Case "gosub": Call nexttok: Call gosubstmt
Case "goto": Call nexttok: Call gotostmt
Case "if": Call nexttok: Call ifstmt
Case "input": Call nexttok: Call inputstmt
Case "next": Call nexttok: Call nextstmt
Case "print", "?": Call nexttok: Call printstmt
Case "pen": Call nexttok: Call penstmt
Case "return": Call nexttok: Call returnstmt
Case "@": Call nexttok: Call arrassn
Case "arraydump": Call nexttok: Call arraydump 'puts @() into array dump_array() for use in main program
Case "arrayload": Call nexttok: Call arrayload 'reads dump_array into @() to pass data from main program
Case ":", "" ' handled below
Case "beep": Call nexttok: Call dobeep
Case Else
If tok = "let" Then Call nexttok
If toktype = "ident" Then
Call assign
Else
Print "Unknown token '"; tok; "' at line:"; curline; " Col:"; textp; " : "; thelin: errors = true
End If
End Select
If errors Then Exit Sub
If tok = "" Then
While tok = ""
If curline = 0 Or curline >= c_maxlines Then Exit Sub
Call initlex(curline + 1)
Wend
ElseIf tok = ":" Then Call nexttok
ElseIf need_colon And Not accept(":") Then
Print ": expected but found: "; tok
Exit Sub
End If
Loop
End Sub
Sub help
Print "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ Tiny Basic (QBASIC) --------ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
Print "³ bye, clear, cls, end/stop, help, list, load/save, new, run, tron/off³Û"
Print "³ for <var> = <expr1> to <expr2> ... next <var> ³Û"
Print "³ gosub <expr> ... return ³Û"
Print "³ goto <expr> ³Û"
Print "³ if <expr> then <statement> ³Û"
Print "³ input [prompt,] <var> ³Û"
Print "³ <var>=<expr> ³Û"
Print "³ arraydump ³Û"
Print "³ beep, print <expr|string>[,<expr|string>][;] ³Û"
Print "³ rem <anystring> or ' <anystring> ³Û"
Print "³ Operators: ^, * / \ mod + - < <= > >= = <>, not, and, or ³Û"
Print "³ Integer variables a..z, and array @(expr) ³Û"
Print "³ Functions: abs(expr), asc(ch), rnd(expr), rnd(expr),sgn(expr) ³Û"
Print "³ sin(expr), cos(expr), tan(expr) ³Û"
Print "³ sindeg(expr), cosdeg(expr), tandeg(expr) ³Û"
Print "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ"
Print " ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß"
End Sub
Sub assign
Dim var, var2, vv As Long
var = getvarindex: Call nexttok
' Print "found : "; tok
Call expect("=")
'Print "found : "; tok
If Right$(var_name(var), 1) <> "$" Then
vars(var) = expression(0)
Else
T$ = tok
If Left$(T$, 1) = Chr$(34) Then
var_string(var) = Right$(T$, Len(T$) - 1)
Else
If Right$(T$, 1) = "$" Then
vv = 0
Do
vv = vv + 1
If vv < c_maxvars Then
If var_name(vv) = T$ Then
var2 = vv
End If
End If
Loop Until var2 <> 0 Or vv > c_maxvars
If var2 <> 0 Then var_string(var) = var_string(var2)
End If
End If
' Print "assigned string variable "; var_name(var), var_string(var)
Call nexttok
End If
' If stringflag <> "" Then
'var_string(var) = stringflag
' End If
If tracing Then Print "*** "; Chr$(var + Asc("a")); " = "; vars(var)
End Sub
Sub dobeep
Beep
End Sub
Sub arraydump
'dump array so it can be passed to main program
For x = 1 To c_at_max
dump_array(x) = atarry(x)
Next x
End Sub
Sub arrayload
'loads array from dump_array to pass variables from main program
For x = 1 To c_at_max
atarry(x) = dump_array(x)
Next x
End Sub
Sub arrassn ' array assignment: @(expr) = expr
Dim As Long n, atndx
atndx = parenexpr
If tok <> "=" Then
Print "Array Assign: Expecting '=', found:"; tok: errors = true
Else
Call nexttok ' skip the "="
n = expression(0)
atarry(atndx) = n
If tracing Then Print "*** @("; atndx; ") = "; n
End If
End Sub
Sub forstmt ' for i = expr to expr
Dim As Long var, n, forndx
var = getvarindex
Call assign
' vars(var) has the value; var has the number value of the variable in 0..25
forndx = var
forvar(forndx) = vars(var)
If tok <> "to" Then
Print "For: Expecting 'to', found:"; tok: errors = true
Else
Call nexttok
n = expression(0)
forlimit(forndx) = n
' need to store iter, limit, line, and col
forline(forndx) = curline
If tok = "" Then forpos(forndx) = textp Else forpos(forndx) = textp - 2
End If
End Sub
Sub gosubstmt ' for gosub: save the line and column
gsp = gsp + 1
gstackln(gsp) = curline
gstacktp(gsp) = textp
Call gotostmt
End Sub
Sub gotostmt
num = expression(0)
Call validlinenum
Call initlex(num)
End Sub
Sub ifstmt
need_colon = false
If expression(0) = 0 Then Call skiptoeol: Exit Sub
If tok = "then" Then Call nexttok
If toktype = "number" Then Call gotostmt
End Sub
Sub inputstmt ' "input" [string ","] var
Dim var As Double, st As String
If toktype = "string" Then
Print Mid$(tok, 2);
Call nexttok
Call expect(",")
Else
Print "? ";
End If
var = getvarindex: Call nexttok
Line Input st
If st = "" Then st = "0"
Select Case Left$(st, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
vars(var) = Val(st)
Case "-"
If Mid$(st, 2, 1) >= "0" And Mid$(st, 2, 1) <= "9" Then vars(var) = Val(st)
Case Else
' Print "string tok "; st
var_string(var) = st
vars(var) = Asc(Left$(st, 1))
Print
End Select
End Sub
Sub liststmt
Dim i As Integer
For i = 1 To c_maxlines
If pgm(i) <> "" Then Print i; " "; pgm(i)
Next i
Print
End Sub
Sub loadstmt
Dim n As Long, filename As String
Call newstmt
filename = getfilename("Load")
If filename = "" Then Exit Sub
Open filename For Input As #1
n = 0
While Not EOF(1)
Line Input #1, pgm(0)
Call initlex(0)
If toktype = "number" And num > 0 And num <= c_maxlines Then
n = num
Else
n = n + 1: textp = 1
End If
pgm(n) = Mid$(pgm(0), textp)
Wend
Close #1
curline = 0
End Sub
Sub newstmt
Dim i As Integer
Call clearvars
ReDim pgm(c_maxlines) As String
' For i = 1 To c_maxlines
'pgm(i) = ""
'Next i
End Sub
Sub nextstmt
Dim forndx As Long
' 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
End If
End Sub
' "print" [[#num "," ] expr { "," [#num ","] expr }] [","] {":" stmt} eol
' expr can also be a literal string
Sub penstmt
penx_x = Val(tok)
Call nexttok
pen_y = Val(tok)
PSet (pen_x, pen_y), _RGB32(255, 255, 255)
End Sub
Sub printstmt
Dim As Single printnl, printwidth, n
Dim junk As String
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: Exit Sub
printwidth = num
Call nexttok
If Not accept(",") Then Print "Print: Expecting a ',', found:"; tok: Exit Sub
End If
If toktype = "string" Then
junk = Mid$(tok, 2)
Call nexttok
Else
isc = confirmstringvar(tok)
If isc > 0 Then
junk = var_string(isc)
Call nexttok
Else
n = expression(0)
junk = LTrim$(Str$(n))
End If
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
End Sub
Sub returnstmt ' exit sub from a subroutine
curline = gstackln(gsp)
textp = gstacktp(gsp)
gsp = gsp - 1
Call initlex2
End Sub
Sub runstmt
'Call clearvars
Call initlex(1)
End Sub
Sub savestmt
Dim i As Long, filename As String
filename = getfilename("Save")
If filename = "" Then Exit Sub
Open filename For Output As #1
For i = 1 To c_maxlines
If pgm(i) <> "" Then Print #1, i; pgm(i)
Next i
Close #1
End Sub
Function getfilename$ (action As String)
Dim filename As String
If toktype = "string" Then
filename = Mid$(tok, 2)
Else
Print action; ": ";
Line Input filename
End If
If filename <> "" Then
If InStr(filename, ".") = 0 Then filename = filename + ".bas"
End If
getfilename = filename
End Function
Sub validlinenum
If num <= 0 Or num > c_maxlines Then Print "Line number out of range": errors = true
End Sub
Sub clearvars
Dim i As Integer
ReDim vars(c_maxvars)
ReDim var_name(c_maxvars)
ReDim var_string(c_maxvars)
ReDim atarry(0 To c_at_max) As Double
'For i = 1 To c_maxvars
'vars(i) = 0
' var_name(i) = ""
'var_string(i) = ""
'Next i
gsp = 0
End Sub
Function parenexpr&
Call expect("("): If errors Then Exit Function
parenexpr = expression(0)
Call expect(")")
End Function
Function expression (minprec As Double)
Dim n As Double
' handle numeric operands - numbers and unary operators
If 0 Then ' to allow elseif
ElseIf toktype = "number" Then n = num: Call nexttok
ElseIf tok = "(" Then n = parenexpr
ElseIf tok = "not" Then Call nexttok: n = Not expression(3)
ElseIf tok = "abs" Then Call nexttok: n = Abs(parenexpr)
ElseIf tok = "asc" Then Call nexttok: expect ("("): n = Asc(Mid$(tok, 2, 1)): Call nexttok: expect (")")
ElseIf tok = "rnd" Then Call nexttok: n = (Rnd * parenexpr)
ElseIf tok = "irnd" Then Call nexttok: n = Int(Rnd * parenexpr) + 1
ElseIf tok = "sgn" Then Call nexttok: n = Sgn(parenexpr)
ElseIf tok = "sin" Then Call nexttok: n = Sin(parenexpr)
ElseIf tok = "cos" Then Call nexttok: n = Cos(parenexpr)
ElseIf tok = "tan" Then Call nexttok: n = Tan(parenexpr)
ElseIf tok = "sindeg" Then Call nexttok: n = Sin(parenexpr * _Pi / 360)
ElseIf tok = "cosdeg" Then Call nexttok: n = Cos(parenexpr * _Pi / 360)
ElseIf tok = "tandeg" Then Call nexttok: n = Tan(parenexpr * _Pi / 360)
ElseIf toktype = "ident" Then n = vars(getvarindex): Call nexttok
ElseIf tok = "@" Then Call nexttok: n = atarry(parenexpr)
ElseIf tok = "-" Then Call nexttok: n = -expression(7)
ElseIf tok = "+" Then Call nexttok: n = expression(7)
Else Print "syntax error: expecting an operand, found: ", tok: errors = true: Exit Function
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: n = n Or expression(2)
ElseIf minprec <= 2 And tok = "and" Then Call nexttok: n = n And expression(3)
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 = "/" Then Call nexttok: n = n / expression(7)
ElseIf minprec <= 6 And 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
expression = n
End Function
Function inputexpression (s As String)
Dim As Long save_curline, save_textp
Dim As String save_thelin, save_thech, save_tok, save_toktype
save_curline = curline: save_textp = textp: save_thelin = thelin: save_thech = thech: save_tok = tok: save_toktype = toktype
pgm(0) = s
Call initlex(0)
inputexpression = expression(0)
curline = save_curline: textp = save_textp: thelin = save_thelin: thech = save_thech: tok = save_tok: toktype = save_toktype
End Function
Function getvarindex
If toktype <> "ident" Then Print "Not a variable:"; tok: errors = true: Exit Function
' Print "***(getvarindex)*** tok "; tok
foundv = 0
Do
vv = vv + 1
If vv < c_maxvars Then
If var_name(vv) = tok Then
foundv = vv
ElseIf var_name(vv) = "" Then
var_name(vv) = tok
foundv = vv
End If
End If
Loop Until foundv <> 0 Or vv > c_maxvars
getvarindex = foundv
End Function
Function confirmstringvar (st$)
Dim ist, vv As Long
T$ = st$
If Right$(T$, 1) = "$" Then
vv = 0
Do
vv = vv + 1
If vv < c_maxvars Then
If var_name(vv) = T$ Then
ist = vv
End If
End If
Loop Until ist <> 0 Or vv > c_maxvars
If ist <> 0 Then confirmstringvar = ist
End If
End Function
Sub expect (s As String)
If accept(s) Then Exit Sub
Print "("; curline; ") expecting "; s; " but found "; tok; " =>"; pgm(curline): errors = true
End Sub
Function accept (s As String)
accept = false
If tok = s Then accept = true: Call nexttok
End Function
Sub initlex (n As Integer)
curline = n: textp = 1
Call initlex2
End Sub
Sub initlex2
need_colon = false
thelin = pgm(curline)
thech = " "
Call nexttok
End Sub
Sub nexttok
tok = "": toktype = ""
While thech <= " "
If thech = "" Then Exit Sub
Call getch
Wend
tok = thech: Call getch
Select Case tok
Case "a" To "z", "A" To "Z": Call readident: If tok = "rem" Then Call skiptoeol
Case "0" To "9": Call readdbl
Case c_squote: Call skiptoeol
Case c_dquote: Call readstr
Case "#", "(", ")", "*", "+", ",", "-", "/", ":", ";", "<", "=", ">", "?", "@", "\", "^":
toktype = "punct"
If (tok = "<" And (thech = ">" Or thech = "=")) Or (tok = ">" And thech = "=") Then
tok = tok + thech
Call getch
End If
Case Else: Print "("; curline; ") "; "What?"; tok; " : "; thelin: errors = true
End Select
End Sub
Sub skiptoeol
tok = "": toktype = ""
textp = Len(thelin) + 1
End Sub
Sub readdbl
toktype = "number"
While thech >= "0" And thech <= "9" Or thech = "." Or thech = "-"
tok = tok + thech
Call getch
Wend
num = Val(tok)
End Sub
Sub readident
toktype = "ident"
While (thech >= "a" And thech <= "z") Or (thech >= "A" And thech <= "Z") Or thech = "$" Or (thech >= "0" And thech <= "9")
tok = tok + thech
Call getch
Wend
tok = LCase$(tok)
End Sub
Sub readstr ' store double quote as first char of string, to distinguish from idents
toktype = "string"
While thech <> c_dquote ' while not a double quote
If thech = "" Then Print "String not terminated": errors = true: Exit Sub
tok = tok + thech
Call getch
Wend
Call getch ' skip closing double quote
End Sub
Sub getch
If textp > Len(thelin) Then
thech = ""
Else
thech = Mid$(thelin, textp, 1)
textp = textp + 1
End If
End SubRE: tiny basic as a subroutine - bplus - 08-01-2023
Just tested Minesweep by Marcus in Jarvis latest post, success! at least as far as I went in test.
RE: tiny basic as a subroutine - James D Jarvis - 08-02-2023
(08-01-2023, 02:36 PM)bplus Wrote: Just tested Minesweep by Marcus in Jarvis latest post, success! at least as far as I went in test.
Glad to see it. There's a version of Trek floating about that might work on this.
RE: tiny basic as a subroutine - James D Jarvis - 08-02-2023
oh yeah in reference to the merge and chain commands... I did the testing for them in the interpreter at runtime. I'll have to give this a shake down and see what I can really get done with it as it is.
RE: tiny basic as a subroutine - James D Jarvis - 08-15-2023
Well I've discovered working on an interpreter is a heck of a lot o fun, almost as much fun as punching myself in the head. Of course the more I work on it the more I realize I should have started from scratch. I'm looking at this and remembering a virtual machine and pseudo-compiler I programmed about 20 year ago and I am wondering... so when did I have a stroke? There's another version coming eventually.
RE: tiny basic as a subroutine - bplus - 08-15-2023
Quote:almost as much fun as punching myself in the headLOL
It's not fun so much as obsession until it works! Then it's great fun! for 2 secs
then you get another idea for a thing to try with it...