DataMuseum.dk

top - metrics - download

    Length: 4352 (0x1100)
    Types: TextFile
    Names: »CALC.PAS«

└─⟦1a1ae220f⟧ Bits:30004190 COMPAS Pascal v.2.2
    └─⟦this⟧ »CALC.PAS« 
└─⟦693a7a378⟧ Bits:30003305 COMPAS, RcTekst, RcKalk, RCComal80 til RC703
    └─⟦this⟧ »CALC.PAS« 
└─⟦6bdda2365⟧ Bits:30005253 COMPAS Pascal v2.21 til CR7
    └─⟦this⟧ »CALC.PAS« 
└─⟦7b7460039⟧ Bits:30005889 KnowledgeMan - ACP - dBase II
    └─⟦this⟧ »CALC.PAS« 
└─⟦7e35b155b⟧ Bits:30005838 CP/M 58K v. 2.2 med COMPAS Pascal 2.13DK (RC700)
    └─⟦this⟧ »CALC.PAS« 
└─⟦856c4d8a3⟧ Bits:30003073 SW1729 COMPAS Pascal v2.20 installationsdiskette til Piccolo
    └─⟦this⟧ »CALC.PAS« 
└─⟦d814f614c⟧ Bits:30008872 EDB Trænings- og Erhvervs Center / Almen Nyttig Data Service
    └─⟦this⟧ »CALC.PAS« 
└─⟦f5abb7d57⟧ Bits:30005754 SW1329/D8 COMPAS Pascal v2.20 (RC703)
    └─⟦this⟧ »CALC.PAS« 

TextFile

PROGRAM CALCULATOR; æ$R-å

æ This program acts like a calculator - You type an expression	å
æ and the program calculates its value. Each time the calcula-	å
æ tor is ready to accept an input line, it prints an asterisk.	å
æ You must then type the expression and end it by pressing the	å
æ RETURN key, and shortly after, the result is displayed. If	å
æ the calculator finds an error, it displays a pointer, which	å
æ points at the error. There are five different operators (^, *	å
æ /, +, and -), and seven standard functions (ABS, SQRT, SIN,	å
æ COS, ARCTAN, LN, and EXP). Parentheses within expressions are	å
æ allowed. A special variable, called X, always holds the value	å
æ of the last computation. To end the program, type QUIT when	å
æ the calculator prompts for an input line.			å

CONST
  STRLEN = 48;
TYPE
  STR = STRINGÆSTRLENÅ;
VAR
  E: INTEGER;
  R: REAL;
  S: STR;

PROCEDURE EVALUATE(VAR EXPR: STR; VAR VALUE: REAL; VAR ERRPOS: INTEGER);
CONST
  ERRCH = '?';
  EOFLINE = @13;
VAR
  POS: INTEGER;
  CH: CHAR;

PROCEDURE NEXTCHAR;
BEGIN
  REPEAT
    POS:=POS+1;
    IF POS<=LEN(EXPR) THEN
    CH:=EXPRÆPOSÅ ELSE
    CH:=EOFLINE;
  UNTIL CH<>' ';
END;

FUNCTION EXPRESSION: REAL;
VAR
  E: REAL;
  OPR: CHAR;

FUNCTION SIMEXPR: REAL;
VAR
  S: REAL;
  OPR: CHAR;

FUNCTION TERM: REAL;
VAR
  T: REAL;

FUNCTION SIGNEDFACTOR: REAL;

FUNCTION FACTOR: REAL;
TYPE
  STDF = (FABS,FSQRT,FSIN,FCOS,FARCTAN,FLN,FEXP);
  STDFLIST = ARRAYÆSTDFÅ OF STRINGÆ6Å;
CONST
  STDFUN: STDFLIST = ('ABS','SQRT','SIN','COS','ARCTAN','LN','EXP');
VAR
  E,EE,L: INTEGER;
  DECPOINT,NEGEXP,FOUND: BOOLEAN;
  F: REAL;
  SF: STDF;
