Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Messages - B+

Pages: [1] 2 3 ... 28
1
Code and examples / Modern Sun Dial
« on: 01. September 2017, 23:04:06 »
I may have learned how to draw the landscape at BP.org, maybe a mod Aurel's code? It's been awhile!

Code: [Select]
'Sunburst 3.bas for QB64 fork (B+=MGA) 2017-09-01
'spiral rays anyone?  throw in the kitchen clock too...

RANDOMIZE TIMER
CONST xmax = 800
CONST ymax = 600
COMMON SHARED cN, pR, pG
SCREEN _NEWIMAGE(xmax, ymax, 32)
_TITLE "Modern Sun Dial by bplus, press spacebar for new view"

'set working variables
midx = xmax / 2
cN = 1
horizon = ymax / 2
maxd = ((xmax - midx) ^ 2 + (ymax - horizon) ^ 2) ^ .5
switch = -1
WHILE 1
    land& = _NEWIMAGE(xmax, ymax, 32)
    _DEST land&
    drawLandscape
    _DEST 0
    switch = NOT switch
    WHILE 1
        CLS
        IF _KEYHIT = 32 THEN EXIT WHILE
        resetPlasma
        _PUTIMAGE , land&, 0
        IF switch THEN
            FOR a = 0 TO _PI(2) STEP _PI(1 / 36)
                IF a = 0 THEN
                    lastx = midx + maxd * COS(a)
                    lasty = horizon + maxd * SIN(a)
                ELSE
                    x1 = midx + maxd * COS(a)
                    y1 = horizon + maxd * SIN(a)
                    changePlasma
                    filltri midx, horizon, lastx, lasty, x1, y1
                    lastx = x1: lasty = y1
                END IF
            NEXT
        END IF
        radius = 0: angle = sangle
        WHILE radius < 400
            x = COS(angle) * radius
            y = SIN(angle) * radius
            r2 = (x ^ 2 + y ^ 2) ^ .5
            size = 4 * r2 ^ .25
            angle = angle - .4
            radius = radius + 2
            COLOR _RGBA(200 + RND * 55, 255, 0, 30)
            sx = midx + 5 * COS(angle + _PI(1 / 2))
            sy = horizon + 5 * SIN(angle + _PI(1 / 2))
            sx1 = midx + 5 * COS(angle - _PI(1 / 2))
            sy1 = horizon + 5 * SIN(angle - _PI(1 / 2))
            filltri sx, sy, sx1, sy1, midx + x, horizon + y
        WEND
        sangle = sangle + _PI(1 / 18)
        IF switch THEN
            FOR r = 25 TO 0 STEP -1
                COLOR _RGBA(255, 255, 205, (25 - r) ^ 2 / 2.45)
                fillcirc midx, horizon, r
            NEXT
        END IF

        now$ = TIME$
        min = VAL(MID$(now$, 4, 2)) / 60
        h = VAL(MID$(now$, 1, 2)) + min
        IF h > 12 THEN h = h - 12
        hourA = h * _PI(1 / 6) - _PI(1 / 2)
        minA = min * _PI(2) - _PI(1 / 2)

        COLOR _RGBA(255, 255, 255, 48)
        sx = midx + 5 * COS(hourA + _PI(1 / 2))
        sy = horizon + 5 * SIN(hourA + _PI(1 / 2))
        sx1 = midx + 5 * COS(hourA - _PI(1 / 2))
        sy1 = horizon + 5 * SIN(hourA - _PI(1 / 2))
        filltri sx, sy, sx1, sy1, midx + 150 * COS(hourA), horizon + 150 * SIN(hourA)


        sx = midx + 5 * COS(minA + _PI(1 / 2))
        sy = horizon + 5 * SIN(minA + _PI(1 / 2))
        sx1 = midx + 5 * COS(minA - _PI(1 / 2))
        sy1 = horizon + 5 * SIN(minA - _PI(1 / 2))
        filltri sx, sy, sx1, sy1, midx + 250 * COS(minA), horizon + 250 * SIN(minA)

        _DISPLAY
        _LIMIT 1
    WEND
WEND

SUB changePlasma ()
    cN = cN + 1
    COLOR _RGBA(200 + 56 * SIN(pR * cN), 200 + 56 * SIN(pG * cN), 128, RND * 32)
END SUB

SUB resetPlasma ()
    pR = RND ^ 2: pG = RND ^ 2
END SUB

