Author Topic: Can you write a program for this Interpreter?  (Read 354 times)

B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Can you write a program for this Interpreter?
« on: 23. July 2017, 10:10:48 »
Code: [Select]
'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
++++++++[>++++[>++>+++>+++>+<<<<-]>+>->+>>+[<]<-]>>.>>---.+++++++..+++.>.<<-.>.+++.------.--------.>+.>++.+++.
« Last Edit: 23. July 2017, 10:18:42 by B+ »

ZXDunny

  • Full Member
  • ***
  • Posts: 130
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #1 on: 23. July 2017, 11:58:13 »
I wrote an interpreter in SpecBAS a while ago:

Code: [Select]
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.

B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #2 on: 23. July 2017, 18:20:49 »
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?

B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #3 on: 24. July 2017, 18:32:44 »
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.

Code: [Select]
'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.

John

  • Sr. Member
  • ****
  • Posts: 361
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #4 on: 24. July 2017, 19:14:23 »
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?

B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #5 on: 25. July 2017, 00:02:19 »
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!

Mike Lobanovsky

  • Full Member
  • ***
  • Posts: 161
    • View Profile
    • Freestyle BASIC Script Language
Re: Can you write a program for this Interpreter?
« Reply #6 on: 25. July 2017, 09:30:35 »
... 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.

Quote
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...

Quote
In short the devil made me do it!

Oh yeah, WHN? and Aurel. But there's also the bright side of the force. :)
Mike
____________________________________________________________________________________________
(3.6GHz i5-3470, 16GB RAM / 2 x nVidia GTX 650Ti SLI-bridged, 2GB VRAM / x64 Win 7, x86 elementaryOS Luna)

John

  • Sr. Member
  • ****
  • Posts: 361
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #7 on: 25. July 2017, 18:32:40 »
Great to have you back Mike!

Your input is always appreciated.


Cybermonkey

  • Administrator
  • Hero Member
  • *****
  • Posts: 574
    • View Profile
    • Home of EGSL
Re: Can you write a program for this Interpreter?
« Reply #8 on: 26. July 2017, 17:27:15 »
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.  ;)
Best regards,
Cybermonkey

B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #9 on: 27. July 2017, 16:10:22 »
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.


B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #10 on: 29. July 2017, 05:13:43 »
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:
Code: [Select]
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.
« Last Edit: 29. July 2017, 05:37:37 by B+ »

B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #11 on: 29. July 2017, 05:20:24 »
Here is the IEN (Is Everything Number) Interpreter:
Code: [Select]
'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.
« Last Edit: 29. July 2017, 05:26:06 by B+ »

B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #12 on: 04. August 2017, 02:16:23 »
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.
« Last Edit: 04. August 2017, 02:23:45 by B+ »

B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #13 on: 04. August 2017, 02:31:32 »
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.

B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Re: Can you write a program for this Interpreter?
« Reply #14 on: 07. August 2017, 05:45:26 »
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

« Last Edit: 07. August 2017, 05:50:04 by B+ »