10 COM X,V[36] 11 REM 12 REM *** HP TIME-SHARED BASIC PROGRAM LIBRARY ******************** 13 REM 14 REM CALPLT: KEYBOARD ENTRY CALCULATOR PROGRAM WITH 7200A 15 REM GRAPHIC PLOTTER OUTPUT 16 REM 36131 (A301) REV A -- 7/71 (PART 2 OF 2) 17 REM 18 REM *** CONTRIBUTED PROGRAM ************************************ 20 REM *** CALCOM ***; 6/1/71 VERSION BY STEVE POULSEN OF OMSI 40 DIM P[70],A$[72],B$[72],S$[52],C$[37],F$[45] 50 S$="+-*/^%<>!()"'92"?0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ." 60 C$="BASDEGFACGRAHELLISQUARADSAMSCRSTOZER" 70 F$="ABSARCCOSCOTCSCEXPHYPINTLOGRNDSECSGNSINTAN" 80 MAT P=ZER 90 N3=0 100 MAT V=ZER 120 B=10 130 M1=O1=Q=Q1=E1=Q2=I1=D1=F=S1=A1=H1=P2=S3=X=0 140 P7=B1=B0=0 150 P=T1=L1=N1=O2=L=1 160 PRINT "INTERPRETIVE CALCULATOR" 170 PRINT '10'10'10 180 PRINT "["'13"] "; 190 T2=100 200 ENTER T2,T2,B$ 210 IF T2 <> -256 THEN 240 220 PRINT '7'7'7'7; 230 GOTO 190 240 P=1 250 M1=LEN(B$) 260 PRINT 270 IF P>M1 THEN 180 280 IF B$[P,P] <> " " THEN 310 290 P=P+1 300 GOTO 270 310 IF P+2>M1 THEN 420 320 O1=0 330 FOR Q=1 TO 36 STEP 3 340 IF B$[P,P+2] <> C$[Q,Q+2] THEN 400 350 O1=INT(Q/3)+1 360 P=P+1 370 IF P>M1 THEN 400 380 IF B$[P,P]='92 THEN 400 390 IF B$[P,P] <> " " THEN 360 400 NEXT Q 410 IF O1 <> 0 THEN 450 420 GOSUB 700 430 GOSUB 1010 440 GOTO 910 450 GOTO O1 OF 460,510,4470,4080,680,530,680,600,620,650,670,4720 460 GOSUB 1400 470 IF X>1 AND X<37 THEN 490 480 X=10 490 B=INT(X) 500 GOTO 910 510 T1=3.14159/180 520 GOTO 910 530 FOR Q7=B+14 TO LEN(S$)-1 540 IF V[Q7-14]=0 THEN 580 550 PRINT S$[Q7,Q7], 560 X=V[Q7-14] 570 GOSUB 1010 580 NEXT Q7 590 GOTO 910 600 T1=1 610 GOTO 910 620 B$=A$ 630 S3=1 640 GOTO 240 650 MAT V=ZER 660 GOTO 910 670 STOP 680 PRINT "NOT YET IMPLEMENTED" 690 GOTO 910 700 Q=P-1 710 Q=Q+1 720 E1=0 730 IF Q>M1 THEN 890 740 IF B$[Q,Q]='92 THEN 890 750 IF B$[Q,Q] <> "=" THEN 710 760 Q2=Q 770 Q=Q-1 780 IF Q

