C!T ROM 2/ctrom_ii_b.zip/ctrom_ii_b/PROGRAM/BASIC/QBS_0103/QBS103-4.DOC

Text File | 1993-04-30 | 40KB | 1,286 lines

════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #4740
 Date:    03-20-93 11:45 (Public)
 From:    JEFF FREEMAN
 To:      ALL
 Subject: Copyright laws in the USA
────────────────────────────────────────────────────────────────────────────────
I just spent 2 hours at the library reading copyright laws and how-to books.
This is what I came up with.  This information contradicts a few of the
opinions that had been expressed in this echo, but since the following
information is easily verifiable, I am not inviting debate.  In other words,
if you don't believe me then go to the library and look it up for yourself -
THEN post.

Everything you write is automatically owned by you (you own the copyright).
Copyrights last for the remainder of your life, plus 50 years.

Publication (posting in the echo, giving to a friend, uploading to a BBS) of
your work without a copyright notice puts the work in the public domain.

However, you may still register the copyright within 5 years and take other
action to re-claim/recover from publishing a work without a copyright notice.

Anyone may publish your work if it is in the Public Domain.

Being in the Public Domain means the work is unprotected by Copyright laws.

Within 3 months of publication, two copies (one for computer programs) of the
work must be deposted in the Copyright Office (address follows).

Only original works of authorship may be copyrighted.  You cannot copyright
someone else's work.

Why register a copyright?

    If registered prior to infringement, you may receive Damages and Attorney
fees.  Otherwise you must pay attorney fees and are not entitled to Damages.

    You must register to file a suit.  If a copyright infringement occurs
before you have registered the copyright, for example, you must register the
copyright to sue the infringer.  Still, you cannot be awarded Damages and
must pay your own attorney fees.

    The burden of proof lies on the infringer.  If you register my work, for
example, the burden of proof is mine.

    You must register to overcome publishing your work without a copyright
notice.

    You needn't be the author in order to obtain a copyright if:

        The Author has Asigned you the right.
        You employed the Author to create the work.

    In regards to the current echowide project, each contributor retains the
copyright for their contribution, however the compiler may copyright the work
as a whole.

    Lastly, what all this means is that if you post something without a
copyright notice in this echo then anyone may publish that work, but no one

can copyright it.

    If you post something and include the copyright notice, then by statute
you should depost (within 3 months) a copy of the program in the Copyright
Office. Mail form TX and A filing fee of $10 plus $4 per additional
certificate.  Write to the following address for form TX, fill it out and
mail in a copy of your program:

            Register of Copyrights
            Copyright Office
            Library of Congress
            Washington, DC  20559

    You may register the copyright within 5 years of publication (with the
copyright notice).  You SHOULD register the copyright within 3 months of
publication.

    You *cannot* register someone else's copyright!  If you want to release
code to the "public domain", simply omit the copyright notice and make no
attempt to reclaim it.

---
 * Origin: WarWorld's point away from home... (1:124/7006.1)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #4914
 Date:    03-19-93 21:00 (Public)
 From:    QUINN TYLER JACKSON
 To:      ALL
 Subject: Formula Solver 1.4    1/
────────────────────────────────────────────────────────────────────────────────
________O_/________________________| SNIP |______________________\_O_______
        O \                        | HERE |                      / O
