|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 8832 (0x2280)
Types: TextFile
Names: »MC-MOD04.INC«
└─⟦d482c3728⟧ Bits:30005987 Turbo Pascal v2.00A (Jet80)
└─ ⟦this⟧ »MC-MOD04.INC«
æ.PAå
æ*******************************************************************å
æ* SOURCE CODE MODULE: MC-MOD04 *å
æ* PURPOSE: Evaluate formulas. *å
æ* Recalculate spread sheet. *å
æ* *å
æ* NOTE: This module contains recursive procedures *å
æ* and is for computer scientists only. *å
æ*******************************************************************å
var
Form: Boolean;
æ$A-å
procedure Evaluate(var IsFormula: Boolean; æ True if formulaå
var Formula: AnyString; æ Fomula to evaluateå
var Value: Real; æ Result of formula å
var ErrPos: Integer);æ Position of error å
const
Numbers: set of Char = Æ'0'..'9'Å;
EofLine = ^M;
var
Pos: Integer; æ Current position in formula å
Ch: Char; æ Current character being scanned å
EXY: stringÆ3Å; æ Intermidiate string for conversion å
æ Procedure NextCh returns the next character in the formula å
æ The variable Pos contains the position ann Ch the character å
procedure NextCh;
begin
repeat
Pos:=Pos+1;
if Pos<=Length(Formula) then
Ch:=FormulaÆPosÅ else Ch:=eofline;
until Ch<>' ';
end æ NextCh å;
function Expression: Real;
var
E: Real;
Opr: Char;
function SimpleExpression: Real;
var
S: Real;
Opr: Char;
function Term: Real;
var
T: Real;
function SignedFactor: Real;
function Factor: Real;
type
StandardFunction = (fabs,fsqrt,fsqr,fsin,fcos,
farctan,fln,flog,fexp,ffact);
StandardFunctionList = arrayÆStandardFunctionÅ of stringÆ6Å;
const
StandardFunctionNames: StandardFunctionList =('ABS','SQRT','SQR','SIN','COS',
'ARCTAN','LN','LOG','EXP','FACT');
var
E,EE,L: Integer; æ intermidiate variables å
Found:Boolean;
F: Real;
Sf:StandardFunction;
OldEFY, æ Current cell å
EFY,
SumFY,
Start:Integer;
OldEFX,
EFX,
SumFX:ScreenIndex;
CellSum: Real;
function Fact(I: Integer): Real;
begin
if I > 0 then begin Fact:=I*Fact(I-1); end
else Fact:=1;
end æ Fact å;
æ.PAå
begin æ Function Factor å
if Ch in Numbers then
begin
Start:=Pos;
repeat NextCh until not (Ch in Numbers);
if Ch='.' then repeat NextCh until not (Ch in Numbers);
if Ch='E' then
begin
NextCh;
repeat NextCh until not (Ch in Numbers);
end;
Val(Copy(Formula,Start,Pos-Start),F,ErrPos);
end else
if Ch='(' then
begin
NextCh;
F:=Expression;
if Ch=')' then NextCh else ErrPos:=Pos;
end else
if Ch in Æ'A'..'G'Å then æ Maybe a cell reference å
begin
EFX:=Ch;
NextCh;
if Ch in Numbers then
begin
F:=0;
EXY:=Ch; NextCh;
if Ch in Numbers then
begin
EXY:=EXY+Ch;
NextCh;
end;
Val(EXY,EFY,ErrPos);
IsFormula:=true;
if (Constant in ScreenÆEFX,EFYÅ.CellStatus) and
not (Calculated in ScreenÆEFX,EFYÅ.CellStatus) then
begin
Evaluate(Form,screenÆEFX,EFYÅ.contents,f,ErrPos);
ScreenÆEFX,EFYÅ.CellStatus:=ScreenÆEFX,EFYÅ.CellStatus+ÆCalculatedÅ
end else if not (Txt in ScreenÆEFX,EFYÅ.CellStatus) then
F:=ScreenÆEFX,EFYÅ.Value;
if Ch='>' then
begin
OldEFX:=EFX; OldEFY:=EFY;
NextCh;
EFX:=Ch;
NextCh;
if Ch in Numbers then
begin
EXY:=Ch;
NextCh;
if Ch in Numbers then
begin
EXY:=EXY+Ch;
NextCh;
end;
val(EXY,EFY,ErrPos);
Cellsum:=0;
for SumFY:=OldEFY to EFY do
begin
for SumFX:=OldEFX to EFX do
begin
F:=0;
if (Constant in ScreenÆSumFX,SumFYÅ.CellStatus) and
not (Calculated in ScreenÆSumFX,SumFYÅ.CellStatus) then
begin
Evaluate(Form,ScreenÆSumFX,SumFYÅ.contents,f,errPos);
ScreenÆSumFX,SumFYÅ.CellStatus:=
ScreenÆSumFX,SumFYÅ.CellStatus+ÆCalculatedÅ;
end else if not (Txt in ScreenÆSumFX,SumFYÅ.CellStatus) then
F:=ScrEEnÆSumFX,SumFYÅ.Value;
Cellsum:=Cellsum+f;
f:=Cellsum;
end;
end;
end;
end;
end;
end else
begin
found:=false;
for sf:=fabs to ffact do
if not found then
begin
l:=Length(StandardFunctionNamesÆsfÅ);
if copy(Formula,Pos,l)=StandardFunctionNamesÆsfÅ then
begin
Pos:=Pos+l-1; NextCh;
F:=Factor;
case sf of
fabs: f:=abs(f);
fsqrt: f:=sqrt(f);
fsqr: f:=sqr(f);
fsin: f:=sin(f);
fcos: f:=cos(f);
farctan: f:=arctan(f);
fln : f:=ln(f);
flog: f:=ln(f)/ln(10);
fexp: f:=exp(f);
ffact: f:=fact(trunc(f));
end;
Found:=true;
end;
end;
if not Found then ErrPos:=Pos;
end;
Factor:=F;
end æ function Factorå;
æ.PAå
begin æ SignedFactor å
if Ch='-' then
begin
NextCh; SignedFactor:=-Factor;
end else SignedFactor:=Factor;
end æ SignedFactor å;
begin æ Term å
T:=SignedFactor;
while Ch='^' do
begin
NextCh; t:=exp(ln(t)*SignedFactor);
end;
Term:=t;
end æ Term å;
begin æ SimpleExpression å
s:=term;
while Ch in Æ'*','/'Å do
begin
Opr:=Ch; NextCh;
case Opr of
'*': s:=s*term;
'/': s:=s/term;
end;
end;
SimpleExpression:=s;
end æ SimpleExpression å;
begin æ Expression å
E:=SimpleExpression;
while Ch in Æ'+','-'Å do
begin
Opr:=Ch; NextCh;
case Opr of
'+': e:=e+SimpleExpression;
'-': e:=e-SimpleExpression;
end;
end;
Expression:=E;
end æ Expression å;
begin æ procedure Evaluate å
if FormulaÆ1Å='.' then Formula:='0'+Formula;
if FormulaÆ1Å='+' then delete(Formula,1,1);
IsFormula:=false;
Pos:=0; NextCh;
Value:=Expression;
if Ch=EofLine then ErrPos:=0 else ErrPos:=Pos;
end æ Evaluate å;
æ.PAå
procedure Recalculate;
var
RFX: ScreenIndex;
RFY:integer;
OldValue: real;
Err: integer;
begin
LowVideo;
GotoXY(1,24); ClrEol;
Write('Calculating..');
for RFY:=1 to FYMax do
begin
for RFX:='A' to FXMax do
begin
with ScreenÆRFX,RFYÅ do
begin
if (Formula in CellStatus) then
begin
CellStatus:=CellStatus+ÆCalculatedÅ;
OldValue:=Value;
Evaluate(Form,Contents,Value,Err);
if OldValue<>Value then
begin
GotoXY(XPosÆRFXÅ,RFY+1);
if (DEC>=0) then Write(Value:FW:DEC)
else Write(Value:FW);
end;
end;
end;
end;
end;
GotoCell(FX,FY);
end;
«eof»