' The program processes the results of a single event, comprising a
'  set of seeding races (if any) followed by the races divided into
'  their heats.  The list of yachts in their finishing order in each heat
'  or seeding race are entered into a data file separately (using a
'  text editor), and the program then works on that prepared file.
'  In this version, DNC or DNS yachts must be explicitly listed;
'   If a yacht is omitted from the heat results list, it'll get a DNC
'   in the lowest heat.
'  Redress (RDG) can be given.  Finishing line ties (TIE) are allowed.
'  Penalties for DSQ, DND, and OCS are applied.
'  Non-finishing codes of OOT/DNF, and RET/RAF are applied.
' The low points scoring system is used.  Simple score ties are resolved
'  automatically, more complex ties are resolved manually (that's you).
'  The number of discards can be set, with a suggestion as per MYA HMS.
' Averages and medians ignore seeding race results, and are calculated
'  after discards.
' The program outputs the results to screen as well as to an output data file.

' Wish list
'  Redress allowed with other codes such as DNF: eg 67DNFRDG4.5
'  Different scoring methods apart from low points
'  Different scoring systems such as HMS, HRS, etc
'  Allow a different number of races to be processed, so we can calculate
'   "average so far", or simply follow changes in the leaderboard.
'  Allow each results line to be as listed by the line judge for each heat;
'   ie the first four in each lower heat are duplicates to be ignored.
'  Jib numbers are any alphanumeric, or at least show "07" for "7".
'  Provide an option to divide the fleet into N heats based on the last race.

' RESTRICTIONS
'  The program does not perform any promotions or relegations.  It assumes
'   that the heat results presented to it have already had all necessary
'   promotions correctly placed in their latest heats.
'  Jib numbers must be purely numeric;  "X21" or "21X" can't be used.

' NOTE: The results are processed heat by heat and the finishing positions
' in the whole race built up.  The seeding races are treated internally as
' heats, with the position counter being reset back to 1 as each seeding
' race is processed.

' SCORING
' As per UK MYA HMS.  In particular,
'  Yachts in lower heats score starting from the last finishing place of
'   the higher heat.  DNF etc yachts in the higher heat are IGNORED when
'   calculating the scores for yachts in lower heats.
'  DNF etc in a seeding race score "number in largest seeding race +1".

' Results input *.DAT file format:
' Line 1:   Title (race name & date, probably)
' Line 2:   Total number of races INCLUDING seeding races
'           (no comma separates these two numbers, just a blank space or two)
' Lines 3+: The results of each seeding race, or the results of each heat,
'           one race/heat on one line, "A" fleet first, then "B", etc.
'           Each group of race heats/seeding races is first preceeded by an
'            identification sequence Tn on its own line:
'            T = Type of race -- S=seeding, R=race heat
'            n = Number of heats/seeding races in the following group
'  Each results line is then the list of jib numbers starting at 1st place
'   for that heat or seeding race.  Promoted yachts are listed only in their
'   highest heat.  Jib numbers are separated by blank spaces,
'   no commas.  A code can be placed immediately after the jib number (no
'   space) to indicate some penalty, such as disqualification (code=DSQ).
'  The redress code (RDG) may be followed by a number,
'   again no spaces, which is the number of redress points given.
'  Note that it is important that EVERY yacht scheduled to race in a heat
'   is listed in the results line for that heat.  Even if the yacht did not
'   achieve a result, it must still be listed with a code such as DNF or DNC.
'   This ensures the correct count can be made of the number of yachts
'   scheduled, the number which started, and the number which finished,
'   which in turn ensures that DNF etc yachts are correctly scored.
'  If still not on the list for any heat, a yacht scores DNC for the lowest heat.

DECLARE SUB calcavg (ind%, avg!)
DECLARE SUB reviewnums ()
DECLARE SUB giveredress (ind%, race%)
DECLARE SUB givepoints ()
DECLARE SUB finishtie ()
DECLARE SUB pencode ()
DECLARE SUB disptable ()
DECLARE SUB getseg (line$, it$, beg%)
DECLARE SUB writeout ()
DECLARE SUB resolvetie ()
DECLARE SUB orderdisclist (ind%)
DECLARE SUB scormeth ()
DECLARE SUB listplace ()
DECLARE SUB listpoint ()
DECLARE SUB calcmed (ind%, medval!)
DECLARE SUB dispyacht (sail%)
DECLARE SUB dispres (file$)
DECLARE SUB getfile (file$, prompt$, extn$)
DECLARE SUB eventres ()
DECLARE SUB discard ()
DECLARE SUB initial ()
DECLARE SUB buildind ()
DECLARE SUB alloc ()
DECLARE SUB decomp (line$, it$, beg%, numb$, text$)
DECLARE SUB readfile ()

COMMON SHARED maxrace%, maxentry%, maxsailno%, maxdisc%, maxheat%
COMMON SHARED maxbonus%, debug, progress, usedefault%
COMMON SHARED result%(), rescode$(), index%(), numrace%, desc$, numevententry%
COMMON SHARED yracepos%(), ytotpoints(), numdisc%, dataset$, filein$, fileout$
COMMON SHARED yjibno%(), yfinalpos%(), scoresys%, pointval(), tiesys%
COMMON SHARED disctype$(), disclist(), median(), finishlist%(), yracecode$()
COMMON SHARED DNCpos%(), DNSpos%(), OCSpos%(), DNFpos%(), RETpos%()
COMMON SHARED DSQpos%(), DNDpos%(), OOTpos%()
COMMON SHARED ytie$(), yracepoints()
COMMON SHARED numheatstart%(), numheatfinish%()
COMMON SHARED numracestart%(), numracefinish%()
COMMON SHARED numheat%(), racetype$(), maxheatsize%
COMMON SHARED numheatentry%(), numheatsched%()
COMMON SHARED DSQbase%, DSQbonus%, DNDbase%, DNDbonus%
COMMON SHARED OCSbase%, OCSbonus%, DNCbase%, DNCbonus%, DNSbase%, DNSbonus%
COMMON SHARED DNFbase%, DNFbonus%, OOTbase%, OOTbonus%, RETbase%, RETbonus%

' The program works by taking each jib number as it appears in the results
' file and allocating an "index number" in sequence, starting from 1.
' Thereafter, all references to a given jib number are translated into
' a reference to that boat's index number.  This keeps the various arrays
' in the program within reasonable size.

ON ERROR GOTO handler

' Debug control
'   0 for normal operation
'  >0 for 'normal' debugging
'  -1 shows the index position assigned to each jib no
'  -2 shows redress calculations
'  -3 shows tie resolution calculations
'  -4 shows finish line TIE calculations
'  -5 shows average & median calculations
debug = 0

' progress = 0 for no information, = 1 for indicators of busy-ness
' = 2 to report number of starters & finishers
progress = 2

' Change these maxima to suit
maxrace% = 20                ' Max number of races (incl. seeding races) that can be processed
maxentry% = 80               ' Max number of entrants
maxsailno% = 300             ' Jib numbers range from 1 to this maximum
maxdisc% = 10                ' Maximum number of discards allowed
maxheat% = 5                 ' Max number of heats
maxheatsize% = 20            ' Set to something like Maxentry / (Maxheat -1)
maxbonus% = 10               ' For future use with different scoring systems

'  The result% array simply lists the raw sail numbers in finishing position
DIM result%(maxrace%, maxheat%, maxheatsize%)

' Penalty and other codes (which immediately follow the jib number) are:
'  (Where these are applied in a seeding race, read "race" instead of "heat".)

'  Code  Meaning                          Penalty assigned     Counted as
'  ----  -------------------------------  -------------------  ------------
'  DSQ   Disqualified                     Event Entry + 1      non-finisher
'  DND   Dsq not discardable              Event Entry + 1      non-finisher

'  DNC   Did not compete                  Heat Entry + 1       non-starter
'  DNS   Did not start                    Heat Entry + 1       non-starter
'  OCS   On the course side at the start  Heat Entry + 1       non-starter

'  DNF   Did not finish                   Heat Entry + 1       non-finisher
'  OOT   Out of time                      Heat Entry + 1       non-finisher

'  RET/RAF   Retired after finishing      Heat Entry + 1       non-finisher

'  RDGxx.x   Redress given
'            If xx.x is given, these are the redress points.
'            If xx.x is not given, the program asks later.

'  TIE   Finish line tie with the following yacht in the results list.
'        This is a non-standard code, designed to be used to inform the
'        program of any such ties.  If there were three yachts tied at
'        the finish line, for example, the data file would have the
'        sequence "67TIE 55TIE 32" in the results list.

' The rescode$ array records the raw results codes from the data file
DIM rescode$(maxrace%, maxheat%, maxheatsize%)

' The penalty positions associated with each code.
' Their values are set in the "pencode" module.
DIM DNCpos%(maxrace%, maxheat%), DNSpos%(maxrace%, maxheat%)
DIM OCSpos%(maxrace%, maxheat%), DNFpos%(maxrace%, maxheat%)
DIM RETpos%(maxrace%, maxheat%), DSQpos%(maxrace%, maxheat%)
DIM DNDpos%(maxrace%, maxheat%), OOTpos%(maxrace%, maxheat%)

'  The yracepos% array records the position of each yacht in each race
'  The position is either the position of the yacht
'   in the race, or 'entry+1' (or whatever is set) otherwise
'  NOTE  An RDG code does not affect position, so place that yacht's
'   jib number in the correct place in the race results file
DIM yracepos%(maxentry%, maxrace%)

'  The yracepoints array records the points earned by the yacht in each race
'  These points are determined by the scoring system in use
'   and by any redress given
DIM yracepoints(maxentry%, maxrace%)

'  The yracecode$ array records any result code for the yacht in each race
'  For the RDG code, the number of redress points xxx may be added later
DIM yracecode$(maxentry%, maxrace%)

'  The yacht results are kept in arrays
'  The yjibno% array identifies the jib number for the yacht at a given
'   index position in the arrays
DIM yjibno%(maxentry%)

'  Provide a points total for each yacht
'  Yacht points total is REAL, not integer.  Reflects redress given, etc
DIM ytotpoints(maxentry%)

'  Provide the yachts' final positions.  Where ties are allowed to remain,
'  a yacht's position is modified to reflect any ties
DIM yfinalpos%(maxentry%)

'  Note a code for any ties
'  Code "=" indicates a tie that is allowed to remain
'  Code "*" indicates a tie that has been broken by best result
'  Code "<" indicates a tie that has been broken by count-back
DIM ytie$(maxentry%)

'  Set up the index array for the yacht index numbers
DIM index%(maxsailno%)

' Set up array of sail numbers in final finishing order
DIM finishlist%(maxentry%)

'  Set up the points value of a position (as determined by the scoring system)
DIM pointval(maxentry% + maxbonus% + 1)

'  Set up the discards array
DIM disclist(maxentry%, maxdisc%), disctype$(maxentry%, maxdisc%)