'92 THEN 950 930 P=P+1 940 GOTO 270 950 P=P+1 960 IF P>M1 THEN 180 970 GOTO 920 980 PRINT B$ 990 PRINT TAB(P-1);"^" 1000 RETURN 1010 E1=E1-14 1020 IF E1 <= .0001 THEN 1060 1030 V[E1]=X 1040 E1=0 1050 RETURN 1060 IF B <> 10 THEN 1090 1070 PRINT X 1080 RETURN 1090 IF X >= 0 THEN 1120 1100 PRINT "-"; 1110 X=ABS(X) 1120 I1=INT(X) 1130 D1=X-I1 1140 IF X <> 0 THEN 1170 1150 PRINT "0" 1160 RETURN 1170 IF ABS(INT(LOG(X)/LOG(B)))<70 THEN 1200 1180 PRINT X;"(BASE 10)" 1190 RETURN 1200 A$=" " 1210 B1=60 1220 X=I1 1230 B1=B1-1 1240 Q=X-INT(X/B)*B 1250 A$[B1,B1]=S$[Q+14,Q+14] 1260 X=INT(X/B) 1270 IF X>0 AND B1>2 THEN 1230 1280 X=D1 1290 A$=A$[B1,B1+LEN(A$)] 1300 B1=LEN(A$) 1310 IF D1=0 THEN 1380 1320 A$[B1,B1]="." 1330 Q=INT(X*B) 1340 B1=B1+1 1350 A$[B1,B1]=S$[Q+14,Q+14] 1360 X=X*B-Q 1370 IF B1<72 AND X <> 0 THEN 1330 1380 PRINT A$ 1390 RETURN 1400 P=P-1 1410 N1=L1=1 1415 B1=0 1420 X=S1=P7=L=0 1430 P=P+1 1440 IF P <= M1 THEN 1520 1450 O2=0 1460 GOSUB 2690 1470 GOSUB 3150 1480 IF L1 <= 1 THEN 1510 1490 GOSUB 980 1500 PRINT "MISSING RIGHT PARENTHESIS" 1510 RETURN 1520 IF B$[P,P]=" " THEN 1430 1530 FOR Q=1 TO LEN(S$) 1540 IF B$[P,P]=S$[Q,Q] THEN 1590 1550 NEXT Q 1560 GOSUB 980 1570 PRINT "ILLEGAL CHARACTER" 1580 GOTO 1430 1590 C=Q 1600 IF C=12 THEN 1450 1610 IF C <> 11 THEN 1810 1620 O2=0 1630 GOSUB 2690 1650 N1=2 1660 IF L1>1 THEN 1700 1670 GOSUB 980 1680 PRINT "EXTRA RIGHT PARENTHESIS" 1690 GOTO 1430 1700 GOSUB 1770 1710 H1=INT(A/10) 1720 A1=A-H1*10 1730 GOSUB 1770 1740 L=INT(A) 1750 F=(A-L)*100 1755 GOSUB 3150 1758 GOSUB 2690 1760 GOTO 1430 1770 IF L1 <= 1 THEN 1670 1780 A=P[L1] 1790 L1=L1-1 1800 RETURN 1805 IF L=0 THEN 1890 1810 IF C <> 10 THEN 2040 1820 A=X 1830 X=0 1840 L=L+1 1850 GOSUB 1970 1860 A=O2 1870 O2=0 1880 GOSUB 1970 1890 A=L+F/100 1900 F=L=0 1910 GOSUB 1970 1920 A=H1*10+A1 1930 GOSUB 1970 1940 H1=A1=0 1950 N1=1 1960 GOTO 1420 1970 L1=L1+1 1980 IF L1<70 THEN 2020 1990 GOSUB 980 2000 PRINT "EXPRESSION TOO COMPLEX" 2010 GOTO 1620 2020 P[L1]=A 2030 RETURN 2040 GOSUB N1 OF 2060,2550 2050 GOTO 1430 2060 IF C=50 THEN 2150 2070 IF C<14 OR C>13+B THEN 2250 2080 IF P7>0 THEN 2120 2090 X=X*B+C-14 2100 S1=N1=1 2110 RETURN 2120 X=X+B^(-P7)*(C-14) 2130 P7=P7+1 2140 GOTO 2100 2150 IF P7>0 THEN 2200 2160 P7=1 2170 S1=1 2180 N1=1 2190 RETURN 2200 GOSUB 980 2210 PRINT "ILLEGAL DECIMAL POINT" 2220 GOTO 2160 2230 N1=1 2240 RETURN 2250 IF S1 <> 1 THEN 2300 2260 P=P-1 2270 S1=P7=0 2280 N1=2 2290 RETURN 2300 IF C<13+B OR C>50 THEN 2490 2310 IF P+2>M1 THEN 2350 2320 FOR F=1 TO 14*3-1 STEP 3 2330 IF B$[P,P+2]=F$[F,F+2] THEN 2380 2340 NEXT F 2350 F=0 2360 X=V[C-14] 2370 GOTO 2270 2380 P=P+2 2390 F=INT(F/3)+1 2400 IF F <> 2 THEN 2440 2410 F=0 2420 A1=1 2430 GOTO 2230 2440 IF F <> 7 THEN 2230 2450 F=0 2460 H1=1 2470 GOTO 2230 2480 F=0 2490 IF C <> 13 THEN 2530 2500 PRINT "INPUT DATA"; 2510 INPUT X 2520 GOTO 2270 2530 X=0 2540 GOTO 2260 2550 P7=S1=0 2560 IF C <> 9 THEN 2640 2570 Q=1 2580 FOR Q1=1 TO X 2590 Q=Q*Q1 2600 NEXT Q1 2610 X=Q 2620 N2=2 2630 RETURN 2640 IF C>8 THEN 2670 2650 O2=C 2660 GOTO 2690 2670 O2=3 2680 P=P-1 2690 IF L>0 THEN 2800 2700 IF O2=0 THEN 2790 2710 A=X 2720 X=0 2730 L=L+1 2740 GOSUB 1970 2750 A=O2 2760 O2=0 2770 GOSUB 1970 2780 N1=1 2790 RETURN 2800 GOSUB 1770 2810 IF INT((A+1)/2) >= INT((O2+1)/2) THEN 2840 2820 GOSUB 1970 2830 GOTO 2710 2840 O7=A 2850 GOSUB 1770 2860 L=L-1 2870 N3=A 2880 GOSUB O7 OF 2900,2920,2940,2960,3030,3080,3110,3130 2890 GOTO 2690 2900 X=N3+X 2910 RETURN 2920 X=N3-X 2930 RETURN 2940 X=N3*X 2950 RETURN 2960 IF X#0 THEN 3010 2970 IF P2#0 THEN 2990 2980 PRINT "DIVISION BY ZERO" 2990 X=1.E+30 3000 RETURN 3010 X=N3/X 3020 RETURN 3030 IF N3>0 THEN 3040 3032 IF X=INT(X) THEN 3040 3034 IF P2>0 THEN 2990 3036 PRINT "NEGATIVE NUMBER TO REAL POWER - - WARNING ONLY" 3038 N3=ABS(N3) 3040 X=N3^X 3050 RETURN 3060 X=1 3070 RETURN 3080 IF N3=0 OR X=0 THEN 3060 3082 X0=1 3083 GOTO 2*(N3#INT(N3))+(P2>0)+1 OF 3084,3084,3086,2990 3084 X9=1+4*((N3/2)=INT(N3/2))+2*SGN(1+SGN(X))+(P2>0) 3085 GOTO X9 OF 3098,3098,3094,3094,3086,2990,3094,3090 3086 PRINT "ROOT OF NEGATIVE NUMBER - - WARNING ONLY" 3088 GOTO 3094 3090 B1=B1+1 3092 X0=1-2*((B0/(2^B1))=INT(B0/(2^B1))) 3094 X=ABS(X)^(1/N3)*X0 3096 RETURN 3098 X0=-1 3099 GOTO 3094 3100 RETURN 3110 X=X MIN N3 3120 RETURN 3130 X=X MAX N3 3140 RETURN 3150 IF F <= 0 THEN 3190 3152 IF A1=0 THEN 3160 3154 X=X/T1 3160 F=INT(F*10+.5)/10 3170 IF F>9 THEN 3210 3180 GOSUB F OF 3230,3240,3250,3370,3490,3610,3240,3630,3650 3182 IF A1=0 THEN 3190 3184 X=X/T1 3190 A1=F=H1=0 3200 RETURN 3210 GOSUB F-9 OF 3670,3690,3810,3830,3950 3220 GOTO 3182 3230 X=ABS(X) 3240 RETURN 3250 X=X*T1 3260 GOTO 4-2*(A1=0)-(H1=0) OF 3350,3330,3310,3290 3290 X=LOG(X+SQR(X^2-1)) 3300 RETURN 3310 X=ATN(SQR(1-X^2)/X) 3320 RETURN 3330 X=(EXP(X)+EXP(-X))/2 3340 RETURN 3350 X=COS(X) 3360 RETURN 3370 X=X*T1 3380 GOTO 4-2*(A1=0)-(H1=0) OF 3470,3450,3430,3410 3410 X=(LOG(X+1)-LOG(X-1))/X 3420 RETURN 3430 X=ATN(1/X) 3440 RETURN 3450 X=(EXP(X)+EXP(-X))/(EXP(X)-EXP(-X)) 3460 RETURN 3470 X=1/TAN(X) 3480 RETURN 3490 X=X*T1 3500 GOTO 4-2*(A1=0)-(H1=0) OF 3590,3550,3570,3530 3530 X=LOG((1/X)+SQR((1/X^2)+1)) 3540 RETURN 3550 X=2/(EXP(X)-EXP(-X)) 3560 RETURN 3570 X=ATN(1/SQR(X^2-1)) 3580 RETURN 3590 X=1/SIN(X) 3600 RETURN 3610 X=EXP(X) 3620 RETURN 3630 X=INT(X) 3640 RETURN 3650 X=LOG(X) 3660 RETURN 3670 X=RND(-X) 3680 RETURN 3690 X=X*T1 3700 GOTO 4-2*(A1=0)-(H1=0) OF 3790,3770,3750,3730 3730 X=LOG((1/X)+SQR((1/X^2)-1)) 3740 RETURN 3750 X=ATN(SQR(X^2-1)) 3760 RETURN 3770 X=2/(EXP(X)+EXP(-X)) 3780 RETURN 3790 X=1/COS(X) 3800 RETURN 3810 X=SGN(X) 3820 RETURN 3830 X=X*T1 3840 GOTO 4-2*(A1=0)-(H1=0) OF 3930,3910,3890,3870 3870 X=LOG(X+SQR(X^2+1)) 3880 RETURN 3890 X=ATN(X/SQR(1-X^2)) 3900 RETURN 3910 X=(EXP(X)-EXP(-X))/2 3920 RETURN 3930 X=SIN(X) 3940 RETURN 3950 X=X*T1 3960 GOTO 4-2*(A1=0)-(H1=0) OF 4050,4030,4010,3990 3990 X=(LOG(1+X)-LOG(1-X))/2 4000 RETURN 4010 X=ATN(X) 4020 RETURN 4030 X=(EXP(X)-EXP(-X))/(EXP(X)+EXP(-X)) 4040 RETURN 4050 X=TAN(X) 4060 RETURN 4070 REM GRAPHING ROUTINE 4080 Q3=P 4085 P2=1 4090 PRINT "LOWER LIMIT OF X"; 4100 INPUT G2 4110 PRINT "UPPER LIMIT OF X"; 4120 INPUT G3 4130 PRINT "X INCREMENT"; 4140 INPUT G4 4150 PRINT "X OFFSET"; 4160 INPUT G5 4170 PRINT "Y SCALING FACTOR"; 4180 INPUT G6 4182 GOSUB 700 4184 GOSUB 1010 4186 B3=2^B1 4190 B5=9999/(G3-G2) 4192 B6=G6*B5 4194 B7=-G2*B5 4196 B8=5000+G5*B6 4200 PRINT "PLTL"'13'10;100;INT(B8);'13'10;5000;INT(B8);'13'109900;INT(B8) 4205 PRINT "PLTT"'13'10"PLTL"'13'10;INT(B7);100;'13'10;INT(B7);5000;'13'10;INT(B7);9900 4207 PRINT "PLTT"'13'10"PLTL" 4210 FOR X7=INT(G2/G4)*G4 TO INT(G3/G4)*G4 STEP G4 4220 FOR G7=1 TO 72 4230 A$[G7,G7]=" " 4240 NEXT G7 4250 G8=0 4260 IF ABS(2*G5)>35 THEN 4290 4270 G8=35+2*G5 4280 A$[G8,G8]="." 4290 IF ABS(X7)>.00001 THEN 4360 4300 A$[10,10]="Y" 4310 FOR G7=11 TO 61 STEP 2 4320 A$[G7,G7+1]=". " 4330 NEXT G7 4340 A$[62,62]="Y" 4350 G8=63 4360 FOR B0=1 TO B3 4365 P=Q3 4370 V[33]=X7 4380 GOSUB 700 4390 GOSUB 1010 4400 Y5=INT(35+2*V[34]*G6+G5) 4410 IF Y5>72 OR Y5<1 THEN 4425 4415 G8=G8 MAX Y5 4420 A$[Y5,Y5]="*" 4425 NEXT B0 4430 PRINT INT(B5*X7+B7);INT(B8+V[34]*B6) 4440 NEXT X7 4441 PRINT "PLTT" 4445 P2=0 4450 GOTO 910 4460 REM PRIME FACTORING ROUTINE 4470 GOSUB 1400 4480 X=INT(ABS(X)) 4490 IF X=0 THEN 4700 4500 R5=SQR(X) 4510 C3=0 4520 X5=2 4530 GOTO 4590 4540 C3=0 4550 IF X5>2 THEN 4570 4560 X5=1 4570 X5=X5+2 4580 IF R5 INT(Q3) THEN 4640 4610 X=Q3 4620 C3=C3+1 4630 IF X>1 THEN 4590 4640 IF C3=0 THEN 4550 4650 IF C3=1 THEN 4680 4660 PRINT X5;"^";C3;"*"; 4670 GOTO 4690 4680 PRINT X5;"*"; 4690 IF X>1 THEN 4540 4700 PRINT X 4710 GOTO 910 4720 PRINT "LOWER LIMIT OF SEARCH"; 4730 INPUT Z8 4740 PRINT "UPPER LIMIT OF SEARCH"; 4750 INPUT Z9 4760 Q5=P 4770 V[33]=Z8 4780 I7=1 4790 Q3=0 4800 P=Q5 4810 GOSUB 700 4820 GOSUB 1010 4830 IF V[34] <> 0 THEN 4870 4840 PRINT V[33]; 4850 V[33]=INT(1+V[33]) 4860 GOTO 4780 4870 V[33]=V[33]+I7 4880 Y5=V[34] 4890 P=Q5 4900 GOSUB 700 4910 GOSUB 1010 4920 IF V[34]=0 THEN 4840 4930 IF SGN(V[34]) <> SGN(Y5) THEN 5000 4940 IF Q3=0 THEN 4980 4950 I7=I7/2 4960 Q3=Q3+1 4970 IF Q3>25 THEN 4840 4980 IF V[33]>Z9 THEN 5050 4990 GOTO 4870 5000 I7=I7/2 5010 V[33]=V[33]-I7 5020 Q3=Q3+1 5030 IF Q3>25 THEN 4840 5040 GOTO 4890 5050 PRINT 5060 GOTO 910 5070 END