Formula Solver 1.4 2/

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

>>> Continued from previous message
DIM SHARED PTR(MAXLEVELS) AS INTEGER    ' Points to location in string_
 being
                                        ' evluated
DIM SHARED EXPR$(MAXLEVELS)       ' Expression being evaluated
DIM SHARED TOKEN$(MAXLEVELS)            ' Current token being evaluated
DIM SHARED TypeToken(MAXLEVELS)         ' Type of current token

CLEAR , , 1024 * 4


CLS
' Initialize tables
nul = fqjEvaluate("")

' The following module level code is used for testing and debugging.

DO
    LvlPtr = 0
    TestDeep% = 0   ' Find all cases of TestDeep% and erase when
                    ' you modify this module to fit into your programs,
                    ' since it is only used for testing purposes
    LOCATE 4
    PRINT "Formula --->" + SPACE$(80);
    LOCATE 4, 16
    LINE INPUT Test$
    LOCATE 6
    Synch! = TIMER          'synchronize to the system timer
    DO
      Start! = TIMER
    LOOP WHILE Start! = Synch!
    PRINT "Result ---->", funSolveEquation(Test$); "                   "
    LOCATE 3
    PRINT "Time ------>"; TIMER - Start!; "                "; TAB(50);_
 "Recursion Depth: "; TestDeep%
    LOCATE 1
    PRINT "Last error->", fqjEvalErrMsg$; "                            "+_
"                           "

    VIEW PRINT 8 TO 24
    FOR i% = 1 TO SymPtr
        IF i% MOD 17 = 0 THEN
            LOCATE 8
            Sec% = TRUE
        END IF

        IF Sec% THEN
            LOCATE , 40
        END IF

        SELECT CASE SymTable(i%).SymType
            CASE SymVARIABLE
                PRINT "V: "; RTRIM$(SymTable(i%).SymName); " -->";
                SELECT CASE SymTable(i%).SymLvl
                    CASE IS > PROTECTED
                        PRINT VarTable(SymTable(i%).TabPtr); "         "+_
" "
                    CASE ELSE
                        PRINT fqjFetchVar(RTRIM$(SymTable(i%).SymName))_
; "          "
                END SELECT
            CASE SymFUNCTION
                PRINT "F: "; RTRIM$(SymTable(i%).SymName)
        END SELECT
    NEXT i%
    Sec% = FALSE
    VIEW PRINT
LOOP


PredefinedFunctionData:

' The following functions are read into the symbol table the first
' time the function is called.  I thought they would be of some help.
' Note that they are PROTECTED.  That is to say, they cannot be
' redefined
' by the user, in the same way the user cannot redefine built-in
' functions
' in BASIC.  Add any to this list any functions that would suit your
' needs.

DATA "square_root[x]","2}x"
DATA "cube_root[x]","3}x"
DATA "rand[high:100,seed:timer]","high?seed"
'                          ^
'                          |
'         seeds with timer if no seed supplied
'
DATA "area_of_circle[r,pi:3.1415926]","pi*r^2"
'                         ^^^^^^^^^
'                             |
'                  defaults if none supplied
'                       |          |
'                       V          V
DATA "distance[x1,y1,z1:0,x2,y2,z2:0]","square_root[(x1-x2)^2+(y1-y2"+_
")^2+(z1-z2)^2]"
DATA "*END*",""

' These following system variables.  They cannot be redefined, since
' they
' return system information.  When you add a system variable to this
' list, you must also add it to the SELECT CASE VarName$ structure in
' the FUNCTION fqjFetchVar.  Here are a few to get you started.

SystemVariableData:
DATA "timer"
DATA "string_mem"
DATA "free_mem"
DATA "stack"
DATA "rnd"
DATA "*END*"

FUNCTION fqjEval (InText$)

EXPR$(LvlPtr) = UCASE$(InText$)

PTR(LvlPtr) = 1

AssignmentPtr% = INSTR(EXPR$(LvlPtr), ASSIGNMENT)
ParenPtr% = INSTR(EXPR$(LvlPtr), "[")

IF AssignmentPtr% = 0 THEN ' just do a simple evaluation
            EXPR$(LvlPtr) = EXPR$(LvlPtr)
            CALL sqjGetToken
            CALL sqjDesParse(1, x)
            fqjEval = x
ELSE                       ' assign a variable or function!
    VariableName$ = LTRIM$(RTRIM$(LEFT$(EXPR$(LvlPtr), AssignmentPtr% -_
 1)))

    SELECT CASE (ParenPtr% > 0) AND (ParenPtr% < AssignmentPtr%)
        CASE 0
                Valu = fqjEval(MID$(EXPR$(LvlPtr), AssignmentPtr% + 2))
                CALL sqjAssignVar(VariableName$, Valu, LvlPtr)
                fqjEval = Valu
        CASE ELSE
                Formula$ = LTRIM$(MID$(EXPR$(LvlPtr), AssignmentPtr% +_
 2))
                CALL sqjAssignFun(VariableName$, Formula$, UNPROTECTED)
    END SELECT
END IF
END FUNCTION

FUNCTION fqjEvalErrMsg$ ()
>>> Continued to next message

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

--- Maximus/2 2.01wb