' Set up array to hold points for median calculation
DIM median(maxrace%)

' Set up arrays to hold the number of yachts recorded in each race & heat
DIM numheatstart%(maxrace%, maxheat%), numheatfinish%(maxrace%, maxheat%)
DIM numracestart%(maxrace%), numracefinish%(maxrace%)

' Record the number of heats in each race/number of seeding races in each group
' Record the type "S" or "R" of a race
DIM numheat%(maxrace%), racetype$(maxrace%)

' "heat entry" count is "heat scheduled" plus previous "heat finishers".
'  It is used in scoring the finishers and penalty codes.
' "heat sched" count is simply the number of boats scheduled in the heat.
'  It is used by the program to move through all the boats in a heat.
DIM numheatentry%(maxrace%, maxheat%), numheatsched%(maxrace%, maxheat%)

CLS
usedefault% = 1

PRINT "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
PRINT "                           REGATTA SCORER"
PRINT "                       (c)1999 Lester Gilbert"
PRINT "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
PRINT
PRINT "The program requires as input a data file (*.DAT) of the"
PRINT "sail numbers (and any penalty codes) in finishing order"
PRINT "for each seeding race (if any) and each heat in each race."
PRINT
PRINT "(Because this is a clunky DOS program built in my garage, it may be"
PRINT "awkward to use if the program is not launched from the same directory"
PRINT "which holds the data files, and is impossible to use if the data files"
PRINT "are in a different drive.)"
PRINT
PRINT "Current setup ";
PRINT "(sail numbers from 1 to"; maxsailno%; ")";
PRINT " is for a maximum of:"
PRINT maxrace%; "races  "; maxentry%; "entrants  ";
PRINT maxdisc%; "discards  ";
PRINT maxheat%; "heats  "; maxheatsize%; "yachts per heat."
PRINT
PRINT "Apart from display, an output results file (*.OUT) is created for"
PRINT "import into a word processor OR spreadsheet."

'  Initialise arrays
CALL initial

'  Read in the data
CALL readfile

'  Build the index array
CALL buildind

'  Assign the penalty positions
CALL pencode

'  Allocate (raw) places
CALL alloc

'  Define the scoring system
CALL scormeth

' Allocate points according to finish positions
CALL givepoints

' Deal with any finishing line ties
CALL finishtie

'  Calculate discards & final scores
CALL discard

'  Write event places file
CALL eventres

'  Display results
DO
	PRINT
	PRINT "1: Review results (output) file contents"
	PRINT "2: List individual yacht result in detail"
	PRINT "3: List of total points in finishing position order"
	PRINT "4: List of total points in jib number order"
	PRINT "5: List all yachts, each result in detail"
	PRINT "6: List table of results, yachts by race"
	PRINT "7: Review number of entrants, starters, finishers"
	PRINT "9: Redefine parameters"
	PRINT "0: Exit"
	INPUT a%
	
	SELECT CASE a%
	CASE 1
		CALL dispres(fileout$)

	CASE 2
		INPUT "Sail number:"; sail%
		CALL dispyacht(sail%)

	CASE 3
		CALL listplace

	CASE 4
		CALL listpoint

	CASE 5
		i% = 0
		DO
			i% = i% + 1
			sail% = yjibno%(i%)
			CALL dispyacht(sail%)
			INPUT "--- <CR>:Next  <0>:Exit ---"; a$
		LOOP UNTIL ((i% >= numevententry%) OR (a$ = "0"))

	CASE 6
		CALL disptable

	CASE 7
		usedefault% = 0
		CALL reviewnums
		usedefault% = 1

	CASE 9
	  
		PRINT
		PRINT "1: Redefine the required scoring system"
		PRINT "2: Redefine number of discards & assign redress points"
		PRINT "3: Redefine penalties"
		PRINT "0: Exit"
		INPUT b%
  
		SELECT CASE b%
		CASE 1
			usedefault% = 0
			CALL scormeth
			usedefault% = 1
			CALL givepoints
			CALL finishtie
			CALL discard
			CALL eventres

		CASE 2
			usedefault% = 0
			CALL discard
			usedefault% = 1
			CALL eventres

		CASE 3
			usedefault% = 0
			CALL pencode
			usedefault% = 1
			CALL alloc
			CALL scormeth
			CALL givepoints
			CALL finishtie
			CALL discard
			CALL eventres

		END SELECT

	END SELECT

LOOP UNTIL a% = 0

END

handler:
	PRINT "ERROR is actually: ";
	SELECT CASE ERR
CASE 1
PRINT "NEXT without FOR"
CASE 37
PRINT "Argument-count mismatch"
CASE 2
PRINT "Syntax error"
CASE 38
PRINT "Array NOT defined"
CASE 3
PRINT "RETURN without GOSUB"
CASE 40
PRINT "Variable required"
CASE 4
PRINT "Out of DATA"
CASE 50
PRINT "FIELD overflow"
CASE 5
PRINT "Illegal function call"
CASE 51
PRINT "Internal error"
CASE 6
PRINT "Overflow"
CASE 52
PRINT "Bad file name or number"
CASE 7
PRINT "Out of memory"
CASE 53
PRINT "File NOT found"
CASE 8
PRINT "Label NOT defined"
CASE 54
PRINT "Bad file mode"
CASE 9
PRINT "Subscript out of range"
CASE 55
PRINT "File already open"
CASE 10
PRINT "Duplicate definition"
CASE 56
PRINT "FIELD statement active"
CASE 11
PRINT "Division by zero"
CASE 57
PRINT "Device I/O error"
CASE 12
PRINT "Illegal in direct mode"
CASE 58
PRINT "File already exists"
CASE 13
PRINT "TYPE mismatch"
CASE 59
PRINT "Bad record length"
CASE 14
PRINT "Out of string space"
CASE 61
PRINT "Disk full"
CASE 16
PRINT "String formula too complex"
CASE 62
PRINT "Input past end of file"
CASE 17
PRINT "Cannot continue"
CASE 63
PRINT "Bad record number"
CASE 18
PRINT "Function not defined"
CASE 64
PRINT "Bad file name"
CASE 19
PRINT "No RESUME"
CASE 67
PRINT "Too many files"
CASE 20
PRINT "RESUME without error"
CASE 68
PRINT "Device unavailable"
CASE 24
PRINT "Device timeout"
CASE 69
PRINT "Communication-buffer overflow"
CASE 25
PRINT "Device fault"
CASE 70
PRINT "Permission denied"
CASE 26
PRINT "FOR without NEXT"
CASE 71
PRINT "Disk NOT ready"
CASE 27
PRINT "Out of paper"
CASE 72
PRINT "Disk-media error"
CASE 29
PRINT "WHILE without WEND"
CASE 73
PRINT "Feature unavailable"
CASE 30
PRINT "WEND without WHILE"
CASE 74
PRINT "Rename across disks"
CASE 33
PRINT "Duplicate Label"
CASE 75
PRINT "Path/File access error"
CASE 35
PRINT "Subprogram NOT defined"
CASE 76
PRINT "Path NOT found"
END SELECT

INPUT "... <CR> to continue   <CTRL-C> to quit ..."; x$

STOP
RESUME NEXT

END

SUB alloc

' Allocate a position to each yacht for each race

FOR i% = 1 TO maxentry%
FOR j% = 1 TO maxrace%
	yracepos%(i%, j%) = 0
	yracepoints(i%, j%) = 0
NEXT j%
NEXT i%

IF ((progress > 0) OR (debug > 0)) THEN PRINT "Allocating places ";
FOR race% = 1 TO numrace%
	IF ((progress > 0) OR (debug > 0)) THEN PRINT racetype$(race%); race%; ":";
	place% = 1
	FOR heat% = 1 TO numheat%(race%)
	  
		IF racetype$(race%) = "S" THEN
			' If a seeding race, make it self-contained and start the positions
			' from 1st again
			place% = 1
		ELSE
			' It is a heat race, so the places in following heats start from
			' the number who FINISHED in the previous heat.
			' This should be the same as the current value of "place%"...
			IF heat% > 1 THEN
				IF place% <> numheatfinish%(race%, heat% - 1) + 1 THEN
					PRINT "Error -- Places in next heat do not start where they should"
					PRINT "Race"; race%; "heat"; heat%; "next place is"; place%
					PRINT "According to previous heat finishers, however, it should be"; numheatfinish%(race%, heat% - 1) + 1
				END IF
			END IF
		END IF
 
	  
		i% = 1
		sail% = result%(race%, heat%, i%)
		DO UNTIL sail% = 0
	  
			code$ = rescode$(race%, heat%, i%)
			ind% = index%(sail%)

			'  Allocate places
			'  Check a given sail no is not duplicated in a race
			IF yracepos%(ind%, race%) = 0 THEN
				yracepos%(ind%, race%) = place%
			ELSE
				PRINT "Sail no"; sail%; "duplicated in race"; race%
				PRINT "Apparently placed"; yracepos%(ind%, race%); "as well as"; place%
				INPUT "... <CR> to quit ..."; x$
				STOP
			END IF
	  
			' Check if a penalty or result code over-rides the place%
			' If so, reserve place% for the next yacht (the next yacht moves up)
			' If not, increment place% for next yacht (the next yacht does not move up)
			' Apart from RDG and TIE, every yacht moves up.
			yracecode$(ind%, race%) = code$
			IF LEN(code$) > 0 THEN c$ = MID$(code$, 1, 3) ELSE c$ = ""

			SELECT CASE c$
				CASE "": place% = place% + 1
				CASE "DNC": yracepos%(ind%, race%) = DNCpos%(race%, heat%)
				CASE "DNS": yracepos%(ind%, race%) = DNSpos%(race%, heat%)
				CASE "OCS": yracepos%(ind%, race%) = OCSpos%(race%, heat%)
				CASE "DNF": yracepos%(ind%, race%) = DNFpos%(race%, heat%)
				CASE "RET", "RAF": yracepos%(ind%, race%) = RETpos%(race%, heat%)
				CASE "DSQ": yracepos%(ind%, race%) = DSQpos%(race%, heat%)
				CASE "DND": yracepos%(ind%, race%) = DNDpos%(race%, heat%)
				CASE "RDG": place% = place% + 1
				CASE "OOT": yracepos%(ind%, race%) = OOTpos%(race%, heat%)
				CASE "TIE": place% = place% + 1
				CASE ELSE
					PRINT "Unrecognised code in race"; race%; "for"; sail%;
					PRINT "apparently placed"; place%
			END SELECT
			IF debug > 0 THEN
				PRINT "/"; sail%; ":"; yracepos%(ind%, race%); " ";
			ELSE
				IF progress > 0 THEN PRINT ".";
			END IF
	  
			i% = i% + 1
			sail% = result%(race%, heat%, i%)
	  
		LOOP
  
		IF debug > 0 THEN INPUT "  <CR> to continue"; x$

	NEXT heat%
  
	sail% = 1
	DO
		ind% = index%(sail%)
		IF ind% > 0 THEN
			' If the yacht is not mentioned as a finisher,
			' give it the DNC position
			' Note that the yacht gets DNC as of the lowest heat
			IF yracepos%(ind%, race%) = 0 THEN
				yracepos%(ind%, race%) = DNCpos%(race%, numheat%(race%))
				yracecode$(ind%, race%) = "DNC"
			END IF
			IF debug > 0 THEN PRINT "/"; sail%; ":"; yracepos%(ind%, race%); " ";
		END IF
		sail% = sail% + 1
	LOOP UNTIL sail% > maxsailno%
	IF debug > 0 THEN INPUT "  <CR> to continue"; x$