BEGIN
  IF CH IN Æ'0'..'9'Å THEN
  BEGIN
    F:=0.0; E:=0; DECPOINT:=FALSE;
    REPEAT
      F:=F*10.0+(ORD(CH)-48);
      IF DECPOINT THEN E:=E-1;
      NEXTCHAR;
      IF (CH='.') AND NOT DECPOINT THEN
      BEGIN
	DECPOINT:=TRUE; NEXTCHAR;
      END;
    UNTIL NOT(CH IN Æ'0'..'9'Å);
    IF CH='E' THEN
    BEGIN
      EE:=0; NEXTCHAR;
      IF CH IN Æ'+','-'Å THEN
      BEGIN
	NEGEXP:=CH='-'; NEXTCHAR;
      END ELSE
      NEGEXP:=FALSE;
      WHILE CH IN Æ'0'..'9'Å DO
      BEGIN
        EE:=EE*10+ORD(CH)-48;
	NEXTCHAR;
      END;
      IF NEGEXP THEN E:=E-EE ELSE E:=E+EE;
    END;
    F:=F*PWRTEN(E);
  END ELSE
  IF CH='(' THEN
  BEGIN
    NEXTCHAR;
    F:=EXPRESSION;
    IF CH=')' THEN NEXTCHAR ELSE CH:=ERRCH;
  END ELSE
  IF CH='X' THEN
  BEGIN
    NEXTCHAR; F:=VALUE;
  END ELSE
  BEGIN
    FOUND:=FALSE;
    FOR SF:=FABS TO FEXP DO
    IF NOT FOUND THEN
    BEGIN
      L:=LEN(STDFUNÆSFÅ);
      IF COPY(EXPR,POS,L)=STDFUNÆSFÅ THEN
      BEGIN
	POS:=POS+L-1; NEXTCHAR;
	F:=FACTOR;
	CASE SF OF
	  FABS: F:=ABS(F);
	  FSQRT: F:=SQRT(F);
	  FSIN: F:=SIN(F);
	  FCOS: F:=COS(F);
	  FARCTAN: F:=ARCTAN(F);
	  FLN: F:=LN(F);
	  FEXP: F:=EXP(F);
	END;
	FOUND:=TRUE;
      END;
    END;
    IF NOT FOUND THEN CH:=ERRCH;
  END;
  FACTOR:=F;
END æFACTORå;

BEGIN æSIGNEDFACTORå
  IF CH='-' THEN
  BEGIN
    NEXTCHAR; SIGNEDFACTOR:=-FACTOR;
  END ELSE
  SIGNEDFACTOR:=FACTOR;
END æSIGNEDFACTORå;

BEGIN æTERMå
  T:=SIGNEDFACTOR;
  WHILE CH='^' DO
  BEGIN
    NEXTCHAR; T:=EXP(LN(T)*SIGNEDFACTOR);
  END;
  TERM:=T;
END æTERMå;

BEGIN æSIMEXPRå
  S:=TERM;
  WHILE CH IN Æ'*','/'Å DO
  BEGIN
    OPR:=CH; NEXTCHAR;
    CASE OPR OF
      '*': S:=S*TERM;
      '/': S:=S/TERM;
    END;
  END;
  SIMEXPR:=S;
END æSIMEXPRå;

BEGIN æEXPRESSIONå
  E:=SIMEXPR;
  WHILE CH IN Æ'+','-'Å DO
  BEGIN
    OPR:=CH; NEXTCHAR;
    CASE OPR OF
      '+': E:=E+SIMEXPR;
      '-': E:=E-SIMEXPR;
    END;
  END;
  EXPRESSION:=E;
END æEXPRESSIONå;

BEGIN æEVALUATEå
  POS:=0; NEXTCHAR;
  VALUE:=EXPRESSION;
  IF CH=EOFLINE THEN ERRPOS:=0 ELSE ERRPOS:=POS;
END æEVALUATEå;

BEGIN æCALCULATORå
  REPEAT
    WRITE('* '); BUFLEN:=STRLEN; READ(S);
    IF (S<>'') AND (S<>'QUIT') THEN
    BEGIN
      EVALUATE(S,R,E);
      IF E=0 THEN
      BEGIN
	WRITE(' =');
	IF R>=0.0 THEN WRITE(R:17) ELSE WRITE(R:18);
      END ELSE
      BEGIN
	WRITELN;
	WRITE('^ ERROR':E+8);
      END;
    END;
    WRITELN;
  UNTIL S='QUIT';
END æCALCULATORå.
«eof»