This sub took me hours to get going because it's behaving so strangely. It's a simple routine to print out some info, but it won't work unless an INPUT statement is used at the end, not an INPUT$() or INKEY$. Even SLEEP causes the sub not to run right. My first choice is for the user just to press a single key and exit the sub, but only the input statement works right - which requires a carriage return. I don't get it. Any help will be much appreciated! See remarks below...

SUB destTable () '

    SHARED destData() AS STRING
    SHARED destCounter AS INTEGER
    SHARED fuel AS SINGLE
    DIM range AS SINGLE
    DIM AS INTEGER counter, entry, entries(20) '
    DIM n AS STRING

    range = fuel / 35.29 '          fuel / rate of burn per light year
    counter = 0

    _FONT messFont: COLOR YELLOW
    n = _TRIM$(MID$(STR$(range), 1, 5))
    _PRINTSTRING (30, 40), "Destinations Within Present Range" + "  (" + n + " Light Years)"

    DO
        counter = counter + 1
        IF range >= VAL(destData(counter, 3)) THEN '    if range is greater than distance to destination...
            entry = entry + 1
            entries(entry) = counter
            _FONT messFont: COLOR ORANGE
            _PRINTSTRING (30, 66 + entry * 25), CHR$(64 + entry) + ") " + destData(counter, 1) '
            _FONT courseFont: COLOR GREEN
            _PRINTSTRING (340, 70 + entry * 25), destData(counter, 2)
            _FONT courseFont: COLOR PINK
            _PRINTSTRING (580, 72 + entry * 25), destData(counter, 3) + " Light Years"
        END IF
    LOOP UNTIL counter = 20

    _FONT messFont: COLOR YELLOW
    _PRINTSTRING (40, 138 + entry * 25), "Your Destination Choice is"
    LOCATE 30, 344
    INPUT n '          <======= !!                           reuse n string
    ' n = INPUT$(1) '                                                ALL THESE REMMED COMMANDS CAUSE THE ABOVE NOT TO DISPLAY TO SCREEN
    ' WHILE INKEY$ = "": n = INKEY$: WEND '           UNTIL *AFTER* USER PRESSES A KEY
    ' DO: n = INKEY$: LOOP UNTIL n <> "" '              only an INPUT statement gets the above table to print ...
    ' SLEEP                                ... otherwise program freezes w/o performing above code until key is hit, then the table appears for a sec
    counter = ASC(n) - 96 '                                        reuse counter
    destCounter = entries(counter) '
    pickDest

END SUB

Wondering if there is a way to get screen resolution size?  Knowing if the screen is 4k or 2k is nicer that making boxes off screen or over/under sized.

This is a program that processes an SVG file and creates code for micro(A). This attempts to "steal" coordinates in millimeters of a "plain" SVG file and present them into strings of run-on 4-digit numbers, which are X and Y absolute coordinate pairs. The values will have to be scaled for a graphics screen according to the maximum dimensions out of the SVG. It looks like the graphics screen of micro(A) is 780x570.

This could probably be done with "sodipodi" format, which is that of Inkscape, but it's not recommended. That program could insert a lot of transformation commands which would make for an uneven picture, and this effort by a hobbyist doesn't provision for that.

N.B. The SVG is expected to have relative coordinates, except the first point of each path. But this is translated into code which employs absolute coordinates. Directly copying from the original document to a QB64 graphics program requires PSET or something else to anchor, then "LINE" with "STEP" option to draw things relatively.

The run-on strings will have sequences of "99999999". This is a reset which means a new shape will begin with the next point listed, and should not connect with the previous coordinate that was obtained. I had to do it this way because micro(A) doesn't process strings very well. Originally it was going to be a string check for "######" for three-digit coordinates. This program shouldn't be used for very large vector pictures anyway.

I had to make more edits to the program to account for "z" at the end of path command. However this could come up with missing lines. I will need more time to look into this.