NEXT race%
PRINT

END SUB

SUB buildind

'  Build the index array, and count the number of entrants, starters, finishers
'  The index is the cross-reference array between the jib number, and the yacht's
'  index position in the various arrays
numevententry% = 0

IF ((progress > 0) OR (debug > 0)) THEN PRINT "Building index ";
FOR race% = 1 TO numrace%
  
	FOR heat% = 1 TO numheat%(race%)
		numheatentry%(race%, heat%) = 0

		IF debug > 0 THEN PRINT racetype$(race%); race%; "h"; heat%; ":";
		place% = 0
		DO
			place% = place% + 1
			sail% = result%(race%, heat%, place%)
			IF sail% <> 0 THEN
				' Is this a previously unknown yacht?
				IF index%(sail%) = 0 THEN
					' Yes, so give it an index
					numevententry% = numevententry% + 1
					IF debug > 0 THEN PRINT sail%; "("; numevententry%; ") ";
					IF progress > 0 THEN PRINT ".";
					index%(sail%) = numevententry%
					IF numevententry% > maxentry% THEN
						PRINT "Too many entrants (max is"; maxentry%; ")!"
						INPUT "... <CR> to quit ..."; x$
						STOP
					END IF
				END IF
			END IF
		LOOP UNTIL sail% = 0
		IF debug > 0 THEN PRINT "   ";
	  
		' "place%" is the number of yachts listed in the results line
		' Assume this is the number of scheduled to race in the heat
		numheatsched%(race%, heat%) = place% - 1
	NEXT heat%
NEXT race%

FOR race% = 1 TO numrace%

	' Calculate the number of starters and finishers for the race by ignoring
	' certain codes
  
	FOR heat% = 1 TO numheat%(race%)

		nos% = 0: nof% = 0
	  
		FOR place% = 1 TO numheatsched%(race%, heat%)
			IF LEN(rescode$(race%, heat%, place%)) > 0 THEN c$ = MID$(rescode$(race%, heat%, place%), 1, 3) ELSE c$ = ""
			SELECT CASE c$
		  
				' These codes indicate non-starters
				CASE "DNC": nos% = nos% + 1
				CASE "DNS": nos% = nos% + 1
				CASE "OCS": nos% = nos% + 1

				' These codes indicate non-finishers
				CASE "DNF": nof% = nof% + 1
				CASE "RET", "RAF": nof% = nof% + 1
				CASE "DSQ": nof% = nof% + 1
				CASE "DND": nof% = nof% + 1
				CASE "OOT": nof% = nof% + 1
		  
				' Do nothing with these codes
				CASE "RDG"
				CASE "TIE"
				CASE ""

				' Unrecognised
				CASE ELSE
					PRINT "Unrecognised code"; racetype$(race%); race%; "h"; heat%; "for"; sail%;
					PRINT "apparently placed"; place%
			END SELECT
		NEXT place%
	 
		' Seeding races are self-contained.
		' Heat races, however, have "entry" sizes which increase with each heat
		' Note that the cumulative "heat entry" is the previous heat FINISHERS
		'  plus those scheduled for this heat...
		IF racetype$(race%) = "R" AND heat% > 1 THEN
			numheatentry%(race%, heat%) = numheatsched%(race%, heat%) + numheatfinish%(race%, heat% - 1)
		ELSE
			numheatentry%(race%, heat%) = numheatsched%(race%, heat%)
		END IF

		' Reduce the count of the number of starters appropriately
		numheatstart%(race%, heat%) = numheatsched%(race%, heat%) - nos%

		' Set number of finishers as number of starters less those ignored
		numheatfinish%(race%, heat%) = numheatstart%(race%, heat%) - nof%
	  
		IF racetype$(race%) = "R" AND heat% > 1 THEN
			numheatstart%(race%, heat%) = numheatstart%(race%, heat%) + numheatfinish%(race%, heat% - 1)
		END IF
	  
		IF racetype$(race%) = "R" AND heat% > 1 THEN
			numheatfinish%(race%, heat%) = numheatfinish%(race%, heat%) + numheatfinish%(race%, heat% - 1)
		END IF

	NEXT heat%
NEXT race%

' Report the number of entrants etc found
CALL reviewnums

sail% = 1
DO UNTIL sail% > maxsailno%
	ind% = index%(sail%)
	IF ind% > 0 THEN
		yjibno%(ind%) = sail%
	END IF
	sail% = sail% + 1
LOOP

' Classic bubble sort
' Put jib numbers into numerical order
bound% = numevententry%
DO
	t% = 0
	FOR j% = 1 TO bound% - 1

		IF yjibno%(j%) > yjibno%(j% + 1) THEN
			t% = j%
			temp% = yjibno%(j%)
			yjibno%(j%) = yjibno%(j% + 1)
			yjibno%(j% + 1) = temp%

			index%(yjibno%(j%)) = j%
			index%(yjibno%(j% + 1)) = j% + 1
		END IF
	
	NEXT j%
	bound% = t%

LOOP UNTIL t% = 0

IF debug = -1 THEN
	sail% = 1
	DO
		ind% = index%(sail%)
		IF ind% > 0 THEN
			PRINT sail%; "("; ind%; ") ";
		END IF
		sail% = sail% + 1
	LOOP UNTIL sail% > maxsailno%
END IF

END SUB

SUB calcavg (ind%, avg!)

'  The calculations IGNORE seeding race results if any.
'  The calculations are made after discards are taken away.
'  However, check that the seeding race result wasn't a discard...

numr% = 0
avg! = ytotpoints(ind%)

IF debug = -5 THEN PRINT "  a"; avg!; "/"; numrace%;
' Take out any seeding race results
FOR race% = 1 TO numrace%
	IF racetype$(race%) = "S" THEN
		avg! = avg! - yracepoints(ind%, race%)
	ELSE
		numr% = numr% + 1
	END IF
NEXT race%
IF debug = -5 THEN PRINT "  b"; avg!; "/"; numr%;

' Put back any seeding race results that were already discarded...
IF numdisc% > 0 THEN
FOR disc% = 1 TO numdisc%
	IF disctype$(ind%, disc%) = "S" THEN
		numr% = numr% + 1
		avg! = avg! + disclist(ind%, disc%)
	END IF
NEXT disc%
END IF
IF debug = -5 THEN PRINT "  c"; avg!; "/"; numr%;

avg! = avg! / (numr% - numdisc%)

END SUB

SUB calcmed (ind%, medval!)

' Calculate a median for the yacht in index ind%
' There are "numrace% - seeding" unordered points in the "median" array

numr% = 0
FOR race% = 1 TO numrace%
	IF racetype$(race%) = "R" THEN
		numr% = numr% + 1
		median(numr%) = yracepoints(ind%, race%)
	END IF
NEXT race%

' Classic bubble sort

bound% = numr%
DO
	t% = 0
	FOR j% = 1 TO bound% - 1
  
		IF median(j%) > median(j% + 1) THEN
			t% = j%
			temp = median(j%)
			median(j%) = median(j% + 1)
			median(j% + 1) = temp
		END IF
		
	NEXT j%
	bound% = t%

LOOP UNTIL t% = 0
' The median array is now sorted in order

midpt = (numr% + 1) / 2
i% = INT(midpt)
i = i%
IF ABS(midpt - i) > .01 THEN itsodd% = 1 ELSE itsodd% = 0

' Before ignoring the apparent discards, check that they
' are not seeding race discards.  If they are, they're already
' ignored -- so reduce the number of apparent discards accordingly.

igd% = numdisc%
FOR disc% = 1 TO numdisc%
	IF disctype$(ind%, disc%) = "S" THEN igd% = igd% - 1
NEXT disc%

IF ((scoresys% < 3) OR (scoresys% = 5)) THEN
	midpt = midpt - (igd% / 2)
ELSE
	midpt = midpt + (igd% / 2)
END IF

IF debug = -5 THEN PRINT "Midpt="; midpt; "  itsodd="; itsodd%
IF debug = -5 THEN
	FOR i% = 1 TO numr%
		PRINT median(i%);
	NEXT i%
END IF

' If midpt is an integer, the median is median(midpt)
' If midpt is fractional, the median is between median(midpt-.5)
' and median(midpt+.5)

IF itsodd% = 0 THEN
	medval! = median(midpt)
ELSE
	medval! = (median(midpt - .5) + median(midpt + .5)) / 2
END IF

END SUB

SUB decomp (line$, it$, beg%, numb$, text$)
' Extract the data from the results line

' Get the next data segment
CALL getseg(line$, it$, beg%)

' Got the string in "it$"
' Now extract the sail number and any adjacent text
' Jib no first...

i% = 0
gotjib% = 0
numb$ = ""
text$ = ""
DO
	i% = i% + 1
	c$ = MID$(it$, i%, 1)
	IF ASC(c$) < 64 THEN
		numb$ = numb$ + c$
	ELSE
		text$ = text$ + c$
		gotjib% = 1
	END IF
LOOP UNTIL ((i% >= LEN(it$)) OR (gotjib% = 1))

IF gotjib% = 1 THEN
	'Treat all remaining material as text
	DO UNTIL i% >= LEN(it$)
		i% = i% + 1
		c$ = MID$(it$, i%, 1)
		text$ = text$ + c$
	LOOP
	text$ = UCASE$(text$)
END IF

SELECT CASE LEN(text$)

CASE 0, 3
	' It's fine, do nothing
CASE 1, 2
	PRINT "Warning, bad code of <"; text$; "> found."
CASE ELSE
	IF MID$(text$, 1, 3) = "RDG" THEN
		' OK, the rest consists of the number
	ELSE
		PRINT "Warning, bad code of <"; text$; "> found."
	END IF
END SELECT

END SUB

SUB discard

' Calculate the discards and final total points
' Ask for number of discards

SELECT CASE numrace%
	CASE 0 TO 3: nd% = 0
	CASE 4 TO 9: nd% = 1
	CASE 10 TO 18: nd% = 2
	CASE 19 TO 27: nd% = 3
	CASE 28 TO 36: nd% = 4
	CASE ELSE
		nd% = INT((numrace% + 1) / 9) + 1
