Author Topic: Steve's Math Evaluator  (Read 7149 times)

0 Members and 1 Guest are viewing this topic.

FellippeHeitor

  • Guest
Re: Steve's Math Evaluator
« Reply #15 on: January 06, 2020, 12:15:02 am »
No problem. Here's your latest fix (with double/triple/multiple negatives all sorted out properly) + $NOPREFIX stuff (ain't diff tools a bliss?)

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(1024, 720, 32)
  2. REDIM SHARED OName(0) AS STRING 'Operation Name
  3. REDIM SHARED PL(0) AS INTEGER 'Priority Level
  4. DIM SHARED qb64prefix_set AS LONG
  5. Set_OrderOfOperations
  6.  
  7. 'qb64prefix_set = 1 'which means the $NOPREFIX metacommand was used and _PI can be used as PI
  8.  
  9.     i$ = INPUT$(1)
  10.     CLS
  11.     SELECT CASE i$
  12.         CASE CHR$(8)
  13.             eval$ = LEFT$(eval$, LEN(eval$) - 1)
  14.         CASE CHR$(13)
  15.             eval$ = ""
  16.         CASE CHR$(27)
  17.             SYSTEM
  18.         CASE ELSE
  19.             eval$ = eval$ + i$
  20.     END SELECT
  21.     PRINT eval$
  22.     PRINT Evaluate_Expression(eval$)
  23.  
  24.  
  25. 'Steve Subs/Functins for _MATH support with CONST
  26. FUNCTION Evaluate_Expression$ (e$)
  27.     t$ = e$ 'So we preserve our original data, we parse a temp copy of it
  28.  
  29.     b = INSTR(UCASE$(e$), "EQL") 'take out assignment before the preparser sees it
  30.     IF b THEN t$ = MID$(e$, b + 3): var$ = UCASE$(LTRIM$(RTRIM$(MID$(e$, 1, b - 1))))
  31.  
  32.     PreParse t$
  33.  
  34.     IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
  35.  
  36.     'Deal with brackets first
  37.     EXP$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
  38.  
  39.     DO
  40.         Eval_E = INSTR(EXP$, ")")
  41.         IF Eval_E > 0 THEN
  42.             c = 0
  43.             DO UNTIL Eval_E - c <= 0
  44.                 c = c + 1
  45.                 IF Eval_E THEN
  46.                     IF MID$(EXP$, Eval_E - c, 1) = "(" THEN EXIT DO
  47.                 END IF
  48.             LOOP
  49.             s = Eval_E - c + 1
  50.             IF s < 1 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT SUB
  51.             eval$ = " " + MID$(EXP$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
  52.  
  53.             'PRINT "PRE-PARSE: "; eval$
  54.             ParseExpression eval$
  55.             'PRINT "AFTER PARSE: "; eval$
  56.             eval$ = LTRIM$(RTRIM$(eval$))
  57.             IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT SUB
  58.             EXP$ = DWD(LEFT$(EXP$, s - 2) + eval$ + MID$(EXP$, Eval_E + 1))
  59.             'PRINT exp$
  60.             IF MID$(EXP$, 1, 1) = "N" THEN MID$(EXP$, 1) = "-"
  61.  
  62.             'temppp$ = DWD(LEFT$(exp$, s - 2) + " ## " + eval$ + " ## " + MID$(exp$, e + 1))
  63.         END IF
  64.     LOOP UNTIL Eval_E = 0
  65.     c = 0
  66.     DO
  67.         c = c + 1
  68.         SELECT CASE MID$(EXP$, c, 1)
  69.             CASE "0" TO "9", ".", "-" 'At this point, we should only have number values left.
  70.             CASE ELSE: Evaluate_Expression$ = "ERROR - Unknown Diagnosis: (" + EXP$ + ") ": EXIT SUB
  71.         END SELECT
  72.     LOOP UNTIL c >= LEN(EXP$)
  73.  
  74.     Evaluate_Expression$ = EXP$
  75.  
  76.  
  77.  
  78. SUB ParseExpression (EXP$)
  79.     DIM num(10) AS STRING
  80.     'PRINT exp$
  81.     EXP$ = DWD(EXP$)
  82.     'We should now have an expression with no () to deal with
  83.     'IF MID$(exp$, 2, 1) = "-" THEN exp$ = "0+" + MID$(exp$, 2)
  84.     FOR J = 1 TO 250
  85.         lowest = 0
  86.         DO UNTIL lowest = LEN(EXP$)
  87.             lowest = LEN(EXP$): OpOn = 0
  88.             FOR P = 1 TO UBOUND(OName)
  89.                 'Look for first valid operator
  90.                 IF J = PL(P) THEN 'Priority levels match
  91.                     IF LEFT$(EXP$, 1) = "-" THEN startAt = 2 ELSE startAt = 1
  92.                     op = INSTR(startAt, EXP$, OName(P))
  93.                     IF op = 0 AND LEFT$(OName(P), 1) = "_" AND qb64prefix_set = 1 THEN
  94.                         'try again without prefix
  95.                         op = INSTR(startAt, EXP$, MID$(OName(P), 2))
  96.                         IF op > 0 THEN
  97.                             EXP$ = LEFT$(EXP$, op - 1) + "_" + MID$(EXP$, op)
  98.                             lowest = lowest + 1
  99.                         END IF
  100.                     END IF
  101.                     IF op > 0 AND op < lowest THEN lowest = op: OpOn = P
  102.                 END IF
  103.             NEXT
  104.             IF OpOn = 0 THEN EXIT DO 'We haven't gotten to the proper PL for this OP to be processed yet.
  105.             IF LEFT$(EXP$, 1) = "-" THEN op = INSTR(2, EXP$, OName(OpOn)) ELSE op = INSTR(EXP$, OName(OpOn))
  106.             numset = 0
  107.  
  108.             '*** SPECIAL OPERATION RULESETS
  109.             IF OName(OpOn) = "-" THEN 'check for BOOLEAN operators before the -
  110.                 SELECT CASE MID$(EXP$, op - 3, 3)
  111.                     CASE "NOT", "XOR", "AND", "EQV", "IMP"
  112.                         EXIT DO 'Not an operator, it's a negative
  113.                 END SELECT
  114.                 IF MID$(EXP$, op - 3, 2) = "OR" THEN EXIT DO 'Not an operator, it's a negative
  115.             END IF
  116.  
  117.             IF op THEN
  118.                 c = LEN(OName(OpOn)) - 1
  119.                 DO
  120.                     SELECT CASE MID$(EXP$, op + c + 1, 1)
  121.                         CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N": numset = -1 'Valid digit
  122.                         CASE "-" 'We need to check if it's a minus or a negative
  123.                             IF OName(OpOn) = "_PI" OR numset THEN EXIT DO
  124.                         CASE ",": numset = 0
  125.                         CASE ELSE 'Not a valid digit, we found our separator
  126.                             EXIT DO
  127.                     END SELECT
  128.                     c = c + 1
  129.                 LOOP UNTIL op + c >= LEN(EXP$)
  130.                 e = op + c
  131.  
  132.                 c = 0
  133.                 DO
  134.                     c = c + 1
  135.                     SELECT CASE MID$(EXP$, op - c, 1)
  136.                         CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N" 'Valid digit
  137.                         CASE "-" 'We need to check if it's a minus or a negative
  138.                             c1 = c
  139.                             bad = 0
  140.                             DO
  141.                                 c1 = c1 + 1
  142.                                 SELECT CASE MID$(EXP$, op - c1, 1)
  143.                                     CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "."
  144.                                         bad = -1
  145.                                         EXIT DO 'It's a minus sign
  146.                                     CASE ELSE
  147.                                         'It's a negative sign and needs to count as part of our numbers
  148.                                 END SELECT
  149.                             LOOP UNTIL op - c1 <= 0
  150.                             IF bad THEN EXIT DO 'We found our seperator
  151.                         CASE ELSE 'Not a valid digit, we found our separator
  152.                             EXIT DO
  153.                     END SELECT
  154.                 LOOP UNTIL op - c <= 0
  155.                 s = op - c
  156.                 num(1) = MID$(EXP$, s + 1, op - s - 1) 'Get our first number
  157.                 num(2) = MID$(EXP$, op + LEN(OName(OpOn)), e - op - LEN(OName(OpOn)) + 1) 'Get our second number
  158.                 IF MID$(num(1), 1, 1) = "N" THEN MID$(num(1), 1) = "-"
  159.                 IF MID$(num(2), 1, 1) = "N" THEN MID$(num(2), 1) = "-"
  160.                 IF num(1) = "-" THEN
  161.                     num(3) = "N" + EvaluateNumbers(OpOn, num())
  162.                 ELSE
  163.                     num(3) = EvaluateNumbers(OpOn, num())
  164.                 END IF
  165.                 IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N"
  166.                 'PRINT "*************"
  167.                 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
  168.                 IF LEFT$(num(3), 5) = "ERROR" THEN EXP$ = num(3): EXIT SUB
  169.                 EXP$ = LTRIM$(N2S(DWD(LEFT$(EXP$, s) + RTRIM$(LTRIM$(num(3))) + MID$(EXP$, e + 1))))
  170.                 'PRINT exp$
  171.             END IF
  172.             op = 0
  173.         LOOP
  174.     NEXT
  175.  
  176.  
  177.  
  178.  
  179. SUB Set_OrderOfOperations
  180.     'PL sets our priortity level. 1 is highest to 65535 for the lowest.
  181.     'I used a range here so I could add in new priority levels as needed.
  182.     'OName ended up becoming the name of our commands, as I modified things.... Go figure!  LOL!
  183.  
  184.     'Constants get evaluated first, with a Priority Level of 1
  185.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_PI"
  186.     REDIM _PRESERVE PL(i): PL(i) = 10
  187.     'I'm not certain where exactly percentages should go.  They kind of seem like a special case to me.  COS10% should be COS.1 I'd think...
  188.     'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
  189.  
  190.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UOF" 'convert to unsigned offset
  191.     REDIM _PRESERVE PL(i): PL(i) = 5
  192.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_OF" 'convert to offset
  193.     REDIM _PRESERVE PL(i): PL(i) = 5
  194.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UBY" 'convert to unsigned byte
  195.     REDIM _PRESERVE PL(i): PL(i) = 5
  196.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_BY" 'convert to byte
  197.     REDIM _PRESERVE PL(i): PL(i) = 5
  198.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UIN" 'convert to unsigned integer
  199.     REDIM _PRESERVE PL(i): PL(i) = 5
  200.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_IN" 'convert to integer
  201.     REDIM _PRESERVE PL(i): PL(i) = 5
  202.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UIF" 'convert to unsigned int64
  203.     REDIM _PRESERVE PL(i): PL(i) = 5
  204.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_IF" 'convert to int64
  205.     REDIM _PRESERVE PL(i): PL(i) = 5
  206.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_ULO" 'convert to unsigned long
  207.     REDIM _PRESERVE PL(i): PL(i) = 5
  208.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_LO" 'convert to long
  209.     REDIM _PRESERVE PL(i): PL(i) = 5
  210.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_SI" 'convert to single
  211.     REDIM _PRESERVE PL(i): PL(i) = 5
  212.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_FL" 'convert to float
  213.     REDIM _PRESERVE PL(i): PL(i) = 5
  214.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_DO" 'convert to double
  215.     REDIM _PRESERVE PL(i): PL(i) = 5
  216.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_UBI" 'convert to unsigned bit
  217.     REDIM _PRESERVE PL(i): PL(i) = 5
  218.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_BI" 'convert to bit
  219.     REDIM _PRESERVE PL(i): PL(i) = 5
  220.  
  221.     'Then Functions with PL 10
  222.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ACOS"
  223.     REDIM _PRESERVE PL(i): PL(i) = 10
  224.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ASIN"
  225.     REDIM _PRESERVE PL(i): PL(i) = 10
  226.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCSEC"
  227.     REDIM _PRESERVE PL(i): PL(i) = 10
  228.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCSC"
  229.     REDIM _PRESERVE PL(i): PL(i) = 10
  230.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ARCCOT"
  231.     REDIM _PRESERVE PL(i): PL(i) = 10
  232.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SECH"
  233.     REDIM _PRESERVE PL(i): PL(i) = 10
  234.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSCH"
  235.     REDIM _PRESERVE PL(i): PL(i) = 10
  236.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COTH"
  237.     REDIM _PRESERVE PL(i): PL(i) = 10
  238.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "COS"
  239.     REDIM _PRESERVE PL(i): PL(i) = 10
  240.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SIN"
  241.     REDIM _PRESERVE PL(i): PL(i) = 10
  242.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "TAN"
  243.     REDIM _PRESERVE PL(i): PL(i) = 10
  244.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "LOG"
  245.     REDIM _PRESERVE PL(i): PL(i) = 10
  246.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EXP"
  247.     REDIM _PRESERVE PL(i): PL(i) = 10
  248.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ATN"
  249.     REDIM _PRESERVE PL(i): PL(i) = 10
  250.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2R"
  251.     REDIM _PRESERVE PL(i): PL(i) = 10
  252.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_D2G"
  253.     REDIM _PRESERVE PL(i): PL(i) = 10
  254.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2D"
  255.     REDIM _PRESERVE PL(i): PL(i) = 10
  256.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_R2G"
  257.     REDIM _PRESERVE PL(i): PL(i) = 10
  258.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2D"
  259.     REDIM _PRESERVE PL(i): PL(i) = 10
  260.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_G2R"
  261.     REDIM _PRESERVE PL(i): PL(i) = 10
  262.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ABS"
  263.     REDIM _PRESERVE PL(i): PL(i) = 10
  264.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SGN"
  265.     REDIM _PRESERVE PL(i): PL(i) = 10
  266.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "INT"
  267.     REDIM _PRESERVE PL(i): PL(i) = 10
  268.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ROUND"
  269.     REDIM _PRESERVE PL(i): PL(i) = 10
  270.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CEIL"
  271.     REDIM _PRESERVE PL(i): PL(i) = 10
  272.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "FIX"
  273.     REDIM _PRESERVE PL(i): PL(i) = 10
  274.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_SEC"
  275.     REDIM _PRESERVE PL(i): PL(i) = 10
  276.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_CSC"
  277.     REDIM _PRESERVE PL(i): PL(i) = 10
  278.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_COT"
  279.     REDIM _PRESERVE PL(i): PL(i) = 10
  280.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ASC"
  281.     REDIM _PRESERVE PL(i): PL(i) = 10
  282.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "CHR$"
  283.     REDIM _PRESERVE PL(i): PL(i) = 10
  284.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_RG" '_RGB32 converted
  285.     REDIM _PRESERVE PL(i): PL(i) = 10
  286.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_RA" '_RGBA32 converted
  287.     REDIM _PRESERVE PL(i): PL(i) = 10
  288.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGB"
  289.     REDIM _PRESERVE PL(i): PL(i) = 10
  290.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RGBA"
  291.     REDIM _PRESERVE PL(i): PL(i) = 10
  292.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_RX" '_RED32 converted
  293.     REDIM _PRESERVE PL(i): PL(i) = 10
  294.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_GR" ' _GREEN32 converted
  295.     REDIM _PRESERVE PL(i): PL(i) = 10
  296.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_BL" '_BLUE32 converted
  297.     REDIM _PRESERVE PL(i): PL(i) = 10
  298.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "C_AL" '_ALPHA32 converted
  299.     REDIM _PRESERVE PL(i): PL(i) = 10
  300.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_RED"
  301.     REDIM _PRESERVE PL(i): PL(i) = 10
  302.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_GREEN"
  303.     REDIM _PRESERVE PL(i): PL(i) = 10
  304.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_BLUE"
  305.     REDIM _PRESERVE PL(i): PL(i) = 10
  306.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "_ALPHA"
  307.     REDIM _PRESERVE PL(i): PL(i) = 10
  308.  
  309.     'Exponents with PL 20
  310.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "^"
  311.     REDIM _PRESERVE PL(i): PL(i) = 20
  312.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "SQR"
  313.     REDIM _PRESERVE PL(i): PL(i) = 20
  314.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "ROOT"
  315.     REDIM _PRESERVE PL(i): PL(i) = 20
  316.     'Multiplication and Division PL 30
  317.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "*"
  318.     REDIM _PRESERVE PL(i): PL(i) = 30
  319.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "/"
  320.     REDIM _PRESERVE PL(i): PL(i) = 30
  321.     'Integer Division PL 40
  322.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "\"
  323.     REDIM _PRESERVE PL(i): PL(i) = 40
  324.     'MOD PL 50
  325.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "MOD"
  326.     REDIM _PRESERVE PL(i): PL(i) = 50
  327.     'Addition and Subtraction PL 60
  328.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "+"
  329.     REDIM _PRESERVE PL(i): PL(i) = 60
  330.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "-"
  331.     REDIM _PRESERVE PL(i): PL(i) = 60
  332.  
  333.     'Relational Operators =, >, <, <>, <=, >=   PL 70
  334.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<>"
  335.     REDIM _PRESERVE PL(i): PL(i) = 70
  336.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "><" 'These next three are just reversed symbols as an attempt to help process a common typo
  337.     REDIM _PRESERVE PL(i): PL(i) = 70
  338.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<="
  339.     REDIM _PRESERVE PL(i): PL(i) = 70
  340.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = ">="
  341.     REDIM _PRESERVE PL(i): PL(i) = 70
  342.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=<" 'I personally can never keep these things straight.  Is it < = or = <...
  343.     REDIM _PRESERVE PL(i): PL(i) = 70
  344.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "=>" 'Who knows, check both!
  345.     REDIM _PRESERVE PL(i): PL(i) = 70
  346.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = ">"
  347.     REDIM _PRESERVE PL(i): PL(i) = 70
  348.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "<"
  349.     REDIM _PRESERVE PL(i): PL(i) = 70
  350.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "="
  351.     REDIM _PRESERVE PL(i): PL(i) = 70
  352.     'Logical Operations PL 80+
  353.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "NOT"
  354.     REDIM _PRESERVE PL(i): PL(i) = 80
  355.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "AND"
  356.     REDIM _PRESERVE PL(i): PL(i) = 90
  357.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "OR"
  358.     REDIM _PRESERVE PL(i): PL(i) = 100
  359.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "XOR"
  360.     REDIM _PRESERVE PL(i): PL(i) = 110
  361.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "EQV"
  362.     REDIM _PRESERVE PL(i): PL(i) = 120
  363.     i = i + 1: REDIM _PRESERVE OName(i): OName(i) = "IMP"
  364.     REDIM _PRESERVE PL(i): PL(i) = 130
  365.  
  366.  
  367.  
  368. FUNCTION EvaluateNumbers$ (p, num() AS STRING)
  369.     DIM n1 AS _FLOAT, n2 AS _FLOAT, n3 AS _FLOAT
  370.     'PRINT "EN$: "; num(1), num(2), OName(p)
  371.     IF INSTR(num(1), ",") THEN EvaluateNumbers$ = "ERROR - Invalid comma (" + num(1) + ")": EXIT FUNCTION
  372.     IF INSTR(num(2), ",") THEN
  373.         SELECT CASE OName(p) 'only certain commands should pass a comma value
  374.             CASE "C_RG", "C_RA", "_RGB", "_RGBA", "_RED", "_GREEN", "C_BL", "_ALPHA"
  375.             CASE ELSE
  376.                 EvaluateNumbers$ = "ERROR - Invalid comma (" + num(2) + ")": EXIT FUNCTION
  377.         END SELECT
  378.     END IF
  379.  
  380.     SELECT CASE PL(p) 'divide up the work so we want do as much case checking
  381.         CASE 5 'Type conversions
  382.             'Note, these are special cases and work with the number BEFORE the command and not after
  383.             SELECT CASE OName(p) 'Depending on our operator..
  384.                 CASE "C_UOF": n1~%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%&)))
  385.                 CASE "C_ULO": n1%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%&)))
  386.                 CASE "C_UBY": n1~%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%%)))
  387.                 CASE "C_UIN": n1~% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%)))
  388.                 CASE "C_BY": n1%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%%)))
  389.                 CASE "C_IN": n1% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%)))
  390.                 CASE "C_UIF": n1~&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&&)))
  391.                 CASE "C_OF": n1~& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&)))
  392.                 CASE "C_IF": n1&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&&)))
  393.                 CASE "C_LO": n1& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&)))
  394.                 CASE "C_UBI": n1~` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~`)))
  395.                 CASE "C_BI": n1` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1`)))
  396.                 CASE "C_FL": n1## = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1##)))
  397.                 CASE "C_DO": n1# = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1#)))
  398.                 CASE "C_SI": n1! = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1!)))
  399.             END SELECT
  400.             EXIT FUNCTION
  401.         CASE 10 'functions
  402.             SELECT CASE OName(p) 'Depending on our operator..
  403.                 CASE "_PI"
  404.                     n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
  405.                     IF num(2) <> "" THEN n1 = n1 * VAL(num(2))
  406.                 CASE "_ACOS": n1 = _ACOS(VAL(num(2)))
  407.                 CASE "_ASIN": n1 = _ASIN(VAL(num(2)))
  408.                 CASE "_ARCSEC": n1 = _ARCSEC(VAL(num(2)))
  409.                 CASE "_ARCCSC": n1 = _ARCCSC(VAL(num(2)))
  410.                 CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
  411.                 CASE "_SECH": n1 = _SECH(VAL(num(2)))
  412.                 CASE "_CSCH": n1 = _CSCH(VAL(num(2)))
  413.                 CASE "_COTH": n1 = _COTH(VAL(num(2)))
  414.                 CASE "C_RG"
  415.                     n$ = num(2)
  416.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB32": EXIT FUNCTION
  417.                     c1 = INSTR(n$, ",")
  418.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  419.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  420.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  421.                     IF c1 = 0 THEN 'there's no comma in the command to parse.  It's a grayscale value
  422.                         n = VAL(num(2))
  423.                         n1 = _RGB32(n, n, n)
  424.                     ELSEIF c2 = 0 THEN 'there's one comma and not 2.  It's grayscale with alpha.
  425.                         n = VAL(LEFT$(num(2), c1))
  426.                         n2 = VAL(MID$(num(2), c1 + 1))
  427.                         n1 = _RGBA32(n, n, n, n2)
  428.                     ELSEIF c3 = 0 THEN 'there's two commas.  It's _RGB values
  429.                         n = VAL(LEFT$(num(2), c1))
  430.                         n2 = VAL(MID$(num(2), c1 + 1))
  431.                         n3 = VAL(MID$(num(2), c2 + 1))
  432.                         n1 = _RGB32(n, n2, n3)
  433.                     ELSEIF c4 = 0 THEN 'there's three commas.  It's _RGBA values
  434.                         n = VAL(LEFT$(num(2), c1))
  435.                         n2 = VAL(MID$(num(2), c1 + 1))
  436.                         n3 = VAL(MID$(num(2), c2 + 1))
  437.                         n4 = VAL(MID$(num(2), c3 + 1))
  438.                         n1 = _RGBA32(n, n2, n3, n4)
  439.                     ELSE 'we have more than three commas.  I have no idea WTH type of values got passed here!
  440.                         EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  441.                     END IF
  442.                 CASE "C_RA"
  443.                     n$ = num(2)
  444.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA32": EXIT FUNCTION
  445.                     c1 = INSTR(n$, ",")
  446.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  447.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  448.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  449.                     IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  450.                     'we have to have 3 commas; not more, not less.
  451.                     n = VAL(LEFT$(num(2), c1))
  452.                     n2 = VAL(MID$(num(2), c1 + 1))
  453.                     n3 = VAL(MID$(num(2), c2 + 1))
  454.                     n4 = VAL(MID$(num(2), c3 + 1))
  455.                     n1 = _RGBA32(n, n2, n3, n4)
  456.                 CASE "_RGB"
  457.                     n$ = num(2)
  458.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB": EXIT FUNCTION
  459.                     c1 = INSTR(n$, ",")
  460.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  461.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  462.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  463.                     IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGB requires 4 parameters for Red, Green, Blue, ScreenMode.": EXIT FUNCTION
  464.                     'we have to have 3 commas; not more, not less.
  465.                     n = VAL(LEFT$(num(2), c1))
  466.                     n2 = VAL(MID$(num(2), c1 + 1))
  467.                     n3 = VAL(MID$(num(2), c2 + 1))
  468.                     n4 = VAL(MID$(num(2), c3 + 1))
  469.                     SELECT CASE n4
  470.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  471.                         CASE ELSE
  472.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n4) + ")": EXIT FUNCTION
  473.                     END SELECT
  474.                     t = _NEWIMAGE(1, 1, n4)
  475.                     n1 = _RGB(n, n2, n3, t)
  476.                     _FREEIMAGE t
  477.                 CASE "_RGBA"
  478.                     n$ = num(2)
  479.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA": EXIT FUNCTION
  480.                     c1 = INSTR(n$, ",")
  481.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  482.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  483.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  484.                     IF c4 THEN c5 = INSTR(c4 + 1, n$, ",")
  485.                     IF c4 = 0 OR c5 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGBA requires 5 parameters for Red, Green, Blue, Alpha, ScreenMode.": EXIT FUNCTION
  486.                     'we have to have 4 commas; not more, not less.
  487.                     n = VAL(LEFT$(num(2), c1))
  488.                     n2 = VAL(MID$(num(2), c1 + 1))
  489.                     n3 = VAL(MID$(num(2), c2 + 1))
  490.                     n4 = VAL(MID$(num(2), c3 + 1))
  491.                     n5 = VAL(MID$(num(2), c4 + 1))
  492.                     SELECT CASE n5
  493.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  494.                         CASE ELSE
  495.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n5) + ")": EXIT FUNCTION
  496.                     END SELECT
  497.                     t = _NEWIMAGE(1, 1, n5)
  498.                     n1 = _RGBA(n, n2, n3, n4, t)
  499.                     _FREEIMAGE t
  500.                 CASE "_RED", "_GREEN", "_BLUE", "_ALPHA"
  501.                     n$ = num(2)
  502.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  503.                     c1 = INSTR(n$, ",")
  504.                     IF c1 = 0 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  505.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  506.                     IF c2 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  507.                     n = VAL(LEFT$(num(2), c1))
  508.                     n2 = VAL(MID$(num(2), c1 + 1))
  509.                     SELECT CASE n2
  510.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  511.                         CASE ELSE
  512.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n2) + ")": EXIT FUNCTION
  513.                     END SELECT
  514.                     t = _NEWIMAGE(1, 1, n4)
  515.                     SELECT CASE OName(p)
  516.                         CASE "_RED": n1 = _RED(n, t)
  517.                         CASE "_BLUE": n1 = _BLUE(n, t)
  518.                         CASE "_GREEN": n1 = _GREEN(n, t)
  519.                         CASE "_ALPHA": n1 = _ALPHA(n, t)
  520.                     END SELECT
  521.                     _FREEIMAGE t
  522.                 CASE "C_RX", "C_GR", "C_BL", "C_AL"
  523.                     n$ = num(2)
  524.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  525.                     n = VAL(num(2))
  526.                     SELECT CASE OName(p)
  527.                         CASE "C_RX": n1 = _RED32(n)
  528.                         CASE "C_BL": n1 = _BLUE32(n)
  529.                         CASE "C_GR": n1 = _GREEN32(n)
  530.                         CASE "C_AL": n1 = _ALPHA32(n)
  531.                     END SELECT
  532.                 CASE "COS": n1 = COS(VAL(num(2)))
  533.                 CASE "SIN": n1 = SIN(VAL(num(2)))
  534.                 CASE "TAN": n1 = TAN(VAL(num(2)))
  535.                 CASE "LOG": n1 = LOG(VAL(num(2)))
  536.                 CASE "EXP": n1 = EXP(VAL(num(2)))
  537.                 CASE "ATN": n1 = ATN(VAL(num(2)))
  538.                 CASE "_D2R": n1 = 0.0174532925 * (VAL(num(2)))
  539.                 CASE "_D2G": n1 = 1.1111111111 * (VAL(num(2)))
  540.                 CASE "_R2D": n1 = 57.2957795 * (VAL(num(2)))
  541.                 CASE "_R2G": n1 = 0.015707963 * (VAL(num(2)))
  542.                 CASE "_G2D": n1 = 0.9 * (VAL(num(2)))
  543.                 CASE "_G2R": n1 = 63.661977237 * (VAL(num(2)))
  544.                 CASE "ABS": n1 = ABS(VAL(num(2)))
  545.                 CASE "SGN": n1 = SGN(VAL(num(2)))
  546.                 CASE "INT": n1 = INT(VAL(num(2)))
  547.                 CASE "_ROUND": n1 = _ROUND(VAL(num(2)))
  548.                 CASE "_CEIL": n1 = _CEIL(VAL(num(2)))
  549.                 CASE "FIX": n1 = FIX(VAL(num(2)))
  550.                 CASE "_SEC": n1 = _SEC(VAL(num(2)))
  551.                 CASE "_CSC": n1 = _CSC(VAL(num(2)))
  552.                 CASE "_COT": n1 = _COT(VAL(num(2)))
  553.             END SELECT
  554.         CASE 20 TO 60 'Math Operators
  555.             SELECT CASE OName(p) 'Depending on our operator..
  556.                 CASE "^": n1 = VAL(num(1)) ^ VAL(num(2))
  557.                 CASE "SQR": n1 = SQR(VAL(num(2)))
  558.                 CASE "ROOT"
  559.                     n1 = VAL(num(1)): n2 = VAL(num(2))
  560.                     IF n2 = 1 THEN EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))): EXIT FUNCTION
  561.                     IF n1 < 0 AND n2 >= 1 THEN sign = -1: n1 = -n1 ELSE sign = 1
  562.                     n3 = 1## / n2
  563.                     IF n3 <> INT(n3) AND n2 < 1 THEN sign = SGN(n1): n1 = ABS(n1)
  564.                     n1 = sign * (n1 ^ n3)
  565.                 CASE "*": n1 = VAL(num(1)) * VAL(num(2))
  566.                 CASE "/": n1 = VAL(num(1)) / VAL(num(2))
  567.                 CASE "\"
  568.                     IF VAL(num(2)) <> 0 THEN
  569.                         n1 = VAL(num(1)) \ VAL(num(2))
  570.                     ELSE
  571.                         EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
  572.                         EXIT FUNCTION
  573.                     END IF
  574.                 CASE "MOD": n1 = VAL(num(1)) MOD VAL(num(2))
  575.                 CASE "+": n1 = VAL(num(1)) + VAL(num(2))
  576.                 CASE "-":
  577.                     n1 = VAL(num(1)) - VAL(num(2))
  578.             END SELECT
  579.         CASE 70 'Relational Operators =, >, <, <>, <=, >=
  580.             SELECT CASE OName(p) 'Depending on our operator..
  581.                 CASE "=": n1 = VAL(num(1)) = VAL(num(2))
  582.                 CASE ">": n1 = VAL(num(1)) > VAL(num(2))
  583.                 CASE "<": n1 = VAL(num(1)) < VAL(num(2))
  584.                 CASE "<>", "><": n1 = VAL(num(1)) <> VAL(num(2))
  585.                 CASE "<=", "=<": n1 = VAL(num(1)) <= VAL(num(2))
  586.                 CASE ">=", "=>": n1 = VAL(num(1)) >= VAL(num(2))
  587.             END SELECT
  588.         CASE ELSE 'a value we haven't processed elsewhere
  589.             SELECT CASE OName(p) 'Depending on our operator..
  590.                 CASE "NOT": n1 = NOT VAL(num(2))
  591.                 CASE "AND": n1 = VAL(num(1)) AND VAL(num(2))
  592.                 CASE "OR": n1 = VAL(num(1)) OR VAL(num(2))
  593.                 CASE "XOR": n1 = VAL(num(1)) XOR VAL(num(2))
  594.                 CASE "EQV": n1 = VAL(num(1)) EQV VAL(num(2))
  595.                 CASE "IMP": n1 = VAL(num(1)) IMP VAL(num(2))
  596.             END SELECT
  597.     END SELECT
  598.  
  599.     EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1)))
  600.  
  601. FUNCTION DWD$ (EXP$) 'Deal With Duplicates
  602.     'To deal with duplicate operators in our code.
  603.     'Such as --  becomes a +
  604.     '++ becomes a +
  605.     '+- becomes a -
  606.     '-+ becomes a -
  607.     t$ = EXP$
  608.     DO
  609.         bad = 0
  610.         DO
  611.             l = INSTR(t$, "++")
  612.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  613.         LOOP UNTIL l = 0
  614.         DO
  615.             l = INSTR(t$, "+-")
  616.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  617.         LOOP UNTIL l = 0
  618.         DO
  619.             l = INSTR(t$, "-+")
  620.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  621.         LOOP UNTIL l = 0
  622.         DO
  623.             l = INSTR(t$, "--")
  624.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  625.         LOOP UNTIL l = 0
  626.         'PRINT "FIXING: "; t$
  627.     LOOP UNTIL NOT bad
  628.     DWD$ = t$
  629.  
  630. SUB PreParse (e$)
  631.     DIM f AS _FLOAT
  632.     STATIC TypeMod(1 TO 21) AS STRING, ConvertedMod(1 TO 21) AS STRING
  633.     IF TypeMod(1) = "" THEN
  634.         TypeMod(1) = "~`": ConvertedMod(1) = "C_UBI" 'unsigned bit
  635.         TypeMod(2) = "~%%": ConvertedMod(2) = "C_UBY" 'unsigned byte
  636.         TypeMod(3) = "~%&": ConvertedMod(3) = "C_UOF" 'unsigned offset
  637.         TypeMod(4) = "~%": ConvertedMod(4) = "C_UIN" 'unsigned integer
  638.         TypeMod(5) = "~&&": ConvertedMod(5) = "C_UIF" 'unsigned integer64
  639.         TypeMod(6) = "~&": ConvertedMod(6) = "C_ULO" 'unsigned long
  640.         TypeMod(7) = "`": ConvertedMod(7) = "C_BI" 'bit
  641.         TypeMod(8) = "%%": ConvertedMod(8) = "C_BY" 'byte
  642.         TypeMod(9) = "%&": ConvertedMod(9) = "C_OF" 'offset
  643.         TypeMod(10) = "%": ConvertedMod(10) = "C_IN" 'integer
  644.         TypeMod(11) = "&&": ConvertedMod(11) = "C_IF" 'integer64
  645.         TypeMod(12) = "&": ConvertedMod(12) = "C_LO" 'long
  646.         TypeMod(13) = "!": ConvertedMod(13) = "C_SI" 'single
  647.         TypeMod(14) = "##": ConvertedMod(14) = "C_FL" 'float
  648.         TypeMod(15) = "#": ConvertedMod(15) = "C_DO" 'double
  649.         TypeMod(16) = "_RGB32": ConvertedMod(16) = "C_RG" 'rgb32
  650.         TypeMod(17) = "_RGBA32": ConvertedMod(17) = "C_RA" 'rgba32
  651.         TypeMod(18) = "_RED32": ConvertedMod(18) = "C_RX" 'red32
  652.         TypeMod(19) = "_GREEN32": ConvertedMod(19) = "C_GR" 'green32
  653.         TypeMod(20) = "_BLUE32": ConvertedMod(20) = "C_BL" 'blue32
  654.         TypeMod(21) = "_ALPHA32": ConvertedMod(21) = "C_AL" 'alpha32
  655.     END IF
  656.     t$ = e$
  657.  
  658.     'First strip all spaces
  659.     t$ = ""
  660.     FOR i = 1 TO LEN(e$)
  661.         IF MID$(e$, i, 1) <> " " THEN t$ = t$ + MID$(e$, i, 1)
  662.     NEXT
  663.  
  664.     t$ = UCASE$(t$)
  665.     IF t$ = "" THEN e$ = "ERROR -- NULL string; nothing to evaluate": EXIT SUB
  666.  
  667.     'ERROR CHECK by counting our brackets
  668.     l = 0
  669.     DO
  670.         l = INSTR(l + 1, t$, "("): IF l THEN c = c + 1
  671.     LOOP UNTIL l = 0
  672.     l = 0
  673.     DO
  674.         l = INSTR(l + 1, t$, ")"): IF l THEN c1 = c1 + 1
  675.     LOOP UNTIL l = 0
  676.     IF c <> c1 THEN e$ = "ERROR -- Bad Parenthesis:" + STR$(c) + "( vs" + STR$(c1) + ")": EXIT SUB
  677.  
  678.     'Modify so that NOT will process properly
  679.     l = 0
  680.     DO
  681.         l = INSTR(l + 1, t$, "NOT")
  682.         IF l THEN
  683.             'We need to work magic on the statement so it looks pretty.
  684.             ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
  685.             'Look for something not proper
  686.             l1 = INSTR(l + 1, t$, "AND")
  687.             IF l1 = 0 OR (INSTR(l + 1, t$, "OR") > 0 AND INSTR(l + 1, t$, "OR") < l1) THEN l1 = INSTR(l + 1, t$, "OR")
  688.             IF l1 = 0 OR (INSTR(l + 1, t$, "XOR") > 0 AND INSTR(l + 1, t$, "XOR") < l1) THEN l1 = INSTR(l + 1, t$, "XOR")
  689.             IF l1 = 0 OR (INSTR(l + 1, t$, "EQV") > 0 AND INSTR(l + 1, t$, "EQV") < l1) THEN l1 = INSTR(l + 1, t$, "EQV")
  690.             IF l1 = 0 OR (INSTR(l + 1, t$, "IMP") > 0 AND INSTR(l + 1, t$, "IMP") < l1) THEN l1 = INSTR(l + 1, t$, "IMP")
  691.             IF l1 = 0 THEN l1 = LEN(t$) + 1
  692.             t$ = LEFT$(t$, l - 1) + "(" + MID$(t$, l, l1 - l) + ")" + MID$(t$, l + l1 - l)
  693.             l = l + 3
  694.             'PRINT t$
  695.         END IF
  696.     LOOP UNTIL l = 0
  697.  
  698.     'Modify so that % will process properly
  699.  
  700.     FOR j = 1 TO UBOUND(TypeMod)
  701.         l = 0
  702.         DO
  703.             l = INSTR(l + 1, t$, TypeMod(j))
  704.             IF l = 0 THEN EXIT DO
  705.             i = 0: l1 = 0: l2 = 0: lo = LEN(TypeMod(j))
  706.             DO
  707.                 IF PL(i) > 10 THEN
  708.                     l2 = _INSTRREV(l, t$, OName$(i))
  709.                     IF l2 > 0 AND l2 > l1 THEN l1 = l2
  710.                 END IF
  711.                 i = i + lo
  712.             LOOP UNTIL i > UBOUND(PL)
  713.             'PRINT "L1:"; l1; "L"; l
  714.             l$ = LEFT$(t$, l1)
  715.             m$ = MID$(t$, l1 + 1, l - l1 - 1)
  716.             r$ = ConvertedMod(j) + MID$(t$, l + lo)
  717.             'PRINT "Y$: "; TypeMod(j)
  718.             'PRINT "L$: "; l$
  719.             'PRINT "M$: "; m$
  720.             'PRINT "R$: "; r$
  721.             IF j > 15 THEN
  722.                 t$ = l$ + m$ + r$ 'replacement routine for commands which might get confused with others, like _RGB and _RGB32
  723.             ELSE
  724.                 'the first 15 commands need to properly place the parenthesis around the value we want to convert.
  725.                 t$ = l$ + "(" + m$ + ")" + r$
  726.             END IF
  727.             'PRINT "T$: "; t$
  728.             l = l + 2 + LEN(TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and  ")"
  729.         LOOP
  730.     NEXT
  731.     'PRINT "HERE: "; t$
  732.  
  733.  
  734.     'Check for bad operators before a ( bracket
  735.     l = 0
  736.     DO
  737.         l = INSTR(l + 1, t$, "(")
  738.         IF l AND l > 2 THEN 'Don't check the starting bracket; there's nothing before it.
  739.             good = 0
  740.             'PRINT "BEFORE: "; t$; l
  741.             FOR i = 1 TO UBOUND(OName)
  742.  
  743.                 m$ = MID$(t$, l - LEN(OName(i)), LEN(OName(i)))
  744.                 'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
  745.                 IF m$ = OName(i) THEN
  746.                     IF PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
  747.                 ELSE
  748.                     IF LEFT$(OName(i), 1) = "_" AND qb64prefix_set = 1 THEN
  749.                         'try without prefix
  750.                         IF MID$(t$, l - (LEN(OName(i)) - 1), LEN(OName(i)) - 1) = MID$(OName(i), 2) AND PL(i) > 1 AND PL(i) <= 250 THEN
  751.                             good = -1: EXIT FOR
  752.                         END IF
  753.                     END IF
  754.                 END IF
  755.             NEXT
  756.             'PRINT t$; l
  757.             IF NOT good THEN e$ = "ERROR - Improper operations before (.": EXIT SUB
  758.             l = l + 1
  759.         END IF
  760.     LOOP UNTIL l = 0
  761.  
  762.     'Check for bad operators after a ) bracket
  763.     l = 0
  764.     DO
  765.         l = INSTR(l + 1, t$, ")")
  766.         IF l AND l < LEN(t$) THEN
  767.             good = 0
  768.             FOR i = 1 TO UBOUND(oname)
  769.                 m$ = MID$(t$, l + 1, LEN(OName(i)))
  770.                 IF m$ = OName(i) THEN
  771.                     IF PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
  772.                 ELSE
  773.                     IF LEFT$(OName(i), 1) = "_" AND qb64prefix_set = 1 THEN
  774.                         'try without prefix
  775.                         IF MID$(t$, l + 1, LEN(OName(i)) - 1) = MID$(OName(i), 2) AND PL(i) > 1 AND PL(i) <= 250 THEN
  776.                             good = -1: EXIT FOR
  777.                         END IF
  778.                     END IF
  779.                 END IF
  780.             NEXT
  781.             IF MID$(t$, l + 1, 1) = ")" THEN good = -1
  782.             IF NOT good THEN e$ = "ERROR - Improper operations after ).": EXIT SUB
  783.             l = l + 1
  784.         END IF
  785.     LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket
  786.  
  787.     'Turn all &H (hex) numbers into decimal values for the program to process properly
  788.     l = 0
  789.     DO
  790.         l = INSTR(t$, "&H")
  791.         IF l THEN
  792.             E = l + 1: finished = 0
  793.             DO
  794.                 E = E + 1
  795.                 comp$ = MID$(t$, E, 1)
  796.                 SELECT CASE comp$
  797.                     CASE "0" TO "9", "A" TO "F" 'All is good, our next digit is a number, continue to add to the hex$
  798.                     CASE ELSE
  799.                         good = 0
  800.                         FOR i = 1 TO UBOUND(OName)
  801.                             IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
  802.                         NEXT
  803.                         IF NOT good THEN e$ = "ERROR - Improper &H value. (" + comp$ + ")": EXIT SUB
  804.                         E = E - 1
  805.                         finished = -1
  806.                 END SELECT
  807.             LOOP UNTIL finished OR E = LEN(t$)
  808.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(VAL(MID$(t$, l, E - l + 1))))) + MID$(t$, E + 1)
  809.         END IF
  810.     LOOP UNTIL l = 0
  811.  
  812.     'Turn all &B (binary) numbers into decimal values for the program to process properly
  813.     l = 0
  814.     DO
  815.         l = INSTR(t$, "&B")
  816.         IF l THEN
  817.             E = l + 1: finished = 0
  818.             DO
  819.                 E = E + 1
  820.                 comp$ = MID$(t$, E, 1)
  821.                 SELECT CASE comp$
  822.                     CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
  823.                     CASE ELSE
  824.                         good = 0
  825.                         FOR i = 1 TO UBOUND(OName)
  826.                             IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
  827.                         NEXT
  828.                         IF NOT good THEN e$ = "ERROR - Improper &B value. (" + comp$ + ")": EXIT SUB
  829.                         E = E - 1
  830.                         finished = -1
  831.                 END SELECT
  832.             LOOP UNTIL finished OR E = LEN(t$)
  833.             bin$ = MID$(t$, l + 2, E - l - 1)
  834.             FOR i = 1 TO LEN(bin$)
  835.                 IF MID$(bin$, i, 1) = "1" THEN f = f + 2 ^ (LEN(bin$) - i)
  836.             NEXT
  837.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(f))) + MID$(t$, E + 1)
  838.         END IF
  839.     LOOP UNTIL l = 0
  840.  
  841.     'PRINT "ALMOST:"; t$
  842.  
  843.     t$ = N2S(t$)
  844.     'PRINT "ALMOST2:"; t$
  845.     VerifyString t$
  846.  
  847.     e$ = t$
  848.  
  849.  
  850.  
  851. SUB VerifyString (t$)
  852.     'ERROR CHECK for unrecognized operations
  853.     j = 1
  854.     DO
  855.         comp$ = MID$(t$, j, 1)
  856.         SELECT CASE comp$
  857.             CASE "0" TO "9", ".", "(", ")", ",": j = j + 1
  858.             CASE ELSE
  859.                 good = 0
  860.                 extrachar = 0
  861.                 FOR i = 1 TO UBOUND(OName)
  862.                     IF MID$(t$, j, LEN(OName(i))) = OName(i) THEN
  863.                         good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
  864.                     ELSE
  865.                         IF LEFT$(OName(i), 1) = "_" AND qb64prefix_set = 1 THEN
  866.                             'try without prefix
  867.                             IF MID$(t$, j, LEN(OName(i)) - 1) = MID$(OName(i), 2) THEN
  868.                                 good = -1: extrachar = 1: EXIT FOR
  869.                             END IF
  870.                         END IF
  871.                     END IF
  872.                 NEXT
  873.                 IF NOT good THEN t$ = "ERROR - Bad Operational value. (" + comp$ + ")": EXIT SUB
  874.                 j = j + (LEN(OName(i)) - extrachar)
  875.         END SELECT
  876.     LOOP UNTIL j > LEN(t$)
  877.  
  878. FUNCTION N2S$ (EXP$) 'scientific Notation to String
  879.     t$ = LTRIM$(RTRIM$(EXP$))
  880.     IF LEFT$(t$, 1) = "-" THEN sign$ = "-": t$ = MID$(t$, 2)
  881.  
  882.     dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
  883.     ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
  884.     check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
  885.     IF check1 < 1 OR check1 > 1 THEN N2S = EXP$: EXIT SUB 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
  886.  
  887.     SELECT CASE l 'l now tells us where the SN starts at.
  888.         CASE IS < dp: l = dp
  889.         CASE IS < dm: l = dm
  890.         CASE IS < ep: l = ep
  891.         CASE IS < em: l = em
  892.     END SELECT
  893.  
  894.     l$ = LEFT$(t$, l - 1) 'The left of the SN
  895.     r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
  896.  
  897.  
  898.     IF INSTR(l$, ".") THEN 'Location of the decimal, if any
  899.         IF r&& > 0 THEN
  900.             r&& = r&& - LEN(l$) + 2
  901.         ELSE
  902.             r&& = r&& + 1
  903.         END IF
  904.         l$ = LEFT$(l$, 1) + MID$(l$, 3)
  905.     END IF
  906.  
  907.     SELECT CASE r&&
  908.         CASE 0 'what the heck? We solved it already?
  909.             'l$ = l$
  910.         CASE IS < 0
  911.             FOR i = 1 TO -r&&
  912.                 l$ = "0" + l$
  913.             NEXT
  914.             l$ = "0." + l$
  915.         CASE ELSE
  916.             FOR i = 1 TO r&&
  917.                 l$ = l$ + "0"
  918.             NEXT
  919.     END SELECT
  920.  
  921.     N2S$ = sign$ + l$
  922.  
