' IARULOG.BAS version 1.2
' Amiga Version by John Gager-K7KB
' Copyright (© 1986,1987 by Clarke Greene K1JX)  NOT FOR COMMERCIAL USE
'
' This Microsoft (tm) BASIC program will build a complete log package
' for the IARU HF Championship.
'
' The file containing the log entries must be an ASCII file in the
' following format:
' 
'               (each band requires a separate log entry file)
'
' TIME       CALLSIGN        RCV'D REPORT  (each log entry must be
'                                          followed by a carriage return)
'
' At least one space must be between each field of each log entry. Only
' a changed digit in the time field must be present; for example, if the
' contest begins at 1800Z and the first contact is made at 1802Z and the
' second contact is made at 1805Z, then only 5 need be entered in the
' time field. If the third contact is made at 1812Z, then 12 should be
' entered in the time field. If the next contact is made at 1812Z, then
' no number need be entered in the time field (however, be sure to enter
' a space to indicate separation between fields).
'
' These files will be produced:
'
' <filename>.LOG - this is a complete log ready for printing
' <filename>.DUP - this is a sorted duplicate listing ready for printing
' <filename>.SUM - this is a summary sheet ready for printing
'
'
' Depending on the version of BASIC for your particular machine, the CLS
' (Clear Screen) command must be changed. Consult your own computer's
' BASIC documentation for more information.
'
'
' If compiling (a VERY good idea for several orders of magnitude
' improvement in speed), use O and E switches. 
'
' This program also uses a prefix library file (DXPREFIX.LIB), which MUST
' be on the same disc (and in the same subdirectory) as this program.
'
' Define arrays and variables
'
CLEAR ,70000&:DEFINT A-Z : OPTION BASE 1
DIM ENTRY$(1500), MULT$(100), PFX$(1000), CNT$(1000), WIERDPFX$(50), WIERDCNT$(50), Q(100)
BLANK$=" " : BL$="" : SLANT$="/" : TRUE=-1
DUPE$="- Duplicate QSO -" : NEWZONE$="    Mult. #"
CONTINENTS$="AFASEUNAOCSA"
'
' Define format strings for printouts
'
LOGFORM$="   \      \  \  \   \           \    \   \    \        \ #   \                \"
DUPFORM$="      \         \   \          \   \          \   \          \   \          \"
SUMFORM$="     \         \    \         \    \         \    \         \    \         \"
'
CLS
COLOR 3 : PRINT : PRINT TAB(24) "IARU HF Competition Log Processor" : COLOR 1 : PRINT
'
'  Read prefix table file
'
PRINT TAB(5)  "Reading prefix library...";
I=0 ' initialize array subscript
OPEN ":DXPREFIX.LIB" FOR INPUT AS #1
WHILE NOT EOF(1)
  I=I+1
  INPUT #1, PFX$(I), DUMMY$, DUMMY$, CNT$(I) ' DUMMY$ is a dummy variable
                                             ' for unused data
WEND
CLOSE
TABLESIZE=I ' prefix table length
COLOR 3 : PRINT "Done" : COLOR 1
'
'  Get user input
'
PRINT : PRINT TAB(5) "What is the station callsign? ";
INPUT "", MYCALL$:MYCALL$=UCASE$(MYCALL$)
THISENTRY$=MYCALL$ : IF INSTR(THISENTRY$,SLANT$)>0 THEN GOSUB GetPortPrefix ELSE THISPFX$=LEFT$(THISENTRY$,4)
GOSUB SearchPrefix : IF NOT INLIST THEN GOSUB SearchWierd
                     ' If the prefix can't be found
                     ' in table, look elsewhere.
MYCNT$=THISCNT$

GetZone:

PRINT : PRINT TAB(5) "What is the station's zone? ";
INPUT "", MYZONE$
IF VAL(MYZONE$)>=1 AND VAL(MYZONE$)<=75 GOTO GoodZone
PRINT CHR$(7) : PRINT TAB(8) "Is '"; MYZONE$; "' correct? <Y/N>  ";
INPUT "", ANS$ : IF UCASE$(ANS$)<>"Y" GOTO GetZone

GoodZone:

IF VAL(MYZONE$)<10 AND LEN(MYZONE$)=1 THEN MYZONE$="0"+MYZONE$
PRINT : PRINT TAB(5) "What is the beginning date of the contest";
COLOR 3 : PRINT" <DD/MM/YR>: "; : COLOR 1
INPUT "", STARTDATE$
MARK=INSTR(STARTDATE$,"/") : IF MARK=0 THEN MARK=INSTR(STARTDATE$,"-")
STARTDAY=VAL(LEFT$(STARTDATE$,MARK-1))
STARTDATE$=RIGHT$(STARTDATE$,LEN(STARTDATE$)-MARK)
MARK=INSTR(STARTDATE$,"/") : IF MARK=0 THEN MARK=INSTR(STARTDATE$,"-")
MON$=" July  "
YR$=RIGHT$(STARTDATE$,LEN(STARTDATE$)-MARK)
PRINT : PRINT TAB(5) "What is the GMT starting time for the contest? ";
INPUT "", STARTGMT$

GetLog:

PRINT : PRINT TAB(5) "What file is the log extract located in? ";
INPUT "", INFILE$ : GOSUB CheckForFile ' check to see if file is valid
IF INSTR(INFILE$,".")<>0 THEN OUTFILE$=LEFT$(INFILE$,INSTR(INFILE$,".")-1) ELSE OUTFILE$=INFILE$
PRINT : PRINT TAB(5) "What frequency band is the log extract for? ";
INPUT "", BAND$
PRINT : PRINT TAB(5) "Which mode is the log extract for?"
PRINT TAB(5) "[Type 1 for CW or 2 for Phone] : ";
INPUT "", MODE
IF MODE=1 THEN RST$="599" ELSE RST$="59"
SENT$=RST$+MYZONE$
'
'  Build log file
'
CLS
PRINT : PRINT TAB(5) "Duping and counting...";
'
'  Clear arrays
'
FOR I=1 TO 1500
  ENTRY$(I)=BL$
NEXT I
FOR I=1 TO 100
  MULT$(I)=BL$
  Q(I)=1
NEXT I
'
'  Initialize variables
'
RAWTOTAL=0 : QSOS=0 : DUPES=0 : MULTNR=0 : TOTPOINTS=0
DAY=STARTDAY : PREVIOUSGMT$=STARTGMT$
'
'  Open input file and ouput .LOG file
'
OPEN INFILE$ FOR INPUT AS #1 LEN=5000
OPEN OUTFILE$+".LOG" FOR OUTPUT AS #2 LEN=5000
'
'  Input data, process, and enter into output file
'
WHILE NOT EOF(1)
  LINE INPUT #1, THISENTRY$ ' read entire line from disc file
  IF LEN(THISENTRY$)=0 THEN GOTO SkipEntry
  WHILE ASC(RIGHT$(THISENTRY$,1))<48 AND LEN(THISENTRY$)>0
    THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1) ' Strip off trailing
                                                   ' spaces, etc.
  WEND
  IF LEN(THISENTRY$)>0 THEN RAWTOTAL=RAWTOTAL+1 ELSE GOTO SkipEntry
