home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / misc3 / navigate.lzh / RNAVREF.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  2.7 KB  |  78 lines
  1. 10  ' RNAVREF.BAS   NAVPROGseven RNAV Cross-Reference   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:ON ERROR GOTO 650:WIDTH 80: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  DIM P$(20),R(20)
  16. 100  BL$=CHR$(7):E$=CHR$(27):U=57.2958
  17. 110  PRINT"Checking RNAV references...";
  18. 120  DEF FNS5(X)=SIN(X/U):DEF FNS6(X)=INT(X*10+0.5)/10
  19. 130  DEF FNS7(X)=ATN(X/SQR(1-X*X))*U
  20. 140  DEF FNS8(X)=SIN(ABS(A/2)/U)*COS(X/U)/SIN(Q2/2)
  21. 150  '
  22. 160  OPEN"I",1,DATADISK$+"FLIGHT.SEQ"
  23. 170  FOR I=1 TO 20:LINE INPUT#1,P$(I):INPUT#1,R(I):N=I
  24. 180  NEXT I:CLOSE
  25. 190  '
  26. 200  OPEN"I",1,DATADISK$+"RNAVLIST.DAT":INPUT#1,KY
  27. 210  DIM LI$(KY),R1$(KY),R1(KY),R2$(KY),R2(KY)
  28. 220  FOR J=1 TO KY:LINE INPUT#1,LI$(J):LINE INPUT#1,R1$(J):INPUT#1,R1(J)
  29. 230  LINE INPUT#1,R2$(J):INPUT#1,R2(J):NEXT J:CLOSE
  30. 240  '
  31. 250  FOR I=1 TO N:FOR J=1 TO KY:IF P$(I)=LI$(J) THEN CP=1:LPT=1 ELSE 310
  32. 260  PI=R(I):K=0:GOSUB 350:PI=R1(J):K=1:GOSUB 350:IF R1$(J)="" THEN 280
  33. 270  L=1:M=0:GOSUB 450
  34. 280  IF R2$(J)="" THEN 310 ELSE PI=R2(J):K=2:GOSUB 350
  35. 290  IF R2$(J)="" THEN 310 ELSE L=2:M=0:GOSUB 450
  36. 300  IF R1$(J)="" OR R2$(J)="" THEN 310 ELSE L=1:M=2:GOSUB 450
  37. 310  CP=0:NEXT J,I:IF LPT=1 THEN LPRINT CHR$(12)
  38. 320  CLOSE:KILL DATADISK$+"FLIGHT.SEQ"
  39. 330  RUN PROGDISK$+"NAVMENU"
  40. 340  '
  41. 350  IF DE=0 THEN OPEN"R",1,DATADISK$+"AIRPORTS.RND",255:DE=1
  42. 360  REC=(PI\5)+1:SS=PI MOD 5:GET#1,REC
  43. 370  'decode
  44. 380  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$
  45. 390  ' FINISH FIELD
  46. 400  F5=CVS(FR$):D6=CVI(D1$):M6=CVS(M1$):D5=CVI(D$):M5=CVS(M$):V5=CVS(V$)
  47. 410  E5=CVI(EL$):I$(K)=ID$:FC$(K)=FAC$:FR(K)=F5:NM$(K)=NM$
  48. 420  M1=M6/60:P2(K)=D6+M1:M=M5/60:P1(K)=D5+M:V(K)=V5:V$(K)=V1$:EL(K)=E5
  49. 430  IF V$(K)="E" THEN V(K)=-V(K)
  50. 440  RETURN
  51. 450  'distance
  52. 460  A=P1(L)-P1(M):B1=P2(L)-P2(M):P#=COS(P2(L)/U)*COS(P2(M)/U)
  53. 470  Q=P#*COS(ABS(A)/U)+COS(ABS(B1)/U)-P#:Q2=ATN(SQR(1-Q*Q)/Q):Q=Q2*U*60
  54. 480  C=FNS6(Q):IF C=0 THEN T=0:Y=0:R=0:GOTO 640
  55. 490  'true bearing
  56. 500  S=FNS8((P2(L)+P2(M))/2):IF S>=1 THEN S=90-S ELSE S=FNS7(S)
  57. 510  IF A>0 AND B1=0 THEN T=90:GOTO 560
  58. 520  IF A<0 AND B1=0 THEN T=270:GOTO 560
  59. 530  IF A>0 AND B1<0 THEN T=S:GOTO 560
  60. 540  IF A>=0 AND B1>0 THEN T=180-S:GOTO 560
  61. 550  IF A<0 AND B1>0 THEN T=180+S ELSE T=360-S
  62. 560  T=FNS6(T)
  63. 570  'magnetic bearing
  64. 580  V1=(V(L)+V(M))/2:V2=FNS6(V1):Y=T+V2:IF Y<0 THEN Y=360-Y
  65. 590  IF Y>360 THEN Y=Y-360
  66. 600  'print
  67. 610  IF CP=1 THEN LPRINT:LPRINT"RNAV bearings for ";I$(0);" ";NM$(0):CP=0
  68. 620  IF M=0 THEN LPRINT"NAV"L": "I$(L);FR(L);C;"nm "Y"deg Mag (";T;"True )"
  69. 630  IF M=2 THEN LPRINT"NAV 1 to NAV 2 : ";C;"nm ";Y;"deg Mag (";T;"True )"
  70. 640  RETURN
  71. 650  'error trap
  72. 660  IF ERL=160 AND ERR=53 THEN RESUME 320
  73. 670  IF ERL=170 AND ERR=62 THEN J=21:RESUME 180
  74. 680  IF ERL=200 AND ERR=53 THEN RESUME 320
  75. 690  IF ERL=320 AND ERR=53 THEN RESUME NEXT
  76. 695  IF ERR=53 AND ERL=94 THEN CLOSE:RESUME 98 
  77. 700  ON ERROR GOTO 0
  78.