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:

Welcome JFPM

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

I installed the lastest KDE Neon linux distro today, but the QB64PE setup script fails with this error.  What would be the best step to fix this?

- Dav

Doing some reading up on gaussian blur this evening. Here's my go at the algorithm as I understand it.

Attached Files

Thumbnail(s)