SUB midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    COLOR _RGB(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
END SUB

FUNCTION rand% (lo%, hi%)
    rand% = (RND * (hi% - lo% + 1)) \ 1 + lo%
END FUNCTION

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fillcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE (CX - X, CY)-(CX + X, CY), , BF

    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    WEND
END SUB

'Andy Amaya's triangle fill modified for QB64
SUB filltri (xx1, yy1, xx2, yy2, xx3, yy3)
    'make copies before swapping
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3

    'triangle coordinates must be ordered: where x1 < x2 < x3
    IF x2 < x1 THEN SWAP x1, x2: SWAP y1, y2
    IF x3 < x1 THEN SWAP x1, x3: SWAP y1, y3
    IF x3 < x2 THEN SWAP x2, x3: SWAP y2, y3
    IF x1 <> x3 THEN slope1 = (y3 - y1) / (x3 - x1)

    'draw the first half of the triangle
    length = x2 - x1
    IF length <> 0 THEN
        slope2 = (y2 - y1) / length
        FOR x = 0 TO length
            LINE (INT(x + x1), INT(x * slope1 + y1))-(INT(x + x1), INT(x * slope2 + y1))
            lastx% = INT(x + x1)
        NEXT
    END IF

    'draw the second half of the triangle
    y = length * slope1 + y1: length = x3 - x2
    IF length <> 0 THEN
        slope3 = (y3 - y2) / length
        FOR x = 0 TO length
            IF INT(x + x2) <> lastx% THEN
                LINE (INT(x + x2), INT(x * slope1 + y))-(INT(x + x2), INT(x * slope3 + y2))
            END IF
        NEXT
    END IF
END SUB

SUB drawLandscape
    'the sky
    FOR i = 0 TO ymax
        midInk 50, 25, 128, 100, 200, 255, i / ymax
        LINE (0, i)-(xmax, i)
    NEXT
    'the land
    startH = ymax - 200
    rr = 70: gg = 70: bb = 90
    FOR mountain = 1 TO 6
        Xright = 0
        y = startH
        WHILE Xright < xmax
            ' upDown = local up / down over range, change along Y
            ' range = how far up / down, along X
            upDown = (RND * .8 - .35) * (mountain * .5)
            range = Xright + rand%(15, 25) * 2.5 / mountain
            lastx = Xright - 1
            FOR X = Xright TO range
                y = y + upDown
                COLOR _RGB(rr, gg, bb)
                LINE (lastx, y)-(X, ymax), , BF 'just lines weren't filling right
                lastx = X
            NEXT
            Xright = range
        WEND
        rr = rand%(rr - 15, rr): gg = rand%(gg - 15, gg): bb = rand%(bb - 25, bb)
        IF rr < 0 THEN rr = 0
        IF gg < 0 THEN gg = 0
        IF bb < 0 THEN bb = 0
        startH = startH + rand%(5, 20)
    NEXT
END SUB


2
Code and examples / Pentacle Flux Capacitor #3, "Dancing Man"
« on: 25. August 2017, 21:04:27 »
Code: [Select]
' Pentacle Flux Capacitor #3.bas SmallBASIC 0.12.9 (B+=MGA) 2017-08-25
' based on mods made in Just Basic version

' Pentacle Flux Capacitor 2.bas SmallBASIC 0.12.9 (B+=MGA) 2017-08-23
'Pentacle Flux Capacitor 2.bas for QB64 fork 2017-08-23
'translated from: Pentacle Flux Capacitor 2.txt for JB (B+=MGA) 2017-08-23

'Some dancing music for the Dancing figure

'Electric Light Orchestra (ELO) It's a Livin' Thing...
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  https://www.youtube.com/watch?v=i2d45tOgBl0&index=1&list=RDi2d45tOgBl0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

RANDOMIZE TIMER
'COMMON SHARED xc, yc, dist, tp(), tp2()
xc = xmax / 2
yc = ymax / 2
DIM tp(4, 1), tp2(4, 1)
drawPFC
PFC = Image(0, 0, xmax, ymax)
while 1
  cls
  PFC.show(0, 0, , 20) ' use image transparency
  color rgb(rand(100, 255), rand(100, 255), rand(200, 255))
  Lightning xc, yc - 90, xc, yc + 10, 135
  FOR i = 0 TO 4
    xe = tp2(i, 0)
    ye = tp2(i, 1)
    d = rand(.1 * dist, .7 * dist)
    SELECT CASE i
    CASE 0
      Lightning xc, yc - 90, xe, ye, .65*d
      Lightning xc, yc - 90, xe, ye, .65*d
    CASE 1, 4
      Lightning xc, yc - 70, xe, ye, d
    CASE 2, 3
      Lightning xc, yc + 10, xe, ye, d
    END SELECT
  NEXT
  Showpage
  delay 30
WEND

SUB drawPFC
  local pRadius, cRadius, a3, r, ao, a, rr, i, xx, yy, dGray, dis, pnt, midx, midy
  'keep global tp(), tp2(), xc, yc, dist
  '3 main points for array tp()
  pRadius = 40: cRadius = 1.5 * pRadius
  a3 = PI * (2 / 5): r = ymax / 2 - cRadius - 20
  ao = PI* (-1 / 2): a = ao
  FOR rr = ymax/2-20 TO 0 STEP -1
    midInk 0, 0, 0, 128, 0, 0, rr / r
    Circle xc, yc, rr filled
  NEXT
  FOR i = 0 TO 4
    tp(i, 0) = xc + r * COS(a)
    tp(i, 1) = yc + r * SIN(a)
    FOR rr = cRadius TO pRadius STEP -1
      COLOR RGB((rr - pRadius) /(cRadius - pRadius) * 255 * (cRadius - rr + pRadius) / cRadius, 0, 0)
      xx = tp(i, 0): yy = tp(i, 1)
      Circle xx, yy, rr filled
    NEXT
    a = a + a3
  NEXT
  xx = tp(0, 0): yy = tp(0, 1)
  dist = distance(xx, yy, xc, yc) 'global
  FOR pnt = 0 TO 4
    FOR dis = 0 TO .5 * dist STEP 10
      dGray = 255 * dis / dist
      xx = tp(pnt, 0): yy = tp(pnt, 1)
      midpoint xx, yy, xc, yc, dis / dist, midx, midy
      FOR r = pRadius * (dist - dis) / dist TO 0 STEP -1
        midInk dGray, dGray, dGray, 255, 255, 255, (pRadius - r) / pRadius
        Circle midx, midy, r filled
      NEXT
    NEXT
    tp2(pnt, 0) = midx
    tp2(pnt, 1) = midy
  NEXT
END SUB

SUB Lightning (x1, y1, x2, y2, d)
  local mx, my
  IF d < 5 THEN
    LINE x1, y1, x2, y2
  ELSE
    mx = (x2 + x1) / 2
    my = (y2 + y1) / 2
    mx = mx + -.5 * RND * d * .4 * rand(-2, 2)
    my = my + -.5 * RND * d * .4 * rand(-2, 2)
    Lightning x1, y1, mx, my, d / 2
    Lightning x2, y2, mx, my, d / 2
  END IF
END SUB

SUB midpoint (x1, y1, x2, y2, fraction, byref midx, byref midy)
  midx = (x2 - x1) * fraction + x1
  midy = (y2 - y1) * fraction + y1
END SUB

SUB midInk (r1, g1, b1, r2, g2, b2, fr)
  COLOR RGB(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)
END SUB

FUNC distance(x1, y1, x2, y2)
  distance = ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
END

FUNC rand(lo, hi)
  rand = INT(RND * (hi - lo + 1)) + lo
END


3
Code and examples / Re: Functions 3D
« on: 18. August 2017, 01:09:00 »
Yes that works, sort of...

Could put the equations in a string array and run the strings through eval. Just a thought...

4
Code and examples / Re: Functions 3D
« on: 16. August 2017, 22:43:10 »
Thanks, wish I could copy/paste into input.

5
Hi Richey,

I would setup a Hi and Lo variable, starting the Hi at 101 and the Lo at 0 then the guess is (Hi - Lo)/2 + Lo, so first guess is 101/2 + 0 = 50 (You might need INT to round down to integer guesses.)

From the feed back on the guess, raise the Lo or Lower the Hi.
So say 50 was too high, then your new Hi is 50 and your next guess is 50/2 + 0 = 25

If 50 was too low then the Lo is made 50 and (101 - 50)/2 + 50 = 75 is your next guess.

Continue in this way until the guess is correct.

You would find a word in a sorted list in the same way.

Append: This works in SmallBASIC
Code: [Select]
' Hi Lo AI.bas SmallBASIC 0.12.9 (B+=MGA) 2017-08-14

secret = int(rnd*100) + 1 ' < 1 to 100
Hi = 101 : Lo = 0   '< make these higher and lower than what the secret number can be (just tested secret = 100, oops!)
label anotherGuess
guess = int((Hi - Lo)/2) + Lo
print "Guessing: ";guess
if guess = secret then
  print "Yes! The secret number was ";guess
  ? : input "Want to see another, y + Enter for yes ";yes
  if yes = "y" then
    ? : secret = int(rnd*100) + 1 : Hi = 101 : Lo = 0 
  else
    stop
  fi
elif guess > secret then
  Print "Too high!"
  Hi = guess
else
  print "Too Low!"
  Lo = guess
fi
goto anotherGuess

EDIT: Hi start at 101 not 100


6
Offtopic / Re: ProBoards
« on: 14. August 2017, 21:35:42 »
Ha! If his ad blocker worked, he wouldn't have seen any ads.

The thing is my browser already has an ad blocker built in.

AND this (see attachment) appears at the heading of the site:


What is one to think when they flat out lie? No popups, no annoyances? Who are they kidding?

7
Code and examples / Re: Functions 3D
« on: 14. August 2017, 21:30:37 »
Hi Galileo,

Do you have suggestions for F(X, Z) = ?

Nothing I have tried has worked without error.

What function was used for screen shot?


8
Offtopic / ProBoards
« on: 12. August 2017, 18:34:28 »
Literally in your face for using an ad blocker!

http://qb64.freeforums.net/thread/66/
(Dang! you have to be a member there too for attached materials.)

Is that what a pro should do?

9
Aha ..ok  :)
yes LBB is far better than jb/lb and it is faster
advantage you can run any program from jb/lb in LBB