END SELECT

IF usedefault% = 0 THEN
	DO
		PRINT
		PRINT "Number of discards (max="; maxdisc%; "  Suggested default="; nd%; ") ";
		INPUT numdisc%
	LOOP UNTIL numdisc% <= maxdisc%
	IF numdisc% < 0 THEN numdisc% = nd%
ELSE
	numdisc% = nd%
END IF

IF ((progress > 0) OR (debug > 0)) THEN PRINT "Calculating"; numdisc%; "discards ";

ind% = 1
DO
 
	IF progress > 0 THEN PRINT ".";
	' Zero the total points
	ytotpoints(ind%) = 0

	'  Prime the discard list
	FOR i% = 1 TO numdisc%
		disclist(ind%, i%) = 0
		disctype$(ind%, i%) = ""
	NEXT i%

	' The search for discards always starts with race 1.
	' If a usable discard is found, it represents
	' the discard being applied to the earliest race result possible,
	' as required by RRS Appendix A.
	race% = 1
	DO
		IF yracecode$(ind%, race%) = "DND" THEN
			' Ignore this one, it can't be discarded
			race% = race% + 1
		ELSE
			i% = 1
			DO UNTIL i% > numdisc%
				IF yracepoints(ind%, race%) > disclist(ind%, i%) THEN
			  
					' Found a discard
					IF debug > 0 THEN PRINT yracepoints(ind%, race%);
					disclist(ind%, i%) = yracepoints(ind%, race%)
				  
					' Note the discard race type
					disctype$(ind%, i%) = racetype$(race%)

					' Re-order the discard list before continuing
					IF numdisc% > 1 THEN CALL orderdisclist(ind%)

					i% = numdisc% + 1
				ELSE
					i% = i% + 1
				END IF
			LOOP
			race% = race% + 1
		END IF
	LOOP UNTIL race% > numrace%
	IF debug > 0 THEN PRINT "/";

	FOR race% = 1 TO numrace%
		ytotpoints(ind%) = ytotpoints(ind%) + yracepoints(ind%, race%)
	NEXT race%

	i% = 1
	DO UNTIL i% > numdisc%
		ytotpoints(ind%) = ytotpoints(ind%) - disclist(ind%, i%)
		IF debug > 0 THEN PRINT disclist(ind%, i%);
		i% = i% + 1
	LOOP

	IF debug > 0 THEN PRINT ")"; ytotpoints(ind%);

	ind% = ind% + 1
LOOP UNTIL ind% > numevententry%

IF progress > 0 OR debug > 0 THEN PRINT

END SUB

SUB dispres (file$)

'  Take the *.OUT file, and display it on the screen

coun% = 1
posn% = 1
OPEN file$ FOR BINARY AS #2

DO UNTIL (EOF(2))
	GET #2, posn%, item%
	posn% = posn% + 1
 
	it1% = item% \ 256

	SELECT CASE it1%
	CASE 34
		' PRINT " ";
	CASE 58
		coun% = 0
		PRINT
		INPUT "... <CR> ..."; x$
		PRINT
	CASE 13
		PRINT
		coun% = coun% + 1
		IF coun% > 22 THEN
			PRINT
			INPUT "... <CR> ..."; x$
			PRINT
			coun% = 0
		END IF
	CASE 10
		REM Do nothing
	CASE ELSE
		PRINT CHR$(it1%);
	END SELECT
LOOP

CLOSE #2

END SUB

SUB disptable

PRINT
PRINT desc$
PRINT "POSITIONS after"; numdisc%; "discards and"; numrace%; "races."

somezred% = 0

PRINT "     ";
FOR race% = 1 TO numrace%
	PRINT "  "; racetype$(race%);
	PRINT USING "##"; race%;
NEXT race%
PRINT "  Total"

lines% = 0
FOR place% = 1 TO numevententry%
	ind% = index%(finishlist%(place%))
	PRINT USING "#####"; yjibno%(ind%);
	lines% = lines% + 1

	FOR race% = 1 TO numrace%
		PRINT USING "###.#"; yracepoints(ind%, race%);
	NEXT race%

	PRINT USING "#####.#"; ytotpoints(ind%);
	SELECT CASE ytie$(ind%)
	  CASE "=":  PRINT "=";
	  CASE "<":  PRINT "<";
	  CASE "*":  PRINT "*";
	  CASE ELSE: PRINT " ";
	END SELECT
		 
	zerored% = 0
	FOR race% = 1 TO numrace%
		c$ = MID$(yracecode$(ind%, race%), 1, 3)
		IF c$ = "RDG" THEN
			 
			 i% = LEN(yracecode$(ind%, race%))
			 IF i% > 3 THEN
				rp = VAL(MID$(yracecode$(ind%, race%), 4, i%))
			 ELSE
				rp = 0
			 END IF

			 IF rp < .001 THEN zerored% = 1
		END IF
	 NEXT race%
		  
	 IF zerored% = 1 THEN
		PRINT "!"
		somezred% = 1
	 ELSE
		PRINT " "
	 END IF
	 IF lines% > 19 THEN
		 lines% = 0
		 INPUT "--- <CR> to continue ---"; x$
	 END IF
NEXT place%

IF lines% > 0 THEN
	INPUT "--- <CR> to continue ---"; x$
END IF

IF somezred% = 1 THEN
	PRINT "(!) NOTICE: An RDG has not been allocated a value"
	INPUT "... <CR> ..."; x$
END IF

END SUB

SUB dispyacht (sail%)

'  Display the detailed results for a given yacht

PRINT
PRINT "JIB NUMBER : "; sail%
ind% = index%(sail%)

IF ind% <> 0 THEN

PRINT "Discards shown as -ve"
PRINT "Race #: ";

FOR race% = 1 TO numrace%
	PRINT "   "; racetype$(race%);
	PRINT USING "##"; race%;
NEXT race%

FOR n% = 1 TO numdisc%
	PRINT USING "######"; -n%;
NEXT n%

PRINT
PRINT "Positn: ";

FOR race% = 1 TO numrace%
	c$ = MID$(yracecode$(ind%, race%), 1, 3)
	SELECT CASE c$
		CASE "", "RDG", "TIE": PRINT USING "######"; yracepos%(ind%, race%);
		CASE ELSE: PRINT "    --";
	END SELECT
NEXT race%

PRINT
PRINT "Points: ";

FOR race% = 1 TO numrace%
	PRINT USING "####.#"; yracepoints(ind%, race%);
NEXT race%

FOR n% = 1 TO numdisc%
  PRINT USING "####.#"; -disclist(ind%, n%);
NEXT n%

PRINT
PRINT "Codes:  ";
hasredress% = 0
FOR race% = 1 TO numrace%
	PRINT "   ";
	PRINT USING "\ \"; yracecode$(ind%, race%);
	c$ = MID$(yracecode$(ind%, race%), 1, 3)
	IF c$ = "RDG" THEN
		hasredress% = 1
	END IF
NEXT race%

IF hasredress% = 1 THEN
	zerored% = 0
	PRINT
	PRINT "Value:  ";
	FOR race% = 1 TO numrace%
		c$ = MID$(yracecode$(ind%, race%), 1, 3)
		IF c$ = "RDG" THEN
			i% = LEN(yracecode$(ind%, race%))
			IF i% > 3 THEN
			  rp = VAL(MID$(yracecode$(ind%, race%), 4, i%))
			ELSE
			  rp = 0
			END IF
			PRINT USING "####.#"; rp;
			IF rp < .001 THEN zerored% = 1
		ELSE
			PRINT "      ";
		END IF
	NEXT race%
	IF zerored% = 1 THEN
		PRINT
		PRINT "NOTICE:  An RDG code has no associated value";
	END IF
END IF

PRINT
PRINT
PRINT " Total  Final  If      Avg  Median          Tie breaking:"
PRINT "points   posn  tie  points  points          '=' Tie remains with another"
PRINT USING "####.#"; ytotpoints(ind%);
PRINT USING "#######"; yfinalpos%(ind%);
PRINT "  ";
PRINT USING "\\"; ytie$(ind%);
PRINT " ";

'  Average and median points are calculated to help with any redress
'  situations.  Because the regatta calculator can be run any number of
'  times against a given data file, you can run the program once to
'  figure out redress points, then run it again with those redress
'  points entered into the data file, or specified when the program
'  requests them.

CALL calcavg(ind%, avg!)
PRINT USING "######.#"; avg!;

CALL calcmed(ind%, medval!)
PRINT USING "######.#"; medval!;

PRINT "          '*' Tie broken by better place"
PRINT "                                            '<' Tie broken on count-back"

ELSE
PRINT "Invalid jib number!"
END IF

END SUB

SUB eventres

'  Calculate the results of the event over all the races
'  Initialise all final positions to "unplaced"
FOR i% = 1 TO numevententry%
	yfinalpos%(i%) = 0
NEXT i%

'  Calculate event overall positions
FOR place% = 1 TO numevententry%
 
	SELECT CASE scoresys%
  
	CASE 1, 2, 5
		'  Just think of a big number here to start with...
		score = (numevententry% + 7) * numrace%
		ind% = 1
		bestind% = 0
		DO
			IF ((ytotpoints(ind%) < score) AND (yfinalpos%(ind%) = 0)) THEN
				score = ytotpoints(ind%)
				bestind% = ind%
			END IF
			ind% = ind% + 1
		LOOP UNTIL ind% > numevententry%
		yfinalpos%(bestind%) = place%

	CASE 3, 4
		score = 0
		ind% = 1
		bestind% = 0
		DO
			IF ((ytotpoints(ind%) > score) AND (yfinalpos%(ind%) = 0)) THEN
				score = ytotpoints(ind%)
				bestind% = ind%
			END IF
			ind% = ind% + 1
		LOOP UNTIL ind% > numevententry%
		yfinalpos%(bestind%) = place%

	END SELECT

NEXT place%

' Resolve any ties
CALL resolvetie

' Write the *.OUT file
CALL writeout

END SUB

SUB finishtie

' Check for finish line ties
' If there are TIE codes, simply share the points
' Make no adjustment to position

