home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / basic / navprog7.lbr / OLDROUTE.BZS / OLDROUTE.BAS
Encoding:
BASIC Source File  |  1987-02-15  |  3.4 KB  |  75 lines
  1. 10 ' OLDROUTE.BAS  NAVPROGseven Route Retrieval Program  22-Jan-82  Rev 6/11/82
  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 540:DEFINT I-J
  10. 100 BL$=CHR$(7):E$=CHR$(27):ER$=E$+"E":PG$=E$+"p":QG$=E$+"q":Y$=E$+"Y"
  11. 110 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 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"
  14. 140 PRINT PG$ER$TAB(40-(LEN(HD$)/2))HD$TAB(79)QG$
  15. 150 PRINT:PRINT"Routes on file: ";
  16. 160 '
  17. 170 OPEN"I",1,"B:ROUTINGS.DAT":INPUT#1,M:DIM RT$(M+1)
  18. 180 FOR J=1 TO M:LINE INPUT #1,RT$(J):NEXT J:CLOSE:FOR J=1 TO M
  19. 190 CO=((J\16)*20)+1:RO=(J MOD 16)+5
  20. 200 PRINT FNC$(RO,CO)J;FNC$(RO,CO+5)"-  "LEFT$(RT$(J),3)" to ";
  21. 210 PRINT RIGHT$(RT$(J),3):NEXT J
  22. 220 '
  23. 230 PRINT FNC$(22,1)J1$"Enter selection  <MENU>  "J$STRING$(2,95)
  24. 240 PRINT:PRINT"Enter `D' for delete mode    Enter `P' for printout";:PRINT K$;
  25. 250 LINE INPUT X$:IF X$="" THEN CLOSE:RUN"MENU"
  26. 260 IF X$="D" OR X$="d" THEN 610
  27. 270 IF X$="P" OR X$="p" THEN 330
  28. 280 X=VAL(X$):IF X>M OR X<1 THEN PRINT BL$:GOTO 230
  29. 290 RT$=RT$(X):IF ASC(RT$)<65 OR ASC(RT$)>90 THEN RT$="X"+RT$
  30. 300 F$="B:"+RT$:GOSUB 490:F$="B:FLIGHT.SEQ":GOSUB 520
  31. 310 PRINT ER$"Standby one...":RUN"NAVPROG7"
  32. 320 '
  33. 330 GOSUB 720:LPRINT"Air routes currently on file"TAB(59)TM$" "D1$:LPRINT
  34. 340 FOR I=1 TO M:RT$=RT$(I):IF ASC(RT$)<65 OR ASC(RT$)>90 THEN RT$="X"+RT$
  35. 350 F$="B:"+RT$:GOSUB 490:LPRINT I;TAB(4);
  36. 360 FOR K=1 TO N:SP=INSTR(I$(K)," "):IF SP=0 THEN SP=6
  37. 370 LPRINT LEFT$(I$(K),SP-1);:IF K=N THEN LPRINT ELSE LPRINT" -> ";
  38. 380 NEXT K,I
  39. 390 OPEN"I",2,"B:RNAVLIST.DAT":INPUT#2,KY
  40. 400 DIM LI$(KY),R1$(KY),R1(KY),R2$(KY),R2(KY):FOR J=1 TO KY:LINE INPUT#2,LI$(J)
  41. 410 LINE INPUT#2,R1$(J):INPUT#2,R1(J):LINE INPUT#2,R2$(J):INPUT#2,R2(J)
  42. 420 NEXT J:CLOSE#2:LPRINT:LPRINT:LPRINT"RNAV cross-references on file:":LPRINT
  43. 430 FOR J=1 TO KY:LPRINT"    "LI$(J)" <-- ";
  44. 440 NV=1:IF R1$(J)<>"" THEN LPRINT"NAV"NV"= "R1$(J)"  ";:NV=2
  45. 450 IF R2$(J)<>"" THEN LPRINT"NAV"NV"= "R2$(J) ELSE LPRINT
  46. 460 NEXT J:ERASE LI$,R1$,R1,R2$,R2
  47. 470 LPRINT CHR$(12):GOTO 230
  48. 480 '
  49. 490 OPEN "I",1,F$:FOR J=1 TO 10:LINE INPUT#1,I$(J):INPUT#1,REF(J):N=J
  50. 500 NEXT J:CLOSE#1:RETURN
  51. 510 '
  52. 520 OPEN"O",1,F$:FOR J=1 TO N:PRINT#1,I$(J):PRINT#1,REF(J):NEXT J:CLOSE#1
  53. 530 RETURN
  54. 540 'error trap
  55. 550 IF ERR=53 AND ERL=170 THEN PRINT "None":PRINT ELSE 570
  56. 560 PRINT"Hit <RETURN> to continue...";:X$=INPUT$(1):PRINT ER$:RUN"MENU"
  57. 570 IF ERR=62 AND ERL=490 THEN N=J-1:J=11:RESUME 500
  58. 580 IF ERR=53 AND ERL=390 THEN RESUME 470
  59. 590 IF ERR=53 AND ERL=660 THEN RESUME 670
  60. 600 ON ERROR GOTO 0
  61. 610 'delete
  62. 620 PRINT FNC$(22,1)J1$"Delete which route?  <EXIT>  "J$STRING$(2,95)K$;
  63. 630 LINE INPUT X$:IF X$="" THEN 230
  64. 640 X=VAL(X$):IF X>M OR X<=0 THEN PRINT BL$:GOTO 620
  65. 650 RT$=RT$(X):IF ASC(RT$)<65 OR ASC(RT$)>90 THEN RT$="X"+RT$
  66. 660 KILL"B:"+RT$
  67. 670 IF M=1 THEN KILL"B:ROUTINGS.DAT":GOTO 10
  68. 680 IF X<>M THEN FOR J=X+1 TO M:RT$(J-1)=RT$(J):NEXT J
  69. 690 RT$(M)="":M=M-1:OPEN"O",1,"B:ROUTINGS.DAT":PRINT#1,M
  70. 700 FOR J=1 TO M:PRINT #1,RT$(J):NEXT J:CLOSE:GOTO 10
  71. 710 ' date and time subroutines
  72. 720 D1$="" ' :A=-2508:CALL A:FOR A=-2605 TO -2597:D1$=D1$+CHR$(PEEK(A)):NEXT A
  73. 730 TM$="" ' :FOR A=-2596 TO -2589:TM$=TM$+CHR$(PEEK(A)):NEXT A
  74. 740 RETURN
  75. OR A=-2605 TO -2597:D1$=D1$+CHR$(PEEK(A))