'
'  Separate received report from THISENTRY$
'
  RCVD$=BL$ ' initialize rcvd field to blank
  WHILE ASC(RIGHT$(THISENTRY$,1))>=48
    RCVD$=RIGHT$(THISENTRY$,1)+RCVD$
    THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1)
  WEND
  IF LEN(RCVD$)<(LEN(RST$)+2) OR ASC(RCVD$)>=65 THEN RCVD$=RST$+RCVD$
  WHILE ASC(RIGHT$(THISENTRY$,1))<48
    THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1) ' Strip off trailing
                                                   ' spaces, etc.
  WEND
'
'  Separate GMT from THISENTRY$
'
  WHILE ASC(LEFT$(THISENTRY$,1))<48
    THISENTRY$=RIGHT$(THISENTRY$,LEN(THISENTRY$)-1) ' Strip off leading
                                                    ' spaces.
  WEND
  IF INSTR(THISENTRY$,BLANK$)<>0 THEN GMT$=LEFT$(THISENTRY$,INSTR(THISENTRY$,BLANK$)-1) ELSE GMT$=BL$
  THISENTRY$=RIGHT$(THISENTRY$,(LEN(THISENTRY$)-LEN(GMT$)))
  WHILE LEFT$(THISENTRY$,1)=BLANK$
    THISENTRY$=RIGHT$(THISENTRY$,LEN(THISENTRY$)-1) ' Strip off leading
                                                    ' spaces.
  WEND
