tiny basic as a subroutine

[James D Jarvis]

@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 there

tinytest2.bas

Code: (Select All)

'Tinytest2
print "well well well"
for n = 1 to a
print n
next n

tinytest3.bas

Code: (Select All)

'tinytest3
cls
print a

[bplus]

(Scratching head)? Shouldn't there be a merge or chain command somewhere in tinytest.bas (which I assume is lead-off bas program)?

[bplus]

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 return

[James D Jarvis]

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 Sub

[bplus]

Just tested Minesweep by Marcus in Jarvis latest post, success! at least as far as I went in test.
   

[James D Jarvis]

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.

[James D Jarvis]

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.

[James D Jarvis]

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.

[bplus]

almost as much fun as punching myself in the head

LOL

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...