'**********************************************************************
' This is a modified version of Kevin Diggin's EVAL.BAS
'**********************************************************************
'
' This version has fixes three bugs
'
' 1) Fixed negation problem.
'    10*-1 is now evaluated correctly
'
'2) Fixed precedence problem.
'   2*3^2 is now evaluated correctly
'
'3) Fixed problem with nested functions.
'   SIN(COS(3)) is now evaluated correctly
'
' I would like to draw your attention to fix number 3. In BCX (3.31)
' if you use a LOCAL in a sub it is translated as STATIC and initialized 
' with 0s every time the function is called. Locals should be used with 
' care in recursive functions. There was nothing wrong with the structure 
' or design of the program.
'
' This EVAL function is smaller, faster and easier to modify than the 
' one I wrote (EVALGO4.BAS). It has almost no error checks for invalid 
' user input, and can easily crash if you make a typo, but this should 
' be easy to fix.
'
' Garvan O'Keeffe
' January 5, 2003
'
'********************************************************************
'          BCX Expression Evaluator by Kevin Diggins (c) 2002
'
'********************************************************************
' Modified by Garvan O'Keeffe on 2003-1-4 as noted below.
'********************************************************************
' SUPPORTED OPERATORS: + - * / ^
'********************************************************************
' SUPPORTED FUNCTIONS:
' SIN COS TAN ASIN ACOS ATN SINH COSH
' ABS SQR SGN LOG LOG10 EXP ROUND TANH PI
'********************************************************************

GLOBAL Stak[256] AS DOUBLE
GLOBAL Formula$
GLOBAL Counter
GLOBAL Look$
GLOBAL LookPtr
GLOBAL EvalError
GLOBAL AX AS DOUBLE
GLOBAL BX AS DOUBLE
GLOBAL Rc AS DOUBLE


CLS
PRINT "Press ? to see a list of available functions"
PRINT "Example:> (1+2)*(SIN(45)*250) -- ENTER TO QUIT"

DO
  INPUT "> ", Formula$
  IF LEN(Formula$) = 0 THEN EXIT LOOP
  Rc = Eval()
  IF EvalError = FALSE THEN PRINT Rc#
LOOP




FUNCTION Eval AS DOUBLE
  LOCAL temp$
'*************************************************************
' Formula MUST be UCASE and free of whitespace
'*************************************************************
  Counter = 0
  AX = 0
  BX = 0
  EvalError = 0
  LookPtr = 0
  Look$ = ""
'*************************************************************
  REMOVE " " FROM UCASE$(Formula$)
'*************************************************************
  IF Formula$ = "?" THEN
    CLS
    PRINT
    PRINT "***************************************************"
    PRINT "[ SUPPORTED FUNCTIONS ]"
    PRINT "***************************************************"
    PRINT " SIN COS TAN ASIN ACOS ATN SINH COSH"
    PRINT " ABS SQR SGN LOG LOG10 EXP ROUND TANH PI"
    PRINT "***************************************************"
    PRINT " [ SUPPORTED OPERATORS ] + - * / ^ "
    PRINT "***************************************************"
    PRINT
    KEYPRESS
    EXIT FUNCTION
  END IF
'*************************************************************
' The following rules are for handling the special cases
' involving negative numbers. Did I forget any?
'*************************************************************
' Strip out strings of pluses and minuses
' Must be careful with +- because 2+-2^2 is not equal to 2-2^2
' - GOK 2003-1-4
'-------------------------------------------------------------
  DO
    temp$ = Formula$
    REPLACE "--" WITH "+" IN Formula$
    REPLACE "++" WITH "+" IN Formula$
    REPLACE "-+" WITH "-" IN Formula$
  LOOP UNTIL Formula$ = temp$