'
'  Fill in missing time data
' 
  GMT$=LEFT$(PREVIOUSGMT$,(4-LEN(GMT$)))+GMT$
  THEDATE$=BL$ : IF GMT$<PREVIOUSGMT$ THEN DAY=DAY+1 : THEDATE$=STR$(DAY)+MON$
'
'  Check for dupes
'
  THISENTRY$=UCASE$(THISENTRY$)
  DUPE.QSO=NOT TRUE : NOTE$=BL$ ' blank note
  FOR I=1 TO QSOS
    IF LEN(ENTRY$(I))<>LEN(THISENTRY$) GOTO NotDupe
    IF ENTRY$(I)=THISENTRY$ THEN NOTE$=DUPE$ : DUPES=DUPES+1 : POINTS=0 : DUPE.QSO=TRUE : I=QSOS
  NotDupe: NEXT I
  IF DUPE.QSO GOTO WriteEntry ' Skip over prefix search if
                              ' this entry is a dupe.
  QSOS=QSOS+1 : ENTRY$(QSOS)=THISENTRY$
'
'  Determine "zone" and search through multiplier table
'
  THISZONE$=RIGHT$(RCVD$,LEN(RCVD$)-LEN(RST$))
  NEWMULT=TRUE ' initially call contact a new multiplier
  FOR I=1 TO MULTNR
    IF MULT$(I)=THISZONE$ THEN Q(I)=Q(I)+1 : NEWMULT=NOT TRUE : I=MULTNR
  NEXT I
  IF NEWMULT THEN MULTNR=MULTNR+1 : MULT$(MULTNR)=THISZONE$ : NOTE$=NEWZONE$+STR$(MULTNR)
  IF ASC(THISZONE$)>=65 OR THISZONE$=MYZONE$ THEN POINTS=1 : GOTO Totals
'
'  Determine prefix and search prefix library for contact continent
'
IF INSTR(THISENTRY$,SLANT$)>0 THEN GOSUB GetPortPrefix ELSE THISPFX$=LEFT$(THISENTRY$,4)
GOSUB SearchPrefix : IF NOT INLIST THEN GOSUB SearchWierd
                     ' If the prefix can't be found
                     ' in table, look elsewhere.
'
'  Resolve USA prefix ambiguities (i.e. KG6=Guam vs. KG6=Calif.) and
'  calculate points.
'
  IF LEFT$(THISPFX$,1)="K" AND (VAL(THISZONE$)=6 OR VAL(THISMULT$)=7 OR VAL(THISMULT$)=8) THEN THISCNT$="NA"
  IF THISCNT$=MYCNT$ THEN POINTS=3 ELSE POINTS=5
'
'  Total QSO points
'
Totals:

  TOTPOINTS=TOTPOINTS+POINTS
'
'  Write entry to file
'
WriteEntry:
  
  IF (RAWTOTAL-1) MOD 50=0 THEN GOSUB PrintHeader ' Print header if this
                                                  ' is the beginning of
                                                  ' a page.
  PRINT #2, USING LOGFORM$; THEDATE$; GMT$; THISENTRY$; SENT$; RCVD$; POINTS; NOTE$
  IF RAWTOTAL MOD 50=0 THEN PRINT #2, CHR$(12) ' Print a form feed if
                                               ' this is the end of page.
  PREVIOUSGMT$=GMT$ : GMT$=BL$
  
SkipEntry:
WEND

IF RAWTOTAL MOD 50<>0 THEN PRINT #2, CHR$(12) ' If a form feed hasn't
                                              ' been printed, then print
                                              ' one now.
CLOSE
COLOR 3 : PRINT "Done" : COLOR 1
'
'  Build dupe sheet
'
PRINT : PRINT TAB(5) "Preparing dupe sheet...";
'
'  Sort callsigns for dupe sheet
'
M=QSOS\2
WHILE M>0
  FOR I=M+1 TO QSOS
    J=I-M
    WHILE J>0
      IF ENTRY$(J)>ENTRY$(J+M) THEN SWAP ENTRY$(J),ENTRY$(J+M) : J=J-M ELSE J=0
    WEND
  NEXT I
  M=M\2
