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