I was wondering if there are any good expression evaluators floating around for EBasic.
I've searched the forum, but to no avail.
If there aren't, any tips on how to make one?
Otherwise, I'll be porting one from some vb6 code i've found...
Thanks!
Here's one Joske wrote 4-5 years ago.
Larry
/*
Expression Evaluator, based on the evaluator of SpeQ
Supports:
Operators + - * / ^E
Parentheses ( )
All common scientific funcions like Sin(), Cos(), Sqrt(), ...
You can define your own variables
by: Jos de Jong, wjosdejong@hotmail.com
*/
AUTODEFINE "OFF"
STRING varname[99] :'all built-in variables and variables created by user
DOUBLE varvalue[99]
INT varcount
STRING funcname[34] :'all built-in functions (sin, cos, ...)
INT funccount
STRING reserved_name[10] :'reserved names like "Angles", "Deg", "Rad", ...
INT reserved_name_count
STRING angles
STRING msg :'a (error)message
'the string msg overrules the answer of an expression.
'If it is not empty, it will be displayed instead of the answer
'msg can contain an error message or other messages
const ctlinput = 1
const ctlhistory = 2
'THE MAIN WINDOW
Def main:window
OPENWINDOW main,-400,100,550,350,@minbox |@maxbox |@size, 0, "Expression Evaluator", &mainroutine
'THE HISTORYBOX
control main, @richedit, "", -100,0,100,100, @BORDER| @CTEDITMULTI |@VSCROLL |@CTEDITAUTOV|@CTEDITAUTOH |@HSCROLL| @VSCROLL |@CTEDITRO, ctlhistory
SETCONTROLNOTIFY main, ctlhistory, TRUE, TRUE
setfont main, "verdana", 10, 400, 0, ctlhistory
add_text("Expression Evaluator" + "")
add_text("Created with IBasic Professional by Jos de Jong, 2005" + "")
add_text("Type \"Help <Enter>\" for help")
'THE INPUTBOX
control main, @richedit, "", -100,100,100,25, @BORDER, ctlinput
SETCONTROLNOTIFY main, ctlinput, TRUE, TRUE
controlcmd main, ctlinput, @RTSETLIMITTEXT, 255
setfont main, "verdana", 10, 400, 0, ctlinput
init_arrays()
resizewin()
setfocus main,ctlinput
waituntil main.hwnd=0
END
'_______________________________________________________________
sub mainroutine
string expression, result
int length
select @MESSAGE
case @IDCREATE
centerwindow main
case @IDSIZE
resizewin()
case @IDCLOSEWINDOW
closewindow Main
case @IDCONTROL
if @CONTROLID=ctlinput
if @NOTIFYCODE = @ENENTERKEY
'user pressed Enter
expression = getcontroltext(main, ctlinput) :'read text in inputbox
setcontroltext main,ctlinput,"" :'clear the inputbox
if trim(UCASE$(expression)) = "HELP" then
'show help
display_help()
else
'evaluate the expression and add results to the historybox
result = ""+ expression + "\t" + eval_line(expression)
add_text(result)
setfocus main,ctlinput
endif
endif
if @NOTIFYCODE = @ENTABKEY THEN SETFOCUS main, ctlhistory
endif
if @CONTROLID=ctlhistory
if @NOTIFYCODE = @ENTABKEY THEN SETFOCUS main, ctlinput
endif
endselect
return
endsub
'_________________________________________________________________
sub resizewin()
'this sub resizes the content of the window main such that it fits in the clientwindow
int l,t,w,h
getclientsize main, l,t,w,h
setsize main, 0,0, w,h-26, ctlhistory
setsize main, 0,h-26,w,26, ctlinput
return
endsub
'_______________________________________________________________
SUB eval_line(expression:STRING), STRING
'this sub evaluates the expression and returns a string that
'can contain the answer or an (error) message.
'the expression can have
' variable definition like "myvar=expr"
' special commands like "angles=rad" and "Clear"
DOUBLE ans
STRING expr
msg=""
expr=expression
IF LTRIM$(expr)="" THEN expr = "Ans"
'check parentheses
IF isok_parentheses(expr)=FALSE THEN ert("Error: Incorrect use of parentheses ( )")
'check for special inputs
IF LCASE$(trim(expr))="clear": clear_memory(): ert("Memory cleared"):RETURN msg: ENDIF
IF LCASE$(trim(expr))="angles": ert("Angles = " + angles):RETURN msg: ENDIF
IF INSTR(expr,"=")>0
'there is a (new) variable defined, for example "myvar = expr"
ans = add_variable(expr)
ELSE
'evaluate the expression
ans = eval(expr)
ENDIF
IF msg<>"" THEN RETURN msg :'return (error) message if not empty
add_variable_name("Ans")
add_variable_value("Ans", ans)
RETURN get_variable_def(expr) + " = " + notation(ans) :'return the answer
ENDSUB
'_______________________________________________________________
SUB eval(expression:STRING), DOUBLE
'evaluate the expression expr.
'The expression can contain operators, values, variables, functions, parentheses, spaces
'Input: a string containing an expression
'Output: a double, containing the answer of the expression.
STRING expr, op
INT n, i
DOUBLE value1, value2, res
expr = trim(expression) :'copy the expression to another to keep the original string intact
'write logfile, "New Expression: {" + expr + "}"
'check if expr is equal to a value. If so, return the value of expr
IF isok_value(trim(expr))=TRUE THEN RETURN val(trim(expr))
'check for the operator with the lowest precedence (outside parentheses), and evalulate it
'order (from low to high): + - * / ^ E
FOR i=1 TO 6
op = MID$("+-*/^E", i, 1)
n=instrP(UCASE$(expr), op)
WHILE n>0
IF isok_operator(expr,op,n)=TRUE
'this is indeed an operator. evaluate it
IF n=1: ert("Error: Missing value before operator " + op): RETURN 0: ENDIF
IF n=LEN(expr): ert("Error: Missing value after operator " + op):RETURN 0: ENDIF
IF op="E"
IF MID$(expr,n+1,1)="+" THEN REPLACE$(expr,n+1,1," ") :'replace "2e+3" with "2e 3" (remove unary plus)
ENDIF
value1 = eval(LEFT$(expr,n-1))
value2 = eval(RIGHT$(expr,LEN(expr)-n))
IF op ="+" THEN res = value1 + value2
IF op ="-" THEN res = value1 - value2
IF op ="*" THEN res = value1 * value2
IF op ="/"
IF value2=0: ert("Error: Divide by zero") :RETURN 0 :ENDIF
res = value1 / value2
ENDIF
IF op ="^" THEN res = value1 ^ value2
IF op ="E" THEN res = value1 * 10^value2
IF USING("%d#.####", res)="1.#INF": ert("Error: Overflow"): RETURN 0: ENDIF :'the value is infinite
RETURN res
ENDIF
IF n>0 THEN n=instrP(UCASE$(expr), op, n-1) :'search for previous operator
ENDWHILE
NEXT i
'if there is no operator found in expr, then expr must be an variablename or function
IF INSTR(expr,"(")>0
'expr is a function
STRING func
n = INSTR(expr,"(")
func = LEFT$(expr, n-1)
'check parentheses at start and end, for example "(2+3)"
IF n=1 THEN RETURN eval(MID$(expr,2,LEN(expr)-2))
'built-in functions like sin(), cos()
expr = MID$(expr, LEN(func)+2, LEN(expr)-LEN(func)-2) /* extract the part between the parenthesis of the function */
RETURN eval_function(func, expr)
ENDIF
'expr must be a variablename
'check if expr is equal to a variablename or -variablename.
FOR n=0 TO varcount-1
IF UCASE$(expr)=UCASE$(varname[n]) THEN RETURN varvalue[n]
IF UCASE$(expr)=UCASE$("-"+varname[n]) THEN RETURN -varvalue[n]
NEXT n
'if still not evalved, then return an error
IF isok_varname(expr)
ert("Error: Unknown variable " + expr)
ELSE
ert("Error: Syntax error in part '" + expr + "'")
ENDIF
RETURN 0
ENDSUB
'_______________________________________________________________
SUB isok_operator(expr:STRING, op:CHAR, n:CHAR), CHAR
'this sub checks of the operator at postion i in expr is a legal operator
'for example the "+" in "2.3E+3" is no operator, and the "-" in "-2.5" is no operator but a unary minus
STRING sign2
IF op="+"
IF UCASE$(MID$(expr,n-1,1))="E"
IF n>2
IF INSTR("1234567890.", MID$(expr,n-2,1))>0 THEN RETURN FALSE
ENDIF
ENDIF
ENDIF
IF op="-"
IF n=1
'this is an unary minus
RETURN FALSE
ELSE
'check for an unary minus (for example 2*-3 or 2.5E-6)
sign2 = LEFT$(expr,n-1)
sign2 = RTRIM$(sign2)
sign2 = RIGHT$(sign2,1)
IF INSTR("+-/*^", sign2)>0 THEN RETURN FALSE
IF UCASE$(MID$(expr,n-1,1))="E"
IF n>2
IF INSTR("1234567890.", MID$(expr,n-2,1))>0 THEN RETURN FALSE
ENDIF
ENDIF
ENDIF
ENDIF
IF op="E"
IF n=1
RETURN FALSE
ELSE
'if left or right from this sign is another operator or end of expression, then E is no operator but a variable
IF INSTR("1234567890.", MID$(expr,n-1,1))=0 THEN RETURN FALSE
IF n=LEN(expr) THEN RETURN FALSE
IF n<len(expr)
IF INSTR("1234567890.-+", MID$(expr,n+1,1))=0 THEN RETURN FALSE
ENDIF
ENDIF
ENDIF
RETURN TRUE
ENDSUB
'_______________________________________________________________
SUB isok_value(expr:STRING), CHAR
'this sub checks if expr is a legal value. if so, returns true. if not, returns false
INT i
STRING sign
FOR i=1 TO LEN(expr)
sign = UCASE$(MID$(expr,i,1))
IF INSTR("1234567890.-", sign)=0 THEN RETURN FALSE :'check for legal signs in the string
IF sign="." THEN IF INSTR(expr,".",i+1)>0 THEN RETURN FALSE :'check if there is max. 1 point in the string
IF sign="-" THEN IF i<>1 THEN RETURN FALSE :'check for correct use of minus: only at position 1
NEXT i
RETURN TRUE
ENDSUB
'__________________________________________________________________
SUB isok_parentheses(expr:STRING), CHAR
'this sub checks if there is no syntax error in use of parentheses
'returns true if correct, returns false if incorrect
INT i, bo, bc
STRING sign
bo = 0: bc = 0
FOR i = 1 TO LEN(expr)
sign = MID$(expr, i, 1)
IF sign = "(" THEN bo++ :'number of parentheses opened
IF sign = ")" THEN bc++ :'number of parentheses closed
IF bc > bo: RETURN FALSE: ENDIF
NEXT i
IF bc <> bo: RETURN FALSE: ENDIF
RETURN TRUE
ENDSUB
'__________________________________________________________________
SUB ert(newmsg:STRING)
'prevent that a new message overwrites the first (error)message
IF msg="" THEN msg=newmsg
RETURN
ENDSUB
'__________________________________________________________________
SUB trim(mystr:STRING),STRING
'remove spaces and tabs at start and end of the string
RETURN LTRIM$(RTRIM$(mystr))
ENDSUB
'__________________________________________________________________
SUB get_variable_def(expr:STRING),STRING
'this sub returs the variable name that is defined in expr. if no variable is definded, then returns "Ans"
'for example "B = 4.5" will return "B"
STRING varname
INT i
i = INSTR(expr,"=")
IF i>0 then return trim(LEFT$(expr,i-1))
RETURN "Ans"
ENDSUB
'__________________________________________________________________
SUB add_variable(expr:STRING),DOUBLE
'this sub add a variable in the expression to the array.
'returns the new value of the variable
DOUBLE newvarvalue :newvarvalue=0
STRING newvarname
INT n
n = INSTR(expr,"=")
IF n=0: ert("Error: Can not add empty variablename"): RETURN 0: ENDIF
'extract the name and the value parts out of the expression
newvarname = trim(LEFT$(expr,n-1))
'check for some special (system) variables
IF LCASE$(newvarname)="angles": set_angles(trim(RIGHT$(expr,LEN(expr)-n))) :RETURN 0 :ENDIF
IF LCASE$(newvarname)="ans" THEN newvarname = "Ans"
IF isok_varname(newvarname)=FALSE: ert("Error: The variable "+newvarname + " is forbidden to redefine"):RETURN 0: ENDIF
newvarvalue = eval(RIGHT$(expr,LEN(expr)-n))
add_variable_name(newvarname)
add_variable_value(newvarname, newvarvalue)
add_variable_name("Ans")
add_variable_value("Ans", newvarvalue)
RETURN newvarvalue
ENDSUB
'__________________________________________________________________
SUB add_variable_name(newvarname AS STRING)
'this sub adds varname to the array varvalues[] if it not already exists
INT n
'check if the variable already exists
FOR n=0 TO varcount-1
IF UCASE$(newvarname)=UCASE$(varname[n]):
varname[n] = newvarname: RETURN
ENDIF
NEXT n
'else add the variable
IF varcount>=99-1: ert("Error: Maximum number of variables exeeded"): RETURN 0: ENDIF
varname[varcount] = newvarname
varvalue[varcount] = 0
varcount++
RETURN
ENDSUB
'__________________________________________________________________
SUB add_variable_value(newvarname AS STRING, newvarvalue AS DOUBLE)
'this sub fills in the new value to varname in the array varvalues[]
INT n
FOR n=0 TO varcount-1
IF UCASE$(newvarname)=UCASE$(varname[n])
varvalue[n] = newvarvalue
RETURN
ENDIF
NEXT n
RETURN
ENDSUB
'__________________________________________________________________
SUB isok_varname(name:STRING),INT
'check if name is legal to use as variable name
'if so, returns true, if not the sub returns false
INT i
STRING sign, sign2
FOR i=1 TO LEN(name)
sign = UCASE$(MID$(name,i,1))
IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ_1234567890[]", sign)=0 THEN RETURN FALSE
IF INSTR("1234567890", sign)>0
IF i=1 THEN RETURN FALSE :'numbers not allowed at the first position of a varname
IF i<len(name)
'numbers in a variable name are only alowed at the end
sign2 = UCASE$(MID$(name,i+1,1))
IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ",sign2)>0 THEN RETURN FALSE
ENDIF
ENDIF
NEXT i
'the reserved names are forbidden to redefine
FOR i=0 TO reserved_name_count-1
IF LCASE$(reserved_name[i]) = LCASE$(name) THEN RETURN FALSE
NEXT i
'functionnames are also forbidden to use as variable name
FOR i=0 TO funccount-1
IF LCASE$(funcname[i]) = LCASE$(name) THEN RETURN FALSE
NEXT i
RETURN TRUE
ENDSUB
'__________________________________________________________________
SUB eval_function(name:STRING, expr:STRING),DOUBLE
'evaluate the function in name for expr. for example name="Sin" and expr="0.25 * Pi"
'Uses the global variable angles
STRING function
DOUBLE value, result, pi, factor
INT n
pi = 4*ATAN(1)
factor = 1
function = UCASE$(name)
'radians, degrees or gradians:
IF UCASE$(angles) = "RAD" THEN factor = 1
IF UCASE$(angles) = "DEG" THEN factor = 360 / (2 * Pi)
IF UCASE$(angles) = "GRAD" THEN factor = 400 / (2 * Pi)
SELECT function
'for example -(3/2+1)
CASE "-"
RETURN -eval(expr)
'COMMON FUNCTIONS
CASE "LOG"
value = eval(expr)
IF value<=0: ert("Error: Log("+expr+") outside domain (0,infinity]"): RETURN 0: ENDIF
RETURN LOG10(value)
CASE "LN"
value = eval(expr)
IF value<=0: ert("Error: Ln("+expr+") outside domain (0,infinity]"): RETURN 0: ENDIF
RETURN LOG(value)
CASE "SQRT"
value = eval(expr)
IF value<0: ert("Error: Sqrt("+expr+") gives an unreal answer"): RETURN 0: ENDIF
RETURN SQRT(value)
CASE "EXP"
RETURN EXP(eval(expr))
CASE "ABS"
RETURN ABS(eval(expr))
'TRIGOMOMETRICAL FUNCTIONS
CASE "SIN"
value = eval(expr)
value /= factor
value = reduce_angle(value)
IF ABS(value) < 10^-14 THEN RETURN 0
IF ABS(value - Pi) < 10^-14 THEN RETURN 0
IF ABS(value - 2*Pi) < 10^-14 THEN RETURN 0
RETURN SIN(value)
CASE "COS"
value = eval(expr)
value /= factor
value = reduce_angle(value)
IF ABS(value - .5*Pi) < 10^-14 THEN RETURN 0
IF ABS(value - 1.5*Pi) < 10^-14 THEN RETURN 0
RETURN COS(value)
CASE "TAN"
value = eval(expr)
value /= factor
value = reduce_angle(value)
IF ABS(value - .5*Pi) < 10^-14 THEN ert("Error: Asymptote in Tan("+expr+")")
IF ABS(value - 1.5*Pi) < 10^-14 THEN ert("Error: Asymptote in Tan("+expr+")")
IF ABS(value) < 10^-14 THEN RETURN 0
IF ABS(value - Pi) < 10^-14 THEN RETURN 0
IF ABS(value - 2*Pi) < 10^-14 THEN RETURN 0
RETURN SIN(value) / COS(value)
CASE "ARCSIN"
value = eval(expr)
IF ABS(value) < 1 THEN result = ASIN(value)
IF ABS(value) = 1 THEN result = value * 0.5 * Pi
IF ABS(value) > 1: ert("Error: ArcSin("+expr+") outside domain [-1,1]"): RETURN 0: ENDIF
RETURN factor * result
CASE "ARCCOS"
value = eval(expr)
IF ABS(value) > 1: ert("Error: ArcCos("+expr+") outside domain [-1,1]"): RETURN 0: ENDIF
IF value = -1 THEN RETURN factor * Pi
IF value = 1 THEN RETURN 0
IF ABS(value) < 1 THEN RETURN factor * ACOS(value)
CASE "ARCTAN"
value = eval(expr)
RETURN factor * ATAN(value)
CASE "CSC"
value = eval(expr)
value = reduce_angle(value)
IF ABS(value) < 10^-14: ert("Error: Asymptote in Csc("+expr+")"): RETURN 0: ENDIF
IF ABS(value - Pi) < 10^-14: ert("Error: Asymptote in Csc("+expr+")"): RETURN 0: ENDIF
RETURN 1/SIN(value)
CASE "SEC"
value = eval(expr)
value = reduce_angle(value)
IF ABS(value - .5*Pi) < 10^-14: ert("Error: Asymptote in Sec("+expr+")"): RETURN 0: ENDIF
IF ABS(value - 1.5*Pi) < 10^-14: ert("Error: Asymptote in Sec("+expr+")"): RETURN 0: ENDIF
RETURN 1/COS(value)
CASE "COT"
value = eval(expr)
value = reduce_angle(value)
IF ABS(value) < 10^-14: ert("Error: Asymptote in Cot("+expr+")"): RETURN 0: ENDIF
IF ABS(value - Pi) < 10^-14: ert("Error: Asymptote in Cot("+expr+")"): RETURN 0: ENDIF
IF ABS(value - .5*Pi) < 10^-14 THEN RETURN 0
IF ABS(value - 1.5*Pi) < 10^-14 THEN RETURN 0
RETURN 1/TAN(value)
'HYPERBOLIC FUNCTIONS
CASE "SINH"
value = eval(expr)
RETURN (EXP(value) - EXP(-value)) / 2
CASE "COSH"
value = eval(expr)
RETURN (EXP(value) + EXP(-value)) / 2
CASE "TANH"
value = eval(expr)
RETURN (EXP(value) - EXP(-value)) / (EXP(value) + EXP(-value))
CASE "CSCH"
value = eval(expr)
IF value=0: ert("Error: Asymptote in Csch(0)"):RETURN 0: ENDIF
RETURN 2 / (EXP(value) - EXP(-value))
CASE "SECH"
value = eval(expr)
RETURN 2 / (EXP(value) + EXP(-value))
CASE "COTH"
value = eval(expr)
IF value=0: ERT("Error: Asymptote in Coth(0)"):RETURN 0: ENDIF
RETURN (EXP(value) + EXP(-value)) / (EXP(value) - EXP(-value))
ENDSELECT
ert("Error: Unknown function " + name + "( )")
RETURN 0
ENDSUB
'__________________________________________________________________
SUB reduce_angle(value:DOUBLE), DOUBLE
'this sub reduces the value of the given angle to the range of [0, 2*Pi)
DOUBLE Pi:Pi=4*ATAN(1)
IF value >= 2*Pi THEN RETURN value - FLOOR(value / (2*Pi)) * 2*Pi
IF value < 0 THEN RETURN value - FLOOR(value / (2*Pi)) * 2*Pi
RETURN value
ENDSUB
'__________________________________________________________________
SUB set_angles(value:STRING), INT
'adjust the system variable angles. angles can be "Rad", "Deg" or "Grad"
'returns true if successfull, else returns false
'Uses the global variable angles
IF LCASE$(value) = "rad"
angles = "Rad"
ert("Angle mode set to Radians")
RETURN TRUE
ENDIF
IF LCASE$(value) = "deg"
angles = "Deg"
ert("Angle mode set to Degrees")
RETURN TRUE
ENDIF
IF LCASE$(value) = "grad"
angles = "Grad"
ert("Angle mode set to Gradians")
RETURN TRUE
ENDIF
ert("Error: Can not set angle mode to " + value + ". Choose Deg, Rad or Grad.")
RETURN FALSE
ENDSUB
'__________________________________________________________________
SUB notation(value:DOUBLE), STRING
'this sub sets the value to the right notation and number of decimals
'and returns it as a string
STRING valstr
STRING start
DOUBLE power
IF ABS(value)<>value THEN start="-" ELSE start=""
value = ABS(value)
IF value<>0 THEN power = FLOOR(LOG10(value)) ELSE power=0 :'because log10(0) is not defined
IF power<-4 OR power>5
'return something like "1.25e9"
value = value / (10^power)
valstr=USING("%d#.#########", value) :'max 9 decimals
WHILE RIGHT$(valstr,1)="0": valstr = LEFT$(valstr,LEN(valstr)-1):ENDWHILE:'remove all zeros at the end
IF RIGHT$(valstr,1)="." THEN valstr = LEFT$(valstr,LEN(valstr)-1):'remove a point at the end
RETURN start + valstr + "e" + USING("#.",power)
ELSE
'return the value without e-notation
valstr=USING("%d#.#########", value) :'max 9 decimals
WHILE RIGHT$(valstr,1)="0": valstr = LEFT$(valstr,LEN(valstr)-1):ENDWHILE
IF RIGHT$(valstr,1)="." THEN valstr = LEFT$(valstr,LEN(valstr)-1)
RETURN start + valstr
ENDIF
ert("Error")
RETURN ""
ENDSUB
'__________________________________________________________________
SUB init_arrays()
'fill in initial values in the arrays
'common program variables:
angles= "Rad"
'for variable arrays:
varname[0]="Pi" :varvalue[0]=4*ATAN(1)
varname[1]="e" :varvalue[1]=EXP(1)
varcount=2
'for function arrays:
funccount=0
funcname[funccount] = "Log", "Ln", "Sqrt", "Exp", "Abs" :funccount+=5
funcname[funccount] = "Sin", "Cos", "Tan", "ArcSin", "ArcCos", "ArcTan", "Csc", "Sec", "Cot" :funccount+=9
funcname[funccount] = "Sinh", "Cosh", "Tanh", "Csch", "Sech", "Coth" :funccount+=6
'20 functions
'for reservedwords array:
reserved_name_count=0
reserved_name[reserved_name_count] = "Angles", "Deg", "Rad", "Grad" :reserved_name_count+=4
reserved_name[reserved_name_count] = "Clear" :reserved_name_count+=1
reserved_name[reserved_name_count] = "Pi", "e" :reserved_name_count+=2
RETURN
ENDSUB
'__________________________________________________________________
SUB clear_memory()
'clear the variables in memory
varcount=2 :'not 0, because the first 2 positions contain Pi and e
RETURN
ENDSUB
'__________________________________________________________________
SUB instrP(source AS STRING, search AS STRING, OPT start=255:CHAR),CHAR
'this sub searches for the LAST string search in the string source,
'reverse of the function instr(). The sub returns 0 if the search could not be found.
'Also this function neglects content between brackets () in source
'example: instrP("opp(2,3), 4.5",",") will return 9, not 6.
CHAR n, bopen,bclose
STRING sign
n=start :IF n>LEN(source) THEN n=LEN(source)-len(search)+1
bopen=0 :'number of parenthesis open (
bclose=0:'number of parenthesis close )
DO
sign = MID$(source, n, LEN(search))
IF (sign=search) AND (bopen=bclose) THEN RETURN n :'exit the sub, return n
IF LEFT$(sign,1)="(" THEN bopen++
IF LEFT$(sign,1)=")" THEN bclose++
n--
UNTIL (n <= 0)
RETURN 0 :'if the string search is not found, then return 0
ENDSUB
'__________________________________________________________________
SUB add_text(text:STRING)
'this sub adds the string text to the editbox ctlhistory
INT length
length = CONTROLCMD (main, ctlhistory, @RTGETTEXTLENGTH)
CONTROLCMD main, ctlhistory, @RTHIDESEL, TRUE
SETFOCUS main, ctlhistory :'so the historybox will automaticly scroll down
CONTROLCMD main, ctlhistory, @RTSETSELECTION, length, length
CONTROLCMD main, ctlhistory, @RTREPLACESEL, text
CONTROLCMD main, ctlhistory, @RTHIDESEL, FALSE
RETURN
ENDSUB
'__________________________________________________________________
SUB display_help()
'display help in on the screen
add_text("" + "HELP" + "")
add_text("This is an expression evaluator." + "")
add_text("You can enter an expression in the textbox below and press <Enter> to calculate it." + "")
add_text("This evaluator supports:" + "")
add_text("\tOperators: + - * / ^ E" + "")
add_text("\tParentheses: ( )" + "")
add_text("\tFunctions:" + "")
add_text("\t\tLog(x), Ln(x), Sqrt(x), Exp(x), Abs(x)" + "")
add_text("\t\tSin(x), Cos(x), Tan(x), ArcSin(x), ArcCos(x), ArcTan(x), Csc(x), Sec(x), Cot(x)" + "")
add_text("\t\tSinh(x), Cosh(x), Tanh(x), Csch(x), Sech(x), Coth(x)" + "")
add_text("\tConstants: Pi, e" + "")
add_text("\tCommands:" + "")
add_text("\t\tClear" + "")
add_text("\t\tAngles = Deg, Rad or Grad" + "")
add_text("\tVariables:" + "")
add_text("\t\tYou can define your own variables. For example type \"Myvar = 5.5+1\"" + "")
add_text("\tExamples:" + "")
add_text("\t\t2.5 * (4/3 + 8/5)" + "")
add_text("\t\tSqrt(36) + 1" + "")
add_text("\t\tSin(0.25 * Pi)^2" + "")
add_text("\t\tMyVar = 4.25" + "")
add_text("\t\t3 + MyVar -0.25" + "")
setfocus main, ctlhistory
RETURN
ENDSUB
Thanks, Mr. Larry! You always seem to have something good up your sleeve.
Although the code works, I might like it a little more organized, so I am throwing my own attempt at translating some old vb code I downloaded (again...).
I might be back with more questions...
Again, thank you!
Attached is my translated VB parser evaluator class.
It compiles fine but my first two top lines don't work:
Dim Brain As Parser
MessageBox(0, Str$(Brain.Evaluate("5+5")), "Result")
I'm still a little new to the Oop in EB, so it would be great If I could see what I'm doing wrong.
I'm just trying to test out my new class, but I haven't figured out how to do that. ::)
Thanks!
MessageBox 0, Str$(Brain.Evaluate("5+5")), "Result"
The file you posted does not compile for me.
The reason is that you are defining
Dim Brain As Parserbefore your class definition.
Moving Dim Brain As Parser
MessageBox(0, Str$(Brain.Evaluate("5+5")), "Result")
after the class definition allows it to compile without errors for me.
However, when I run it the message box does not appear.
It should appear whether you enter it as you did or as Mike did.
So it appears that your program is going off into some sort of loop.
I started trying to track it down.
In your evaluate method you are never returning from the call to:Value = ParseNumExp()
In your ParseNumExp method you are never returning from the call to:Value = ParseTerm()
In your ParseTerm method you are hung in this :While mPosition <= Len(mExpression)
MPosition is never changing from 1
You should be able to find it from there.
Larry
Thanks for the help guys!
Larry, you must be some sort of genius or something! Thanks for tracking that down for me.
I'm now working on hunting the rest of it down, If I get stuck I'll be sure to bring it back up here for help. Else, if/when I succeed, I'll post my working result!
Quote from: JosephE on September 15, 2009, 02:33:56 PM
....you must be some sort of genius or something!...
After you've been around for a while and read more of my responses you'll find how far from the truth that statement is.
There are lot's of people on this forum that program circles around me on a daily basis.
I'm just an amateur who loves programming, loves EBasic, and enjoys trying to help as best I can, when I can.
Larry
Well thanks for your help!
Hmm....after playing around with the evaluator translated from VB, I've gone back to the one you posted.
I'm trying to put in separate code module file. I've made the eval(...) function global in the file, and I'm trying to import it in my other file with Declare Extern eval(expression:string), double.
But now I'm getting a duplicate declaration. What does that mean? I know I've declared the external function just right, and I've globalized the function in the include file.
I can post files if necessary.
Thanks!
It's a lot easier to figure out when we can see how you have the actual code.
But the error message you are getting is saying you have it declared twice.
Larry
Joseph,
It sounds like you are unfamiliar with project management. To separate your source into separate files you need to use a project, and not a single file compile. The users guide has instructions on how to create a project.
Here is one description on how to use multiple source files:
http://www.ionicwind.com/forums/index.php/topic,2904.0.html
Here is an example:
http://www.ionicwind.com/forums/index.php/topic,2557.0.html
Here are some general rules about project management:
1. Include files should NOT contain code such as subroutines, only constants, declarations, types, enumerations, etc.
2. Include files are never added to a project, they are only used with the $include statement
3. If you have global variables that you want to share between multiple source files then use the PROJECTGLOBAL functionality as noted here :http://www.ionicwind.com/forums/index.php/topic,2057.0.html
If you get stuck or have more questions on using projects please ask. When done correctly you can manage 100's of source files in a project allowing easy updates and changes to your program.
Regards,
Paul Turley.
Thank you Paul. You're absolutely right. Thanks for the links!
I'll study up on projects. After looking at that a bit, I'm sure that's what's causing my problem.
Oh, and thanks for describing my problem, Larry.
:)