'This file created by PostIt! v4.0.
'>>> Start of page 1.

 '     THE                                *                  RDF14.BAS
 '  JACK MACK                            *
 '  RECURSIVE                           * ***    *     *
 '   DESCENT                           *     *     * *
 '  ALGEBRAIC       ******             *     *     * *
 '   FORMULA            *               `****'   *     *
 '     AND             **      ***************************************
 '  DEFINABLE            *    *
 '  FUNCTIONS            *   *
 '   ENGINE         *****'  *         *              *
 '                         *         *                *
 '        *               *         *                  *
 '       * *             *         *    5(100-x+2b)     *   *     *
 '      *   *           *          *                    *   *     *
 '           *         *           *   *************    *   *     *
 '            *       *            *                    *   `******
 '             *     *             *       3!+35y       *         *
 '              *   *               *                  *          *
 '               * *                 *                *      `****'
 '  v1.4          *                   *              *
 '              Public Domain Code Written By Quinn Tyler Jackson
 '
 '
 '           *                        *                           *
 '            ****************************************************
 '            *ALL FUTURE VERSIONS WILL LOSE QBASIC COMPATIBILITY*
 '          ***     AND WILL ADOPT PDS/VBDOS EXTENSIONS, SO      ***
 '            *           GRAB THIS ONE WHILE YOU CAN!           *
 '            ****************************************************
 '           *                        *                           *
 '
 '
 ' DEDICATION:
 '
 ' This program is dedicated to my wife Laleh, and our three children,
 '  Ozra, Shahraam, and Arehzou, who give up a lot of their time with
 '           me so I can program at this infernal keyboard!
 '
 ' The superlative, full-featured equation solver, featuring:
 '
 '  1. STANDARD AND ADVANCED OPERATORS
 '  2. STANDARD PRECEDENCE SOLVING ALGORITHM
 '  3. ASSIGNABLE VARIABLES WITH DESCRIPTIVE NAMES
 '  4. NEW TO VERSION 1.4!!!!  Function definition!
 '
 '  I've supplied the module, you figure it out!

DECLARE FUNCTION funSolveEquation! (InText$)

DECLARE FUNCTION fqjEval! (InText$)
DECLARE FUNCTION fqjVAL! (InText$)
DECLARE FUNCTION fqjFetchVar! (VarName$)
DECLARE FUNCTION fqjInList% (OpTyp$, Op$)
DECLARE FUNCTION fqjSolveFormula! (InToken$)
DECLARE FUNCTION fqjEvalErrMsg$ ()
DECLARE FUNCTION fqjEvaluate! (InText$)
DECLARE SUB sjfParse (Word$(), Txt$, Spt$, WordNum%)
DECLARE SUB sqjApplyOp (Op$, x!, y!)
DECLARE SUB sqjAssignFun (FunctName$, Formula$, Protection%)
DECLARE SUB sqjAssignVar (VarName$, VarValue!, Protection%)
DECLARE SUB sqjDesParse (Phase%, x!)
DECLARE SUB sqjGetToken ()

CONST TRUE = -1
CONST FALSE = NOT TRUE

CONST ASSIGNMENT = ":="     ' This can be changed to suit your needs
                            ' Using a simple = is possible, since
' logical
                            ' equality is a double == with this parser,
                            ' but the PASCAL standard := is easier to
' deal
                            ' with as an assignment operator for some.

' Operator classes                PRECEDENCE
'---------------------------------------------------
CONST POWER = "^}?**>><<!`#"       ' FIRST
CONST MULTDIV = "*/\%"             ' SECOND
CONST ADDSUB = "+-"                ' THIRD
CONST LOGICAL = "&|=~<=<>==>"      ' FOURTH
CONST UNARY = "!#`"                ' UNARY operators


DIM SHARED WHITESPACE AS STRING
DIM SHARED OPERATOR AS STRING

CONST OperatorClass = 1
CONST DigitClass = 2
CONST FunctionClass = 3

CONST MAXLEVELS = 10    ' Numbers of levels of nesting allowed
CONST MAXCOMMANDS = 10  ' Number of commands per statement
CONST MAXPARAMS = 10    ' Number of parameters in a function allowed
CONST SYMMAX = 200      ' Total number of symbols allowed
CONST VARMAX = 100      ' Total number of variables allowed
CONST FUNMAX = 100      ' Total number of definable functions allowed
CONST SYSMAX = 25

TYPE SymbolTableType
        SymName AS STRING * 30  ' Name of the symbol
        SymLvl AS INTEGER       ' Level that it was assigned
        SymType AS INTEGER      ' Whether it is a variable or function

        TabPtr AS INTEGER       ' Ptr to data tables
