PROGRAM Calculator(Input,Output);
{Purpose : This is a reverse polish notation calculator.
           Written in Turbo Pascal version v6.0.}
USES CRT;

TYPE
    Point =^Entry;
    Entry = RECORD
            Next : Point;
            Number : REAL;
    END;

VAR
   Stack : Point;
   Choice : CHAR;

PROCEDURE Initialize;
BEGIN
     CLRSCR;
     Stack:=NIL;
END;{Initialize}

PROCEDURE Display;
VAR
   Temp : Point;
   Count : INTEGER;
BEGIN
     CLRSCR;
     GOTOXY(5,2);
     WRITELN(Output,'Stack:');
     Temp:=Stack;
     Count:=3;
     WHILE ((Temp<>NIL) AND (Count<>24)) DO BEGIN
           GOTOXY(5,Count);
           WRITELN(Output,Temp^.Number);
           Count:=Count+1;
           Temp:=Temp^.Next;
     END;{Temp<>NIL AND Count<>0};
     GOTOXY(1,1);
     WRITE(Output,'Press <ENTER> to continue');
     READLN(Input);
END;{Display}

PROCEDURE Add(Number : REAL);
VAR
   Temp : Point;
BEGIN
     NEW(Temp);
     Temp^.Number:=Number;
     Temp^.Next:=Stack;
     Stack:=Temp;
     Temp:=NIL;
END;

PROCEDURE Loop;
VAR
   Numb : REAL;
BEGIN
     CLRSCR;
     WRITELN(Output,'Type in number:');
     REPEAT
           {$I-}
           GOTOXY(1,2);
           READLN(Input,Numb);
           {$I+}
     UNTIL IOResult=0;
     Add(Numb);
     Display;
END;

PROCEDURE ADDITION;
VAR
   Head : Point;
   Number : REAL;
BEGIN
    IF ((Stack<>NIL) AND (Stack^.Next<>NIL)) THEN
          BEGIN
          Head:=Stack;
          Stack:=Stack^.Next^.Next;
          Number:=Head^.Number+Head^.Next^.Number;
          DISPOSE(Head^.Next);
          DISPOSE(Head);
          Add(Number);
    END;{WHILE}
END;{ADDITION}

PROCEDURE SUBTRACT;
VAR
   Head : Point;
   Number : REAL;
BEGIN
     IF ((Stack<>NIL) AND (Stack^.Next<>NIL)) THEN
           BEGIN
           Head:=Stack;
           Stack:=Stack^.Next^.Next;
           Number:=Head^.Next^.Number-Head^.Number;
           DISPOSE(Head^.Next);
           DISPOSE(Head);
           Add(Number);
     END;{WHILE}
END;{SUBTRACT}

PROCEDURE Multiply;
VAR
   Head : Point;
   Number : REAL;
BEGIN
     IF ((Stack<>NIL) AND (Stack^.Next<>NIL)) THEN
           BEGIN
           Head:=Stack;
           Stack:=Stack^.Next^.Next;
           Number:=Head^.Next^.Number*Head^.Number;
           DISPOSE(Head^.Next);
           DISPOSE(Head);
           Add(Number);
     END;{WHILE}
END;{Multiply}

PROCEDURE Divide;
VAR
   Head : Point;
   Number : REAL;
BEGIN
     IF ((Stack<>NIL) AND (Stack^.Next<>NIL)) THEN
        BEGIN
        Head:=Stack;
        Stack:=Stack^.Next^.Next;
        Number:=Head^.Next^.Number/Head^.Number;
        DISPOSE(Head^.Next);
        DISPOSE(Head);
        Add(Number);
     END;{WHILE}
END;{Divide}

PROCEDURE Raise;
VAR
   Head : Point;
   Repeats : INTEGER;
   Number : REAL;
BEGIN
     IF ((Stack<>NIL) AND (Stack^.Next<>NIL)) THEN BEGIN
        Head:=Stack;
        Repeats:=TRUNC(Head^.Number);
        Stack:=Stack^.Next;
        DISPOSE(Head);
        Head:=Stack;
        Number:=Head^.Number;
        FOR Repeats:=2 TO Repeats DO BEGIN
            ADD(Number);
            MULTIPLY;
        END;{Repeats:=2 TO Repeats}
     END;{IF}
END;{Raise}

PROCEDURE Operation;
VAR
   Choice : CHAR;
BEGIN
     REPEAT
           CLRSCR;
           WRITELN(Output,'Type in the function that you wish to perform');
           WRITELN(Output,'+ - / * ^');
           READLN(Input,Choice);
     UNTIL CHOICE IN ['+','-','/','*','^'];
     CASE Choice OF
          '+' : ADDITION;
          '-' : SUBTRACT;
          '*' : MULTIPLY;
          '/' : DIVIDE;
          '^' : Raise;
     END;{Case}
     Display;
END;{Operation}

BEGIN
     Initialize;
     REPEAT
           CLRSCR;
           Choice:=CHR(0);
           WRITELN(Output,'Type E and <ENTER> to quit.');
           WRITELN(Output,'Type N and <ENTER> to enter a number');
           WRITELN(Output,'Type O and <ENTER> to enter an operation');
           WRITELN(Output,'Type S and <ENTER> to show stack');
           READLN(Input,Choice);
           IF Choice IN ['N','n'] THEN Loop;
           IF Choice IN ['O','o'] THEN Operation;
           IF Choice IN ['S','s'] THEN Display;
     UNTIL Choice IN ['E','e'];
END.