100 ' ********************************************************

110 ' *     IBM PC BASIC VERSION A3.30                       *

120 ' *     FILE NAME    "HOI"                               *

130 ' *     AZIMUTH AND DISTANCE TOWARDS RESPECTIVE STATION  *

140 ' *     1987/10                             I.KATO       *

150 ' ********************************************************

160 KEY OFF:CLS:SCREEN 9

170 '

180 DEFDBL G,H,K,L,M,N,R,S,T

190 DIM A$(7),B$(3),F(12)

200 DATA "A POINT LATITUDE","A POINT LONGITUDE","B POINT LATITUDE",                      "B POINT LONGITUDE","AZIMUTH(A to B)","AZIMUTH(B to A)","SPAN DISTANCE"

210 DATA "DEGREE","MINUTE","SECOND"

220 FOR I=1 TO 7:READ A$(I):NEXT

230 FOR I=1 TO 3:READ B$(I):NEXT

240 COLOR 7:LOCATE  1, 1:PRINT STRING$(80,"-"):COLOR 14

250 LOCATE  2, 1:PRINT "[ITEM 22]         AZIMUTH AND DISTANCE TOWARDS RESPECTIVE STATION":COLOR 7

270 LOCATE  3, 1:PRINT STRING$(80,"-")

280 LOCATE  4, 1:PRINT "AZIMUTH     (rad)      =ATN(SIN(S-R)/(COS(K)*TAN(L)-SIN(K)*COS(S-R)))"

290 LOCATE  5, 1:PRINT "SPAN DISTANCE(km)      =SIN(K)*SIN(L)+COS(K)*COS(L)*COS(R-S)

300 LOCATE  6, 1:PRINT "                          K(L):LATITUDE,   R(S):LONGITUDE"

310 LOCATE  7, 1:PRINT STRING$(80,"-")

320 FOR I=1 TO 4:LOCATE 7+I,1:PRINT I;" ";A$(I):NEXT

330 GOSUB 4010:GOSUB 4110:GOSUB 4210:GOSUB 4310

340 '

350 COLOR 6:LOCATE 22,10:PRINT "Do you correct any data  (Y/N) ? ";:Y$=INPUT$(1)

360 IF Y$<>"Y" AND Y$<>"y" AND Y$<>"N" AND Y$<>"n" THEN 350

370 COLOR 7:LOCATE 22,10:PRINT SPC(69)

380 IF Y$="Y" OR Y$="y" THEN 390 ELSE 1000

390 COLOR 6:LOCATE 22,10:LINE INPUT "Input the item number(1-4) to be corrected  ";X$

400 COLOR 7:LOCATE 22,10:PRINT SPC(69)

410 NO=VAL(X$)

420 IF NO=0 OR NO>4 THEN 390

430 LOCATE 7+NO,21:PRINT SPC(59)

440 ON NO GOSUB 4010,4110,4210,4310

450 GOTO 350

1000 ' ---------------------

1010 ' *  direction angle  *

1020 ' ---------------------

1030 DEG=180/3.14159

1040 K= F(1)+ (F(2)*60+ F(3))/3600:K=K/DEG:IF AI$="S" OR AI$="s" THEN K=-K

1050 R= F(4)+ (F(5)*60+ F(6))/3600:R=R/DEG:IF AK$="W" OR AK$="w" THEN R=-R

1060 L= F(7)+ (F(8)*60+ F(9))/3600:L=L/DEG:IF BI$="S" OR BI$="s" THEN L=-L

1070 S=F(10)+(F(11)*60+F(12))/3600:S=S/DEG:IF BK$="W" OR BK$="w" THEN S=-S

1080 IF K=0 AND L=0 THEN M=-90 ELSE                                                     M=ATN(SIN(S-R)/(COS(K)*TAN(L)-SIN(K)*COS(S-R))):M=M*DEG