As it stands, this does not produce useable running micro(A) code, it only creates a couple of array variables and initializes them. I should also offer some simple code in micro(A) to put the lines together for the drawing. But my cohort protested. :/ But why since it's only "line" statements to use? In fact this could be translated into a QB64 or any BASIC program that supports graphics and has a line-drawing statement supporting absolute coordinates.

I got a bit lazy with this program. I was supposed to add Dav's routine to get filenames on Linux or Windows and display them in a nice box in SCREEN 0, and allow this for any version of QB64. Instead if you don't have Phoenix Edition v3.4 or later, you will have to type in a filename for a file that exists inside "(home)/Pictures". Including the directories. This is hard-coded. Yes I know it should be better.

Despite this caveat, this code should run on QB64 v2.0 and up. It does nothing fancy except parse a few values in text format.

There are more explanations as comments in the source code.

Neat trick of the QB64 IDE! It makes "pale" the code that the "conditional" decides doesn't apply for "$IF... THEN... $ELSE... $END IF".

User "roquedrivel" from "BASIC4US" forum helped with this program.

'by mnrvovrfc 3-Aug-2023

'this needs extensive testing because Inkscape keeps mixing absolute and relative coordinates.

'it doesn't matter between "sodipodi" or "plain" SVG.

'GIMP exports paths in absolute coordinates only, but is clunkier to work with.

'this would be easier with relative coordinates only, with the first

'  "m" command of a path having the only absolute coordinate.

'it helps sometimes setting, before creating any document:

'  Preferences/Input and Output/SVG Output/Paths: choose "relative" from menu.

'this works with lines only! Not bezier paths! Any bezier paths need to have the

'  two control points reset: press [N] to choose node tool,

'  select the node then the first choice

'  on the toolbar for path nodes on the top of the screen.

'one more thing: from a plain SVG the measurement

'  is in millimeters *NOT* in pixels!

'This program is meant to be run from the terminal!

'It's up to you to select the terminal text, copy and then paste into a text editor

'  or into micro(A)'s editor. Then keep developing the script from there.

'If this is not satisfactory then the user is free to add code

'  to create an output file.

$CONSOLE:ONLY

OPTION _EXPLICIT

DIM SHARED sf(1 TO 20) AS STRING, sl(1 TO 20) AS STRING

DIM AS DOUBLE xx, yy, x0, y0, x1, y1

DIM AS LONG fe, x, y, u, v, gh, coma

DIM AS INTEGER g, h

DIM apath$, afile$, dee$, a$, c$, qu$, entry$

DIM f AS _BYTE, lut AS _BYTE



qu$ = CHR$(34)



h = 1

g = 0

gh = 0

sf(h) = "st[" + _TRIM$(STR$(h)) + "] = " + qu$

dee$ = " d=" + qu$

$IF WIN THEN

        apath$ = environ$("USERPROFILE") + "\Pictures\"

$ELSE

    apath$ = ENVIRON$("HOME") + "/Pictures/"

    '/" let's see if this fixes the "qb" code block bug on forum

$END IF

$IF VERSION < 3.4 THEN

        'sorry Dav's file list routine was supposed to be here...

        '  but that would require "direntry.h"

        PRINT "The current path now is "; apath$

        PRINT "Please type in the name of an SVG file to load."

        LINE INPUT afile$

        IF afile$ = "" THEN SYSTEM

        afile$ = apath$ + afile$

        IF NOT _FILEEXISTS(afile$) THEN

        PRINT "Unable to proceed!"

        PRINT "File not found: "; afile$

        END IF

$ELSE

    afile$ = _OPENFILEDIALOG$("Please choose an SVG file.", apath$, "*.svg", "Plain SVG")

    IF afile$ = "" THEN SYSTEM

$END IF

fe = FREEFILE

OPEN afile$ FOR INPUT AS fe