Yep! it is a great advantage unless you want to share your experience at JB forum.  ::)

10
;-))  Probably need to copy save some examples or write a program to be able to run anything.

The files looked for end with *BNB.txt

Attached is a bunch of my test files in zip. Examples until you can figure out how to write your own.

As you can see from screen shot all three of these Windows have a File menu! Load a file for the B interpreter from the running B interpreter program, the one with biggest print.

PS Hey! First time I tried LBB in couple of years, worked right out of the box! :)

PPS LBB lists Edit menu first and THEN Files menu, probably because Edit is built in when use a TextEdit control.

PPPS I was going to say my .bas extension name is registered for SmallBASIC so I write .txt Just Basic program files but you did figure that out because you got the B Interpreter loaded in LBB.

11
JB is nice, with texteditor in GUI, I don't have to outsource to edit a program file, nice File Dialog too (compared to QB64).
Now for first time (for me) a variables table to store names and values. 275 lines or less interpreter with no eval function, easy as eating pie to add functions.

Code: [Select]
'B Interpreter v2.txt for JB (B+=MGA) 2017-08-06

global nCodeLines, nVariables, maxVariables, err$
nVariables = 0
maxVariables = 100
dim v$(maxVariables, 1)
fname$ = "untitled BNB.txt"

    '  Mainwin is output
    'probably should setup an output graphics window for color drawing and printing

    WindowWidth = 800
    WindowHeight = 675

    statictext #main.fname, "Untitled BNB.txt", 5, 5, 780, 50
    texteditor #main.te, 5, 61, 760, 540
    menu #main, "&File", "&New", [fileNew],"&Load", [fileLoad], "&Save", [fileSave], "save &As", [fileAsSave], "e&Xit", [quit]
    menu #main, "&Run","&Run",[Run]
    open "B Interpreter" for window as #main
    #main, "trapclose [quit]"
    #main, "font arial 10 20"

    wait

[fileNew]
    ttl$ = "New *BNB.txt file base name";chr$(13)
    prom$ = ttl$ + "Please enter a base name, BNB.txt will be added to it."
    prompt prom$; base$
    if base$ <> "" then fname$ = base$ + " BNB.txt" else fname$ = "untitled BNB.txt"
    #main.fname, fname$
wait

[fileLoad]
    filedialog "test", "*BNB.TXT", fname$
    if fname$ <> "" and right$(upper$(fname$), 7) = "BNB.TXT" then
        open fname$ for input as #1
        ' this next line is a total surprise to me!!!
        #main.te "!contents #1"
        close #1
    else
        fname$ = "untitled BNB.txt"
    end if
    #main.fname, fname$
wait

[fileSave]
    'save current list to file
    #main.te "!contents? txt$"
    open fname$ for output as #1
    print #1, txt$
    close #1
wait

[fileAsSave]
    ttl$ = "Another *BNB.txt file base name";chr$(13)
    prompt ttl$+"Please enter a base name, BNB.txt will be added to it.";base$
    if base$ <> "" then
        fname$ = base$ + " BNB.txt"
        #main.te "!contents? txt$"
        open fname$ for output as #1
        print #1, txt$
        close #1
    end if
    #main.fname, fname$
wait

[Run]
    'nCodeLines is global for the executor
    #main.te, "!lines nCodeLines"
    if nCodeLines > 0 then
        redim program$(nCodeLines)
        nVariables = 0 : err$ = ""
        cls
        redim v$(maxVariables, 1)
        for i = 1 to nCodeLines
            #main.te, "!line ";i;" codeLine$"
            program$(i) = codeLine$
        next
        call executor
    end if
wait

[quit]
    close #main
    end

