| |
DL1MDY > CASIO 06.07.98 00:54l 448 Lines 8316 Bytes #999 (999) @ ALLE
BID : 578DB0ZKA01J
Read: DG1HUA DG2NBN GUEST
Subj: UKWTEST2.PRG
Path: DB0MAK<DB0RGB<DB0ABH<DB0ZKA
Sent: 980705/2129z @:DB0ZKA.#BAY.DEU.EU [Augsburg JN58ki] BCM1.39tb
From: DL1MDY @ DB0ZKA.#BAY.DEU.EU (Pius)
To: CASIO @ ALLE
X-Info: No login password
X-BID: 578DB0ZKA01J
10 REM UKW WETBEWERB
20 REM MENUE 1
30 LOCATE 9,0:PRINT"UKW WETBEWERB"
40 IF NEU=0 THEN 70
50 LOCATE 2,3:PRINTREV"neu";NORM;
60 GOTO 80
70 LOCATE 2,3:PRINT"neu";
80 IF DAT=0 THEN 110
90 LOCATE 9,3:PRINTREV"daten";NORM;
100 GOTO 120
110 LOCATE 9,3:PRINT"daten";
120 LOCATE 17,3:PRINT"eintrag";
130 LOCATE 26,3:PRINT"print";
140 REM INKEY$ MENUE 1
150 a = ASC(INKEY$)
160 IF a <252 THEN 150
170 a = a - 251:ON a GOTO 180,280,410,2010
180 REM UKW NEU ANLEGEN
190 CLS:PRINT"UKW WETBEWERB WIRD NEU ANGELEGT"
200 OPEN "UKW QSO" FOR OUTPUT AS#1
210 OPEN "UKW Pkt" FOR OUTPUT AS#2
220 OPEN "UKW Call" FOR OUTPUT AS#3
230 OPEN "UKW Land" FOR OUTPUT AS#4
240 OPEN "UKW LGF" FOR OUTPUT AS#5
250 OPEN "UKW Zpkt" FOR OUTPUT AS#6
260 PRINT #2,0;",";0;",";0;",";0;",";0;",";0;",";0
270 CLOSE:NEU=1:DAT=0:Z1=0:BEEP:CLS:GOTO20
280 REM DATEN EINTRAGEN
290 CLS:PRINT "Daten der Station Eintragen"
300 PRINT"Rufzeichen ";ECS$
310 PRINT"Wertungsgruppe ";WG$
320 PRINT"Locator ";ELC$;
330 LOCATE 14,1:INPUT ECS$
340 LOCATE 14,2:INPUT WG$
350 LOCATE 14,3:INPUT ELC$
360 IF DAT=1 GOTO 1280
370 GOTO 1230
380 LOCATE 14,3:INPUT"",ELC$
390 GOTO 1280
400 DAT=1:BEEP:CLS:GOTO 20
410 'EINTRAG UKW DATEI
420 OPEN"UKW Pkt"FOR INPUT AS#2
430 INPUT #2,QS$,SU$,MD$,DX$,LN$,GF$,Z1$
440 QS=VAL(QS$):SU=VAL(SU$):MD=VAL(MD$):DX=VAL(DX$):LN=VAL(LN$):GF=VAL(GF$):Z1=VAL(Z1$)
450 CLOSE # 2:CLS:GOTO 490
460 'EINTRAG QSO
470 LET CS$="":NG$="":NB$="":LC$="":LD$="":DS$="":BM$="":S=0
480 CLS:BEEP:GOTO 490
490 'QSO MASKE.MENUE 2
500 PRINT REV "cs"
510 LOCATE 14,0:PRINT"Nrg";
520 LOCATE 23,0:PRINT "Nrb";
530 LOCATE0,1:PRINT "loc";
540 LOCATE 9,1:PRINT "land";
550 LOCATE 16,1:PRINT "LD";
560 LOCATE 20,1: PRINT "LGF";
570 LOCATE 25,1:PRINT "qso";
580 LOCATE 0,2:PRINT "qrb";
590 LOCATE 7,2:PRINT "md";
600 LOCATE 12,2:PRINT "odx";
610 LOCATE 19,2:PRINT "su";
620 LOCATE 27,2:PRINT "bm";
630 LOCATE 0,3:PRINT "eintrag";
640 LOCATE 9,3:PRINT "suchen";
650 LOCATE17,3:PRINT "sichern";
660 LOCATE 25,3:PRINT "pause";
670 LOCATE 2,0:PRINT NORM CS$;
680 LOCATE 17,0:PRINT NG$;
690 LOCATE 26,0:PRINT NB$;
700 LOCATE 3,1:PRINT LC$;
710 LOCATE 13,1:PRINT LD$;
720 QSN = QS+1:QSN$ = STR$(QSN):QSN$=MID$(QSN$,2)
730 IF LEN(QSN$)=1 THEN QSN$="00"+QSN$
740 IF LEN(QSN$)=2 THEN QSN$="0"+ QSN$
750 IF LEN(QSN$)>2 THEN QSN$=""+QSN$
760 LOCATE 19,0:PRINT QSN$;
770 LOCATE 18,1:PRINT LN$;
780 LOCATE 23,1:PRINT GF$;
790 LOCATE 28,1:PRINT QS$;
800 LOCATE 3,2:PRINT DS$;
810 LOCATE 9,2:PRINT MD$;
820 LOCATE 15,2:PRINT DX$;
830 LOCATE 21,2:PRINT SU$;
840 LOCATE 29,2:PRINT BM$;
850 BEEP 1
860 b=ASC(INKEY$)
870 IF b = 32 THEN 900 ELSE 880
880 IF b<252 THEN 860 ELSE 890
890 b=b-251:ON b GOTO 460,1040,1120,2210
900 LET ZF$=""
910 LOCATE 2,0:INPUT"",ZF$:CS$=LEFT$(ZF$,12)
920 IF CS$=" " THEN BEEP:GOTO 910
930 IF S=0 THEN LET S=1:GOTO860
940 LOCATE 17,0:INPUT"",ZF$:NG$=LEFT$(ZF$,6)
950 IF LEFT$(NG$,2)=" " THEN BEEP:GOTO 940
960 LOCATE 26,0:INPUT"",ZF$:NB$=LEFT$(ZF$,6)
970 IF LEFT$(NB$,2)="" THEN BEEP:GOTO 960
980 DT$=MID$(DATE$,4,2)+LEFT$(DATE$,2)+RIGHT$(DATE$,2)
990 UT$=LEFT$(TIME$,2)+MID$(TIME$,4,2)
1000 LOCATE 3,1:INPUT"",ZF$:LC$=LEFT$(ZF$,6):GOSUB 1230
1010 LOCATE 13,1:INPUT"",ZF$:LD$=LEFT$(ZF$,3)
1020 IF LD$=" " THEN BEEP:GOTO 1010
1030 GOTO 860
1040 REM Suchen
1050 OPEN"UKW Call"FORINPUT AS#3
1060 IF EOF(3) THEN 1100 ELSE 1070
1070 INPUT #3,CSX$
1080 IF CSX$ = CS$ THEN 1090 ELSE 1060
1090 LOCATE 17,3:PRINT"sichern";
1100 LOCATE 9,3:PRINT"suchen";
1110 CLOSE #3:LET S=1:BEEP:GOTO 860
1120 REM Sichern
1130 IF LC$="" THEN 850
1140 GOSUB 1620:GOSUB 1670:GOSUB 1760:GOSUB 1860
1150 Z1=Z1+1:IF Z1=60 THEN 1160 ELSE 1180
1160 OPEN "UKW Zpkt" FOR APPEND AS#6
1170 PRINT #6,SU$:CLOSE #6:Z1=0
1180 Z1$=STR$(Z1)
1190 OPEN "UKW Pkt" FOR OUTPUT AS#2
1200 PRINT#2,QS$;",";SU$;",";MD$;",";DX$;",";LN$;",";GF$;",";Z1$
1210 LOCATE 17,3:PRINT"sichern";
1220 CLOSE #2:BEEP:GOTO 770
1230 REM ENTFERNUNGS BERECHNUNG MIT EU & WW LOCATOR
1240 IF DAT = 1 THEN 1320
1250 DATA 1,2,2,2,1,0,0,0,1,1,0,0,1,2,2,2,1,0,1,1
1260 DIM H(20):FOR I=1 TO 20:READ H(I):NEXT
1270 ANGLE 1:K=PI/180:L=180/PI:M=PI/2
1280 A$ = ELC$
1290 IF LEN(A$)<5 OR LEN(A$)>6 THEN BEEP0:BEEP1:GOTO 380
1300 GOSUB 1350
1310 X=U:Y=V:DAT=1:GOTO 400
1320 IF LC$=" " THEN BEEP:GOTO 1000
1330 GOSUB 1340:GOSUB 1560:GOTO 1670
1340 A$=LC$:IF A$=ELC$ THEN T1=0:Q=0:GOTO 1570
1350 IF LEN(A$)=5 THEN GOSUB 1460: RETURN
1360 IF LEN(A$)=6 THEN GOSUB 1520: RETURN
1370 BEEP0:BEEP1:GOTO 1000
1380 IF Z<0 THEN Q=360-Q
1390 RETURN
1400 T=(COS(Z)*COS(U)*COS(X))+(SIN(U)*SIN(X))
1410 T=(-ATN(T/SQR(1-T*T)))+M:T1=T*40009/(2*PI)
1420 Q=(SIN(U)-(SIN(X)*COS(T)))/(COS(X)*SIN(T))
1430 IF Q>0.999999 THEN Q=0:RETURN
1440 IF Q<-0.999999 THEN Q=180:RETURN
1450 Q=(-ATN(Q/SQR(1-Q^2)))+M:Q=Q*L:RETURN
1460 S1$=LEFT$(A$,2):S2$=MID$(A$,2,2):S3$=MID$(A$,3,1):S4$=MID$(A$,4,1):S5$=MID$(A$,5,2):B=ASC(S1$)-65:C=ASC(S2$)-64
1470 D=VAL(S3$):E=VAL(S4$):F=ASC(S5$)-64:IF B>21 THEN B=B-26
1480 IF C>23 THEN C=C-26
1490 IF E=0 THEN E=10:D=D-1
1500 U=K*(40+C-(D/8)-(H(F+10)/24)-0.020833)
1510 V=K*((2*B)+(E/5)+(H(F)/15)-0.169):RETURN
1520 B1=ASC(LEFT$(A$,2)):B2=ASC(MID$(A$,2,2)):Z1=VAL(MID$(A$,3,1)):Z2=VAL(MID$(A$,4,1)):B3=ASC(MID$(A$,5,2)):B4=ASC(MID$(A$,6,2))
1530 V=K*((B1-65)*20-180+(Z1*2)+(B3-65)/12+1/24)
1540 U=K*((B2-65)*10-90+Z2+(B4-65)/24+1/48)
1550 RETURN
1560 Z=V-Y:GOSUB1400:GOSUB1380
1570 DS=INT(T1+0.5):DS$=STR$(DS):DS$=MID$(DS$,2)
1580 BM=INT(Q+0.5):BM$=STR$(BM):BM$=MID$(BM$,2)
1590 LOCATE 3,2:PRINT DS$;
1600 LOCATE 29,2:PRINT BM$;
1610 BEEP 1:GOTO 1010
1620 SU=SU+DS:SU$=STR$(SU):SU$=MID$(SU$,2)
1630 QS=QS+1:QS$=STR$(QS):QS$=MID$(QS$,2)
1640 IF DS>DX THEN DX=DS:DX$=STR$(DX):DX$=MID$(DX$,2)
1650 MD=INT(SU/QS+0.5):MD$=STR$(MD):MD$=MID$(MD$,2)
1660 RETURN
1670 REM Auswertung Land
1680 OPEN "UKW Land" FOR INPUT AS#4
1690 IF EOF(4) THEN 1730
1700 INPUT #4,LDX$
1710 IF LD$=LDX$ THEN 1720 ELSE 1690
1720 CLOSE #4:LD$="---":RETURN
1730 LN=LN+1:LN$=STR$(LN):LN$=MID$(LN$,2):CLOSE #4
1740 OPEN "UKW Land" FOR APPEND AS #4
1750 PRINT#4,LD$:CLOSE#4:RETURN
1760 REM Auswertung Locator Grosfelder
1770 LGF$=LEFT$(LC$,4)
1780 OPEN "UKW LGF"FOR INPUT AS#5
1790 IF EOF(5) THEN 1830
1800 INPUT #5,LGFX$
1810 IF LGF$ = LGFX$ GOTO 1820 ELSE 1790
1820 LGF$="----":CLOSE#5:RETURN
1830 GF=GF+1:GF$=STR$(GF):GF$=MID$(GF$,2):CLOSE #5
1840 OPEN "UKW LGF"FOR APPEND AS#5
1850 PRINT #5,LGF$:CLOSE #5:RETURN
1860 REM QSO Sichern
1870 OPEN"UKW Call" FOR APPEND AS#3
1880 PRINT #3,CS$
1890 CLOSE #3
1900 OPEN "UKW QSO" FOR APPEND AS#1
1910 PRINT#1,USING"|& &|";DT$;
1920 PRINT#1,USING"& &|";UT$;
1930 PRINT#1,USING"& &|";CS$;
1940 PRINT#1,USING"& &|";NG$;
1950 PRINT#1,USING"& &|";NB$;
1960 PRINT#1,USING"& &|";LC$;
1970 PRINT#1,USING"& &|";DS$;
1980 PRINT#1,USING"& &|";LD$;
1990 PRINT#1,USING"& &|";LGF$
2000 CLOSE #1:RETURN
2010 REM Ausdruck
2020 LOCATE 26,3:PRINT REV "print";NORM;
2030 OPEN"UKW QSO" FOR INPUT AS#1:OPEN"UKW Zpkt" FOR INPUT AS#6:ZWS$="":ST=0
2040 LET Z2=0:ST=ST+1:LPRINT CHR$(10);
2050 LPRINT CHR$(9);CHR$(14);"LOG-Blatt fuer UKW Wetbewerbe";CHR$(20);CHR$(13);CHR$(10);CHR$(10);
2060 LPRINT CHR$(9);"Rufzeichen:"ECS$;" ";"Locator:"ELC$;" ";"Wertungsgruppe:";WG$;" ";"Seite:";ST;CHR$(13);CHR$(10);CHR$(10);
2070 LPRINT CHR$(9);"|Datum | UTC| Rufzeichen |Nr.geg|Nr.bek|Locator|Punkte|Land|LGF |"
2080 LPRINT CHR$(9);CHR$(9);CHR$(9);CHR$(9);" Uebertrag:";ZWS$;CHR$(13);CHR$(10);
2090 IF EOF(1) THEN 2170
2100 INPUT#1,QSO$
2110 LPRINT CHR$(9);QSO$;CHR$(13);CHR$(10);
2120 Z2=Z2+1:IF Z2=55 THEN 2130 ELSE 2090
2130 INPUT#6,ZWS$:GOSUB 2140:GOTO 2040
2140 LPRINT CHR$(9);CHR$(9);CHR$(9);CHR$(9);CHR$(9);CHR$(9);" Summe:";ZWS$;CHR$(10):RETURN
2150 LPRINT"QSO=";QS$;" Punkte pro QSO=";MD$;" Weiteste QSO=";DX$;" Laender=";LN$;" Locator Grosfelder=";GF$;CHR$(10);CHR$(10);
2160 RETURN
2170 CLOSE#1:CLOSE#6:OPEN "UKW Pkt" FOR INPUT AS#2
2180 INPUT#2,QS$,SU$,MD$,DX$,LN$,GF$:CLOSE#2:ZWS$=SU$:GOSUB 2140:GOSUB 2150
2190 LPRINT CHR$(10);:Z2=Z2+1:IF Z2=55 THEN 2200 ELSE 2190
2200 LPRINT CHR$(13);CHR$(10):BEEP:CLS:END
2210 REM Pause
2220 BEEP:BEEP1:BEEP:CLS:END
Read previous mail | Read next mail
| |