DO UNTIL EOF(fe)

    LINE INPUT #fe, entry$

    u = INSTR(entry$, dee$)

    IF u THEN

        lut = 0

        x = -1E+6

        y = -1E+6

        xx = 0

        yy = 0

        c$ = ""

        a$ = ""

        entry$ = MID$(entry$, LEN(dee$) + u)

        entry$ = LEFT$(entry$, LEN(entry$) - 1)

        PRINT entry$

        'trying to squash a bug where it refuses to read the final pair

        entry$ = entry$ + " "

        sf(h) = sf(h) + "99999999"

        gh = gh + 8

        g = g + 1

        v = 1

        u = INSTR(entry$, " ")

        DO WHILE u

            a$ = MID$(entry$, v, u - v)

            'must make sure there are lines only here.

            'might also have to check "M" and "m", this only assumes "m" at beginning

            '  is absolute coordinate.

            'this cannot handle "h" nor "v", requires manual editing of SVG file or a

            '  search-and-replace conversion in this program.

            'at last moment I had to make a provision for "z" which means draw a line,

            '  going back to the first (absolute) point of the path.

            IF a$ = "L" THEN lut = 1

            IF a$ = "l" THEN lut = 0

            IF a$ = "z" THEN EXIT DO

            IF LEN(a$) <> 1 THEN

                coma = INSTR(a$, ",")

                x1 = VAL(LEFT$(a$, coma - 1))

                y1 = VAL(MID$(a$, coma + 1))

                IF x = -1E+6 AND y = -1E+6 THEN

                    x0 = x1

                    y0 = y1

                    xx = x1

                    yy = y1

                    x = INT(xx)

                    y = INT(yy)

                ELSEIF lut THEN

                    xx = x1

                    yy = y1

                ELSE

                    xx = xx + x1

                    yy = yy + y1

                END IF

                outtheline

            END IF

            v = u + 1

            u = INSTR(v, entry$, " ")

        LOOP

        IF RIGHT$(entry$, 3) = " z " THEN

            xx = x0

            yy = y0

            outtheline

        END IF

        PRINT "---"

    END IF

LOOP

CLOSE fe



sf(h) = sf(h) + qu$

a$ = _TRIM$(STR$(h))

sl(h) = "sl[" + a$ + "] =" + STR$(gh)



PRINT "var i, j, x1, y1, x2, y2, xscale, yscale, xmove, first, stnumele"

PRINT "str a, b"

PRINT "str st["; a$; "]"

PRINT "var sl["; a$; "]"

FOR g = 1 TO h

    PRINT sf(g)

    PRINT sl(g)

NEXT

PRINT "stnumele ="; h + 1

PRINT "xscale = 1"

PRINT "yscale = 1"

PRINT "xmove = 0"

PRINT "wcolor 0, 0, 0"

PRINT "fcolor 255, 255, 255"

PRINT "i = 1"

PRINT "label lb02"

PRINT "    j = 1"

PRINT "    label lb03"

PRINT "        x1 = x2"

PRINT "        y1 = y2"

PRINT "        b = st[i]"

PRINT "        a = mstr(b, j, 4)"

PRINT "        x2 = val(a)"

PRINT "        if x2 = 9999"

PRINT "            first = 1"

PRINT "            j = j + 8"

PRINT "            goto cb03"

PRINT "        endif"

PRINT "        x2 = x2 * xscale"

PRINT "        x2 = x2 + xmove"

PRINT "        j = j + 4"

PRINT "        b = st[i]"

PRINT "        a = mstr(b, j, 4)"

PRINT "        y2 = val(a)"

PRINT "        y2 = y2 * yscale"

PRINT "        if first = 0"

PRINT "            line x1, y1, x2, y2"

PRINT "        endif"

PRINT "        if first = 1 : first = 0 : endif"

PRINT "    j = j + 4"

PRINT "label cb03"

PRINT "    if j < sl[i] : goto lb03 : endif"

PRINT "i = i + 1"