« Last Edit: January 06, 2020, 12:23:45 am by FellippeHeitor »

Marked as best answer by SMcNeill on March 10, 2020, 11:22:41 am

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #16 on: January 07, 2020, 10:30:23 am »
And here's a test version which should have the fix for the glitch in scientific notation conversion, and also allow for formulas to work inside functions containing a comma (such as _RGB32(127 *2, 255 * 1, _PI(70))).

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(1024, 720, 32)
  2. REDIM SHARED OName(0) AS STRING 'Operation Name
  3. REDIM SHARED PL(0) AS INTEGER 'Priority Level
  4. REDIM SHARED PP_TypeMod(0) AS STRING, PP_ConvertedMod(0) AS STRING 'Prepass Name Conversion variables.
  5.  
  6.     i$ = INPUT$(1)
  7.     CLS
  8.  
  9.     PRINT "Formula to Evaluate => ";
  10.     SELECT CASE i$
  11.         CASE CHR$(8)
  12.             eval$ = LEFT$(eval$, LEN(eval$) - 1)
  13.         CASE CHR$(13)
  14.             eval$ = ""
  15.         CASE CHR$(27)
  16.             SYSTEM
  17.         CASE ELSE
  18.             eval$ = eval$ + i$
  19.     END SELECT
  20.     PRINT eval$
  21.     result$ = Evaluate_Expression(eval$)
  22.     PRINT "Result: "; result$
  23.     _CLIPBOARD$ = eval$ + " = " + result$
  24.  
  25.  
  26. 'Steve Subs/Functins for _MATH support with CONST
  27. FUNCTION Evaluate_Expression$ (e$)
  28.     t$ = e$ 'So we preserve our original data, we parse a temp copy of it
  29.     PreParse t$
  30.  
  31.  
  32.     IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
  33.  
  34.     'Deal with brackets first
  35.     exp$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
  36.  
  37.     DO
  38.         Eval_E = INSTR(exp$, ")")
  39.         IF Eval_E > 0 THEN
  40.             c = 0
  41.             DO UNTIL Eval_E - c <= 0
  42.                 c = c + 1
  43.                 IF Eval_E THEN
  44.                     IF MID$(exp$, Eval_E - c, 1) = "(" THEN EXIT DO
  45.                 END IF
  46.             LOOP
  47.             s = Eval_E - c + 1
  48.             IF s < 1 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT SUB
  49.             eval$ = " " + MID$(exp$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
  50.  
  51.             'PRINT "Before ParseExpression: "; eval$
  52.             ParseExpression eval$
  53.             'PRINT "After ParseExpression: "; eval$
  54.             eval$ = LTRIM$(RTRIM$(eval$))
  55.             IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT SUB
  56.             exp$ = DWD(LEFT$(exp$, s - 2) + eval$ + MID$(exp$, Eval_E + 1))
  57.             'PRINT exp$
  58.             IF MID$(exp$, 1, 1) = "N" THEN MID$(exp$, 1) = "-"
  59.  
  60.             'temppp$ = DWD(LEFT$(exp$, s - 2) + " ## " + eval$ + " ## " + MID$(exp$, e + 1))
  61.         END IF
  62.     LOOP UNTIL Eval_E = 0
  63.     c = 0
  64.     DO
  65.         c = c + 1
  66.         SELECT CASE MID$(exp$, c, 1)
  67.             CASE "0" TO "9", ".", "-" 'At this point, we should only have number values left.
  68.             CASE ELSE: Evaluate_Expression$ = "ERROR - Unknown Diagnosis: (" + exp$ + ") ": EXIT SUB
  69.         END SELECT
  70.     LOOP UNTIL c >= LEN(exp$)
  71.  
  72.     Evaluate_Expression$ = exp$
  73.  
  74.  
  75.  
  76. SUB ParseExpression (exp$)
  77.     DIM num(10) AS STRING
  78.     'PRINT exp$
  79.     exp$ = DWD(exp$)
  80.     'We should now have an expression with no () to deal with
  81.     'IF MID$(exp$, 2, 1) = "-" THEN exp$ = "0+" + MID$(exp$, 2)
  82.     FOR J = 1 TO 250
  83.         lowest = 0
  84.         DO UNTIL lowest = LEN(exp$)
  85.             lowest = LEN(exp$): OpOn = 0
  86.             FOR P = 1 TO UBOUND(OName)
  87.                 'Look for first valid operator
  88.                 IF J = PL(P) THEN 'Priority levels match
  89.                     IF LEFT$(exp$, 1) = "-" THEN op = INSTR(2, exp$, OName(P)) ELSE op = INSTR(exp$, OName(P))
  90.                     IF op > 0 AND op < lowest THEN lowest = op: OpOn = P
  91.                 END IF
  92.             NEXT
  93.             IF OpOn = 0 THEN EXIT DO 'We haven't gotten to the proper PL for this OP to be processed yet.
  94.             IF LEFT$(exp$, 1) = "-" THEN op = INSTR(2, exp$, OName(OpOn)) ELSE op = INSTR(exp$, OName(OpOn))
  95.             numset = 0
  96.  
  97.             '*** SPECIAL OPERATION RULESETS
  98.             IF OName(OpOn) = "-" THEN 'check for BOOLEAN operators before the -
  99.                 SELECT CASE MID$(exp$, op - 3, 3)
  100.                     CASE "NOT", "XOR", "AND", "EQV", "IMP"
  101.                         EXIT DO 'Not an operator, it's a negative
  102.                 END SELECT
  103.                 IF MID$(exp$, op - 3, 2) = "OR" THEN EXIT DO 'Not an operator, it's a negative
  104.             END IF
  105.  
  106.             IF op THEN
  107.                 c = LEN(OName(OpOn)) - 1
  108.                 DO
  109.                     SELECT CASE MID$(exp$, op + c + 1, 1)
  110.                         CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N": numset = -1 'Valid digit
  111.                         CASE "-" 'We need to check if it's a minus or a negative
  112.                             IF OName(OpOn) = "_PI" OR numset THEN EXIT DO
  113.                         CASE ",": numset = 0
  114.                         CASE ELSE 'Not a valid digit, we found our separator
  115.                             EXIT DO
  116.                     END SELECT
  117.                     c = c + 1
  118.                 LOOP UNTIL op + c >= LEN(exp$)
  119.                 e = op + c
  120.  
  121.                 c = 0
  122.                 DO
  123.                     c = c + 1
  124.                     SELECT CASE MID$(exp$, op - c, 1)
  125.                         CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N" 'Valid digit
  126.                         CASE "-" 'We need to check if it's a minus or a negative
  127.                             c1 = c
  128.                             bad = 0
  129.                             DO
  130.                                 c1 = c1 + 1
  131.                                 SELECT CASE MID$(exp$, op - c1, 1)
  132.                                     CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "."
  133.                                         bad = -1
  134.                                         EXIT DO 'It's a minus sign
  135.                                     CASE ELSE
  136.                                         'It's a negative sign and needs to count as part of our numbers
  137.                                 END SELECT
  138.                             LOOP UNTIL op - c1 <= 0
  139.                             IF bad THEN EXIT DO 'We found our seperator
  140.                         CASE ELSE 'Not a valid digit, we found our separator
  141.                             EXIT DO
  142.                     END SELECT
  143.                 LOOP UNTIL op - c <= 0
  144.                 s = op - c
  145.                 num(1) = MID$(exp$, s + 1, op - s - 1) 'Get our first number
  146.                 num(2) = MID$(exp$, op + LEN(OName(OpOn)), e - op - LEN(OName(OpOn)) + 1) 'Get our second number
  147.                 IF MID$(num(1), 1, 1) = "N" THEN MID$(num(1), 1) = "-"
  148.                 IF MID$(num(2), 1, 1) = "N" THEN MID$(num(2), 1) = "-"
  149.                 IF num(1) = "-" THEN
  150.                     num(3) = "N" + EvaluateNumbers(OpOn, num())
  151.                 ELSE
  152.                     num(3) = EvaluateNumbers(OpOn, num())
  153.                 END IF
  154.                 IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N"
  155.                 'PRINT "*************"
  156.                 'PRINT num(1), OName(OpOn), num(2), num(3), exp$
  157.                 IF LEFT$(num(3), 5) = "ERROR" THEN exp$ = num(3): EXIT SUB
  158.                 exp$ = LTRIM$(N2S(DWD(LEFT$(exp$, s) + RTRIM$(LTRIM$(num(3))) + MID$(exp$, e + 1))))
  159.                 'PRINT exp$
  160.             END IF
  161.             op = 0
  162.         LOOP
  163.     NEXT
  164.  
  165.  
  166.  
  167.  
  168. SUB Set_OrderOfOperations
  169.     'PL sets our priortity level. 1 is highest to 65535 for the lowest.
  170.     'I used a range here so I could add in new priority levels as needed.
  171.     'OName ended up becoming the name of our commands, as I modified things.... Go figure!  LOL!
  172.     REDIM OName(10000) AS STRING, PL(10000) AS INTEGER
  173.     'Constants get evaluated first, with a Priority Level of 1
  174.  
  175.     i = i + 1: OName(i) = "C_UOF": PL(i) = 5 'convert to unsigned offset
  176.     i = i + 1: OName(i) = "C_OF": PL(i) = 5 'convert to offset
  177.     i = i + 1: OName(i) = "C_UBY": PL(i) = 5 'convert to unsigned byte
  178.     i = i + 1: OName(i) = "C_BY": PL(i) = 5 'convert to byte
  179.     i = i + 1: OName(i) = "C_UIN": PL(i) = 5 'convert to unsigned integer
  180.     i = i + 1: OName(i) = "C_IN": PL(i) = 5 'convert to integer
  181.     i = i + 1: OName(i) = "C_UIF": PL(i) = 5 'convert to unsigned int64
  182.     i = i + 1: OName(i) = "C_IF": PL(i) = 5 'convert to int64
  183.     i = i + 1: OName(i) = "C_ULO": PL(i) = 5 'convert to unsigned long
  184.     i = i + 1: OName(i) = "C_LO": PL(i) = 5 'convert to long
  185.     i = i + 1: OName(i) = "C_SI": PL(i) = 5 'convert to single
  186.     i = i + 1: OName(i) = "C_FL": PL(i) = 5 'convert to float
  187.     i = i + 1: OName(i) = "C_DO": PL(i) = 5 'convert to double
  188.     i = i + 1: OName(i) = "C_UBI": PL(i) = 5 'convert to unsigned bit
  189.     i = i + 1: OName(i) = "C_BI": PL(i) = 5 'convert to bit
  190.  
  191.     'Then Functions with PL 10
  192.     i = i + 1:: OName(i) = "_PI": PL(i) = 10
  193.     i = i + 1: OName(i) = "_ACOS": PL(i) = 10
  194.     i = i + 1: OName(i) = "_ASIN": PL(i) = 10
  195.     i = i + 1: OName(i) = "_ARCSEC": PL(i) = 10
  196.     i = i + 1: OName(i) = "_ARCCSC": PL(i) = 10
  197.     i = i + 1: OName(i) = "_ARCCOT": PL(i) = 10
  198.     i = i + 1: OName(i) = "_SECH": PL(i) = 10
  199.     i = i + 1: OName(i) = "_CSCH": PL(i) = 10
  200.     i = i + 1: OName(i) = "_COTH": PL(i) = 10
  201.     i = i + 1: OName(i) = "COS": PL(i) = 10
  202.     i = i + 1: OName(i) = "SIN": PL(i) = 10
  203.     i = i + 1: OName(i) = "TAN": PL(i) = 10
  204.     i = i + 1: OName(i) = "LOG": PL(i) = 10
  205.     i = i + 1: OName(i) = "EXP": PL(i) = 10
  206.     i = i + 1: OName(i) = "ATN": PL(i) = 10
  207.     i = i + 1: OName(i) = "_D2R": PL(i) = 10
  208.     i = i + 1: OName(i) = "_D2G": PL(i) = 10
  209.     i = i + 1: OName(i) = "_R2D": PL(i) = 10
  210.     i = i + 1: OName(i) = "_R2G": PL(i) = 10
  211.     i = i + 1: OName(i) = "_G2D": PL(i) = 10
  212.     i = i + 1: OName(i) = "_G2R": PL(i) = 10
  213.     i = i + 1: OName(i) = "ABS": PL(i) = 10
  214.     i = i + 1: OName(i) = "SGN": PL(i) = 10
  215.     i = i + 1: OName(i) = "INT": PL(i) = 10
  216.     i = i + 1: OName(i) = "_ROUND": PL(i) = 10
  217.     i = i + 1: OName(i) = "_CEIL": PL(i) = 10
  218.     i = i + 1: OName(i) = "FIX": PL(i) = 10
  219.     i = i + 1: OName(i) = "_SEC": PL(i) = 10
  220.     i = i + 1: OName(i) = "_CSC": PL(i) = 10
  221.     i = i + 1: OName(i) = "_COT": PL(i) = 10
  222.     i = i + 1: OName(i) = "ASC": PL(i) = 10
  223.     i = i + 1: OName(i) = "CHR$": PL(i) = 10
  224.     i = i + 1: OName(i) = "C_RG": PL(i) = 10 '_RGB32 converted
  225.     i = i + 1: OName(i) = "C_RA": PL(i) = 10 '_RGBA32 converted
  226.     i = i + 1: OName(i) = "_RGB": PL(i) = 10
  227.     i = i + 1: OName(i) = "_RGBA": PL(i) = 10
  228.     i = i + 1: OName(i) = "C_RX": PL(i) = 10 '_RED32 converted
  229.     i = i + 1: OName(i) = "C_GR": PL(i) = 10 ' _GREEN32 converted
  230.     i = i + 1: OName(i) = "C_BL": PL(i) = 10 '_BLUE32 converted
  231.     i = i + 1: OName(i) = "C_AL": PL(i) = 10 '_ALPHA32 converted
  232.     i = i + 1: OName(i) = "_RED": PL(i) = 10
  233.     i = i + 1: OName(i) = "_GREEN": PL(i) = 10
  234.     i = i + 1: OName(i) = "_BLUE": PL(i) = 10
  235.     i = i + 1: OName(i) = "_ALPHA": PL(i) = 10
  236.  
  237.     'Exponents with PL 20
  238.     i = i + 1: OName(i) = "^": PL(i) = 20
  239.     i = i + 1: OName(i) = "SQR": PL(i) = 20
  240.     i = i + 1: OName(i) = "ROOT": PL(i) = 20
  241.     'Multiplication and Division PL 30
  242.     i = i + 1: OName(i) = "*": PL(i) = 30
  243.     i = i + 1: OName(i) = "/": PL(i) = 30
  244.     'Integer Division PL 40
  245.     i = i + 1: OName(i) = "\": PL(i) = 40
  246.     'MOD PL 50
  247.     i = i + 1: OName(i) = "MOD": PL(i) = 50
  248.     'Addition and Subtraction PL 60
  249.     i = i + 1: OName(i) = "+": PL(i) = 60
  250.     i = i + 1: OName(i) = "-": PL(i) = 60
  251.  
  252.     'Relational Operators =, >, <, <>, <=, >=   PL 70
  253.     i = i + 1: OName(i) = "<>": PL(i) = 70 'These next three are just reversed symbols as an attempt to help process a common typo
  254.     i = i + 1: OName(i) = "><": PL(i) = 70
  255.     i = i + 1: OName(i) = "<=": PL(i) = 70
  256.     i = i + 1: OName(i) = ">=": PL(i) = 70
  257.     i = i + 1: OName(i) = "=<": PL(i) = 70 'I personally can never keep these things straight.  Is it < = or = <...
  258.     i = i + 1: OName(i) = "=>": PL(i) = 70 'Who knows, check both!
  259.     i = i + 1: OName(i) = ">": PL(i) = 70
  260.     i = i + 1: OName(i) = "<": PL(i) = 70
  261.     i = i + 1: OName(i) = "=": PL(i) = 70
  262.     'Logical Operations PL 80+
  263.     i = i + 1: OName(i) = "NOT": PL(i) = 80
  264.     i = i + 1: OName(i) = "AND": PL(i) = 90
  265.     i = i + 1: OName(i) = "OR": PL(i) = 100
  266.     i = i + 1: OName(i) = "XOR": PL(i) = 110
  267.     i = i + 1: OName(i) = "EQV": PL(i) = 120
  268.     i = i + 1: OName(i) = "IMP": PL(i) = 130
  269.     i = i + 1: OName(i) = ",": PL(i) = 1000
  270.  
  271.     REDIM _PRESERVE OName(i) AS STRING, PL(i) AS INTEGER
  272.  
  273. FUNCTION EvaluateNumbers$ (p, num() AS STRING)
  274.     DIM n1 AS _FLOAT, n2 AS _FLOAT, n3 AS _FLOAT
  275.     'PRINT "EVALNUM:"; OName(p), num(1), num(2)
  276.     IF INSTR(num(1), ",") THEN
  277.         EvaluateNumbers$ = "ERROR - Invalid comma (" + num(1) + ")": EXIT FUNCTION
  278.     END IF
  279.     l2 = INSTR(num(2), ",")
  280.     IF l2 THEN
  281.         SELECT CASE OName(p) 'only certain commands should pass a comma value
  282.             CASE "C_RG", "C_RA", "_RGB", "_RGBA", "_RED", "_GREEN", "C_BL", "_ALPHA"
  283.             CASE ELSE
  284.                 C$ = MID$(num(2), l2)
  285.                 num(2) = LEFT$(num(2), l2 - 1)
  286.         END SELECT
  287.     END IF
  288.  
  289.     SELECT CASE PL(p) 'divide up the work so we want do as much case checking
  290.         CASE 5 'Type conversions
  291.             'Note, these are special cases and work with the number BEFORE the command and not after
  292.             SELECT CASE OName(p) 'Depending on our operator..
  293.                 CASE "C_UOF": n1~%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%&)))
  294.                 CASE "C_ULO": n1%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%&)))
  295.                 CASE "C_UBY": n1~%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%%)))
  296.                 CASE "C_UIN": n1~% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%)))
  297.                 CASE "C_BY": n1%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%%)))
  298.                 CASE "C_IN": n1% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%)))
  299.                 CASE "C_UIF": n1~&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&&)))
  300.                 CASE "C_OF": n1~& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&)))
  301.                 CASE "C_IF": n1&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&&)))
  302.                 CASE "C_LO": n1& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&)))
  303.                 CASE "C_UBI": n1~` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~`)))
  304.                 CASE "C_BI": n1` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1`)))
  305.                 CASE "C_FL": n1## = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1##)))
  306.                 CASE "C_DO": n1# = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1#)))
  307.                 CASE "C_SI": n1! = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1!)))
  308.             END SELECT
  309.             EXIT FUNCTION
  310.         CASE 10 'functions
  311.             SELECT CASE OName(p) 'Depending on our operator..
  312.                 CASE "_PI"
  313.                     n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
  314.                     IF num(2) <> "" THEN n1 = n1 * VAL(num(2))
  315.                 CASE "_ACOS": n1 = _ACOS(VAL(num(2)))
  316.                 CASE "_ASIN": n1 = _ASIN(VAL(num(2)))
  317.                 CASE "_ARCSEC": n1 = _ARCSEC(VAL(num(2)))
  318.                 CASE "_ARCCSC": n1 = _ARCCSC(VAL(num(2)))
  319.                 CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
  320.                 CASE "_SECH": n1 = _SECH(VAL(num(2)))
  321.                 CASE "_CSCH": n1 = _CSCH(VAL(num(2)))
  322.                 CASE "_COTH": n1 = _COTH(VAL(num(2)))
  323.                 CASE "C_RG"
  324.                     n$ = num(2)
  325.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB32": EXIT FUNCTION
  326.                     c1 = INSTR(n$, ",")
  327.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  328.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  329.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  330.                     IF c1 = 0 THEN 'there's no comma in the command to parse.  It's a grayscale value
  331.                         n = VAL(num(2))
  332.                         n1 = _RGB32(n, n, n)
  333.                     ELSEIF c2 = 0 THEN 'there's one comma and not 2.  It's grayscale with alpha.
  334.                         n = VAL(LEFT$(num(2), c1))
  335.                         n2 = VAL(MID$(num(2), c1 + 1))
  336.                         n1 = _RGBA32(n, n, n, n2)
  337.                     ELSEIF c3 = 0 THEN 'there's two commas.  It's _RGB values
  338.                         n = VAL(LEFT$(num(2), c1))
  339.                         n2 = VAL(MID$(num(2), c1 + 1))
  340.                         n3 = VAL(MID$(num(2), c2 + 1))
  341.                         n1 = _RGB32(n, n2, n3)
  342.                     ELSEIF c4 = 0 THEN 'there's three commas.  It's _RGBA values
  343.                         n = VAL(LEFT$(num(2), c1))
  344.                         n2 = VAL(MID$(num(2), c1 + 1))
  345.                         n3 = VAL(MID$(num(2), c2 + 1))
  346.                         n4 = VAL(MID$(num(2), c3 + 1))
  347.                         n1 = _RGBA32(n, n2, n3, n4)
  348.                     ELSE 'we have more than three commas.  I have no idea WTH type of values got passed here!
  349.                         EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  350.                     END IF
  351.                 CASE "C_RA"
  352.                     n$ = num(2)
  353.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA32": EXIT FUNCTION
  354.                     c1 = INSTR(n$, ",")
  355.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  356.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  357.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  358.                     IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
  359.                     'we have to have 3 commas; not more, not less.
  360.                     n = VAL(LEFT$(num(2), c1))
  361.                     n2 = VAL(MID$(num(2), c1 + 1))
  362.                     n3 = VAL(MID$(num(2), c2 + 1))
  363.                     n4 = VAL(MID$(num(2), c3 + 1))
  364.                     n1 = _RGBA32(n, n2, n3, n4)
  365.                 CASE "_RGB"
  366.                     n$ = num(2)
  367.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB": EXIT FUNCTION
  368.                     c1 = INSTR(n$, ",")
  369.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  370.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  371.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  372.                     IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGB requires 4 parameters for Red, Green, Blue, ScreenMode.": EXIT FUNCTION
  373.                     'we have to have 3 commas; not more, not less.
  374.                     n = VAL(LEFT$(num(2), c1))
  375.                     n2 = VAL(MID$(num(2), c1 + 1))
  376.                     n3 = VAL(MID$(num(2), c2 + 1))
  377.                     n4 = VAL(MID$(num(2), c3 + 1))
  378.                     SELECT CASE n4
  379.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  380.                         CASE ELSE
  381.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n4) + ")": EXIT FUNCTION
  382.                     END SELECT
  383.                     t = _NEWIMAGE(1, 1, n4)
  384.                     n1 = _RGB(n, n2, n3, t)
  385.                     _FREEIMAGE t
  386.                 CASE "_RGBA"
  387.                     n$ = num(2)
  388.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA": EXIT FUNCTION
  389.                     c1 = INSTR(n$, ",")
  390.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  391.                     IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
  392.                     IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
  393.                     IF c4 THEN c5 = INSTR(c4 + 1, n$, ",")
  394.                     IF c4 = 0 OR c5 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGBA requires 5 parameters for Red, Green, Blue, Alpha, ScreenMode.": EXIT FUNCTION
  395.                     'we have to have 4 commas; not more, not less.
  396.                     n = VAL(LEFT$(num(2), c1))
  397.                     n2 = VAL(MID$(num(2), c1 + 1))
  398.                     n3 = VAL(MID$(num(2), c2 + 1))
  399.                     n4 = VAL(MID$(num(2), c3 + 1))
  400.                     n5 = VAL(MID$(num(2), c4 + 1))
  401.                     SELECT CASE n5
  402.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  403.                         CASE ELSE
  404.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n5) + ")": EXIT FUNCTION
  405.                     END SELECT
  406.                     t = _NEWIMAGE(1, 1, n5)
  407.                     n1 = _RGBA(n, n2, n3, n4, t)
  408.                     _FREEIMAGE t
  409.                 CASE "_RED", "_GREEN", "_BLUE", "_ALPHA"
  410.                     n$ = num(2)
  411.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  412.                     c1 = INSTR(n$, ",")
  413.                     IF c1 = 0 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  414.                     IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
  415.                     IF c2 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
  416.                     n = VAL(LEFT$(num(2), c1))
  417.                     n2 = VAL(MID$(num(2), c1 + 1))
  418.                     SELECT CASE n2
  419.                         CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
  420.                         CASE ELSE
  421.                             EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n2) + ")": EXIT FUNCTION
  422.                     END SELECT
  423.                     t = _NEWIMAGE(1, 1, n4)
  424.                     SELECT CASE OName(p)
  425.                         CASE "_RED": n1 = _RED(n, t)
  426.                         CASE "_BLUE": n1 = _BLUE(n, t)
  427.                         CASE "_GREEN": n1 = _GREEN(n, t)
  428.                         CASE "_ALPHA": n1 = _ALPHA(n, t)
  429.                     END SELECT
  430.                     _FREEIMAGE t
  431.                 CASE "C_RX", "C_GR", "C_BL", "C_AL"
  432.                     n$ = num(2)
  433.                     IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
  434.                     n = VAL(num(2))
  435.                     SELECT CASE OName(p)
  436.                         CASE "C_RX": n1 = _RED32(n)
  437.                         CASE "C_BL": n1 = _BLUE32(n)
  438.                         CASE "C_GR": n1 = _GREEN32(n)
  439.                         CASE "C_AL": n1 = _ALPHA32(n)
  440.                     END SELECT
  441.                 CASE "COS": n1 = COS(VAL(num(2)))
  442.                 CASE "SIN": n1 = SIN(VAL(num(2)))
  443.                 CASE "TAN": n1 = TAN(VAL(num(2)))
  444.                 CASE "LOG": n1 = LOG(VAL(num(2)))
  445.                 CASE "EXP": n1 = EXP(VAL(num(2)))
  446.                 CASE "ATN": n1 = ATN(VAL(num(2)))
  447.                 CASE "_D2R": n1 = 0.0174532925 * (VAL(num(2)))
  448.                 CASE "_D2G": n1 = 1.1111111111 * (VAL(num(2)))
  449.                 CASE "_R2D": n1 = 57.2957795 * (VAL(num(2)))
  450.                 CASE "_R2G": n1 = 0.015707963 * (VAL(num(2)))
  451.                 CASE "_G2D": n1 = 0.9 * (VAL(num(2)))
  452.                 CASE "_G2R": n1 = 63.661977237 * (VAL(num(2)))
  453.                 CASE "ABS": n1 = ABS(VAL(num(2)))
  454.                 CASE "SGN": n1 = SGN(VAL(num(2)))
  455.                 CASE "INT": n1 = INT(VAL(num(2)))
  456.                 CASE "_ROUND": n1 = _ROUND(VAL(num(2)))
  457.                 CASE "_CEIL": n1 = _CEIL(VAL(num(2)))
  458.                 CASE "FIX": n1 = FIX(VAL(num(2)))
  459.                 CASE "_SEC": n1 = _SEC(VAL(num(2)))
  460.                 CASE "_CSC": n1 = _CSC(VAL(num(2)))
  461.                 CASE "_COT": n1 = _COT(VAL(num(2)))
  462.             END SELECT
  463.         CASE 20 TO 60 'Math Operators
  464.             SELECT CASE OName(p) 'Depending on our operator..
  465.                 CASE "^": n1 = VAL(num(1)) ^ VAL(num(2))
  466.                 CASE "SQR": n1 = SQR(VAL(num(2)))
  467.                 CASE "ROOT"
  468.                     n1 = VAL(num(1)): n2 = VAL(num(2))
  469.                     IF n2 = 1 THEN EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))): EXIT FUNCTION
  470.                     IF n1 < 0 AND n2 >= 1 THEN sign = -1: n1 = -n1 ELSE sign = 1
  471.                     n3 = 1## / n2
  472.                     IF n3 <> INT(n3) AND n2 < 1 THEN sign = SGN(n1): n1 = ABS(n1)
  473.                     n1 = sign * (n1 ^ n3)
  474.                 CASE "*": n1 = VAL(num(1)) * VAL(num(2))
  475.                 CASE "/": n1 = VAL(num(1)) / VAL(num(2))
  476.                 CASE "\"
  477.                     IF VAL(num(2)) <> 0 THEN
  478.                         n1 = VAL(num(1)) \ VAL(num(2))
  479.                     ELSE
  480.                         EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
  481.                         EXIT FUNCTION
  482.                     END IF
  483.                 CASE "MOD": n1 = VAL(num(1)) MOD VAL(num(2))
  484.                 CASE "+": n1 = VAL(num(1)) + VAL(num(2))
  485.                 CASE "-":
  486.                     n1 = VAL(num(1)) - VAL(num(2))
  487.             END SELECT
  488.         CASE 70 'Relational Operators =, >, <, <>, <=, >=
  489.             SELECT CASE OName(p) 'Depending on our operator..
  490.                 CASE "=": n1 = VAL(num(1)) = VAL(num(2))
  491.                 CASE ">": n1 = VAL(num(1)) > VAL(num(2))
  492.                 CASE "<": n1 = VAL(num(1)) < VAL(num(2))
  493.                 CASE "<>", "><": n1 = VAL(num(1)) <> VAL(num(2))
  494.                 CASE "<=", "=<": n1 = VAL(num(1)) <= VAL(num(2))
  495.                 CASE ">=", "=>": n1 = VAL(num(1)) >= VAL(num(2))
  496.             END SELECT
  497.         CASE ELSE 'a value we haven't processed elsewhere
  498.             SELECT CASE OName(p) 'Depending on our operator..
  499.                 CASE "NOT": n1 = NOT VAL(num(2))
  500.                 CASE "AND": n1 = VAL(num(1)) AND VAL(num(2))
  501.                 CASE "OR": n1 = VAL(num(1)) OR VAL(num(2))
  502.                 CASE "XOR": n1 = VAL(num(1)) XOR VAL(num(2))
  503.                 CASE "EQV": n1 = VAL(num(1)) EQV VAL(num(2))
  504.                 CASE "IMP": n1 = VAL(num(1)) IMP VAL(num(2))
  505.             END SELECT
  506.     END SELECT
  507.  
  508.     EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))) + C$
  509.  
  510.     'PRINT "AFTEREVN:"; EvaluateNumbers$
  511.  
  512. FUNCTION DWD$ (exp$) 'Deal With Duplicates
  513.     'To deal with duplicate operators in our code.
  514.     'Such as --  becomes a +
  515.     '++ becomes a +
  516.     '+- becomes a -
  517.     '-+ becomes a -
  518.     t$ = exp$
  519.     DO
  520.         bad = 0
  521.         DO
  522.             l = INSTR(t$, "++")
  523.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  524.         LOOP UNTIL l = 0
  525.         DO
  526.             l = INSTR(t$, "+-")
  527.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  528.         LOOP UNTIL l = 0
  529.         DO
  530.             l = INSTR(t$, "-+")
  531.             IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
  532.         LOOP UNTIL l = 0
  533.         DO
  534.             l = INSTR(t$, "--")
  535.             IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
  536.         LOOP UNTIL l = 0
  537.         'PRINT "FIXING: "; t$
  538.     LOOP UNTIL NOT bad
  539.     DWD$ = t$
  540.  
  541. SUB PreParse (e$)
  542.     DIM f AS _FLOAT
  543.  
  544.     IF PP_TypeMod(0) = "" THEN
  545.         REDIM PP_TypeMod(100) AS STRING, PP_ConvertedMod(100) AS STRING 'Large enough to hold all values to begin with
  546.         PP_TypeMod(0) = "Initialized" 'Set so we don't do this section over and over, as we keep the values in shared memory.
  547.         Set_OrderOfOperations 'Call this once to set up our proper order of operations and variable list
  548.         'and the below is a conversion list so symbols don't get cross confused.
  549.         i = i + 1: PP_TypeMod(i) = "~`": PP_ConvertedMod(i) = "C_UBI" 'unsigned bit
  550.         i = i + 1: PP_TypeMod(i) = "~%%": PP_ConvertedMod(i) = "C_UBY" 'unsigned byte
  551.         i = i + 1: PP_TypeMod(i) = "~%&": PP_ConvertedMod(i) = "C_UOF" 'unsigned offset
  552.         i = i + 1: PP_TypeMod(i) = "~%": PP_ConvertedMod(i) = "C_UIN" 'unsigned integer
  553.         i = i + 1: PP_TypeMod(i) = "~&&": PP_ConvertedMod(i) = "C_UIF" 'unsigned integer64
  554.         i = i + 1: PP_TypeMod(i) = "~&": PP_ConvertedMod(i) = "C_ULO" 'unsigned long
  555.         i = i + 1: PP_TypeMod(i) = "`": PP_ConvertedMod(i) = "C_BI" 'bit
  556.         i = i + 1: PP_TypeMod(i) = "%%": PP_ConvertedMod(i) = "C_BY" 'byte
  557.         i = i + 1: PP_TypeMod(i) = "%&": PP_ConvertedMod(i) = "C_OF" 'offset
  558.         i = i + 1: PP_TypeMod(i) = "%": PP_ConvertedMod(i) = "C_IN" 'integer
  559.         i = i + 1: PP_TypeMod(i) = "&&": PP_ConvertedMod(i) = "C_IF" 'integer64
  560.         i = i + 1: PP_TypeMod(i) = "&": PP_ConvertedMod(i) = "C_LO" 'long
  561.         i = i + 1: PP_TypeMod(i) = "!": PP_ConvertedMod(i) = "C_SI" 'single
  562.         i = i + 1: PP_TypeMod(i) = "##": PP_ConvertedMod(i) = "C_FL" 'float
  563.         i = i + 1: PP_TypeMod(i) = "#": PP_ConvertedMod(i) = "C_DO" 'double
  564.         i = i + 1: PP_TypeMod(i) = "_RGB32": PP_ConvertedMod(i) = "C_RG" 'rgb32
  565.         i = i + 1: PP_TypeMod(i) = "_RGBA32": PP_ConvertedMod(i) = "C_RA" 'rgba32
  566.         i = i + 1: PP_TypeMod(i) = "_RED32": PP_ConvertedMod(i) = "C_RX" 'red32
  567.         i = i + 1: PP_TypeMod(i) = "_GREEN32": PP_ConvertedMod(i) = "C_GR" 'green32
  568.         i = i + 1: PP_TypeMod(i) = "_BLUE32": PP_ConvertedMod(i) = "C_BL" 'blue32
  569.         i = i + 1: PP_TypeMod(i) = "_ALPHA32": PP_ConvertedMod(i) = "C_AL" 'alpha32
  570.         REDIM _PRESERVE PP_TypeMod(i) AS STRING, PP_ConvertedMod(i) AS STRING 'And then resized to just contain the necessary space in memory
  571.     END IF
  572.     t$ = e$
  573.  
  574.     'First strip all spaces
  575.     t$ = ""
  576.     FOR i = 1 TO LEN(e$)
  577.         IF MID$(e$, i, 1) <> " " THEN t$ = t$ + MID$(e$, i, 1)
  578.     NEXT
  579.  
  580.     t$ = UCASE$(t$)
  581.     IF t$ = "" THEN e$ = "ERROR -- NULL string; nothing to evaluate": EXIT SUB
  582.  
  583.     'ERROR CHECK by counting our brackets
  584.     l = 0
  585.     DO
  586.         l = INSTR(l + 1, t$, "("): IF l THEN c = c + 1
  587.     LOOP UNTIL l = 0
  588.     l = 0
  589.     DO
  590.         l = INSTR(l + 1, t$, ")"): IF l THEN c1 = c1 + 1
  591.     LOOP UNTIL l = 0
  592.     IF c <> c1 THEN e$ = "ERROR -- Bad Parenthesis:" + STR$(c) + "( vs" + STR$(c1) + ")": EXIT SUB
  593.  
  594.     'Modify so that NOT will process properly
  595.     l = 0
  596.     DO
  597.         l = INSTR(l + 1, t$, "NOT")
  598.         IF l THEN
  599.             'We need to work magic on the statement so it looks pretty.
  600.             ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
  601.             'Look for something not proper
  602.             l1 = INSTR(l + 1, t$, "AND")
  603.             IF l1 = 0 OR (INSTR(l + 1, t$, "OR") > 0 AND INSTR(l + 1, t$, "OR") < l1) THEN l1 = INSTR(l + 1, t$, "OR")
  604.             IF l1 = 0 OR (INSTR(l + 1, t$, "XOR") > 0 AND INSTR(l + 1, t$, "XOR") < l1) THEN l1 = INSTR(l + 1, t$, "XOR")
  605.             IF l1 = 0 OR (INSTR(l + 1, t$, "EQV") > 0 AND INSTR(l + 1, t$, "EQV") < l1) THEN l1 = INSTR(l + 1, t$, "EQV")
  606.             IF l1 = 0 OR (INSTR(l + 1, t$, "IMP") > 0 AND INSTR(l + 1, t$, "IMP") < l1) THEN l1 = INSTR(l + 1, t$, "IMP")
  607.             IF l1 = 0 THEN l1 = LEN(t$) + 1
  608.             t$ = LEFT$(t$, l - 1) + "(" + MID$(t$, l, l1 - l) + ")" + MID$(t$, l + l1 - l)
  609.             l = l + 3
  610.             'PRINT t$
  611.         END IF
  612.     LOOP UNTIL l = 0
  613.  
  614.     FOR j = 1 TO UBOUND(PP_TypeMod)
  615.         l = 0
  616.         DO
  617.             l = INSTR(l + 1, t$, PP_TypeMod(j))
  618.             IF l = 0 THEN EXIT DO
  619.             i = 0: l1 = 0: l2 = 0: lo = LEN(PP_TypeMod(j))
  620.             DO
  621.                 IF PL(i) > 10 THEN
  622.                     l2 = _INSTRREV(l, t$, OName$(i))
  623.                     IF l2 > 0 AND l2 > l1 THEN l1 = l2
  624.                 END IF
  625.                 i = i + lo
  626.             LOOP UNTIL i > UBOUND(PL)
  627.             'PRINT "L1:"; l1; "L"; l
  628.             l$ = LEFT$(t$, l1)
  629.             m$ = MID$(t$, l1 + 1, l - l1 - 1)
  630.             r$ = PP_ConvertedMod(j) + MID$(t$, l + lo)
  631.             'PRINT "Y$: "; TypeMod(j)
  632.             'PRINT "L$: "; l$
  633.             'PRINT "M$: "; m$
  634.             'PRINT "R$: "; r$
  635.             IF j > 15 THEN
  636.                 t$ = l$ + m$ + r$ 'replacement routine for commands which might get confused with others, like _RGB and _RGB32
  637.             ELSE
  638.                 'the first 15 commands need to properly place the parenthesis around the value we want to convert.
  639.                 t$ = l$ + "(" + m$ + ")" + r$
  640.             END IF
  641.             'PRINT "T$: "; t$
  642.             l = l + 2 + LEN(PP_TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and  ")"
  643.         LOOP
  644.     NEXT
  645.     '    PRINT "HERE: "; t$
  646.  
  647.  
  648.  
  649.     'Check for bad operators before a ( bracket
  650.     l = 0
  651.     DO
  652.         l = INSTR(l + 1, t$, "(")
  653.         IF l AND l > 2 THEN 'Don't check the starting bracket; there's nothing before it.
  654.             good = 0
  655.             'PRINT "BEFORE: "; t$; l
  656.             FOR i = 1 TO UBOUND(OName)
  657.                 m$ = MID$(t$, l - LEN(OName(i)), LEN(OName(i)))
  658.                 'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
  659.                 IF m$ = OName(i) THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
  660.             NEXT
  661.             'PRINT t$; l
  662.             IF NOT good THEN e$ = "ERROR - Improper operations before (.": EXIT SUB
  663.             l = l + 1
  664.         END IF
  665.     LOOP UNTIL l = 0
  666.  
  667.     'Check for bad operators after a ) bracket
  668.     l = 0
  669.     DO
  670.         l = INSTR(l + 1, t$, ")")
  671.         IF l AND l < LEN(t$) THEN
  672.             good = 0
  673.             FOR i = 1 TO UBOUND(oname)
  674.                 m$ = MID$(t$, l + 1, LEN(OName(i)))
  675.                 IF m$ = OName(i) THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI
  676.             NEXT
  677.             IF MID$(t$, l + 1, 1) = ")" THEN good = -1
  678.             IF NOT good THEN e$ = "ERROR - Improper operations after ).": EXIT SUB
  679.             l = l + 1
  680.         END IF
  681.     LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket
  682.  
  683.     'Turn all &H (hex) numbers into decimal values for the program to process properly
  684.     l = 0
  685.     DO
  686.         l = INSTR(t$, "&H")
  687.         IF l THEN
  688.             E = l + 1: finished = 0
  689.             DO
  690.                 E = E + 1
  691.                 comp$ = MID$(t$, E, 1)
  692.                 SELECT CASE comp$
  693.                     CASE "0" TO "9", "A" TO "F" 'All is good, our next digit is a number, continue to add to the hex$
  694.                     CASE ELSE
  695.                         good = 0
  696.                         FOR i = 1 TO UBOUND(oname)
  697.                             IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
  698.                         NEXT
  699.                         IF NOT good THEN e$ = "ERROR - Improper &H value. (" + comp$ + ")": EXIT SUB
  700.                         E = E - 1
  701.                         finished = -1
  702.                 END SELECT
  703.             LOOP UNTIL finished OR E = LEN(t$)
  704.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(VAL(MID$(t$, l, E - l + 1))))) + MID$(t$, E + 1)
  705.         END IF
  706.     LOOP UNTIL l = 0
  707.  
  708.     'Turn all &B (binary) numbers into decimal values for the program to process properly
  709.     l = 0
  710.     DO
  711.         l = INSTR(t$, "&B")
  712.         IF l THEN
  713.             E = l + 1: finished = 0
  714.             DO
  715.                 E = E + 1
  716.                 comp$ = MID$(t$, E, 1)
  717.                 SELECT CASE comp$
  718.                     CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
  719.                     CASE ELSE
  720.                         good = 0
  721.                         FOR i = 1 TO UBOUND(oname)
  722.                             IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
  723.                         NEXT
  724.                         IF NOT good THEN e$ = "ERROR - Improper &B value. (" + comp$ + ")": EXIT SUB
  725.                         E = E - 1
  726.                         finished = -1
  727.                 END SELECT
  728.             LOOP UNTIL finished OR E = LEN(t$)
  729.             bin$ = MID$(t$, l + 2, E - l - 1)
  730.             FOR i = 1 TO LEN(bin$)
  731.                 IF MID$(bin$, i, 1) = "1" THEN f = f + 2 ^ (LEN(bin$) - i)
  732.             NEXT
  733.             t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(f))) + MID$(t$, E + 1)
  734.         END IF
  735.     LOOP UNTIL l = 0
  736.  
  737.     'PRINT "ALMOST:"; t$
  738.  
  739.     t$ = N2S(t$)
  740.     'PRINT "ALMOST2:"; t$
  741.     VerifyString t$
  742.     'PRINT "Out of PreParse: "; e$
  743.     e$ = t$
  744.  
  745.  
  746.  
  747. SUB VerifyString (t$)
  748.     'ERROR CHECK for unrecognized operations
  749.     j = 1
  750.     DO
  751.         comp$ = MID$(t$, j, 1)
  752.         SELECT CASE comp$
  753.             CASE "0" TO "9", ".", "(", ")", ",": j = j + 1
  754.             CASE ELSE
  755.                 good = 0
  756.                 FOR i = 1 TO UBOUND(OName)
  757.                     IF MID$(t$, j, LEN(OName(i))) = OName(i) THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
  758.                 NEXT
  759.                 IF NOT good THEN t$ = "ERROR - Bad Operational value. (" + comp$ + ")": EXIT SUB
  760.                 j = j + LEN(OName(i))
  761.         END SELECT
  762.     LOOP UNTIL j > LEN(t$)
  763.  
  764. FUNCTION N2S$ (exp$) 'scientific Notation to String
  765.  
  766.     'PRINT "Before notation:"; exp$
  767.  
  768.     t$ = LTRIM$(RTRIM$(exp$))
  769.     IF LEFT$(t$, 1) = "-" OR LEFT$(t$, 1) = "N" THEN sign$ = "-": t$ = MID$(t$, 2)
  770.  
  771.     dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
  772.     ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
  773.     check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
  774.     IF check1 < 1 OR check1 > 1 THEN N2S = exp$: EXIT SUB 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
  775.  
  776.     SELECT CASE l 'l now tells us where the SN starts at.
  777.         CASE IS < dp: l = dp
  778.         CASE IS < dm: l = dm
  779.         CASE IS < ep: l = ep
  780.         CASE IS < em: l = em
  781.     END SELECT
  782.  
  783.     l$ = LEFT$(t$, l - 1) 'The left of the SN
  784.     r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
  785.  
  786.  
  787.     IF INSTR(l$, ".") THEN 'Location of the decimal, if any
  788.         IF r&& > 0 THEN
  789.             r&& = r&& - LEN(l$) + 2
  790.         ELSE
  791.             r&& = r&& + 1
  792.         END IF
  793.         l$ = LEFT$(l$, 1) + MID$(l$, 3)
  794.     END IF
  795.  
  796.     SELECT CASE r&&
  797.         CASE 0 'what the heck? We solved it already?
  798.             'l$ = l$
  799.         CASE IS < 0
  800.             FOR i = 1 TO -r&&
  801.                 l$ = "0" + l$
  802.             NEXT
  803.             l$ = "0." + l$
  804.         CASE ELSE
  805.             FOR i = 1 TO r&&
  806.                 l$ = l$ + "0"
  807.             NEXT
  808.     END SELECT
  809.  
  810.     N2S$ = sign$ + l$
  811.     'PRINT "After notation:"; N2S$
  812.  

