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