IF ((progress > 0) OR (debug = -4)) THEN PRINT "Checking for finish line TIEs ";
FOR race% = 1 TO numrace%
	FOR heat% = 1 TO numheat%(race%)
		IF progress > 0 THEN PRINT ".";
		place% = 1
		IF debug = -4 THEN PRINT : PRINT race%; heat%;
		DO
			gottatie% = 0
			pointer% = place%
			numtie% = 0
			tiepts = 0
			IF debug = -4 THEN PRINT " ^";
			DO
				numtie% = numtie% + 1: IF debug = -4 THEN PRINT "numtie"; numtie%;
				IF numtie% > 1 THEN gottatie% = 1: IF debug = -4 THEN PRINT " gottatie"; gottatie%;
				sail% = result%(race%, heat%, pointer%): IF debug = -4 THEN PRINT " sail"; sail%;
				tiepts = tiepts + yracepoints(index%(sail%), race%): IF debug = -4 THEN PRINT " tiepts"; tiepts;
				pointer% = pointer% + 1: IF debug = -4 THEN PRINT " pointer"; pointer%;
			LOOP UNTIL rescode$(race%, heat%, pointer% - 1) <> "TIE"
			FOR tie% = 1 TO numtie%
				sail% = result%(race%, heat%, place% + tie% - 1)
				yracepoints(index%(sail%), race%) = tiepts / numtie%
				IF debug = -4 AND gottatie% = 1 THEN PRINT sail%; "tied, pts"; tiepts / numtie%; " ";
			NEXT tie%
			place% = place% + numtie%
		LOOP UNTIL place% > numheatsched%(race%, heat%)
	NEXT heat%
NEXT race%
IF progress > 0 OR debug = -4 THEN PRINT

END SUB

SUB getfile (file$, prompt$, extn$)

'  Ask for the name of the *.DAT file
'  or help the user choose the right file
'  NOTE that you cannot change drives...

req% = 0
spec$ = "*" + extn$

DO
	PRINT
	IF file$ = "" THEN
		PRINT "Current "; prompt$; " file name is unspecified"
	ELSE
		PRINT "Current "; prompt$; " file name is "; file$; extn$
	END IF
	PRINT "0:Accept  1:Change dir  ";
	PRINT "2:List "; extn$; " files  ";
	PRINT "3:Specify file  4:List all files";
	INPUT req%

	SELECT CASE req%

	CASE 1
		INPUT "Required directory path (cannot change drive)"; a$
		CHDIR a$

	CASE 2
		PRINT
		FILES spec$

	CASE 3
		PRINT "Enter "; prompt$;
		INPUT " file name (omit extension)"; file$
		file$ = UCASE$(file$)

	CASE 4
		PRINT
		FILES

	END SELECT
LOOP UNTIL req% = 0 OR req% = 3

END SUB

SUB getseg (line$, it$, beg%)

REM
REM Extract the next data segment "It$" from "line$" starting at "beg%"
REM

lt% = LEN(line$)
it$ = ""

DO
	beg% = beg% + 1
	c$ = MID$(line$, beg%, 1)
LOOP UNTIL ((c$ <> " ") OR (beg% >= lt%))
fin% = beg%

IF fin% < lt% THEN
	DO
		fin% = fin% + 1
		c$ = MID$(line$, fin%, 1)
	LOOP UNTIL ((c$ = " ") OR (fin% >= lt%))
END IF

IF fin% >= lt% THEN
	it$ = MID$(line$, beg%, fin% - beg% + 1)
ELSE
	it$ = MID$(line$, beg%, fin% - beg%)
END IF

beg% = fin%

END SUB

SUB givepoints

IF ((progress > 0) OR (debug > 0)) THEN PRINT "Allocating points ";
ind% = 1
DO
	sail% = yjibno%(ind%)
	IF debug > 0 THEN PRINT " "; sail%; "(";
	IF progress > 0 THEN PRINT ".";
 
	' Allocate points for the position in the race
	FOR race% = 1 TO numrace%
			
		'  The points value of a position is determined by the
		'  scoring system, and is set up earlier
		yracepoints(ind%, race%) = pointval(yracepos%(ind%, race%))
		IF yracecode$(ind%, race%) <> "" THEN
		 
			c$ = MID$(yracecode$(ind%, race%), 1, 3)
			SELECT CASE c$
				CASE "DNC"
				CASE "DNS"
				CASE "OCS"
				CASE "DNF"
				CASE "DSQ"
				CASE "DND"
					' It's non-discardable below
				CASE "RDG"
					CALL giveredress(ind%, race%)
				CASE "OOT"
				CASE "RET", "RAF"
				CASE "TIE"
				CASE ELSE
					PRINT "Unknown code <"; c$; ">! ";
			END SELECT
		END IF
	NEXT race%
	ind% = ind% + 1
LOOP UNTIL ind% > numevententry%
IF progress > 0 OR debug > 0 THEN PRINT

END SUB

SUB giveredress (ind%, race%)

' Extract the redress points given with the RDG code
i% = LEN(yracecode$(ind%, race%))
IF i% > 3 THEN
	rp = VAL(MID$(yracecode$(ind%, race%), 4, i%))
ELSE
	rp = 0
END IF

IF rp < .001 THEN
	PRINT
	PRINT "No redress points specified for jib no"; yjibno%(ind%); "in race"; race%
	PRINT "-1:Specify them later   xx.x:Use these";
	INPUT rp
	IF rp > 0 THEN
		yracecode$(ind%, race%) = yracecode$(ind%, race%) + STR$(rp)
	END IF
END IF

IF rp > 0 THEN
	PRINT
	PRINT "There are"; rp; "redress points specified for jib no"; yjibno%(ind%); "in race"; race%
	PRINT "-1:Delete and respecify them later   0:Correct   xx.x:Use these instead";
	INPUT rp2
	IF rp2 > 0 THEN
		yracecode$(ind%, race%) = MID$(yracecode$(ind%, race%), 1, 3)
		rp = rp2
		yracecode$(ind%, race%) = yracecode$(ind%, race%) + STR$(rp)
	END IF
	IF rp2 < 0 THEN
		rp = 0
		yracecode$(ind%, race%) = MID$(yracecode$(ind%, race%), 1, 3)
	END IF
END IF

IF rp > 0 THEN yracepoints(ind%, race%) = rp

END SUB

SUB initial

' Initialise the various arrays
' NB Results codes can't be initialised until
' "buildind" establishes the value of "numevententry%"

FOR i% = 1 TO maxrace%
FOR j% = 1 TO maxheat%
FOR k% = 1 TO maxheatsize%
	result%(i%, j%, k%) = 0
NEXT k%
NEXT j%
NEXT i%

FOR i% = 1 TO maxsailno%
	index%(i%) = 0
NEXT i%

FOR i% = 1 TO maxentry%
FOR j% = 1 TO maxdisc%
	disclist(i%, j%) = 0
NEXT j%
NEXT i%

DSQbase% = 1: DSQbonus% = 1
DNDbase% = 1: DNDbonus% = 1
OCSbase% = 2: OCSbonus% = 1
DNCbase% = 2: DNCbonus% = 1
DNSbase% = 2: DNSbonus% = 1
DNFbase% = 2: DNFbonus% = 1
OOTbase% = 2: OOTbonus% = 1
RETbase% = 2: RETbonus% = 1

END SUB

SUB listplace

'  List the yachts in finishing position order

PRINT
PRINT desc$
PRINT "POSITIONS after"; numdisc%; "discards and"; numrace%; "races."

somezred% = 0

e = numevententry%
cols% = INT(1! + e / 20!)

FOR c% = 1 TO cols%
	PRINT " Posn  Jib  Total  ";
NEXT c%
PRINT

IF numevententry% > 20 THEN rows% = 20 ELSE rows% = numevententry%

FOR r% = 1 TO rows%

	FOR c% = 1 TO cols%
		place% = r% + 20 * (c% - 1)
		IF place% <= numevententry% THEN
			ind% = index%(finishlist%(place%))
			PRINT USING "####"; yfinalpos%(ind%);
			SELECT CASE ytie$(ind%)
			  CASE "=":  PRINT "=";
			  CASE "<":  PRINT "<";
			  CASE "*":  PRINT "*";
			  CASE ELSE: PRINT " ";
			END SELECT
			PRINT USING "#####"; yjibno%(ind%);
			PRINT USING "#####.#"; ytotpoints(ind%);
		  
			zerored% = 0
			FOR race% = 1 TO numrace%
			  c$ = MID$(yracecode$(ind%, race%), 1, 3)
			  IF c$ = "RDG" THEN
				
					i% = LEN(yracecode$(ind%, race%))
					IF i% > 3 THEN
					  rp = VAL(MID$(yracecode$(ind%, race%), 4, i%))
					ELSE
					  rp = 0
					END IF

					IF rp < .001 THEN zerored% = 1
			  END IF
			NEXT race%
			IF zerored% = 1 THEN
			  PRINT "!  ";
			  somezred% = 1
			ELSE
			  PRINT "   ";
			END IF
		END IF
	NEXT c%
	PRINT
NEXT r%

IF somezred% = 1 THEN PRINT "(!) NOTICE: An RDG has not been allocated a value"
INPUT "... <CR> ..."; x$

END SUB

SUB listpoint

' List the yachts in jib number order

PRINT
PRINT desc$
PRINT "POINTS after"; numdisc%; "discards and"; numrace%; "races."
somezred% = 0

e = numevententry%
cols% = INT(1! + e / 20!)

FOR c% = 1 TO cols%
	PRINT " Jib  Total Posn   ";
NEXT c%
PRINT

IF numevententry% > 20 THEN rows% = 20 ELSE rows% = numevententry%

FOR r% = 1 TO rows%
FOR c% = 1 TO cols%
		ind% = r% + 20 * (c% - 1)
		IF ind% <= numevententry% THEN
			
			PRINT USING "####"; yjibno%(ind%);
			PRINT USING "#####.#"; ytotpoints(ind%);
			PRINT USING "#####"; yfinalpos%(ind%);
			SELECT CASE ytie$(ind%)
			  CASE "=":  PRINT "=";
			  CASE "<":  PRINT "<";
			  CASE "*":  PRINT "*";
			  CASE ELSE: PRINT " ";
			END SELECT
		  
			zerored% = 0
			FOR race% = 1 TO numrace%
			  c$ = MID$(yracecode$(ind%, race%), 1, 3)
			  IF c$ = "RDG" THEN
					i% = LEN(yracecode$(ind%, race%))
					IF i% > 3 THEN
					  rp = VAL(MID$(yracecode$(ind%, race%), 4, i%))
					ELSE
					  rp = 0
					END IF
					IF rp < .001 THEN zerored% = 1
			  END IF
			NEXT race%
			IF zerored% = 1 THEN
			  PRINT "!  ";
			  somezred% = 1
			ELSE
			  PRINT "   ";
			END IF
		 
		END IF
	NEXT c%
	PRINT
NEXT r%

IF somezred% = 1 THEN PRINT "(!) NOTICE: An RDG has not been allocated a value"
INPUT "... <CR> ..."; x$

END SUB

SUB orderdisclist (ind%)

' Re-order the discards list
' Necessary so that the discards list can be changed as worse
'  results are found

' Classic bubble sort

bound% = numdisc%
DO
	t% = 0
	FOR j% = 1 TO bound% - 1
 
		IF disclist(ind%, j%) > disclist(ind%, j% + 1) THEN
			t% = j%
			temp = disclist(ind%, j%)
			temp$ = disctype$(ind%, j%)
			disclist(ind%, j%) = disclist(ind%, j% + 1)
			disctype$(ind%, j%) = disctype$(ind%, j% + 1)
			disclist(ind%, j% + 1) = temp
			disctype$(ind%, j% + 1) = temp$
		END IF
		
	NEXT j%
	bound% = t%

