home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / equatev5.zip / EQUATE.BAS next >
BASIC Source File  |  1994-05-07  |  9KB  |  337 lines
  1. REM Equate v5.0 PDS 7.1 BASIC source.
  2. DECLARE FUNCTION Instrng% (Temp$, Temp2$)
  3. DECLARE FUNCTION BinaryToDecimal# (B$)
  4. REM Boolean operator truth table:
  5. REM  Value  | Value of operator
  6. REM   of    |       X    X    X    X    X
  7. REM         | NOT  AND  OR   XOR  EQV  IMP
  8. REM  X   Y  |  X    Y    Y    Y    Y    Y
  9. REM  -------------------------------------
  10. REM  T   T  |  F    T    T    F    T    T
  11. REM  T   F  |  F    F    T    T    F    F
  12. REM  F   T  |  T    F    T    T    F    T
  13. REM  F   F  |  T    F    F    F    T    T
  14. DECLARE SUB Equate (Temp#)
  15. DECLARE SUB Parse1 (Temp#)
  16. DECLARE SUB Parse2 (Temp#)
  17. DECLARE SUB Parse3 (Temp#)
  18. DECLARE SUB Parse4 (Temp#)
  19. DECLARE SUB Parse5 (Temp#)
  20. DECLARE SUB Parse6 (Temp#)
  21. DECLARE SUB Quantity (Temp$, Temp#, Temp2#)
  22. DECLARE SUB Read.Token ()
  23. DEFINT A-Z
  24. COMMON SHARED Token AS INTEGER, Token.Index AS INTEGER
  25. COMMON SHARED Out2 AS STRING, Strng AS STRING
  26. REM (in order of precedence)
  27. REM Comparitive operators:
  28. REM   >  greater than
  29. REM   <  less than
  30. REM   =  equal to
  31. REM   #  not equal to
  32. REM Boolean operators:
  33. REM   &  AND
  34. REM   |  OR
  35. REM   !  NOT
  36. REM   ~  XOR
  37. REM   @  IMP
  38. REM   %  EQV
  39. REM Relational operators:
  40. REM   +  plus
  41. REM   -  minus/negation
  42. REM   *  multiply
  43. REM   /  divide
  44. REM   ^  exponent
  45. REM   ?  modulo
  46. REM Signature operators:
  47. REM   ABS(x)  -  absolute value of x
  48. REM   ATN(x)  -  arctangent of x
  49. REM   COS(x)  -  cosine of x
  50. REM   EXP(x)  -  e raised to the xth
  51. REM   FIX(x)  -  truncated decimal from x
  52. REM   INT(x)  -  largest integer equal to x
  53. REM   LOG(x)  -  natural logarithm of x
  54. REM   RND(x)  -  random number between 1 and x
  55. REM   SGN(x)  -  sign of x
  56. REM   SIN(x)  -  sine of x
  57. REM   SQR(x)  -  square root of x
  58. REM   TAN(x)  -  tangent of x
  59. REM Quantity operators:
  60. REM   (  quantity
  61. REM   [  quantity
  62. REM   {  quantity
  63. REM Octal number: <numeric>O
  64. REM   starts with a number, for example: 019O
  65. REM Hexidecimal number: <numeric>H
  66. REM   starts with a number, for example: 07FH
  67. REM Binary number: <numeric>B
  68. REM   such as: 1011B
  69. PRINT "Equate. Equation parser v4.0"
  70. DO
  71.    PRINT "Enter Q to quit."
  72.    PRINT "Input equation to parse:"
  73.    INPUT Out2
  74.    Out2 = UCASE$(Out2)
  75.    IF Out2 = "Q" THEN
  76.       EXIT DO
  77.    END IF
  78.    CALL Equate(Var#)
  79.    PRINT Out2; " equals "; Var#
  80. LOOP
  81. END
  82.  
  83. FUNCTION BinaryToDecimal# (B$)
  84.  Bit = 0
  85.  Value# = 0
  86.  FOR L = LEN(B$) TO 1 STEP -1
  87.     IF MID$(B$, L, 1) = "1" THEN
  88.        Value# = Value# + 2 ^ Bit
  89.     END IF
  90.     Bit = Bit + 1
  91.  NEXT
  92.  BinaryToDecimal# = Value#
  93. END FUNCTION
  94.  
  95. ' routine to pre-parse input equation, and call recursive parser
  96. SUB Equate (Temp#)
  97.  Temp# = False
  98.  Token.Index = 1
  99.  CALL Read.Token
  100.  CALL Parse1(Temp#)
  101. END SUB
  102.  
  103. FUNCTION Instrng (Temp$, Temp2$)
  104. IF LEN(Temp2$) = 0 THEN
  105.    Instrng = 0
  106. ELSE
  107.    Instrng = INSTR(Temp$, Temp2$)
  108. END IF
  109. END FUNCTION
  110.  
  111. ' starts parsing recursively in this routine. operator precedence order.
  112. SUB Parse1 (Temp#)
  113.  CALL Parse2(Temp#)
  114.  Token.Parsed$ = Strng
  115.  WHILE Instrng("<>=#", Token.Parsed$)
  116.     CALL Read.Token
  117.     CALL Parse2(Temp2#)
  118.     CALL Quantity(Token.Parsed$, Temp#, Temp2#)
  119.     Token.Parsed$ = Strng
  120.  WEND
  121. END SUB
  122.  
  123. SUB Parse2 (Temp#)
  124.  CALL Parse3(Temp#)
  125.  Token.Parsed$ = Strng
  126.  WHILE Instrng("&|!~@%", Token.Parsed$)
  127.     CALL Read.Token
  128.     CALL Parse3(Temp2#)
  129.     CALL Quantity(Token.Parsed$, Temp#, Temp2#)
  130.     Token.Parsed$ = Strng
  131.  WEND
  132. END SUB
  133.  
  134. SUB Parse3 (Temp#)
  135.  CALL Parse4(Temp#)
  136.  Token.Parsed$ = Strng
  137.  WHILE Instrng("+-", Token.Parsed$)
  138.     CALL Read.Token
  139.     CALL Parse4(Temp2#)
  140.     CALL Quantity(Token.Parsed$, Temp#, Temp2#)
  141.     Token.Parsed$ = Strng
  142.  WEND
  143. END SUB
  144.  
  145. SUB Parse4 (Temp#)
  146.  CALL Parse5(Temp#)
  147.  Token.Parsed$ = Strng
  148.  WHILE Instrng("*/", Token.Parsed$)
  149.     CALL Read.Token
  150.     CALL Parse5(Temp2#)
  151.     CALL Quantity(Token.Parsed$, Temp#, Temp2#)
  152.     Token.Parsed$ = Strng
  153.  WEND
  154. END SUB
  155.  
  156. SUB Parse5 (Temp#)
  157.  CALL Parse6(Temp#)
  158.  Token.Parsed$ = Strng
  159.  WHILE Instrng("^?", Token.Parsed$)
  160.     CALL Read.Token
  161.     CALL Parse6(Temp2#)
  162.     CALL Quantity(Token.Parsed$, Temp#, Temp2#)
  163.     Token.Parsed$ = Strng
  164.  WEND
  165. END SUB
  166.  
  167. SUB Parse6 (Temp#)
  168.  Token.Parsed$ = Strng
  169.  IF Instrng("([{", Token.Parsed$) THEN
  170.     CALL Read.Token
  171.     CALL Parse1(Temp#)
  172.     CALL Read.Token
  173.     EXIT SUB
  174.  END IF
  175.  CALL Quantity(Token.Parsed$, Temp#, Temp2#)
  176. END SUB
  177.  
  178. ' routine to apply equation symbol on two variables
  179. SUB Quantity (Token.Parsed$, Temp#, Temp2#)
  180.  SELECT CASE Token
  181.  CASE 1
  182.     SELECT CASE Token.Parsed$
  183.     CASE "+"
  184.        Temp# = Temp# + Temp2#
  185.     CASE "-"
  186.        Temp# = Temp# - Temp2#
  187.     CASE "/"
  188.        Temp# = Temp# / Temp2#
  189.     CASE "*"
  190.        Temp# = Temp# * Temp2#
  191.     CASE "^"
  192.        Temp# = Temp# ^ Temp2#
  193.     CASE "?"
  194.        Temp# = Temp# MOD Temp2#
  195.     CASE "<"
  196.        Temp# = Temp# < Temp2#
  197.     CASE ">"
  198.        Temp# = Temp# > Temp2#
  199.     CASE "="
  200.        Temp# = Temp# = Temp2#
  201.     CASE "#"
  202.        Temp# = Temp# <> Temp2#
  203.     CASE "&"
  204.        Temp# = Temp# AND Temp2#
  205.     CASE "|"
  206.        Temp# = Temp# OR Temp2#
  207.     CASE "!"
  208.        Temp# = NOT Temp2#
  209.     CASE "~"
  210.        Temp# = Temp# XOR Temp2#
  211.     CASE "@"
  212.        Temp# = Temp# IMP Temp2#
  213.     CASE "%"
  214.        Temp# = Temp# EQV Temp2#
  215.     END SELECT
  216.  CASE 2
  217.     Token.Type$ = RIGHT$(Token.Parsed$, 1)
  218.     SELECT CASE Token.Type$
  219.     CASE "b", "B"
  220.        Temp# = BinaryToDecimal#(LEFT$(Token.Parsed$, LEN(Token.Parsed$) - 1))
  221.     CASE "h", "H"
  222.        Temp# = CDBL(VAL("&H" + Token.Parsed$))
  223.     CASE "o", "O"
  224.        Temp# = CDBL(VAL("&O" + Token.Parsed$))
  225.     CASE ELSE
  226.        Temp# = CDBL(VAL(Token.Parsed$))
  227.     END SELECT
  228.     CALL Read.Token
  229.  CASE 3
  230.     SELECT CASE Token.Parsed$
  231.     CASE "PI"
  232.        Temp# = 3.14159
  233.        CALL Read.Token
  234.     CASE "E"
  235.        Temp# = 2.718
  236.        CALL Read.Token
  237.     CASE "RND"
  238.        CALL Read.Token
  239.        CALL Parse1(Temp2#)
  240.        CALL Read.Token
  241.        Temp# = CDBL(RND * Temp2# + 1)
  242.     CASE "ABS"
  243.        CALL Read.Token
  244.        CALL Parse1(Temp2#)
  245.        CALL Read.Token
  246.        Temp# = ABS(Temp2#)
  247.     CASE "SGN"
  248.        CALL Read.Token
  249.        CALL Parse1(Temp2#)
  250.        CALL Read.Token
  251.        Temp# = SGN(Temp2#)
  252.     CASE "SQR"
  253.        CALL Read.Token
  254.        CALL Parse1(Temp2#)
  255.        CALL Read.Token
  256.        Temp# = SQR(Temp2#)
  257.     CASE "INT"
  258.        CALL Read.Token
  259.        CALL Parse1(Temp2#)
  260.        CALL Read.Token
  261.        Temp# = INT(Temp2#)
  262.     CASE "FIX"
  263.        CALL Read.Token
  264.        CALL Parse1(Temp2#)
  265.        CALL Read.Token
  266.        Temp# = FIX(Temp2#)
  267.     CASE "TAN"
  268.        CALL Read.Token
  269.        CALL Parse1(Temp2#)
  270.        CALL Read.Token
  271.        Temp# = TAN(Temp2#)
  272.     CASE "ATN"
  273.        CALL Read.Token
  274.        CALL Parse1(Temp2#)
  275.        CALL Read.Token
  276.        Temp# = ATN(Temp2#)
  277.     CASE "SIN"
  278.        CALL Read.Token
  279.        CALL Parse1(Temp2#)
  280.        CALL Read.Token
  281.        Temp# = SIN(Temp2#)
  282.     CASE "COS"
  283.        CALL Read.Token
  284.        CALL Parse1(Temp2#)
  285.        CALL Read.Token
  286.        Temp# = COS(Temp2#)
  287.     CASE "EXP"
  288.        CALL Read.Token
  289.        CALL Parse1(Temp2#)
  290.        CALL Read.Token
  291.        Temp# = EXP(Temp2#)
  292.     CASE "LOG"
  293.        CALL Read.Token
  294.        CALL Parse1(Temp2#)
  295.        CALL Read.Token
  296.        Temp# = LOG(Temp2#)
  297.     END SELECT
  298.  END SELECT
  299. END SUB
  300.  
  301. ' gets next equation symbol in string, or next number, or constant mnemonic.
  302. ' counts index value of place in parse string, returns type of next symbol.
  303. SUB Read.Token
  304.  Strng = ""
  305.  IF INSTR("-+*/^()[]{}<>=#&|!~?@%", MID$(Out2, Token.Index, 1)) THEN
  306.     Token = 1
  307.     Strng = MID$(Out2, Token.Index, 1)
  308.     Token.Index = Token.Index + 1
  309.     EXIT SUB
  310.  END IF
  311.  IF MID$(Out2, Token.Index, 1) >= "0" AND MID$(Out2, Token.Index, 1) <= "9" THEN
  312.     WHILE INSTR("-+*/^()[]{}<>=#&|!~?@%", MID$(Out2, Token.Index, 1)) = False
  313.        Strng = Strng + MID$(Out2, Token.Index, 1)
  314.        Token.Index = Token.Index + 1
  315.     WEND
  316.     Token = 2
  317.     EXIT SUB
  318.  END IF
  319.  IF MID$(Out2, Token.Index, 1) = "." THEN
  320.     WHILE INSTR("-+*/^()[]{}<>=#&|!~?@%", MID$(Out2, Token.Index, 1)) = False
  321.        Strng = Strng + MID$(Out2, Token.Index, 1)
  322.        Token.Index = Token.Index + 1
  323.     WEND
  324.     Token = 2
  325.     EXIT SUB
  326.  END IF
  327.  IF MID$(Out2, Token.Index, 1) >= "A" AND MID$(Out2, Token.Index, 1) <= "Z" THEN
  328.     WHILE INSTR("-+*/^()[]{}<>=#&|!~?@%", MID$(Out2, Token.Index, 1)) = False
  329.        Strng = Strng + MID$(Out2, Token.Index, 1)
  330.        Token.Index = Token.Index + 1
  331.     WEND
  332.     Token = 3
  333.     EXIT SUB
  334.  END IF
  335. END SUB
  336.  
  337.