_TITLE "SB by bplus 2018-09-14" 'from BRUN v2? does not use the makeover eval function? '2018-02-13 adding string array functions put and get, a god awlful amount of shuffling values around to simulate a numneric array
'get takes numbers out of the string array (of numbers) and puts it in a number variable, a yucky hack! to get numeric arrays
'2018-02-05 BRUN started from Nano3 writtem in SmallBASIC
'added FB Eval modified for QB64
'2018-02-07 change the way variable assignments are made now n and s
'add theFile$ to BRUN title bar
'add cp to print in center of screen
'eliminate Dflag
'add locate = cr, mostly I want to just get to a row, let's call this row
'change variable assignment method and arrays and consts to manage
'modify record for number and string variables
'add lookup function
'more shared vaiables for processing in subs and functions
'TO DO
'add a bunch of string stuff space! I need space!
'separate area for error reporting and BRUN messaging
'colors 3 digit number toy rgb system
'ink for fore color statement
'paper for back color
'add line one graphic to do it all?
'readFile(lineNum), writeFile(lineNum)
'try to keep everything case insensitive including variables
debug = 0
'variable tables
DIM SHARED nName$
(nmax
), nValue
(nmax
), sName$
(smax
), sValue$
(smax
)
'for evaluate
EvalErr$ = ""
'for gosub
'for processing program lines
'integers for main
DIM theFile$
, fLine$
, temp$
, pLine$
, s$
, fw$
, es$
, value$
, wdx$
DIM v
, f
, ansY
, ansX
, ans
, nVal
'get started, do we have a program to run?
p$(lineCnt) = wPrep$(fLine$)
lineCnt = lineCnt + 1
'debug check p$() loaded
IF lineCnt
> 40 THEN nStop
= 40 ELSE nStop
= lineCnt
- 1 INPUT "Here is listing of first 40 lines, press enter for run..."; temp$
cl = 0 'current line
stackIndex = 0
pLine$ = p$(cl)
wc = wCnt(pLine$)
w$(i) = Wrd$(pLine$, i)
s$ = ""
v = 0
f = nLookUp%(w$(i), v)
temp$ = ""
f = sLookUp%(w$(i), temp$)
s$ = s$ + temp$
s$ = s$ + w$(i) + " "
s$ = ""
v = 0
f = nLookUp%(w$(i), v)
ansY = Evaluate(w$(2))
ansX = Evaluate(w$(3))
PRINT "Evaluate Error: "; EvalErr$;
" occured on line "; cl
s$ = ""
v = 0
f = nLookUp%(w$(i), v)
ansX = Evaluate(w$(2))
ansY = Evaluate(w$(3))
PRINT "Evaluate Error: "; EvalErr$;
" occured on line "; cl
s$ = ""
v = 0: f = 0
f = nLookUp%(w$(i), v)
ans = Evaluate(temp$)
nRecord w$(2), ans
PRINT "Evaluate Error: "; EvalErr$;
" occured on line "; cl
f = 0
c = 1: f = 0
fw$ = Wrd$(p$(i), 1)
c = c - 1
c = c + 1
PRINT "Error: could not find do to match loop on line "; cl
c = 1: f = 0
fw$ = Wrd$(p$(i), 1)
c = c - 1
c = c + 1
PRINT "Error: could not find loop to match exit on line "; cl
es$ = ""
es$ = es$ + w$(i) + " "
'PRINT "evaluate this "; es$
ans = Evaluate(es$)
'PRINT "evaluated to "; ans
cl = find(cl)
PRINT "Evaluate Error: "; EvalErr$;
" occured on line "; cl
cl = find(cl)
f = 0
PRINT "Could not find return for sub at line "; cl
f = 0
PRINT "Error: could not find sub "; w$
(2) stack(stackIndex) = cl: cl = i: stackIndex = stackIndex + 1
stackIndex = stackIndex - 1
cl = stack(stackIndex): stack(stackIndex) = 0
es$ = ""
es$ = es$ + w$(i) + " "
ans = Evaluate(es$)
nRecord w$(2), ans
PRINT "Evaluate Error: "; EvalErr$;
" occured on line "; cl
CASE "$" 'record literal strings to variables here es$ = rightOf$(p$(cl), "{")
es$ = leftOf$(es$, "}")
sRecord w$(2), es$
CASE "sf" 'string functions syntax: sf var sFunction parameters, according to function var will be string or number CASE "+" 'concant string varaible values temp$ = ""
IF sLookUp%
(w$
(i
), s$
) > 0 THEN temp$
= temp$
+ s$
sRecord w$(2), temp$
OK% = sLookUp%(w$(4), s$)
sRecord w$(2), Wrd$(s$, v)
PRINT "word error: could not get " + w$
(5) + " word from variable " + w$
(4)
CASE ">" 'into variable name at w$(2) at nplace w$(3) the str$ value of w$(4) +.... 'This sub stores into the w$(2) string variable (whether it exists or not)
' the value built up from w$(4) ++++ and made a string
' to the variable value at word location value of w$(3) a number variable
' the w$(3) value must be an existing n variable name
es$ = ""
es$ = es$ + w$(i) + " "
'PRINT "evaluate this "; es$
ans = Evaluate(es$)
'PRINT "evaluated to "; ans
PRINT "Evaluate Error: "; EvalErr$;
" occured on line "; cl
CASE "<" ' put into var at w$(2) from array w$(3) at array index w$(4) 'briefly pull a number in string array stored as string and store value into variableat w$(2)
' this sub retrieves the word at w$(4) a number variable
' from the string variable at w$(3)
' and stores the value in number variable w$(2)
value$ = ""
OK% = sLookUp%(w$(3), value$)
nVal = 0
OK% = nLookUp%(w$(4), nVal)
wdx$ = Wrd$(value$, nVal)
PRINT "Could not find number variable "; w$
(4);
" in line"; cl:
EXIT WHILE
PRINT " Here is number table:" PRINT " Here is strings tables:" INPUT "OK line processed "; OK
cl = cl + 1
PRINT "Drag drop a *SB.txt file onto SB.exe to run."
FUNCTION wPut%
(sVar$
, nVar$
, value$
) ' nVar$ must exist "Put" 'into variable name at w$(2) at nplace w$(3) the value at w$(4) 'if this function fails return false else return 1
nValue = 0
OK = nLookUp%(nVar$, nValue)
sVal$ = ""
OK = sLookUp%(sVar$, sVal$)
b$ = ""
IF OK
= 0 THEN 'no string var started b$ = b$ + "`" + " "
b$ = b$ + value$
sRecord sVar$, b$
wPut% = 1
ELSE 'sVar$ started so get the string count and put the value in it or at end of it in position nValue wc = wCnt(sVal$)
IF nValue
> wc
THEN 'new value is past current size b$ = sVal$ + " "
FOR i
= wc
+ 1 TO nValue
- 1 b$ = b$ + "`" + " "
b$ = b$ + value$
sRecord sVar$, b$
wPut% = 1
ELSE 'new value replaces one in string IF i
<> nValue
THEN b$
= b$
+ Wrd$
(sVal$
, i
) + " " ELSE b$
= b$
+ value$
+ " " wPut% = 1
c = 1
fw$ = Wrd$(p$(i), 1)
c = c - 1
c = c + 1
PRINT "Error: could not find e or f to match i in line "; ln
find = -1
mt = -1
IF mt
<> -1 THEN nName$
(mt
) = ln$: nValue
(mt
) = value
value = -999: nLookUp% = 0
mt = -1
FOR i
= 0 TO smax
'check if name is used yet, if so set value$ to it IF sName$
(i
) = "" AND mt
= -1 THEN mt
= i
'save the first open slot in case we need it IF mt
<> -1 THEN sName$
(mt
) = ln$: sValue$
(mt
) = value$
value$ = "": sLookUp% = 0
'this preps e$ string for actual evaluation function and makes call to it,
'checks results for error returns that or number if no error.
'Dim As String c, b, subst
DIM b$
, c$
, subst$
, wd$
, fun$
b$ = "" 'rebuild string with padded spaces
'this makes sure ( ) + * / % ^ are wrapped with spaces, on your own with - sign
FOR i
= 1 TO LEN(e$
) 'filter chars and count () po = po - 1: b$ = b$ + " ) "
po = po + 1: b$ = b$ + " ( "
b$ = b$ + " " + c$ + " "
ELSEIF INSTR(" -.0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz<>=", c$
) > 0 THEN b$ = b$ + c$
e$ = wPrep$(b$)
p
= wIn
(LCASE$(e$
), Wrd$
("rnd e pi", i
)) e$ = wSubst$(e$, p, p, subst$)
p
= wIn
(LCASE$(e$
), Wrd
("rnd e pi", i
)) wc = wCnt(e$)
b$ = ""
wd$ = Wrd$(e$, i)
v = 0
f = nLookUp%(wd$, v)
IF debug
THEN PRINT "nLookup of "; wd$;
" found:"; f;
" value "; v
Evaluate = evalW(e$)
' the recursive part of EVAL, eliminated DFlag, now check lcase$ of fun$
'Dim As String fun, w, test, inner, ops, op, middle
DIM fun$
, test$
, inner$
, w$
, ops$
, op$
, middle$
IF debug
THEN PRINT "EvalW gets: "; s$
'debug or fun$ to watch recursive calls in reverse
pop = wIn(s$, "(") 'parenthesis open place
fun$ = "": lPlace = 1
test$
= LCASE$(Wrd$
(s$
, pop
- 1)) funPlace = wIn("int sin cos tan atan log exp sqr rad deg", test$) 'no asin or acos in QB64
fun$ = test$: lPlace = pop - 1
fun$ = "": lPlace = pop
wc = wCnt(s$): po = 1
IF Wrd$
(s$
, i
) = "(" THEN po
= po
+ 1 IF Wrd$
(s$
, i
) = ")" THEN po
= po
- 1 inner$ = ""
FOR i
= (pop
+ 1) TO (rPlace
- 1) w$ = Wrd$(s$, i)
inner$ = inner$ + w$ + " "
IF wIn
("( and or = < > <= >= <> + - * / % ^", w$
) > 0 THEN recurs
= 1 'QB64 doesn't have these?
'CASE "asin": IF DFlag THEN m = DEG * (Asin(innerV)) ELSE m = Asin(innerV)
' CASE "acos": IF DFlag THEN m = DEG * (acos(innerV)) ELSE m = acos(innerV)
CASE "exp" 'the error limit is inconsistent in JB IF -745 <= innerV
AND innerV
<= 709 THEN 'your system may have different results 'what the heck???? 708 works fine all alone as limit ?????
EvalErr$
= "EXP(n) only works for n = -745 to 709.":
EXIT FUNCTION EvalErr$
= "SQR only works for numbers >= 0.":
EXIT FUNCTION CASE "rad": m
= innerV
* RAD
CASE "deg": m
= innerV
* DEG
pop = wIn(s$, "(")
ops$ = "% ^ / * - + = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)
op$ = Wrd$(ops$, o)
p = wIn(s$, op$)
EvalErr$ = "For a Mod b, b value < 2."
EvalErr$ = "For a ^ b, a needs to be >= 0 when b not integer."
EvalErr$ = "Div by 0"
CASE "not":
IF b
= 0 THEN middle$
= "1" ELSE middle$
= "0" 'use b as nothing should be left of not s$ = wSubst$(s$, p - 1, p + 1, middle$)
'PRINT s$
p = wIn(s$, op$)
'return trimmed source string s with one space between each word
'remove all double or more spaces
b$ = ""
wPrep$ = b$
' This duplicates JB word(string, wordNumber) base 1, space as default delimiter
' by returning the Nth word of source string s
' this function assumes s has been through wPrep
s$ = ss$ 'don't change ss$
w$ = "": c = 1
w$ = "": c = c + 1
'This function counts the words in source string s
'this function assumes s has been thru wPrep
's = wPrep(s)
c
= 1: p
= 1: ip
= INSTR(p
, s$
, " ") c
= c
+ 1: p
= ip
+ 1: ip
= INSTR(p
, s$
, " ") wCnt = c
'Where is word In source s, 0 = Not In source
'this function assumes s has been thru wPrep
wc = wCnt(s$): wIn = 0
' substitute string in s to replace section first to last words inclusive
'this function assumes s has been thru wPrep
FUNCTION wSubst$
(s$
, first
, last
, subst$
) wc = wCnt(s$): b$ = ""
IF first
<= i
AND i
<= last
THEN 'do this only once! IF subF
= 0 THEN b$
= b$
+ subst$
+ " ": subF
= 1 b$ = b$ + Wrd$(s$, i) + " "
posOf
= INSTR(source$
, of$
) IF posOf
> 0 THEN leftOf$
= MID$(source$
, 1, posOf
- 1)
posOf
= INSTR(source$
, of$
)