LOOP UNTIL t% = 0


END SUB

SUB pencode

'  Assign the penalty position to the various codes
'  If you want, you can assign different positions
'  Yachts will be assigned points based on their position

'  "base" defines where the position starts:
'    1=number of whole event entry
'    2=number of heat/seeding race entry
'    3=number of heat/seeding race starters
'    4=number of heat/seeding race finishers
'  "bonus" defines the addition to make to the base
'    Usually 1

DIM maxheatentry%(maxrace%)
DIM basetext$(4), padtext$(4)
basetext$(1) = "Event entry": padtext$(1) = "   "
basetext$(2) = "Heat entry": padtext$(2) = "    "
basetext$(3) = "Heat starters": padtext$(3) = " "
basetext$(4) = "Heat finishers": padtext$(4) = ""

done% = 0

' Calculate, for seeding races, the largest seeding race entry
race% = 1
DO UNTIL race% > numrace% OR racetype$(race%) = "R"
	maxheatentry%(race%) = 1
	FOR heat% = 1 TO numheat%(race%)
		IF maxheatentry%(race%) < numheatsched%(race%, heat%) THEN
			maxheatentry%(race%) = numheatsched%(race%, heat%)
		END IF
	NEXT heat%
	race% = race% + 1
LOOP

DO

IF usedefault% = 0 THEN

	DSQtext$ = "    " + basetext$(DSQbase%) + " +" + STR$(DSQbonus%) + padtext$(DSQbase%)
	DNDtext$ = "    " + basetext$(DNDbase%) + " +" + STR$(DNDbonus%) + padtext$(DNDbase%)
	OCStext$ = "    " + basetext$(OCSbase%) + " +" + STR$(OCSbonus%) + padtext$(OCSbase%)
	DNCtext$ = "    " + basetext$(DNCbase%) + " +" + STR$(DNCbonus%) + padtext$(DNCbase%)
	DNStext$ = "    " + basetext$(DNSbase%) + " +" + STR$(DNSbonus%) + padtext$(DNSbase%)
	DNFtext$ = "    " + basetext$(DNFbase%) + " +" + STR$(DNFbonus%) + padtext$(DNFbase%)
	OOTtext$ = "    " + basetext$(OOTbase%) + " +" + STR$(OOTbonus%) + padtext$(OOTbase%)
	RETtext$ = "    " + basetext$(RETbase%) + " +" + STR$(RETbonus%) + padtext$(RETbase%)

	PRINT
	PRINT "Penalty positions"
	PRINT "(Base:  1=Event entry  2=Heat entry  3=Heat starters  4=Heat finishers)"
	PRINT "Ref Item     Base  Bonus                    (UK MYA HMS suggests)"
	PRINT " 2  DSQ     "; DSQbase%; "   "; DSQbonus%; DSQtext$; "  (Event entry +1)"
	PRINT " 3  DND     "; DNDbase%; "   "; DNDbonus%; DNDtext$; "  (Event entry +1)"
	PRINT " 4  OCS     "; OCSbase%; "   "; OCSbonus%; OCStext$; "  (Heat entry +1)"
	PRINT " 5  DNC     "; DNCbase%; "   "; DNCbonus%; DNCtext$; "  (Heat entry +1)"
	PRINT " 6  DNS     "; DNSbase%; "   "; DNSbonus%; DNStext$; "  (Heat entry +1)"
	PRINT " 7  DNF     "; DNFbase%; "   "; DNFbonus%; DNFtext$; "  (Heat entry +1)"
	PRINT " 8  OOT     "; OOTbase%; "   "; OOTbonus%; OOTtext$; "  (Heat entry +1)"
	PRINT " 9  RET/RAF "; RETbase%; "   "; RETbonus%; RETtext$; "  (Heat entry +1)"
END IF

FOR race% = 1 TO numrace%
	FOR heat% = 1 TO numheat%(race%)
		SELECT CASE DSQbase%
			CASE 1: DSQpos%(race%, heat%) = numevententry% + DSQbonus%
			CASE 2:
				IF racetype$(race%) = "R" THEN
					DSQpos%(race%, heat%) = numheatentry%(race%, heat%) + DSQbonus%
				ELSE
					DSQpos%(race%, heat%) = maxheatentry%(race%) + DSQbonus%
				END IF
			CASE 3: DSQpos%(race%, heat%) = numheatstart%(race%, heat%) + DSQbonus%
			CASE 4: DSQpos%(race%, heat%) = numheatfinish%(race%, heat%) + DSQbonus%
		END SELECT
	 
		SELECT CASE DNDbase%
			CASE 1: DNDpos%(race%, heat%) = numevententry% + DNDbonus%
			CASE 2:
				IF racetype$(race%) = "R" THEN
					DNDpos%(race%, heat%) = numheatentry%(race%, heat%) + DNDbonus%
				ELSE
					DNDpos%(race%, heat%) = maxheatentry%(race%) + DNDbonus%
				END IF
			CASE 3: DNDpos%(race%, heat%) = numheatstart%(race%, heat%) + DNDbonus%
			CASE 4: DNDpos%(race%, heat%) = numheatfinish%(race%, heat%) + DNDbonus%
		END SELECT

		SELECT CASE OCSbase%
			CASE 1: OCSpos%(race%, heat%) = numevententry% + OCSbonus%
			CASE 2:
				IF racetype$(race%) = "R" THEN
					OCSpos%(race%, heat%) = numheatentry%(race%, heat%) + OCSbonus%
				ELSE
					OCSpos%(race%, heat%) = maxheatentry%(race%) + OCSbonus%
				END IF
			CASE 3: OCSpos%(race%, heat%) = numheatstart%(race%, heat%) + OCSbonus%
			CASE 4: OCSpos%(race%, heat%) = numheatfinish%(race%, heat%) + OCSbonus%
		END SELECT
	 
		SELECT CASE DNCbase%
			CASE 1: DNCpos%(race%, heat%) = numevententry% + DNCbonus%
			CASE 2:
				IF racetype$(race%) = "R" THEN
					DNCpos%(race%, heat%) = numheatentry%(race%, heat%) + DNCbonus%
				ELSE
					DNCpos%(race%, heat%) = maxheatentry%(race%) + DNCbonus%
				END IF
			CASE 3: DNCpos%(race%, heat%) = numheatstart%(race%, heat%) + DNCbonus%
			CASE 4: DNCpos%(race%, heat%) = numheatfinish%(race%, heat%) + DNCbonus%
		END SELECT
	  
		SELECT CASE DNSbase%
			CASE 1: DNSpos%(race%, heat%) = numevententry% + DNSbonus%
			CASE 2:
				IF racetype$(race%) = "R" THEN
					DNSpos%(race%, heat%) = numheatentry%(race%, heat%) + DNSbonus%
				ELSE
					DNSpos%(race%, heat%) = maxheatentry%(race%) + DNSbonus%
				END IF
			CASE 3: DNSpos%(race%, heat%) = numheatstart%(race%, heat%) + DNSbonus%
			CASE 4: DNSpos%(race%, heat%) = numheatfinish%(race%, heat%) + DNSbonus%
		END SELECT
	  
		SELECT CASE DNFbase%
			CASE 1: DNFpos%(race%, heat%) = numevententry% + DNFbonus%
			CASE 2:
				IF racetype$(race%) = "R" THEN
					DNFpos%(race%, heat%) = numheatentry%(race%, heat%) + DNFbonus%
				ELSE
					DNFpos%(race%, heat%) = maxheatentry%(race%) + DNFbonus%
				END IF
			CASE 3: DNFpos%(race%, heat%) = numheatstart%(race%, heat%) + DNFbonus%
			CASE 4: DNFpos%(race%, heat%) = numheatfinish%(race%, heat%) + DNFbonus%
		END SELECT
 
		SELECT CASE OOTbase%
			CASE 1: OOTpos%(race%, heat%) = numevententry% + OOTbonus%
			CASE 2:
				IF racetype$(race%) = "R" THEN
					OOTpos%(race%, heat%) = numheatentry%(race%, heat%) + OOTbonus%
				ELSE
					OOTpos%(race%, heat%) = maxheatentry%(race%) + OOTbonus%
				END IF
			CASE 3: OOTpos%(race%, heat%) = numheatstart%(race%, heat%) + OOTbonus%
			CASE 4: OOTpos%(race%, heat%) = numheatfinish%(race%, heat%) + OOTbonus%
		END SELECT
	  
		SELECT CASE RETbase%
			CASE 1: RETpos%(race%, heat%) = numevententry% + RETbonus%
			CASE 2:
				IF racetype$(race%) = "R" THEN
					RETpos%(race%, heat%) = numheatentry%(race%, heat%) + RETbonus%
				ELSE
					RETpos%(race%, heat%) = maxheatentry%(race%) + RETbonus%
				END IF
			CASE 3: RETpos%(race%, heat%) = numheatstart%(race%, heat%) + RETbonus%
			CASE 4: RETpos%(race%, heat%) = numheatfinish%(race%, heat%) + RETbonus%
		END SELECT
	NEXT heat%
NEXT race%

IF usedefault% = 0 THEN
	INPUT "Change to (Ref no), or exit (0) "; ref%
	IF ref% = 0 THEN
		done% = 1
	ELSE
		INPUT " Base "; b%
		INPUT "Bonus "; s%
		IF b% < 1 OR b% > 4 THEN
			PRINT "Bad base!"
			b% = 1
		END IF
		IF s% < 0 OR s% > maxbonus% THEN
			PRINT "Bad bonus!"
			s% = 1
		END IF
		SELECT CASE ref%
			CASE 2: DSQbase% = b%: DSQbonus% = s%
			CASE 3: DNDbase% = b%: DNDbonus% = s%
			CASE 4: OCSbase% = b%: OCSbonus% = s%
			CASE 5: DNCbase% = b%: DNCbonus% = s%
			CASE 6: DNSbase% = b%: DNSbonus% = s%
			CASE 7: DNFbase% = b%: DNFbonus% = s%
			CASE 8: OOTbase% = b%: OOTbonus% = s%
			CASE 9: RETbase% = b%: RETbonus% = s%
			CASE ELSE: PRINT "Bad ref!"
		END SELECT
	END IF
ELSE
	done% = 1
END IF

LOOP UNTIL done% = 1
END SUB

SUB readfile

'  Read the *.DAT file

prompt$ = "race results input data"
extn$ = ".DAT"
file$ = ""
CALL getfile(file$, prompt$, extn$)
IF file$ = "" THEN
	PRINT "Invalid file name!"
	INPUT "... <CR> to quit ..."; x$
	END
END IF

dataset$ = file$
filein$ = dataset$ + extn$

