home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
misc
/
livdup
/
duper.bas
next >
Wrap
BASIC Source File
|
1987-12-13
|
6KB
|
149 lines
10 ' DUPER.BAS version 1.3 - Copyright (C) 1986,1987 by Clarke Greene K1JX NOT FOR COMMERCIAL USE
20 '
30 ' This Microsoft (tm) BASIC program will build a sorted "Dupe Sheet"
40 '
50 ' This file will be produced:
60 '
70 ' <filename> - this is a sorted duplicate listing ready for printing
80 '
90 '
100 ' Depending on the version of BASIC for your particular machine, the CLS (Clear Screen) command must
110 ' be changed. Consult your own computer's BASIC documentation for more information.
120 '
130 '
140 ' If compiling (a VERY good idea for several orders of magnitude improvement in speed), use O and E switches
150 '
160 '
170 WARNING$="Copyright (C) 1986,1987 by Clarke Greene K1JX NOT FOR COMMERCIAL USE"
171 '
180 ' Define arrays and variables
190 DEFINT A-Z : OPTION BASE 1
200 DIM ENTRY$(2000)
210 BLANK$=" " : BL$="" : BS$=CHR$(8) : CTRLE$=CHR$(5) : CR$=CHR$(13) : DEL$=BS$+CHR$(32) : ESC$=CHR$(27)
220 TRUE= -1
230 DUPE$=CHR$(7)+" ** Duplicate QSO **"
240 DUPFORM$=" \ \ \ \ \ \ \ \ \ \"
250 '
260 ' Print message to user
270 CLS
280 PRINT TAB(26) "Interactive Contest Log Duper"
290 PRINT : PRINT
300 PRINT TAB(5) "What is your station's callsign? ";
310 INPUT; "", MYCALL$ : IF LEN(MYCALL$)=0 THEN 310 ELSE PRINT : PRINT
320 '
330 ' Clear array
340 FOR I=1 TO 2000
350 ENTRY$(I)=BL$
360 NEXT I
370 '
380 ' Initialize variables
390 QSOS=0 : DUPES=0
400 '
410 ' Main user entry loop
420 CLS : PRINT : PRINT
430 PRINT TAB(5) "Enter callsign {Press Esc to end} > ";
440 THISENTRY$=BL$ : CHAR$=BL$
450 WHILE CHAR$<>CR$ AND CHAR$<>ESC$
460 CHAR$=INKEY$ : IF LEN(CHAR$)=0 GOTO 530
470 IF CHAR$=CR$ OR CHAR$=ESC$ GOTO 530 ' if the character is an <ESC> or <CR>, jump to exit loop
480 IF CHAR$=BS$ AND LEN(THISENTRY$)>0 THEN THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1) : PRINT DEL$;: GOTO 520
490 IF ASC(CHAR$)<47 GOTO 530 ' ignore invalid characters
500 IF ASC(CHAR$)>96 THEN GOSUB 1410 ' capitalize character if necessary
510 THISENTRY$=THISENTRY$+CHAR$ ' add character to string
520 PRINT CHAR$; ' echo character to screen
530 WEND
540 IF CHAR$=ESC$ GOTO 810 ' if the user wants to quit, jump to close log
550 IF LEN(THISENTRY$)=0 GOTO 440
560 '
570 ' Check for dupes
580 DUPE.QSO=NOT TRUE : NOTE$=BL$ ' clear note field
590 FOR I=1 TO QSOS
600 IF THISENTRY$=ENTRY$(I) THEN NOTE$=DUPE$ : DUPE.QSO=TRUE : I=QSOS
610 NEXT I
620 '
630 ' Print result of dupe search to screen
640 PRINT NOTE$ : PRINT
650 PRINT : PRINT : PRINT : PRINT
660 PRINT TAB(9) "Total QSOs:";
670 IF DUPE.QSO THEN PRINT QSOS ELSE PRINT QSOS+1
680 PRINT
690 PRINT TAB(9) "Total Duplicates:";
700 IF DUPE.QSO THEN PRINT DUPES+1 ELSE PRINT DUPES
710 PRINT : PRINT : PRINT : PRINT : PRINT
720 PRINT TAB(9) "Type Ctrl-E to change the last entry,"
730 PRINT TAB(9) "or any other key to continue. ";
740 ANS$=INPUT$(1)
750 IF ANS$=CTRLE$ GOTO 410 ' if ^E was input, go back and edit entry
760 '
770 ' Adjust variables and loop
780 IF DUPE.QSO THEN DUPES=DUPES+1 : GOTO 410
790 QSOS=QSOS+1 : ENTRY$(QSOS)=THISENTRY$ : GOTO 410
800 '
810 ' Get filename from user
820 CLS
830 PRINT
840 PRINT TAB(5) "What is the name of the file you want to save the dupe sheet in?"
850 PRINT : PRINT TAB(8) "> ";
860 INPUT "", OUTFILE$ : IF LEN(OUTFILE$)=0 THEN 860 ELSE PRINT
870 '
880 ' Routine to prevent overwriting existing file
890 ON ERROR GOTO 1380
900 OPEN OUTFILE$ FOR INPUT AS #1 ' try opening file
910 CLOSE
920 PRINT CHR$(7) : PRINT TAB(5) "That file already exists - do you want to overwrite it? <Y/N> ";
930 ANS$=INPUT$(1) : PRINT
940 IF ANS$<>"Y" AND ANS$<>"y" THEN 810 ELSE PRINT
950 ON ERROR GOTO 0
960 PRINT : PRINT TAB(5) "What frequency band is this dupe sheet for? ";
970 INPUT; "", BAND$ : IF LEN(BAND$)=0 THEN 970 ELSE PRINT
980 '
990 ' Build dupe sheet
1000 PRINT : PRINT TAB(5) "Preparing dupe sheet... ";
1010 '
1020 ' Sort callsigns for dupe sheet
1030 M=QSOS\2
1040 WHILE M>0
1050 FOR I=M+1 TO QSOS
1060 J=I-M
1070 WHILE J>0
1080 IF ENTRY$(J)>ENTRY$(J+M) THEN SWAP ENTRY$(J),ENTRY$(J+M) : J=J-M ELSE J=0
1090 WEND
1100 NEXT I
1110 M=M\2
1120 WEND
1130 '
1140 ' Enter dupe sheet into file
1150 OPEN OUTFILE$ FOR OUTPUT AS #1
1160 IF QSOS MOD 250=0 THEN LASTPAGE=QSOS\250 ELSE LASTPAGE=QSOS\250+1
1170 FOR PAGE=1 TO LASTPAGE
1180 PRINT #1, SPC(20-(LEN(MYCALL$)+LEN(BAND$))/2); MYCALL$; " -- Dupe Sheet for "; BAND$; " MHz Band -- Page"; STR$(PAGE)
1190 PRINT #1, BL$ : PRINT #1, BL$
1200 FOR ROW=1 TO 50
1210 E=(PAGE-1)*250+ROW
1220 PRINT #1, USING DUPFORM$; ENTRY$(E); ENTRY$(E+50); ENTRY$(E+100); ENTRY$(E+150); ENTRY$(E+200)
1230 NEXT ROW
1240 PRINT #1, CHR$(12) ' go to next page
1250 NEXT PAGE
1260 CLOSE
1270 PRINT "done"
1280 '
1290 ' Print results
1300 PRINT : PRINT TAB(8) "Valid QSOs: "; QSOS
1310 PRINT : PRINT TAB(8) "Duplicate QSOs: "; DUPES
1320 PRINT : PRINT : PRINT
1330 PRINT TAB(5) "Type C to continue with another band for this contest,"
1340 PRINT : PRINT TAB(5) "or any other key to Exit ";
1350 ANS$=INPUT$(1)
1360 IF ANS$="C" OR ANS$="c" THEN 330 ELSE CLS : SYSTEM
1370 '
1380 ' Error trap for existing file
1390 RESUME 950
1400 '
1410 ' Subroutine to capitalize character
1420 ALPHA=ASC(CHAR$)
1430 WHILE ALPHA >96
1440 ALPHA=ALPHA-32
1450 WEND
1460 CHAR$=CHR$(ALPHA)
1470 RETURN