Formula Solver 1.4 3/

 BBS: Inland Empire Archive
Date: 03-19-93 (21:00)             Number: 370
From: QUINN TYLER JACKSON          Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Formula Solver 1.4    3/       Conf: (2) Quik_Bas

>>> Continued from previous message
' This function returns either a null string for no error, or a
' description
' of the most recent error that occurred in processing a statement.
' Errors
' terminate the process and return 0, whereas warnings continue
' functioning
' and return a value based upon defaults.

SELECT CASE ErrorCode + WarningCode
    CASE 0
        T$ = ""
    CASE eqjDivisionByZero
        T$ = "Division by zero"
    CASE eqjProtectedVariable
        T$ = "Attempt to overwrite protected variable"
    CASE eqjProtectedFunction
        T$ = "Attrmpt to redefine protected function"
    CASE eqjSymbolTableFull
        T$ = "Symbol table full"
    CASE eqjVariableTableFull
        T$ = "Variable table full"
    CASE eqjFunctionTableFull
        T$ = "Function table full"
    CASE eqjMismatchedParenthesis
        T$ = "Mismatched parenthesis encountered"
    CASE eqjUndefinedVariable
        T$ = "Undefined variable referenced -- assuming value of 0"
    CASE eqjFunctionDefaultUsed
        T$ = "Function parameter not supplied -- default assumed"
    CASE eqjSyntaxError
        T$ = "General syntax error"
END SELECT

fqjEvalErrMsg$ = T$
END FUNCTION

FUNCTION fqjEvaluate (InText$)


InText$ = LTRIM$(InText$)

' Expand unary suffixes for easier parsing
 FOR i% = 1 TO LEN(UNARY)
    Temp$ = MID$(UNARY, i%, 1)
    IF INSTR(InText$, Temp$) THEN
        TempPtr = 1
        DO
            Char$ = MID$(InText$, TempPtr, 1)
            IF fqjInList(UNARY, Char$) THEN
                InText$ = LEFT$(InText$, TempPtr) + "0" + MID$(InText$,_
 TempPtr + 1)
            END IF
            TempPtr = TempPtr + 1
        LOOP UNTIL TempPtr >= LEN(InText$)
    END IF
NEXT i%

fqjEvaluate = fqjVAL(InText$)

END FUNCTION

FUNCTION fqjFetchVar (VarName$)

SELECT CASE VarName$
    CASE "TIMER"
        fqjFetchVar = TIMER
    CASE "STRING_MEM"
        fqjFetchVar = FRE("A")
    CASE "FREE_MEM"
        fqjFetchVar = FRE(-1)
    CASE "STACK"
        fqjFetchVar = FRE(-2)
    CASE "RND"
        fqjFetchVar = RND
    CASE ELSE
        FOR i% = SymPtr TO 1 STEP -1
'            IF SymTable(i%).SymLvl = LvlPtr OR SymTable(i%).SymLvl = 1
' THEN
                IF SymTable(i%).SymType = SymVARIABLE THEN
                    IF RTRIM$(SymTable(i%).SymName) = VarName$ THEN
                        fqjFetchVar = VarTable(SymTable(i%).TabPtr)
                            EXIT FUNCTION
                    END IF
                END IF
'            END IF
        NEXT i%
        WarningCode = eqjUndefinedVariable
END SELECT
END FUNCTION

FUNCTION fqjInList% (OpTyp$, Op$)

IF LEN(Op$) THEN
    IF INSTR(OpTyp$, Op$) > 0 THEN
        fqjInList% = TRUE
    END IF
END IF
END FUNCTION

FUNCTION fqjSolveFormula (InToken$)

DIM Param$(MAXPARAMS)
DIM Default(MAXPARAMS)
DIM ParValue$(MAXPARAMS)
DIM ParValue(MAXPARAMS)

Paren% = INSTR(InToken$, "[")
FunctName$ = LTRIM$(RTRIM$(LEFT$(InToken$, Paren% - 1)))
Par$ = MID$(InToken$, Paren% + 1, LEN(InToken$) - Paren% - 1)

FOR i% = 1 TO SymPtr
    IF SymTable(i%).SymType = SymFUNCTION THEN
        IF RTRIM$(SymTable(i%).SymName) = FunctName$ THEN
            Formula$ = ForTable(SymTable(i%).TabPtr)
            Para$ = ParTable(SymTable(i%).TabPtr)
            CALL sjfParse(Param$(), Para$, ",", Tot%)
            FOR a% = 1 TO Tot%
                Temp$ = Param$(a%)
                TempPtr = INSTR(Temp$, ":")
                SELECT CASE TempPtr
                    CASE 0
                        ' Do nothing
                        Default(a%) = 0
                    CASE ELSE
                        Param$(a%) = LEFT$(Temp$, TempPtr - 1)
                        Default(a%) = fqjEvaluate(MID$(Temp$, TempPtr +_
 1))
                END SELECT
            NEXT a%
            EXIT FOR
        END IF
    END IF
NEXT i%

CALL sjfParse(ParValue$(), Par$, ",", Tot2%)

FOR i% = 1 TO Tot%

    IF ParValue$(i%) = "" THEN
        ParValue(i%) = Default(i%)
        WarningCode = eqjFunctionDefaultUsed
    ELSE
        ParValue(i%) = fqjEvaluate(ParValue$(i%))
    END IF
>>> Continued to next message

 * OLX 2.1 TD * A program is just a big bug that happened to work....