0030 RUN SURVEY
0040 SUB SURVEY71
0050 DESTROY ALL @ OPTION ANGLE DEGREES @ STD @ Z=-999999
0060 CALL GETSTR('file name ',F$,'',1)
0065 IF F$='' OR LEN(F$)>8 THEN DISP 'Invalid Filespec' @ GOTO 60
0070 FOR I=1 TO INF @ IF CAT$(I)='' THEN 150
0080 U=POS(CAT$(I)[1,8],' ') @ IF NOT U THEN U=9
0090 IF CAT$(I)[1,U-1]<>F$ THEN 140
0100 ON ERROR GOTO 130
0110 ASSIGN #1 TO F$ @ READ #1,1;P0 @ READ #1,3;U,M1,M2 @ READ #1,4;P1,P2,P3
0120 OFF ERROR @ PRINT 'COORD FILE: ';F$ @ GOTO 290
0130 OFF ERROR @ DISP ERRM$ @ GOTO 60
0140 NEXT I
0150 U=(MEM-2000) DIV 24 @ IF U<=0 THEN PRINT 'Insufficient Memory' @ GOTO 460
0170 CALL GETNUM('size ('&STR$(U)&' max) ',P0,M1,1)
0180 IF P0>U OR P0<=0 THEN DISP 'Invalid Size' @ GOTO 170
0185 ON ERROR GOTO 442
0190 CREATE DATA F$,P0+7,24 @ ASSIGN #1 TO F$ @ OFF ERROR
0200 M1=FNS('BNS','abs angl Brg,Naz,Saz') @ M2=FNS('DA','field angl Defl,Angl')+3
0220 U=FNS('DG','Degrees,Grads') @ ON U GOTO 230,240
0230 P1=FNS('012','secs #decs (0-2)')-1 @ GOTO 250
0240 P1=FNS('0123456','angls #decs (0-6)')-1
0250 P2=FNS('012345','coords #decs (0-5)')-1 @ P3=FNS('012345','distances #decs (0-5)')-1
0270 DISP 'working' @ PRINT #1,0;'HPAFNNN' @ PRINT #1,1;P0 @ PRINT #1,2;P0+5
0275 PRINT #1,3;U,M1,M2 @ PRINT #1,4;P1,P2,P3 @ FOR I=5 TO P0+4 @ PRINT #1,I;Z,Z,Z @ NEXT I
0285 RESTORE #1,P0+5 @ PRINT #1;'COLNAMS',3,'Northing','Easting','Height'
0290 ON U GOTO 300,330
0300 IF P1=0 THEN I1$='10A,2x,aa,3dz,x,zz,a,zz,a' @ GOTO 340
0310 IF P1=1 THEN I1$='10A,aa,3dz,x,zz,a,zz.d,a' ELSE I1$='10A,aa,2dz,x,zz,a,zz.dd,a'
0320 GOTO 340
0330 I1$='10A,'&STR$(7-P1+(P1=0))&'x,aa,3dz' @ IF P1 THEN I1$=I1$&'.'&STR$(P1)&'d'
0340 I2$='7A,xx,'&STR$(12-P2+(P2=0))&'dz' @ IF P2 THEN I2$=I2$&'.'&STR$(P2)&'d'
0350 I2$=I2$&',x,a' @ I3$='11A,'&STR$(12-P3+(P3=0))&'dz' @ IF P3 THEN I3$=I3$&'.'&STR$(P3)&'d'
0370 ON FNS('FCUE','File,Cogo,User,Ex') GOTO 380,390,400,405
0380 CALL SURV1(#1,(M1),U,I2$,I3$) @ GOTO 370
0390 CALL SURV2(#1,(M1),M2,U,10^P1,I1$,I2$,I3$) @ GOTO 370
0400 CALL SURV3(#1,(U)) @ GOTO 370
0405 DISP 'exited SURVEY' @ END 
0410 DEF FNS(A$,P$)
0420 Q$=PEEK$('2F946',4) @ DELAY 0,9 @ DISP P$&CHR$(27)&'>' @ POKE '2F946',Q$
0430 K$=KEYWAIT$ @ K=POS(A$,UPRC$(K$)) @ IF NOT K THEN 420
0440 FNS=K @ DISP CHR$(27)&'<' @ END DEF 
0442 DISP ERRM$ @ GOTO 60
0460 END SUB 
0500 SUB SURV1(#1,M1,U,I2$,I3$)
0501 M9=M1
0505 I2$='7'&I2$[POS(I2$,"A")]
0506 I3$='11'&I3$[POS(I3$,"A")]
0530 DIM T6(4),T7(4),A1$[64] @ R=0 @ PRINT 'File Management'
0540 W$='working' @ Z=-999999 @ E9$='Too Many Inputs' @ E8$='Too Few Inputs'
0560 I0=FNS('ALCE-','Assgn,List,Clear,v,Ex',0) @ IF I0=1 THEN 580
0570 I0=I0-1 @ ON I0 GOTO 640,620,620,1260,575
0575 CALL FL @ GOTO 560
0580 I0=FNS('DBE-','Duplicat,Balance,v,Ex',0) @ IF I0=1 THEN 600
0590 I0=I0+3 @ ON I0-4 GOTO 620,620,1260,595
0595 CALL FL @ GOTO 580
0600 I0=FNS('RTSE-','Rotat,Trans,Scal,v,Ex',0) @ IF I0=1 THEN 560
0610 I0=I0+6 @ IF I0=11 THEN 1260
0612 IF I0=12 THEN CALL FL @ GOTO 600
0615 IF I0#8 THEN 620
0616 CALL SURV3(#1,U) @ GOTO 600
0620 S$='start,end #s ' @ GOSUB 1050 @ IF F=-3 THEN 627
0623 P1=T6(1) @ P2=T6(2) @ IF P1*P2 THEN 630 ELSE DISP E8$ @ GOTO 620
0627 ON I0-1 GOTO 560,560,1260,580,580,1260,600,600,600,1260
0630 READ #1,1;P @ IF P1>P2 THEN I=P1 @ P1=P2 @ P2=I @ DISP 'Using '&STR$(P1)&'-'&STR$(P2)
0631 IF P1<1 THEN P1=1
0632 IF P2>P THEN P2=P
0638 ON I0 GOTO 640,660,670,1260,680,810,1260,710,750,780,1260
0640 S$='point #' @ GOSUB 1030 @ IF NOT T6(1) THEN 560
0650 R=T6(1) @ P=R @ GOSUB 1090 @ GOTO 640
0660 DISP W$ @ FOR P=P1 TO P2 @ GOSUB 1120 @ NEXT P @ GOTO 560
0670 DISP W$ @ FOR P=P1+4 TO P2+4 @ PRINT #1,P;Z,Z,Z @ NEXT P @ GOTO 560
0680 S$='new start #' @ GOSUB 1030 @ P3=T6(1) @ IF NOT P3 THEN 580
0690 P4=P3-P1 @ READ #1,1;P @ IF P2+P4>P THEN DISP 'Invalid Point' @ GOTO 680
0700 DISP W$ @ FOR P=P1+4 TO P2+4 @ READ #1,P;N,E,H
0701 P9=P+P4-4 @ CALL CHK(#1,P9,Q9,Z)
0702 IF Q9=1 THEN 704 ELSE 705
0704 PRINT #1,P+P4;N,E,H
0705 NEXT P @ GOTO 580
0710 S$='rotation angl ' @ GOSUB 1070 @ S=SIN(A) @ C=COS(A)
0720 DISP W$ @ FOR P=P1+4 TO P2+4 @ READ #1,P;N,E,H
0730 IF N#Z THEN N1=N*C-E*S @ E1=N*S+E*C @ PRINT #1,P;N1,E1,H
0740 NEXT P @ GOTO 600
0750 LINPUT 'N,E,H ';A1$ @ IF A1$='' THEN N1=0 @ E1=0 @ H1=0 @ GOTO 759
0751 P=POS(A1$,',') @ IF NOT P THEN DISP E8$ @ GOTO 750
0752 N1=VAL(A1$[1,P-1]) @ A1$=A1$[P+1] @ P=POS(A1$,',') @ IF NOT P THEN DISP E8$ @ GOTO 750
0753 E1=VAL(A1$[1,P-1]) @ A1$=A1$[P+1] @ P=POS(A1$,',') @ IF P THEN DISP E9$ @ GOTO 750
0754 IF A1$='' THEN DISP E8$ @ GOTO 750 ELSE H1=VAL(A1$)
0759 DISP W$ @ FOR P=P1+4 TO P2+4 @ READ #1,P;N,E,H
0760 IF N#Z THEN N=N+N1 @ E=E+E1 @ H=H+H1*(H>Z) @ PRINT #1,P;N,E,H
0770 NEXT P @ GOTO 600
0780 INPUT 'multiplier ';S @ DISP W$ @ FOR P=P1+4 TO P2+4 @ READ #1,P;N,E,H @ IF N=Z THEN 800
0790 N=N*S @ E=E*S @ IF H>Z THEN H=H*S
0800 PRINT #1,P;N,E,H @ NEXT P @ GOTO 600
0810 S$='angl adjust ' @ GOSUB 1070 @ IF A=0 THEN 860 ELSE A=A/(P2-P1)
0820 DISP W$ @ READ #1,P1+4;N2,E2 @ FOR P=P1+5 TO P2+4 @ N1=N2 @ E1=E2 @ READ #1,P;N2,E2,H2
0830 N=N2-N1 @ E=E2-E1 @ L=SQR(N^2+E^2) @ B=ANGLE(N,E) @ PRINT #1,P;B,L,H2 @ NEXT P
0840 S=0 @ READ #1,P1+4;N2,E2 @ FOR P=P1+5 TO P2+4 @ N1=N2 @ E1=E2 @ READ #1,P;B,L,H2
0850 S=S+A @ B=B+S @ N2=N1+L*COS(B) @ E2=E1+L*SIN(B) @ PRINT #1,P;N2,E2,H2 @ NEXT P
0860 PRINT 'UNADJUSTED:' @ P=P2 @ GOSUB 1120
0865 CALL GETNUM('true N,E of #'&STR$(P2)&' ',N0,E0,0)
0870 N0=N0-N @ N=N0 @ E0=E0-E @ E=E0 @ H0=0
0880 IF H>Z THEN CALL GETNUM('true H of #'&STR$(P2)&' ',H0,L1,1) @ H0=H0-H @ H=H0
0890 PRINT 'CORRECTION:' @ GOSUB 1130 @ DISP W$
0900 L0=0 @ L1=0 @ D1=0 @ M1=0 @ READ #1,P1+4;N2,E2,H2
0910 FOR P=P1+5 TO P2+4 @ N1=N2 @ E1=E2 @ H1=H2 @ READ #1,P;N2,E2,H2 @ N=N2-N1 @ E=E2-E1
0920 L=SQR(N^2+E^2) @ L0=L0+L @ L1=L1+N^2/L @ D1=D1+E^2/L @ M1=M1+E*N/L
0930 PRINT #1,P;N,E,H2-H1 @ NEXT P @ L=SQR(N0^2+E0^2) @ IF L=0 OR L0=0 THEN 1010
0940 PRINT 'CLOSURE:' @ PRINT USING I3$;'error';L @ PRINT USING I3$;'1 in ',L0/L
0950 I0=FNS('EBC','Bowditch,Crandall,Ex',1) @ IF I0<2 THEN 1010
0960 DISP W$ @ H0=H0/L0 @ IF I0=2 THEN N0=N0/L0 @ E0=E0/L0
0970 A=(N0*D1-E0*M1)/(D1*L1-M1^2) @ B=(E0*L1-N0*M1)/(D1*L1-M1^2)
0980 FOR P=P1+5 TO P2+4 @ READ #1,P;N,E,H @ L=SQR(N^2+E^2) @ IF I0=2 THEN N1=L*N0 @ E1=L*E0
0990 IF I0=3 THEN N1=A*N^2/L+B*N*E/L @ E1=A*E*N/L+B*E^2/L
1000 PRINT #1,P;N+N1,E+E1,H+L*H0 @ NEXT P
1010 READ #1,P1+4;N2,E2,H2 @ FOR P=P1+5 TO P2+4 @ N1=N2 @ E1=E2 @ H1=H2 @ READ #1,P;N,E,H
1020 N2=N1+N @ E2=E1+E @ H2=H1+H @ PRINT #1,P;N2,E2,H2 @ NEXT P @ M1=M9 @ GOTO 580
1030 CALL GETSTR(S$,A1$,'',1)
1040 CALL IP(#1,A1$,'',R,T6(),T7(),F) @ IF NOT F THEN 1030 ELSE RETURN 
1050 CALL GETSTR(S$,A1$,A2$,0)
1060 CALL IP(#1,A1$,A2$,P,T6(),T7(),F) @ IF F THEN RETURN ELSE 1050
1070 CALL GETSTR(S$,A1$,'',1)
1080 CALL IA(A1$,F,A,U) @ IF NOT F THEN 1070 ELSE RETURN 
1090 CALL GETNUM('N,E of #'&STR$(P)&' ',N,E,0)
1097 CALL GETSTR('H of #'&STR$(P)&' ',A1$,'',1)
1100 IF A1$='' THEN H=Z @ GOTO 1110
1101 FOR I3=0 TO 9 @ IF POS(A1$,STR$(I3)) THEN 1105
1102 NEXT I3 @ DISP 'Numeric Input' @ GOTO 1097
1105 H=VAL(A1$)
1110 CALL CHK(#1,P,Q9,Z)
1111 IF Q9=1 THEN 1115 ELSE RETURN 
1115 PRINT #1,P+4;N,E,H @ GOTO 1130
1120 READ #1,P+4;N,E,H @ IF N=Z THEN RETURN 
1130 PRINT USING I2$;'#'&STR$(P),N,'N' @ PRINT USING I2$;'#'&STR$(P),E,'E'
1140 IF H>Z THEN PRINT USING I2$;'#'&STR$(P),H,'H'
1150 RETURN 
1220 DEF FNS(A$,P$,S3)
1230 Q$=PEEK$('2F946',4) @ DELAY 0,9 @ DISP P$&CHR$(27)&'>' @ POKE '2F946',Q$
1240 K$=KEYWAIT$ @ IF NOT S3 AND K$='#51' THEN FNS=1 @ GOTO 1255
1245 K=POS(A$,UPRC$(K$)) @ IF NOT K THEN 1230
1250 IF NOT S3 THEN FNS=K+1 ELSE FNS=K
1255 DISP CHR$(27)&'<' @ END DEF 
1260 END SUB 
1400 SUB GETSTR(P$,A1$,A2$,F)
1420 ON ERROR GOTO 1450
1430 DISP P$; @ IF F THEN INPUT '';A1$ @ GOTO 1440
1435 LINPUT '';A1$ @ P=POS(A1$,',') @ IF NOT P THEN A2$='' @ GOTO 1440
1436 IF POS(A1$[P+1],',') THEN DISP 'Too Many Inputs' @ GOTO 1430
1437 A2$=A1$[P+1] @ A1$=A1$[1,P-1]
1440 OFF ERROR @ GOTO 1460
1450 DISP ERRM$ @ GOTO 1430
1460 END SUB 
1500 SUB GETNUM(P$,A1,A2,F)
1520 ON ERROR GOTO 1550
1530 IF F THEN DISP P$; @ INPUT '';A1 ELSE DISP P$; @ INPUT '';A1,A2
1540 OFF ERROR @ GOTO 1560
1550 DISP ERRM$ @ GOTO 1530
1560 END SUB 
2000 SUB SURV2(#1,M1,M2,U,L5,I1$,I2$,I3$)
2004 I1$='10'&I1$[POS(I1$,"A")]
2005 I2$='7'&I2$[POS(I2$,"A")]
2006 I3$='11'&I3$[POS(I3$,"A")]
2030 DIM P8(4),N8(4),E8(4),H8(4),S8(4),T6(2),T7(2) @ Z=-999999 @ R=0 @ P=0 @ B0=0
2050 W$='Solution Impossible' @ PRINT 'Coordinate Geometry'
2060 S$='from #' @ P=1 @ P0=1 @ GOSUB 3390 @ R=T6(1)
2070 GOSUB 3480 @ S$='backsight ' @ GOSUB 3310 @ B0=A0
2080 CALL OA((B0),0,(M1),'b.s.',I1$,U,L5)
2090 IF FNS('AF','angls Abs,Field',1)=2 THEN M0=M2 ELSE M0=M1
2100 P=P8(1)
2110 F8=0 @ ON FNS('SLCE*-','Start,Line,Curve,v,Ex',0) GOTO 2060,2360,2780,4040,2211,2217,2120
2120 I=FNS('RAE*-','Radial,Area,v,Ex',0) @ ON I GOTO 2130,2130,4040,2212,2218,2110
2130 A9=0
2140 S$='#'&STR$(P8(1))&' to # [;thru] ' @ GOSUB 3280
2150 P8(3)=T6(1) @ P8(4)=T6(2) @ S8(3)=T7(1) @ S8(4)=T7(2)
2160 S8(2)=1-2*(I=1) @ ON S8(3)+2 GOTO 2220,2330,2170
2170 S=SGN(P8(4)-P8(3)) @ IF P8(4)=0 OR S=0 THEN P8(4)=P8(3) @ S=1
2180 FOR F=P8(3) TO P8(4) STEP S @ READ #1,F+4;N8(2),E8(2),H8(2) @ IF N8(2)=Z THEN 2350
2190 P8(2)=F @ P1=1 @ P=2 @ P2=2 @ GOSUB 3510 @ GOSUB 3480 @ IF S8(P2)>0 THEN GOSUB 3540
2200 IF I=2 THEN A9=A9+(E8(2)-E8(1))*(N8(2)+N8(1)) @ GOSUB 3270
2210 NEXT F @ GOTO 2140
2211 GOSUB 2213 @ GOTO 2110
2212 GOSUB 2213 @ GOTO 2120
2213 IF M0=M1 THEN M0=M2 ELSE M0=M1
2214 RETURN 
2215 IF FLAG(1) THEN CFLAG 1 ELSE SFLAG 1
2216 RETURN 
2217 GOSUB 2215 @ GOTO 2110
2218 GOSUB 2215 @ GOTO 2120
2220 IF I=1 THEN 2170
2230 READ #1,P8(3)+4;N8(3),E8(3),H8(3) @ IF N8(3)=Z THEN 2350
2240 S$='point #' @ GOSUB 3280 @ P8(2)=T6(1) @ IF NOT P8(2) THEN 2140
2250 READ #1,P8(2)+4;N8(2),E8(2),H8(2) @ IF N8(2)=Z THEN 2350
2260 N=N8(1)-N8(3) @ E=E8(1)-E8(3) @ B1=ANGLE(N,E) @ R1=SQR(N^2+E^2)
2270 N=N8(2)-N8(3) @ E=E8(2)-E8(3) @ B2=ANGLE(N,E) @ R2=SQR(N^2+E^2)
2280 IF ABS(R1-R2)>R1/100 THEN DISP 'Unequal Radii' @ GOTO 2140
2290 A1=B2-B1 @ IF ABS(A1)>180 THEN A1=A1-360*SGN(A1)
2300 P1=2 @ GOSUB 3550
2310 A9=A9+R1^2*RAD(A1)+(E8(3)-E8(1))*(N8(3)+N8(1))+(E8(2)-E8(3))*(N8(2)+N8(3))
2320 GOSUB 3270 @ GOTO 2140
2330 IF I=2 THEN PRINT USING I3$;'sq ft',ABS(A9/2) @ PRINT USING I3$;'acres',ABS(A9/87120)
2340 GOTO 2120
2350 DISP 'Point Not Stored' @ GOTO 2140
2360 GOSUB 3270 @ P1$=STR$(P8(1))
2370 P1=1 @ P=3 @ P2=3 @ A1=0 @ F0=0 @ S$='#'&P1$&' to #' @ GOSUB 3280
2380 P8(3)=T6(1) @ P8(4)=T6(2) @ S8(3)=T7(1) @ S8(4)=T7(2)
2390 IF NOT (P8(3) OR P8(4)) THEN 2110
2400 IF P8(3) THEN P2$=STR$(P8(3)) ELSE P2$=STR$(P8(4))
2410 S1$=P1$&'*'&P2$&' '
2420 S$='hrz[;vrt] angl '&S1$ @ GOSUB 3310 @ IF F=1 THEN B1=A0 @ F0=1 @ A1=G2
2430 IF A1 THEN S$='slope dst '&S1$ ELSE S$='hrz[;vrt] dst '&S1$
2440 GOSUB 3290 @ IF F=1 THEN D1=D @ V1=V @ F0=F0+2
2450 ON F0+1 GOTO 2460,2530,2530,2480
2460 GOSUB 3420 @ GOSUB 3510 @ GOSUB 3480 @ IF S8(P2)>0 THEN GOSUB 3540
2470 GOTO 2360
2480 IF A1 THEN V1=D1*SIN(A1) @ D1=D1*COS(A1)
2490 N8(3)=N8(1)+D1*COS(B1) @ E8(3)=E8(1)+D1*SIN(B1)
2500 IF H8(1)#Z THEN H8(3)=H8(1)+V1 ELSE H8(3)=Z
2510 GOSUB 3510 @ GOSUB 3480 @ IF S8(P2)>0 THEN GOSUB 3540
2520 GOSUB 3470 @ GOTO 2360
2530 S$='2nd known #' @ P=2 @ GOSUB 3390 @ GOSUB 3480 @ S1$=STR$(P8(2))&'*'&P2$&' '
2540 S$='hrz angl '&S1$ @ GOSUB 3310 @ IF F=1 THEN B2=A0 @ F0=F0+2
2550 ON F0 GOTO 2620,2620,2560,2590
2560 FOR J=1 TO 2 @ T6(J)=N8(J) @ T7(J)=E8(J) @ NEXT J
2570 CALL BB(T6(),T7(),(B1),(B2),F,N2,E2) @ P8(4)=0
2580 FOR J=3 TO 4 @ N8(J)=N2 @ E8(J)=E2 @ NEXT J @ GOTO 2700
2590 T6(1)=N8(2) @ T6(2)=N8(1) @ T7(1)=E8(2) @ T7(2)=E8(1) @ CALL BD(T6(),T7(),B2,D1,F)
2610 FOR J=1 TO 2 @ N8(J+2)=T6(J) @ E8(J+2)=T7(J) @ NEXT J @ GOTO 2700
2620 S$='distance '&S1$ @ GOSUB 3290 @ IF F=1 THEN D2=D @ F0=F0+2
2630 IF F0<3 THEN 2360
2635 FOR J=1 TO 2 @ T6(J)=N8(J) @ T7(J)=E8(J) @ NEXT J @ ON F0-2 GOTO 2640,2670
2640 CALL BD(T6(),T7(),B1,D2,F) @ GOTO 2690
2670 CALL DD(T6(),T7(),D1,D2,F)
2690 FOR J=1 TO 2 @ N8(J+2)=T6(J) @ E8(J+2)=T7(J) @ NEXT J
2700 H8(3)=Z @ H8(4)=Z
2710 IF F THEN DISP W$ @ GOTO 2370
2720 FOR P=3 TO 4 @ P1=1 @ P2=P
2730 IF NOT P8(P2) THEN 2770
2740 GOSUB 3510 @ IF S8(P2)>0 THEN GOSUB 3540
2750 P1=2 @ GOSUB 3510 @ GOSUB 3480 @ IF S8(P2)>0 THEN GOSUB 3540
2760 GOSUB 3470
2770 NEXT P @ GOTO 2360
2780 GOSUB 3270 @ IF F8 THEN 2800
2790 I=FNS('ACTE','Arc,Chd,Tan,v,Ex',0) @ F8=0 @ ON I GOTO 2810,2810,2810,2110,2800
2800 I=FNS('DRE','Dlt,Rad,v,Ex',0)+3 @ F8=1 @ ON I-3 GOTO 2830,2920,2110,2790
2810 S$='arcchdtan' @ P=(I-1)*3+1 @ S$=S$[P,P+2]&' length '
2820 GOSUB 3290 @ D1=D @ GOTO 2840
2830 S$='delta ' @ GOSUB 3300 @ A1=A
2840 S$='rp ' @ P=3 @ GOSUB 3390
2850 N=N8(1)-N8(3) @ E=E8(1)-E8(3) @ R1=SQR(N^2+E^2) @ B1=ANGLE(N,E)
2855 IF I=2 AND ABS(D1)>2*R1 THEN DISP W$ @ GOTO 2780
2860 IF I=1 THEN A1=DEG(D1/R1)
2870 IF I=2 THEN A1=2*ASIN(D1/R1/2)
2880 IF I=3 THEN A1=2*ATN(D1/R1)
2890 S$='#'&STR$(P8(1))&' to #' @ GOSUB 3280 @ P8(2)=T6(1) @ IF NOT P8(2) THEN 2780
2900 B2=B1+A1 @ N8(2)=N8(3)+R1*COS(B2) @ E8(2)=E8(3)+R1*SIN(B2) @ H8(2)=Z
2910 P2=2 @ GOSUB 3470 @ P1=2 @ GOSUB 3550 @ GOTO 2780
2920 S$='radius ' @ GOSUB 3290 @ R1=D @ S1=0 @ S2=0
2930 S$='# on tan in (-rp) ' @ P=1 @ GOSUB 3390 @ F1=S8(1)>0 @ IF F1 THEN 2960
2940 S$='radius in (-ccw) ' @ GOSUB 3290 @ D1=D @ S1=SGN(D1)
2950 D1=ABS(D1)-R1*S1 @ GOTO 2980
2960 S$='angl in ' @ GOSUB 3310 @ B1=A0
2970 N8(1)=N8(1)-R1*SIN(B1) @ E8(1)=E8(1)+R1*COS(B1)
2980 S$='# on tan out (-rp) ' @ P=2 @ GOSUB 3390 @ F2=S8(2)>0 @ IF F2 THEN 3010
2990 S$='radius out (-ccw) ' @ GOSUB 3290 @ D2=D @ S2=SGN(D2)
3000 D2=ABS(D2)-R1*S2 @ GOTO 3030
3010 S$='angl out ' @ GOSUB 3310 @ B2=A0
3020 N8(2)=N8(2)-R1*SIN(B2) @ E8(2)=E8(2)+R1*COS(B2)
3030 S$='solve #' @ GOSUB 3280 @ P8(1)=T6(1) @ IF NOT P8(1) THEN 2780
3040 P8(3)=T6(1)+1 @ P8(2)=P8(3)+1
3050 IF 1+F1+F2+F2#3 THEN T6(1)=N8(1) @ T6(2)=N8(2) @ T7(1)=E8(1) @ T7(2)=E8(2)
3055 ON 1+F1+F2+F2 GOTO 3060,3090,3120,3150
3060 CALL DD(T6(),T7(),D1,D2,F) @ P=4-(S1=S2) @ GOTO 3140
3090 CALL BD(T6(),T7(),B1,D2,F) @ P=3+(S2<0) @ GOTO 3140
3120 T6(1)=N8(2) @ T6(2)=N8(1) @ T7(1)=E8(2) @ T7(2)=E8(1)
3130 CALL BD(T6(),T7(),B2,D1,F) @ P=3+(S1>0)
3140 N8(3)=T6(1) @ E8(3)=T7(1) @ N8(P)=T6(2) @ E8(P)=T7(2) @ GOTO 3180
3150 CALL BB(T6(),T7(),(B1),(B2),F,N2,E2)
3170 P=4 @ N8(3)=N2 @ E8(3)=E2 @ N8(P)=N2 @ E8(P)=E2
3180 IF F THEN DISP W$ @ GOTO 2780
3190 IF F1 THEN N8(1)=N8(3)+R1*SIN(B1) @ E8(1)=E8(3)-R1*COS(B1) @ GOTO 3220
3200 N=S1*R1*(N8(3)-N8(1))/D1 @ E=S1*R1*(E8(3)-E8(1))/D1
3210 B1=90+ANGLE(N,E) @ N8(1)=N8(3)+N @ E8(1)=E8(3)+E
3220 IF F2 THEN N8(2)=N8(3)+R1*SIN(B2) @ E8(2)=E8(3)-R1*COS(B2) @ GOTO 3250
3230 N=S2*R1*(N8(3)-N8(2))/D2 @ E=S2*R1*(E8(3)-E8(2))/D2
3240 B2=90+ANGLE(N,E) @ N8(2)=N8(3)+N @ E8(2)=E8(3)+E
3250 D1=SQR((N8(2)-N8(1))^2+(E8(2)-E8(1))^2) @ A1=2*ASIN(D1/(2*R1))
3260 FOR P2=1 TO 3 @ H8(P2)=Z @ GOSUB 3470 @ NEXT P2 @ P1=1 @ GOSUB 3550 @ GOTO 2780
3270 P8(1)=P8(P0) @ N8(1)=N8(P0) @ E8(1)=E8(P0) @ H8(1)=H8(P0) @ P0=1 @ RETURN 
3280 T=1 @ GOTO 3320
3290 T=2 @ GOTO 3320
3300 T=3 @ GOTO 3320
3310 T=4
3320 CALL GETSTR(S$,A1$,'',1) @ A1$=A1$&';' @ F=POS(A1$,';') @ A2$=A1$[F+1] @ A1$=A1$[1,F-1]
3330 ON T GOTO 3340,3350,3360,3370
3340 CALL IP(#1,A1$,A2$,R,T6(),T7(),F) @ GOTO 3380
3350 CALL ID(#1,A1$,A2$,F,D,V) @ GOTO 3380
3360 CALL IA(A1$,F,A,U) @ GOTO 3380
3370 A0=B0 @ CALL IB(#1,A1$,A2$,A0,U,F,G2)
3380 IF NOT F THEN 3320 ELSE RETURN 
3390 CALL GETSTR(S$,A1$,'',1)
3400 CALL IP(#1,A1$,'0',R,T6(),T7(),F) @ F=T6(2) @ P8(P)=T6(1) @ S8(P)=T7(1)
3410 IF NOT P8(P) THEN 3390
3420 READ #1,P8(P)+4;N8(P),E8(P),H8(P) @ IF N8(P)#Z THEN RETURN 
3430 CALL GETNUM('N,E of #'&STR$(P8(P))&' ',N8(P),E8(P),0)
3440 CALL GETSTR('H of #'&STR$(P8(P))&' ',A1$,'',1)
3450 IF A1$>'' THEN H8(P)=VAL(A1$) ELSE H8(P)=Z
3460 PRINT #1,P8(P)+4;N8(P),E8(P),H8(P) @ RETURN 
3470 CALL CHK(#1,P8(P2),Q9,Z)
3471 IF Q9=1 THEN 3475
3472 P8(P2)=0 @ RETURN 
3475 PRINT #1,P8(P2)+4;N8(P2),E8(P2),Z @ RETURN 
3480 PRINT USING I2$;'#'&STR$(P8(P)),N8(P),'N' @ PRINT USING I2$;'#'&STR$(P8(P)),E8(P),'E'
3500 RETURN 
3510 N=N8(P2)-N8(P1) @ E=E8(P2)-E8(P1) @ S$=STR$(P8(P1))&'-'&STR$(P8(P2))
3520 B1=MOD(ANGLE(N,E),360) @ CALL OA(B1,B0,M0,S$,I1$,U,L5)
3530 PRINT USING I3$;S$,SQR(N^2+E^2) @ IF S8(P2)<=0 THEN RETURN 
3540 P0=P2 @ P=P0 @ B0=MOD(B1+180,360) @ R=P8(P0) @ RETURN 
3550 FOR P=P1 TO 3 @ GOSUB 3480 @ NEXT P @ CALL OA(B2,B1,5,'delta',I1$,U,L5)
3560 PRINT USING I3$;'arc',ABS(R1*RAD(A1))
3570 IF ABS(A1)<179.99 THEN PRINT USING I3$;'tan',ABS(R1*TAN(A1/2))
3580 PRINT 'chord:' @ P1=1 @ P2=2 @ S8(2)=-1 @ GOSUB 3510 @ IF S8(P2)>0 THEN GOSUB 3540
3590 S8(2)=1 @ S8(3)=1
3600 PRINT 'radials:' @ P2=3 @ GOSUB 3510 @ IF S8(P2)>0 THEN GOSUB 3540
3610 P1=3 @ P2=2 @ GOSUB 3510 @ IF S8(P2)>0 THEN GOSUB 3540
3615 RETURN 
4000 DEF FNS(A$,P$,S3)
4010 Q$=PEEK$('2F946',4) @ DELAY 0,9 @ DISP P$&CHR$(27)&'>' @ POKE '2F946',Q$
4020 K$=KEYWAIT$ @ IF NOT S3 AND K$='#51' THEN K=LEN(A$)+1 @ GOTO 4030
4025 K=POS(A$,UPRC$(K$)) @ IF NOT K THEN 4010
4030 FNS=K @ DISP CHR$(27)&'<' @ END DEF 
4040 END SUB 
4800 SUB FNV(S$,V,F)
4805 ON ERROR GOTO 4920
4810 FOR I=1 TO LEN(S$)
4820 IF POS('.+-0123456789',S$[I,I]) THEN 4870
4840 IF S$[I,I]#' ' THEN 4860
4850 NEXT I
4860 F=1 @ V=0 @ END 
4870 P1=I @ IF LEN(S$)=1 THEN 4915
4880 FOR I=P1+1 TO LEN(S$)
4890 IF (S$[I,I]<'0' OR S$[I,I]>'9') AND S$[I,I]#'.' THEN 4910
4900 NEXT I
4910 I=I-1
4915 V=VAL(S$[P1,I]) @ F=0 @ END 
4920 OFF ERROR @ GOTO 4860 @ END SUB 
5000 SUB IA(A1$,F,A,U)
5010 ON ERROR GOTO 5090
5020 A0=0 @ IF A1$='' THEN F=-1 @ A=0 @ END 
5030 P=MAX(POS(A1$[2],'+'),POS(A1$[2],'-')) @ IF P<1 THEN 5060
5040 CALL IA(A1$[P+1],F,A,U) @ IF NOT F THEN END 
5050 A0=A0+A @ A1$=A1$[1,P] @ GOTO 5030
5060 CALL FNV(A1$,A,F) @ IF F THEN 5090
5065 IF U=2 THEN A=A*.9 @ GOTO 5075
5070 P=IP(FP(A)*100) @ A=IP(A)+((FP(A)-P/100)*1000/6+P)/60
5075 P=POS(A1$,'/') @ IF NOT P THEN 5080
5078 CALL FNV(A1$[P+1,LEN(A1$)],B,F) @ IF F THEN 5090 ELSE A=A/B
5080 F=1 @ A=A0+A @ END 
5090 IF ERRN=24 THEN DISP ERRM$ ELSE DISP 'Invalid Angle'
5095 F=0 @ A=0 @ END SUB 
5200 SUB IB(#1,B$,Z$,A0,U,F,G2)
5210 ON ERROR GOTO 5370
5220 IF B$='' THEN 5360
5230 T$=B$ @ P1=IP(POS(' NnSs+-',B$[1,1])/2) @ ON P1+1 GOTO 5240,5300,5300,5320
5240 P=POS(B$,'*') @ IF NOT P THEN 5310
5250 CALL FNV(B$,P1,F) @ IF F THEN 5370
5260 CALL FNV(B$[P+1],P,F) @ IF F THEN 5370
5277 READ #1,P1+4;N1,E1 @ READ #1,P+4;N2,E2
5280 IF N1=-999999 OR N2=-999999 THEN 5370 ELSE A0=ANGLE(N2-N1,E2-E1)
5290 A=0 @ P=POS(B$,'+') @ IF NOT P THEN P=POS(B$,'-')
5295 IF NOT P THEN 5330 ELSE T$=B$[P] @ GOTO 5320
5300 P=IP(POS(' EeWw',B$[2,2])/2) @ FOR I=3 TO LEN(B$) @ IF B$[I,I]#' ' THEN 5305
5301 NEXT I @ GOTO 5370
5305 T$=CHR$(45-2*(P1=P))&B$[I]
5310 A0=180*(P1=2)
5320 CALL IA(T$,F,A,U) @ IF NOT F THEN END 
5330 A0=MOD(A0+A,360) @ CALL IA(Z$,F,A,U) @ IF NOT F THEN END 
5340 P1=COS(A) @ IF ABS(P1)<COS(45) THEN A=ASIN(P1) ELSE A=ASIN(SIN(A)*SGN(P1))
5350 F=1 @ G2=A @ END 
5360 F=-1 @ G2=0 @ END 
5370 IF ERRN=24 THEN DISP ERRM$ ELSE DISP 'Invalid Direction'
5375 F=0 @ A0=0 @ G2=0 @ END SUB 
5400 SUB ID(#1,D$,D1$,F,D,V)
5410 C=0 @ ON ERROR GOTO 5530
5420 D=0 @ D0=0 @ IF D$='' THEN 5510
5430 P=MAX(POS(D$[2],'+'),POS(D$[2],'-')) @ IF P<1 THEN 5460
5440 CALL ID(#1,D$[P+1],'',F,D,V) @ IF NOT F THEN END 
5450 D0=D0+D @ D$=D$[1,P] @ GOTO 5430
5460 P=POS(D$,'*') @ IF P THEN 5470
5465 CALL FNV(D$,D,F) @ IF F THEN 5530 ELSE 5500
5470 Q=POS(D$,'/') @ IF NOT Q THEN Q=LEN(D$) ELSE Q=Q-1
5480 CALL FNV(D$[1,P-1],P1,F) @ IF F THEN 5530
5483 CALL FNV(D$[P+1,Q],P2,F) @ IF F THEN 5530
5485 READ #1,ABS(P1)+4;N1,E1 @ READ #1,P2+4;N2,E2
5490 IF N1=-999999 OR N2=-999999 THEN 5530 ELSE D=SQR((N2-N1)^2+(E2-E1)^2)*SGN(P1)
5500 Q=POS(D$,'/') @ IF NOT Q THEN 5510
5505 CALL FNV(D$[Q+1],B,F) @ IF F THEN 5530 ELSE D=D/B
5510 IF C THEN F=1-2*(D1=0) @ V=D0+D @ D=D1 @ END 
5520 D1=D0+D @ C=1 @ D$=D1$ @ GOTO 5420
5530 IF ERRN=24 THEN DISP ERRM$ ELSE DISP 'Invalid Distance'
5540 F=0 @ D=0 @ V=0 @ END SUB 
5600 SUB IP(#1,A1$,A2$,P,T6(),T7(),F)
5610 ON ERROR GOTO 5700
5620 READ #1,1;P9 @ F=1
5630 FOR J=1 TO 2
5635 IF J=1 AND A1$='+' OR J=2 AND A2$='+' THEN T6(J)=P+1 @ GOTO 5680
5640 IF J#1 THEN 5660
5641 IF A1$='' THEN T6(J)=0 @ F=F-2 @ GOTO 5680
5642 FOR L=0 TO 9 @ IF POS(A1$,STR$(L)) THEN 5650
5643 NEXT L @ GOTO 5700
5650 T6(J)=INT(VAL(A1$)) @ GOTO 5680
5660 IF A2$='' THEN T6(J)=0 @ F=F-2 @ GOTO 5680
5666 FOR L=0 TO 9 @ IF POS(A2$,STR$(L)) THEN 5670
5667 NEXT L @ GOTO 5700
5670 T6(J)=INT(VAL(A2$))
5680 T7(J)=SGN(T6(J)) @ T6(J)=ABS(T6(J)) @ IF T6(J)>P9 THEN 5700
5690 NEXT J @ END 
5700 IF ERRN=24 THEN DISP ERRM$ ELSE DISP 'Invalid Point'
5710 F=0 @ FOR J=1 TO 2 @ T7(J)=0 @ T6(J)=0 @ NEXT J
5720 END SUB 
5800 SUB OA(A,A0,M,S$,I1$,U,L5)
5810 T$='NESESWNWNASADRDLARAL'
5820 T2=A @ D5=4+(M>4) @ N5=0 @ ON M GOTO 5830,5860,5840,5850,5850
5830 D5=(T2 DIV 90.0000000001+1)/2 @ T2=(INT(D5)*180-T2)/((INT(D5)-D5)*4+1) @ D5=D5+D5
5835 GOTO 5860
5840 T2=MOD(T2-180,360) @ GOTO 5860
5850 T2=T2-MOD(A0+180*(M=4),360) @ T2=T2-360*SGN(T2)*(ABS(T2)>180) @ N5=T2<0 @ T2=ABS(T2)
5853 IF S$="delta" THEN 5860
5855 IF N5=1 THEN N5=0 @ T2=360-T2
5860 N5=(D5+M+N5-2)*2+1 @ ON U GOTO 5870,5890
5870 T2=T2+.5/(3600*L5) @ T3=(T2-IP(T2))*60
5880 PRINT USING I1$;S$,T$[N5,N5+1],IP(T2),IP(T3),"'",IP((T3-IP(T3))*60*L5)/L5,'"' @ END 
5890 PRINT USING I1$;S$,T$[N5,N5+1],T2*10/9 @ END SUB 
5900 SUB BB(T6(),T7(),S1,S2,F,N2,E2)
5910 F=0 @ N2=0 @ E2=0 @ C1=COS(S1) @ C2=COS(S2)
5920 S1=SIN(S1) @ S2=SIN(S2) @ D=S1*C2-S2*C1 @ IF ABS(D)<EPS THEN 5960
5930 N2=(T6(1)*S1*C2-T6(2)*S2*C1+C1*C2*(T7(2)-T7(1)))/D
5940 E2=(T7(2)*S1*C2-T7(1)*S2*C1+S1*S2*(T6(1)-T6(2)))/D
5950 END 
5960 F=1 @ FOR J=1 TO 2 @ T6(J)=0 @ T7(J)=0 @ NEXT J @ END SUB 
6000 SUB BD(T6(),T7(),A1,D2,F)
6010 CALL BB(T6(),T7(),(A1),A1+90,F,N2,E2)
6020 D=D2^2-(N2-T6(2))^2-(E2-T7(2))^2 @ IF D<0 THEN F=1 @ GOTO 6050
6030 D=SQR(D) @ T6(1)=N2-D*COS(A1) @ T7(1)=E2-D*SIN(A1)
6040 T6(2)=N2+D*COS(A1) @ T7(2)=E2+D*SIN(A1)
6050 END SUB 
6100 SUB DD(T6(),T7(),D1,D2,F)
6110 F=0 @ T6(2)=T6(2)-T6(1)
6120 T7(2)=T7(2)-T7(1) @ D=SQR(T6(2)^2+T7(2)^2) @ A=ANGLE(T6(2),T7(2))
6130 IF D=0 OR D>D1+D2 OR D1>D+D2 OR D2>D+D1 THEN F=1 @ GOTO 6170
6140 D=ACOS((D^2+D1^2-D2^2)/(2*D*D1))
6150 T6(2)=T6(1)+D1*COS(A+D) @ T7(2)=T7(1)+D1*SIN(A+D)
6160 T6(1)=T6(1)+D1*COS(A-D) @ T7(1)=T7(1)+D1*SIN(A-D)
6170 END SUB 
7200 SUB SURV3(#1,U)
7205 DIM T6(2),T7(2),N8(4),E8(4),H8(4) @ Z=-999999 @ R=0 @ P=0 @ B0=0
7210 S$='Pivot # [;Line Pt#] >' @ GOSUB 8000
7220 IF A2$='' THEN J=1 ELSE J=2
7230 FOR I=1 TO J
7240 READ #1,T6(I)+4;N8(I),E8(I),H8(I)
7250 IF N8(I)#Z AND E8(I)#Z THEN 7270
7255 IF I=1 THEN Q$=A1$ ELSE Q$=A2$
7260 DISP "ENTER N,E of # "&Q$&" >";
7265 INPUT "";N8(I),E8(I) @ PRINT #1,T6(I)+4;N8(I),E8(I),Z @ GOTO 7250
7270 NEXT I
7280 A0=0
7290 IF J=1 THEN 7300
7295 CALL IB(#1,A1$&"*"&A2$,"",A0,1,F,G2)
7300 S$='MOVE Pt# '&A1$&' TO Pt# >' @ CALL GETSTR(S$,B1$,'',1)
7310 IF B1$="" THEN B1$=A1$
7320 CALL IP(#1,B1$,"",R,T6(),T7(),F)
7330 IF NOT F THEN 7300
7340 READ #1,T6(1)+4;N8(2),E8(2),H8(2)
7350 IF N8(2)#Z AND E8(2)#Z THEN 7370
7355 DISP "ENTER N,E of #"&B1$&" >";
7360 INPUT '';N8(2),E8(2) @ PRINT #1,T6(1)+4;N8(2),E8(2),Z @ GOTO 7350
7370 N0=N8(2)-N8(1) @ E0=E8(2)-E8(1)
7380 IF J=1 THEN S$="Input Rotation >" ELSE S$="Rot Line "&A1$&"-"&A2$&" To Brg >"
7385 DISP S$;
7390 INPUT "";R$
7395 IF R$="" THEN R$="+0"
7400 B0=A0
7410 CALL IB(#1,R$,"",B0,1,F,G2)
7420 IF F=0 THEN 7385
7430 R0=B0-A0 @ A$=A1$ @ C=COS(R0) @ S=SIN(R0)
7440 S$="Rotate # [;Thru #] >"
7450 GOSUB 8000
7460 IF A1$="" THEN 8040
7470 IF A2$="" THEN A2$=A1$
7475 DISP "Working"
7480 FOR I=VAL(A1$) TO VAL(A2$)
7490 READ #1,I+4;N8(2),E8(2),H8(2)
7495 IF N8(2)=Z AND E8(2)=Z THEN 7560
7520 E=E8(2)-E8(1) @ N=N8(2)-N8(1)
7530 E8(3)=N*S+E*C+E8(1)+E0
7540 N8(3)=N*C-E*S+N8(1)+N0
7550 PRINT #1,I+4;N8(3),E8(3),H8(2)
7560 NEXT I
7570 GOTO 7440
8000 T=1
8010 CALL GETSTR(S$,A1$,'',1) @ F=POS(A1$,';') @ A2$=A1$[F+1] @ A1$=A1$[1,F-1]
8015 IF A1$='' THEN A1$=A2$ @ A2$=''
8020 CALL IP(#1,A1$,A2$,R,T6(),T7(),F)
8030 IF NOT F THEN 8010 ELSE RETURN 
8040 END SUB 
9000 SUB CHK(#1,P9,Q9,Z)
9010 IF NOT FLAG(1) THEN 9016
9011 READ #1,P9+4;N9,E9,H9
9012 IF N9=Z AND E9=Z THEN 9016 ELSE BEEP 
9013 DISP "OVERWRITE #"&STR$(P9)&" Y/N >"; @ INPUT "","N";Q9$
9014 IF Q9$[1,1]="Y" THEN 9016
9015 Q9=0 @ END 
9016 Q9=1
9017 END SUB 
9020 SUB FL
9022 IF FLAG(1) THEN CFLAG 1 ELSE SFLAG 1
9026 END SUB 
