4901688 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n vmpu2.bas
   1: DECLARE FUNCTION Add$ (nnn1$, nnn2$)
   2: DECLARE FUNCTION AddComma$ (N$)
   3: DECLARE FUNCTION Div$ (nnn1$, nnn2$)
   4: DECLARE FUNCTION Fact$ (nn$)
   5: DECLARE FUNCTION FindCPUMathErrors! ()
   6: DECLARE FUNCTION IsGreater! (nnn1$, nnn2$)
   7: DECLARE FUNCTION Mul$ (nnn1$, nnn2$)
   8: DECLARE FUNCTION Pwr$ (n1$, n2$)
   9: DECLARE FUNCTION RemoveSpace$ (t$)
  10: DECLARE FUNCTION RemoveZero$ (n1$)
  11: DECLARE FUNCTION Solve$ (oe$, Meth!)
  12: DECLARE FUNCTION SolveSimple$ (equ$, Meth!)
  13: DECLARE FUNCTION Subt$ (nnn1$, nnn2$)
  14: DECLARE FUNCTION Switch$ (tof1!, r1$, tof2!, r2$)
  15: DECLARE FUNCTION Trim$ (t$)
  16: 
  17: FUNCTION Add$ (nnn1$, nnn2$)
  18: n1$ = Trim$(nnn1$): n2$ = Trim$(nnn2$)
  19: IF INSTR(n1$, "-") <> 0 XOR INSTR(n2$, "-") <> 0 THEN
  20: IF INSTR(n2$, "-") <> 0 THEN Add$ = Subt$(RIGHT$(n1$, LEN(n1$) - INSTR(n1$, "-")), RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-"))): EXIT FUNCTION
  21: IF INSTR(n1$, "-") <> 0 THEN Add$ = Subt$(RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-")), RIGHT$(n1$, LEN(n1$) - INSTR(n1$, "-"))): EXIT FUNCTION
  22: END IF
  23: IF INSTR(n1$, "-") <> 0 AND INSTR(n2$, "-") <> 0 THEN Neg$ = "-": n1$ = RIGHT$(n1$, LEN(n1$) - INSTR(n1$, "-")): n2$ = RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-"))
  24: 
  25: 
  26: 
  27: 
  28: IF INSTR(n1$, ".") <> 0 OR INSTR(n2$, ".") <> 0 THEN
  29: IF INSTR(n1$, ".") = 0 THEN n1$ = n1$ + ".0"
  30: IF INSTR(n2$, ".") = 0 THEN n2$ = n2$ + ".0"
  31: IF INSTR(n1$, ".") > INSTR(n2$, ".") THEN n2$ = STRING$(INSTR(n1$, ".") - INSTR(n2$, "."), "0") + n2$ ELSE n1$ = STRING$(INSTR(n2$, ".") - INSTR(n1$, "."), "0") + n1$
  32: IF LEN(n1$) - INSTR(n1$, ".") > LEN(n2$) - INSTR(n2$, ".") THEN n2$ = n2$ + STRING$((LEN(n1$) - INSTR(n1$, ".")) - (LEN(n2$) - INSTR(n2$, ".")), "0") ELSE n1$ = n1$ + STRING$((LEN(n2$) - INSTR(n2$, ".")) - (LEN(n1$) - INSTR(n1$, ".")), "0")
  33: Stor = LEN(n1$) - INSTR(n1$, ".")
  34: IF INSTR(n1$, ".") <> 0 THEN n1$ = LEFT$(n1$, INSTR(n1$, ".") - 1) + RIGHT$(n1$, (LEN(n1$) - INSTR(n1$, ".")))
  35: IF INSTR(n2$, ".") <> 0 THEN n2$ = LEFT$(n2$, INSTR(n2$, ".") - 1) + RIGHT$(n2$, (LEN(n2$) - INSTR(n2$, ".")))
  36: ELSE
  37: IF LEN(n1$) > LEN(n2$) THEN n2$ = STRING$(LEN(n1$) - LEN(n2$), "0") + n2$ ELSE n1$ = STRING$(LEN(n2$) - LEN(n1$), "0") + n1$
  38: END IF
  39: 
  40: FOR q = LEN(n1$) TO 1 STEP -1
  41: mx$ = LTRIM$(RTRIM$(STR$((VAL(MID$(n1$, q, 1)) + VAL(MID$(n2$, q, 1))) + Rmd)))
  42: Rmd = VAL(LEFT$(mx$, LEN(mx$) - 1)): mx$ = RIGHT$(mx$, 1)
  43: cc$ = mx$ + cc$
  44: NEXT q
  45: IF Rmd = 0 THEN D$ = cc$ ELSE D$ = LTRIM$(RTRIM$(STR$(Rmd))) + cc$
  46: IF Stor <> 0 THEN D$ = LEFT$(D$, LEN(D$) - Stor) + "." + RIGHT$(D$, Stor)
  47: Add$ = Neg$ + D$
  48: 
  49: END FUNCTION
  50: 
  51: FUNCTION AddComma$ (N$)
  52: IF INSTR(N$, ".") = 0 THEN dd = LEN(N$) ELSE dd = INSTR(N$, ".") - 1
  53: FOR q = dd TO 1 STEP -1
  54: IF (dd - q) MOD 3 = 0 AND q <> dd THEN mm$ = "," + mm$
  55: mm$ = MID$(N$, q, 1) + mm$
  56: NEXT q
  57: IF INSTR(N$, ".") <> 0 THEN dc$ = "." + RIGHT$(N$, LEN(N$) - INSTR(N$, "."))
  58: AddComma$ = mm$ + dc$
  59: END FUNCTION
  60: 
  61: FUNCTION Div$ (nnn1$, nnn2$)
  62: n1$ = nnn1$: n2$ = nnn2$
  63: IF IsGreater(n1$, n2$) = 3 THEN Div$ = "1": EXIT FUNCTION
  64: IF INSTR(n1$, ".") = 0 THEN Mrk = LEN(n1$) ELSE Mrk = INSTR(n1$, ".")
  65: DIM Num$(9)
  66: Num$(1) = n2$
  67: FOR q = 2 TO 9
  68:         Num$(q) = Mul$(n2$, Trim$(STR$(q)))
  69: NEXT q
  70: Level = LEN(n1$)
  71: DO
  72:         Level = Level - 1
  73:         c = LEN(n1$) - Level: Cl$ = ""
  74:         DO UNTIL 1 = 2
  75:                 Cl$ = LEFT$(n1$, c)
  76:                 IF IsGreater(n1$, Cl$) = 1 OR IsGreater(n1$, Cl$) = 3 THEN EXIT DO ELSE c = c + 1
  77:         LOOP
  78:         mmx = c
  79:         Cl$ = LEFT$(n1$, mmx)
  80:         FOR g = 1 TO 9
  81:                 IF IsGreater(Cl$, Num$(g)) = 2 THEN mmz = g - 1: EXIT FOR
  82:         NEXT g
  83:         tt$ = tt$ + Trim$(STR$(mmz))
  84:         IF Level >= 0 THEN Post$ = STRING$(Level, "0"): pre$ = "" 'ELSE pre$ = "." + STRING$(Level * -1, "0"): Post$ = ""
  85:         n1$ = RemoveZero$(Subt$(n1$, Num$(mmz) + Post$))
  86: IF Level < 0 AND n1$ <> "0" THEN n1$ = n1$ + "0"
  87: 'if Instr(Mrk,tt$,)
  88: LOOP UNTIL n1$ = "0" OR Stpp
  89: tt$ = RemoveZero$(tt$)
  90: IF LEN(tt$) = Mrk - 1 THEN Div$ = tt$ ELSE Div$ = LEFT$(tt$, Mrk) + "." + RIGHT$(tt$, LEN(tt$) - (Mrk + 1))
  91: END FUNCTION
  92: 
  93: SUB Errorr (Msg$)
  94: PRINT "Error:"; Msg$
  95: END SUB
  96: 
  97: FUNCTION Fact$ (nn$)
  98: ff$ = nn$
  99: gg$ = nn$
 100: DO
 101: ff$ = RemoveZero$(Subt$(ff$, "1"))
 102: gg$ = RemoveZero$(Mul$(gg$, ff$))
 103: LOOP UNTIL RemoveZero$(ff$) = "1"
 104: Fact$ = RemoveZero$(gg$)
 105: END FUNCTION
 106: 
 107: FUNCTION FindCPUMathErrors
 108: CLS
 109: VIEW PRINT 1 TO 24
 110: LOCATE 1, 1: PRINT "CPU"; TAB(36); " ³ "; "VMPU"
 111: LOCATE 2, 1: PRINT STRING$(36, 196) + "Å" + STRING$(42, 196);
 112: LOCATE 25, 1: PRINT "Press Any Key to Stop Test";
 113: VIEW PRINT 3 TO 24
 114: IF 33.1 / 331 <> .1 THEN ErrErrs = 1: PRINT 33.1 / 331; TAB(36); " ³ .1"
 115: g$ = "-40"
 116: inc$ = ".001"
 117: DO
 118: g$ = Add$(g$, inc$)
 119: IF IsGreater(STR$(VAL(g$) - VAL(inc$)), Subt$(g$, inc$)) <> 3 THEN ErrErr1 = 1
 120: IF VAL(g$) - VAL(inc$) <> VAL(Subt$(g$, inc$)) AND ErrErr1 = 1 THEN PRINT VAL(g$) - VAL(inc$); TAB(36); " ³ "; VAL(Subt$(g$, inc$)): ErrErrs = ErrErrs + 1
 121: 
 122: IF IsGreater(STR$(VAL(g$) * VAL(inc$)), Mul$(g$, inc$)) <> 3 THEN ErrErr2 = 1
 123: IF VAL(g$) * VAL(inc$) <> VAL(Mul$(g$, inc$)) AND ErrErr2 = 1 THEN PRINT VAL(g$) * VAL(inc$); TAB(36); " ³ "; VAL(Mul$(g$, inc$)): ErrErrs = ErrErrs + 1
 124: 
 125: IF IsGreater(STR$(VAL(g$) + VAL(inc$)), Add$(g$, inc$)) <> 3 THEN ErrErr3 = 1
 126: IF VAL(g$) + VAL(inc$) <> VAL(Add$(g$, inc$)) AND ErrErr3 = 1 THEN PRINT VAL(g$) + VAL(inc$); TAB(36); " ³ "; VAL(Add$(g$, inc$)): ErrErrs = ErrErrs + 1
 127: 
 128: 
 129: 'LOCATE CSRLIN, 1: PRINT g$; ", Errors:"; ErrErrs;
 130: ErrErr1 = 0: ErrErr2 = 0: ErrErr3 = 0: ErrErr4 = 0:
 131: IF INKEY$ <> "" THEN PRINT : EXIT DO
 132: LOOP UNTIL g$ = "40"
 133: FindCPUMathErrors = ErrErrs
 134: X = CSRLIN
 135: VIEW PRINT 1 TO 25
 136: LOCATE X, 1
 137: END FUNCTION
 138: 
 139: FUNCTION IsGreater (nnn1$, nnn2$)
 140: n1$ = nnn1$: n2$ = nnn2$
 141: IF INSTR(n1$, "-") <> 0 AND INSTR(n2$, "-") = 0 THEN IsGreater = 2: EXIT FUNCTION
 142: IF INSTR(n2$, "-") <> 0 AND INSTR(n1$, "-") = 0 THEN IsGreater = 1: EXIT FUNCTION
 143: IF INSTR(n2$, "-") <> 0 AND INSTR(n1$, "-") <> 0 THEN nn1$ = n1$: nn2$ = n2$: n1$ = nn2$: n2$ = nn1$
 144: 
 145: n1$ = RIGHT$(n1$, LEN(n1$) - INSTR(n1$, "-")): n2$ = RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-"))
 146: 
 147: 
 148: IF INSTR(n1$, ".") <> 0 OR INSTR(n2$, ".") <> 0 THEN
 149: IF INSTR(n1$, ".") = 0 THEN n1$ = n1$ + ".0"
 150: IF INSTR(n2$, ".") = 0 THEN n2$ = n2$ + ".0"
 151: IF INSTR(n1$, ".") > INSTR(n2$, ".") THEN n2$ = STRING$(INSTR(n1$, ".") - INSTR(n2$, "."), "0") + n2$ ELSE n1$ = STRING$(INSTR(n2$, ".") - INSTR(n1$, "."), "0") + n1$
 152: IF LEN(n1$) - INSTR(n1$, ".") > LEN(n2$) - INSTR(n2$, ".") THEN n2$ = n2$ + STRING$((LEN(n1$) - INSTR(n1$, ".")) - (LEN(n2$) - INSTR(n2$, ".")), "0") ELSE n1$ = n1$ + STRING$((LEN(n2$) - INSTR(n2$, ".")) - (LEN(n1$) - INSTR(n1$, ".")), "0")
 153: Stor = LEN(n1$) - INSTR(n1$, ".")
 154: IF INSTR(n1$, ".") <> 0 THEN n1$ = LEFT$(n1$, INSTR(n1$, ".") - 1) + RIGHT$(n1$, (LEN(n1$) - INSTR(n1$, ".")))
 155: IF INSTR(n2$, ".") <> 0 THEN n2$ = LEFT$(n2$, INSTR(n2$, ".") - 1) + RIGHT$(n2$, (LEN(n2$) - INSTR(n2$, ".")))
 156: ELSE
 157: IF LEN(n1$) > LEN(n2$) THEN n2$ = STRING$(LEN(n1$) - LEN(n2$), "0") + n2$ ELSE n1$ = STRING$(LEN(n2$) - LEN(n1$), "0") + n1$
 158: END IF
 159: 
 160: 
 161: FOR q = 1 TO LEN(n1$)
 162: IF VAL(MID$(n1$, q, 1)) > VAL(MID$(n2$, q, 1)) THEN IsGreater = 1: EXIT FUNCTION
 163: IF VAL(MID$(n2$, q, 1)) > VAL(MID$(n1$, q, 1)) THEN IsGreater = 2: EXIT FUNCTION
 164: NEXT q
 165: IsGreater = 3
 166: END FUNCTION
 167: 
 168: FUNCTION Mul$ (nnn1$, nnn2$)
 169: nn1$ = Trim$(nnn1$): nn2$ = Trim$(nnn2$)
 170: IF nn1$ = "1" THEN Mul$ = nn2$: EXIT FUNCTION
 171: IF nn2$ = "1" THEN Mul$ = nn1$: EXIT FUNCTION
 172: IF nn1$ = "-1" THEN nn2$ = " " + nn2$: MID$(nn2$, VAL(Switch$(INSTR(nn2$, "-") = 0, "1", INSTR(nn2$, "-") <> 0, STR$(INSTR(nn2$, "-")))), 1) = Switch$(INSTR(nn2$, "-") <> 0, " ", INSTR(nn2$, "-") = 0, "-"): Mul$ = Trim$(nn2$): EXIT FUNCTION
 173: IF nn2$ = "-1" THEN nn1$ = " " + nn1$: MID$(nn1$, VAL(Switch$(INSTR(nn1$, "-") = 0, "1", INSTR(nn1$, "-") <> 0, STR$(INSTR(nn1$, "-")))), 1) = Switch$(INSTR(nn1$, "-") <> 0, " ", INSTR(nn1$, "-") = 0, "-"): Mul$ = Trim$(nn1$): EXIT FUNCTION
 174: 
 175: 
 176: IF LEFT$(nn1$, 1) = "-" XOR LEFT$(nn2$, 1) = "-" THEN Neg$ = "-" ELSE Neg$ = ""
 177: 
 178: IF IsGreater(n1$, n2$) = 2 THEN nn1$ = n2$: nn2$ = n1$: n1$ = nn1$: n2$ = nn2$
 179: 
 180: IF INSTR(n1$, ".") <> 0 OR INSTR(n2$, ".") <> 0 THEN
 181: IF INSTR(n1$, ".") = 0 THEN n1$ = n1$ + ".0"
 182: IF INSTR(n2$, ".") = 0 THEN n2$ = n2$ + ".0"
 183: IF INSTR(n1$, ".") > INSTR(n2$, ".") THEN n2$ = STRING$(INSTR(n1$, ".") - INSTR(n2$, "."), "0") + n2$ ELSE n1$ = STRING$(INSTR(n2$, ".") - INSTR(n1$, "."), "0") + n1$
 184: IF LEN(n1$) - INSTR(n1$, ".") > LEN(n2$) - INSTR(n2$, ".") THEN n2$ = n2$ + STRING$((LEN(n1$) - INSTR(n1$, ".")) - (LEN(n2$) - INSTR(n2$, ".")), "0") ELSE n1$ = n1$ + STRING$((LEN(n2$) - INSTR(n2$, ".")) - (LEN(n1$) - INSTR(n1$, ".")), "0")
 185: Stor = LEN(n1$) - INSTR(n1$, ".")
 186: IF INSTR(n1$, ".") <> 0 THEN n1$ = LEFT$(n1$, INSTR(n1$, ".") - 1) + RIGHT$(n1$, (LEN(n1$) - INSTR(n1$, ".")))
 187: IF INSTR(n2$, ".") <> 0 THEN n2$ = LEFT$(n2$, INSTR(n2$, ".") - 1) + RIGHT$(n2$, (LEN(n2$) - INSTR(n2$, ".")))
 188: ELSE
 189: IF LEN(n1$) > LEN(n2$) THEN n2$ = STRING$(LEN(n1$) - LEN(n2$), "0") + n2$ ELSE n1$ = STRING$(LEN(n2$) - LEN(n1$), "0") + n1$
 190: END IF
 191: 
 192: 
 193: IF INSTR(nn1$, ".") <> 0 OR INSTR(nn2$, ".") <> 0 THEN
 194: IF INSTR(nn1$, ".") = 0 THEN nn1$ = nn1$ + ".0"
 195: IF INSTR(nn2$, ".") = 0 THEN nn2$ = nn2$ + ".0"
 196: 
 197: Stor = (LEN(nn1$) - INSTR(nn1$, ".")) + (LEN(nn2$) - INSTR(nn2$, "."))
 198: IF INSTR(nn1$, ".") <> 0 THEN nn1$ = LEFT$(nn1$, INSTR(nn1$, ".") - 1) + RIGHT$(nn1$, (LEN(nn1$) - INSTR(nn1$, ".")))
 199: IF INSTR(nn2$, ".") <> 0 THEN nn2$ = LEFT$(nn2$, INSTR(nn2$, ".") - 1) + RIGHT$(nn2$, (LEN(nn2$) - INSTR(nn2$, ".")))
 200: END IF
 201: 
 202: FOR q1 = LEN(nn2$) TO 1 STEP -1
 203: ccc$ = STRING$(LEN(nn2$) - q1, "0")
 204: FOR q2 = LEN(nn1$) TO 1 STEP -1
 205: mmm$ = RTRIM$(LTRIM$(STR$((VAL(MID$(nn1$, q2, 1)) * VAL(MID$(nn2$, q1, 1))) + Rmd)))
 206: Rmd = VAL(LEFT$(mmm$, LEN(mmm$) - 1)): mmm$ = RIGHT$(mmm$, 1)
 207: ccc$ = mmm$ + ccc$
 208: NEXT q2
 209: ccc$ = LTRIM$(RTRIM$(STR$(Rmd))) + ccc$
 210: tt$ = Add$(tt$, ccc$)
 211: Rmd = 0
 212: NEXT q1
 213: IF (LEN(tt$) - Stor) < 0 THEN tt$ = STRING$((LEN(tt$) - Stor) * -1, "0") + tt$
 214: IF Stor > 0 THEN tt$ = LEFT$(tt$, LEN(tt$) - Stor) + "." + RIGHT$(tt$, Stor)
 215: 
 216: Mul$ = Neg$ + tt$
 217: END FUNCTION
 218: 
 219: FUNCTION Pwr$ (n1$, n2$)
 220: nz1$ = n1$
 221: nz2$ = n1$
 222: gg$ = n2$
 223: DO
 224: nz1$ = RemoveZero$(Mul$(nz1$, nz2$))
 225: gg$ = RemoveZero$(Subt$(gg$, "1"))
 226: LOOP UNTIL RemoveZero$(gg$) = "1"
 227: Pwr$ = RemoveZero$(nz1$)
 228: END FUNCTION
 229: 
 230: FUNCTION RemoveSpace$ (t$)
 231: FOR q = 1 TO LEN(t$)
 232: IF MID$(t$, q, 1) = " " THEN  ELSE dd$ = dd$ + MID$(t$, q, 1)
 233: NEXT q
 234: RemoveSpace$ = dd$
 235: END FUNCTION
 236: 
 237: FUNCTION RemoveZero$ (n1$)
 238: Neg = INSTR(n1$, "-")
 239: IF INSTR(n1$, ".") = 0 THEN ddd = LEN(n1$) ELSE ddd = INSTR(n1$, ".")
 240: FOR q = 1 + Neg TO ddd
 241: IF MID$(n1$, q, 1) <> "0" THEN EXIT FOR
 242: NEXT q
 243: IF Neg <> 0 THEN Nx$ = "-" ELSE Nx$ = ""
 244: IF RIGHT$(n1$, LEN(n1$) - q + 1) = "" THEN Rz$ = "0" ELSE Rz$ = RIGHT$(n1$, LEN(n1$) - q + 1)
 245: IF INSTR(Rz$, ".") = 1 THEN Rz$ = "0" + Rz$
 246: IF INSTR(Rz$, ".") = 0 THEN RemoveZero$ = Nx$ + Rz$: EXIT FUNCTION
 247: FOR q = LEN(Rz$) TO INSTR(Rz$, ".") STEP -1
 248: IF MID$(Rz$, q, 1) <> "0" THEN EXIT FOR
 249: NEXT q
 250: RemoveZero$ = Nx$ + LEFT$(Rz$, q)
 251: 
 252: END FUNCTION
 253: 
 254: FUNCTION Solve$ (oe$, Meth)
 255: e$ = Trim$(RemoveSpace$(oe$))
 256: DO
 257: m = INSTR(e$, "^")
 258: IF m = 0 THEN m = INSTR(e$, "*")
 259: IF m = 0 THEN m = INSTR(e$, "/")
 260: IF m = 0 THEN m = INSTR(e$, "+"): dd = 12
 261: IF m = 0 THEN m = INSTR(e$, "-"): dd = 12
 262: IF m = 1 AND dd = 12 THEN m = 0
 263: dd = 0
 264: IF m = 0 THEN GOTO Solved
 265: FOR q = 1 TO m - 1
 266: IF LTRIM$(RTRIM$(STR$(VAL(MID$(e$, m - q, 1))))) <> MID$(e$, m - q, 1) AND MID$(e$, m - q, 1) <> "." AND (q = 1 AND LEFT$(e$, 1) <> "-") THEN EXIT FOR
 267: NEXT q
 268: FOR q1 = m - 1 TO LEN(e$)
 269: IF LTRIM$(RTRIM$(STR$(VAL(MID$(e$, m + q1, 1))))) <> MID$(e$, m + q1, 1) AND MID$(e$, m + q1, 1) <> "." THEN EXIT FOR
 270: NEXT q1
 271: eq$ = MID$(e$, m - q + 1, (m - q) - 1 + (q1 + m))
 272: 'MSGBOX e$ + ", " + eq$ + STR$(q) + STR$(q1)
 273: 'k$ = (eq$)
 274: e$ = LEFT$(e$, m - q) + SolveSimple$(eq$, Meth) + MID$(e$, q1 + m, LEN(e$))
 275: Solved:
 276: LOOP UNTIL m = 0
 277: Solve$ = e$
 278: END FUNCTION
 279: 
 280: FUNCTION SolveSimple$ (equ$, Meth)
 281: IF Meth = 0 THEN
 282: IF INSTR(equ$, "^") <> 0 THEN z1$ = Trim$(MID$(equ$, 1, INSTR(equ$, "^") - 1)): z2$ = Trim$(MID$(equ$, INSTR(equ$, "^") + 1, LEN(equ$) - INSTR(equ$, "^"))): SolveSimple$ = RemoveZero$(Pwr$(z1$, z2$)): EXIT FUNCTION
 283: IF INSTR(equ$, "*") <> 0 THEN z1$ = Trim$(MID$(equ$, 1, INSTR(equ$, "*") - 1)): z2$ = Trim$(MID$(equ$, INSTR(equ$, "*") + 1, LEN(equ$) - INSTR(equ$, "*"))): SolveSimple$ = RemoveZero$(Mul$(z1$, z2$)): EXIT FUNCTION
 284: IF INSTR(equ$, "/") <> 0 THEN z1$ = Trim$(MID$(equ$, 1, INSTR(equ$, "/") - 1)): z2$ = Trim$(MID$(equ$, INSTR(equ$, "/") + 1, LEN(equ$) - INSTR(equ$, "/"))): SolveSimple$ = RemoveZero$(Div$(z1$, z2$)): EXIT FUNCTION
 285: IF INSTR(equ$, "+") <> 0 THEN z1$ = Trim$(MID$(equ$, 1, INSTR(equ$, "+") - 1)): z2$ = Trim$(MID$(equ$, INSTR(equ$, "+") + 1, LEN(equ$) - INSTR(equ$, "+"))): SolveSimple$ = RemoveZero$(Add$(z1$, z2$)): EXIT FUNCTION
 286: IF INSTR(equ$, "-") <> 0 THEN z1$ = Trim$(MID$(equ$, 1, INSTR(equ$, "-") - 1)): z2$ = Trim$(MID$(equ$, INSTR(equ$, "-") + 1, LEN(equ$) - INSTR(equ$, "-"))): SolveSimple$ = RemoveZero$(Subt$(z1$, z2$)): EXIT FUNCTION
 287: ELSE
 288: IF INSTR(equ$, "^") <> 0 THEN z1 = VAL(MID$(equ$, 1, INSTR(equ$, "^") - 1)): z2 = VAL(MID$(equ$, INSTR(equ$, "^") + 1, LEN(equ$) - INSTR(equ$, "^"))): SolveSimple$ = Trim$(STR$(z1 ^ z2)): EXIT FUNCTION
 289: IF INSTR(equ$, "*") <> 0 THEN z1 = VAL(MID$(equ$, 1, INSTR(equ$, "*") - 1)): z2 = VAL(MID$(equ$, INSTR(equ$, "*") + 1, LEN(equ$) - INSTR(equ$, "*"))): SolveSimple$ = Trim$(STR$(z1 * z2)): EXIT FUNCTION
 290: IF INSTR(equ$, "/") <> 0 THEN z1 = VAL(MID$(equ$, 1, INSTR(equ$, "/") - 1)): z2 = VAL(MID$(equ$, INSTR(equ$, "/") + 1, LEN(equ$) - INSTR(equ$, "/"))): SolveSimple$ = Trim$(STR$(z1 / z2)): EXIT FUNCTION
 291: IF INSTR(equ$, "+") <> 0 THEN z1 = VAL(MID$(equ$, 1, INSTR(equ$, "+") - 1)): z2 = VAL(MID$(equ$, INSTR(equ$, "+") + 1, LEN(equ$) - INSTR(equ$, "+"))): SolveSimple$ = Trim$(STR$(z1 + z2)): EXIT FUNCTION
 292: IF INSTR(equ$, "-") <> 0 THEN z1 = VAL(MID$(equ$, 1, INSTR(equ$, "-") - 1)): z2 = VAL(MID$(equ$, INSTR(equ$, "-") + 1, LEN(equ$) - INSTR(equ$, "-"))): SolveSimple$ = Trim$(STR$(z1 - z2)): EXIT FUNCTION
 293: 
 294: END IF
 295: END FUNCTION
 296: 
 297: FUNCTION Subt$ (nnn1$, nnn2$)
 298: n1$ = nnn1$: n2$ = nnn2$
 299: 
 300: IF (INSTR(n2$, "-") <> 0 AND INSTR(n1$, "-") = 0) THEN Subt$ = Add$(n1$, RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-"))): EXIT FUNCTION
 301: IF (INSTR(n1$, "-") <> 0 AND INSTR(n2$, "-") = 0) THEN Subt$ = "-" + Add$(n2$, RIGHT$(n1$, LEN(n1$) - INSTR(n1$, "-"))): EXIT FUNCTION
 302: IF (INSTR(n1$, "-") <> 0 AND INSTR(n2$, "-") <> 0) THEN n1$ = RIGHT$(n1$, LEN(n2$) - INSTR(n2$, "-")): n2$ = RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-")): IsAnsNeg = 1
 303: 
 304: IF IsGreater(n1$, n2$) = 2 THEN Neg = (1 + IsAnsNeg) MOD 2: dd1$ = n1$: dd2$ = n2$: n1$ = dd2$: n2$ = dd1$
 305: 
 306: IF INSTR(n1$, "-") <> 0 AND INSTR(n2$, "-") <> 0 THEN Neg = 1: n1$ = RIGHT$(n1$, LEN(n1$) - INSTR(n1$, "-")): n2$ = RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-")): Subt$ = "-" + Add$(n1$, n2$): EXIT FUNCTION
 307: 
 308: 
 309: 
 310: IF INSTR(n1$, ".") <> 0 OR INSTR(n2$, ".") <> 0 THEN
 311: IF INSTR(n1$, ".") = 0 THEN n1$ = n1$ + ".0"
 312: IF INSTR(n2$, ".") = 0 THEN n2$ = n2$ + ".0"
 313: IF INSTR(n1$, ".") > INSTR(n2$, ".") THEN n2$ = STRING$(INSTR(n1$, ".") - INSTR(n2$, "."), "0") + n2$ ELSE n1$ = STRING$(INSTR(n2$, ".") - INSTR(n1$, "."), "0") + n1$
 314: IF LEN(n1$) - INSTR(n1$, ".") > LEN(n2$) - INSTR(n2$, ".") THEN n2$ = n2$ + STRING$((LEN(n1$) - INSTR(n1$, ".")) - (LEN(n2$) - INSTR(n2$, ".")), "0") ELSE n1$ = n1$ + STRING$((LEN(n2$) - INSTR(n2$, ".")) - (LEN(n1$) - INSTR(n1$, ".")), "0")
 315: Stor = LEN(n1$) - INSTR(n1$, ".")
 316: IF INSTR(n1$, ".") <> 0 THEN n1$ = LEFT$(n1$, INSTR(n1$, ".") - 1) + RIGHT$(n1$, (LEN(n1$) - INSTR(n1$, ".")))
 317: IF INSTR(n2$, ".") <> 0 THEN n2$ = LEFT$(n2$, INSTR(n2$, ".") - 1) + RIGHT$(n2$, (LEN(n2$) - INSTR(n2$, ".")))
 318: ELSE
 319: IF LEN(n1$) > LEN(n2$) THEN n2$ = STRING$(LEN(n1$) - LEN(n2$), "0") + n2$ ELSE n1$ = STRING$(LEN(n2$) - LEN(n1$), "0") + n1$
 320: END IF
 321: 
 322: 
 323: FOR q = LEN(n1$) TO 1 STEP -1
 324: 
 325: IF VAL(MID$(n1$, q, 1)) < VAL(MID$(n2$, q, 1)) THEN
 326:     Num1 = VAL(MID$(n1$, q, 1)) + 10
 327:     l = 0
 328:     DO
 329:         l = l + 1
 330:         Br$ = MID$(n1$, q - l, 1)
 331:         IF Br$ = "0" THEN MID$(n1$, q - l, 1) = "9"
 332:     LOOP UNTIL Br$ <> "0"
 333:     MID$(n1$, q - l, 1) = RTRIM$(LTRIM$(STR$(VAL(MID$(n1$, q - l, 1)) - 1)))
 334: ELSE
 335:     Num1 = VAL(MID$(n1$, q, 1))
 336: END IF
 337: sc = Num1 - VAL(MID$(n2$, q, 1))
 338: cc$ = Trim$(STR$(sc)) + cc$
 339: NEXT q
 340: IF Neg = 1 THEN cc$ = "-" + cc$
 341: IF Stor <> 0 THEN cc$ = LEFT$(cc$, LEN(cc$) - Stor) + "." + RIGHT$(cc$, Stor)
 342: 
 343: Subt$ = cc$
 344: 
 345: END FUNCTION
 346: 
 347: FUNCTION Switch$ (tof1, r1$, tof2, r2$)
 348: IF tof1 = -1 THEN Switch$ = r1$
 349: IF tof2 = -1 THEN Switch$ = r2$
 350: END FUNCTION
 351: 
 352: FUNCTION Trim$ (t$)
 353: Trim$ = LTRIM$(RTRIM$(t$))
 354: END FUNCTION
 355: 
4901689 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 16:10:53