'-------------------------------------------------------------
' use lowercase letter n for negation - GOK 2003-1-4
'-------------------------------------------------------------
  IF LEFT$(Formula$,1) = "-" THEN Formula$ = "1n" & MID$(Formula$,2)
  IF LEFT$(Formula$,1) = "+" THEN Formula$ = MID$(Formula$,2)

  REPLACE "(-" WITH "(1n" IN Formula$
  REPLACE "^-" WITH "^1n" IN Formula$
  REPLACE "*-" WITH "*1n" IN Formula$
  REPLACE "/-" WITH "/1n" IN Formula$
  REPLACE "+-" WITH "+1n" IN Formula$
  REPLACE "(+" WITH "(" IN Formula$
  REPLACE "^+" WITH "^" IN Formula$
  REPLACE "*+" WITH "*" IN Formula$
  REPLACE "/+" WITH "/" IN Formula$

  REPLACE "PI" WITH "3.141592653589793" IN Formula$

'-------------------------------------------------------------
  IF LEN(Formula$) = 0 THEN
    AX = 0
    EXIT FUNCTION
  END IF
'*************************************************************
  IF INSTR(Formula$,"()") THEN
    AX = 0
    EXIT FUNCTION
  END IF
'*************************************************************
  IF INSTR(Formula$,")(") THEN
    AX = 0
    EXIT FUNCTION
  END IF
'*************************************************************
  IF TALLY(Formula$,"(") <> TALLY(Formula$,")") THEN
    AX = 0
    EXIT FUNCTION
  END IF
'*************************************************************
  CALL GetChar
  CALL Level5
  IF LookPtr < LEN(Formula$) THEN
    EvalError = TRUE
    AX = 0
  END IF
  FUNCTION = AX
END FUNCTION





SUB GetSymbol
'-----------------------------------------------------------
' DIM LOCAL does not work because it is translated as static
' GOK 2003-1-4
'-----------------------------------------------------------
' DIM LOCAL Identifier$
  DIM RAW Identifier$
  Identifier$ = SymbolName$()
  IF Look$ = "(" THEN
    CALL Match( "(" )
    DO
      CALL Level5
      INCR Counter
      Stak[Counter] = AX
      IF Look$ = "," THEN
        CALL GetChar
      ELSE
        EXIT LOOP
      END IF
    LOOP
    CALL Match( ")" )
    IF LEN(Identifier$) > 1 THEN
      SELECT CASE Identifier$
'*****************************
        CASE "SIN"
        AX= SIN(Stak[Counter])
        DECR Counter
'*****************************
        CASE "COS"
        AX= COS(Stak[Counter])
        DECR Counter
'*****************************
        CASE "TAN"
        AX= TAN(Stak[Counter])
        DECR Counter
'*****************************
        CASE "ASIN"
        AX= ASIN(Stak[Counter])
        DECR Counter
'*****************************
        CASE "ACOS"
        AX= ACOS(Stak[Counter])
        DECR Counter
'*****************************
        CASE "ATN"
        AX= ATN (Stak[Counter])
        DECR Counter
'*****************************
        CASE "SINH"
        AX= SINH(Stak[Counter])
        DECR Counter
'*****************************
        CASE "COSH"
        AX= COSH(Stak[Counter])
        DECR Counter
'*****************************
        CASE "TANH"
        AX= TANH(Stak[Counter])
        DECR Counter
'*****************************
        CASE "ABS"
        AX= ABS(Stak[Counter])
        DECR Counter
'*****************************
        CASE "SQR"
        AX= SQR(Stak[Counter])
        DECR Counter
'*****************************
        CASE "SGN"
        AX= SGN(Stak[Counter])
        DECR Counter
'*****************************
        CASE "LOG"
        AX= LOG(Stak[Counter])
        DECR Counter
'*****************************
        CASE "LOG10"
        AX= LOG10(Stak[Counter])
        DECR Counter
'*****************************
        CASE "EXP"
        AX= EXP(Stak[Counter])
        DECR Counter
'***************************************************************************
        CASE "ROUND"                             ' Here's a function that
        AX= ROUND(Stak[Counter-1],Stak[Counter]) ' uses 2 arguments. It's
        DECR Counter                             ' easy to handle this :-)
        DECR Counter
'***************************************************************************
        CASE ELSE
        EvalError = TRUE
        AX = 0
        Counter = 0
'***************************************************************************
      END SELECT
    END IF
  END IF
END SUB

'-----------------------------------------------------------
' Added 2 new levels of precedence to handle
' negation and Exponentiation - GOK 2003-1-4
'-----------------------------------------------------------