PRINT "if i < stnumele : goto lb02 : endif"

PRINT "swap"

SYSTEM





SUB outtheline ()

    SHARED AS LONG x, y, gh

    SHARED AS DOUBLE xx, yy

    SHARED AS INTEGER g, h

    SHARED qu$

    DIM hs$

    x = INT(xx)

    y = INT(yy)

    PRINT x; ","; y

    sf(h) = sf(h) + Zeroes$(x, 4) + Zeroes$(y, 4)

    gh = gh + 8

    g = g + 1

    IF g >= 80 THEN

        hs$ = _TRIM$(STR$(h))

        sf(h) = sf(h) + qu$

        sl(h) = "sl[" + hs$ + "] =" + STR$(gh)

        gh = 0

        g = 0

        h = h + 1

        hs$ = _TRIM$(STR$(h))

        sf(h) = "st[" + hs$ + "] = " + qu$

    END IF

END SUB





FUNCTION Zeroes$ (num AS LONG, numdig AS INTEGER)

    DIM b$, v AS LONG

    DIM AS INTEGER sg, hx

    IF num < 0 THEN sg = -1: num = num * -1

    IF numdig < 0 THEN hx = 1: numdig = numdig * -1 ELSE hx = 0

    IF hx THEN

        b$ = HEX$(num)

    ELSE

        b$ = LTRIM$(STR$(num))

    END IF

    v = numdig - LEN(b$)

    IF v > 0 THEN b$ = STRING$(v, 48) + b$

    IF sg = -1 THEN b$ = "-" + b$

    Zeroes$ = b$

END FUNCTION

https://basicanywheremachine-news.blogsp...m-and.html

Knocked up a little lightbar driven menu routine which will go in my library soon.

''

' LIGHTBAR Menu

'

' Creating lightbar driven menus using arrow keys to choose, enter to select, and

' making it reusable and modular.

'

' Code is a bit long, I'm sure someone can do this better! Regardless, this will end

' up in my QB64_GJ_LIB library soon.

' 

' @author Rick Christy <grymmjack@gmail.com>

'

OPTION _EXPLICIT

SCREEN 0 : _BLINK OFF : _CONTROLCHR OFF

_TITLE "LIGHTBAR Menu Routine DEMO"



TYPE LIGHTBAR ' bg|b = background, fg|f = foreground, k = key

    opt_bg_color AS INTEGER

    opt_fg_color AS INTEGER

    bar_bg_color AS INTEGER

    bar_fg_color AS INTEGER

    bar_kf_color AS INTEGER

    bar_kb_color AS INTEGER

    key_bg_color AS INTEGER

    key_fg_color AS INTEGER

    opt_selected AS INTEGER

    delimeter    AS STRING

END TYPE



DIM menu AS LIGHTBAR : DIM opts(5) AS STRING : DIM choice AS INTEGER

menu.opt_bg_color  = 0

menu.opt_fg_color  = 12

menu.bar_bg_color  = 3

menu.bar_fg_color  = 11

menu.bar_kf_color  = 14

menu.bar_kb_color  = 11

menu.key_bg_color  = 3

menu.key_fg_color  = 14

menu.opt_selected  = 0

menu.delimeter     = "|"

opts$(0)           = " |P|izza                                  "

opts$(1)           = " |R|ibs                                   "

opts$(2)           = " |W|ings                                  "

opts$(3)           = " |S|alad                                  "

opts$(4)           = " |B|readsticks                            "

opts$(5)           = " |Q|uit                                   "



COLOR 12, 0: PRINT "----------------------------------------"

COLOR 7, 0 : PRINT " Welcome to"; 

COLOR 12, 0: PRINT " ANTONIOS"; : COLOR 10, 0: PRINT " PIZZERIA!"

COLOR 7, 0 : PRINT " Pick your favorite food from our menu!"

COLOR 14, 0: PRINT "----------------------------------------"

