10  COM X,V[36]
11  REM
12  REM ***  HP TIME-SHARED BASIC PROGRAM LIBRARY  ***********************
13  REM
14  REM         CALCOM:  KEYBOARD ENTRY CALCULATOR PROGRAM
15  REM
16  REM         36131 (A301) REV A -- 7/71  (PART 1 OF 2)
17  REM 
18  REM ***  CONTRIBUTED PROGRAM  ****************************************
19  REM
20  REM         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<P THEN 830
790  IF B$[Q,Q]=" " THEN 770
800  FOR Q1=14+B TO LEN(S$)-1
810  IF B$[Q,Q]=S$[Q1,Q1] THEN 870
820  NEXT Q1
830  P=Q
840  GOSUB 980
850  PRINT "ILLEGAL VARIABLE ON LEFT OF EQUAL SIGN"
860  GOTO 910
870  E1=Q1
880  P=Q2+1
890  GOSUB 1400
900  RETURN 
910  A$=B$
920  IF B$[P,P] <> '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  IF G6 <> 0 THEN 4210
4200  G6=.85
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 A$[1,G8 MIN 72]
4440  NEXT X7
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<X5 THEN 4700
4590  Q3=X/X5
4600  IF Q3 <> 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 