END TYPE

' Used by SymType
CONST SymVARIABLE = 0
CONST SymFUNCTION = 1

CONST PROTECTED = -1
CONST UNPROTECTED = 1

DIM SHARED ErrorCode AS INTEGER
DIM SHARED WarningCode AS INTEGER
' Error code constants
CONST eqjDivisionByZero = 1
CONST eqjProtectedFunction = 2
CONST eqjProtectedVariable = 3
CONST eqjSymbolTableFull = 4
CONST eqjVariableTableFull = 5
CONST eqjFucntionTableFull = 6
CONST eqjMismatchedParenthesis = 7
CONST eqjUndefinedVariable = 8
CONST eqjFunctionDefaultUsed = 9
CONST eqjSyntaxError = 10

' Variables global to this module...
DIM SHARED SymTable(SYMMAX) AS SymbolTableType  ' Table holds symbols
DIM SHARED VarTable(VARMAX) AS SINGLE           ' Table hold variable_
 data
DIM SHARED ParTable(FUNMAX) AS STRING   ' Table holds function_
 parameters
DIM SHARED ForTable(FUNMAX) AS STRING   ' Table holds function formulas
DIM SHARED SysTable(SYSMAX) AS STRING

DIM SHARED SymPtr AS INTEGER    ' Points to highest symbol in table
DIM SHARED VariPtr AS INTEGER   ' Points to highest variable in table
DIM SHARED FunPtr AS INTEGER    ' Points to highest function in table
DIM SHARED LvlPtr AS INTEGER    ' Indicates the current level being
                                ' evaluated
>>> Continued to next message

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

--- Maximus/2 2.01wb
 * Origin: The Nibble's Roost, Richmond BC Canada 604-244-8009 (1:153/918)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #4915
 Date:    03-19-93 21:00 (Public)
 From:    QUINN TYLER JACKSON
 To:      ALL
 Subject: Formula Solver 1.4    2/
────────────────────────────────────────────────────────────────────────────────
>>> 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
 * Origin: The Nibble's Roost, Richmond BC Canada 604-244-8009 (1:153/918)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #4916
 Date:    03-19-93 21:00 (Public)
 From:    QUINN TYLER JACKSON
 To:      ALL
 Subject: Formula Solver 1.4    3/
────────────────────────────────────────────────────────────────────────────────
>>> 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....

--- Maximus/2 2.01wb
 * Origin: The Nibble's Roost, Richmond BC Canada 604-244-8009 (1:153/918)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #4917
 Date:    03-19-93 21:00 (Public)
 From:    QUINN TYLER JACKSON
 To:      ALL
 Subject: Formula Solver 1.4    4/
────────────────────────────────────────────────────────────────────────────────
>>> Continued from previous message
    ' Push the parameters to the variable stack temporarily

    IF SymPtr < SYMMAX THEN
        ' Since it wasn't, put it there
        VariPtr = VariPtr + 1
        SymPtr = SymPtr + 1

        IF VariPtr <= VARMAX THEN
            SymTable(SymPtr).SymName = Param$(i%)
            SymTable(SymPtr).SymType = SymVARIABLE
            SymTable(SymPtr).TabPtr = VariPtr
            SymTable(SymPtr).SymLvl = LvlPtr + 1
            VarTable(VariPtr) = ParValue(i%)
        ELSE
            ErrorCode = eqjVariableTableFull
        END IF
    ELSE
        ErrorCode = eqjSymbolTableFull
    END IF

NEXT i%

fqjSolveFormula = fqjEvaluate(Formula$)

VariPtr = VariPtr - Tot%    ' Clear the variable stack of
SymPtr = SymPtr - Tot%      ' variables used in parameter
END FUNCTION

FUNCTION fqjVAL (InText$)

' Initialize some variables....

