Home   Jensen Archive   jWiki   Jensen News   Jensen Cloud   Jensen Programming   Jensen Family Tree   JensenDiary

KOMPAS.BAS

10 DEFDBL A-Z
20 PI = 3.141592654#
30 DEF FNSINUS (X) = SIN(X * PI / 180)
40 DEF FNTANG (X) = TAN(X * PI / 180)
50 DEF FNCOSIN (X) = COS(X * PI / 180)
60 DEF FNACS (X) = ATN(SQR(1 - X * X) / X) * 180 / PI - 90 * (SGN(X) - 1)
70 DEF FNASN (X) = ATN(X / SQR(1 - X * X)) * 180 / PI
80 COLOR 14, 6, 4
90 CLS
100 PRINT "Almanak og kompasretning"
110 INPUT "Dato YY.MMDD"; E
120 V = E
130 INPUT "Tid hh.mmss"; K
140 Y = INT(E)
150 M = INT((E - Y) * 100)
160 D = E * 10000 - (INT(100 * E)) * 100
170 H = INT(K): U = INT((K - H) * 100): S = K * 10000 - (INT(100 * K)) * 100
180 P = SGN(Y / 4 - INT(Y / 4))
190 Z = INT((Y - 84) * 365.25 + .75)
200 N = (M - 1) * 30
210 IF M = 2 THEN N = N + 1
220 IF M > 2 THEN N = N + CINT(.6 * (M - 3) - P)
230 N = Z + N + D - 1
240 E = H * 3600# + U * 60 + S
250 T = N * 86400# + E
260 A = 31556926#
270 T = A * (T / A - INT(T / A))
280 F = .01674: I = 360 / A * (T - 252000#): J = I
290 L = J - 180 / PI * F * FNSINUS(J)
300 J = J + I - L
310 IF ABS(I - L) < .000001 THEN 330
320 GOTO 290
330 VV = (FNCOSIN(J) - F) / (1 - F * FNCOSIN(J))
340 IF VV = 0 THEN O = 90: GOTO 360
350 O = FNACS(VV)
360 IF I < 0 THEN O = -O
370 IF I > 180 THEN O = 360 - O
380 O = O - 77.28442: R = 23.447
390 B = FNASN(FNSINUS(R) * FNSINUS(O))
400 Q = ABS(B): GOSUB 590
410 IF B < 0 THEN PRINT "Dkl = S"; X; "�"; P; "'"
420 IF B >= 0 THEN PRINT "Dkl = N"; X; "�"; P; "'"
430 W = 180 / PI * ATN(FNCOSIN(R) * FNTANG(O))
440 IF O > 90 THEN W = W + 180
450 IF O > 270 THEN W = W + 180
460 C = (T - 6863040!) / A * 360 - W - 1.867
470 GG = (E / 240 + 180 + C) / 360
480 G = (GG - INT(GG)) * 360
490 Q = G
500 GOSUB 590
510 PRINT "GHA ="; X; "�"; P; "'"
520 Q = 12 - C / 15
530 GOSUB 590
540 PRINT "Mer. pass "; X; "t"; P; "m"
550 P = X * 100 + P
560 D = B
570 A = V
580 GOTO 600
590 X = INT(Q): P = (INT(600 * (Q - INT(Q)) + .5)) / 10: RETURN
600 IF P < 1200 THEN P = P + 40
610 PRINT "Dato"; A
620 PRINT "Hvor foreg�r kompasretningen i n�rheden af? Indtast:"
630 PRINT "1 for Marstal"
640 PRINT "2 for �r�sk�bing"
650 PRINT "3 for S�by"
660 PRINT "4 for Bagenkop"
670 PRINT "5 for andre steder"
680 INPUT K
690 ON ERROR GOTO 710
700 GOTO 730
710 IF ERR = 25 THEN COLOR 15, 6: PRINT "Printeren er ikke t�ndt eller tilsluttet": COLOR 14, 6
720 RESUME 730
730 INPUT "�nsker du udskrift? J/N "; UD$
735 IF UD$ = "j" THEN LPRINT : LPRINT : LPRINT
740 MV = 0: PRINT "Dato "; A: IF UD$ = "j" THEN LPRINT "Dato "; A
750 IF K = 1 THEN L = 17.7: PRINT "MARSTAL": B = 54.85: IF UD$ = "j" THEN LPRINT "MARSTAL"
760 IF K = 2 THEN L = 18.3: PRINT "�R�SK�BING": B = 54.9: IF UD$ = "j" THEN LPRINT "�R�SK�BING"
770 IF K = 3 THEN L = 18.9: PRINT "S�BY": B = 54.95: IF UD$ = "j" THEN LPRINT "S�BY"
780 IF K = 4 THEN L = 17.2: PRINT "BAGENKOP": B = 54.75: IF UD$ = "j" THEN LPRINT "BAGENKOP"
790 IF K > 4.5 THEN INPUT "Bredde i GRADER  ,  MINUTER"; BG, BM: INPUT "L�ngde i GRADER  ,  MINUTER"; LG, LM: INPUT "Misvisning i grader"; MV
800 IF K > 4.5 THEN B = BG + BM / 60: L = (15 - (LG + LM / 60)) * 4
810 IF (K > 4.5) AND (UD$ = "j") THEN LPRINT "Bredde"; BG; "�"; BM; "'", "L�ngde"; LG; "�"; LM; "'", "Misvisning"; MV; "�"
820 INPUT "Start GMT (hh(.mm))"; S
830 INPUT "Slut GMT (hh(.mm))"; E
840 PRINT " GMT      Mv. pejling"
850 IF UD$ = "j" THEN LPRINT " GMT       Mv. pejling"
860 G = 0
870 S = S + 1
880 E = E + 1
890 DEFSNG I
900 FOR I = S TO E STEP .01
910 IF (I - INT(I)) >= .6 THEN I = INT(I + 1)
920 F = I
930 F = INT(F) + (F - INT(F)) * 5 / 3
940 T = F - L / 60 - (P - 1200) / 60
950 T = 180 + 15 * T
960 IF T >= 360 THEN T = T - 360
970 C = FNCOSIN(T) * FNSINUS(B) - FNCOSIN(B) * FNTANG(D)
980 IF ABS(C) < .0001 THEN GOTO 1090
990 V = 180 / PI * ATN(FNSINUS(T) / C)
1000 IF T < 180 THEN GOTO 1040
1010 IF V > 0 THEN GOTO 1070
1020 Z = V + 180
1030 GOTO 1110
1040 IF V >= 0 THEN Z = 180 + V: GOTO 1110
1050 Z = 360 + V
1060 GOTO 1110
1070 Z = V
1080 GOTO 1110
1090 IF T < 180 THEN Z = 90
1100 Z = 270
1110 Z = INT(Z - MV + .5)
1120 IF ABS(Z - G) < 1 THEN GOTO 1160
1130 PRINT INT((I - 1) * 100); "     "; Z
1140 IF UD$ = "j" THEN LPRINT INT((I - 1) * 100); "     "; Z
1150 G = Z
1160 NEXT I
1170 INPUT "Listen er f�rdig. Vil du forts�tte? J/N  "; FO$
1180 IF FO$ = "j" THEN GOTO 10
1190 IF FO$ = "n" THEN COLOR 14, 1: CLS : SYSTEM
1200 GOTO 1170
1210 END