COLOR 2, 0 : PRINT " ..if you're not hungry press ESCAPE.. "

COLOR 12, 0: PRINT "----------------------------------------"

PRINT

COLOR 9, 0 : PRINT " UP and DOWN choose and ENTER picks!"

PRINT



choice% = LIGHTBAR%(menu, opts$())

IF choice% <> -1 THEN

    PRINT

    COLOR 11, 0 : PRINT "You chose option ";

    COLOR 14, 0 : PRINT UCASE$(_TRIM$(STR$(choice%)));

    COLOR 11, 0 : PRINT ": ";

    COLOR 12, 0 : PRINT _TRIM$(opts$(choice%))

    IF choice% = 0 THEN

        COLOR 10, 0 : PRINT "An excellent choice! It is also my favorite!"

    END IF

ELSE

    PRINT

    COLOR 3, 0 : PRINT "Not hungry eh? OK you come back later!"

END IF

PRINT

COLOR 12, 0 : PRINT "Thank you! Come again!"







FUNCTION LIGHTBAR%(menu AS LIGHTBAR, options$())

    DIM AS STRING opt_l, opt_r, k, opt_sel_l, opt_sel_r, opt_sel_k

    DIM AS INTEGER obg, ofg, bbg, bfg, bkf, bkb, kbg, kfg, key_pos_s, key_pos_e

    DIM AS INTEGER row, col, orig_bg, orig_fg, lb, ub, i, selected, choice_made

    lb% = LBOUND(options$) : ub% = UBOUND(options$)



    ' fetch convenience colors

    obg% = menu.opt_bg_color : ofg% = menu.opt_fg_color

    bbg% = menu.bar_bg_color : bfg% = menu.bar_fg_color

    bkf% = menu.bar_kf_color : bkb% = menu.bar_kb_color

    kbg% = menu.key_bg_color : kfg% = menu.key_fg_color  



    DIM keys(lb% TO ub%) AS STRING          ' holds hot keys (chars in delimeters)

    row% = CSRLIN : col% = POS(0)           ' store initial cursor position

    orig_fg% = SCREEN(row%, col%, 1) AND 15 ' store initial foreground color

    orig_bg% = SCREEN(row%, col%, 1) \ 16   ' store initial background color

    selected% = menu.opt_selected           ' get selected option



    LIGHTBAR_draw:

        LOCATE row%, col%

        FOR i% = lb% TO ub%

            key_pos_s% = INSTR(0, options$(i%), menu.delimeter)

            key_pos_e% = INSTR(key_pos_s%, options$(i%), menu.delimeter)

            keys$(i%) = MID$(options$(i%), key_pos_s% + 1, 1)

            opt_l$ = MID$(options$(i%), 0, key_pos_s%)

            opt_r$ = MID$(options$(i%), key_pos_s% + 3)

            COLOR ofg%, obg% : PRINT opt_l$;

            COLOR kfg%, kbg% : PRINT keys$(i%);

            COLOR ofg%, obg% : PRINT opt_r$

            IF i% = selected% THEN

                opt_sel_l$ = opt_l$ : opt_sel_r$ = opt_r$ : opt_sel_k$ = keys$(i%)

            END IF

        NEXT i%



        ' draw selected option

        LOCATE row% + selected%, col%

        COLOR bfg%, bbg% : PRINT opt_sel_l$;

        COLOR bkf%, bkb% : PRINT opt_sel_k$;

        COLOR bfg%, bbg% : PRINT opt_sel_r$



    LIGHTBAR_get_choice:

        DO:

            ' handle arrow keys

            k$ = INKEY$

            SELECT CASE k$

                CASE CHR$(27): ' escape to abort

                    selected% = -1

                CASE CHR$(0) + CHR$(71): ' home to jump to first option

                    selected% = lb%

                    GOTO LIGHTBAR_draw

                CASE CHR$(0) + CHR$(79): ' end to jump to last option

                    selected% = ub%

                    GOTO LIGHTBAR_draw

                CASE CHR$(0) + CHR$(80): ' down arrow to go down an option

                    selected% = selected% + 1

                    IF selected% > ub% THEN selected% = lb%

                    GOTO LIGHTBAR_draw

                CASE CHR$(0) + CHR$(72): ' up arrow to go up an option

                    selected% = selected% - 1

                    IF selected% < lb% THEN selected% = ub%

                    GOTO LIGHTBAR_draw

            END SELECT

            ' handle hot keys

            FOR i% = lb% TO ub%

                IF LCASE$(k$) = LCASE$(keys$(i%)) THEN 

                    selected% = i%

                    choice_made% = 1

                    GOTO LIGHTBAR_draw

                END IF

            NEXT i%

        LOOP UNTIL k$ = CHR$(13) OR k$ = CHR$(27) OR choice_made% = 1



    COLOR orig_fg%, orig_bg% ' restore original colors

    LOCATE row% + (ub% - lb%) + 1, col% ' position cursor under menu

    LIGHTBAR% = selected%

