home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / basic / navprog7.lbr / AIRINPUT.BZS / AIRINPUT.BAS
Encoding:
BASIC Source File  |  1987-02-15  |  15.5 KB  |  342 lines
  1. 10 ' AIRINPUT.BAS       (c) 1982 Alan Bose    22-Jan-82   Rev 2/10/83
  2. 20 ' CP/M modifications (c) 1982 by Glen Hassebrock, Jr.
  3. 30 CLEAR:WIDTH 255:ON ERROR GOTO 3160
  4. 40 BL$=CHR$(7):E$=CHR$(27):ER$=E$+"E":P$=E$+"p":Q$=E$+"q":G$=E$+"F":NG$=E$+"G"
  5. 50 Y$=E$+"Y":L$=E$+"l":J$=E$+"j":K$=E$+"k":J1$=E$+"J":U=57.29577950000003#
  6. 60 DEF FNC$(C1,C2)=Y$+CHR$(C1+31)+CHR$(C2+31)
  7. 70 DEF FNS6(X)=INT(X*10+.5)/10
  8. 80 DEF FNS7(X)=ATN(X/SQR(1-X*X))*U
  9. 90 DEF FNS8(X)=SIN(ABS(A/2)/U)*COS(X/U)/SIN(Q2/2)
  10. 100 PRINT ER$"Standby one";:MX=32767:MN=0
  11. 110 OPEN"R",1,"B:AIRPORTS.RND",255:GOSUB 3330:PRINT"..."
  12. 120 OPEN"R",2,"B:AIRINDEX.RND",255:MD=(MD*5)-1:IF MD=-1 THEN MD=0
  13. 130 OL=MD+10:DIM ID$(OL),RN$(2),RN(2):FOR J=0 TO MD:REC=(J\51)+1:SS=J MOD 51
  14. 140 IF LOC(2)<>REC THEN GET #2,REC
  15. 150 FIELD #2,SS*5 AS DU$,5 AS ID$:ID$(J)=ID$
  16. 160 IF ASC(ID$)=0 THEN ID$(J)=SPACE$(5)
  17. 170 NEXT J:CLOSE#2:IM=MD
  18. 180 'data box
  19. 190 PRINT ER$G$FNC$(2,6)"f";
  20. 200 FOR J=7 TO 74:PRINT "a";:NEXT J:PRINT "c"FNC$(4,6)"e";
  21. 210 FOR J=7 TO 74:PRINT "a";:NEXT J:PRINT "d"
  22. 220 PRINT FNC$(2,12)"s"FNC$(2,15)"s"FNC$(2,23)"s"FNC$(2,44)"s";
  23. 230 PRINT FNC$(2,52)"s"FNC$(2,61)"s"FNC$(2,69)"s";
  24. 240 PRINT FNC$(4,12)"u"FNC$(4,15)"u"FNC$(4,23)"u"FNC$(4,44)"u";
  25. 250 PRINT FNC$(4,52)"u"FNC$(4,61)"u"FNC$(4,69)"u";
  26. 260 PRINT FNC$(3,6)"`"FNC$(3,12)"`"FNC$(3,15)"`"FNC$(3,23)"`"FNC$(3,44);
  27. 270 PRINT "`"FNC$(3,52)"`"FNC$(3,61)"`"FNC$(3,69)"`"FNC$(3,75)"`":PRINT NG$
  28. 280 PRINT FNC$(1,7)"Ident Fac Freq"FNC$(1,32)"Name"FNC$(1,47)"Lat"
  29. 290 PRINT FNC$(1,55)"Long"FNC$(1,64)"Var"FNC$(1,70)"Elev"
  30. 300 PRINT FNC$(5,9)"1"FNC$(5,13)"2"FNC$(5,19)"3"FNC$(5,33)"4"FNC$(5,47);
  31. 310 PRINT "5"FNC$(5,56)"6"FNC$(5,65)"7"FNC$(5,72)"8"
  32. 320 'menu
  33. 330 PRINT FNC$(7,1)J1$FNC$(8,7)"PRESS  `I' to input new data"
  34. 340 PRINT FNC$(9,14)"`U' to update existing data"
  35. 350 PRINT FNC$(10,14)"`E' to exit"
  36. 360 X$=INPUT$(1):GOSUB 3120:MD$=X$:PRINT FNC$(8,1)J1$:IF MD$="I" THEN 430
  37. 370 IF MD$="U" THEN 440
  38. 380 IF MD$<>"E" THEN PRINT BL$:GOTO 330
  39. 390 PRINT ER$"Returning to menu.  Sure? (Y or N)  <N>  ";:X$=INPUT$(1):PRINT X$
  40. 400 IF X$=CHR$(13) THEN X$="N"
  41. 410 GOSUB 3120:IF X$="Y" THEN CLOSE:GOSUB 2680:RUN"MENU"
  42. 420 IF X$="N" THEN 180 ELSE PRINT BL$:GOTO 390
  43. 430 C8=0:GOTO 510
  44. 440 'revise
  45. 450 PRINT FNC$(8,7)L$"Enter Identifier   <MENU>   "J$STRING$(5,95)K$;
  46. 460 LINE INPUT X$:PRINT J1$:IF X$="" THEN 320
  47. 470 IF LEN(X$)>5 THEN PRINT BL$:GOTO 450
  48. 480 GOSUB 3120:AP$=X$+SPACE$(5-LEN(X$)):NL$=AP$:GOSUB 1450
  49. 490 IF FD=0 THEN PRINT BL$"Can't find "AP$:GOTO 450
  50. 500 RO=3:GOSUB 1750
  51. 510 IF MD$="I" AND C8=8 THEN PUT#1,REC:ID$(PI)=ID$:EN=1:GOTO 320
  52. 520 IF MD$="I" THEN C8=C8+1:GOTO 560
  53. 530 PRINT FNC$(7,1)J1$:PRINT FNC$(8,7)"Press number for revision  <EXIT>  ";
  54. 540 C$=INPUT$(1):IF C$=CHR$(13) THEN PUT#1,REC:ID$(PI)=ID$:GOTO 320
  55. 550 C8=VAL(C$)
  56. 560 PRINT FNC$(7,1)J1$;
  57. 570 ON C8 GOTO 590,750,840,900,980,1160,1320,1400
  58. 580 PRINT BL$:GOTO 530
  59. 590 'id
  60. 600 PRINT "Enter airport/facility code: "J$STRING$(5,95)
  61. 610 IF MD$="U" THEN PRINT:PRINT"Enter 'D' to erase listing"
  62. 620 PRINT K$;:LINE INPUT X$:IF MD$="I" AND X$="" THEN 320
  63. 630 IF X$="" THEN 500
  64. 640 GOSUB 3120:AP$=X$+SPACE$(5-LEN(X$)):NL$=AP$
  65. 650 IF (MD$="I" AND X$="D") OR LEN(X$)>5 THEN PRINT BL$:GOTO 560
  66. 660 IF MD$="I" THEN GOSUB 1600
  67. 670 IF X$<>"D" THEN LSET ID$=NL$:EN=1:GOTO 500
  68. 680 GOSUB 3200:KY=KY-1:FOR J=1 TO KY:IF LI$(J)=ID$ THEN LI$(J)="":EE=1
  69. 690 IF R1$(J)=ID$ AND R1(J)=PI THEN R1$(J)="":EE=1
  70. 700 IF R2$(J)=ID$ AND R2(J)=PI THEN R2$(J)="":EE=1
  71. 710 IF R1$(J)="" AND R2$(J)="" THEN LI$(J)=""
  72. 720 IF LI$(J)="" THEN DD=DD+1
  73. 730 NEXT J:IF EE=1 THEN GOSUB 3270 ELSE GOSUB 3320
  74. 740 GOSUB 2630:GOSUB 1750:GOTO 320
  75. 750 'facility
  76. 760 PRINT L$"Enter facility code:  "J$STRING$(2,95)
  77. 770 PRINT:PRINT"A = Airport":PRINT"V = VOR/VORTAC":PRINT"N = NDB/LOM"
  78. 780 PRINT "I = Intersection":PRINT "R = Reporting point":PRINT "C = Checkpoint"
  79. 790 PRINT "W = Waypoint":PRINT "L = Landmark":PRINT K$;:LINE INPUT X$
  80. 800 IF LEN(X$)>2 THEN PRINT BL$:GOTO 560
  81. 810 IF MD$="I" AND X$="" THEN 320
  82. 820 IF X$<>"" THEN GOSUB 3120:LSET FAC$=X$
  83. 830 GOTO 500
  84. 840 'freq
  85. 850 IF MD$="I" AND INSTR(FAC$,"V")=0 AND INSTR(FAC$,"N")=0 THEN 500
  86. 860 PRINT"Enter navaid frequency  "J$STRING$(7,95)K$;:LINE INPUT X$
  87. 870 IF MD$="I" AND X$="" THEN 320
  88. 880 IF X$<>"" THEN LSET FR$=MKS$(VAL(X$))
  89. 890 GOTO 500
  90. 900 'name
  91. 910 PRINT L$"Enter facility name  "J$STRING$(20,95)K$;:LINE INPUT X$
  92. 920 IF MD$="I" AND X$="" THEN 320
  93. 930 IF LEN(X$)>20 THEN PRINT BL$"20 characters maximum"FNC$(7,1);:GOTO 910
  94. 940 IF INSTR(X$,",")<>0 THEN 960
  95. 950 PRINT BL$"Forgot state preceded by comma"FNC$(7,1);:GOTO 910
  96. 960 IF X$<>"" THEN LSET NM$=X$
  97. 970 GOTO 500
  98. 980 'lat
  99. 990 IF MD$="I" AND INSTR(FAC$,"I")>0 AND INSTR(FAC$,"V")=0 THEN 1000 ELSE 1010
  100. 1000 IF INSTR(FAC$,"N")=0 THEN GOSUB 1930:GOTO 500
  101. 1010 PRINT"Enter degrees latitude"FNC$(7,30)J$STRING$(2,95)"   deg"
  102. 1020 PRINT:PRINT"Enter `R' for RNAV calculation of lat. & long. from known fix"
  103. 1030 PRINT K$;:LINE INPUT X$:X=VAL(X$)
  104. 1040 IF MD$="I" AND X$="" THEN 320
  105. 1050 IF X$="R" OR X$="r" THEN TR=REC:TS=SS:I$=ID$:PUT#1,REC:GOSUB 1930:GOTO 500
  106. 1060 IF X$="" THEN 500
  107. 1070 IF X>90 OR X<=0 THEN PRINT BL$:GOTO 1030
  108. 1080 LSET D1$=MKI$(X)
  109. 1090 PRINT J1$"Enter minutes latitude  <0>  "J$STRING$(4,95)" min"K$;
  110. 1100 LINE INPUT X$:X=VAL(X$):IF X$="" THEN X=0:PRINT K$"0"
  111. 1110 IF X>=60 OR X<0 THEN PRINT BL$:GOTO 1090
  112. 1120 PRINT J1$"Enter seconds latitude  <0>  "J$STRING$(4,95)" sec"K$;
  113. 1130 LINE INPUT X$:Y=VAL(X$):IF X$="" THEN Y=0:PRINT K$"0"
  114. 1140 IF Y>60 OR Y<0 THEN PRINT BL$:GOTO 1120
  115. 1150 X=X+(Y/60):LSET M1$=MKS$(X):GOTO 500
  116. 1160 'enter long
  117. 1162 PRINT"East or West Longitude?  <W>  ";:X$=INPUT$(1):PRINT X$
  118. 1164 IF X$="E" OR X$="e" THEN EW=1 ELSE EW=0
  119. 1170 PRINT"Enter degrees longitude"FNC$(8,31)J$STRING$(3,95)"  deg"
  120. 1180 PRINT:PRINT"Enter `R' for RNAV calculation of lat. & long. from known fix"
  121. 1190 PRINT K$;:LINE INPUT X$:X=VAL(X$)
  122. 1200 IF MD$="I" AND X$="" THEN 320
  123. 1210 IF X$="" THEN 500
  124. 1220 IF X$="R" OR X$="r" THEN TR=REC:TS=SS:I$=ID$:PUT#1,REC:GOSUB 1930:GOTO 500
  125. 1230 IF X>180 OR X<0 THEN PRINT BL$:GOTO 1170
  126. 1235 IF EW=1 THEN X=-X
  127. 1240 LSET D$=MKI$(X)
  128. 1250 PRINT J1$"Enter minutes longitude  <0>  "J$STRING$(4,95)" min"K$;
  129. 1260 LINE INPUT X$:X=VAL(X$):IF X$="" THEN X=0:PRINT K$"0"
  130. 1270 IF X>=60 OR X<0 THEN PRINT BL$;:GOTO 1250
  131. 1280 PRINT"Enter seconds longitude  <0>  "J$STRING$(4,95)" sec"K$;
  132. 1290 LINE INPUT X$:Y=VAL(X$):IF X$="" THEN Y=0:PRINT K$"0"
  133. 1300 IF Y>60 OR Y<0 THEN PRINT BL$:GOTO 1280
  134. 1310 X=X+(Y/60)
  135. 1312 IF EW=1 THEN X=-X
  136. 1314 LSET M$=MKS$(X):GOTO 500
  137. 1320 'var
  138. 1330 PRINT"Enter magnetic variation  <0>  "J$STRING$(4,95)" deg"K$;
  139. 1340 LINE INPUT X$:X=VAL(X$):IF MD$="I" AND X$="" THEN X=0
  140. 1350 IF X$="" THEN 500
  141. 1360 LSET V$=MKS$(X):IF X=0 THEN LSET V1$=" ":GOTO 500
  142. 1370 PRINT"East or West variation?  "J1$;:X$=INPUT$(1):PRINT X$:GOSUB 3120
  143. 1380 IF X$<>"E" AND X$<>"W" THEN PRINT BL$;:GOTO 1370
  144. 1390 PRINT FNC$(7,1)J1$:LSET V1$=X$:GOTO 500
  145. 1400 'elev
  146. 1410 PRINT"Enter elevation of facility  "J$STRING$(5,95)K$;
  147. 1420 LINE INPUT X$:X=VAL(X$):IF MD$="I" AND X$="" THEN PRINT BL$:GOTO 560
  148. 1430 IF X$<>"" THEN LSET EL$=MKI$(X)
  149. 1440 GOTO 500
  150. 1450 'search-match
  151. 1460 RO=3
  152. 1470 FD=0
  153. 1480 FOR J=0 TO IM:IF ID$(J)<>AP$ THEN 1530
  154. 1490 IF FD=1 THEN RO=7:GET#1,REC:PRINT FNC$(7,1)J1$:GOSUB 1750:RO=8:FD=2
  155. 1500 PI=J
  156. 1510 IF FD>1 THEN REC=(J\5)+1:SS=J MOD 5:GET#1,REC:GOSUB 1750:FD=FD+1:RO=RO+1
  157. 1520 IF FD=0 THEN FD=1:REC=(J\5)+1:SS=J MOD 5:GET#1,REC
  158. 1530 NEXT J
  159. 1540 IF FD=0 OR FD=1 THEN 1590
  160. 1550 PRINT FNC$(RO+1,1)"Enter number of your choice  <"PI">  "J$;
  161. 1560 PRINT STRING$(3,95)K$;:LINE INPUT X$
  162. 1570 IF X$="" THEN 1590
  163. 1580 PI=VAL(X$):REC=(PI\5)+1:SS=PI MOD 5:GET #1,REC:PRINT FNC$(6,1)J1$
  164. 1590 RETURN
  165. 1600 'search-blank
  166. 1610 FD=0:FH=0:FOR J=0 TO IM
  167. 1620 IF ID$(J)=SPACE$(5) THEN FH=1:TI=J:J=IM+1
  168. 1630 IF ID$(J)<>AP$ THEN 1650
  169. 1640 FD=FD+1:RO=8+FD:REC=(J\5)+1:SS=J MOD 5:GET#1,REC:PI=J:GOSUB 1750
  170. 1650 NEXT J
  171. 1660 IF FH=0 THEN IM=IM+1:TI=IM
  172. 1670 IF IM<=OL THEN 1690
  173. 1680 PRINT ER$"Standby one...then re-enter":CLOSE:GOSUB 2680:GOTO 10
  174. 1690 RO=3:IF FD=0 THEN 1730
  175. 1700 PRINT FNC$(10+FD,7)"Found...continue with additional entry?  (Y or N)";
  176. 1710 PRINT "  <Y>";:X$=INPUT$(1):GOSUB 3120:IF X$="N" THEN 320
  177. 1720 IF X$<>"Y" AND X$<>CHR$(13) THEN PRINT BL$:GOTO 1700
  178. 1730 PI=TI:REC=(PI\5)+1:SS=PI MOD 5:GET #1,REC:GOSUB 1750:GOSUB 2630
  179. 1740 RETURN
  180. 1750 'decode & display
  181. 1760 FIELD #1,SS*50 AS DU$,5 AS ID$,2 AS FAC$,4 AS FR$,20 AS NM$,2 AS D1$,
  182.  
  183. 4 AS M1$,2 AS D$,4 AS M$,4 AS V$,1 AS V1$,2 AS EL$
  184. 1770 F5=CVS(FR$):D6=CVI(D1$):M6=CVS(M1$):D5=CVI(D$):M5=CVS(M$):V5=CVS(V$)
  185. 1780 E5=CVI(EL$)
  186. 1790 PI$=STR$(PI):PI$=PI$+SPACE$(4-LEN(PI$)):PRINT FNC$(RO,1)PI$;
  187. 1800 PRINT FNC$(RO,7)ID$FNC$(RO,13)FAC$FNC$(RO,16)SPC(7)FNC$(RO,16);
  188. 1810 IF F5=0 THEN 1860
  189. 1820 IF F5>136 THEN PRINT USING"#####";F5;:GOTO 1860
  190. 1830 IF F5*10\1=F5*10/1 THEN PRINT USING"####.#";F5;:GOTO 1860
  191. 1840 IF F5*100\1=F5*100/1 THEN PRINT USING"####.##";F5;:GOTO 1860
  192. 1850 PRINT USING"###.###";F5;
  193. 1860 PRINT FNC$(RO,24);NM$;
  194. 1870 PRINT FNC$(RO,45);USING"##";D6;:PRINT FNC$(RO,48);USING"##.#";M6;
  195. 1880 PRINT FNC$(RO,53);USING"###";D5;:PRINT FNC$(RO,57);USING"##.#";ABS(M5);
  196. 1890 PRINT FNC$(RO,62);USING"###.#";V5;
  197. 1900 PRINT FNC$(RO,68)V1$;FNC$(RO,70);USING"#####";E5
  198. 1910 IF INSTR(FAC$,"V")=0 AND INSTR(FAC$,"N")=0 THEN NV=0 ELSE NV=1
  199. 1920 RETURN
  200. 1930 'RNAV lat & long
  201. 1940 PRINT FNC$(6,1)J1$
  202. 1950 PRINT"This routine will find the latitude & longitude of "I$
  203. 1960 PRINT"by taking fixes on 1 or 2 navaids already on file.":PRINT
  204. 1970 PRINT"The navaids you specify should be the ones you'll use in the air"
  205. 1980 PRINT"to determine your position.":PRINT
  206. 1990 PRINT"Postion can be determined two ways:":PRINT
  207. 2000 PRINT TAB(5)"1  -  Distance & bearing FROM one navaid":PRINT
  208. 2010 PRINT TAB(5)"2  -  Bearings FROM two navaids":PRINT
  209. 2020 PRINT J$J1$TAB(5)"Enter selection  <RETURN>  ";:X$=INPUT$(1):PRINT X$
  210. 2030 '2 bearings
  211. 2040 IF X$=CHR$(13) THEN C8=C8-1:GOTO 2620
  212. 2050 IF X$="2" THEN RN=1:GOTO 2070
  213. 2060 IF X$="1" THEN RN=0 ELSE PRINT BL$K$;:GOTO 2020
  214. 2070 PRINT FNC$(7,1)J1$;
  215. 2080 PRINT FNC$(7,1)L$"Enter identifier of known fix on file  "J$;
  216. 2090 PRINT STRING$(5,95)K$;:LINE INPUT X$:PRINT J1$
  217. 2100 IF X$="" THEN C8=C8-1:GOTO 2620
  218. 2110 IF LEN(X$)>5 THEN PRINT BL$:GOTO 2080
  219. 2120 GOSUB 3120:AP$=X$+SPACE$(5-LEN(X$)):PUT#1,REC:TI=PI:RO=9:GOSUB 1470
  220. 2130 IF FD=0 THEN PRINT BL$"Can't find "AP$:GOTO 2080
  221. 2140 PRINT FNC$(7,1)J1$:RO=9:GOSUB 1750:RN$(RN)=ID$:RN(RN)=PI:PI=TI
  222. 2150 IF NV=1 THEN 2200
  223. 2160 PRINT BL$"Not listed as navaid. Use? (Y or N) <N> ";:X$=INPUT$(1):PRINT X$
  224. 2170 IF X$=CHR$(13) THEN X$="N"
  225. 2180 GOSUB 3120:IF X$="N" THEN 2080
  226. 2190 IF X$<>"Y" THEN PRINT BL$:GOTO 2160
  227. 2200 X4=D6+(M6/60):X6=-(D5+(M5/60)):K9=0:L9=0
  228. 2210 IF RN<>0 THEN PRINT FNC$(RO+2,1)"Bearing FROM "ID$" to "NL$:GOTO 2270
  229. 2220 'dist & 1 bearing
  230. 2230 PRINT FNC$(RO+2,1)"Distance & bearing FROM "ID$" to "NL$
  231. 2240 PRINT FNC$(RO+4,5)"Enter distance in nautical miles  "J$;
  232. 2250 PRINT STRING$(3,95)K$;
  233. 2260 LINE INPUT D$:D=VAL(D$):IF D=0 THEN PRINT BL$:GOTO 2240
  234. 2270 PRINT FNC$(RO+5,5)"Enter bearing  "J$STRING$(3,95)K$;
  235. 2280 LINE INPUT H$:H=VAL(H$):IF H<0 OR H>360 THEN PRINT BL$:GOTO 2270
  236. 2290 IF H$="" THEN C8=C8-1:GOTO 1930
  237. 2300 PRINT FNC$(RO+6,5)"Is bearing True or Magnetic?  <T>  "J1$;
  238. 2310 X$=INPUT$(1):PRINT X$:GOSUB 3120:IF X$="T" OR X$=CHR$(13) THEN 2350
  239. 2320 IF X$<>"M" THEN PRINT BL$:GOTO 2300
  240. 2330 V=V5:IF V1$="E" THEN V=-V
  241. 2340 H=H-V
  242. 2350 IF RN<>0 THEN P2(RN)=X4:P1(RN)=-X6:RA(RN)=H
  243. 2360 IF RN=1 THEN RN=2:GOTO 2070
  244. 2370 IF RN=2 THEN GOSUB 2800:GOTO 2400
  245. 2380 C=D:C1=H
  246. 2390 'solve lat & long
  247. 2400 IF C1>270 THEN 2440
  248. 2410 IF C1>180 THEN 2450
  249. 2420 IF C1>90 THEN 2460
  250. 2430 IF C1<=90 THEN 2470
  251. 2440 A=360-C1:GOSUB 2480:K=B1:L=-B2:GOTO 2490
  252. 2450 A=C1-180:GOSUB 2480:K=-B1:L=-B2:GOTO 2490
  253. 2460 A=180-C1:GOSUB 2480:K=-B1:L=B2:GOTO 2490
  254. 2470 A=C1:GOSUB 2480:K=B1:L=B2:GOTO 2490
  255. 2480 B=A/U:B1=C*COS(B):B2=C*SIN(B):RETURN
  256. 2490 K9=K:L9=L:X8=X4+(K9/60):X9=(X4+X8)/(2*U):X8=ABS(X8):Y=INT(X8):Y1=X8-Y
  257. 2500 Y2=Y1*60:Y3=(L9/COS(X9))/60:Y4=ABS(X6+Y3):Y5=INT(Y4):Y6=Y4-Y5:Y7=Y6*60
  258. 2510 REC=(PI\5)+1:SS=PI MOD 5:GET#1,REC:RO=3:GOSUB 1750:LSET D1$=MKI$(Y)
  259. 2520 LSET M1$=MKS$(Y2):LSET D$=MKI$(Y5):LSET M$=MKS$(Y7):GOSUB 1750:C8=C8+1
  260. 2530 IF INSTR(FAC$,"V")>0 THEN 2620
  261. 2540 GOSUB 3200:LI$(KY)=NL$
  262. 2550 IF RN=0 THEN R1$(KY)=RN$(0):R1(KY)=RN(0):R2$(KY)="":R2(KY)=0:GOTO 2570
  263. 2560 R1$(KY)=RN$(1):R1(KY)=RN(1):R2$(KY)=RN$(2):R2(KY)=RN(2)
  264. 2570 RP=0:FOR J=1 TO KY-1
  265. 2580 IF LI$(J)=LI$(KY) AND R1$(J)=R1$(KY) AND R1(J)=R1(KY) THEN 2590 ELSE 2600
  266. 2590 IF R2$(J)=R2$(KY) AND R2(J)=R2(KY) THEN RP=1
  267. 2600 NEXT J
  268. 2610 IF RP=0 THEN GOSUB 3270 ELSE GOSUB 3320
  269. 2620 RETURN
  270. 2630 'clear
  271. 2640 EN=1:LSET ID$=SPACE$(5):LSET FAC$=SPACE$(2):LSET FR$=MKS$(0)
  272. 2650 LSET NM$=SPACE$(20):LSET D1$=MKI$(0):LSET M1$=MKS$(0)
  273. 2660 LSET D$=MKI$(0):LSET M$=MKS$(0):LSET V$=MKS$(0):LSET V1$=" "
  274. 2670 LSET EL$=MKI$(0):PUT#1,REC:ID$(PI)=SPACE$(5):RETURN
  275. 2680 'write index
  276. 2690 IF EN=0 THEN RETURN
  277. 2700 PRINT ER$"Standby one..."
  278. 2710 OPEN"R",2,"B:AIRINDEX.RND",255
  279. 2720 REC=1:FOR J=0 TO IM:RC=(J\51)+1:SS=J MOD 51
  280. 2730 IF REC<>RC THEN PUT#2,REC:REC=RC:FIELD#2,255 AS CL$:LSET CL$=" "
  281. 2740 FIELD #2,SS*5 AS DU$,5 AS ID$
  282. 2750 LSET ID$=ID$(J)
  283. 2760 NEXT J
  284. 2770 IF RC<>LOC(2)-1 THEN PUT#2,RC
  285. 2780 CLOSE#2:RETURN
  286. 2790 '2 bearings
  287. 2800 IF RA(1)>RA(2) AND RA(2)<RA(1)-180 THEN AB=(360-RA(1))+RA(2):GOTO 2820
  288. 2810 AB=ABS(RA(1)-RA(2))
  289. 2820 IF AB>180 THEN AB=AB-180
  290. 2830 IF AB>=15 AND AB<=165 THEN 2870
  291. 2840 PRINT BL$FNC$(7,1)J1$FNC$(9,1)"You're too close to the line that ";
  292. 2850 PRINT "runs between the navaids":PRINT "to compute your position ";
  293. 2860 PRINT "accurately.":GOTO 2080
  294. 2870 GOSUB 2950
  295. 2880 IF RA(1)>T AND T<RA(1)-180 THEN AA=(360-RA(1))+T ELSE AA=ABS(T-RA(1))
  296. 2890 IF AA>180 THEN AA=AA-180
  297. 2900 IF T>180 THEN T1=T-180 ELSE T1=T+180
  298. 2910 IF RA(2)>T1 AND T1<RA(2)-180 THEN AC=(360-RA(2))+T1 ELSE AC=ABS(T1-RA(2))
  299. 2920 IF AC>180 THEN AC=AC-180
  300. 2930 SC=SIN(AC/U)*SIN(Q2)/SIN(AB/U):SC=ATN(SC/SQR(-SC*SC+1)):C=SC*U*60
  301. 2940 C1=RA(1):X4=P2(1):X6=-P1(1):H=RA(1):RETURN
  302. 2950 'distance
  303. 2960 A=P1(1)-P1(2):B1=P2(1)-P2(2):P#=COS(P2(1)/U)*COS(P2(2)/U)
  304. 2970 Q=P#*COS(ABS(A)/U)+COS(ABS(B1)/U)-P#:IF Q<=0 THEN PRINT BL$:GOTO 3100
  305. 2980 Q2=ATN(SQR(1-Q*Q)/Q):Q=Q2*U*60
  306. 2990 C=FNS6(Q):IF C>900 AND ABS(A)>30 THEN PRINT BL$:GOTO 3090
  307. 3000 IF C=0 THEN T=0:RETURN
  308. 3010 ' true course
  309. 3020 S=FNS8((P2(1)+P2(2))/2):IF S>=1 THEN S=90-S ELSE S=FNS7(S)
  310. 3030 IF A>0 AND B1=0 THEN T=90:GOTO 3080
  311. 3040 IF A<0 AND B1=0 THEN T=270:GOTO 3080
  312. 3050 IF A>0 AND B1<0 THEN T=S:GOTO 3080
  313. 3060 IF A>=0 AND B1>0 THEN T=180-S:GOTO 3080
  314. 3070 IF A<0 AND B1>0 THEN T=180+S ELSE T=360-S
  315. 3080 T=FNS6(T):RETURN
  316. 3090 PRINT BL$"Distance excessive...":GOTO 1990
  317. 3100 PRINT BL$"Distance excessive."
  318. 3110 PRINT"Possible course errors due to rhumb line.":GOTO 1990
  319. 3120 'map lc
  320. 3130 FOR L=1 TO LEN(X$):U$=MID$(X$,L,1)
  321. 3140 IF ASC(U$)>96 AND ASC(U$)<123 THEN MID$(X$,L,1)=CHR$(ASC(U$)-32)
  322. 3150 NEXT L:RETURN
  323. 3160 'error
  324. 3170 IF ERR=53 AND ERL=3210 THEN KY=1:RESUME 3260
  325. 3180 IF ERL=2750 AND ERR=9 THEN RESUME NEXT
  326. 3190 ON ERROR GOTO 0
  327. 3200 'read RNAV
  328. 3210 OPEN"I",2,"B:RNAVLIST.DAT"
  329. 3220 INPUT#2,KY
  330. 3230 KY=KY+1:DIM LI$(KY),R1$(KY),R1(KY),R2$(KY),R2(KY)
  331. 3240 FOR J=1 TO KY-1:LINE INPUT#2,LI$(J):LINE INPUT#2,R1$(J):INPUT#2,R1(J)
  332. 3250 LINE INPUT#2,R2$(J):INPUT#2,R2(J):NEXT J:CLOSE#2
  333. 3260 RETURN
  334. 3270 'write RNAV
  335. 3280 OPEN"O",2,"B:RNAVLIST.DAT":PRINT#2,KY-DD
  336. 3290 FOR J=1 TO KY:IF LI$(J)="" THEN 3310 ELSE PRINT#2,LI$(J)
  337. 3300 PRINT#2,R1$(J):PRINT#2,R1(J):PRINT#2,R2$(J):PRINT#2,R2(J)
  338. 3310 NEXT J:CLOSE#2
  339. 3320 DD=0:ERASE LI$,R1$,R1,R2$,R2:RETURN
  340. 3330 MD=(MX+MN)\2:GET #1,MD:IF EOF(1) THEN MX=MD ELSE MN=MD
  341. 3340 IF MX>MN+1 THEN 3330 ELSE MD=MN:RETURN
  342. 1$,R1,R2$,R2:RETURN
  343. 3330 MD=(MX+MN)\2:GET #1,MD:IF EOF(1) THEN MX=MD ELSE M