WEND
'
'  Enter dupe sheet into file
'
OPEN OUTFILE$+".DUP" FOR OUTPUT AS #1
IF QSOS MOD 250=0 THEN LASTPAGE=QSOS\250 ELSE LASTPAGE=QSOS\250+1
FOR PAGE=1 TO LASTPAGE
  PRINT #1, SPC(20-(LEN(MYCALL$)+LEN(BAND$))/2); MYCALL$; " -- Dupe Sheet for ";
  PRINT #1, BAND$; " MHz Band -- Page"; STR$(PAGE)
  PRINT #1, BL$ : PRINT #1, BL$
  FOR ROW=1 TO 50
    E=(PAGE-1)*250+ROW
    PRINT #1, USING DUPFORM$; ENTRY$(E); ENTRY$(E+50); ENTRY$(E+100); ENTRY$(E+150); ENTRY$(E+200)
  NEXT ROW
  PRINT #1, CHR$(12) ' go to next page
NEXT PAGE
CLOSE
COLOR 3 : PRINT "Done" : COLOR 1
'
'  Build summary listing
'
PRINT : PRINT TAB(5) "Preparing summary sheet...";
'
'  Sort multipliers for summary sheet
'
M=MULTNR\2
WHILE M>0
  FOR I=M+1 TO MULTNR
    J=I-M
    WHILE J>0
      IF MULT$(J)>MULT$(J+M) THEN SWAP MULT$(J),MULT$(J+M) : SWAP Q(J),Q(J+M) : J=J-M ELSE J=0
    WEND
  NEXT I
  M=M\2
WEND
'
'  Append number of qsos per zone onto zone numbers
'
FOR I=1 TO MULTNR
  MULT$(I)=MULT$(I)+SPACE$(6-LEN(MULT$(I)))+" -"+STR$(Q(I))
NEXT I
'
'  Enter summary sheet into file
'
OPEN OUTFILE$+".SUM" FOR OUTPUT AS #1
PRINT #1, SPC(8-(LEN(MYCALL$)+LEN(BAND$))/2); MYCALL$; " -- Summary Sheet for "; BAND$;
PRINT #1, " MHz Band - "; YR$; " IARU HF Championship" 
PRINT #1, BL$
PRINT #1, TAB(11); "Multiplier Listing and number of contacts per multiplier"
PRINT #1, BL$ : PRINT #1, BL$
IF MULTNR MOD 5=0 THEN LASTROW=MULTNR\5 ELSE LASTROW=MULTNR\5+1
FOR ROW=1 TO LASTROW
  PRINT #1, USING SUMFORM$; MULT$(ROW); MULT$(ROW+LASTROW); MULT$(ROW+LASTROW*2); MULT$(ROW+LASTROW*3); MULT$(ROW+LASTROW*4)
NEXT ROW
PRINT #1, BL$ : PRINT #1, BL$ : PRINT #1, BL$
PRINT #1, TAB(17); "Total Valid QSOs - "; STR$(QSOS); TAB(45); "Dupes - "; STR$(DUPES)
PRINT #1, TAB(17); "Total QSO points - "; STR$(TOTPOINTS)
PRINT #1, TAB(17); "Multipliers - "; STR$(MULTNR)
CLOSE
COLOR 3 : PRINT "Done" : COLOR 1
'
'  Print results
'
CLS : PRINT CHR$(7)
PRINT : PRINT TAB(5) "Results for the "; BAND$; " MHz band":PRINT 
PRINT TAB(8) "Valid QSOs:"; : COLOR 3 : PRINT USING"          ####";QSOS : COLOR 1
PRINT TAB(8) "Duplicate QSOs:"; : COLOR 3 : PRINT USING"        ##";DUPES : COLOR 1
PRINT TAB(8) "Total QSO points:"; : COLOR 3 : PRINT USING" ######,";TOTPOINTS : COLOR 1
PRINT TAB(8) "Multipliers:"; : COLOR 3 : PRINT USING"          ###";MULTNR : COLOR 1
PRINT : PRINT : PRINT 
PRINT TAB(5) "Type "; : COLOR 3 :PRINT "C"; : COLOR 1
PRINT" to continue with another band,"
PRINT TAB(5) "or any other key to Exit ";
ANS$=INPUT$(1)
IF UCASE$(ANS$)="C" THEN CLS : GOTO GetLog ELSE CLS : END
'
'  Subroutine to trap missing file
'
CheckForFile:

ON ERROR GOTO NoFile:
OPEN INFILE$ FOR INPUT AS #1 ' try opening file
ON ERROR GOTO 0
CLOSE
RETURN

NoFile:

