home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PRO98SRC.ZIP / RECURSE.BAS < prev    next >
BASIC Source File  |  1993-11-07  |  4KB  |  138 lines
  1. SUB RECURSE (c$)
  2. ' THIS ROUTINE CALCULATES THE VALUE OF AN INLINE EQUASION (recursive decent)
  3. ' inlines can be nested 3/13/93
  4. b$=c$
  5. DO
  6. aA = INSTR(b$, "[")                ' find first [
  7. IF aA = 0 THEN EXIT DO             ' if none then quit
  8. n=instr(aA+1,B$, "[")              ' find a second [
  9.  
  10. IF n THEN                         ' if it is there then
  11. ' recursive                       ' grab everything after first [
  12.     d$=mid$(B$,aa+1)           '
  13.     CALL RECURSE(D$)          ' call recurse on that
  14.     B$=LEFT$(B$,aa)+D$         ' add result to left up to first [
  15. END IF                            '
  16. b = INSTR(aA, b$, "]"): IF b = 0 THEN EXIT DO ' if no ] then quit
  17. IF b = aA + 1 THEN EXIT DO         ' if [] then quit
  18. C = b - (aA + 1)                   ' extract the equasion
  19. v$ = MID$(b$, aA + 1, C)           ' put equasion into v$
  20. Va$=MID$(STR$(CALC(v$)),2)        ' calculate value of v$
  21. REPLACE "["+v$+"]" WITH Va$ IN b$ ' replace the calculation with result
  22. LOOP                   ' keep going until no more [
  23. c$=b$                             ' return result in original parameter
  24. END SUB
  25.  
  26.  
  27. FUNCTION Calc (A$)
  28. SHARED Token$, TokenType, P, Arg$
  29. IF INSTR(A$,"@") THEN FUNCTIONS A$
  30. Arg$=A$
  31. R = 0
  32. P = 1
  33. IF Arg$ = "" THEN GOTO EndCalcSub
  34. CALL GetExp(R)
  35. LET Calc = R
  36. EndCalcSub:
  37. END FUNCTION
  38.  
  39.  
  40. SUB Arith (O$, R, H)
  41. SHARED Arg$, Token$, TokenType, P
  42. IF O$ = "-" THEN R = R - H
  43. IF O$ = "+" THEN R = R + H
  44. IF O$ = "*" THEN R = R * H
  45. IF O$ = "/" THEN R = R / H
  46. IF O$ = "^" THEN R = R ^ H
  47. IF O$ = "<" THEN R = R < H
  48. IF O$ = ">" THEN R = R > H
  49. IF O$ = "=" THEN R = R = H
  50. END SUB
  51.  
  52. SUB GetExp (R)
  53. SHARED Arg$, Token$, TokenType, P
  54. CALL GetToken
  55. CALL Level1(R)
  56. END SUB
  57.  
  58. SUB GetToken
  59. SHARED Arg$, Token$, TokenType, P
  60. Token$ = ""
  61. WHILE MID$(Arg$, P, 1) = " ": P = P + 1: WEND
  62. 'Tokentype 1 is an operator
  63. IF INSTR(MID$(Arg$, P, 1), ANY "-+*/^()<>=") THEN TokenType = 1: Token$ = MID$(Arg$, P, 1): P = P + 1: EXIT SUB
  64. 'Toekentype 2 is a number
  65. IF INSTR(MID$(Arg$, P, 1), ANY "0123456789.") THEN WHILE INSTR(" -+*/^()<>=", MID$(Arg$, P, 1)) = 0: Token$ = Token$ + MID$(Arg$, P, 1): P = P + 1: WEND: TokenType = 2:EXIT SUB
  66. WHILE INSTR(" -+*/^()<>=01234567890.", MID$(Arg$, P, 1)) = 0: Token$ = Token$ + MID$(Arg$, P, 1): P = P + 1: WEND: TokenType = 3
  67. END SUB
  68.  
  69. SUB Level1 (R)
  70. SHARED Arg$, Token$, TokenType, P
  71. CALL Level2(R): O$ = Token$
  72. WHILE O$ = "<" OR O$ = ">" OR O$ = "="
  73. CALL GetToken
  74. CALL Level2(H)
  75. CALL Arith(O$, R, H)
  76. O$ = Token$
  77. WEND
  78. END SUB
  79.  
  80. SUB Level2 (R)
  81. SHARED Arg$, Token$, TokenType, P
  82. CALL Level3(R)
  83. O$ = Token$
  84. WHILE O$ = "+" OR O$ = "-"
  85. CALL GetToken
  86. CALL Level3(H)
  87. CALL Arith(O$, R, H)
  88. O$ = Token$
  89. WEND
  90. END SUB
  91.  
  92. SUB Level3 (R)
  93. SHARED Arg$, Token$, TokenType, P
  94. CALL Level4(R)
  95. O$ = Token$
  96. WHILE O$ = "*" OR O$ = "/"
  97. CALL GetToken
  98. CALL Level4(H)
  99. CALL Arith(O$, R, H)
  100. O$ = Token$
  101. WEND
  102. END SUB
  103.  
  104. SUB Level4 (R)
  105. SHARED Arg$, Token$, TokenType, P
  106. CALL Level5(R)
  107. IF Token$ = "^" THEN CALL GetToken: CALL Level4(H): CALL Arith("^", R, H)
  108. END SUB
  109.  
  110. SUB Level5 (R)
  111. SHARED Arg$, Token$, TokenType, P
  112. O$ = ""
  113. IF TokenType = 1 AND (Token$ = "+" OR Token$ = "-") THEN O$ = Token$: CALL GetToken
  114. CALL Level6(R): IF O$ <> "" THEN CALL Un(O$, R)
  115. END SUB
  116.  
  117. SUB Level6 (R)
  118. SHARED  Arg$, Token$, TokenType, P
  119. IF Token$ = "(" AND TokenType = 1 THEN 230
  120. CALL Ptv(R): EXIT SUB
  121. 230 CALL GetToken
  122. CALL Level1(R)
  123. IF Token$ <> ")" THEN PRINT "Mismatched Parenthesis"  ' or use ERROR nn
  124. CALL GetToken
  125. END SUB
  126.  
  127. SUB Ptv (R)
  128. SHARED Arg$, Token$, TokenType, P
  129. IF TokenType = 2 THEN R = VAL(Token$): CALL GetToken: EXIT SUB
  130. PRINT "Bad Syntax"   ' or use ERROR nn
  131. END SUB
  132.  
  133. SUB Un (O$, R)
  134. SHARED Arg$, Token$, TokenType, P
  135. IF O$ = "-" THEN R = -R
  136. END SUB
  137.  
  138.