' The file has:
' A one line title (race name & date, probably)
' The total number of races including seeding races, on the next line
' The results of each heat/seeding race, one heat on one line
' A race consists of the sequence of heat results

OPEN filein$ FOR INPUT AS #1
IF debug > 0 THEN PRINT "File of results called "; filein$; " opened"

INPUT #1, desc$
IF debug > 0 THEN PRINT desc$

INPUT #1, numrace%
IF numrace% > maxrace% THEN
	PRINT "Too many races!"
	INPUT "... <CR> to quit ..."; x$
	STOP
END IF
IF numrace% < 1 THEN
	PRINT "Apparently"; numrace%; "races specified!"
	INPUT "... <CR> to quit ..."; x$
	STOP
END IF

PRINT
IF debug > 0 THEN PRINT "Number of races"; numrace%

'  For each race, read the results list -- ie list of sail numbers
IF ((progress > 0) OR (debug > 0)) THEN PRINT "Reading data ";
FOR race% = 1 TO numrace%
  
	INPUT #1, line$
	strt% = 0
	' Extract the race identifier Tn
	' T = S (seeding race) or R (heat race)
	' n = number of heats/seeding races which follow
	CALL getseg(line$, vn$, strt%)
	IF debug > 0 THEN PRINT "/"; vn$; "/ ";

	racetype$(race%) = UCASE$(MID$(vn$, 1, 1))
	IF racetype$(race%) = "S" OR racetype$(race%) = "R" THEN
		' That's fine
	ELSE
		PRINT "Bad race type ("; racetype$(race%); ") specified for race"; race%; "!"
		INPUT "... <CR> to quit ..."; x$
		STOP
	END IF
  
	vn$ = MID$(vn$, 2)
	numheat%(race%) = VAL(vn$)
	IF numheat%(race%) > maxheat% OR numheat%(race%) < 1 THEN
		PRINT "Bad number of heats ("; numheat%(race%); ") specified for race"; race%; "!"
		INPUT "... <CR> to quit ..."; x$
		STOP
	END IF
  
	FOR heat% = 1 TO numheat%(race%)
	  
		INPUT #1, line$
		length% = LEN(line$)
		strt% = 0
	  
		IF ((progress > 0) OR (debug > 0)) THEN
		  PRINT "  "; racetype$(race%);
		  PRINT race%;
		  PRINT " h";
		  PRINT heat%; ":";
		END IF
		place% = 1
		  
		DO
			CALL decomp(line$, vn$, strt%, numb$, text$)
			sail% = VAL(numb$)
				
			IF debug > 0 THEN PRINT " "; sail%; "("; text$; ")";
			IF progress > 0 THEN PRINT ".";
			IF ((sail% > maxsailno%) OR (sail% < 1)) THEN
				PRINT "Bad sail no:"; sail%
				INPUT "... <CR> to quit ..."; x$
				STOP
			END IF
			result%(race%, heat%, place%) = sail%
			rescode$(race%, heat%, place%) = text$
			place% = place% + 1
			IF place% > maxheatsize% THEN
				PRINT "Too many in heat"; heat%; "of race"; race%; "(max is"; maxheatsize%; ")!"
				INPUT "... <CR> to quit ..."; x$
				STOP
			END IF
	  
		LOOP UNTIL strt% >= length%
	NEXT heat%
NEXT race%

PRINT

CLOSE #1
END SUB

SUB resolvetie

'  Resolve ties

DIM count%(2), ylist%(maxsailno%), ylistreas%(maxsailno%)

IF progress > 0 THEN PRINT "Resolving score ties ";

'  Clear the tie indicator array
FOR ind% = 1 TO numevententry%
	ytie$(ind%) = " "
NEXT ind%

' Places are allocated in "yfinalpos%(ind%)" and adjusted for ties
'  that are allowed to remain
' The "finishlist%(place%)" provides a list of all yachts in place order

FOR place% = 1 TO numevententry%
	ind% = 1
	done% = 0
	DO
		IF yfinalpos%(ind%) = place% THEN
			finishlist%(place%) = yjibno%(ind%)
			done% = 1
			IF debug = -3 THEN PRINT "/"; place%; yjibno%(ind%); ytotpoints(ind%);
		END IF
		ind% = ind% + 1
	LOOP UNTIL ((ind% > numevententry%) OR (done% = 1))
NEXT place%

IF progress > 0 AND debug = -3 THEN PRINT

place% = 1
DO
	IF progress > 0 THEN PRINT ".";
	tiehere% = 0
	anytie% = 1
	place2% = place% + 1
	DO
		' Final (adjusted) position is recorded in "yfinalpos%(ind%) <-- place%"
		' "finishlist%(place%) <-- sail%" conveniently lists yachts in order
		' Check ytie$(ind%) to see if finishlist%(place%) involves a tie

		' Compare points for yachts in adjacent places
	  
		ind% = index%(finishlist%(place%))
		ind2% = index%(finishlist%(place2%))
		diff = ABS(ytotpoints(ind%) - ytotpoints(ind2%))
		IF diff < .05 THEN
			IF debug = -3 THEN
				PRINT "Tie for"; place%; "between"; yjibno%(ind%); "and"; yjibno%(ind2%);
			END IF
			tiehere% = tiehere% + 1
		ELSE
			anytie% = 0
		END IF
		place2% = place2% + 1
	LOOP UNTIL ((place2% > numevententry%) OR (anytie% = 0))
 
	' The number of yachts tied for a given place is "tiehere%"
	IF tiehere% > 0 THEN
		place2% = place% + tiehere%
		IF debug = -3 THEN PRINT " Boats between"; place%; "and"; place2%; "are tied"

		SELECT CASE tiesys%
			' Allowing ties to remain is pretty simple
			CASE 1
				IF debug = -3 THEN PRINT "Allowing ties to remain"
				FOR i% = place% TO place2%
					ind% = index%(finishlist%(i%))
					ytie$(ind%) = "="
					yfinalpos%(ind%) = place%
				NEXT i%
				 
			' Breaking ties is hard
			CASE 2
				' Find the boat with the most 1st places etc (ignoring discards)
				' If a boat has redress, give up immediately, get the user to do it
				' If there are more than two boats, give up immediately
			  
				IF debug = -3 THEN PRINT "Finding best result"
					 
				' Set the tie indicator to "*"
				' Check if the tie involves redress
				FOR i% = place% TO place2%
					ind% = index%(finishlist%(i%))
					ytie$(ind%) = "*"
					hasredress% = 0
					FOR j% = 1 TO numrace%
						c$ = MID$(yracecode$(ind%, j%), 1, 3)
						IF c$ = "RDG" THEN
						  hasredress% = 1
						END IF
					NEXT j%
				NEXT i%
			  
				IF tiehere% > 1 THEN
				  gethelp% = 1
				ELSE
				  IF hasredress% = 1 THEN
					 gethelp% = 1
				  ELSE
					' OK, no redress, only two yachts, we can do it...
					 gethelp% = 0
					 count%(1) = 0
					 count%(2) = 0
					 bestpos% = 0
					 notie% = 1
					
					 DO
						' Look for 1st, then 2nd, etc
						bestpos% = bestpos% + 1
						FOR i% = place% TO place2%
						  ind% = index%(finishlist%(i%))
						  count%(i% - place% + 1) = 0
						  FOR j% = 1 TO numrace%
							 IF yracepos%(ind%, j%) = bestpos% THEN
								count%(i% - place% + 1) = count%(i% - place% + 1) + 1
							 END IF
						  NEXT j%
						NEXT i%
						IF debug = -3 THEN PRINT "Count of"; bestpos%; "th place is"; count%(1); "and"; count%(2)
							 
						' Does one yacht have more of this position?
						IF count%(1) <> count%(2) THEN
						  notie% = 0
						  IF count%(2) > count%(1) THEN
							 ' Reverse positions
							 jib2% = finishlist%(place2%)
							 jib1% = finishlist%(place%)
							 finishlist%(place2%) = jib1%
							 finishlist%(place%) = jib2%
							 yfinalpos%(index%(jib1%)) = place2%
							 yfinalpos%(index%(jib2%)) = place%
						  END IF
						END IF
					 LOOP UNTIL notie% = 0 OR bestpos% >= numevententry%
					
					 IF bestpos% >= numevententry% THEN
						' Best results were all equal
						' Tie must be broken on (manual) count-back
						FOR i% = place% TO place2%
						  ind% = index%(finishlist%(i%))
						  ytie$(ind%) = "<"
						NEXT i%
					 END IF
						  
				  END IF
				END IF
		
		 IF notie% = 1 OR gethelp% = 1 THEN
			DO
			  errors% = 0
			  PRINT
			  PRINT "Couldn't automatically resolve ties for places"; place%; "to"; place2%
			  PRINT "Please resolve ties manually"
			  PRINT "These are the results for the yachts involved"
		  
			  ' Initialise the list of jib numbers involved
			  FOR i% = 1 TO maxsailno%
				 ylist%(i%) = 0
			  NEXT i%

			  PRINT "First, yacht results are listed in order of best places obtained"
			  FOR i% = place% TO place2%
				 ind% = index%(finishlist%(i%))
				 PRINT "Jib no";
				 PRINT USING "####"; yjibno%(ind%);
				 ylist%(yjibno%(ind%)) = -1
				 PRINT ": ";
				 bestpos% = 0
				 DO
					bestpos% = bestpos% + 1
					FOR j% = 1 TO numrace%
					  IF yracepos%(ind%, j%) = bestpos% THEN PRINT USING "###"; bestpos%;
					NEXT j%
				 LOOP UNTIL bestpos% >= numevententry% + maxbonus%
				 PRINT
			  NEXT i%
		  
			  PRINT "Now, results are listed in order of race obtained for count-back"
			  PRINT "          Race";
			  FOR j% = 1 TO numrace%
				 PRINT USING "###"; j%;
			  NEXT j%
			  PRINT
			  FOR i% = place% TO place2%
				 ind% = index%(finishlist%(i%))
				 PRINT "Jib no";
				 PRINT USING "####"; yjibno%(ind%);
				 PRINT ": ";
				 FOR j% = 1 TO numrace%
					PRINT USING "###"; yracepos%(ind%, j%);
				 NEXT j%
				 PRINT
			  NEXT i%

			  FOR i% = place% TO place2%
				 PRINT "Which jib no goes into"; i%; "th place";
				 INPUT jibno%
				 ind% = index%(jibno%)
				 IF ind% <> 0 THEN
					IF ylist%(jibno%) = -1 THEN
					  ylist%(jibno%) = i%
					ELSE
					  IF ylist%(jibno%) = 0 THEN
						 PRINT "No, that jib number isn't involved here"
						 errors% = 1
						 EXIT FOR
					  ELSE
						 PRINT "No, that jib number's tie has already been resolved"
						 errors% = 1
						 EXIT FOR
					  END IF
					END IF
				 ELSE
					PRINT "No, that jib number isn't in the event"
					errors% = 1
					EXIT FOR
				 END IF
				
				 IF errors% = 0 THEN
					PRINT "Is your decision based on (1) Best position  (2) Count-back  (3) Coin toss ";
					INPUT reas%
					IF reas% = 3 THEN reas% = 2
					IF reas% = 1 OR reas% = 2 THEN
					  ylistreas%(jibno%) = reas%
					ELSE
					  PRINT "Bad input"
					  errors% = 1
					  EXIT FOR
					END IF
				 END IF

				 NEXT i%
			  IF errors% = 1 THEN
				 PRINT "Oops -- errors -- Press <Enter> to try again";
				 INPUT " "; a$
			  END IF
			LOOP UNTIL errors% = 0

			' Apply the manual decisions
			FOR sail% = 1 TO maxsailno%
			  IF ylist%(sail%) > 0 THEN
				 ind% = index%(sail%)
				 finishlist%(ylist%(sail%)) = sail%
				 yfinalpos%(ind%) = ylist%(sail%)
				 IF ylistreas%(sail%) = 2 THEN ytie$(ind%) = "<"
			  END IF
			NEXT sail%

		 END IF

	  END SELECT
	  
	END IF
	place% = place% + tiehere% + 1
	tiehere% = 0
	anytie% = 1
