Expression evaluator

[definitelyokay]

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!

[LarryMc]

Here's one Joske wrote 4-5 years ago.

Larry

Code Select Expand

/*
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


[definitelyokay]

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!

[definitelyokay]

Attached is my translated VB parser evaluator class.

It compiles fine but my first two top lines don't work:

Code Select Expand

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!

[mrainey]

MessageBox 0, Str$(Brain.Evaluate("5+5")), "Result"

[LarryMc]

The file you posted does not compile for me.
The reason is that you are defining

Code Select Expand

Dim Brain As Parserbefore your class definition.

Moving

Code Select Expand

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:

Code Select Expand

Value = ParseNumExp()
In your ParseNumExp method you are never returning from the call to:

Code Select Expand

Value = ParseTerm()
In your ParseTerm method you are hung in this :

Code Select Expand

While mPosition <= Len(mExpression)
MPosition is never changing from 1

You should be able to find it from there.

Larry
   

[definitelyokay]

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!

[LarryMc]

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

[definitelyokay]

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!

[LarryMc]

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

[Ionic Wind Support Team]

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.

[definitelyokay]

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.