END FUNCTION

All my QB64 programs under Linux (KDE Neon) can be resized/maximized anytime.  I'd like to prevent that.   Is there a way?  I tried $RESIZE:OFF but it doesn't seem to stop it.

- Dav

Since there is not much going on here at the moment, a small task:

A triangular track system with three points is given. (pic 36) Section a is a short dead end with a bumper block. Sections c and b are short distances between the points, the length of which can just accommodate one railroad wagon each.

Route D is a long, open-ended route. There is a goods wagon on section B and a container wagon on section C; on section D there is a locomotive with a tender. The section A bounded by the buffer stop is so short that it can accommodate the length of the freight wagon or container wagon, but not the locomotive and tender.
So while each of the cars can be moved from section B or C to the other side alone via the dead short distance A, this is not possible for the locomotive because of its length.

A locomotive driver now has the task of swapping the position of the two wagons by a shunting process, so that after the shunting process is complete, the container wagon is on track section B and the freight wagon is on track section C. The locomotive ends up on section D again (Fig. 37).

How is the shunting process to accomplish this?

Here is yet another version, Cloud variation:

Run a tiny basic interpreter inside a qb64 program. Sorry no string variables at this point.  I implemented a crude but simple means of passing variables into and out of the array space the interpreter uses. Will also load and save tiny basic programs. I added a few commands to the interpreter but most of the original work was done by one Ed Davis.

'tiny basic in a subroutine

' vesion 0.1.j2823

' 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



'$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 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 Double ' 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"

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) = "arraydump"

pl$(10) = "print " + Chr$(34) + "Type Run to execute the program and Quit to exit" + Chr$(34)







Call tiny_basic("list", pl$())

Cls

Print "Back in main program": Print

Print "Variables passed from interpreter"

For x = 1 To 10

    Print dump_array(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$())

    Dim loadlines, prox

    loadlines = UBound(pl$)

    For prox = 1 To loadlines

        pgm(prox) = pl$(prox)

    Next

    icmd$ = LCase$(icmd$)

    Select Case icmd$

        Case "run"

            tok = "run"

            Call docmd

        Case "list"

            tok = "list"

            Call docmd

        Case "new"

            tok = "new"

            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 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 "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 As Long

    var = getvarindex: Call nexttok

    Call expect("=")

    vars(var) = expression(0)

    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_aeeay to pass varaibles 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

            'vars(var) = Asc(st)

            Print "string tok "; tok

            var_string(var) = tok

            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

    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

            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

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

    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 = CLng(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



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

Just starting to figure out how to document the meta-programming features in BAM, and I decided to pick an easy one first.

Not very many use cases for the "now" macro (scroll to the bottom of the page for the link below), but it is pretty handy for program documentation and program intro screens.

https://basicanywheremachine.neocities.o...3Anow#Home