IF LvlPtr < MAXLEVELS THEN
    LvlPtr = LvlPtr + 1

    DIM CommandArray$(MAXCOMMANDS)

        ' separate statement by semicolons
        CALL sjfParse(CommandArray$(), InText$, ";", Tot%)

        FOR i% = 1 TO Tot%
            fqjVAL = fqjEval(CommandArray$(i%))

            IF ErrorCode THEN
                fqjVAL = 0
                EXIT FUNCTION
            END IF
        NEXT i%

    LvlPtr = LvlPtr - 1

    ELSE

        ErrorCode = eqjNestedTooDeep
END IF
END FUNCTION

FUNCTION funSolveEquation (InText$)

STATIC Initialized%

IF Initialized% = FALSE THEN
    RESTORE PredefinedFunctionData
    DO
        READ N$, F$
        IF N$ <> "*END*" THEN
            CALL sqjAssignFun(N$, F$, PROTECTED)
        END IF
    LOOP UNTIL N$ = "*END*"

    RESTORE SystemVariableData
    DO
        READ N$
        IF N$ <> "*END*" THEN
            CALL sqjAssignVar(N$, 0, PROTECTED)
        END IF
    LOOP UNTIL N$ = "*END*"

    Initialized% = TRUE
END IF

OPERATOR = ADDSUB + MULTDIV + POWER + LOGICAL
WHITESPACE = " " + CHR$(13) + CHR$(9) + CHR$(10)

ErrorCode = 0
WarningCode = 0
LvlPtr = 0
funSolveEquation = fqjEvaluate(InText$)

END FUNCTION

SUB sjfParse (Word$(), Txt$, Spt$, WordNum%)

Text$ = Txt$
WordNum% = 0
SepLen% = LEN(Spt$)

DO
    WordNum% = WordNum% + 1
    EndWord% = INSTR(Text$, Spt$)
    IF EndWord% THEN
        Word$(WordNum%) = LEFT$(Text$, EndWord% - 1)
        Text$ = MID$(Text$, EndWord% + SepLen%)
    ELSE
        Word$(WordNum%) = Text$
        Text$ = ""

    END IF
LOOP WHILE LEN(Text$)
END SUB

SUB sqjApplyOp (Op$, x, y)

' This is the meat of the operator section, and can be modified to
' includ ANY symbol as an operator, or any two byte symbol combination.
' Any symbol added has to be added to the constant that sets its
' level of precedence.

SELECT CASE Op$
    CASE "-"    ' subtraction
        x = x - y
    CASE "+"    ' addition
        x = x + y
    CASE "*"    ' multiplication
        x = x * y
    CASE "/"    ' division
        IF y <> 0 THEN
            x = x / y
        ELSE
            ErrorCode = eqjDivisionByZero
        END IF
    CASE "\"    ' integer division
        IF y <> 0 THEN
            x = x \ y
        ELSE
            ErrorCode = eqjDivisionByZero
        END IF
    CASE "%"    ' modulo division
        IF y <> 0 THEN
            x = x MOD y
        ELSE
            ErrorCode = eqjDivisionByZero
        END IF
    CASE "^", "**"  ' exponentation
        x = x ^ y
    CASE "}"    ' the rth root of y
        IF y <> 0 THEN
            x = y ^ (1 / x)
>>> Continued to next message

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

--- Maximus/2 2.01wb
 * Origin: The Nibble's Roost, Richmond BC Canada 604-244-8009 (1:153/918)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #4918
 Date:    03-19-93 21:00 (Public)
 From:    QUINN TYLER JACKSON
 To:      ALL
 Subject: Formula Solver 1.4    5/
