RetroBASIC
Basicprogramming(.org) => General questions and discussions => Topic started by: B+ on July 23, 2017, 08:10:48 AM
-
'BF in QB.bas for SmallBASIC 0.12.9 (B+=MGA) 2017-07-22
' I just translated some QB code from Rosetta to SmallBASIC
' and tested a couple of programs Hello World, Goodbye World
' count down also found at Rosetta Code.
CLS
memsize = 20000
instChars = "+-<>.,[]" 'valid characters
ptr = 0 'memory pointer
source = ""
INPUT "BF Filename (if blank will use lineput for program) ... "; filename
IF filename = "" THEN
? "Please enter the BF program line to intepret."
LINEINPUT source
ELSE
OPEN filename FOR INPUT AS #1
repeat
LINEINPUT #1, FLINE
source = source + FLINE
UNTIL EOF(1)
close #1
END IF
if len(source) < 1 then
? "No source code to BF."
pause
stop
'else
' ? source
end if
'let's clean the code up, check bracket balance
bktCnt = 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(instChars, char) THEN
code = code + char
'count brackets
IF char = "[" THEN bktCnt = bktCnt + 1
IF char = "]" THEN bktCnt = bktCnt - 1
END IF
NEXT
IF bktCnt THEN 'mismatched brackets
PRINT "Uneven brackets"
pause
stop
else
? "Code: ";code
END IF
'
DIM memory(memsize)
inLine = "" 'input buffer
FOR i = 1 TO LEN(code) 'loop through the code
instruction = MID(code, i, 1) 'get the instruction we're on
SELECT CASE instruction
CASE "+"
memory(ptr) = memory(ptr) + 1
CASE "-"
memory(ptr) = memory(ptr) - 1
CASE "."
PRINT CHR(memory(ptr));
CASE ","
IF inLine = "" THEN LINEINPUT inLine 'buffer input
inChar = LEFT(inLine, 1) 'take the first char off the buffer
inLine = MID(inLine, 2) 'delete it from the buffer
memory(ptr) = ASC(inChar) 'use it
CASE ">"
ptr = ptr + 1
IF ptr > 20000 THEN
PRINT "Memory pointer out of range"
pause
stop
END IF
CASE "<"
ptr = ptr - 1
IF ptr < 0 THEN
PRINT "Memory pointer out of range"
pause
stop
END IF
CASE "["
IF memory(ptr) = 0 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
END IF
CASE "]"
IF memory(ptr) <> 0 THEN
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
END IF
END SELECT
NEXT
?:? "done"
pause
Feel free to change memsize!
bf count down.txt
++++++++++++++++++++++++++++++++[>+>+<<-]>>+++++++++++++++++++++++++<<++++++++++[>>.-<.<-]
bf goodbye.txt
++++++++++[>+>+++>++++>+++++++>++++++++>+++++++++>++++++++++>+++++++++++>++++++++++++<<<<<<<<<-]>>>>+.>>>>+..<.<++++++++.>>>+.<<+.<<<<++++.<++.>>>+++++++.>>>.+++.<+++++++.--------.<<<<<+.<+++.---.
bf hello.txt
++++++++[>++++[>++>+++>+++>+<<<<-]>+>->+>>+[<]<-]>>.>>---.+++++++..+++.>.<<-.>.+++.------.--------.>+.>++.+++.
-
I wrote an interpreter in SpecBAS a while ago:
10 REM Brainfuck interpreter
20 c$="++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."
30 BANK NEW bfdat,32768: i=0,d=0,a$="<>+-.,[]"
40 i+=1: IF i>LEN c$ or not (c$(i) in a$) THEN STOP else go sub code c$(i): GO TO 40
43 v=PEEK(bfdat,d): INC v,1,0 TO 255: POKE bfdat,d,v: return
44 INPUT b$: POKE bfdat,d,CODE b$:return
45 LET v=PEEK(bfdat,d): DEC v,1,0 TO 255: POKE bfdat,d,v: return
46 PRINT CHR$(PEEK(bfdat,d));:return
60 d-=1:return
62 d+=1:return
91 IF PEEK(bfdat,d)=0 THEN b=1:GO SUB 300: end if: return
93 IF PEEK(bfdat,d)<>0 THEN b=1:GO SUB 400: end if: return
300 i+=1: IF i>LEN c$ THEN STOP ELSE IF c$(i)="[" THEN b+=1
310 IF c$(i)="]" THEN b-=1: IF b=0 THEN RETURN
320 GO TO 300
400 i-=1: IF i<1 THEN STOP ELSE IF c$(i)="]" THEN b+=1
410 IF c$(i)="[" THEN b-=1: IF b=0 THEN RETURN
420 GO TO 400
I'm not sure I can get it any smaller. Put your BF code into the c$ variable, and RUN to interpret.
-
Hi D,
That is one sweet little interpreter! Could it be the smallest Turing complete?
The question remains, How do I write programs that do things with these crazy simple interpreters.
Having only yesterday double translated BF, I have no clues but intend to look into the matter. A possible IDE?
-
To All,
I have started a little study of how to write a program in BF and was at once taken back by how tedious a project that might be!
Yikes! The rigmarole needed just to print one letter!
Already, I have written a transition program to eliminate counting how many + - < 0r > signs/commands you have to type in a row.
I have eliminated 2 commands and changed incrementing or decrementing the ptr with a @# command where # is a positive or negative integer.
Same deal with + - commands, replaced by ^# (^ sort of looks like delta), # again is a positive or negative integer.
I call the new Interpreter BQ for Brain Quickie or Be Quick (about it).
Hello World! program now looks like this:
^8[@1^4[@1^2@1^3@1^3@1^1@-4^-1]@1^1@1^-1@1^1@2^1[@-1]@-1^-1]@2.@2^-3.^7..^3.@1.@-2^-1.@1.^3.^-6.^-8.@1^1.@1^2.^3.
Ha! I thought it might be shorter but every single < has to be replaced by @-1 and single - replaced by ^-1, 1 for 3 is not good deal.
But at least you are saved from typing x amount of +-< or > in a row!
Alas, it also probably spoils the purity of BF with all the extra number characters added to a program.
'BQ Interpreter.bas for SmallBASIC 0.12.9 (B+=MGA) 2017-07-22
' try a little mod of the BF Interpreter
CLS
memsize = 20000
instChars = "^@.,[]-1234567890" 'valid characters
ptr = 0 'memory pointer
source = ""
INPUT "BQ Filename (if blank will use lineput for program) ... "; filename
IF filename = "" THEN
? "Please enter the BF program line to intepret."
LINEINPUT source
ELSE
OPEN filename FOR INPUT AS #1
repeat
LINEINPUT #1, FLINE
source = source + FLINE
UNTIL EOF(1)
close #1
END IF
if len(source) < 1 then
? "No source code to BF."
pause
stop
'else
' ? source
end if
'let's clean the code up, check bracket balance
bktCnt = 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(instChars, char) THEN
code = code + char
'count brackets
IF char = "[" THEN bktCnt = bktCnt + 1
IF char = "]" THEN bktCnt = bktCnt - 1
END IF
NEXT
IF bktCnt THEN 'mismatched brackets
PRINT "Uneven brackets"
pause
stop
else
? "Code: ";code
END IF
'
DIM memory(memsize)
inLine = "" 'input buffer
cmd = "" : ds = ""
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("^@.,[]", c) or i = len(code) then 'hit next command
if cmd <> "" then 'execute unfinished command
d = val(ds)
'exec last cmd
if cmd = "^" then memory(ptr) = memory(ptr) + d
if cmd = "@" then
ptr = ptr + d
if ptr < 0 or ptr > memsize then
? "Pointer out of range." : pause : stop
end if
end if
cmd = "" : ds = ""
end if
select case c
case "^" : cmd = "^"
case "@" : cmd = "@"
CASE "." : ? CHR(memory(ptr));
CASE ","
IF inLine = "" THEN LINEINPUT inLine 'buffer input
inChar = LEFT(inLine, 1) 'take the first char off the buffer
inLine = MID(inLine, 2) 'delete it from the buffer
memory(ptr) = ASC(inChar) 'use it
CASE "["
IF memory(ptr) = 0 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
END IF
CASE "]"
IF memory(ptr) <> 0 THEN
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
END IF
END SELECT
end if
NEXT
?:? "done"
pause
I call it transitional because I have an idea for two more commands to set ptr and memory values with absolute numbers instead of incrementing.
That! should save time and tedium.
They say BF is Turing Complete, so how is an IF THEN coded or decision branching handled? Seems to me that not only do you need a memory pointer, you need a program pointer.
-
Why has BASIC programming turned into a lets redefine the wheel again? Doesn't anyone like BASIC programming anymore? Is creating BASIC like interpreters what BASIC is all about?
Can you imagine 100 variations of QB or VB?
-
Why has BASIC programming turned into a lets redefine the wheel again? Doesn't anyone like BASIC programming anymore? Is creating BASIC like interpreters what BASIC is all about?
Can you imagine 100 variations of QB or VB?
Hi John,
I can't speak for anyone else but in my case it comes from hanging out with the wrong crowd. WHN? and Aurel are the main contagions. WHN? gets my interest up with a couple of challenges and meanwhile Aurel is trying to figure out PCP. I mean, I still love graphics programs, simple games, math puzzles... but I start to wonder about the very essence, the foundations, the simplest of beginnings of this marvelous and powerful tool we have at our fingertips. When one takes a bite from the fruit of the tree of knowledge there is no turning back, so sorry.
In short the devil made me do it!
-
... but I start to wonder about the very essence, the foundations, the simplest of beginnings of this marvelous and powerful tool we have at our fingertips.
I hear sincerity in your voice, B+, and I like it.
When one takes a bite from the fruit of the tree of knowledge there is no turning back, so sorry.
That's it! And life is so desperately short...
In short the devil made me do it!
Oh yeah, WHN? and Aurel. But there's also the bright side of the force. :)
-
Great to have you back Mike!
Your input is always appreciated.
-
That's it! And life is so desperately short...
Life moves pretty fast. If you don’t stop and look around once in awhile, you could miss it. ;)
-
Hi all, here is a teaser:
I have made such interesting improvements on BF > BQ (Be Quicker) > now EIN (Everything Is Number).
Only have 2 tests with baby EIN and just figured how to add some letter strings this morning.
The first screen shot tests 14 binary operations applied to 2 and 5.
The 2nd screen shot counts to 20 by 2's (the M6 is a dummy memory storage to prevent the print of an unwanted 0 after the count. I spent hours trying to figure out how to get rid of the bugger. Seems a dummy line patches the problem. I am going to translate into QB64 and/or JB to see what they do.)
In both screen shots the "program" is listed in the first line.
-
OK here is a very small very primitive Interpreter that I can actually write a program for like the Hi Lo Guessing Game:
IEN Hi Lo Game:P Z100 M4 Z1 A0 F3 A4 B3 * M3 Z2 A0 B3 F3 Z1 A0 B3 + M3
[ C69 C110 C116 C101 C114 C32 C97 C32 C103 C117 C101 C115 C115 C32 C102 C111 C114 C32 C109 C121 C32 C110 C117 C109 C98 C101 C114 C32 C98 C101 C116 C119 C101 C101 C110 C32 C49 C32 C97 C110 C100 C32 C49 C48 C48 C32 ?4
A4 B10 =
I
X
N
A4 B3 >
I
C72 C105 C103 C104 P
E
<
I
C76 C111 C119 P
E
C82 C105 C103 C104 C116 C33 P
X
N
N
P
]
The first line is creating a the number to guess. The 2nd line starts the loop with an INPUT Guess prompt. The rest is testing the guess and telling if High or Lo or Right! and Exiting. You also have the option to quit by just hitting Enter or 0 at the prompt.
In the output screen, the first 3 lines show the program stripped of all the stuff that makes it readable by humans, the string the Interpreter actually processes.
The zip pack conatins the Interpreter, 4 test files and these supplementary Help files:
Pack Contents.txt
Readme.txt
Asc Table.txt
Convert Strings.bas program to store code for stings into a file to copy / paste into a IEN program, saves a ton of time!
Sample of Converted strings.txt file used for the Hi Lo Game.
-
Here is the IEN (Is Everything Number) Interpreter:
'IEN Interpreter.bas for SmallBASIC 0.12.9 (B+=MGA) 2017-07-28 new name
memsize = 20000
DIM memory(memsize)
numChars = "-.1234567890"
cmdChars = "WC?ABZMIENP[X]F%^/*~+=<>()!&|"
allChars = numChars + cmdChars
while 1
color 0, 11 : cls
anyfile = files("IEN*.txt")
sort anyfile
? "EIN (Everything Is Numbered) Files:":?
if len(anyfile) > 0 then
for i = 0 to ubound(anyfile)
? i, anyfile(i)
next
? : input "Enter file NUMBER (any else quits) > ", flnm
if isnumber(flnm) then
if flnm >= 0 and flmn <=ubound(anyfile) then
getfile = anyfile(flnm)
tload getfile, source, 1
else
stop
end if
else
stop
end if
else
? "No files found" : source = ""
end if
color 7, 1 : cls
if source <> "" then
for i = 1 to len(source)
? mid(source, i, 1);
if i mod 60 = 0 then ?
next
?
end if
?:input "n(New) e(Edit) r(Run) k(Kill) q(Quits) other(Files)"; menu
select case ucase(left(menu,1))
case "N" : input "Enter a title, for *IEN + title + DATE.TXT* format ";tl
dt = right(date,4) + "-" + mid(date,4,2) + "-" + left(date,2)
fname = "IEN " + tl + " " + dt + ".txt"
OPEN fname FOR OUTPUT AS #1
CLOSE #1
RUN "notepad " + fname
case "E" : run "notepad "+ getfile
case "K" : kill getfile
case "Q" : end
case "R" : color 7, 0 : cls : runSource
end select
wend
SUB runSource
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
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
ERASE memory
DIM memory(memsize)
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" : memory(1) = memory(d)
CASE "B" : memory(2) = memory(d)
CASE "Z" : memory(0) = d
CASE "M" : memory(d) = memory(0)
CASE "F"
SELECT CASE memory(1)
CASE 0 : if memory(2) <> 0 then memory(d) = 0 else memory(d) = 1
CASE 1 : memory(d) = RND
CASE 2 : memory(d) = INT(memory(2))
END SELECT
CASE "W" : ? memory(d);
case "C" : ? chr(d);
CASE "?" : input test
if isstring(test) then test = val(test)
memory(d) = test
END SELECT
cmd = "" : ds = ""
END IF 'if cmd <> ""
'handle current cmd
IF INSTR("WC?ABZMF", c) THEN 'get d first
cmd = c
ELSEIF c = "I" : IF memory(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 '<<< ??? doesn't seem to matter i+1, i-1 or nothing
ELSEIF c = "%" THEN : memory(0) = memory(1) % memory(2)
ELSEIF c = "^" THEN : memory(0) = memory(1) ^ memory(2)
ELSEIF c = "/" THEN : memory(0) = memory(1) / memory(2)
ELSEIF c = "*" THEN : memory(0) = memory(1) * memory(2)
ELSEIF c = "~" THEN : memory(0) = memory(1) - memory(2)
ELSEIF c = "+" THEN : memory(0) = memory(1) + memory(2)
ELSEIF c = "=" THEN : memory(0) = memory(1) = memory(2)
ELSEIF c = "<" THEN : memory(0) = memory(1) < memory(2)
ELSEIF c = ">" THEN : memory(0) = memory(1) > memory(2)
ELSEIF c = "(" THEN : memory(0) = memory(1) <= memory(2)
ELSEIF c = ")" THEN : memory(0) = memory(1) >= memory(2)
ELSEIF c = "!" THEN : memory(0) = memory(1) <> memory(2)
ELSEIF c = "&" THEN : memory(0) = memory(1) and memory(2)
ELSEIF c = "|" THEN : memory(0) = memory(1) or memory(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
175 lines without EVAL or PCP... It only executes one line programs.
The first 50+ lines are doing IDE stuff.
-
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:
'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:
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.
-
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:
'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:
'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.
-
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.
'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
-
hi Mark
for testing i use LBB
well i agree JB is better than qb64 sdl-consoler
but i get only this:
-
;-)) 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.
-
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
-
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. ::)
-
yeah
they dont like lbb because is better than jb/lb