A Reverse Polish Notation calculator for COCO 3

Color BASIC, Extended Color BASIC, CoCo 3 BASIC, and Disk Extended Color BASIC call all be discussed here.

A Reverse Polish Notation calculator for COCO 3

Postby BillO » Sun Mar 11, 2018 4:32 pm

This is a program that I originally wrote for my Apple II some time ago and just recently ported to my COCO 3.

It is actually a very powerful calculator (precision issues aside) for dealing with very complex calculations. Being an RPN calculator it utilizes a stack. Operands (values/arguments) are placed on the stack and operations are then executed in appropriate order. The result of each operation is placed on the top of the stack and becomes the next available operand. Generally speaking there are two type of operations. Those that only a require a single operand (Square Root, Log, etc.), and those that require 2 (+, -, /, etc.). More than 2 are possible, but no such functions have been implemented in this calculator. As operations are performed operands are removed from the stack and as mentioned before, the result of each operation becomes the next operand on top of the stack. it is important to note that the operands are pulled from the stack right to left. For instance if your stack looks like this:

5
25

Then entering the operation'/' will be equivalent to 25/5 and the result, 5, will be placed on the stack One more example - if your stack looks like this:

3
4

Then entering the operation 'P' (for exponentiation) will be equivalent to 4^3 and the result, 64, will be placed on the stack. So, to enter a formula like 2*(3+(6/4)) you would enter 2, then 3, then 6, then 4, then / then + then * and the result, 9, will remain on the stack. Of course there is more than one way to skin a cat and you could certainly enter that formula differently, but the essential thing is the have your operations performed in the correct order on the appropriate operands.

When run the program displays the implemented operations. In addition 'CE' will pop the top value off the stack, 'CL' will clear the entire stack, 'E' enter Euler's constant (2.71828183), 'PI' will enter Pi (3.14159266) and ZZ will quit the program.