────────────────────────────────────────────────────────────────────────────────
>>> Continued from previous message
        ELSE
            ErrorCode = eqjDivisionByZero
        END IF
    CASE "?"    ' random number from 0 to x, seed y
        RANDOMIZE y
        x = RND * x
    CASE "<<"   ' bitshift left y by x bits
        x = INT(y) * 2 ^ INT(x)
    CASE ">>"   ' bitshift right y by x bits
        x = INT(y) \ 2 ^ INT(x)
    CASE "!"    ' factorial
        Temp& = 1
        FOR i% = 1 TO x
                Temp& = Temp& * i%
        NEXT i%
        x = Temp&
    CASE "`"
        x = ABS(x)
    CASE "#"    ' absolute
        x = INT(x)
    CASE "<"    ' logical less than than
        x = x < y
    CASE "<=", "=<" ' logical less than or equal to
        x = x <= y
    CASE ">"    ' logical greater than
        x = x > y
    CASE ">=", "=>" ' logical greater than or equal to
        x = x >= y
    CASE "=="    ' logical equality
        x = x = y
    CASE "<>" ' logical inequality
        x = x <> y
    CASE "|=", "=|" ' logical implication
        x = x IMP y
    CASE "&=", "=&" ' logical equivlance
        x = x EQV y
    CASE "&"   ' bitwise AND
        x = x AND y
    CASE "|"    ' bitwise OR
        x = x OR y
    CASE "~"    ' bitwise XOR
        x = x XOR y
END SELECT
END SUB

SUB sqjAssignFun (FunctName$, Formula$, Protection%)

FunctName$ = UCASE$(FunctName$)

ParPtr% = INSTR(FunctName$, "[")
NamePart$ = LEFT$(FunctName$, ParPtr% - 1)
ParamPart$ = MID$(FunctName$, ParPtr% + 1, LEN(FunctName$) - ParPtr% -_

 1)

' First we see if this function is already in the list
FOR i% = 1 TO SymPtr
    IF SymTable(i%).SymType = SymFUNCTION THEN
        IF RTRIM$(SymTable(i%).SymName) = NamePart$ THEN
            IF SymTable(i%).SymLvl <> PROTECTED THEN
                ' Since it was, just change its formula
                IF ParamPart$ <> "" THEN
                    ' Make sure it just isn't a formula
                    ' that uses empty parenthesis for the params.
                    ParTable(SymTable(i%).TabPtr) = ParamPart$
                END IF
            ELSE
                ErrorCode = eqjProtectedFunction
            END IF
            ForTable(SymTable(i%).TabPtr) = Formula$
            EXIT SUB
        END IF
    END IF
NEXT i%

IF SymPtr < SYMMAX THEN
    ' Since it wasn't, put it there
    FunPtr = FunPtr + 1
    SymPtr = SymPtr + 1

    IF FunPtr <= FUNMAX THEN
        SymTable(SymPtr).SymName = NamePart$
        SymTable(SymPtr).SymType = SymFUNCTION
        SymTable(SymPtr).SymLvl = Protection%
        SymTable(SymPtr).TabPtr = FunPtr
        ParTable(FunPtr) = ParamPart$
        ForTable(FunPtr) = Formula$
    ELSE
        ErrorCode = eqjFunctionTableFull
    END IF
ELSE
    ErrorCode = eqjSymbolTableFull
END IF
END SUB

SUB sqjAssignVar (VarName$, VarValue, Protection%)
VarName$ = UCASE$(VarName$)

' First we see if this variable is already in the list
FOR i% = 1 TO SymPtr
    IF SymTable(i%).SymType = SymVARIABLE THEN
        IF RTRIM$(SymTable(i%).SymName) = VarName$ THEN
            IF SymTable(i%).SymLvl <> PROTECTED THEN
                IF SymTable(i%).SymLvl = LvlPtr THEN
                    ' Since it was, just change its value
                    VarTable(SymTable(i%).TabPtr) = VarValue

                    EXIT SUB
                END IF
            ELSE
                ErrorCode = eqjProtectedVariable
                EXIT SUB
            END IF
        END IF
    END IF
NEXT i%

IF SymPtr < SYMMAX THEN
    ' Since it wasn't, put it there
    VariPtr = VariPtr + 1
    SymPtr = SymPtr + 1

    IF VariPtr <= VARMAX THEN
        SymTable(SymPtr).SymName = VarName$
        SymTable(SymPtr).SymType = SymVARIABLE
        SymTable(SymPtr).TabPtr = VariPtr
        SymTable(SymPtr).SymLvl = Protection%
        VarTable(VariPtr) = VarValue
    ELSE
        ErrorCode = eqjVariableTableFull
    END IF