1090 IF K=0 AND L=0 THEN N=-90 ELSE                                                     N=ATN(SIN(R-S)/(COS(L)*TAN(K)-SIN(L)*COS(R-S))):N=N*DEG

1100 H=R-S

1110 '

1120 IF H>0 AND M>0 THEN B=ABS(180+M):GOSUB 1300

1130 IF H<0 AND M<0 THEN B=ABS(180+M):GOSUB 1300

1140 IF H>0 AND M<0 THEN B=ABS(M)    :GOSUB 1300

1150 IF H<0 AND M>0 THEN B=ABS(M)    :GOSUB 1300

1160 IF H=0 AND K<L THEN B=0         :GOSUB 1300

1170 IF H=0 AND K>L THEN B=180       :GOSUB 1300

1180 C(1)=C:D(1)=D:E(1)=E:COLOR 2

1190 LOCATE 13, 5:PRINT A$(5):LOCATE 13,27:PRINT USING "###:##:##";C(1),D(1),E(1);:PRINT " (from TN)"

1200 IF H>0 AND N>0 THEN B=ABS(N)    :GOSUB 1300

1210 IF H<0 AND N<0 THEN B=ABS(N)    :GOSUB 1300

1220 IF H>0 AND N<0 THEN B=ABS(180+N):GOSUB 1300

1230 IF H<0 AND N>0 THEN B=ABS(180+N):GOSUB 1300

1240 IF H=0 AND K<L THEN B=180       :GOSUB 1300

1250 IF H=0 AND K>L THEN B=0         :GOSUB 1300

1260 C(2)=C:D(2)=D:E(2)=E

1270 LOCATE 14, 5:PRINT A$(6):LOCATE 14,27:PRINT USING "###:##:##";C(2),D(2),E(2);:PRINT " (from TN)"

1280 COLOR 7:LOCATE 16,30:PRINT "(TN: True North)"

1290 GOTO 2000

1300 ' --  translate degree subroutine  --

1310 C=INT(B):D=INT((B-C)*60):E=INT((B-C-D/60)*3600+.5)

1320 RETURN

2000 ' -------------------

2010 ' *  span distance  *

2020 ' -------------------

2030 G=SIN(K)*SIN(L)+COS(K)*COS(L)*COS(R-S)

2040 ' ---- ACS -----

2050 G=-ATN(G/SQR(-G*G+1))+1.5708

2060 T=6370*G:T=INT(T*100+.5)/100

2070 COLOR 3:LOCATE 18, 5:PRINT A$(7):LOCATE 18,26:PRINT USING "###,###.## km";T

2080 COLOR 7:GOSUB 5000

3000 '

3110 COLOR 6:LOCATE 22,10:PRINT "Do you continue this work (Y/N) ? ";:Y$=INPUT$(1)

3120 IF Y$<>"Y" AND Y$<>"y" AND Y$<>"N" AND Y$<>"n" THEN 3110

3130 COLOR 7:LOCATE 22,10:PRINT SPC(69)

3140 IF Y$="Y" OR Y$="y" THEN SCREEN 0:CLS:SCREEN 9:GOTO 240

3150 CLS:SCREEN 0:RUN "ME"

4000 ' --------------------

4002 ' *  data input sub  *

4004 ' --------------------

4010 ' A point latitude

4020 COLOR 6:LOCATE  8, 1:PRINT 1" ";:PRINT A$(1)

4030 COLOR 6:LOCATE 22, 1:PRINT "Input  "A$(1)"  ";:INPUT "NORTH or SOUTH (N/S) ";X$

4040 IF X$<>"N" AND X$<>"n" AND X$<>"S" AND X$<>"s" THEN LOCATE 22,1:                PRINT SPC(79):GOTO 4030

4050 AI$=X$

4060 FLAG$="IDO":GOSUB 4410

4070 FOR I=1 TO 3:F(I)=D(I):NEXT