SUB Level5
  CALL Level4
  WHILE IsAddop(Look$)
    INCR Counter
    Stak[Counter] = AX
    SELECT CASE Look$
      CASE "+" : CALL Add
      CASE "-" : CALL Subtract
    END SELECT
  WEND
END SUB





SUB Level4
  CALL Level3
  WHILE INSTR( "*/", Look$ )
    INCR Counter
    Stak[Counter] = AX
    SELECT CASE Look$
      CASE "*" : CALL Multiply
      CASE "/" : CALL Divide
    END SELECT
  WEND
END SUB


SUB Level3
  CALL Level2
  WHILE INSTR( "^", Look$ )
    INCR Counter
    Stak[Counter] = AX
    SELECT CASE Look$
      CASE "^" : CALL Expon
    END SELECT
  WEND
END SUB


SUB Level2
  CALL Level1
  WHILE INSTR( "n", Look$ )
    INCR Counter
    Stak[Counter] = AX
    SELECT CASE Look$
      CASE "n" : CALL Negation
    END SELECT
  WEND
END SUB


SUB Level1
  IF Look$ = "(" THEN
    CALL Match( "(" )
    CALL Level5
    CALL Match( ")" )
    EXIT SUB
  END IF
  IF IsAlpha( Look$ ) THEN
    CALL GetSymbol
  ELSE
    AX = VAL(GetNum$())
  END IF
END SUB




SUB Add
  CALL Match( "+" )
  CALL Level4
  BX = Stak[Counter]
  DECR Counter
  AX = AX + BX
END SUB




SUB Subtract
  CALL Match ( "-" )
  CALL Level4
  BX = Stak[Counter]
  DECR Counter
  SWAP AX,BX
  AX = AX - BX
END SUB




SUB Multiply
  CALL Match("*")
  CALL Level3
  BX = Stak[Counter]
  DECR Counter
  AX = AX * BX
END SUB




SUB Divide
  CALL Match("/")
  CALL Level3
  BX = Stak[Counter]
  DECR Counter
  SWAP AX,BX
  AX = AX / BX
END SUB




SUB Expon
  CALL Match("^")
  CALL Level2
  BX = Stak[Counter]
  DECR Counter
  SWAP AX,BX
  AX = AX ^ BX
END SUB



SUB Negation
  CALL Match("n")
  CALL Level1
  BX = Stak[Counter]
  DECR Counter
  SWAP AX,BX
  AX = -AX * BX
END SUB



FUNCTION IsAlpha(C$)
  FUNCTION = INSTR("?ABCDEFGHIJKLMNOPQRSTUVWXYZ", C$)
END FUNCTION




FUNCTION IsDigit(C$)
  FUNCTION = INSTR(".0123456789",C$)
END FUNCTION




FUNCTION IsAlNum(C$)
  FUNCTION = IsAlpha(C$) OR IsDigit(C$)
END FUNCTION




FUNCTION IsAddop(C$)
  FUNCTION = INSTR ( "+-", C$ )
END FUNCTION




SUB GetChar
  INCR LookPtr
  Look$ = MID$(Formula$,LookPtr,1)
  IF LookPtr > LEN(Formula$) THEN Look$ = ""
END SUB




SUB Match (X$)
  IF Look$ <> X$ THEN
    EvalError = TRUE
    AX = 0
  ELSE
    CALL GetChar
  END IF
END SUB




FUNCTION SymbolName$
  DIM RAW Token$
  Token$ = ""
  IF NOT IsAlpha(Look$) THEN
    EvalError = TRUE
    AX = 0
    EXIT FUNCTION
  END IF
  WHILE IsAlNum(Look$)
    Token$ = Token$ & Look$
    CALL GetChar
  WEND
  FUNCTION = Token$
END FUNCTION




FUNCTION GetNum$
  DIM RAW Value$
  Value$ = ""
  IF NOT IsDigit(Look$) THEN
    EvalError = TRUE
    AX = 0
    EXIT FUNCTION
  END IF
  WHILE IsDigit(Look$)
    Value$ = Value$ & Look$
    CALL GetChar
  WEND
  FUNCTION = Value$
END FUNCTION