PRINT CHR$(7) : PRINT TAB(4) "That file does not exist - type X to Exit or any other key to continue ";
ANS$=INPUT$(1) : IF UCASE$(ANS$)="X" THEN CLS : END
PRINT 
RESUME GetLog
'
'  Subroutine to determine prefix from portable designator
'
GetPortPrefix:

MARK=INSTR(THISENTRY$,SLANT$)
IF MARK>3 THEN THISPFX$=RIGHT$(THISENTRY$,LEN(THISENTRY$)-MARK) ELSE THISPFX$=LEFT$(THISENTRY$,MARK-1)
IF LEN(THISPFX$)>1 GOTO ReturnPfx ' have prefix - return
IF ASC(THISPFX$)>58 OR ASC(THISPFX$)<47 THEN THISPFX$=LEFT$(THISENTRY$,4) : GOTO ReturnPfx
K=2 ' find position of first numeral in call
WHILE (ASC(MID$(THISENTRY$,K,1))>57 OR ASC(MID$(THISENTRY$,K,1))<48) AND K<LEN(THISENTRY$)
  K=K+1
WEND
THISPFX$=LEFT$(THISENTRY$,K-1)+THISPFX$ ' new prefix = portable number
                                        ' in old prefix
ReturnPfx:
RETURN
'
'  Subroutine to determine station's continent from prefix
'
SearchPrefix:

K=4 : INLIST=NOT TRUE : SAVEDPFX$=THISPFX$
WHILE K>0 AND INLIST=NOT TRUE
  THISPFX$=LEFT$(THISPFX$,K)
  LOW=1 : HIGH=TABLESIZE : INLIST=NOT TRUE ' Initial values for 
                                           ' binary sort.
  WHILE LOW<=HIGH AND INLIST=NOT TRUE
    L=(LOW+HIGH)\2
    IF THISPFX$=PFX$(L) THEN INLIST=TRUE : THISCNT$=CNT$(L)
    IF THISPFX$<PFX$(L) THEN HIGH=L-1 ELSE LOW=L+1
  WEND
  K=K-1
WEND
RETURN
'
'  Subroutine to search unusual prefix list
'
SearchWierd:
 
IF NRWIERDPFX=0 GOTO GetPrefix ' If the supplementary prefix list is
                               ' empty, then skip ahead.
K=4
WHILE K>0
  SAVEDPFX$=LEFT$(SAVEDPFX$,K)
  FOR J=1 TO NRWIERDPFX
    IF SAVEDPFX$=WIERDPFX$(J) THEN INLIST=TRUE : THISCNT$=WIERDCNT$(J) : J=NRWIERDPFX : K=1
  NEXT J
  K=K-1
WEND
IF INLIST THEN RETURN ' If the prefix was found, then return.
'
'  Routine to get prefix definition and continent
'  from user for prefix not found in library.
'
GetPrefix:

CLS:PRINT CHR$(7) : PRINT
PRINT TAB(5) "The prefix for "; : COLOR 3 : PRINT THISENTRY$;
COLOR 1 : PRINT" can't be found in the prefix library."
PRINT : PRINT TAB(5) "What is the callsign prefix? "; 
INPUT "", THISPFX$ : THISPFX$=UCASE$(THISPFX$)
NRWIERDPFX=NRWIERDPFX+1 : WIERDPFX$(NRWIERDPFX)=THISPFX$

GetContinent:

PRINT : PRINT TAB(5) "What is the continent? [AF, AS, EU, NA, OC, SA] ";
INPUT "", THISCNT$ : THISCNT$=UCASE$(THISCNT$)
FOR J=1 TO 11 STEP 2
  IF THISCNT$=MID$(CONTINENTS$,J,2) THEN INLIST=TRUE : J=11
NEXT J ' Check for valid continent name
IF NOT INLIST THEN PRINT CHR$(7);: GOTO GetContinent
WIERDCNT$(NRWIERDPFX)=THISCNT$
CLS : PRINT : PRINT TAB(5) "Back to duping and counting...";
RETURN
'
'  Subroutine to print log sheet header
'
PrintHeader:

PRINT #2, BL$
PRINT #2, TAB(5); MYCALL$; "  "; BAND$; " MHz Log"; TAB(70); "Page"; STR$(RAWTOTAL\50+1)
PRINT #2, BL$
PRINT #2, "     Date    Time   Callsign         Sent     Rcvd      Pt.        Notes"
PRINT #2, "   "; STRING$(74,61)
THEDATE$=STR$(DAY)+MON$
RETURN