home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TBASIC / MC5.INC < prev    next >
Text File  |  1987-04-01  |  11KB  |  340 lines
  1. '┌───────────────────────────────────────────────────────────────────────────┐
  2. '│                               MC.BAS                                   │
  3. '│                             VERSION 1.0                                   │
  4. '│                                                                           │
  5. '│                           MODULE: MC5.INC                                 │
  6. '│                                                                           │
  7. '│                   Turbo Basic                     │
  8. '│        (C) Copyright 1987 by Borland International             │
  9. '│                                                                           │
  10. '│ DESCRIPTION: This module contains the procedures to evaluate formulas in  │
  11. '│        the spreadsheet and in general recalculate the entire         │
  12. '│        spreadsheet.                             │
  13. '└───────────────────────────────────────────────────────────────────────────┘
  14.  
  15. SUB NextChar
  16. ' this procedure returns the next character in the formula of the cell
  17. ' currently being evaluated
  18.  
  19.   SHARED Eofline$,Position%,FormulaStr$,NextChar$
  20.  
  21.   DO
  22.     INCR Position%
  23.     IF Position% <= LEN(FormulaStr$) THEN
  24.       NextChar$ = MID$(FormulaStr$, Position%, 1)
  25.     ELSE
  26.       NextChar$ = EofLine$
  27.     END IF
  28.   LOOP UNTIL NextChar$<>" "
  29. END SUB
  30.  
  31.  
  32. DEF FN Fact#(R#)
  33. ' recursive Factorial of R#
  34.  
  35.   IF (R#>0.0) AND (R#<34.0) THEN
  36.     FNFact#=R#*FNFact#(R#-1)
  37.   ELSE
  38.     FNFact#=1.0
  39.   END IF
  40.  
  41. END DEF
  42.  
  43.  
  44. DEF FNFactor#
  45. ' function Factor is the meat of the procedure Evaluate. Within this the
  46. ' procedure the current expression is actually evaluated. Using nested
  47. ' if-then-else statements, the function determines if the sub-expression
  48. ' is a number, the sum of a sub-range of cells (i.e. A1>A5), or a function
  49. ' (i.e. ABS(x) )
  50.  
  51.   LOCAL E%,EE%,L%,Sf% ' temporary variables
  52.   LOCAL Found%        ' boolean flag - standard function Found or not
  53.   LOCAL F#            ' F holds value returned by recursive calls to Factor
  54.   LOCAL CellSum#      ' Sum of a cell range
  55.   LOCAL Sf$           ' standard function string variable
  56.   LOCAL ExpFX%        ' ExpEFX and ExpFY hold the positions of the cells
  57.   LOCAL ExpFY%        ' referenced in any formulas
  58.   LOCAL Start%,Exy$           ' temporary cell references
  59.   LOCAL OldExpFX%,OldExpFy%   '
  60.   LOCAL CellStatus%,Contents$         ' Cell attribute variables
  61.   LOCAL Value#, Dec%, Fw%,CellColor%  '
  62.  
  63.   F# = NoPutReal#
  64.   IF FNInCharSet%(NextChar$, Numbers$) THEN
  65.     Start% = Position%
  66.     DO
  67.       CALL NextChar
  68.     LOOP UNTIL FNInCharSet%(NextChar$, Numbers$)<>%True
  69.     IF NextChar$ = "." THEN    ' is decimal point
  70.       DO
  71.          CALL NextChar
  72.       LOOP UNTIL FNInCharSet%(NextChar$, Numbers$)<>%True
  73.     END IF
  74.     IF NextChar$ = "E" THEN
  75.       CALL NextChar
  76.       DO
  77.         CALL NextChar
  78.       LOOP UNTIL FNInCharSet%(NextChar$, Numbers$)<>%True
  79.     END IF
  80.     ' now get the value of the number
  81.     F# = VAL(MID$(FormulaStr$, Start%, Position%-Start%))
  82.   ELSEIF NextChar$ = "(" THEN
  83.     'Parenthesis expression
  84.     CALL NextChar
  85.     IF NextChar$ = "+" THEN CALL NextChar
  86.     F# = FNExpression#
  87.     IF NextChar$ = ")" THEN
  88.       CALL NextChar
  89.     ELSE
  90.       ErrorPosition% = Position%
  91.     END IF
  92.   ELSEIF FNInCharSet%(NextChar$, "ABCDEFG") AND _
  93.          FNInCharSet%(MID$(FormulaStr$+" ",Position%+1,1),Numbers$+" ") THEN
  94.     ' Cell reference expression
  95.     ExpFX%=ASC(NextChar$)
  96.     CALL NextChar
  97.     IF FN InCharSet%(NextChar$, Numbers$) THEN
  98.       F# = 0
  99.       Exy$ = NextChar$
  100.       CALL NextChar
  101.       IF FN InCharSet%(NextChar$, Numbers$) THEN
  102.         Exy$ = Exy$ + NextChar$
  103.         CALL NextChar
  104.       END IF
  105.       ' GET Cell Number
  106.       ExpFy% = VAL(Exy$)
  107.       IF ExpFy%>%FyMax  THEN ExpFy%=%FyMax
  108.       IsFormula% = %TRUE
  109.       ' now check if the content of the cell referenced in the formula
  110.       ' is a constant. If so then verify that it has been calculated.
  111.       ' If the constant has been calculated then make a recursive call
  112.       ' to the procedure Evaluate to evaluate the contents of the cell.
  113.        CALL GetRec(ExpFx%, ExpFy%, CellStatus%, Contents$, Value#, _
  114.                   Dec%, Fw%,CellColor%)
  115.       IF FNIn%( %Constant , CellStatus% ) AND _
  116.               ( FNIn%( %Calculated , CellStatus% )<>%True )  THEN
  117.         CALL Evaluate(Form%, Contents$, F#, ErrorPosition%)
  118.         IsFormula% = %TRUE
  119.         CALL GetRec(ExpFx%, ExpFy%, CellStatus%, Contents$, Value#, _
  120.                     Dec%, Fw%,CellColor%)
  121.         CALL AddSet(%Calculated ,CellStatus%)
  122.         CALL PutRec(ExpFx%, ExpFy%, CellStatus%, CHR$(0), NoPutReal#, _
  123.                     -1, -1, -1)
  124.       ELSE
  125.         IF  FNIn%( %Txt , CellStatus%)<>%True  THEN F# = Value#
  126.       END IF
  127.       IF NextChar$ = ">" THEN
  128.       ' it's a cell range operator
  129.         OldExpFX% = ExpFX%
  130.         OldExpFY% = ExpFY%
  131.         CALL NextChar
  132.         ExpFx% = ASC(NextChar$)
  133.         CALL NextChar
  134.         IF FNInCharSet%(NextChar$, Numbers$) THEN
  135.           Exy$ = NextChar$
  136.           CALL NextChar
  137.           IF FNInCharSet%(NextChar$, Numbers$) THEN
  138.             Exy$ = Exy$ + NextChar$
  139.             CALL NextChar
  140.           END IF
  141.           ' now get the Cell number
  142.           ExpFy% = VAL(Exy$)
  143.           IF ExpFy%>%FyMax  THEN ExpFy%=%FyMax
  144.            CellSum# = 0.0
  145.            ' visit each cell specified in SUB-range of formula
  146.           FOR Momo% = OldExpFy% to ExpFy%
  147.             FOR Ida% = OldExpFx% to ExpFx%
  148.               F# = 0.0
  149.               CALL GetRec(Ida%, Momo%, CellStatus%, Contents$, Value#, _
  150.                           Dec%, Fw%,CellColor%)
  151.               IF FN In%( %Constant , CellStatus% ) AND _
  152.                 (FNIn%( %Calculated , CellStatus%)<>%True ) THEN
  153.                 CALL Evaluate(Form%, Contents$, F#, ErrorPosition%)
  154.                 ' update CellStatus to indicate that the cells' value has
  155.                 ' been calculated
  156.                 CALL GetRec(Ida%, Momo%, CellStatus%, Contents$, _
  157.                             Value#, Dec%, Fw%,CellColor%)
  158.                 CALL AddSet(%Calculated ,CellStatus%)
  159.                 CALL PutRec(Ida%, Momo%, CellStatus%, CHR$(0), _
  160.                             NoPutReal#, -1, -1, -1)
  161.               ELSE
  162.                 IF NOT FNIn%( %Txt , CellStatus% ) THEN F# = Value#
  163.               END IF
  164.               CellSum# = CellSum# + F#
  165.             NEXT
  166.           NEXT
  167.           F# = CellSum#
  168.         END IF
  169.       END IF
  170.     END IF
  171.   ELSE
  172.    ' Standard function
  173.    Found% = %FALSE
  174.    FOR Sf% = %Fabs  to %Ffact
  175.      ' step through all possible Standard functions
  176.      IF Found%<>%True  THEN
  177.        L% = LEN(StandardFunction$(Sf%))
  178.        IF MID$(FormulaStr$, Position%, L%) = _
  179.                          StandardFunction$(Sf%) THEN
  180.          Position% = Position% + L% - 1
  181.          CALL NextChar
  182.          F# = FNFactor#
  183.          SELECT CASE Sf%
  184.            CASE %Fabs
  185.              F# = ABS(F#)
  186.            CASE %Fsqrt
  187.              IF F# > 0 THEN F# = SQR(F#) ELSE F# = -1
  188.            CASE %Fsqr
  189.              F# = F#^2
  190.            CASE %Fsin
  191.              F# = SIN(F#)
  192.            CASE %Fcos
  193.              F# = COS(F#)
  194.            CASE %Farctan
  195.              F# = ATN(F#)
  196.            CASE %Fln
  197.              F# = LOG(F#)
  198.            CASE %Flog
  199.              F# = log10(F#)
  200.            CASE %Fexp
  201.              F# = EXP(F#)
  202.            CASE %Fint
  203.              F# = INT(F#)
  204.            CASE %Fsgn
  205.              F# = SGN(F#)
  206.            CASE %Frnd
  207.              F# = RND(F#)
  208.            CASE %Ffact
  209.              F# = FNFact#(F#)
  210.          END SELECT
  211.          Found% = %TRUE
  212.        END IF
  213.      END IF
  214.    NEXT Sf%
  215.    IF Found%<>%True  THEN ErrorPosition% = Position%
  216.   END IF
  217.   FNFactor# = F#
  218. END DEF
  219.  
  220. DEF FNSignedFactor#
  221. ' this function first determines the sign of the expression. It then
  222. ' calls the procedure factor to get the value of the expression.
  223.  
  224.   IF NextChar$ = "-" THEN
  225.     CALL NextChar
  226.     FN SignedFactor# = -FNFactor#
  227.   ELSE
  228.     FNSignedFactor# = FNFactor#
  229.   END IF
  230. END DEF
  231.  
  232. DEF FN Term#
  233.  
  234.  LOCAL T#
  235.  
  236.   T# = FNSignedFactor#
  237.   WHILE NextChar$ = "^"
  238.     CALL NextChar
  239.     T# = T#^FNSignedFactor#
  240.   WEND
  241.   FNTerm# = T#
  242. END DEF
  243.  
  244. DEF FN SimpleExpression#
  245.  
  246.   LOCAL SimpExp#, Opr$
  247.  
  248.   SimpExp# = FNTerm#
  249.   WHILE FN InCharSet%(NextChar$,"*/")
  250.     Opr$ = NextChar$
  251.     CALL NextChar
  252.     SELECT CASE Opr$
  253.       CASE "*"
  254.         SimpExp# = SimpExp# * FNTerm#
  255.       CASE "/"
  256.         SimpExp# = SimpExp# / FN Term#
  257.     END SELECT
  258.   WEND
  259.   FN SimpleExpression# = SimpExp#
  260. END DEF
  261.  
  262. DEF FN Expression#
  263.  
  264.   LOCAL E#, Opr$
  265.  
  266.   E# = FNSimpleExpression#
  267.   WHILE FN InCharSet%(NextChar$, "+-")
  268.     Opr$ = NextChar$
  269.     CALL NextChar
  270.     SELECT CASE Opr$
  271.       CASE "+"
  272.         E# = E# + FNSimpleExpression#
  273.       CASE "-"
  274.         E# = E# - FN SimpleExpression#
  275.     END SELECT
  276.   WEND
  277.   FNExpression# = E#
  278. END DEF
  279.  
  280. SUB Evaluate(GlobIsFormula%, F$, Value#, Er%)
  281. ' this procedure evaluates a string passed to it, the string represents
  282. ' a value or an expression or formula.
  283.  
  284.   SHARED Eofline$,Position%,FormulaStr$,NextChar$,IsFormula%,ErrorPosition%
  285.  
  286.   FormulaStr$=F$
  287.   IF left$(FormulaStr$, 1) = "." THEN
  288.     FormulaStr$ = "0" + FormulaStr$
  289.   ELSEIF left$(FormulaStr$, 1) = "+" THEN
  290.     CALL Delete(FormulaStr$, 1, 1)
  291.   END IF
  292.   IsFormula% = %FALSE
  293.   ErrorPosition% = %FALSE
  294.   Position% = 0
  295.   CALL NextChar
  296.   Value# = FNExpression#
  297.   GlobIsFormula%=IsFormula%
  298.   IF NextChar$ = EofLine$ THEN
  299.     ErrorPosition% = 0
  300.   ELSE
  301.     Errorposition% = Position%
  302.   END IF
  303.   Er%=ErrorPosition%
  304. END SUB
  305.  
  306. SUB Recalculate
  307. ' this procedure steps through the entire spreadsheet recalculating each cell
  308.  
  309.   LOCAL  Rfx%, Rfy%, OldValue#, Er%, CellStatus%, Contents$, Value#
  310.   LOCAL  Dec%, Fw%, CellColor%, form%
  311.   SHARED Globfx%,Globfy%,Xpos%(), NoPutReal#
  312.  
  313.   CALL ClearStat
  314.   CALL BlinkVideo
  315.   CALL Msg(" Computing ...")
  316.   CALL LowVideo
  317.   FOR Rfy% = %FyMin  to %FyMax
  318.     FOR Rfx% = %FxMin  to %FxMax
  319.       CALL GetRec(RFx%, RFy%, CellStatus%, Contents$, Value#, Dec%, Fw%, _
  320.                   CellColor%)
  321.       IF FNIn%(%Formula,CellStatus%) or FNIn%(%Constant,CellStatus%) THEN
  322.         OldValue# = Value#
  323.         CALL AddSet( %Calculated  , CellStatus% )
  324.         CALL PutRec(RFx%, RFy%, CellStatus%, CHR$(0), NoPutReal#, -1, -1, -1)
  325.         CALL Evaluate(Form%, Contents$, Value#, Er%)
  326.         IF OldValue# <> Value# THEN
  327.           LOCATE Rfy% + 1, Xpos%(Rfx%), 0
  328.           color CellColor% \ 256, CellColor% mod 256
  329.           PRINT using FNMASK$(FW%,DEC%);Value#;
  330.         END IF
  331.         CALL PutRec(RFx%, RFy%, CellStatus%, CHR$(0), Value#, -1, -1, -1)
  332.       END IF
  333.     NEXT Rfx%
  334.   NEXT Rfy%
  335.   CALL NormVideo
  336.   CALL Clearstat
  337.   CALL GotoCell( GlobFx%, GlobFy% )
  338. END SUB
  339.  
  340.