ELSE
    ErrorCode = eqjSymbolTableFull
END IF
END SUB

SUB sqjDesParse (Phase%, x)

SHARED TestDeep%    ' This variable used for testing how deep recursion_
 goes
' This is the central cortex of this module.
' It uses wicked recursion, so beware!  In fact, this routine is so
' recursive that unless you're a major masochist, you'd better leave it
' well enough alone!
TestDeep% = TestDeep% + 1   ' Used for testing phase only
>>> Continued to next message

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

--- Maximus/2 2.01wb
 * Origin: The Nibble's Roost, Richmond BC Canada 604-244-8009 (1:153/918)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #4919
 Date:    03-19-93 21:00 (Public)
 From:    QUINN TYLER JACKSON
 To:      ALL
 Subject: Formula Solver 1.4    6/
────────────────────────────────────────────────────────────────────────────────
>>> Continued from previous message
SELECT CASE Phase%

    CASE 1
        ' See if something of a higher precedence should be done first.
        CALL sqjDesParse(2, x)

        Op$ = TOKEN$(LvlPtr)

        ' The lowest level of precedence is handled by this Level.

        DO WHILE fqjInList(LOGICAL, Op$)
            CALL sqjGetToken
            CALL sqjDesParse(2, y)
            CALL sqjApplyOp(Op$, x, y)
            Op$ = TOKEN$(LvlPtr)
        LOOP

    CASE 2
        ' See if something of a higher precedence should be done first.
        CALL sqjDesParse(3, x)
        Op$ = TOKEN$(LvlPtr)

        DO WHILE fqjInList(ADDSUB, Op$)
            CALL sqjGetToken
            CALL sqjDesParse(3, y)
            CALL sqjApplyOp(Op$, x, y)
            Op$ = TOKEN$(LvlPtr)
        LOOP

    CASE 3
        ' See if something of a higher precedence should be done first.
        CALL sqjDesParse(4, x)

        Op$ = TOKEN$(LvlPtr)

        DO WHILE fqjInList(MULTDIV, Op$)
            CALL sqjGetToken
            CALL sqjDesParse(4, y)
            CALL sqjApplyOp(Op$, x, y)
            Op$ = TOKEN$(LvlPtr)
        LOOP

    CASE 4
        ' See if something of a higher precedence should be done first.
        CALL sqjDesParse(5, x)

        Op$ = TOKEN$(LvlPtr)

        IF fqjInList(POWER, Op$) THEN
            CALL sqjGetToken
            CALL sqjDesParse(5, y)
            CALL sqjApplyOp(Op$, x, y)

        END IF

    CASE 5
        Op$ = ""

        IF TypeToken(LvlPtr) = OperatorClass AND (fqjInList(ADDSUB,_
 TOKEN$(LvlPtr))) THEN
            Op$ = TOKEN$(LvlPtr)
            CALL sqjGetToken
        END IF

        CALL sqjDesParse(6, x)

        ' This handles negative prefixes
        SELECT CASE Op$
            CASE "-"
                x = -x
        END SELECT

    CASE 6
        ' This level handles parentheses

        IF TOKEN$(LvlPtr) = "(" AND TypeToken(LvlPtr) = OperatorClass_
 THEN
            CALL sqjGetToken
            CALL sqjDesParse(1, x)

            IF TOKEN$(LvlPtr) <> ")" THEN
                ErrorCode = eqjMismatchedParenthesis
            END IF

            CALL sqjGetToken
        ELSE
            SELECT CASE TypeToken(LvlPtr)
                CASE DigitClass
                    x = VAL(TOKEN$(LvlPtr))
                    CALL sqjGetToken
                CASE FunctionClass
                    x = fqjSolveFormula(TOKEN$(LvlPtr))
                    TypeToken(LvlPtr) = DigitClass
                    CALL sqjGetToken
            END SELECT
        END IF
