5  REM  HP CONTRIBUTED LIBRARY, 2/75
10  REM U 0F H COLLEGE OF TECHNOLOGY COMPLEX FUNCTION CALCULATOR
20  REM GEORGE MCKAY,2/24/74
30  REM RESTART
40  PRINT "U OF H TECH COMPLEX CALCULATOR; INSTRUCTIONS";
50  INPUT A$
60  IF A$[1,1]="N" THEN 260
70  PRINT "FUNCTIONS IMPLEMENTED ARE SIN,COS,TAN,HSIN (HYPERBOLIC SINE)"
80  PRINT "HCOS, & HTAN (ARGUMENTS IN RADIANS);SQR(Z), '^' (POWER/ROOT)"
90  PRINT "LOG (BASE E), EXP (EPSILON TO THE POWER OF R+JX), AND THE"
100  PRINT "ARITHMETIC OPERATIONS ARE *, /, +, -. SAMPLE INPUTS:"
110  PRINT "'SIN 2+J-5' OR SIN(2+J-5)..'(2+J5)^(-3+J-7)'..SIGN MUST"
120  PRINT "BE NEXT TO THE NUMBER.. 2-J7 IS NOT PERMITTED..."
130  PRINT "TO CONVERT FROM RECTANGULAR-TO-POLAR FORM TYPE 'CONP'"
140  PRINT "FOLLOWED BY  ''R' +J 'X'' WHERE 'R' IS THE 'REAL' & 'X' IS"
150  PRINT "THE IMAGINARY ARGUMENT. FOR EXAMPLE: 'CONP 3+J4' OR '3,4'"
160  PRINT "WILL RESULT IN Z=5 AT AN ANGLE OF .927295 RADIANS (53.1301"
170  PRINT "DEGREES). TO CONVERT FROM POLAR-TO-RECTANGULAR FORM:"
180  PRINT "TYPE 'CONR <MAGNITUDE>, <ANGLE>' I.E. CONR 5, .927295"
190  PRINT "IF THE ANGLE IS IN RADIANS - OR COND 5, 53.1301 IF THE"
200  PRINT "ANGLE IS IN DEGREES.."
210  DEF FNS()=(EXP()-EXP(-))/2
220  DEF FNC()=(EXP()+EXP(-))/2
230  DIM A$[72],B$[72],P$[72],O$[72],Z$[15],O[72],S[72],R[20],X[20]
240  PRINT "INPUT YOUR EXPRESSION FOLLOWED BY A CARRIAGE RETURN:"
250  GOTO 270
260  PRINT "NEXT:"
270  ENTER 255,K,A$
280  PRINT 
290  GOSUB 1460
300  P=3.14159
310  B$=A$
320  K=K1=J=1
330  FOR I=1 TO LEN(A$)+1
340  Z0=I
350  N=I
360  GOSUB 1570
370  IF Z >= 0 THEN 2000
380  NEXT I
390  GOSUB 1460
400  K=0
410  FOR I=1 TO LEN(A$)+1
420  IF A$[I,I+2]="X,X" THEN 1980
430  IF A$[I,I]="/" THEN 2280
440  IF A$[I,I]="*" THEN 2280
450  IF A$[I,I]="-" THEN 2180
460  IF A$[I,I]="(" THEN 1420
470  IF A$[I,I]=")" THEN 1440
480  IF A$[I,I+3]="X+JX" THEN 1960
490  IF A$[I,I]="+" THEN 2240
500  IF A$[I,I]="^" THEN 2280
510  NEXT I
520  IF K=0 THEN 550
530  PRINT "UNEQUAL # OF '(' & ')'"
540  GOTO 260
550  GOSUB 1460
560  L=1
570  FOR I=1 TO LEN(A$)
580  IF A$[I,I+3]="COND" THEN 3560
590  IF A$[I,I+3]="HSIN" THEN 2320
600  IF A$[I,I+3]="HCOS" THEN 2400
610  IF A$[I,I+3]="HTAN" THEN 2420
620  IF A$[I,I+3]="CONP" THEN 2440
630  IF A$[I,I+3]="CONR" THEN 2460
640  IF A$[I,I+2]="SIN" THEN 2480
650  IF A$[I,I+2]="COS" THEN 2500
660  IF A$[I,I+2]="TAN" THEN 2540
670  IF A$[I,I+2]="SQR" THEN 2580
680  IF A$[I,I]="^" THEN 2680
690  IF A$[I,I]="*" THEN 2700
700  IF A$[I,I]="/" THEN 2700
710  IF A$[I,I]="+" THEN 2720
720  IF A$[I,I]="-" THEN 2720
730  IF A$[I,I]=")" THEN 2600
740  IF A$[I,I]="(" THEN 2620
750  IF A$[I,I]="Z" THEN 2640
760  IF A$[I,I+2]="LOG" THEN 2560
770  IF A$[I,I+2]="EXP" THEN 2520
780  IF A$[I,I]="X" THEN 2220
790  GOTO 2220
800  NEXT I
805  GOSUB 1460
809  B$="DEFGHPRLSCTB"
810  FOR N=1 TO LEN(A$)
812  IF A$[N,N]="(" THEN 3970
813  FOR I=1 TO LEN(B$)
814  IF A$[N,N]=B$[I,I] THEN 3970
815  NEXT I
816  NEXT N
820  REM LEGAL CHARACTER?
830  B$="()^*/+-DZEFGHPRLSCTB"
840  FOR N=1 TO LEN(A$)
850  FOR I=1 TO LEN(B$)
860  IF A$[N,N]=B$[I,I] THEN 900
870  NEXT I
880  I=N+1
890  GOTO 2220
900  NEXT N
950  GOSUB 3580
960  REM INTERPRETER
970  K=0
980  L=0
990  FOR I=1 TO LEN(A$)+1
1000  D$=P$[I,I]
1010  IF D$="Z" THEN 3140
1020  IF D$="D" THEN 3510
1030  IF D$="-" THEN 2740
1040  IF D$="+" THEN 2840
1050  IF D$="*" THEN 2890
1060  IF D$="/" THEN 2790
1070  IF D$="^" THEN 1250
1080  IF D$="E" THEN 3090
1090  IF D$="F" THEN 3160
1100  IF D$="H" THEN 3210
1110  IF D$="P" THEN 3410
1120  IF D$="R" THEN 3460
1130  IF D$="S" THEN 3260
1140  IF D$="C" THEN 3310
1150  IF D$="T" THEN 3360
1160  IF D$="B" THEN 3040
1170  IF D$="L" THEN 2950
1180  IF D$="G" THEN 3000
1190  NEXT I
1200  PRINT 
1210  PRINT "ANSWER = ";R[L];"+J ";X[L]
1220  GOTO 3410
1230  GOTO 260
1240  REM '^' ROUTINE
1250  X=SQR(R[L-1]^2+X[L-1]^2)
1260  IF R[L-1]=0 THEN 1340
1270  Y=ATN(X[L-1]/R[L-1])
1280  IF R[L-1]>0 THEN 1380
1290  IF X[L-1]>0 THEN 1320
1300  Y=Y-P
1310  GOTO 1380
1320  Y=Y+P
1330  GOTO 1380
1340  IF X[L-1] >= 0 THEN 1370
1350  Y=-P/2
1360  GOTO 1380
1370  Y=P/2
1380  E=X^R[L]/EXP(X[L]*Y)*COS(R[L]*Y+X[L]*LOG(X))
1390  X[L]=X^R[L]/EXP(X[L]*Y)*SIN(R[L]*Y+X[L]*LOG(X))
1400  R[L]=E
1410  GOTO 3900
1420  K=K+1
1430  GOTO 510
1440  K=K-1
1450  GOTO 510
1460  REM REMOVE BLANKS IN A$
1470  B$=A$
1480  Z1=1
1490  FOR Z=1 TO LEN(B$)+1
1500  IF B$[Z,Z]=" " THEN 1530
1510  A$[Z1,Z1]=B$[Z,Z]
1520  Z1=Z1+1
1530  NEXT Z
1540  A$=A$[1,Z1-1]
1550  B$=A$
1560  RETURN 
1570  REM ALFTOV,MODIFIED
1580  Z4=Z5=0
1590  Z=-1.E-38
1600  LET Z1=Z2=Z3=1
1610  LET Z$="0123456789+-.E "
1620  FOR Z9=Z0 TO LEN(A$)
1630  FOR Z8=1 TO 15
1640  IF A$[Z9,Z9]=Z$[Z8,Z8] THEN 1670
1650  NEXT Z8
1660  GOTO 1910
1670  IF Z8=15 THEN 1900
1680  IF Z8>10 THEN 1770
1690  GOTO Z2 OF 1700,1720,1740
1700  LET Z=10*Z+Z8-1
1710  GOTO 1900
1720  LET Z5=Z5+1
1730  GOTO 1700
1740  LET Z4=10*Z4+Z8-1
1750  GOTO 1900
1760  REM
1770  GOTO Z8-10 OF 1780,1780,1850,1880
1780  IF Z2<3 AND Z >= 0 THEN 1910
1790  IF Z2=3 THEN 1820
1800  LET Z1=23-2*Z8
1810  GOTO 1900
1820  IF Z4>0 THEN 1910
1830  LET Z3=23-2*Z8
1840  GOTO 1900
1850  IF Z2>1 THEN 1910
1860  LET Z2=2
1870  GOTO 1900
1880  IF Z2=3 THEN 1910
1890  LET Z2=3
1900  NEXT Z9
1910  LET Z0=Z9
1920  IF ABS(Z3*Z4-Z5)<50 THEN 1940
1930  LET Z5=Z3*(Z4-50)
1940  Z=Z*10^(Z3*Z4-Z5)
1950  RETURN 
1960  A$[I,I+3]="   Z"
1970  GOTO 510
1980  A$[I,I+2]="  Z"
1990  GOTO 510
2000  IF B$[N,N]="-" THEN 2030
2010  K2=1
2020  GOTO 2040
2030  K2=-1
2040  IF INT(K1/2)*2=K1 THEN 2080
2050  R[K]=Z*K2
2060  K=K+1
2070  GOTO 2100
2080  X[J]=Z*K2
2090  J=J+1
2100  REM SUB 'X' FOR OPERAND
2110  FOR M=I TO Z0-1
2120  A$[M,M]=" "
2130  NEXT M
2140  A$[I,I]="X"
2150  I=Z0
2160  K1=K1+1
2170  GOTO 380
2180  REM SYNTAX ERROR CHECK
2190  IF A$[I+1,I+1]="J" THEN 2220
2200  IF A$[I+1,I+1]#"(" THEN 2220
2210  GOTO 510
2220  PRINT "ILLEGAL CHARACTER OR OPERATION"
2230  GOTO 260
2240  IF A$[I+1,I+1]="(" THEN 800
2250  REM '+' CALL
2260  IF A$[I+1,I+1]#"J" THEN 2220
2270  GOTO 510
2280  REM '^' CALL
2290  IF A$[I+1,I+1]="(" THEN 2310
2300  GOTO 2220
2310  GOTO 510
2320  A$[I,I]="E"
2330  S[L]=5
2340  A$[I+1,I+3]=" "
2350  I=I+3
2360  L=L+1
2370  GOTO 800
2380  S[L]=6
2390  GOTO 2340
2400  A$[I,I]="F"
2410  GOTO 2330
2420  A$[I,I]="H"
2430  GOTO 2330
2440  A$[I,I]="P"
2450  GOTO 2380
2460  A$[I,I]="R"
2470  GOTO 2380
2480  A$[I,I]="S"
2490  GOTO 2660
2500  A$[I,I]="C"
2510  GOTO 2660
2520  A$[I,I]="G"
2530  GOTO 2660
2540  A$[I,I]="T"
2550  GOTO 2660
2560  A$[I,I]="L"
2570  GOTO 2660
2580  A$[I,I]="B"
2590  GOTO 2660
2600  S[L]=2
2610  GOTO 2360
2620  S[L]=1
2630  GOTO 2360
2640  S[L]=0
2650  GOTO 2360
2660  A$[I+1,I+2]=" "
2670  I=I+2
2680  S[L]=5
2690  GOTO 2360
2700  S[L]=4
2710  GOTO 2360
2720  S[L]=3
2730  GOTO 2360
2740  REM '-' ROUTINE
2750  E=R[L-1]-R[L]
2760  X[L]=X[L-1]-X[L]
2770  R[L]=E
2780  GOTO 3900
2790  REM '/' ROUTINE
2800  E=(R[L-1]*R[L]+X[L-1]*X[L])/(R[L]^2+X[L]^2)
2810  X[L]=(X[L-1]*R[L]-R[L-1]*X[L])/(R[L]^2+X[L]^2)
2820  R[L]=E
2830  GOTO 3900
2840  REM '+' ROUTINE
2850  E=R[L-1]+R[L]
2860  X[L]=X[L-1]+X[L]
2870  R[L]=E
2880  GOTO 3900
2890  REM '*' ROUTINE
2900  E=(R[L-1]*R[L])-(X[L-1]*X[L])
2910  X[L]=(R[L-1]*X[L])+(R[L]*X[L-1])
2920  R[L]=E
2930  GOTO 3900
2940  REM LOG ROUTINE
2950  E=.5*LOG(R[L]^2+X[L]^2)
2960  X[L]=ATN(X[L]/R[L])
2970  R[L]=E
2980  GOTO 1190
2990  REM EXP ROUTINE
3000  E=EXP(R[L])*COS(X[L])
3010  X[L]=EXP(R[L])*SIN(X[L])
3020  R[L]=E
3030  GOTO 1190
3040  REM SQR ROUTINE
3050  E=SQR((R[L]+SQR(R[L]^2+X[L]^2))/2)
3060  X[L]=SGN(X[L])*SQR((-R[L]+SQR(R[L]^2+X[L]^2))/2)
3070  R[L]=E
3080  GOTO 1190
3090  REM HSIN ROUTINE
3100  E=FNS(R[L])*COS(X[L])
3110  X[L]=FNC(R[L])*SIN(X[L])
3120  R[L]=E
3130  GOTO 1190
3140  L=L+1
3150  GOTO 1190
3160  REM HCOS ROUTINE
3170  E=FNC(R[L])*COS(X[L])
3180  X[L]=FNS(R[L])*SIN(X[L])
3190  R[L]=E
3200  GOTO 1190
3210  REM HTAN
3220  Y=FNC(2*R[L])+COS(2*X[L])
3230  R[L]=FNS(2*R[L])/Y
3240  X[L]=SIN(2*X[L])/Y
3250  GOTO 1190
3260  REM SIN
3270  E=SIN(R[L])*FNC(X[L])
3280  X[L]=COS(R[L])*FNS(X[L])
3290  R[L]=E
3300  GOTO 1190
3310  REM COS
3320  E=SIN(R[L])*FNC(X[L])
3330  X[L]=-SIN(R[L])*FNS(X[L])
3340  R[L]=E
3350  GOTO 1190
3360  REM TAN
3370  Y=COS(2*R[L])+FNC(2*X[L])
3380  R[L]=SIN(2*R[L])/Y
3390  X[L]=FNS(2*X[L])/Y
3400  GOTO 1190
3410  REM CONP
3420  PRINT "Z = ";SQR(R[L]^2+X[L]^2)
3430  E=ATN(X[L]/R[L])
3440  PRINT "ANGLE = ";E;"RADIANS (";E*180/P;"DEGREES)"
3450  GOTO 260
3460  REM CONR
3470  E=R[L]*COS(X[L])
3480  X[L]=R[L]*SIN(X[L])
3490  R[L]=E
3500  GOTO 1190
3510  REM COND
3520  E=R[L]*COS(X[L]*P/180)
3530  X[L]=R[L]*SIN(X[L]*P/180)
3540  R[L]=E
3550  GOTO 1190
3560  A$[I,I]="D"
3570  GOTO 2380
3580  REM POLISH CONV SUBR
3590  P$[1,LEN(A$)]=" "
3600  P$=P$[1,LEN(A$)]
3610  O$[1,LEN(A$)]=" "
3620  O$=O$[1,LEN(A$)]
3630  I=K=1
3640  J=2
3650  S[LEN(A$)+1]=0
3660  O[1]=-1
3670  IF S[I]=0 THEN 3850
3680  IF S[I]=2 THEN 3740
3690  O$[J,J]=A$[I,I]
3700  O[J]=S[I]
3710  I=I+1
3720  J=J+1
3730  GOTO 3670
3740  I=I+1
3750  J=J-1
3760  REM HIERARCHY CHECK
3770  IF O[J-1] >= S[I] THEN 3810
3780  REM POLISH COMPLETE?
3790  IF I=LEN(A$)+1 THEN 3890
3800  GOTO 3670
3810  P$[K,K]=O$[J-1,J-1]
3820  J=J-1
3830  K=K+1
3840  GOTO 3760
3850  P$[K,K]=A$[I,I]
3860  I=I+1
3870  K=K+1
3880  GOTO 3760
3890  RETURN 
3900  M=L-1
3910  IF M>1 THEN 3930
3920  GOTO 1190
3930  X[M]=X[M-1]
3940  R[M]=R[M-1]
3950  M=M-1
3960  GOTO 3910
3970  IF N=1 THEN 815
3975  IF A$[N-1,N-1]=")" THEN 4000
3980  IF A$[N-1,N-1]="Z" THEN 4000
3990  GOTO 815
4000  PRINT "IMPLIED '*'"
4010  GOTO 260
4020  END 
