'********************************************************************
'        BCX Expression Evaluator by Kevin Diggins (c) 2002
'********************************************************************
'                    SUPPORTED OPERATORS:  +  -  *  /  ^
'********************************************************************
'                    SUPPORTED FUNCTIONS:
'     SIN  COS   TAN  ASIN  ACOS   ATN   SINH    COSH
'     ABS  SQR  SGN   LOG   LOG10  EXP   ROUND   TANH
'********************************************************************

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
'*************************************************************
'    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"
    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?
'*************************************************************
  IF LEFT$(Formula$,1) = "-" THEN Formula$ = "0" & Formula$
  IF LEFT$(Formula$,1) = "+" THEN Formula$ = "0" & Formula$
'*************************************************************
  REPLACE "(-" WITH "(0-" IN Formula$
  REPLACE "^-" WITH "^0-" IN Formula$
  REPLACE "*-" WITH "*0-" IN Formula$
  REPLACE "/-" WITH "/0-" IN Formula$
  REPLACE "--" WITH "-0-" IN Formula$
  REPLACE "+-" WITH "+0-" IN Formula$
  REPLACE "(+" WITH "(0+" IN Formula$
  REPLACE "^+" WITH "^0+" IN Formula$
  REPLACE "*+" WITH "*0+" IN Formula$
  REPLACE "/+" WITH "/0+" IN Formula$
  REPLACE "-+" WITH "-0+" IN Formula$
  REPLACE "++" WITH "+0+" 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 Expression
  IF LookPtr < Len(Formula$) THEN
    EvalError = TRUE
    AX = 0
  END IF
  FUNCTION = AX
END FUNCTION







SUB GetSymbol
  LOCAL Identifier$
  Identifier$ = SymbolName$()
  IF Look$ = "(" THEN
    Call Match( "(" )
    DO
      Call Expression
      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





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





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






SUB Factor
  IF Look$ = "(" THEN
    CALL Match( "(" )
    CALL Expression
    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 Term
  BX = Stak[Counter]
  DECR Counter
  AX = AX + BX
END SUB





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




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




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




SUB Expon
  CALL Match("^")
  CALL Factor
  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