Have fun...
Code: Select all
10 REM RPN CALCULATOR
20 REM
30 REM Eventually I want to extend this with additional
40 REM   transcendental functions, especially relating to trigonometry.
50 REM   However, as is, it is quite powerful with respect to
60 REM   dealing with complex calculations.  A property of stack
70 REM   oriented calculators.
80 REM
90 REM Ported from my original Applesoft version: 2017/11/14
99 WIDTH 80
100 REM
110 REM *** DEFINE CONSTANTS ***
120 REM
130 SV=10
140 SH=4
150 PV=7
160 PH=3
170 EV=10
180 EH=19
190 N=22-SV
300 REM
310 REM *** INIT. VARS AND ARRAYS ***
320 REM
330 I=0
340 DIM ST(256)
500 REM
510 REM *** PAINT INITIAL SCREEN ***
520 REM
540 WIDTH 80
550 PRINT "AVAILABLE OPERATIONS"
560 PRINT "+       %               LN (NATUAL LOG)   SIN"
570 PRINT "-       P (EXPONENT)    LOG               COS"
580 PRINT "*       EX (NAT EXP)    ! (FACTORIAL)     TAN"
590 PRINT "/       S (SQR ROOT)    N (NEGATE)"
1000 REM
1010 REM *** TOKEN INPUT LOOP ***
1020 REM
1030 OP$="N"
1040 LOCATE PH, PV:PRINT "                  ":LOCATE PH, PV:INPUT A$
1050 IF A$="CE" THEN GOSUB 4060:GOTO 1220
1060 IF A$="CL" THEN GOSUB 4090:GOTO 1220
1070 IF A$="+" THEN GOSUB 2030
1080 IF A$="-" THEN GOSUB 2050
1090 IF A$="*" THEN GOSUB 2070
1100 IF A$="/" THEN GOSUB 2090
1110 IF A$="P" THEN GOSUB 2120
1120 IF A$="%" THEN GOSUB 2132
1125 IF A$="EX" THEN GOSUB 2140
1130 IF A$="COS" THEN GOSUB 2160
1140 IF A$="SIN" THEN GOSUB 2210
1150 IF A$="S" THEN GOSUB 2180
1160 IF A$="TAN" THEN GOSUB 2230
1170 IF A$="!" THEN GOSUB 2260
1172 IF A$="LN" THEN GOSUB 2300
1173 IF A$="LOG" THEN GOSUB 2400
1175 IF A$="N" THEN ST(I)=-ST(I):OP$="Y"
1180 IF A$="E" THEN A=2.71828183:GOSUB 4030:OP$="Y"
1190 IF A$="PI" THEN A=3.14159266:GOSUB 4030:OP$="Y"
1200 IF A$="ZZ" THEN CLS:END
1210 IF OP$="N" THEN A=VAL(A$):GOSUB 4030
1220 GOSUB 6030
1230 GOTO 1030
2000 REM
2010 REM *** FUNCTION AND OPERATION IMPLEMENTATION ***
2020 REM
2030 IF I<2 THEN GOTO 5030
2040 R=ST(I-1) + ST(I):GOTO 4040
2050 IF I<2 THEN GOTO 5030
2060 R=ST(I-1)-ST(I):GOTO 4040
2070 IF I<2 THEN GOTO 5030
2080 R=ST(I-1)*ST(I):GOTO 4040
2090 IF I<2 THEN GOTO 5030
2100 IF ST(I)=0 THEN GOTO 5060
2110 R=ST(I-1)/ST(I):GOTO 4040
2120 IF I<2 THEN GOTO 5030
2130 R=ST(I-1)^ST(I):GOTO 4040
2132 IF I<2 THEN GOTO 5030
2134 R=ST(I-1)/(ST(I)/100):GOTO 4040
2140 IF I<1 THEN GOTO 5030
2150 R=2.7182813^ST(I):GOTO 4050
2160 IF I<1 THEN GOTO 5030
2170 R=COS(ST(I)):GOTO 4050
2180 IF I<1 THEN GOTO 5030
2190 IF ST(I)<0 THEN GOTO 5060
2200 R=SQR(ST(I)):GOTO 4050
2210 IF I<1 THEN GOTO 5030
2220 R=SIN(ST(I)):GOTO 4050
2230 IF I<1 THEN GOTO 5030
2250 R=TAN(ST(I)):GOTO 4050
2260 IF I<1 THEN GOTO 5030
2270 IF ST(I)-ABS(INT(ST(I)))<>0 THEN GOTO 5040
2280 IF I>33 THEN GOTO 5050
2290 R=1:FOR Q=1 TO ST(I):R=R*Q:NEXT Q:GOTO 4050
2300 IF I<1 THEN GOTO 5030
2310 IF ST(I)<0 THEN GOTO 5060
2320 R=LOG(ST(I)):GOTO 4050
2400 IF I<1 THEN GOTO 5030
2410 IF ST(I)<0 THEN GOTO 5060
2420 R=LOG(ST(I))/LOG(10):GOTO 4050
4000 REM
4010 REM *** STACK OPERATIONS ***
4020 REM
4030 I=I+1:ST(I)=A:RETURN
4040 I=I-1
4050 ST(I)=R:GOTO 4100
4060 ST(I)=0:IF I>0 THEN I=I-1:GOTO 4100
4090 FOR I=256 TO 1 STEP -1:ST(I)=0:NEXT I
4100 OP$="Y":RETURN
5000 REM
5010 REM *** ERROR HANDLING ***
5020 REM
5030 MS$="INSUFFICIENT VALUES FOR OPERATION":GOTO 5070
5040 MS$="OPERAND MUST BE A POSITIVE INTEGER":GOTO 5070
5050 MS$="OPERAND TOO LARGE":GOTO 5070
5060 MS$=STR$(ST(I))+" IS NOT A VALID OPERAND"
5070 LOCATE EH, EV:PRINT MS$:GOSUB 7030:LOCATE EH, EV:PRINT "                                   ";:OP$="Y":RETURN
6000 REM
6010 REM *** SCREEN MANAGEMENT ***
6020 REM
6030 FOR J=SV TO 22:LOCATE SH, J:PRINT "                ";:NEXT J
6040 K=SV-1:M=1:IF I>N THEN M=I-N
6050 IF I>0 THEN FOR J=I TO M STEP -1:K=K+1:LOCATE SH, K:PRINT ST(J):NEXT J
6070 RETURN
7000 REM
7010 REM *** TIMERS ***
7020 REM
7030 FOR T=0 TO 2000:NEXT T:RETURN
User avatar
BillO
 
Posts: 14
Joined: Wed Mar 07, 2018 9:19 am
Location: The deep woods of Central Ontario

Return to CoCo BASIC

Who is online

Users browsing this forum: No registered users and 1 guest