DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »CALC.PAS«

└─⟦a5a1ac263⟧ Bits:30003067 Diskette til vedligeholdelse af elevprogrammer på Piccolo
    └─⟦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
  CHAR = STRINGÆ1Å;
  STR = STRINGÆSTRLENÅ;
VAR
  E: INTEGER;
  R: REAL;
  S: STR;

FUNCTION EXP10(R: REAL): INTEGER;
VAR
  E: INTEGER;
BEGIN
  E:=HI((MEMÆADDR(R)Å-$80)*77+5);
  IF E>=128 THEN E:=E-256;
  IF R<PWRTEN(E) THEN E:=E-1;
  EXP10:=E;
END;

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>='0') AND (CH<='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 (CH<'0') OR (CH>'9');
    IF CH='E' THEN
    BEGIN
      EE:=0; NEXTCHAR;
      IF (CH='-') OR (CH='+') THEN
      BEGIN
	NEGEXP:=CH='-'; NEXTCHAR;
      END ELSE
      NEGEXP:=FALSE;
      WHILE (CH>='0') AND (CH<='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 æOF FACTORå;

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

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

BEGIN æSIMEXPRå
  S:=TERM;
  WHILE (CH='*') OR (CH='/') DO
  BEGIN
    OPR:=CH; NEXTCHAR;
    IF OPR='*' THEN S:=S*TERM ELSE S:=S/TERM;
  END;
  SIMEXPR:=S;
END æOF SIMEXPRå;

BEGIN æEXPRESSIONå
  E:=SIMEXPR;
  WHILE (CH='+') OR (CH='-') DO
  BEGIN
    OPR:=CH; NEXTCHAR;
    IF OPR='+' THEN E:=E+SIMEXPR ELSE E:=E-SIMEXPR;
  END;
  EXPRESSION:=E;
END æOF EXPRESSIONå;

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

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 (ABS(R)<1E11) AND (ABS(R)>=1E-3) THEN
	WRITE(' ',R:0:10-EXP10(R)) ELSE
	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 æOF CALCULATORå.
«eof»