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