https://www.reddit.com/r/BASICAnywhereMa...k_program/

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:

Welcome JFPM