sub executor
for i = 1 to nCodeLines
    scan
    cmd$ = upper$(word$(program$(i), 1))
    select case cmd$
        case "V"    'set VariableName Number or SET VariableName Function
            var$ = word$(program$(i), 2)
            if isVariable(var$) then
                fn$ = upper$(word$(program$(i), 3))
                p1$ = getValue$(word$(program$(i), 4))
                p2$ = getValue$(word$(program$(i), 5))
                p3$ = getValue$(word$(program$(i), 6))
                p4$ = getValue$(word$(program$(i), 7))
                p5$ = getValue$(word$(program$(i), 8))
                p6$ = getValue$(word$(program$(i), 9))
                'notice p1$;" ";p2$
                select case fn$
                    'Binary Operations
                    case "@" : val$ = p1$ '< just set a varaible to a value or variable
                    case "+" : val$ = str$(val(p1$) + val(p2$))
                    case "-" : val$ = str$(val(p1$) - val(p2$))
                    case "*" : val$ = str$(val(p1$) * val(p2$))
                    case "/" : val$ = str$(val(p1$) / val(p2$))
                    case "^" : val$ = str$(val(p1$) ^ val(p2$))
                    case "%" : val$ = str$(val(p1$) mod val(p2$))

                    'number comapares dont forget #
                    case "#=" : val$ = str$(val(p1$) = val(p2$))
                    case "#<" : val$ = str$(val(p1$) < val(p2$))
                    case "#>" : val$ = str$(val(p1$) > val(p2$))
                    case "#<=" : val$ = str$(val(p1$) <= val(p2$))
                    case "#>=" : val$ = str$(val(p1$) >= val(p2$))
                    case "#<>" : val$ = str$(val(p1$) <> val(p2$))

                    'string compares dont forget $
                    case "$=" : val$ = str$(p1$ = p2$)
                    case "$<" : val$ = str$(p1$ < p2$)
                    case "$>" : val$ = str$(p1$ > p2$)
                    case "$<=" : val$ = str$(p1$ <= p2$)
                    case "$>=" : val$ = str$(p1$ >= p2$)
                    case "$<>" : val$ = str$(p1$ <> p2$)

                    'more number 0 and -1 for Boolean Builds
                    case "AND" : if val(p1$) <> 0 and val(p2$) <> 0 then val$ = "1" else val$ = "0"
                    case "OR" : if val(p1$) <> 0 or val(p2$) <> 0 then val$ = "1" else val$ = "0"
                    case "NOT" : val$ = str$(NOT(val(p1$)))

                    'STRING STUFF

                    'set a varaible to some spaces
                    case "SPACE" : val$ = space$(val(p1$))

                    'set a variable to a string with spaces in it
                    'LS or ls stands for long string (string with spaces)
                    'LS reads next line of code between {My text inside brackets}
                    'and assigns it the the variable name on LS line.
                    case "LS" : i = i + 1
                        val$ = word$(program$(i), 2, "{")
                        val$ = word$(val$, 1, "}")
                    case "MID1" : val$ = mid$(p1$, val(p2$))
                    case "MID2" : val$ = mid$(p1$, val(p2$), val(p3$))
                    case "LEN"  : val$ = str$(len(p1$))
                    case "INPUT" : input "Enter > ";val$

                    'NUMBER STUFF

                    case "INT" : val$ = str$(int(val(p1$)))
                    case "RND" : val$ = str$(RND(0))


                end select
                call dVariable var$, val$
            else
                notice "Line ";i;" variable ";var$;" is improper name."
            end if

        'Output p is short for print, 3 ways to end
        case "P" : print getValue$(word$(program$(i), 2))
        case "P;" : print getValue$(word$(program$(i), 2));
        case "P," : print getValue$(word$(program$(i), 2)),

        'Decision branching IF... [ELSE]... FI < need one word to end block
        'FI command just marks end of IF block
        case "IF" : if getValue$(word$(program$(i), 2)) = "0" then call findi i
            if err$ <> "" then exit for
        case "ELSE" : call findi i : if err$ <> "" then exit for

        'Loop structure DO... EXIT (only way out except END)... LOOP
        'DO just marks beginning of LOOP for LOOP command
        case "LOOP" : loopCnt = -1 'count the bracket we're on
            i = i - 1   'move the code pointer back a char
            while loopCnt <> 0
                'count nested loops till we fine the matching one
                if upper$(word$(program$(i), 1)) = "LOOP" then loopCnt = loopCnt - 1
                if upper$(word$(program$(i), 1)) = "DO" then loopCnt = loopCnt + 1
                i = i - 1 'search backwards
            wend
            i = i + 1
        case "EXIT" : loopCnt = 1 'count the bracket we're on
            i = i + 1 'move the code pointer to the next char
            while loopCnt <> 0
                'count nested loops till we find the matching one
                if upper$(word$(program$(i), 1)) = "LOOP" then loopCnt = loopCnt - 1
                if upper$(word$(program$(i), 1)) = "DO" then loopCnt = loopCnt + 1
                i = i + 1 'search forward
            WEND
            i = i - 1

        case "END" : exit for
        case "CLS" : cls
        case "LOCATE" : p1$ = getValue$(word$(program$(i), 2))
            p2$ = getValue$(word$(program$(i), 3))
            locate val(p1$), val(p2$)
        case "PAUSE" : p1$ = getValue$(word$(program$(i), 2))
            call pause val(p1$)

    end select
next
print : print "Variables Table:"
for j = 1 to nVariables
    print v$(j, 0);" = ";v$(j, 1)
next
end sub

'need a way to tell a variable from a string
function isVariable(test$)
    isVariable = 0 : ca = asc(left$(upper$(test$), 1))
    'notice "isVar ";ca;" ";right$(test$, 1)
    if 64 < ca and ca < 91 then
        if right$(test$, 1) = "#" or right$(test$, 1) = "$" then
            isVariable = 1
        end if
    end if
end function


'add variable and value or edit variable value
sub dVariable variable$, value$
    if isVariable(variable$) then  'check if variable name OK
        if nVariables > 0 then
            for i = 1 to nVariables
                if variable$ = v$(i, 0) then flag = 1 : v$(i, 1) = value$ : exit for
            next
        end if
        if not(flag) then
            nVariables = nVariables + 1
            v$(nVariables, 0) = variable$ : v$(nVariables, 1) = value$
        end if
    end if
end sub

function getValue$(test$)  'if a varaible name return the value else return test$
    if isVariable(test$) then 'check if test$ is a variable name
        if nVariables > 0 then
            getValue$ = ""
            for i = 1 to nVariables
                if test$ = v$(i, 0) then getValue$ = v$(i, 1) : exit for
            next
        end if
    else
        getValue$ = test$
    end if
end function

sub findi byref i
    cnt = 1 : saveI = i
    for j = i + 1 to nCodeLines
        fw$ = upper$(word$(program$(j), 1))
        if fw$ = "FI" then
            cnt = cnt - 1
            if cnt = 0 then i = j  : exit sub
        else
            if fw$ = "IF" then
                cnt = cnt + 1
            else
                if fw$ = "ELSE" and cnt = 1 then i = j : exit sub
            end if
        end if
    next
    err$ = "Could not find FI for line ";saveI
    notice err$
end sub

sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub


12
I have developed the code in parallel in two different BASICs so for comparison and if you want to try a translation...

