home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / misc3 / navigate.lzh / AIRROUTE.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  5.0 KB  |  140 lines
  1. 10  ' AIRROUTE.BAS   NAVPROGseven Route Program   22-Jan-82   Rev 01/22/86
  2. 20  ' Version F.03.02  for the IBM PC
  3. 30  ' (c) Copyright 1982 Alan Bose
  4. 40  ' 1224 Allison Lane
  5. 50  ' Schaumburg, IL 60194
  6. 60  '
  7. 70  ' CP/M modifications (c) 1982 by Glen Hassebrock, Jr.
  8. 75  ' HP-150 modifications (c) 1984 by Alan Bose
  9. 76  ' PC-DOS modifications (c) 1985 by Bruce Carson
  10. 80  '
  11. 90  CLEAR:WIDTH 80:ON ERROR GOTO 1080:DEFINT I-J
  12. 92  PROGDISK$="A:":DATADISK$="B:"
  13. 94  OPEN "I",1,"NAVDISCS.DAT"
  14. 96  INPUT #1,PROGDISK$,DATADISK$:CLOSE
  15. 98   GOSUB 8000
  16. 100  BL$=CHR$(7):E$=CHR$(27)
  17. 110  DIM I$(20),REF(20),FC$(20),FR(20),P$(20),P1(20),P2(20),V(20),V$(20),EL(20)
  18. 130  CLS:PRINT "Standby one";:MX=32767:MN=0
  19. 140  '
  20. 150  OPEN "R",1,DATADISK$+"AIRPORTS.RND",255:GOSUB 1110:PRINT"..."
  21. 160  OPEN "R",2,DATADISK$+"AIRINDEX.RND",255:MD=(MD*5)-1:DIM ID$(MD):FOR J=0 TO MD
  22. 170  REC=(J\51)+1:SS=J MOD 51:IF LOC(2)<>REC THEN GET#2,REC
  23. 180  FIELD #2,SS*5 AS DU$,5 AS ID$:ID$(J)=ID$:NEXT J:CLOSE#2:IM=MD
  24. 190  '
  25. 200  CLS:PRINT TAB(25)"NAVPROGseven Route Preparation"
  26. 205  N = 20
  27. 210  'LOCATE 13,16:PRINT "Enter number of checkpoints (20 max.)  <MENU>  ";
  28. 220  'PRINT STRING$(2,32);:LOCATE ,POS(0)-2:LINE INPUT N$:N=VAL(N$)
  29. 230  'IF N$="" THEN CLOSE:RUN"MENU"
  30. 240  'IF N<2 OR N>20 THEN PRINT:PRINT BL$"Sorry, 2 to 20 checkpoints only.":GOTO 210
  31. 250  'data box
  32. 260  LOCATE 2,1:GOSUB 9000
  33. 360  PRINT NG$:PRINT " Ident Fac Freq";TAB(32)"Name";
  34. 370  PRINT TAB(47)"Lat";TAB(55)"Long";TAB(64);"Var";TAB(70)"Elev"
  35. 380  '
  36. 390  FOR I=1 TO N
  37. 400  LOCATE I+6,1:IF I = 1 THEN PRINT "Enter Origin Airport ID <MENU>  "; ELSE PRINT "Enter checkpoint"I"  <End>  ";
  38. 410  PRINT STRING$(5,32);:LOCATE ,POS(0)-5:LINE INPUT X$:IF X$="" THEN 800
  39. 420  IF LEN(X$)>5 THEN PRINT BL$"5 characters maximum":GOTO 400
  40. 430  IF LEN(X$)<2 THEN PRINT BL$"2 characters minimium":GOTO 400
  41. 440  GOSUB 1040:P$=X$+SPACE$(5-LEN(X$))
  42. 450  'search index for match & get
  43. 460  RO=I+4
  44. 470  FD=0
  45. 480  FOR J=0 TO IM:IF ID$(J)<>P$ THEN 530
  46. 490  IF FD=1 THEN RO=I+8:GET #1,REC:LOCATE I+8,1:PRINT  :GOSUB 610:RO=I+9:FD=2
  47. 500  PI=J
  48. 510  IF FD>1 THEN REC=(J\5)+1:SS=J MOD 5:GET#1,REC:GOSUB 610:FD=FD+1:RO=RO+1
  49. 520  IF FD=0 THEN FD=1:REC=(J\5)+1:SS=J MOD 5:GET#1,REC
  50. 530  NEXT J
  51. 540  IF FD<>0 THEN 560
  52. 550  PRINT BL$"Can't find "P$:PRINT"If correct, return to menu and input data.":GOTO 400
  53. 560  IF FD=1 THEN 600
  54. 570  LOCATE RO+1,1:PRINT "Enter number of your choice  <"PI">  ";
  55. 580  PRINT STRING$(3,32);:LOCATE ,POS(0)-3:LINE INPUT X$:IF X$="" THEN 600
  56. 590  PI=VAL(X$):REC=(PI\5)+1:SS=PI MOD 5:GET#1,REC
  57. 600  LOCATE I+6,1:GOSUB 9000:RO=I+3:FD=0:GOSUB 610
  58. 601  IF VR > 0 OR I = 1 THEN 605
  59. 602  IF INSTR(FAC$,"V") > 0 THEN VR = 1:RTID$ = ID$
  60. 605  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$,4 AS M1$,2 AS D$,4 AS M$,4 AS V$,1 AS V1$,2 AS EL$
  64. 640  F5=CVS(FR$):D6=CVI(D1$):M6=CVS(M1$):D5=CVI(D$):M5=CVS(M$):V5=CVS(V$)
  65. 650  E5=CVI(EL$):I$(I)=ID$:FC$(I)=FAC$:FR(I)=F5:P$(I)=NM$
  66. 660  M1=M6/60:P2(I)=D6+M1:M=M5/60:P1(I)=D5+M:V(I)=V5:V$(I)=V1$:EL(I)=E5
  67. 670  LOCATE RO,1:IF FD=0 THEN PRINT I; ELSE PRINT PI;
  68. 680  PRINT TAB(7);ID$;TAB(13);FAC$;TAB(16);
  69. 690  IF F5=0 THEN PRINT SPC(7);:GOTO 740
  70. 700  IF F5>136 THEN PRINT USING"####";F5;:GOTO 740
  71. 710  IF F5*10\1=F5*10/1 THEN PRINT USING"####.#";F5;:GOTO 740
  72. 720  IF F5*100\1=F5*100/1 THEN PRINT USING"####.##";F5;:GOTO 740
  73. 730  PRINT USING"###.###";F5;
  74. 740  PRINT TAB(24);NM$;TAB(45);USING"##";D6;
  75. 750  PRINT TAB(48);USING"##.#";M6;
  76. 760  PRINT TAB(53);USING"###";D5;
  77. 770  PRINT TAB(57);USING"##.#";ABS(M5);
  78. 780  PRINT TAB(62);USING"###.#";V5;
  79. 790  PRINT TAB(68);V1$;TAB(70);USING"#####";E5:RETURN
  80. 800  '
  81. 805  IF I = 1 AND X$ = "" THEN CLOSE:RUN PROGDISK$+"NAVMENU"
  82. 806  N = I - 1
  83. 810  LOCATE N+6,1:GOSUB 9000:PRINT  "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  LOCATE N+6,1:GOSUB 9000
  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$=DATADISK$+"FLIGHT.SEQ":GOSUB 1030
  93. 910  LOCATE N+6,1:GOSUB 9000:LOCATE ,1:PRINT "Standby one...":RUN PROGDISK$+"NAVPROG7"
  94. 920  '                                         update route file
  95. 930  LOCATE N+6,1:GOSUB 9000
  96. 931  PRINT "Enter Route Suffix <";RTID$;"> ";STRING$(3,32);:LOCATE ,POS(0)-3
  97. 932  LINE INPUT X$:GOSUB 1040:IF X$ <> "" THEN  RTID$ = X$
  98. 933  IF LEN(RTID$)> 3 THEN RTID$ = LEFT$(RTID$,3)
  99. 935  RTID$ = RTID$ + SPACE$(3-LEN(RTID$))
  100. 937  RF$=LEFT$(I$(1),3)+LEFT$(I$(N),3)+"."+RTID$
  101. 940  LOCATE N+6,1:GOSUB 9000:PRINT "Standby one..."
  102. 950  OPEN "I",1,DATADISK$+"ROUTINGS.DAT":INPUT#1,RN:DIM RT$(RN+1)
  103. 960  FOR J=1 TO RN:LINE INPUT #1,RT$(J):IF RT$(J)=RF$ THEN DR=1
  104. 970  NEXT J:CLOSE
  105. 980  RT$(RN+1)=RF$:IF ASC(RF$)<65 OR ASC(RF$)>90 THEN RF$="X"+RF$
  106. 990  F$=DATADISK$+RF$:GOSUB 1030:IF DR=1 THEN RETURN
  107. 1000  OPEN"O",1,DATADISK$+"ROUTINGS.DAT":PRINT#1,RN+1:FOR J=1 TO RN+1:PRINT#1,RT$(J)
  108. 1010  NEXT J:CLOSE:RETURN
  109. 1020  '
  110. 1030  OPEN"O",1,F$:FOR J=1 TO N:PRINT#1,I$(J):PRINT#1,REF(J):NEXT J:CLOSE:RETURN
  111. 1040  'map lc
  112. 1050  FOR L=1 TO LEN(X$):U$=MID$(X$,L,1)
  113. 1060  IF ASC(U$)>96 AND ASC(U$)<123 THEN MID$(X$,L,1)=CHR$(ASC(U$)-32)
  114. 1070  NEXT L:RETURN
  115. 1080  'error trap
  116. 1090  IF ERR=53 AND ERL=950 THEN RESUME 980
  117. 1095  IF ERR=53 AND ERL=94 THEN CLOSE:RESUME 98 
  118. 1100  ON ERROR GOTO 0
  119. 1110  MD=(MX+MN)\2:GET #1,MD:IF EOF(1) THEN MX=MD ELSE MN=MD
  120. 1120  IF MX>MN+1 THEN 1110 ELSE MD=MN:RETURN
  121. 8000  '     install erase-to-end-of-screen  subroutine
  122. 8010  DEF SEG=&H1700
  123. 8020  FOR ADDR% = 0 TO 19
  124. 8030  READ CODE%
  125. 8040  POKE ADDR%,CODE%
  126. 8050  NEXT
  127. 8060  CLREOS% = 0
  128. 8070  RETURN
  129. 8080  DATA &h55,&h8b,&hec,&h8b,&h76,&h06,&h8b,&h0c
  130. 8090  DATA &hb8,&h20,&h0a,&hb7,&h00
  131. 8100  DATA &hcd,&h10
  132. 8110  DATA &h5d,&hca,&h02,&h00,&h00
  133. 9000  '    erase to end-of-screen
  134. 9010  CLINE = CSRLIN                            'remember cursor position
  135. 9020  CROW  = POS(0)
  136. 9030  NUMCHR% = 1919 - ((CLINE - 1)*80 +CROW)   'num chars to write
  137. 9040  CALL CLREOS%(NUMCHR%)                     'erase to end of screen
  138. 9050  LOCATE CLINE,CROW,1                       'restore cursor
  139. 9060  RETURN
  140.