home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / basic / navprog7.lbr / AIRROUTE.BZS / AIRROUTE.BAS
Encoding:
BASIC Source File  |  1987-02-15  |  5.3 KB  |  115 lines
  1. 10 ' AIRROUTE.BAS   NAVPROGseven Route Program   22-Jan-82   Rev 2/10/83
  2. 20 '
  3. 30 ' (c) Copyright 1982 Alan Bose
  4. 40 ' President, Taildragger Flyers
  5. 50 ' Ross Field, Benton Harbor, MI
  6. 60 '
  7. 70 ' CP/M modifications (c) 1982 by Glen Hassebrock, Jr.
  8. 80 '
  9. 90 CLEAR:WIDTH 255:ON ERROR GOTO 1080:DEFINT I-J
  10. 100 BL$=CHR$(7):E$=CHR$(27):ER$=E$+"E":PG$=E$+"p":QG$=E$+"q":G$=E$+"F"
  11. 110 NG$=E$+"G":Y$=E$+"Y":L$=E$+"l":J$=E$+"j":K$=E$+"k":J1$=E$+"J"
  12. 120 DEF FNC$(C1,C2)=Y$+CHR$(C1+31)+CHR$(C2+31)
  13. 130 PRINT FNC$(25,1)ER$E$"H"ER$"Standby one";:MX=32767:MN=0
  14. 140 '
  15. 150 OPEN "R",1,"B:AIRPORTS.RND",255:GOSUB 1110:PRINT"..."
  16. 160 OPEN "R",2,"B:AIRINDEX.RND",255:MD=(MD*5)-1:DIM ID$(MD):FOR J=0 TO MD
  17. 170 REC=(J\51)+1:SS=J MOD 51:IF LOC(2)<>REC THEN GET#2,REC
  18. 180 FIELD #2,SS*5 AS DU$,5 AS ID$:ID$(J)=ID$:NEXT J:CLOSE#2:IM=MD
  19. 190 '
  20. 200 PRINT ER$FNC$(1,25)"NAVPROGseven Route Preparation"
  21. 210 PRINT FNC$(13,19)"Enter number of checkpoints (10 max.)  <MENU>  "J$;
  22. 220 PRINT STRING$(2,95)K$;:LINE INPUT N$:N=VAL(N$)
  23. 230 IF N$="" THEN CLOSE:RUN"MENU"
  24. 240 IF N<2 OR N>10 THEN PRINT BL$"2 to 10 checkpoints only":GOTO 210
  25. 250 'data box
  26. 260 PRINT FNC$(2,1)J1$:PRINT G$FNC$(3,6)"f";
  27. 270 FOR J=7 TO 74:PRINT "a";:NEXT J:PRINT "c":PRINT FNC$(4+N,6)"e";
  28. 280 FOR J=7 TO 74:PRINT "a";:NEXT J:PRINT "d"
  29. 290 PRINT FNC$(3,12)"s"FNC$(3,15)"s"FNC$(3,23)"s"FNC$(3,44)"s";
  30. 300 PRINT FNC$(3,52)"s"FNC$(3,61)"s"FNC$(3,69)"s"
  31. 310 PRINT FNC$(4+N,12)"u"FNC$(4+N,15)"u"FNC$(4+N,23)"u";
  32. 320 PRINT FNC$(4+N,44)"u"FNC$(4+N,52)"u"FNC$(4+N,61)"u"FNC$(4+N,69)"u"
  33. 330 FOR I=1 TO N:PRINT FNC$(3+I,6)"`"FNC$(3+I,12)"`"FNC$(3+I,15)"`";
  34. 340 PRINT FNC$(3+I,23)"`"FNC$(3+I,44)"`"FNC$(3+I,52)"`";
  35. 350 PRINT FNC$(3+I,61)"`"FNC$(3+I,69)"`"FNC$(3+I,75)"`";:NEXT I
  36. 360 PRINT NG$:PRINT FNC$(2,7)"Ident Fac Freq"FNC$(2,32)"Name"
  37. 370 PRINT FNC$(2,47)"Lat"FNC$(2,55)"Long"FNC$(2,64)"Var"FNC$(2,70)"Elev"
  38. 380 '
  39. 390 FOR I=1 TO N
  40. 400 PRINT FNC$(N+6,1)"Enter checkpoint"I"  <EXIT>  "J$;
  41. 410 PRINT STRING$(5,95)K$;:LINE INPUT X$:IF X$="" THEN 200
  42. 420 IF LEN(X$)>5 THEN PRINT BL$"5 characters maximum":GOTO 400
  43. 430 IF LEN(X$)<2 THEN PRINT BL$"2 characters minimium":GOTO 400
  44. 440 GOSUB 1040:P$=X$+SPACE$(5-LEN(X$))
  45. 450 'search index for match & get
  46. 460 RO=I+4
  47. 470 FD=0
  48. 480 FOR J=0 TO IM:IF ID$(J)<>P$ THEN 530
  49. 490 IF FD=1 THEN RO=N+8:GET #1,REC:PRINT FNC$(N+8,1)J1$:GOSUB 610:RO=N+9:FD=2
  50. 500 PI=J
  51. 510 IF FD>1 THEN REC=(J\5)+1:SS=J MOD 5:GET#1,REC:GOSUB 610:FD=FD+1:RO=RO+1
  52. 520 IF FD=0 THEN FD=1:REC=(J\5)+1:SS=J MOD 5:GET#1,REC
  53. 530 NEXT J
  54. 540 IF FD<>0 THEN 560
  55. 550 PRINT BL$"Can't find "P$:PRINT"Return to menu and input data?":GOTO 400
  56. 560 IF FD=1 THEN 600
  57. 570 PRINT FNC$(RO+1,1)"Enter number of your choice  <"PI">  "J$;
  58. 580 PRINT STRING$(3,95)K$;:LINE INPUT X$:IF X$="" THEN 600
  59. 590 PI=VAL(X$):REC=(PI\5)+1:SS=PI MOD 5:GET#1,REC
  60. 600 PRINT FNC$(N+6,1)J1$:RO=I+3:FD=0:GOSUB 610:NEXT I:GOTO 800
  61. 610 'decode & display
  62. 620 REF(I)=PI
  63. 630 FIELD #1,SS*50 AS DU$,5 AS ID$,2 AS FAC$,4 AS FR$,20 AS NM$,2 AS D1$,
  64.  
  65. 4 AS M1$,2 AS D$,4 AS M$,4 AS V$,1 AS V1$,2 AS EL$
  66. 640 F5=CVS(FR$):D6=CVI(D1$):M6=CVS(M1$):D5=CVI(D$):M5=CVS(M$):V5=CVS(V$)
  67. 650 E5=CVI(EL$):I$(I)=ID$:FC$(I)=FAC$:FR(I)=F5:P$(I)=NM$
  68. 660 M1=M6/60:P2(I)=D6+M1:M=M5/60:P1(I)=D5+M:V(I)=V5:V$(I)=V1$:EL(I)=E5
  69. 670 PRINT FNC$(RO,1);:IF FD=0 THEN PRINT I; ELSE PRINT PI;
  70. 680 PRINT FNC$(RO,7)ID$FNC$(RO,13)FAC$;FNC$(RO,16);
  71. 690 IF F5=0 THEN PRINT SPC(7);:GOTO 740
  72. 700 IF F5>136 THEN PRINT USING"####";F5;:GOTO 740
  73. 710 IF F5*10\1=F5*10/1 THEN PRINT USING"####.#";F5;:GOTO 740
  74. 720 IF F5*100\1=F5*100/1 THEN PRINT USING"####.##";F5;:GOTO 740
  75. 730 PRINT USING"###.###";F5;
  76. 740 PRINT FNC$(RO,24);NM$;FNC$(RO,45);USING"##";D6;
  77. 750 PRINT FNC$(RO,48);USING"##.#";M6;
  78. 760 PRINT FNC$(RO,53);USING"###";D5;
  79. 770 PRINT FNC$(RO,57);USING"##.#";ABS(M5);
  80. 780 PRINT FNC$(RO,62);USING"###.#";V5;
  81. 790 PRINT FNC$(RO,68);V1$;FNC$(RO,70);USING"#####";E5:RETURN
  82. 800 '
  83. 810 PRINT FNC$(N+6,1)J1$"Route of flight correct? (Y or N)  <Y>  ";
  84. 820 X$=INPUT$(1):PRINT X$:IF X$=CHR$(13) THEN X$="Y"
  85. 830 GOSUB 1040:IF X$<>"N" AND X$<>"Y" THEN PRINT BL$:GOTO 810
  86. 840 IF X$="N" THEN 210 ELSE CLOSE
  87. 850 PRINT FNC$(N+6,1)J1$;
  88. 860 PRINT"Save route of flight for future use? (Y or N)  <Y>  ";
  89. 870 X$=INPUT$(1):PRINT X$:IF X$=CHR$(13) THEN X$="Y"
  90. 880 GOSUB 1040:IF X$<>"N" AND X$<>"Y" THEN PRINT BL$:GOTO 850
  91. 890 IF X$<>"N" THEN GOSUB 930
  92. 900 F$="B:FLIGHT.SEQ":GOSUB 1030
  93. 910 PRINT FNC$(N+6,1)J1$"Standby one...":RUN"NAVPROG7"
  94. 920 '
  95. 930 OPEN"I",1,"B:ROUTINGS.DAT"
  96. 940 PRINT FNC$(N+6,1)J1$"Standby one..."
  97. 950 RF$=LEFT$(I$(1),3)+"."+LEFT$(I$(N),3):INPUT#1,RN:DIM RT$(RN+1)
  98. 960 FOR J=1 TO RN:LINE INPUT #1,RT$(J):IF RT$(J)=RF$ THEN DR=1
  99. 970 NEXT J:CLOSE
  100. 980 RT$(RN+1)=RF$:IF ASC(RF$)<65 OR ASC(RF$)>90 THEN RF$="X"+RF$
  101. 990 F$="B:"+RF$:GOSUB 1030:IF DR=1 THEN RETURN
  102. 1000 OPEN"O",1,"B:ROUTINGS.DAT":PRINT#1,RN+1:FOR J=1 TO RN+1:PRINT#1,RT$(J)
  103. 1010 NEXT J:CLOSE:RETURN
  104. 1020 '
  105. 1030 OPEN"O",1,F$:FOR J=1 TO N:PRINT#1,I$(J):PRINT#1,REF(J):NEXT J:CLOSE:RETURN
  106. 1040 'map lc
  107. 1050 FOR L=1 TO LEN(X$):U$=MID$(X$,L,1)
  108. 1060 IF ASC(U$)>96 AND ASC(U$)<123 THEN MID$(X$,L,1)=CHR$(ASC(U$)-32)
  109. 1070 NEXT L:RETURN
  110. 1080 'error trap
  111. 1090 IF ERR=53 AND ERL=930 THEN RESUME 980
  112. 1100 ON ERROR GOTO 0
  113. 1110 MD=(MX+MN)\2:GET #1,MD:IF EOF(1) THEN MX=MD ELSE MN=MD
  114. 1120 IF MX>MN+1 THEN 1110 ELSE MD=MN:RETURN
  115. 100 ON ERROR GOTO 0
  116. 1110 MD=(MX+MN)\2:GET #1,MD:IF EOF(1