Here is SmallBASIC version of SNH Interpreter:
Code: [Select]
'SNH Interpreter.bas for SmallBASIC 0.12.9 (B+=MGA) 2017-07-31
' Strings Now Handled
CONST  CHARWIDTH = TXTW("W")
CONST  CELLSPERLINE = XMAX/CHARWIDTH
memsize = 20000
DIM m$(memsize)
numChars = "-.1234567890"
cmdChars = "W?ABCDFMIENP[X]%^/*~+=<>()!&|"
allChars = numChars + cmdChars

WHILE 1
  CLS
  anyfile = FILES("*SNH.txt")
  ? "SNH (Strings Now Handled) Files:":?
  IF LEN(anyfile) > 0 THEN
    FOR i = 0 TO ubound(anyfile)
      ? i, anyfile(i)
    NEXT
    ? : INPUT "number > files quits, Enter file NUMBER to run (any else quits) > ", flnm
    IF ISNUMBER(flnm) AND flnm >= 0 AND flnm <= UBOUND(anyfile)
        getfile = anyfile(flnm)
        TLOAD getfile, source, 1
        CLS : runSource
    ELSE
      STOP
    END IF
  ELSE
    ? "Sorry, no files to run, press any..." : STOP
  END IF
WEND

SUB runSource  'NOTE watch out for locals!
  ERASE m$
  DIM m$(memsize)
  'note: anything above first {}
  bs = INSTR(source, "{") : be = INSTR(bs + 1, source, "}")
  WHILE bs AND be
    ix = VAL(MID(source, bs + 1, be - bs - 1))
    IF ix < 1 THEN EXIT LOOP
    bs = INSTR(be + 1, source, "{")
    ti = MID(source, be + 1, bs - be - 1)
    tEnd = INSTR(ti, ";")
    IF tEnd = 0 THEN ? "Missing ; for {";ix;"}." : PAUSE : EXIT SUB
    ti = MID(ti, 1, tEnd - 1)
    m$(ix) = ti
    be = INSTR(bs + 1, source, "}")
    IF be = 0 THEN ? "Unmatched { } pairs." : PAUSE : EXIT SUB
  WEND
  source = MID(source, be + 1)
 
  source = UCASE(source)
  '? "Source after {}:"
 
  'let's clean the code up, check bracket balance
  bktCnt = 0 : ifCnt = 0 : code = ""
  FOR i = 1 TO LEN(source)
    char = MID(source, i, 1)
    'check to see if this is a valid instruction character
    IF INSTR(allChars, char) THEN
      code = code + char
      'count brackets
      IF char = "[" THEN bktCnt = bktCnt + 1
      IF char = "]" THEN bktCnt = bktCnt - 1
      if char = "I" Then ifCnt = ifCnt + 1
      if char = "N" then ifCnt = ifCnt - 1
    END IF
  NEXT
  IF bktCnt THEN 'mismatched brackets
    ? "Uneven brackets" : PAUSE : EXIT SUB
  ELSEIF ifCnt THEN
    ? "Uneven I N counts" : PAUSE : EXIT SUB
  ELSE
    '? code  'check
  END IF
  cmd = "" : ds = "" : err = ""
  FOR i = 1 TO LEN(code) 'loop through the code
    c = MID(code, i, 1) 'get the instruction we're on
    IF INSTR("-.1234567890", c) THEN ds = ds + c
    IF INSTR(cmdChars, c) OR i = len(code) THEN 'hit next command or end
      IF cmd <> "" THEN 'execute unfinished command
        d = VAL(ds)
        'exec last cmd
        SELECT CASE cmd
        CASE "A" : m$(1) = m$(d)
        CASE "B" : m$(2) = m$(d)
        CASE "C" : m$(3) = m$(d)
        CASE "D" : m$(4) = m$(d)       
        CASE "F"
          SELECT CASE m$(1) 'the function name m$(2) 1st para...
          CASE "NOT" : IF VAL(m$(2)) <> 0 THEN m$(d) = "0" ELSE m$(d) = "1"
          CASE "RND" : m$(d) = STR(RND)
          CASE "INT" : m$(d) = STR(INT(VAL(m$(2))))                           
          CASE "CTR": spacesNeeded = (CELLSPERLINE - LEN(m$(2)))/2
            ? SPACE(spacesNeeded) + m$(2);
          CASE "CLS": CLS
          CASE "COLOR": COLOR VAL(m$(2)), VAL(m$(3))
          CASE "LEN": m$(d) = STR(LEN(m$(2)))
          CASE "MID1": m$(d) = MID(m$(2), VAL(m$(3)))
          CASE "MID2": m$(d) = MID(m$(2), VAL(m$(3)), VAL(m$(4)))
          CASE "INSTR1": m$(d) = STR(INSTR(m$(2), m$(3)))
          CASE "INSTR2": m$(d) = STR(INSTR(VAL(m$(2)), m$(3), m$(4)))
          CASE "LOCATE": LOCATE VAL(m$(2)), VAL(m$(3))
          END SELECT
        CASE "M" : m$(d) = m$(0)
        CASE "W" : ? m$(d);
        CASE "?" : INPUT test
          IF ISNUMBER(test) THEN test = STR(test)
          m$(d) = test
        END SELECT
        cmd = "" : ds = ""
      END IF 'if cmd <> ""

      'handle current cmd
      IF INSTR("ABCDFMW?", c) THEN  'get d first
        cmd = c
      ELSEIF c = "I" : IF m$(0) = 0 then Findi
         IF err <> "" THEN ? err : PAUSE : EXIT SUB
      ELSEIF c = "E" THEN
        Findi
        IF err <> "" THEN ? err : PAUSE : EXIT SUB
      ELSEIF c = "P" THEN
        ?
      ELSEIF c = "X" THEN
        bktCnt = 1 'count the bracket we're on
        i = i + 1 'move the code pointer to the next char
        WHILE bktCnt <> 0
          'count nested loops till we find the matching one
          IF MID(code, i, 1) = "]" THEN bktCnt = bktCnt - 1
          IF MID(code, i, 1) = "[" THEN bktCnt = bktCnt + 1
          i = i + 1 'search forward
        WEND
        i = i - 1
      ELSEIF c = "]" THEN ' end a loop if loop index is 0
        bktCnt = -1 'count the bracket we're on
        i = i - 1   'move the code pointer back a char
        WHILE bktCnt <> 0
          'count nested loops till we fine the matching one
          IF MID(code, i, 1) = "]" THEN bktCnt = bktCnt - 1
          IF MID(code, i, 1) = "[" THEN bktCnt = bktCnt + 1
          i = i - 1 'search backwards
        WEND
        i = i + 1   
      ELSEIF c = "%" THEN : m$(0) = STR(VAL(m$(1)) % VAL(m$(2)))
      ELSEIF c = "^" THEN : m$(0) = STR(VAL(m$(1)) ^ Val(m$(2)))
      ELSEIF c = "/" THEN : m$(0) = STR(VAL(m$(1)) / VAL(m$(2)))
      ELSEIF c = "*" THEN : m$(0) = STR(VAL(m$(1)) * VAL(m$(2)))
      ELSEIF c = "~" THEN : m$(0) = STR(VAL(m$(1)) - VAL(m$(2)))
      ELSEIF c = "+" THEN : m$(0) = STR(VAL(m$(1)) + VAL(m$(2)))
      ELSEIF c = "=" THEN : m$(0) = STR(VAL(m$(1)) = VAL(m$(2)))
      ELSEIF c = "<" THEN : m$(0) = STR(VAL(m$(1)) < VAL(m$(2)))
      ELSEIF c = ">" THEN : m$(0) = STR(VAL(m$(1)) > VAL(m$(2)))
      ELSEIF c = "(" THEN : m$(0) = STR(VAL(m$(1)) <= VAL(m$(2)))
      ELSEIF c = ")" THEN : m$(0) = STR(VAL(m$(1)) >= VAL(m$(2)))
      ELSEIF c = "!" THEN : m$(0) = STR(VAL(m$(1)) <> VAL(m$(2)))
      ELSEIF c = "&" THEN : m$(0) = STR(VAL(m$(1)) AND VAL(m$(2)))
      ELSEIF c = "|" THEN : m$(0) = STR(VAL(m$(1)) OR VAL(m$(2)))
      END IF
    END IF ' ran into next command
    '? mid(code, i, 1); :input temp
  NEXT
  ?:? "Run is done, hit any..." : PAUSE