4080 COLOR 7:LOCATE  8,25:PRINT AI$:LOCATE  8,27:PRINT USING "###:##:##";F(1),F(2),F(3)

4085 LOCATE  8, 1:PRINT 1" ";:PRINT A$(1)

4090 FOR I=22 TO 23:LOCATE I,1:PRINT SPC(79):NEXT

4100 RETURN

4110 ' A longitude

4120 COLOR 6:LOCATE  9, 1:PRINT 2" ";:PRINT A$(2)

4130 COLOR 6:LOCATE 22, 1:PRINT "Input  "A$(2)"  ";:INPUT "EAST or WEST (E/W)  ";X$

4140 IF X$<>"E" AND X$<>"e" AND X$<>"W" AND X$<>"w" THEN LOCATE 22,1:                PRINT SPC(79):GOTO 4130

4150 AK$=X$

4160 FLAG$="KDO":GOSUB 4410

4170 FOR I=1 TO 3:F(I+3)=D(I):NEXT

4180 COLOR 7:LOCATE  9,25:PRINT AK$:LOCATE  9,27:PRINT USING "###:##:##";F(4),F(5),F(6)

4185 LOCATE  9, 1:PRINT 2" ";:PRINT A$(2)

4190 FOR I=22 TO 23:LOCATE I,1:PRINT SPC(79):NEXT

4200 RETURN

4210 ' B latitude

4220 COLOR 6:LOCATE 10, 1:PRINT 3" "A$(3)

4230 COLOR 6:LOCATE 22, 1:PRINT "Input  "A$(3)"  ";:INPUT "NORTH or SOUTH (N/S)  ";X$

4240 IF X$<>"N" AND X$<>"n" AND X$<>"S" AND X$<>"s" THEN LOCATE 22,1:                PRINT SPC(79):GOTO 4230

4250 BI$=X$

4260 FLAG$="IDO":GOSUB 4410

4270 FOR I=1 TO 3:F(I+6)=D(I):NEXT

4280 COLOR 7:LOCATE 10,25:PRINT BI$:LOCATE 10,27:PRINT USING "###:##:##";F(7),F(8),F(9)

4285 LOCATE 10, 1:PRINT 3" "A$(3)

4290 FOR I=22 TO 23:LOCATE I,1:PRINT SPC(79):NEXT

4300 RETURN

4310 ' B longitude

4320 COLOR 6:LOCATE 11, 1:PRINT 4" "A$(4)

4330 COLOR 6:LOCATE 22, 1:PRINT "Input  "A$(4)"  ";:INPUT "EAST or WEST (E/W)  ";X$

4340 IF X$<>"E" AND X$<>"e" AND X$<>"W" AND X$<>"w" THEN LOCATE 22,1:                PRINT SPC(79):GOTO 4330

4350 BK$=X$

4360 FLAG$="KDO":GOSUB 4410

4370 FOR I=1 TO 3:F(I+9)=D(I):NEXT

4380 COLOR 7:LOCATE 11,25:PRINT AK$:LOCATE 11,27:PRINT USING "###:##:##";F(10),F(11),F(12)

4385 LOCATE 11, 1:PRINT 4" "A$(4)

4390 FOR I=22 TO 23:LOCATE I,1:PRINT SPC(79):NEXT

4400 RETURN

4410 ' --  data input sub  --

4420 FOR I=1 TO 3

4430   LOCATE 23,26+(I-1)*15:PRINT B$(I)"=";:LINE INPUT D$(I)

4440   D(I)=VAL(D$(I))

4450   IF FLAG$="IDO" AND D(1)> 90 THEN LOCATE 23,26:PRINT SPC(14):GOTO 4430

4460   IF FLAG$="KDO" AND D(1)>180 THEN LOCATE 23,26:PRINT SPC(14):GOTO 4430

4470   IF D(2)>60  THEN LOCATE 23,41:PRINT SPC(14):GOTO 4430