END SELECT
END SUB

SUB sqjGetToken ()

TOKEN$(LvlPtr) = ""

DO WHILE fqjInList(WHITESPACE, MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1))
    PTR(LvlPtr) = PTR(LvlPtr) + 1
LOOP


Temp$ = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
IF Temp$ >= "0" AND Temp$ <= "9" THEN

    ' Build up a number from its digits
    DO WHILE INSTR(" ()" + OPERATOR$, MID$(EXPR$(LvlPtr), PTR(LvlPtr),_
 1)) = 0
        TOKEN$(LvlPtr) = TOKEN$(LvlPtr) + MID$(EXPR$(LvlPtr),_
 PTR(LvlPtr), 1)
        PTR(LvlPtr) = PTR(LvlPtr) + 1
    LOOP

    TypeToken(LvlPtr) = DigitClass
    EXIT SUB
END IF

IF INSTR("()" + OPERATOR$, MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)) THEN

    TypeToken(LvlPtr) = OperatorClass
    TOKEN$(LvlPtr) = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
    PTR(LvlPtr) = PTR(LvlPtr) + 1

    IF INSTR("()", TOKEN$(LvlPtr)) THEN
        EXIT SUB
    ELSE
        ' see if it's a compound operator
        IF INSTR(OPERATOR$, MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)) THEN
            Temp$ = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
            IF Temp$ <> "-" THEN
                TOKEN$(LvlPtr) = TOKEN$(LvlPtr) + Temp$
                PTR(LvlPtr) = PTR(LvlPtr) + 1
            END IF
        END IF
    END IF
    EXIT SUB
END IF

Temp$ = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
IF Temp$ >= "@" AND Temp$ <= "Z" THEN
>>> Continued to next message

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

--- Maximus/2 2.01wb
 * Origin: The Nibble's Roost, Richmond BC Canada 604-244-8009 (1:153/918)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #4920
 Date:    03-19-93 21:00 (Public)
 From:    QUINN TYLER JACKSON
 To:      ALL
 Subject: Formula Solver 1.4    7/
────────────────────────────────────────────────────────────────────────────────
>>> Continued from previous message
    ' Build up a variable name based upon letters
    DO WHILE INSTR(" ()" + OPERATOR$, MID$(EXPR$(LvlPtr), PTR(LvlPtr),_
 1)) = 0
        Temp$ = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
        IF Temp$ <> "[" THEN
            TOKEN$(LvlPtr) = TOKEN$(LvlPtr) + Temp$
            PTR(LvlPtr) = PTR(LvlPtr) + 1
        ELSE
            TOKEN$(LvlPtr) = TOKEN$(LvlPtr) + "["
            DO WHILE SepPtr% <> -1
                PTR(LvlPtr) = PTR(LvlPtr) + 1
                T$ = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
                SELECT CASE T$
                    CASE "["
                        SepPtr% = SepPtr% + 1
                    CASE "]"
                        SepPtr% = SepPtr% - 1
                END SELECT
                TOKEN$(LvlPtr) = TOKEN$(LvlPtr) + T$
            LOOP
            PTR(LvlPtr) = PTR(LvlPtr) + 1
            TypeToken(LvlPtr) = FunctionClass
            EXIT SUB
        END IF
    LOOP

    TOKEN$(LvlPtr) = STR$(fqjFetchVar(TOKEN$(LvlPtr)))
    TypeToken(LvlPtr) = DigitClass
    EXIT SUB
END IF
END SUB


________O_/________________________| SNIP |______________________\_O_______
        O \                        | HERE |                      / O


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

--- Maximus/2 2.01wb
 * Origin: The Nibble's Roost, Richmond BC Canada 604-244-8009 (1:153/918)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #4921
 Date:    03-19-93 21:58 (Public)
 From:    QUINN TYLER JACKSON
 To:      ALL
 Subject: About Formula Solver