END SUB

SUB Findi
  'code, i, err  are global
  LOCAL cnt, c1, j
  cnt = 1
  FOR j = i + 1 TO LEN(code)
    c1 = MID(code, j, 1)
    IF c1 = "N" THEN
      cnt = cnt - 1
      IF cnt = 0 THEN i = j  : EXIT SUB
    ELSEIF c1 = "I" THEN
      cnt = cnt + 1
    ELSEIF c1 = "E" and cnt = 1 THEN
      i = j  : EXIT SUB
    END IF
  NEXT
  err = "Could not find N"
END SUB

And here is the QB64 v1,1 (Walter's fork) version:
Code: [Select]
'SNH Interpreter.bas for QB64 fork (B+=MGA) 2017-08-01 trans
RANDOMIZE TIMER
_TITLE "Strings Now Hamdled, the SNH Interpreter (tiny)"
SCREEN 12: COLOR 7, 0: CLS

'for directory stuff
CONST ListMAX% = 20
COMMON SHARED dirList$()
COMMON SHARED DIRCount% 'returns file count if desired
DIM dirList$(ListMAX%)

CONST numChars$ = "-.1234567890"
CONST cmdChars$ = "W?ABCDFMIENP[X]%^/*~+=><()!&|"
CONST allChars$ = numChars$ + cmdChars$

CONST memsize% = 20000
COMMON SHARED m$()
COMMON SHARED source$, code$, err$
DIM m$(memsize%)
NotBeenHere% = 1
'PRINT "COMMAND$ = "; COMMAND$
'INPUT "OK, press enter "; temp$
WHILE 1
    source$ = ""
    COLOR 7, 0: CLS
    ERASE dirList$
    DIM dirList$(ListMAX%)
    loadDirList "*SNH.txt"
    IF _FILEEXISTS(COMMAND$) AND RIGHT$(UCASE$(COMMAND$), 7) = "SNH.TXT" AND NotBeenHere% = 1 THEN
        filename$ = COMMAND$: NotBeenHere% = 0
    ELSEIF DIRCount% THEN
        FOR i% = 1 TO DIRCount%
            PRINT i%, dirList$(i%)
        NEXT
        PRINT: INPUT "0 quits, Enter line number of SNH Filename you desire "; ln%
        IF ln% < 1 OR ln% > DIRCount% THEN END
        filename$ = dirList$(ln%)
    ELSE
        PRINT "No *SNH.txt files found."
        SLEEP: END
    END IF
    OPEN filename$ FOR INPUT AS #1
    DO
        LINE INPUT #1, fline$
        source$ = source$ + fline$
        'PRINT fline$
        'INPUT " OK, enter"; temp$
    LOOP UNTIL EOF(1)
    CLOSE #1
    runSource
WEND

SUB runSource
    ERASE m$
    DIM m$(memsize%)
    'note: anything above first {} is comment and ignored
    'First get m$ (string memory array) loaded with data values
    FOR i% = 1 TO LEN(source$)
        c$ = MID$(source$, i%, 1)
        IF c$ = "{" THEN
            bs% = i%
            WHILE MID$(source$, i%, 1) <> "}"
                i% = i% + 1
                IF i% = LEN(source$) THEN PRINT "Missing }": SLEEP: EXIT SUB
            WEND
            ix% = VAL(MID$(source$, bs% + 1, i% - bs% - 1))
            IF ix% < 1 THEN EXIT FOR
            b$ = "": i% = i% + 1
            WHILE MID$(source$, i%, 1) <> ";"
                b$ = b$ + MID$(source$, i%, 1)
                i% = i% + 1
                IF i% = LEN(source$) THEN PRINT "Missing ending ;": SLEEP: EXIT SUB
            WEND
            m$(ix%) = b$
        END IF
    NEXT
    source$ = MID$(source$, i% + 1)

    'OK now letters, digits or symbols from strings wont interfere with program code
    source$ = UCASE$(source$)
    'let's clean the code up, check bracket balance
    bktCnt% = 0: ifCnt% = 0: code$ = ""
    FOR i = 1 TO LEN(source$)
        char$ = MID$(source$, i, 1)
        'check to see if this is a valid instruction character
        IF INSTR(allChars$, char$) THEN
            code$ = code$ + char$
            'count brackets
            IF char$ = "[" THEN bktCnt% = bktCnt% + 1
            IF char$ = "]" THEN bktCnt% = bktCnt% - 1
            IF char$ = "I" THEN ifCnt% = ifCnt% + 1
            IF char$ = "N" THEN ifCnt% = ifCnt% - 1
        END IF
    NEXT
    PRINT "Code check: "; code$
    IF bktCnt% THEN 'mismatched brackets
        PRINT "Uneven brackets": SLEEP: EXIT SUB
    ELSEIF ifCnt% THEN
        PRINT "Uneven I N counts": SLEEP: EXIT SUB
    ELSE
        PRINT code$ 'check
        INPUT "OK, press enter... "; temp$
        CLS
    END IF

    cmd$ = "": ds$ = "": err$ = ""
    FOR i% = 1 TO LEN(code$) 'loop through the code
        c$ = MID$(code$, i%, 1) 'get the instruction we're on
        IF INSTR("-.1234567890", c$) THEN ds$ = ds$ + c$
        IF INSTR(cmdChars$, c$) OR i% = LEN(code$) THEN 'hit next command or end
            IF cmd$ <> "" THEN 'execute unfinished command
                d# = VAL(ds$)
                'exec last cmd
                SELECT CASE cmd$
                    CASE "A": m$(1) = m$(d#)
                    CASE "B": m$(2) = m$(d#)
                    CASE "C": m$(3) = m$(d#)
                    CASE "D": m$(4) = m$(d#)
                    CASE "F"
                        SELECT CASE m$(1) 'the function name m$(2) 1st para...
                            CASE "NOT": IF VAL(m$(2)) = 0 THEN m$(d#) = "-1" ELSE m$(d#) = "0"
                            CASE "RND": m$(d#) = STR$(RND)
                            CASE "INT": m$(d#) = STR$(INT(VAL(m$(2))))
                            CASE "CTR": LOCATE CSRLIN, (80 - LEN(m$(2))) / 2: PRINT m$(2);
                            CASE "CLS": CLS
                            CASE "COLOR": COLOR VAL(m$(2)), VAL(m$(3))
                            CASE "LEN": m$(d#) = STR$(LEN(m$(2)))
                            CASE "MID1": m$(d#) = MID$(m$(2), VAL(m$(3)))
                            CASE "MID2": m$(d#) = MID$(m$(2), VAL(m$(3)), VAL(m$(4)))
                            CASE "INSTR1": m$(d#) = STR$(INSTR(m$(2), m$(3)))
                            CASE "INSTR2": m$(d#) = STR$(INSTR(VAL(m$(2)), m$(3), m$(4)))
                            CASE "LOCATE": LOCATE VAL(m$(2)), VAL(m$(3))
                        END SELECT
                    CASE "M": m$(d#) = m$(0)
                    CASE "W": PRINT m$(d#);
                    CASE "?": INPUT m$(d#)
                END SELECT
                cmd$ = "": ds$ = ""
            END IF 'if cmd <> ""

            'handle current cmd
            IF INSTR("ABCDFMW?", c$) THEN
                cmd$ = c$
            ELSEIF c$ = "I" THEN
                IF VAL(m$(0)) = 0 THEN i% = Findi(i%)
                IF err$ <> "" THEN PRINT err$: SLEEP: EXIT SUB
            ELSEIF c$ = "E" THEN
                i% = Findi(i%)
                IF err$ <> "" THEN PRINT err$: SLEEP: EXIT SUB
            ELSEIF c$ = "P" THEN
                PRINT
            ELSEIF c$ = "X" THEN
                bktCnt% = 1 'count the bracket we're on
                i% = i% + 1 'move the code pointer to the next char
                WHILE bktCnt% <> 0
                    'count nested loops till we find the matching one
                    IF MID$(code$, i%, 1) = "]" THEN bktCnt% = bktCnt% - 1
                    IF MID$(code$, i%, 1) = "[" THEN bktCnt% = bktCnt% + 1
                    i% = i% + 1 'search forward
                WEND
                i% = i% - 1%
            ELSEIF c$ = "]" THEN ' end a loop if loop index is 0
                bktCnt% = -1 'count the bracket we're on
                i% = i% - 1 'move the code pointer back a char
                WHILE bktCnt% <> 0
                    'count nested loops till we fine the matching one
                    IF MID$(code$, i%, 1) = "]" THEN bktCnt% = bktCnt% - 1
                    IF MID$(code$, i%, 1) = "[" THEN bktCnt% = bktCnt% + 1
                    i% = i% - 1 'search backwards
                WEND
                i% = i% + 1
            ELSEIF c$ = "%" THEN: m$(0) = STR$(VAL(m$(1)) MOD VAL(m$(2)))
            ELSEIF c$ = "^" THEN: m$(0) = STR$(VAL(m$(1)) ^ VAL(m$(2)))
            ELSEIF c$ = "/" THEN: m$(0) = STR$(VAL(m$(1)) / VAL(m$(2)))
            ELSEIF c$ = "*" THEN: m$(0) = STR$(VAL(m$(1)) * VAL(m$(2)))
            ELSEIF c$ = "~" THEN: m$(0) = STR$(VAL(m$(1)) - VAL(m$(2)))
            ELSEIF c$ = "+" THEN: m$(0) = STR$(VAL(m$(1)) + VAL(m$(2)))
            ELSEIF c$ = "=" THEN: m$(0) = STR$(VAL(m$(1)) = VAL(m$(2)))
            ELSEIF c$ = "<" THEN: m$(0) = STR$(VAL(m$(1)) < VAL(m$(2)))
            ELSEIF c$ = ">" THEN: m$(0) = STR$(VAL(m$(1)) > VAL(m$(2)))
            ELSEIF c$ = "(" THEN: m$(0) = STR$(VAL(m$(1)) <= VAL(m$(2)))
            ELSEIF c$ = ")" THEN: m$(0) = STR$(VAL(m$(1)) >= VAL(m$(2)))
            ELSEIF c$ = "!" THEN: m$(0) = STR$(VAL(m$(1)) <> VAL(m$(2)))
            ELSEIF c$ = "&" THEN
                IF VAL(m$(1)) <> 0 AND VAL(m$(2)) <> 0 THEN m$(0) = "-1" ELSE m$(0) = "0"
            ELSEIF c$ = "|" THEN
                IF VAL(m$(1)) <> 0 OR VAL(m$(2)) <> 0 THEN m$(0) = "-1" ELSE m$(0) = "0"
            END IF ' ran into next command
        END IF
    NEXT
    PRINT: INPUT "Run is done, enter to continue..."; temp$
END SUB

FUNCTION Findi% (i%)
    cnt% = 1
    FOR j% = i% + 1 TO LEN(code$)
        c1$ = MID$(code$, j%, 1)
        IF c1$ = "N" THEN
            cnt% = cnt% - 1
            IF cnt% = 0 THEN Findi% = j%: EXIT FUNCTION
        ELSEIF c1$ = "I" THEN
            cnt% = cnt% + 1
        ELSEIF c1$ = "E" AND cnt% = 1 THEN
            Findi% = j%: EXIT SUB
        END IF
    NEXT
    err$ = "Could not find N"
END FUNCTION

' modified function from Help files
SUB loadDirList (spec$)
    CONST TmpFile$ = "DIR$INF0.INF"
    IF spec$ > "" THEN 'get file names when a spec is given
        SHELL _HIDE "DIR " + spec$ + " /b > " + TmpFile$
        Index% = 0: dirList$(Index%) = "": ff% = FREEFILE
        OPEN TmpFile$ FOR APPEND AS #ff%
        size& = LOF(ff%)
        CLOSE #ff%
        IF size& = 0 THEN KILL TmpFile$: EXIT SUB
        OPEN TmpFile$ FOR INPUT AS #ff%
        DO WHILE NOT EOF(ff%) AND Index% < ListMAX%
            Index% = Index% + 1
            LINE INPUT #ff%, dirList$(Index%)
        LOOP
        DIRCount% = Index% 'SHARED variable can return the file count
        CLOSE #ff%
        KILL TmpFile$
    ELSE IF Index% > 0 THEN Index% = Index% - 1 'no spec sends next file name
    END IF
END SUB


A Just Basic version might be fun with the GUI text editor control for editing and running in completely contained environment.

13
Time for another installment of my on going adventures with esoteric Interpreters.

This is such a popular subject I have to find reasons for myself to post this trivial pursuit.

I find a few actually:
1. Backup, if my computer or a forum fails not everything is lost!
2. Organization, sometimes it is allot easier to find something I had posted than deal with the mess my files have become
   specially the SmallBASIC ones!
3. I may quit this pursuit for some time and it would be nice to pickup where I left off, (probably a sub point of 2.)
4. Every now and again a pro who has been here before me and has invaluable time saving advice to offer.
5. Reviewing my work in public has an honesty to myself sort of thing about it.
6. Yeah, might be a showing off kind of thing there too.

So for the record here is the SNH Interpreter, what does SNH mean?

Strings Now Handled!

Here is a sample program, a SmallBASIC program to compare it to and almost exactly the same output:
First the SmallBASIC program:
Code: [Select]
'The Rain in Spain test.bas for SmallBASIC 0.12.9 (B+=MGA) 2017-08-03
'This file is included to compare and contrast with the:
' test NOT INSTR1 INSTR2 2017-08-02 SNH.txt file in the
' distribution pack. This is the BASIC version of that code.

const  W = txtw("W") 'for simulating CTR in SNH Interpreter in the sub used here.

test = "In vain the rain in Spain falls mainly on the plain. What's to gain ?
lastSpacePosPlusOne = 1 'the start of the string
currentSpacePos = instr(test, " ")
while 1
  if NOT(currentSpacePos) then ' print word
    word = mid(test, lastSpacePosPlusOne)
    CP word
    exit loop
  else 'finish out
    word = mid(test, lastSpacePosPlusOne, currentSpacePos - lastSpacePosPlusOne)
    CP word
    lastSpacePosPlusOne = currentSpacePos + 1
    currentSpacePos = instr(lastSpacePosPlusOne, test, " ")
  fi
wend
CP "Done! B+"
pause

'this is built-in routine CTR for SNH Interpreter
sub CP(text)
  cellsPerLine = xmax/W
  spacesNeeded = (cellsPerLine - len(text))/2
  ? space(spacesNeeded) + text
end


The SNH program:
Code: [Select]
Oh! we might be able to place comments in the Data section after the
semi-colon, test that too!

pseudo-code

'setup for loop
27 = 1 start of line
17 = next space
Center print title
Center print Sentence 10
17 = instr1 10 16  first scan starts at 1
do
if not 17
14 = A24 mid1 10, 27
ctr print 14
exit loop
else
'17 = new loc
18 = 17 - 27
14 = A 25 mid2 10, 27, 18
A 20 ctr p 14
27 = 17 + 1
17 = instr2 27 10 16

end if
loop
A20 ctr p done B19 p
{9};dummy for Functions that don't return anything
{10}In vain the rain in Spain falls mainly on the plain. What's to gain ?;
{11}NOT; test function long over due!
{12}INSTR1; test this newer one
{13}INSTR2; and this newer one too
{14}; word place
{15}1; start an index with this
{16} ; this is a space, hopefully, what we will be searching for in 10
{17}; this is reserved for space locations
{18}; this is reserved for calc 17 - 27  then - 1 for mid section
{19}Done B+;
{20}CTR; the center print function
{22}Testing both MID, both INSTR, NOT and comments in data / memory section.;
{24}MID1;    2 para MID$ to end
{25}MID2;    3 para MID$ a section start and length
{27}1;  last space + 1
{0}
A20 B22 F9 P
B10 F9 P
A12 B10 C16 F17
[
A11 B17 F0
I
A24 B10 C27 F14
A20 B14 F9 P
X
E
A17 B27 ~ M18
A25 B10 C27 D18 F14
A20 B14 F9 P
A17 B15 + M27
A13 B27 C10 D16 F17
N
]
A20 B19 F9 P


Some notes, 3 part SNH program:
1. Until the first {###} all is comment. I find if I map out the code in basic first, it is easier to convert the variables and functions and data in the memory string array.

2. In the {###} section the memory location is the number inside the {} and the string contents from }  to ; are stored in an array. Comments can be fit between the ; and the next { bracket.

The second section is ended by {0} or {end} or anything that will evaluate to < 1.

3. Finally the 3rd section is the actual program part the processes the text into SmallBASIC commands to execute.
The 3rd section is stripped of all tabs, spaces, CRLF's so it's just letter, digits and symbols recognized by the interpreter.

Attached:
The .zip pack includes sample files tested when building the interpreter, the SmallBASIC.bas code for the interpreter and for the sample code above and a Read me SNH Interpreter.txt instruction document.

14
Offtopic / Re: WhatA Fu** they...
« on: 04. August 2017, 01:20:57 »
Hi Aurel,

No I have not received such an email. ;(

Why the FU** ? Is C++ normally free anyway?

Or do you know this is spam or worse?

15
Offtopic / Re: N54 trashing
« on: 31. July 2017, 15:39:51 »
Yeah, I look in there now and then.

You've seen HACKER? The guy won't let go, he is still posting about WHN? That was months ago!

I've seen it twice at JB and a recurring theme at 54.

Pages: [1] 2 3 ... 28