4480   IF D(3)>60  THEN LOCATE 23,55:PRINT SPC(14):GOTO 4430

4490 NEXT

4500 RETURN

5000 ' --------------------

5010 ' *  graph draw sub  *

5020 ' --------------------

5030 VIEW(400,105)-(625,280),,5

5040 WINDOW SCREEN(0,0)-(100,100)

5050 K=K*DEG:R=R*DEG:L=L*DEG:S=S*DEG

5060 WX=(90-(K+L)/2)/90*111.2

5070 K=90-K:L=90-L

5080 VX=(R-S)*WX:VY=(K-L)*111.2

5090 IF ABS(VX)>=ABS(VY) THEN 5100 ELSE 5150

5100 '

5110 IF S>=R THEN WX1=25:WX2=75

5120 IF R>S  THEN WX1=75:WX2=25

5130 WY1=50+VY/ABS(VX)*25:WY2=50-VY/ABS(VX)*25

5140 GOTO 5190

5150 '

5160 IF K>=L THEN WY1=75:WY2=25

5170 IF L>K  THEN WY1=25:WY2=75

5180 WX1=50+VX/ABS(VY)*25:WX2=50-VX/ABS(VY)*25

5190 LINE(WX1,0)-(WX1,WY1),7

5200 LINE(WX2,0)-(WX2,WY2),7

5210 LINE(WX1,WY1)-(WX2,WY2),4

5220 IF S>R AND K>L THEN AX1=ATN((WY1-WY2)/(WX2-WX1)):                                  AX2=ATN((WX2-WX1)/(WY1-WY2)):CIRCLE(WX1,WY1),15,2,AX1,3.14/2:                   CIRCLE(WX2,WY2),15,2,(4.71-AX2),3.14/2:GOTO 5300

5230 IF S>R AND K<L THEN AX1=ATN((WY2-WY1)/(WX2-WX1)):                                  AX2=ATN((WX2-WX1)/(WY2-WY1)):CIRCLE(WX1,WY1),15,2,6.28-AX1,3.14/2:              CIRCLE(WX2,WY2),15,2,3.14/2,3.14/2+AX2:GOTO 5300

5240 IF S>R AND K=L THEN CIRCLE(WX1,WY1),15,2,0,3.14/2:                                 CIRCLE(WX2,WY2),15,2,3.14/2,3.14:GOTO 5300

5250 IF R>S AND K>L THEN AX1=ATN((WX1-WX2)/(WY1-WY2)):                                  AX2=ATN((WY1-WY2)/(WX1-WX2)):CIRCLE(WX1,WY1),15,2,3.14/2,3.14/2+AX1:            CIRCLE(WX2,WY2),15,2,6.28-AX2,3.14/2:GOTO 5300

5260 IF R>S AND K<L THEN AX1=ATN((WX1-WX2)/(WY2-WY1)):                                  AX2=ATN((WY2-WY1)/(WX1-WX2)):CIRCLE(WX1,WY1),15,2,4.71-AX1,3.14/2:              CIRCLE(WX2,WY2),15,2,AX2,3.14/2:GOTO 5300

5270 IF R>S AND K=L THEN CIRCLE(WX1,WY1),15,2,3.14/2,3.14:                              CIRCLE(WX2,WY2),15,2,0,3.14/2  :GOTO 5300

5280 IF R=S AND K>=L THEN CIRCLE(WX2,WY2),15,2,4.71,3.14/2:GOTO 5300

5290 IF R=S AND K<L  THEN CIRCLE(WX1,WY1),15,2,4.71,3.14/2

5300 LOCATE 1+(60+WY1)/8,1+(400+WX1*2)/8:PRINT "A"

5310 LOCATE 1+(60+WY2)/8,1+(400+WX2*2)/8:PRINT "B"

5320 LOCATE 9,64:PRINT "T"

5330 LOCATE 9,65:PRINT "N"

5340 RETURN