home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / misc3 / navigate.lzh / OLDROUTE.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  4.2 KB  |  122 lines
  1. 10  ' OLDROUTE.BAS  NAVPROGseven Route Retrieval 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 540:DEFINT I-J:KEY OFF:GOSUB 4000
  12. 92  PROGDISK$="A:":DATADISK$="B:"
  13. 94  OPEN "I",1,"NAVDISCS.DAT"
  14. 96  INPUT #1,PROGDISK$,DATADISK$:CLOSE
  15. 100  BL$=CHR$(7):E$=CHR$(27)
  16. 110  DIM I$(20),REF(20)
  17. 130  HD$="N A V P R O G s e v e n   R O U T E   R E T R I E V A L"
  18. 140  CLS:PRINT TAB(40-(LEN(HD$)/2))HD$
  19. 150  PRINT:PRINT"Routes on file: ";
  20. 160  '
  21. 170  OPEN"I",1,DATADISK$+"ROUTINGS.DAT":INPUT#1,M:DIM RT$(M+1)
  22. 180  FOR J=1 TO M:LINE INPUT #1,RT$(J):NEXT J:CLOSE:
  23. 190  FOR J = 1 TO M:CO=((J\16)*25)+1:RO=(J MOD 16)+4
  24. 200  LOCATE RO,CO:PRINT J;:LOCATE ,CO+4:PRINT"- "LEFT$(RT$(J),3)" to ";
  25. 205  IF MID$(RT$(J),4,1) = "." THEN PRINT RIGHT$(RT$(J),3);:GOTO 215
  26. 210  PRINT MID$(RT$(J),4,3);
  27. 211  IF RIGHT$(RT$(J),4) <> ".RT1" THEN PRINT " (";RIGHT$(RT$(J),3);")";
  28. 215  NEXT J:GOSUB 5000
  29. 219  LOCATE 24,1:PRINT "n - Select Route,  D- Delete, P- Print Routes, L- List route ";
  30. 220  '
  31. 230  LOCATE 23,1:PRINT "Enter selection  <MENU>    ";:LOCATE ,POS(0)-3
  32. 250  LINE INPUT X$:IF X$="" THEN CLOSE:KEY OFF:CLS:RUN PROGDISK$+"NAVMENU"
  33. 251  X = VAL(RIGHT$(X$,LEN(X$)-1))
  34. 252  XL$ = LEFT$(X$,1)
  35. 260  IF XL$="D" OR XL$="d" THEN 610
  36. 270  IF XL$="P" OR XL$="p" THEN 330
  37. 275  IF XL$="L" OR XL$="l" THEN 800
  38. 280  X=VAL(X$):IF X>M OR X<1 THEN PRINT BL$:GOTO 230
  39. 290  RT$=RT$(X):IF ASC(RT$)<65 OR ASC(RT$)>90 THEN RT$="X"+RT$
  40. 300  F$=DATADISK$+RT$:GOSUB 490:F$=DATADISK$+"FLIGHT.SEQ":GOSUB 520
  41. 310  CLS:PRINT "Standby one...":RUN PROGDISK$+"NAVPROG7"
  42. 320  '
  43. 330  LPRINT TAB(15);"NAVPROGseven   Stored Routes";TAB(59);DATE$
  44. 340  FOR I=1 TO M:RT$=RT$(I):IF ASC(RT$)<65 OR ASC(RT$)>90 THEN RT$="X"+RT$
  45. 350  F$=DATADISK$+RT$:GOSUB 490:LPRINT I;TAB(5);
  46. 352  LPRINT LEFT$(RT$(I),3);" to ";
  47. 354  IF MID$(RT$(I),4,1)="." THEN LPRINT RIGHT$(RT$(I),3):GOTO 360
  48. 356  LPRINT MID$(RT$(I),4,3);" via "RIGHT$(RT$(I),3);" routing"
  49. 360  FOR K=1 TO N:SP=INSTR(I$(K)," "):IF SP=0 THEN SP=6
  50. 370  LPRINT LEFT$(I$(K),SP-1);:IF K=N THEN LPRINT ELSE LPRINT" -> ";
  51. 380  NEXT K,I
  52. 390  OPEN"I",2,DATADISK$+"RNAVLIST.DAT":INPUT#2,KY
  53. 400  DIM LI$(KY),R1$(KY),R1(KY),R2$(KY),R2(KY):FOR J=1 TO KY:LINE INPUT#2,LI$(J)
  54. 410  LINE INPUT#2,R1$(J):INPUT#2,R1(J):LINE INPUT#2,R2$(J):INPUT#2,R2(J)
  55. 420  NEXT J:CLOSE#2:LPRINT:LPRINT:LPRINT"RNAV cross-references on file:":LPRINT
  56. 430  FOR J=1 TO KY:LPRINT"    "LI$(J)" <-- ";
  57. 440  NV=1:IF R1$(J)<>"" THEN LPRINT"NAV"NV"= "R1$(J)"  ";:NV=2
  58. 450  IF R2$(J)<>"" THEN LPRINT"NAV"NV"= "R2$(J) ELSE LPRINT
  59. 460  NEXT J:ERASE LI$,R1$,R1,R2$,R2
  60. 470  LPRINT CHR$(12):GOTO 230
  61. 480  '
  62. 490  OPEN "I",1,F$:FOR J=1 TO 20:LINE INPUT#1,I$(J):INPUT#1,REF(J):N=J
  63. 500  NEXT J:CLOSE#1:RETURN
  64. 510  '
  65. 520  OPEN"O",1,F$:FOR J=1 TO N:PRINT#1,I$(J):PRINT#1,REF(J):NEXT J:CLOSE#1
  66. 530  RETURN
  67. 540  'error trap
  68. 550  IF ERR=53 AND ERL=170 THEN PRINT "None":PRINT ELSE 570
  69. 560  PRINT"Hit <RETURN> to continue...";:X$=INPUT$(1):CLS:RUN PROGDISK$+"NAVMENU"
  70. 570  IF ERR=62 AND ERL=490 THEN N=J-1:J=21:RESUME 500
  71. 580  IF ERR=53 AND ERL=390 THEN RESUME 470
  72. 590  IF ERR=53 AND ERL=660 THEN RESUME 670
  73. 595  IF ERR=53 AND ERL=94 THEN CLOSE:RESUME 100
  74. 600  ON ERROR GOTO 0
  75. 610  'delete
  76. 620  LOCATE 23,1:PRINT  "Delete which route?  <EXIT>  ";:LOCATE ,POS(0)-1
  77. 630  LINE INPUT X$:IF X$="" THEN 230
  78. 640  X=VAL(X$):IF X>M OR X<=0 THEN PRINT BL$:GOTO 620
  79. 650  RT$=RT$(X):IF ASC(RT$)<65 OR ASC(RT$)>90 THEN RT$="X"+RT$
  80. 660  KILL DATADISK$+RT$
  81. 670  IF M=1 THEN KILL DATADISK$+"ROUTINGS.DAT":GOTO 10
  82. 680  IF X<>M THEN FOR J=X+1 TO M:RT$(J-1)=RT$(J):NEXT J
  83. 690  RT$(M)="":M=M-1:OPEN"O",1,DATADISK$+"ROUTINGS.DAT":PRINT#1,M
  84. 700  FOR J=1 TO M:PRINT #1,RT$(J):NEXT J:CLOSE:GOTO 10
  85. 800  ' list
  86. 810  IF X > 0 THEN 850
  87. 820  LOCATE 22,1:PRINT SPC(79);:LOCATE 22,1:LINE INPUT "Enter Route number <Exit> ";X$
  88. 830  IF X$ = "" THEN 230
  89. 840  X = VAL(X$)
  90. 850  IF X > M OR X <  1 THEN PRINT BL$:GOTO 820
  91. 860  LOCATE 22,1:GOSUB 5000:
  92. 870  RT$ = RT$(X)
  93. 880  PRINT X;TAB(6);LEFT$(RT$,3);" to ";
  94. 882  IF MID$(RT$,4,1)="." THEN PRINT RIGHT$(RT$,3):GOTO 890
  95. 884  PRINT MID$(RT$,4,3);" via "RIGHT$(RT$,3);" routing"
  96. 890  IF ASC(RT$) < 65 OR ASC(RT$) > 90 THEN RT$ = "X" + RT$
  97. 900  F$ = DATADISK$+RT$:GOSUB 490
  98. 910  FOR K = 1 TO N:SP =INSTR(I$(K)," "):IF SP = 0 THEN SP = 6
  99. 920  PRINT LEFT$(I$(K),SP-1);:IF K=N THEN PRINT; ELSE PRINT " -> ";
  100. 930  NEXT K
  101. 940  PRINT:PRINT "Depress Enter to continue ";:X$=INPUT$(1)
  102. 950  GOTO 190
  103. 4000  '     install erase-to-end-of-screen  subroutine
  104. 4010  DEF SEG=&H1700
  105. 4020  FOR ADDR% = 0 TO 19
  106. 4030  READ CODE%
  107. 4040  POKE ADDR%,CODE%
  108. 4050  NEXT
  109. 4060  CLREOS% = 0
  110. 4070  RETURN
  111. 4080  DATA &h55,&h8b,&hec,&h8b,&h76,&h06,&h8b,&h0c
  112. 4090  DATA &hb8,&h20,&h0a,&hb7,&h00
  113. 4100  DATA &hcd,&h10
  114. 4110  DATA &h5d,&hca,&h02,&h00,&h00
  115. 5000  '    erase to end-of-screen
  116. 5010  CLINE = CSRLIN                            'remember cursor position
  117. 5020  CROW  = POS(0)
  118. 5030  NUMCHR% = 1919 - ((CLINE - 1)*80 +CROW)   'num chars to write
  119. 5040  CALL CLREOS%(NUMCHR%)                     'erase to end of screen
  120. 5050  LOCATE CLINE,CROW,1                       'restore cursor
  121. 5060  RETURN
  122.