LOOP UNTIL place% >= numevententry%

IF progress > 0 THEN PRINT

END SUB

SUB reviewnums

PRINT
PRINT "The program found"; numevententry%; "entrants."
IF usedefault% = 0 THEN

	finrace% = 0
	DO
		fin% = 0
		begrace% = finrace% + 1
		DO UNTIL fin% > 12 OR finrace% = numrace%
			finrace% = finrace% + 1
			fin% = fin% + numheat%(finrace%)
		LOOP

		PRINT "            ";
		FOR race% = begrace% TO finrace%
			PRINT racetype$(race%);
			PRINT USING "##"; race%;
			FOR heat% = 1 TO numheat%(race%) - 1
				PRINT "     ";
			NEXT heat%
		NEXT race%
		PRINT

		PRINT "            ";
		FOR race% = begrace% TO finrace%
			FOR heat% = 1 TO numheat%(race%)
				PRINT "h";
				PRINT USING "#"; heat%;
				PRINT "  ";
			NEXT heat%
		NEXT race%
		PRINT

		PRINT "Scheduled ";
		FOR race% = begrace% TO finrace%
			FOR heat% = 1 TO numheat%(race%)
				PRINT USING "####"; numheatentry%(race%, heat%);
			NEXT heat%
		NEXT race%
		PRINT

		PRINT "Starters  ";
		FOR race% = begrace% TO finrace%
			FOR heat% = 1 TO numheat%(race%)
				PRINT USING "####"; numheatstart%(race%, heat%);
			NEXT heat%
		NEXT race%
		PRINT

		PRINT "Finishers ";
		FOR race% = begrace% TO finrace%
			FOR heat% = 1 TO numheat%(race%)
				PRINT USING "####"; numheatfinish%(race%, heat%);
			NEXT heat%
		NEXT race%
  
		PRINT
		INPUT "--- <CR> to continue ---"; x$
	LOOP UNTIL finrace% = numrace%

PRINT "NB Numbers in heats (but not seeding races) are cumulative."
END IF
END SUB

SUB scormeth

IF usedefault% = 0 THEN

' Ask for the scoring method to be used
' At present, this code is commented out and the low points system forced

'DO
'   PRINT
'   PRINT "Points value of a finishing position:"
'   PRINT " 1 = Low points"
'   PRINT " 2 = Low points, first place scores 0.7"
'   PRINT " 3 = High points, first place scores 'number of entrants'"
'   PRINT " 4 = High points, first place scores 100"
'   PRINT " 5 = Bonus points, 0  3  5.7  8  10  11.7  13  14..."
'   INPUT " "; scoresys%
'LOOP UNTIL ((scoresys% > 0) AND (scoresys% < 6))

' Ask how to resolve ties
' At present, this code is commented out and RRS A2.3 is used
'DO
'   PRINT
'   PRINT "Resolve ties by:"
'   PRINT " 1 = Allow ties to remain (RRS A1.2), shown using '=' symbol"
'   PRINT " 2 = Most 1st places, then most 2nd... (RRS A2.3), shown '*'"
'   PRINT "     (If equal best places, you'll do a manual count-back, shown '<')"
'   print "     (If using MYA HMS, you'll toss a coin instead of counting back)"
'   INPUT " "; tiesys%
'LOOP UNTIL ((tiesys% > 0) AND (tiesys% < 3))

	PRINT
	PRINT "Scoring method is 'Low points'"
	PRINT "Ties are broken (RRS A2.3) by best result"
	PRINT
	scoresys% = 1
	tiesys% = 2

ELSE
	scoresys% = 1
	tiesys% = 2
END IF

' Assign the points value of a position
' The low points system is forced at present

SELECT CASE scoresys%

CASE 1
	' Low points system
	FOR i% = 1 TO numevententry% + maxbonus% + 1
		pointval(i%) = i%
	NEXT i%

CASE 2
	FOR i% = 1 TO numevententry% + maxbonus% + 1
		pointval(i%) = i%
	NEXT i%
	pointval(1) = .7

CASE 3
	FOR i% = 1 TO numevententry%
		pointval(i%) = numevententry% - i% + 1
	NEXT i%
	pointval(numevententry% + 1) = 0

CASE 4
	FOR i% = 1 TO numevententry%
		pointval(i%) = 100! - i% * 100! / numevententry%
	NEXT i%
	pointval(numevententry% + 1) = 0

CASE 5
	FOR i% = 1 TO numevententry% + maxbonus% + 1
		SELECT CASE i%
			CASE 1
				pointval(i%) = 0
			CASE 2
				pointval(i%) = 3
			CASE 3
				pointval(i%) = 5.7
			CASE 4
				pointval(i%) = 8
			CASE 5
				pointval(i%) = 10
			CASE 6
				pointval(i%) = 11.7
			CASE 7
				pointval(i%) = 13
			CASE ELSE
				pointval(i%) = 13 + (i% - 7)
		END SELECT
	NEXT i%
END SELECT

END SUB

SUB writeout

'  Write the *.OUT file

prompt$ = "event final scores output data"
extn$ = ".OUT"
file$ = dataset$
CALL getfile(file$, prompt$, extn$)
IF file$ = "" THEN
	PRINT "Invalid file name!"
	INPUT "... <CR> to quit ..."; x$
	END
END IF

fileout$ = file$ + extn$

OPEN fileout$ FOR OUTPUT AS #2

PRINT #2, CHR$(34); desc$; CHR$(34)
PRINT #2, CHR$(34); "POINTS after"; numdisc%; "discards and"; numrace%; "races."; CHR$(34)
PRINT #2, CHR$(34); " Jib  Total Posn"; CHR$(34)

' List in sail number order
sail% = 1
DO
	ind% = index%(sail%)
	IF ind% <> 0 THEN
		PRINT #2, USING "####"; sail%;
		PRINT #2, USING "#####.#"; ytotpoints(ind%);
		PRINT #2, USING "#####"; yfinalpos%(ind%);
		PRINT #2, " "; CHR$(34);
		SELECT CASE ytie$(ind%)
		  CASE "=":  PRINT #2, "=";
		  CASE "<":  PRINT #2, "<";
		  CASE "*":  PRINT #2, "*";
		  CASE ELSE: PRINT #2, " ";
		END SELECT
		PRINT #2, CHR$(34)
	END IF
	sail% = sail% + 1
LOOP UNTIL sail% = maxsailno%

PRINT #2, ":"
PRINT #2, CHR$(34); desc$; CHR$(34)
PRINT #2, CHR$(34); "POSITIONS after"; numdisc%; "discards and"; numrace%; "races."; CHR$(34)
PRINT #2, CHR$(34); " Posn   Jib  Total"; CHR$(34)

FOR place% = 1 TO numevententry%
	sail% = finishlist%(place%)
	ind% = index%(sail%)
	PRINT #2, USING "####"; yfinalpos%(ind%);
	PRINT #2, " "; CHR$(34);
	SELECT CASE ytie$(ind%)
	  CASE "=":  PRINT #2, "=";
	  CASE "<":  PRINT #2, "<";
	  CASE "*":  PRINT #2, "*";
	  CASE ELSE: PRINT #2, " ";
	END SELECT
	PRINT #2, CHR$(34);
	PRINT #2, USING "#####"; yjibno%(ind%);
	PRINT #2, USING "#####.#"; ytotpoints(ind%)
NEXT place%

PRINT #2, ":"

PRINT
PRINT #2, CHR$(34); desc$; CHR$(34)
PRINT #2, CHR$(34); "TABLE after"; numdisc%; "discards and"; numrace%; "races"; CHR$(34)

somezred% = 0

PRINT #2, "     ";
FOR race% = 1 TO numrace%
	PRINT #2, CHR$(34); "  "; racetype$(race%);
	PRINT #2, USING "##"; race%;
	PRINT #2, CHR$(34);
NEXT race%
PRINT #2, CHR$(34); "  Total"; CHR$(34)

lines% = 0
FOR place% = 1 TO numevententry%
	ind% = index%(finishlist%(place%))
	PRINT #2, USING "#####"; yjibno%(ind%);
	lines% = lines% + 1

	FOR race% = 1 TO numrace%
		PRINT #2, USING "###.#"; yracepoints(ind%, race%);
	NEXT race%

	PRINT #2, USING "#####.#"; ytotpoints(ind%);
	PRINT #2, " "; CHR$(34);
	SELECT CASE ytie$(ind%)
	  CASE "=":  PRINT #2, "=";
	  CASE "<":  PRINT #2, "<";
	  CASE "*":  PRINT #2, "*";
	  CASE ELSE: PRINT #2, " ";
	END SELECT
		
	zerored% = 0
	FOR race% = 1 TO numrace%
		c$ = MID$(yracecode$(ind%, race%), 1, 3)
		IF c$ = "RDG" THEN
			
			 i% = LEN(yracecode$(ind%, race%))
			 IF i% > 3 THEN
				rp = VAL(MID$(yracecode$(ind%, race%), 4, i%))
			 ELSE
				rp = 0
			 END IF

			 IF rp < .001 THEN zerored% = 1
		END IF
	 NEXT race%
		 
	 IF zerored% = 1 THEN
		PRINT #2, "!";
		somezred% = 1
	 ELSE
		PRINT #2, " ";
	 END IF
	 PRINT #2, CHR$(34)
NEXT place%

IF somezred% = 1 THEN
	PRINT #2, CHR$(34); "(!) NOTICE  An RDG has not been allocated a value"; CHR$(34)
END IF

PRINT #2, ":"
CLOSE #2

END SUB