home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / misc3 / navigate.lzh / AUTONAV.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  8.4 KB  |  235 lines
  1. 10  ' AUTONAV.BAS   Automatic Route Selection Program   22-Jan-82  Rev 01/22/86
  2. 20  ' (c) Copyright 1982 Alan Bose
  3. 30  ' CP/M modifications (c) 1982 by Glen Hassebrock, Jr.
  4. 35  ' HP-150 modifications (c) 1984 by Alan Bose
  5. 36  ' PC-DOS modifications (c) 1985 by Bruce Carson           Version F.03.02
  6. 40  CLEAR:DEFINT I-J:ON ERROR GOTO 6000:GOSUB 4000
  7. 42  PROGDISK$="A:":DATADISK$="B:"
  8. 44  OPEN "I",1,"NAVDISCS.DAT"
  9. 46  INPUT #1,PROGDISK$,DATADISK$:CLOSE
  10. 50  BL$=CHR$(7):E$=CHR$(27)
  11. 60  U=57.2958
  12. 80  DEF FND$(X3)=FNC$(X3 MOD 20+2,(X3\20)*15+1)
  13. 90  DEF FNS6(X)=INT(X*10+0.5)/10
  14. 100  DEF FNS7(X)=ATN(X/SQR(1-X*X))*U
  15. 110  DEF FNS8(X)=SIN(ABS(A/2)/U)*COS(X/U)/SIN(Q2/2)
  16. 120  CLS:PRINT"Standby one";:MX=32767:MN=0
  17. 130  '
  18. 140  OPEN"R",1,DATADISK$+"AIRPORTS.RND",255:GOSUB 2030:PRINT "...":MD=MD*5
  19. 150  DIM ID$(MD),FA$(MD),LT(MD),LN(MD),PR(MD),W(25),D(25),H(25)
  20. 160  FOR J=1 TO MD:REC=((J-1)\5)+1:SS=(J-1) MOD 5
  21. 170  IF LOC(1)<>REC THEN GET#1,REC
  22. 180  FIELD#1,SS*50 AS DU$,5 AS ID$,2 AS FAC$,24 AS DU$,2 AS D1$,4 AS M1$,2 AS D$,4 AS M$
  23. 190  ID$(J)=ID$:FA$(J)=FAC$:D6=CVI(D1$):M6=CVS(M1$):D5=CVI(D$):M5=CVS(M$)
  24. 200  IF ASC(ID$(J))=0 THEN ID$(J)=SPACE$(5)
  25. 210  IF ID$(J)=SPACE$(5) THEN PR(J)=3
  26. 220  M1=M6/60:LT(J)=D6+M1:M=M5/60:LN(J)=D5+M:NEXT J
  27. 230  '
  28. 240  CLS:PRINT TAB(20);"NAVPROGseven Automatic Route Preparation"
  29. 245  PRINT
  30. 250  LOCATE 7,1:GOSUB 5000:PRINT "Enter departure point  <MENU>      ";:LOCATE ,POS(0)-5
  31. 260  LINE INPUT X$:IF X$="" THEN CLOSE:RUN PROGDISK$+"NAVMENU"
  32. 270  I=1:GOSUB 1810:GOSUB 1440:IF FD=0 THEN 250
  33. 280  P2=LT(W(1)):P1=LN(W(1)):PR(PI)=2:XT=P2:NT=P2:XN=P1:NN=P1
  34. 290  '
  35. 300  LOCATE 7,1:GOSUB 5000:PRINT "Enter destination   <EXIT>       ";:LOCATE ,POS(0)-5
  36. 310  LINE INPUT X$:IF X$="" THEN 250
  37. 320  MC=3:I=3:GOSUB 1810:GOSUB 1440:IF FD=0 THEN 300
  38. 330  P4=LT(W(3)):P3=LN(W(3)):PR(PI)=2:GOSUB 1670:PH=T:TD=C
  39. 335  IF TD>30 THEN 380
  40. 340  LOCATE 7,1:GOSUB 5000:PRINT  "That's a lot of work for a"INT(TD)"mile flight.  ";
  41. 350  PRINT "Continue? (Y or N) ";:X$=INPUT$(1):GOSUB 1810:PRINT X$
  42. 360  IF X$="N" THEN 240 ELSE IF X$<>"Y" THEN PRINT BL$:GOTO 340
  43. 370  '
  44. 380  LOCATE 7,1:PRINT  "Enter specific checkpoint to overfly, if desired  ";
  45. 390  PRINT"<CONTINUE> ";:LINE INPUT X$
  46. 400  IF X$="" THEN W(2)=W(3):W(3)=0:MC=2:NW=0:GOTO 470
  47. 410  I=2:GOSUB 1810:GOSUB 1440:IF FD=0 THEN 380
  48. 420  LOCATE 7,1:PRINT BL$;"90 degree course change doubles time needed to ";
  49. 430  PRINT"calculate."
  50. 440  P2=LT(W(2)):P1=LN(W(2)):PR(PI)=2:NW=1
  51. 450  GOSUB 1670:TD=C:DH=ABS(PH-T):IF DH>180 THEN DH=360-DH
  52. 460  P4=LT(W(1)):P3=LN(W(1)):GOSUB 1670:TD=TD+C
  53. 470  MV=30+DH:I=5:LOCATE 7,1:PRINT SPC(79);:LOCATE ,1
  54. 480  LOCATE I+3,1:GOSUB 5000:PRINT"Enter checkpoint to be disregarded, if desired";
  55. 490  PRINT"  <CONTINUE> ";:LINE INPUT X$
  56. 500  IF X$="" THEN 530
  57. 510  GOSUB 1810:GOSUB 1440:IF FD=0 THEN 480
  58. 520  I=I+1:PR(PI)=3:PRINT"  WILL BE IGNORED":GOTO 480
  59. 530  LOCATE I+3,1:GOSUB 5000:PRINT "Correct? (Y or N) ";:X$=INPUT$(1):GOSUB 1810:PRINT X$
  60. 540  IF X$="N" THEN 240 ELSE IF X$<>"Y" THEN PRINT BL$:GOTO 530
  61. 550  LOCATE ,1:GOSUB 5000:PRINT "VOR to VOR only? (Y or N) ";:X$=INPUT$(1):GOSUB 1810
  62. 560  PRINT X$:IF X$="N" THEN VN=1 ELSE IF X$<>"Y" THEN PRINT BL$:GOTO 550
  63. 570  LOCATE 7,1:GOSUB 5000
  64. 580  '
  65. 590  FOR J=1 TO MC
  66. 600  IF LT(W(J))>XT THEN XT=LT(W(J)):GOTO 620
  67. 610  IF LT(W(J))<NT THEN NT=LT(W(J))
  68. 620  IF LN(W(J))>XN THEN XN=LN(W(J)):GOTO 640
  69. 630  IF LN(W(J))<NN THEN NN=LN(W(J))
  70. 640  NEXT J:XT=XT+3:NT=NT-0.5:XN=XN+1:NN=NN-1:FOR J=1 TO MD
  71. 650  IF VN=1 THEN 680
  72. 660  IF J=W(1) OR J=W(2) OR J=W(3) THEN 730
  73. 670  IF INSTR(FA$(J),"V")=0 THEN PR(J)=3:GOTO 730
  74. 680  IF LT(J)>XT THEN 720
  75. 690  IF LT(J)<NT THEN 720
  76. 700  IF LN(J)>XN THEN 720
  77. 710  IF LN(J)>=NN THEN 730
  78. 720  PR(J)=3
  79. 730  NEXT J
  80. 740  CLOSE:GOSUB 1670:PRINT"Please align printer paper and then press <RETURN>.";
  81. 750  LINE INPUT X$:ML=INT(TD/2):IF ML<30 THEN ML=30
  82. 755  CLS:PRINT TAB(20);"NAVPROGseven Automatic Route Preparation"
  83. 760  LPRINT "NAVPROGseven Automatic Route Preparation"TAB(60)TM$" "DT$
  84. 770  LPRINT:LPRINT:LPRINT"Depart: "ID$(W(1))"    Dest: "ID$(W(MC))
  85. 780  LPRINT"Great circle dist: "TD"nm":LPRINT:LPRINT TAB(16)"nm"TAB(25)"TC"
  86. 790  LOCATE 2,1:PRINT TAB(40)"Depart: "ID$(W(1))"    Dest: "ID$(W(MC))
  87. 800  PRINT TAB(40)"Great circle dist: "TD"nm"
  88. 810  FOR J=0 TO MD:IF PR(J)=1 THEN PR(J)=0
  89. 820  NEXT J
  90. 830  '
  91. 840  CY=1:NE=0:FOR J=1 TO MC:LOCATE (J MOD 20+2),(J/20)*15+1:PRINT J;:LOCATE (J MOD 20+2),(J/20)*15+5
  92. 850  PRINT ID$(W(J))" "FA$(W(J)):NEXT J
  93. 860  P2=LT(W(CY)):P1=LN(W(CY)):P4=LT(W(CY+1)):P3=LN(W(CY+1))
  94. 870  IF PR(W(CY))=0 THEN PR(W(CY))=1
  95. 880  LOCATE (CY MOD 20+2),(CY/20)*15+1:PRINT CY;:GOSUB 1670:PH=T:SH=T:PD=C:BD=C:BH=360:BP=0:DD=2*C
  96. 890  IF C<ML THEN D(CY)=BD:H(CY)=INT(SH):GOTO 1190
  97. 900  '
  98. 910  FOR J=1 TO MD:LOCATE 1,1:PRINT ID$(J):IF PR(J)>0 THEN 1130
  99. 920  P4=LT(J):P3=LN(J):IF P1=P3 AND P2=P4 THEN 1130
  100. 930  GOSUB 1670:IF C>TD THEN PR(J)=3:GOTO 1130
  101. 940  IF C>PD OR (ML>60 AND C>PD*0.66) THEN 1130
  102. 950  C1=C:T1=T:RD=C:DH=ABS(PH-T):IF DH>180 THEN DH=360-DH
  103. 960  IF NW=0 AND CY=1 AND INSTR(FA$(J),"V")=0 AND DH>10 THEN 990
  104. 970  IF DH<=30 THEN 1010
  105. 980  IF DH<=MV THEN 1130
  106. 990  IF CY=1 OR DH<=90 THEN PR(J)=3:GOTO 1130
  107. 1000  PR(J)=1:GOTO 1130
  108. 1010  P2=P4:P1=P3:P4=LT(W(CY+1)):P3=LN(W(CY+1))
  109. 1020  GOSUB 1670:T2=T:C2=C:RD=RD+C:P2=LT(W(CY)):P1=LN(W(CY))
  110. 1030  IF RD>DD THEN 1130
  111. 1040  DH=ABS(PH-T):IF DH>180 THEN DH=360-DH
  112. 1050  IF DH<30 THEN 1080
  113. 1060  IF ML<30 AND CY+1=MC AND DH<45 AND C<14 THEN 1080
  114. 1070  IF ML>=30 OR CY+1<>MC OR DH>60 OR C>7 THEN 1130
  115. 1080  BP=J:DD=RD:NE=1
  116. 1090  SH=T1:BD=C1:S2=T2:B2=C2::BP$=ID$(BP):LOCATE ((CY+1)MOD 20+2),((CY+1)/20)*15+1:PRINT CY+1;
  117. 1100  LOCATE ((CY+1)MOD 20+2),((CY+1)/20)*15+5:PRINT BP$;" "FA$(BP)
  118. 1110  FOR K=CY+1 TO MC:LOCATE ((K+1)MOD 20+2),((K+1)/20)*15+1:PRINT K+1;:LOCATE((K+1)MOD 20+2),((K+1)\20)*15+5
  119. 1120  PRINT ID$(W(K))" "FA$(W(K)):NEXT K
  120. 1130  NEXT J:LOCATE 1,1:PRINT SPACE$(9)
  121. 1140  '
  122. 1150  IF BP<=0 THEN 1190
  123. 1160  FOR J=MC TO CY+1 STEP -1:W(J+1)=W(J):D(J+1)=D(J):H(J+1)=H(J)
  124. 1170  NEXT J:W(CY+1)=BP:PR(BP)=2:D(CY)=BD:D(CY+1)=B2:H(CY)=INT(SH)
  125. 1180  H(CY+1)=INT(S2):MC=MC+1:GOTO 1200
  126. 1190  IF BP=0 THEN D(CY)=BD:H(CY)=INT(SH):GOTO 1210
  127. 1200  P2=LT(BP):P1=LN(BP)
  128. 1210  LOCATE (CY MOD 20+2),(CY/20)*15+1:PRINT CY
  129. 1220  IF BP>0 THEN CY=CY+2 ELSE CY=CY+1:GOTO 1280
  130. 1230  IF BD<ML*0.33 THEN CY=CY-1
  131. 1240  IF B2<ML*0.33 THEN CY=CY-2
  132. 1250  IF BP<=0 THEN 1280
  133. 1260  FOR J=1 TO MC:LOCATE (J MOD 20+2),(J/20)*15+1:PRINT J;:LOCATE (J MOD 20+2),(J\20)*15+5:PRINT ID$(W(J))" ";
  134. 1270  PRINT FA$(W(J));:NEXT J
  135. 1280  IF CY<MC THEN 860
  136. 1290  IF NE=0 AND NW>3 AND ML>60 THEN 1400
  137. 1300  IF NE=0 AND NW>1 THEN 1380
  138. 1310  TM=0:LPRINT:LPRINT:FOR J=1 TO MC:LPRINT J;TAB(5)ID$(W(J))" ";
  139. 1320  LPRINT FA$(W(J));:IF J=MC THEN 1350
  140. 1330  LPRINT TAB(14);USING"####.#";D(J);
  141. 1340  LPRINT TAB(24);USING"###";H(J)
  142. 1350  TM=TM+D(J):NEXT J:LPRINT:LPRINT TAB(14)STRING$(6,45)
  143. 1360  LPRINT TAB(14);USING"####.#";TM
  144. 1370  IF MC>20 THEN LPRINT"Select up to 20 checkpoints for navigation"
  145. 1380  ML=INT(ML*0.5)
  146. 1390  IF ML>=15 THEN GOSUB 1900:IF MD>MC THEN 790
  147. 1400  CLOSE:LPRINT CHR$(12)
  148. 1405  PRINT
  149. 1410  LOCATE 24,40,1:PRINT  "Return to menu? (Y or N) ";:X$=INPUT$(1)
  150. 1420  GOSUB 1810:PRINT X$:IF X$="Y" THEN RUN PROGDISK$+"NAVMENU"
  151. 1430  IF X$="N" THEN 10 ELSE PRINT BL$:GOTO 1410
  152. 1440  'search index for match & get
  153. 1450  P$=X$+SPACE$(5-LEN(X$)):RO=I+2:FD=0
  154. 1460  FOR J=1 TO MD:IF ID$(J)<>P$ THEN 1520
  155. 1470  IF FD=1 THEN RO=15:GET#1,REC:LOCATE 15,1:GOSUB 5000:GOSUB 1630:RO=16:FD=2
  156. 1480  PI=J
  157. 1490  IF FD<=1 THEN 1510
  158. 1500  REC=((J-1)\5)+1:SS=(J-1) MOD 5:GET#1,REC:GOSUB 1630:FD=FD+1:RO=RO+1
  159. 1510  IF FD=0 THEN FD=1:REC=((J-1)\5)+1:SS=(J-1) MOD 5:GET#1,REC
  160. 1520  NEXT J
  161. 1530  IF FD<>0 THEN 1560
  162. 1540  PRINT BL$"Can't find "P$:PRINT"Return to menu and input data? (Y or N) ";
  163. 1550  X$=INPUT$(1):GOSUB 1810:PRINT X$:IF X$="Y" THEN CLOSE:RUN PROGDISK$+"NAVMENU" ELSE RETURN
  164. 1560  IF FD=1 THEN 1600
  165. 1570  LOCATE RO+2,1:PRINT"Enter number of your choice <"PI">    ";:LOCATE ,POS(0)-3
  166. 1580  LINE INPUT X$:IF X$="" THEN 1600
  167. 1590  PI=VAL(X$):REC=((PI-1)\5)+1:SS=(PI-1) MOD 5:GET#1,REC
  168. 1600  LOCATE 15,1:PRINT;:RO=I+2:GOSUB 1630:IF I<4 THEN W(I)=PI
  169. 1610  RETURN
  170. 1620  '
  171. 1630  'decode & display
  172. 1640  FIELD#1,SS*50 AS DU$,5 AS ID$,2 AS FAC$,4 AS DU$,20 AS NM$
  173. 1650  LOCATE RO+1,1:IF RO>14 THEN PRINT PI;
  174. 1660  LOCATE RO+1,7:PRINT ID$;TAB(13);FAC$;TAB(24)NM$:RETURN
  175. 1670  'distance
  176. 1680  A=P1-P3:B1=P2-P4:P#=COS(P2/U)*COS(P4/U)
  177. 1690  Q=P#*COS(ABS(A)/U)+COS(ABS(B1)/U)-P#:IF Q<=0 THEN PRINT BL$:GOTO 1850
  178. 1700  Q2=ATN(SQR(1-Q*Q)/Q):Q=Q2*U*60
  179. 1710  C=FNS6(Q):IF C>900 AND ABS(A)>30 THEN PRINT BL$:GOTO 1870
  180. 1720  IF C=0 THEN T=0:RETURN
  181. 1730  'true course
  182. 1740  S=FNS8((P2+P4)/2):IF S>=1 THEN S=90-S ELSE S=FNS7(S)
  183. 1750  IF A>0 AND B1=0 THEN T=90:GOTO 1800
  184. 1760  IF A<0 AND B1=0 THEN T=270:GOTO 1800
  185. 1770  IF A>0 AND B1<0 THEN T=S:GOTO 1800
  186. 1780  IF A>=0 AND B1>0 THEN T=180-S:GOTO 1800
  187. 1790  IF A<0 AND B1>0 THEN T=180+S ELSE T=360-S
  188. 1800  T=FNS6(T):RETURN
  189. 1810  'map lc
  190. 1820  FOR L=1 TO LEN(X$):U$=MID$(X$,L,1)
  191. 1830  IF ASC(U$)>96 AND ASC(U$)<123 THEN MID$(X$,L,1)=CHR$(ASC(U$)-32)
  192. 1840  NEXT L:RETURN
  193. 1850  LOCATE MC+6,1):PRINT"BL$"DISTANCE EXCESSIVE..."
  194. 1860  PRINT"Press any key to continue...";:X$=INPUT$(1):GOTO 10
  195. 1870  LOCATE MC+6,1:PRINT SPC(79);:LOCATE ,1:PRINT "BL$"DISTANCE EXCESSIVE."
  196. 1880  PRINT"Possible course errors due to rhumb line."
  197. 1890  PRINT"Press any key to continue...";:X$=INPUT$(1):GOTO 10
  198. 1900  'condense
  199. 1910  IF MV>90 THEN 2020
  200. 1920  LOCATE 1,1:PRINT "Condensing list":PRINT MD
  201. 1930  NW=NW+1:OS=0:FOR J=1 TO MD
  202. 1940  IF PR(J)<3 THEN 2010
  203. 1950  IF PR(J)=3 THEN OS=OS+1:LOCATE 2,1:PRINT MD-OS;
  204. 1960  IF J+OS>MD THEN J=MD+1:GOTO 2010
  205. 1970  ID$(J)=ID$(J+OS):FA$(J)=FA$(J+OS):LT(J)=LT(J+OS):LN(J)=LN(J+OS)
  206. 1980  PR(J)=PR(J+OS):PR(J+OS)=4
  207. 1990  FOR K=1 TO MC:IF J+OS=W(K) THEN W(K)=J
  208. 2000  NEXT K:GOTO 1940
  209. 2010  NEXT J:MD=MD-OS:LOCATE 1,1:PRINT SPACE$(16)
  210. 2020  RETURN
  211. 2030  MD=(MX+MN)\2:GET #1,MD:IF EOF(1) THEN MX=MD ELSE MN=MD
  212. 2040  IF MX>MN+1 THEN 2030 ELSE MD=MN:RETURN
  213. 4000  '     install erase-to-end-of-screen  subroutine
  214. 4010  DEF SEG=&H1700
  215. 4020  FOR ADDR% = 0 TO 19
  216. 4030  READ CODE%
  217. 4040  POKE ADDR%,CODE%
  218. 4050  NEXT
  219. 4060  CLREOS% = 0
  220. 4070  RETURN
  221. 4080  DATA &h55,&h8b,&hec,&h8b,&h76,&h06,&h8b,&h0c
  222. 4090  DATA &hb8,&h20,&h0a,&hb7,&h00
  223. 4100  DATA &hcd,&h10
  224. 4110  DATA &h5d,&hca,&h02,&h00,&h00
  225. 5000  '    erase to end-of-screen
  226. 5010  CLINE = CSRLIN                            'remember cursor position
  227. 5020  CROW  = POS(0)
  228. 5030  NUMCHR% = 1919 - ((CLINE - 1)*80 +CROW)   'num chars to write
  229. 5040  CALL CLREOS%(NUMCHR%)                     'erase to end of screen
  230. 5050  LOCATE CLINE,CROW,1                       'restore cursor
  231. 5060  RETURN
  232. 6000  ' error trap
  233. 6010  IF ERR=53 AND ERL=44 THEN CLOSE:RESUME 50 
  234. 6020  ON ERROR GOTO 0
  235.