10 ' AUTONAV.BAS   Automatic Route Selection Program   22-Jan-82  Rev 6/11/82
20 ' (c) Copyright 1982 Alan Bose
30 ' CP/M modifications (c) 1982 by Glen Hassebrock, Jr.
40 CLEAR:WIDTH 255:DEFINT I-J
50 BL$=CHR$(7):E$=CHR$(27):ER$=E$+"E":PG$=E$+"p":QG$=E$+"q":Y$=E$+"Y":L$=E$+"K"
60 J$=E$+"j":K$=E$+"k":J1$=E$+"k":J1$=E$+"J":U=57.29577950000003#
70 DEF FNC$(X1,X2)=Y$+CHR$(X1+31)+CHR$(X2+31):H$=FNC$(2,1)
80 DEF FND$(X3)=FNC$(X3 MOD 20+2,(X3\20)*15+1)
90 DEF FNS6(X)=INT(X*10+.5)/10
100 DEF FNS7(X)=ATN(X/SQR(1-X*X))*U
110 DEF FNS8(X)=SIN(ABS(A/2)/U)*COS(X/U)/SIN(Q2/2)
120 PRINT FNC$(25,1)ER$E$"H"ER$"Standby one";:MX=32767:MN=0
130 '
140 OPEN"R",1,"B:AIRPORTS.RND",255:GOSUB 2030:PRINT "...":MD=MD*5
150 DIM ID$(MD),FA$(MD),LT(MD),LN(MD),PR(MD),W(25),D(25),H(25)
160 FOR J=1 TO MD:REC=((J-1)\5)+1:SS=(J-1) MOD 5
170 IF LOC(1)<>REC THEN GET#1,REC
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$
190 ID$(J)=ID$:FA$(J)=FAC$:D6=CVI(D1$):M6=CVS(M1$):D5=CVI(D$):M5=CVS(M$)
200 IF ASC(ID$(J))=0 THEN ID$(J)=SPACE$(5)
210 IF ID$(J)=SPACE$(5) THEN PR(J)=3
220 M1=M6/60:LT(J)=D6+M1:M=M5/60:LN(J)=D5+M:NEXT J
230 '
240 PRINT ER$FNC$(1,20)"NAVPROGseven Automatic Route Preparation"
250 PRINT FNC$(7,1)J1$"Enter departure point  <MENU>  "J$STRING$(5,95)K$;
260 LINE INPUT X$:IF X$="" THEN CLOSE:RUN"MENU"
270 I=1:GOSUB 1810:GOSUB 1440:IF FD=0 THEN 250
280 P2=LT(W(1)):P1=LN(W(1)):PR(PI)=2:XT=P2:NT=P2:XN=P1:NN=P1
290 '
300 PRINT FNC$(7,1)J1$"Enter destination  <EXIT>  "J$STRING$(5,95)K$;
310 LINE INPUT X$:IF X$="" THEN 250
320 MC=3:I=3:GOSUB 1810:GOSUB 1440:IF FD=0 THEN 300
330 P4=LT(W(3)):P3=LN(W(3)):PR(PI)=2:GOSUB 1670:PH=T:TD=C
335 IF TD>30 THEN 380
340 PRINT FNC$(7,1)J1$"That's a lot of work for a"INT(TD)"mile flight.  ";
350 PRINT "Continue? (Y or N) ";:X$=INPUT$(1):GOSUB 1810:PRINT X$
360 IF X$="N" THEN 240 ELSE IF X$<>"Y" THEN PRINT BL$:GOTO 340
370 '
380 PRINT FNC$(7,1)J1$"Enter specific checkpoint to overfly, if desired  ";
390 PRINT"<CONTINUE> "J$STRING$(5,95)K$;:LINE INPUT X$
400 IF X$="" THEN W(2)=W(3):W(3)=0:MC=2:NW=0:GOTO 470
410 I=2:GOSUB 1810:GOSUB 1440:IF FD=0 THEN 380
420 PRINT FNC$(7,1)BL$L$"90 degree course change doubles time needed to ";
430 PRINT"calculate."
440 P2=LT(W(2)):P1=LN(W(2)):PR(PI)=2:NW=1
450 GOSUB 1670:TD=C:DH=ABS(PH-T):IF DH>180 THEN DH=360-DH
460 P4=LT(W(1)):P3=LN(W(1)):GOSUB 1670:TD=TD+C
470 MV=30+DH:I=5:PRINT FNC$(7,1)L$;
480 PRINT FNC$(I+2,1)J1$:PRINT"Enter checkpoint to be disregarded, if desired";
490 PRINT"  <CONTINUE> "J$STRING$(5,95)K$;:LINE INPUT X$
500 IF X$="" THEN 530
510 GOSUB 1810:GOSUB 1440:IF FD=0 THEN 480
520 I=I+1:PR(PI)=3:PRINT"  WILL BE IGNORED":GOTO 480
530 PRINT FNC$(I+3,1)J1$"Correct? (Y or N) ";:X$=INPUT$(1):GOSUB 1810:PRINT X$
540 IF X$="N" THEN 240 ELSE IF X$<>"Y" THEN PRINT BL$:GOTO 530
550 PRINT FNC$(7,1)J1$"VOR to VOR only? (Y or N) ";:X$=INPUT$(1):GOSUB 1810
560 PRINT X$:IF X$="N" THEN VN=1 ELSE IF X$<>"Y" THEN PRINT BL$:GOTO 550
570 PRINT FNC$(7,1)J1$
580 '
590 FOR J=1 TO MC
600 IF LT(W(J))>XT THEN XT=LT(W(J)):GOTO 620
610 IF LT(W(J))<NT THEN NT=LT(W(J))
620 IF LN(W(J))>XN THEN XN=LN(W(J)):GOTO 640
630 IF LN(W(J))<NN THEN NN=LN(W(J))
640 NEXT J:XT=XT+3:NT=NT-.5:XN=XN+1:NN=NN-1:FOR J=1 TO MD
650 IF VN=1 THEN 680
660 IF J=W(1) OR J=W(2) OR J=W(3) THEN 730
670 IF INSTR(FA$(J),"V")=0 THEN PR(J)=3:GOTO 730
680 IF LT(J)>XT THEN 720
690 IF LT(J)<NT THEN 720
700 IF LN(J)>XN THEN 720
710 IF LN(J)>=NN THEN 730
720 PR(J)=3
730 NEXT J
740 CLOSE:GOSUB 1670:PRINT"Please align printer paper and then press <RETURN>.";
750 LINE INPUT X$:ML=INT(TD/2):IF ML<30 THEN ML=30
760 GOSUB 2060:LPRINT "NAVPROGseven Automatic Route Preparation"TAB(60)TM$" "DT$
770 LPRINT:LPRINT:LPRINT"Depart: "ID$(W(1))"    Dest: "ID$(W(MC))
780 LPRINT"Great circle dist: "TD"nm":LPRINT:LPRINT TAB(16)"nm"TAB(25)"TC"
790 PRINT H$J1$:PRINT TAB(40)"Depart: "ID$(W(1))"    Dest: "ID$(W(MC))
800 PRINT TAB(40)"Great circle dist: "TD"nm"TAB(40)"Test Segment:"ML"nm"
810 FOR J=0 TO MD:IF PR(J)=1 THEN PR(J)=0
820 NEXT J
830 '
840 CY=1:NE=0:FOR J=1 TO MC:PRINT FND$(J);J;FNC$(J MOD 20+2,(J\20)*15+5);
850 PRINT ID$(W(J))" "FA$(W(J)):NEXT J
860 P2=LT(W(CY)):P1=LN(W(CY)):P4=LT(W(CY+1)):P3=LN(W(CY+1))
870 IF PR(W(CY))=0 THEN PR(W(CY))=1
880 PRINT FND$(CY)PG$CY;QG$:GOSUB 1670:PH=T:SH=T:PD=C:BD=C:BH=360:BP=0:DD=2*C
890 IF C<ML THEN D(CY)=BD:H(CY)=INT(SH):GOTO 1190
900 '
910 FOR J=1 TO MD:PRINT FNC$(1,1)ID$(J):IF PR(J)>0 THEN 1130
920 P4=LT(J):P3=LN(J):IF P1=P3 AND P2=P4 THEN 1130
930 GOSUB 1670:IF C>TD THEN PR(J)=3:GOTO 1130
940 IF C>PD OR (ML>60 AND C>PD*.66) THEN 1130
950 C1=C:T1=T:RD=C:DH=ABS(PH-T):IF DH>180 THEN DH=360-DH
960 IF NW=0 AND CY=1 AND INSTR(FA$(J),"V")=0 AND DH>10 THEN 990
970 IF DH<=30 THEN 1010
980 IF DH<=MV THEN 1130
990 IF CY=1 OR DH<=90 THEN PR(J)=3:GOTO 1130
1000 PR(J)=1:GOTO 1130
1010 P2=P4:P1=P3:P4=LT(W(CY+1)):P3=LN(W(CY+1))
1020 GOSUB 1670:T2=T:C2=C:RD=RD+C:P2=LT(W(CY)):P1=LN(W(CY))
1030 IF RD>DD THEN 1130
1040 DH=ABS(PH-T):IF DH>180 THEN DH=360-DH
1050 IF DH<30 THEN 1080
1060 IF ML<30 AND CY+1=MC AND DH<45 AND C<14 THEN 1080
1070 IF ML>=30 OR CY+1<>MC OR DH>60 OR C>7 THEN 1130
1080 BP=J:DD=RD:NE=1
1090 SH=T1:BD=C1:S2=T2:B2=C2::BP$=ID$(BP):PRINT FND$(CY+1)CY+1;
1100 PRINT FNC$((CY+1)MOD 20+2,((CY+1)\20)*15+5)PG$BP$QG$" "FA$(BP)
1110 FOR K=CY+1 TO MC:PRINT FND$(K+1);K+1;FNC$((K+1)MOD 20+2,((K+1)\20)*15+5);
1120 PRINT ID$(W(K))" "FA$(W(K)):NEXT K
1130 NEXT J:PRINT FNC$(1,1)SPACE$(9)
1140 '
1150 IF BP<=0 THEN 1190
1160 FOR J=MC TO CY+1 STEP -1:W(J+1)=W(J):D(J+1)=D(J):H(J+1)=H(J)
1170 NEXT J:W(CY+1)=BP:PR(BP)=2:D(CY)=BD:D(CY+1)=B2:H(CY)=INT(SH)
1180 H(CY+1)=INT(S2):MC=MC+1:GOTO 1200
1190 IF BP=0 THEN D(CY)=BD:H(CY)=INT(SH):GOTO 1210
1200 P2=LT(BP):P1=LN(BP)
1210 PRINT FND$(CY)CY
1220 IF BP>0 THEN CY=CY+2 ELSE CY=CY+1:GOTO 1280
1230 IF BD<ML*.33 THEN CY=CY-1
1240 IF B2<ML*.33 THEN CY=CY-2
1250 IF BP<=0 THEN 1280
1260 FOR J=1 TO MC:PRINT FND$(J)J;FNC$(J MOD 20+2,(J\20)*15+5)ID$(W(J))" ";
1270 PRINT FA$(W(J));:NEXT J
1280 IF CY<MC THEN 860
1290 IF NE=0 AND NW>3 AND ML>60 THEN 1400
1300 IF NE=0 AND NW>1 THEN 1380
1310 TM=0:LPRINT:LPRINT:FOR J=1 TO MC:LPRINT J;TAB(5)ID$(W(J))" ";
1320 LPRINT FA$(W(J));:IF J=MC THEN 1350
1330 LPRINT TAB(14);USING"####.#";D(J);
1340 LPRINT TAB(24);USING"###";H(J)
1350 TM=TM+D(J):NEXT J:LPRINT:LPRINT TAB(14)STRING$(6,45)
1360 LPRINT TAB(14);USING"####.#";TM
1370 IF MC>10 THEN LPRINT"Select up to 10 checkpoints for navigation"
1380 ML=INT(ML*.5)
1390 IF ML>=15 THEN GOSUB 1900:IF MD>MC THEN 790
1400 CLOSE:LPRINT CHR$(12)
1410 PRINT FNC$(3,1)J1$"Return to menu? (Y or N) ";:X$=INPUT$(1)
1420 GOSUB 1810:PRINT X$:IF X$="Y" THEN RUN"MENU"
1430 IF X$="N" THEN 10 ELSE PRINT BL$:GOTO 1410
1440 'search index for match & get
1450 P$=X$+SPACE$(5-LEN(X$)):RO=I+2:FD=0
1460 FOR J=1 TO MD:IF ID$(J)<>P$ THEN 1520
1470 IF FD=1 THEN RO=15:GET#1,REC:PRINT FNC$(15,1)J1$:GOSUB 1630:RO=16:FD=2
1480 PI=J
1490 IF FD<=1 THEN 1510
1500 REC=((J-1)\5)+1:SS=(J-1) MOD 5:GET#1,REC:GOSUB 1630:FD=FD+1:RO=RO+1
1510 IF FD=0 THEN FD=1:REC=((J-1)\5)+1:SS=(J-1) MOD 5:GET#1,REC
1520 NEXT J
1530 IF FD<>0 THEN 1560
1540 PRINT BL$"Can't find "P$:PRINT"Return to menu and input data? (Y or N) ";
1550 X$=INPUT$(1):GOSUB 1810:PRINT X$:IF X$="Y" THEN CLOSE:RUN"MENU" ELSE RETURN
1560 IF FD=1 THEN 1600
1570 PRINT FNC$(RO+1,1)"Enter number of your choice <"PI"> "J$STRING$(3,95);
1580 PRINT K$;:LINE INPUT X$:IF X$="" THEN 1600
1590 PI=VAL(X$):REC=((PI-1)\5)+1:SS=(PI-1) MOD 5:GET#1,REC
1600 PRINT FNC$(15,1)J1$:RO=I+2:GOSUB 1630:IF I<4 THEN W(I)=PI
1610 RETURN
1620 '
1630 'decode & display
1640 FIELD#1,SS*50 AS DU$,5 AS ID$,2 AS FAC$,4 AS DU$,20 AS NM$
1650 PRINT FNC$(RO,1)L$;:IF RO>14 THEN PRINT PI;
1660 PRINT FNC$(RO,7)ID$FNC$(RO,13)FAC$FNC$(RO,24)NM$:RETURN
1670 'distance
1680 A=P1-P3:B1=P2-P4:P#=COS(P2/U)*COS(P4/U)
1690 Q=P#*COS(ABS(A)/U)+COS(ABS(B1)/U)-P#:IF Q<=0 THEN PRINT BL$:GOTO 1850
1700 Q2=ATN(SQR(1-Q*Q)/Q):Q=Q2*U*60
1710 C=FNS6(Q):IF C>900 AND ABS(A)>30 THEN PRINT BL$:GOTO 1870
1720 IF C=0 THEN T=0:RETURN
1730 'true course
1740 S=FNS8((P2+P4)/2):IF S>=1 THEN S=90-S ELSE S=FNS7(S)
1750 IF A>0 AND B1=0 THEN T=90:GOTO 1800
1760 IF A<0 AND B1=0 THEN T=270:GOTO 1800
1770 IF A>0 AND B1<0 THEN T=S:GOTO 1800
1780 IF A>=0 AND B1>0 THEN T=180-S:GOTO 1800
1790 IF A<0 AND B1>0 THEN T=180+S ELSE T=360-S
1800 T=FNS6(T):RETURN
1810 'map lc
1820 FOR L=1 TO LEN(X$):U$=MID$(X$,L,1)
1830 IF ASC(U$)>96 AND ASC(U$)<123 THEN MID$(X$,L,1)=CHR$(ASC(U$)-32)
1840 NEXT L:RETURN
1850 PRINT FNC$(MC+6,1)E$"y4"BL$"Distance excessive..."
1860 PRINT"Press any key to continue...";:X$=INPUT$(1):GOTO 10
1870 PRINT FNC$(MC+6,1)E$"y4"BL$"Distance excessive."
1880 PRINT"Possible course errors due to rhumb line."
1890 PRINT"Press any key to continue...";:X$=INPUT$(1):GOTO 10
1900 'condense
1910 IF MV>90 THEN 2020
1920 PRINT FNC$(1,1)"Condensing files":PRINT MD
1930 NW=NW+1:OS=0:FOR J=1 TO MD
1940 IF PR(J)<3 THEN 2010
1950 IF PR(J)=3 THEN OS=OS+1:PRINT FNC$(2,1)MD-OS;L$
1960 IF J+OS>MD THEN J=MD+1:GOTO 2010
1970 ID$(J)=ID$(J+OS):FA$(J)=FA$(J+OS):LT(J)=LT(J+OS):LN(J)=LN(J+OS)
1980 PR(J)=PR(J+OS):PR(J+OS)=4
1990 FOR K=1 TO MC:IF J+OS=W(K) THEN W(K)=J
2000 NEXT K:GOTO 1940
2010 NEXT J:MD=MD-OS:PRINT FNC$(1,1)SPACE$(16):PRINT L$
2020 RETURN
2030 MD=(MX+MN)\2:GET #1,MD:IF EOF(1) THEN MX=MD ELSE MN=MD
2040 IF MX>MN+1 THEN 2030 ELSE MD=MN:RETURN
2050 ' date and time subroutines
2060 DT$="" ' :A=-2508:CALL A:FOR A=-2605 TO -2597:DT$=DT$+CHR$(PEEK(A)):NEXT A
2070 TM$="" ' :FOR A=-2596 TO -2589:TM$=TM$+CHR$(PEEK(A)):NEXT A:RETURN
2080 RETURN