────────────────────────────────────────────────────────────────────────────────
The previous seven part post is the revised version of my formula
solver.  New to this version are definable functions and some bug fixes
to version 1.0.  I've numbered this 1.4 because there were 3
intermediate versions at my end before reaching this one.

This message is to serve as a brief tutorial on the syntax of the
FUNCTION funSolveEquation(InText$).

First of all, there are standard statements:

1+1
2+3
9*2+2
etc.

That's fairly simple.  Then, there are more advanced operators, such as
` and # and }.

-4` = 4  That is to say, ` returns the ABSOLUTE value of x.

4.5# = 4  That is to say, # returns the integer part of x.

2}4 means "the square root of 4"
3}8 means "the cube root of 4"

That is, n}x returns the nth root of x.

Then, there are exotic operators, such as !, which is the factorial
symbol, which means that 5! returns 5 factorial, or 1x2x3x4x5, or 120.
0! is 1 by definition.

There are other operators:

5%2 works as 5 MOD 2
5\2 does integer division
5~7 works as 5 XOR 7
5&7 works as 5 AND 7
5|7 works as 5 OR 7

Some logical operators:

1>2 returns 0, for false
1<>2 returns -1, for true
5==2 returns 0, for false
(1<3)|=(2==1) returns -1, for IMPLIED TRUTH

Parenthesis override standard BODMAS precedence.  Therefore:

5*(1+2) returns 15, rather than 7.

VARIABLE ASSIGNMENT:

Variables are case insensitive, and can consist of:


        first character must be either @ or A-Z
        subsequent characters can be anything but spaces or
        operators (numbers or commas are legal, as are underscores, but
        A^TEST would be a to the power of test.

Variable assignment is achieved by the statment:

Variable:=equation

Therefore, one could do any of the following:

STATEMENT                          VALUE OF A
___---------------------------------------------
A:=10                                10
A:=10*2                              20
A:=square_root[9]                     3

Suppose A is equal to 10, the following would change its value to 20:

A:=A*2

FUNCTIONS:

Functions are assigned in a similar fashion to variables.

square[x]:=x^2

Now, whenever a value for the x parameter is supplied, it is put into
the formula, and the function returns the result.  Variables in function
parameters are local to those functions and are dynamic.  That is to
say, if x is specified as being 100 somewhere else, that doesn't affect
the function.

Therefore,

square[10] would return 100.
square[n] would return 4 if n were equal to 2
square[1+5] would return 36 and
square[square[2]] would return 16, and is an example of the nesting that
is possible with functions.

In the definition of the function, one can assign parameter defaults.
That is, one can supply values for the parameters that are used as a
default value if that parameter is not supplied in the call.

area[radius,pi:(22/7)]:=pi*radius^2

As it stands, suppose someone were to then call the function like this:

area[10]

This would return 31.429, using the default of 22/7 for pi, which is a

rough approximation.  However, if a stickler were to come along and
demand a more accurate value for pi, he could supply the missing
parameter:

area[10,3.14159]

and the function would use this value for pi rather than the default.

Note that when the default parameter is at the END of the paremeter list
in the function definition, there is no need for a placeholder.  In
other locations, one is required:

area[pi:22/7,radius]:=pi*radius^2

Now, to call this using the default value for pi, one would have to do
this:

area[,10]

The , serves as a place holder for the missing parameter, just as in the
BASIC statement:

LOCATE ,10

SOME ADVANCED TOPICS:

Multiline statements are possible.  The result of the LAST calculation
in the list is what funSolveEquation returns.  Therefore, one could do
this:
        2
a:=1;b:=2;c:=3;a+b+c

This would return the value 6.
Functions canNOT take advantage of this feature.

I leave you to figure out the rest....
Quinn


 * OLX 2.1 TD * Programming is never saying you're finished....

--- Maximus/2 2.01wb
 * Origin: The Nibble's Roost, Richmond BC Canada 604-244-8009 (1:153/918)