home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / basic / navprog7.lbr / AUTONAV.BZS / AUTONAV.BAS
Encoding:
BASIC Source File  |  1987-02-15  |  9.5 KB  |  211 lines
  1. 10 ' AUTONAV.BAS   Automatic Route Selection Program   22-Jan-82  Rev 6/11/82
  2. 20 ' (c) Copyright 1982 Alan Bose
  3. 30 ' CP/M modifications (c) 1982 by Glen Hassebrock, Jr.
  4. 40 CLEAR:WIDTH 255:DEFINT I-J
  5. 50 BL$=CHR$(7):E$=CHR$(27):ER$=E$+"E":PG$=E$+"p":QG$=E$+"q":Y$=E$+"Y":L$=E$+"K"
  6. 60 J$=E$+"j":K$=E$+"k":J1$=E$+"k":J1$=E$+"J":U=57.29577950000003#
  7. 70 DEF FNC$(X1,X2)=Y$+CHR$(X1+31)+CHR$(X2+31):H$=FNC$(2,1)
  8. 80 DEF FND$(X3)=FNC$(X3 MOD 20+2,(X3\20)*15+1)
  9. 90 DEF FNS6(X)=INT(X*10+.5)/10
  10. 100 DEF FNS7(X)=ATN(X/SQR(1-X*X))*U
  11. 110 DEF FNS8(X)=SIN(ABS(A/2)/U)*COS(X/U)/SIN(Q2/2)
  12. 120 PRINT FNC$(25,1)ER$E$"H"ER$"Standby one";:MX=32767:MN=0
  13. 130 '
  14. 140 OPEN"R",1,"B:AIRPORTS.RND",255:GOSUB 2030:PRINT "...":MD=MD*5
  15. 150 DIM ID$(MD),FA$(MD),LT(MD),LN(MD),PR(MD),W(25),D(25),H(25)
  16. 160 FOR J=1 TO MD:REC=((J-1)\5)+1:SS=(J-1) MOD 5
  17. 170 IF LOC(1)<>REC THEN GET#1,REC
  18. 180 FIELD#1,SS*50 AS DU$,5 AS ID$,2 AS FAC$,24 AS DU$,2 AS D1$,4 AS M1$,
  19.  
  20. 2 AS D$,4 AS M$
  21. 190 ID$(J)=ID$:FA$(J)=FAC$:D6=CVI(D1$):M6=CVS(M1$):D5=CVI(D$):M5=CVS(M$)
  22. 200 IF ASC(ID$(J))=0 THEN ID$(J)=SPACE$(5)
  23. 210 IF ID$(J)=SPACE$(5) THEN PR(J)=3
  24. 220 M1=M6/60:LT(J)=D6+M1:M=M5/60:LN(J)=D5+M:NEXT J
  25. 230 '
  26. 240 PRINT ER$FNC$(1,20)"NAVPROGseven Automatic Route Preparation"
  27. 250 PRINT FNC$(7,1)J1$"Enter departure point  <MENU>  "J$STRING$(5,95)K$;
  28. 260 LINE INPUT X$:IF X$="" THEN CLOSE:RUN"MENU"
  29. 270 I=1:GOSUB 1810:GOSUB 1440:IF FD=0 THEN 250
  30. 280 P2=LT(W(1)):P1=LN(W(1)):PR(PI)=2:XT=P2:NT=P2:XN=P1:NN=P1
  31. 290 '
  32. 300 PRINT FNC$(7,1)J1$"Enter destination  <EXIT>  "J$STRING$(5,95)K$;
  33. 310 LINE INPUT X$:IF X$="" THEN 250
  34. 320 MC=3:I=3:GOSUB 1810:GOSUB 1440:IF FD=0 THEN 300
  35. 330 P4=LT(W(3)):P3=LN(W(3)):PR(PI)=2:GOSUB 1670:PH=T:TD=C
  36. 335 IF TD>30 THEN 380
  37. 340 PRINT FNC$(7,1)J1$"That's a lot of work for a"INT(TD)"mile flight.  ";
  38. 350 PRINT "Continue? (Y or N) ";:X$=INPUT$(1):GOSUB 1810:PRINT X$
  39. 360 IF X$="N" THEN 240 ELSE IF X$<>"Y" THEN PRINT BL$:GOTO 340
  40. 370 '
  41. 380 PRINT FNC$(7,1)J1$"Enter specific checkpoint to overfly, if desired  ";
  42. 390 PRINT"<CONTINUE> "J$STRING$(5,95)K$;:LINE INPUT X$
  43. 400 IF X$="" THEN W(2)=W(3):W(3)=0:MC=2:NW=0:GOTO 470
  44. 410 I=2:GOSUB 1810:GOSUB 1440:IF FD=0 THEN 380
  45. 420 PRINT FNC$(7,1)BL$L$"90 degree course change doubles time needed to ";
  46. 430 PRINT"calculate."
  47. 440 P2=LT(W(2)):P1=LN(W(2)):PR(PI)=2:NW=1
  48. 450 GOSUB 1670:TD=C:DH=ABS(PH-T):IF DH>180 THEN DH=360-DH
  49. 460 P4=LT(W(1)):P3=LN(W(1)):GOSUB 1670:TD=TD+C
  50. 470 MV=30+DH:I=5:PRINT FNC$(7,1)L$;
  51. 480 PRINT FNC$(I+2,1)J1$:PRINT"Enter checkpoint to be disregarded, if desired";
  52. 490 PRINT"  <CONTINUE> "J$STRING$(5,95)K$;:LINE INPUT X$
  53. 500 IF X$="" THEN 530
  54. 510 GOSUB 1810:GOSUB 1440:IF FD=0 THEN 480
  55. 520 I=I+1:PR(PI)=3:PRINT"  WILL BE IGNORED":GOTO 480
  56. 530 PRINT FNC$(I+3,1)J1$"Correct? (Y or N) ";:X$=INPUT$(1):GOSUB 1810:PRINT X$
  57. 540 IF X$="N" THEN 240 ELSE IF X$<>"Y" THEN PRINT BL$:GOTO 530
  58. 550 PRINT FNC$(7,1)J1$"VOR to VOR only? (Y or N) ";:X$=INPUT$(1):GOSUB 1810
  59. 560 PRINT X$:IF X$="N" THEN VN=1 ELSE IF X$<>"Y" THEN PRINT BL$:GOTO 550
  60. 570 PRINT FNC$(7,1)J1$
  61. 580 '
  62. 590 FOR J=1 TO MC
  63. 600 IF LT(W(J))>XT THEN XT=LT(W(J)):GOTO 620
  64. 610 IF LT(W(J))<NT THEN NT=LT(W(J))
  65. 620 IF LN(W(J))>XN THEN XN=LN(W(J)):GOTO 640
  66. 630 IF LN(W(J))<NN THEN NN=LN(W(J))
  67. 640 NEXT J:XT=XT+3:NT=NT-.5:XN=XN+1:NN=NN-1:FOR J=1 TO MD
  68. 650 IF VN=1 THEN 680
  69. 660 IF J=W(1) OR J=W(2) OR J=W(3) THEN 730
  70. 670 IF INSTR(FA$(J),"V")=0 THEN PR(J)=3:GOTO 730
  71. 680 IF LT(J)>XT THEN 720
  72. 690 IF LT(J)<NT THEN 720
  73. 700 IF LN(J)>XN THEN 720
  74. 710 IF LN(J)>=NN THEN 730
  75. 720 PR(J)=3
  76. 730 NEXT J
  77. 740 CLOSE:GOSUB 1670:PRINT"Please align printer paper and then press <RETURN>.";
  78. 750 LINE INPUT X$:ML=INT(TD/2):IF ML<30 THEN ML=30
  79. 760 GOSUB 2060:LPRINT "NAVPROGseven Automatic Route Preparation"TAB(60)TM$" "DT$
  80. 770 LPRINT:LPRINT:LPRINT"Depart: "ID$(W(1))"    Dest: "ID$(W(MC))
  81. 780 LPRINT"Great circle dist: "TD"nm":LPRINT:LPRINT TAB(16)"nm"TAB(25)"TC"
  82. 790 PRINT H$J1$:PRINT TAB(40)"Depart: "ID$(W(1))"    Dest: "ID$(W(MC))
  83. 800 PRINT TAB(40)"Great circle dist: "TD"nm"TAB(40)"Test Segment:"ML"nm"
  84. 810 FOR J=0 TO MD:IF PR(J)=1 THEN PR(J)=0
  85. 820 NEXT J
  86. 830 '
  87. 840 CY=1:NE=0:FOR J=1 TO MC:PRINT FND$(J);J;FNC$(J MOD 20+2,(J\20)*15+5);
  88. 850 PRINT ID$(W(J))" "FA$(W(J)):NEXT J
  89. 860 P2=LT(W(CY)):P1=LN(W(CY)):P4=LT(W(CY+1)):P3=LN(W(CY+1))
  90. 870 IF PR(W(CY))=0 THEN PR(W(CY))=1
  91. 880 PRINT FND$(CY)PG$CY;QG$:GOSUB 1670:PH=T:SH=T:PD=C:BD=C:BH=360:BP=0:DD=2*C
  92. 890 IF C<ML THEN D(CY)=BD:H(CY)=INT(SH):GOTO 1190
  93. 900 '
  94. 910 FOR J=1 TO MD:PRINT FNC$(1,1)ID$(J):IF PR(J)>0 THEN 1130
  95. 920 P4=LT(J):P3=LN(J):IF P1=P3 AND P2=P4 THEN 1130
  96. 930 GOSUB 1670:IF C>TD THEN PR(J)=3:GOTO 1130
  97. 940 IF C>PD OR (ML>60 AND C>PD*.66) THEN 1130
  98. 950 C1=C:T1=T:RD=C:DH=ABS(PH-T):IF DH>180 THEN DH=360-DH
  99. 960 IF NW=0 AND CY=1 AND INSTR(FA$(J),"V")=0 AND DH>10 THEN 990
  100. 970 IF DH<=30 THEN 1010
  101. 980 IF DH<=MV THEN 1130
  102. 990 IF CY=1 OR DH<=90 THEN PR(J)=3:GOTO 1130
  103. 1000 PR(J)=1:GOTO 1130
  104. 1010 P2=P4:P1=P3:P4=LT(W(CY+1)):P3=LN(W(CY+1))
  105. 1020 GOSUB 1670:T2=T:C2=C:RD=RD+C:P2=LT(W(CY)):P1=LN(W(CY))
  106. 1030 IF RD>DD THEN 1130
  107. 1040 DH=ABS(PH-T):IF DH>180 THEN DH=360-DH
  108. 1050 IF DH<30 THEN 1080
  109. 1060 IF ML<30 AND CY+1=MC AND DH<45 AND C<14 THEN 1080
  110. 1070 IF ML>=30 OR CY+1<>MC OR DH>60 OR C>7 THEN 1130
  111. 1080 BP=J:DD=RD:NE=1
  112. 1090 SH=T1:BD=C1:S2=T2:B2=C2::BP$=ID$(BP):PRINT FND$(CY+1)CY+1;
  113. 1100 PRINT FNC$((CY+1)MOD 20+2,((CY+1)\20)*15+5)PG$BP$QG$" "FA$(BP)
  114. 1110 FOR K=CY+1 TO MC:PRINT FND$(K+1);K+1;FNC$((K+1)MOD 20+2,((K+1)\20)*15+5);
  115. 1120 PRINT ID$(W(K))" "FA$(W(K)):NEXT K
  116. 1130 NEXT J:PRINT FNC$(1,1)SPACE$(9)
  117. 1140 '
  118. 1150 IF BP<=0 THEN 1190
  119. 1160 FOR J=MC TO CY+1 STEP -1:W(J+1)=W(J):D(J+1)=D(J):H(J+1)=H(J)
  120. 1170 NEXT J:W(CY+1)=BP:PR(BP)=2:D(CY)=BD:D(CY+1)=B2:H(CY)=INT(SH)
  121. 1180 H(CY+1)=INT(S2):MC=MC+1:GOTO 1200
  122. 1190 IF BP=0 THEN D(CY)=BD:H(CY)=INT(SH):GOTO 1210
  123. 1200 P2=LT(BP):P1=LN(BP)
  124. 1210 PRINT FND$(CY)CY
  125. 1220 IF BP>0 THEN CY=CY+2 ELSE CY=CY+1:GOTO 1280
  126. 1230 IF BD<ML*.33 THEN CY=CY-1
  127. 1240 IF B2<ML*.33 THEN CY=CY-2
  128. 1250 IF BP<=0 THEN 1280
  129. 1260 FOR J=1 TO MC:PRINT FND$(J)J;FNC$(J MOD 20+2,(J\20)*15+5)ID$(W(J))" ";
  130. 1270 PRINT FA$(W(J));:NEXT J
  131. 1280 IF CY<MC THEN 860
  132. 1290 IF NE=0 AND NW>3 AND ML>60 THEN 1400
  133. 1300 IF NE=0 AND NW>1 THEN 1380
  134. 1310 TM=0:LPRINT:LPRINT:FOR J=1 TO MC:LPRINT J;TAB(5)ID$(W(J))" ";
  135. 1320 LPRINT FA$(W(J));:IF J=MC THEN 1350
  136. 1330 LPRINT TAB(14);USING"####.#";D(J);
  137. 1340 LPRINT TAB(24);USING"###";H(J)
  138. 1350 TM=TM+D(J):NEXT J:LPRINT:LPRINT TAB(14)STRING$(6,45)
  139. 1360 LPRINT TAB(14);USING"####.#";TM
  140. 1370 IF MC>10 THEN LPRINT"Select up to 10 checkpoints for navigation"
  141. 1380 ML=INT(ML*.5)
  142. 1390 IF ML>=15 THEN GOSUB 1900:IF MD>MC THEN 790
  143. 1400 CLOSE:LPRINT CHR$(12)
  144. 1410 PRINT FNC$(3,1)J1$"Return to menu? (Y or N) ";:X$=INPUT$(1)
  145. 1420 GOSUB 1810:PRINT X$:IF X$="Y" THEN RUN"MENU"
  146. 1430 IF X$="N" THEN 10 ELSE PRINT BL$:GOTO 1410
  147. 1440 'search index for match & get
  148. 1450 P$=X$+SPACE$(5-LEN(X$)):RO=I+2:FD=0
  149. 1460 FOR J=1 TO MD:IF ID$(J)<>P$ THEN 1520
  150. 1470 IF FD=1 THEN RO=15:GET#1,REC:PRINT FNC$(15,1)J1$:GOSUB 1630:RO=16:FD=2
  151. 1480 PI=J
  152. 1490 IF FD<=1 THEN 1510
  153. 1500 REC=((J-1)\5)+1:SS=(J-1) MOD 5:GET#1,REC:GOSUB 1630:FD=FD+1:RO=RO+1
  154. 1510 IF FD=0 THEN FD=1:REC=((J-1)\5)+1:SS=(J-1) MOD 5:GET#1,REC
  155. 1520 NEXT J
  156. 1530 IF FD<>0 THEN 1560
  157. 1540 PRINT BL$"Can't find "P$:PRINT"Return to menu and input data? (Y or N) ";
  158. 1550 X$=INPUT$(1):GOSUB 1810:PRINT X$:IF X$="Y" THEN CLOSE:RUN"MENU" ELSE RETURN
  159. 1560 IF FD=1 THEN 1600
  160. 1570 PRINT FNC$(RO+1,1)"Enter number of your choice <"PI"> "J$STRING$(3,95);
  161. 1580 PRINT K$;:LINE INPUT X$:IF X$="" THEN 1600
  162. 1590 PI=VAL(X$):REC=((PI-1)\5)+1:SS=(PI-1) MOD 5:GET#1,REC
  163. 1600 PRINT FNC$(15,1)J1$:RO=I+2:GOSUB 1630:IF I<4 THEN W(I)=PI
  164. 1610 RETURN
  165. 1620 '
  166. 1630 'decode & display
  167. 1640 FIELD#1,SS*50 AS DU$,5 AS ID$,2 AS FAC$,4 AS DU$,20 AS NM$
  168. 1650 PRINT FNC$(RO,1)L$;:IF RO>14 THEN PRINT PI;
  169. 1660 PRINT FNC$(RO,7)ID$FNC$(RO,13)FAC$FNC$(RO,24)NM$:RETURN
  170. 1670 'distance
  171. 1680 A=P1-P3:B1=P2-P4:P#=COS(P2/U)*COS(P4/U)
  172. 1690 Q=P#*COS(ABS(A)/U)+COS(ABS(B1)/U)-P#:IF Q<=0 THEN PRINT BL$:GOTO 1850
  173. 1700 Q2=ATN(SQR(1-Q*Q)/Q):Q=Q2*U*60
  174. 1710 C=FNS6(Q):IF C>900 AND ABS(A)>30 THEN PRINT BL$:GOTO 1870
  175. 1720 IF C=0 THEN T=0:RETURN
  176. 1730 'true course
  177. 1740 S=FNS8((P2+P4)/2):IF S>=1 THEN S=90-S ELSE S=FNS7(S)
  178. 1750 IF A>0 AND B1=0 THEN T=90:GOTO 1800
  179. 1760 IF A<0 AND B1=0 THEN T=270:GOTO 1800
  180. 1770 IF A>0 AND B1<0 THEN T=S:GOTO 1800
  181. 1780 IF A>=0 AND B1>0 THEN T=180-S:GOTO 1800
  182. 1790 IF A<0 AND B1>0 THEN T=180+S ELSE T=360-S
  183. 1800 T=FNS6(T):RETURN
  184. 1810 'map lc
  185. 1820 FOR L=1 TO LEN(X$):U$=MID$(X$,L,1)
  186. 1830 IF ASC(U$)>96 AND ASC(U$)<123 THEN MID$(X$,L,1)=CHR$(ASC(U$)-32)
  187. 1840 NEXT L:RETURN
  188. 1850 PRINT FNC$(MC+6,1)E$"y4"BL$"Distance excessive..."
  189. 1860 PRINT"Press any key to continue...";:X$=INPUT$(1):GOTO 10
  190. 1870 PRINT FNC$(MC+6,1)E$"y4"BL$"Distance excessive."
  191. 1880 PRINT"Possible course errors due to rhumb line."
  192. 1890 PRINT"Press any key to continue...";:X$=INPUT$(1):GOTO 10
  193. 1900 'condense
  194. 1910 IF MV>90 THEN 2020
  195. 1920 PRINT FNC$(1,1)"Condensing files":PRINT MD
  196. 1930 NW=NW+1:OS=0:FOR J=1 TO MD
  197. 1940 IF PR(J)<3 THEN 2010
  198. 1950 IF PR(J)=3 THEN OS=OS+1:PRINT FNC$(2,1)MD-OS;L$
  199. 1960 IF J+OS>MD THEN J=MD+1:GOTO 2010
  200. 1970 ID$(J)=ID$(J+OS):FA$(J)=FA$(J+OS):LT(J)=LT(J+OS):LN(J)=LN(J+OS)
  201. 1980 PR(J)=PR(J+OS):PR(J+OS)=4
  202. 1990 FOR K=1 TO MC:IF J+OS=W(K) THEN W(K)=J
  203. 2000 NEXT K:GOTO 1940
  204. 2010 NEXT J:MD=MD-OS:PRINT FNC$(1,1)SPACE$(16):PRINT L$
  205. 2020 RETURN
  206. 2030 MD=(MX+MN)\2:GET #1,MD:IF EOF(1) THEN MX=MD ELSE MN=MD
  207. 2040 IF MX>MN+1 THEN 2030 ELSE MD=MN:RETURN
  208. 2050 ' date and time subroutines
  209. 2060 DT$="" ' :A=-2508:CALL A:FOR A=-2605 TO -2597:DT$=DT$+CHR$(PEEK(A)):NEXT A
  210. 2070 TM$="" ' :FOR A=-2596 TO -2589:TM$=TM$+CHR$(PEEK(A)):NEXT A:RETURN
  211. 2080 RETURN
  212. 5 TO -2597:DT$=DT$+CHR$(PEEK(A)):