This doesn't have any of the $NOPREFIX code in it yet, as I was having issues before with just plugging it into QB64 and having it work as a replacement when I tried it.  If this holds up here, as a stand-alone EXE, and nobody encounters any further glitches with it, I'll start with adding it into my personal repo first -- where's there's no $NOPREFIX in it.  Then, once I've got it up and interacting with my version of QB64, I'll take what I learn from that testing and push it into the main development branch and get it up and going...

...and then I can add the $NOPREFIX code back in and get it to working with it properly.  ;)

So, still several steps before this ends up inside QB64 replacing our existing process, but it's moving ever so slowly forward, towards that  goal.  :)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Steve's Math Evaluator
« Reply #17 on: March 10, 2020, 07:00:27 am »
Can we get a bump and a Best Answer for this thread?
You're not done when it works, you're done when it's right.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Steve's Math Evaluator
« Reply #18 on: March 10, 2020, 03:23:22 pm »
Can we get a bump and a Best Answer for this thread?

Sure.  ;D
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

FellippeHeitor

  • Guest
Re: Steve's Math Evaluator
« Reply #19 on: March 10, 2020, 03:30:10 pm »
Quote
...and then I can add the $NOPREFIX code back in and get it to working with it properly.  ;)

So, still several steps before this ends up inside QB64 replacing our existing process, but it's moving ever so slowly forward, towards that  goal.  :)

Important to notice this has already been adapted to work with $NOPREFIX and has been added to QB64 before the v1.4 release.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Steve's Math Evaluator
« Reply #20 on: March 10, 2020, 04:14:29 pm »
Ty boys, you know where this'll end up!
« Last Edit: March 10, 2020, 04:27:29 pm by STxAxTIC »
You're not done when it works, you're done when it's right.