10 REM ********************************
20 REM * LIST LOCATOR.BAS             *
30 REM * Program f|r utr{kning av av- *
40 REM * st}nd, b{ring och po{ng  vid *
50 REM * tester. B}de  gammal  och ny *
60 REM * locator kan anv{ndas.  Summa *
70 REM * QSO & po{ng ges vid avslutn. *
80 REM * Ins{nt av Kurt Eriksson <396>*
90 REM ********************************
95 ! WIDTH 40 F\R ABC802 OCH 806
100 ; CHR$(12) CUR(0,0);
110 ; "*** SM7DOX *** LOCATOR *** SM5BKK ***" : ; 
120 REM IMPLEMENTED ON ABC-80 BY Jan Hov`n, 790805.
130 REM Ny locator enl QTC 6/80 Kurt        Eriksson 1985-01-05
140 ; "Ber{knar avst}nd, riktning och testpo{ngmellan QTH 1 och QTH 2." : ; 
170 ; "Ge ny el. gammal locator eller Lat,Long."
190 ; TAB(10);
200 ; "Input som Lat,Long....svara 0"
210 ; TAB(10);
220 ; "F|r att {ndra QTH 1...svara 1"
230 ; TAB(10);
240 ; "Avsluta programmet....svara 2"
250 G$=CHR$(151)
260 T$=CHR$(135)
270 ; CUR(10,9);
280 ; G$ "<,,,,,,,,<,,,,,,,,,<,,,,,,,,,l"
290 ; CUR(11,9) G$ "5" T$ "Loc.  " G$ "5";
300 ; T$ "Lat.   " G$ "5" T$ "Long.  " G$ "j";
310 ; G$ "<,,,,,,,,=,,,,,,,,=,,,,,,,,,=,,,,,,,,,n";
320 ; G$ "5" T$ "QTH 1:" G$ "5" T$ "      " G$ "5" T$ "       " G$ "5" T$ "       " G$ "j";
330 ; G$ "=,,,,,,,,=,,,,,,,,=,,,,,,,,,=,,,,,,,,,n";
340 ; G$ "5" T$ "QTH 2:" G$ "5" T$ "      " G$ "5" T$ "       " G$ "5" T$ "       " G$ "j";
350 ; G$ "-,,,,,,,,-,,,,,,,,-,,,,,,,,,-,,,,,,,,,.";
360 ; G$ "<" STRING$(15,44) "<" STRING$(10,44) "<" STRING$(10,44) "l";
370 ; G$ "5" T$ "QRB:       km" G$ "5" T$ "QTE:    " G$ "5" T$ "P:      " G$ "j";
380 ; G$ "-" STRING$(15,44) "-" STRING$(10,44) "-" STRING$(10,44) ".";
390 ; G$ "<" STRING$(19,44) "<" STRING$(17,44) "l";
400 ; G$ "5" T$ "Input            " G$ "5" T$ SPACE$(15) G$ "j";
410 ; G$ "-" STRING$(19,44) "-" STRING$(17,44) ".";
420 REM 
430 REM CONSTANTS
440 REM ---------
450 R1=6378.38 : R2=6356.91
460 M=PI/180
470 DEF FNA(X)=PI/2-ATN(X/SQR(1-X^2%)) 
480 E1=(R1*R1-R2*R2)/(R2*R2)
490 DIM Q$(3)=2
500 REM 
510 REM INPUT OF VALUES
520 REM ---------------
530 REM --- QTH-LOC 1 ---
540 REM 
550 ; CUR(21,9) "LOCATOR  1:"
560 ; CUR(21,23) SPACE$(15)
570 ON ERROR GOTO 550
580 ; CUR(21,23); : INPUT A$
590 ; CUR(13,12) "      "
600 ; CUR(13,21) "       "
610 ; CUR(13,31) "       "
620 IF A$="0" THEN 660
630 IF A$="2" THEN 1850
640 GOSUB 1190 : IF F1%=1% THEN 550 ELSE IF N%=1% 700
650 GOSUB 1070 : GOTO 700
660 ; CUR(21,9) "Lat,Long 1:"
670 ; CUR(21,23) SPACE$(15)
680 ; CUR(21,23); : INPUT A3,A4
690 GOSUB 2049
700 ; CUR(13,12) A$
710 ; CUR(13,21) INT(100*A3+.5)/100
720 ; CUR(13,31) INT(100*A4+.5)/100
730 A1=M*A3 : A2=M*A4
740 B1=PI/2-ATN(R2*TAN(A1)/R1)
750 C1=SIN(B1) : C2=COS(B1)
760 REM --- QTH-LOC 2 ---
770 REM 
780 ; CUR(21,9) "LOCATOR  2:"
790 ; CUR(21,23) SPACE$(15)
800 ON ERROR GOTO 780
810 ; CUR(21,23); : INPUT A$
820 ; CUR(15,12) "      "
830 ; CUR(15,21) "       "
840 ; CUR(15,31) "       "
850 ; CUR(18,7) "      "
860 ; CUR(18,23) "    " CUR(18,32) "      "
870 IF A$="0" THEN 920
880 IF A$="1" THEN 550
890 IF A$="2" THEN 1850
900 GOSUB 1190 : IF F1%=1% THEN 780 ELSE IF N%=1% 960
910 GOSUB 1070 : GOTO 960
920 ; CUR(21,9) "Lat,Long 2:"
930 ; CUR(21,23) SPACE$(14)
940 ; CUR(21,23); : INPUT A3,A4
950 GOSUB 2049
960 ; CUR(15,12) A$
970 ; CUR(15,21) INT(100*A3+.5)/100
980 ; CUR(15,31) INT(100*A4+.5)/100
990 A3=M*A3 : A4=M*A4
1000 GOSUB 1360
1010 ; CUR(18,7) INT(A6+.5)
1020 ; CUR(18,23) INT(A5+.5)
1025 ; CUR(18,32) P
1030 GOTO 780
1040 REM 
1050 REM DECODING QTH-LOC. (GAMLA)
1060 REM -------------------------
1070 REM A3=LAT,A4=LONG,A5=RIKTN,A6=AVST,A1=LAT1,A2=LONG1
1080 A4=1/30+2*(ASCII(MID$(A$,1,1))-65)
1090 A3=1/48-25+ASCII(MID$(A$,2,1))
1100 C%=VAL(MID$(A$,3,2))-1%
1110 A4=A4+(C%-10%*(C%/10%))/5
1120 A3=A3+(7%-C%/10%)/8
1130 D$=MID$(A$,5,1)
1140 IF D$="G" OR D$="J" OR D$="C" THEN A3=A3+1/24
1150 IF D$="H" OR D$="A" OR D$="B" THEN A3=A3+1/12
1160 IF D$="B" OR D$="C" OR D$="D" THEN A4=A4+2/15
1170 IF D$="A" OR D$="J" OR D$="E" THEN A4=A4+1/15
1180 RETURN 
1190 F1%=0% : N%=0% : REM FELRUTIN
1200 IF LEN(A$)=5% THEN 1210
1203 IF LEN(A$)=6% THEN 1900
1205 GOTO 1300
1210 F%=ASCII(MID$(A$,1%,1%))
1220 IF F%<65% OR F%>90% THEN 1300
1230 F%=ASCII(MID$(A$,2%,1%))
1240 IF F%<65% OR F%>90% THEN 1300
1250 F%=VAL(MID$(A$,3%,2%))
1260 IF F%<1% OR F%>80% THEN 1300
1270 F%=ASCII(MID$(A$,5%,1%))
1280 IF F%<65% OR F%=73% OR F%>74% THEN 1300
1290 GOTO 1310
1300 F1%=1%
1310 RETURN 
1320 REM 
1330 REM CAL. OF DISTANCE & AZIMUTH
1340 REM lat & long i radianer
1350 REM --------------------------
1360 F=(A1+A3)/2
1370 L=ABS(A2-A4)
1380 IF L>PI THEN L=2*PI-L
1390 B=(A1-A3)^2%
1400 N=E1*COS(F)^2%
1410 T=TAN(F)^2%
1420 D1=SIN(F) : D2=COS(F)
1430 L1=60*B*N*(1+N+3*T+6*N*T)/(1+N)^2%
1440 L2=120*N*(L*D1)^2%
1450 L3=B*B*N*(1+15*T)
1460 L4=2*B*N*(1+10*T-15*T*T)*(L*D2)^2%
1470 L5=6*N*T*(3-T)*(L*D2)^4%
1480 L6=L*SQR(1+N)*(1440-L1-L2-L3-L4-L5)/1440
1490 B3=PI/2-ATN(R2*TAN(A3)/R1)
1500 X=C2*COS(B3)+C1*SIN(B3)*COS(L6)
1510 IF 1-X*X>.0003 THEN S=FNA(X) : GOTO 1530
1520 S=SQR(B+(L*D2)^2%)
1530 Q=(COS(B3)-C2*COS(S))/(C1*SIN(S))
1540 IF 1-Q*Q>.0003 THEN A5=FNA(Q) : GOTO 1560
1550 IF A1>A3 THEN A5=PI ELSE A5=0
1560 L1=60*B*N*(1-N-T-6*N*T)/(1+N)^2%
1570 L2=120*N*(L*D1)^2%
1580 L3=3*B*B*N*(1-T)
1590 L4=2*B*N*(1-2*T-15*T*T)*(L*D2)^2%
1600 L5=2*N*(9*T-5*T*T)*(L*D2)^4%
1610 A6=1440*S*R1/((1440-L1-L2-L3-L4-L5)*SQR(1+N))
1615 P=INT((A6+10)/10) : IF P>200 THEN P=200
1617 P1=P1+P : Q1%=Q1%+1%
1620 IF A2<0 THEN 1670
1630 IF A4<A2 AND A4>(A2-PI) THEN 1650
1640 GOTO 1690
1650 A5=2*PI-A5
1660 GOTO 1690
1670 IF A4>A2 AND A4<(A2+PI) THEN 1690
1680 A5=2*PI-A5
1690 A5=A5/M : RETURN 
1700 REM Lat/Long till gammal locator borttagen
1850 ; CUR(18,19) "QSO:    ";CUR(18,23) Q1%;CUR(18,32) P1;CUR(7,0)
1860 END 
1900 F%=ASCII(MID$(A$,1%,1%)) : IF F%<65% OR F%>82% THEN 1990
1910 F%=ASCII(MID$(A$,2%,1%)) : IF F%<65% OR F%>82% THEN 1990
1920 F%=VAL(MID$(A$,3%,2%)) : IF F%<0% OR F%>99% THEN 1990
1930 F%=ASCII(MID$(A$,5%,1%)) : IF F%<65% OR F%>88% THEN 1990
1940 F%=ASCII(MID$(A$,6%,1%)) : IF F%<65% OR F%>88% THEN 1990
1950 GOTO 2000
1990 F1%=1% : RETURN 
1995 REM --- NY locator till lat/long
2000 FOR K%=1% TO 6%
2010   A(K%)=ASCII(MID$(A$,K%,1%))
2020 NEXT K% 
2030 A4=-180+(A(1)-65)*20+(A(3)-48)*2+(A(5)-64.5)/12
2040 A3=-90+(A(2)-65)*10+A(4)-48+(A(6)-64.5)/24
2042 N%=1% : RETURN 
2049 REM --- lat/long till locator (ny)
2050 L0=A4 : L0=(L0+180)/20
2060 L1=A3 : L1=(L1+90)/10
2070 A=INT(L0)
2080 E=INT(L1)
2090 L0=(L0-A)*10
2100 L1=(L1-E)*10
2110 C=INT(L0)
2120 D=INT(L1)
2130 A$=CHR$(A+65)+CHR$(E+65)+CHR$(C+48)+CHR$(D+48)
2140 A$=A$+CHR$(INT((L0-C)*24)+65)+CHR$(INT((L1-D)*24)+65)
2150 RETURN