' The program processes the results of a single event, comprising a ' simple set of races. The list of yachts in their finishing order ' are entered into a data file separately (using a text editor), ' and the program then works on that prepared file. ' If a yacht doesn't appear in a race, it scores DNS. ' There is no need in this version to specify DNC or DNS codes therefore; ' just omit the yacht concerned from the race results list. ' Redress (RDG) can be given. ' Penalties for ZPG, DSQ, DND, and OCS are applied. ' Non-finishing codes of OOT, DNF, and RET are applied. ' The low points scoring system is used. Simple 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. ' Average points are calculated AFTER discards. ' Median points are calculated assuming ZERO discards. ' The program outputs the results to screen as well as to an output data file. ' RESTRICTIONS ' No heats, no seeding races, no promotion or relegation. ' Penalty position assignments are fixed (but you can change the program). ' Only one code allowed per yacht. If you want to give RDG to a RET or ' OOT yacht, then you'll have to list the yacht as a finisher (last, ' probably) and give it the RDG required. ' Jib numbers must be purely numeric; "X21" or "21X" can't be used. ' NOTE: The results are processed for a whole race, not as heats. ' It is possible to process heats (but not seeding races) if the ' results from a set of heats are presented as a single completed race. ' This means that individual heat RETs, DSQs, etc will not really be ' processed correctly, and this work-around is not recommended ' if it is, er, a "serious" event. ' Results input *.DAT file format: ' Line 1: Title (race name & date, probably) ' Line 2: Number of races ' Lines 3+: The results of each race, one race on one line ' Race result is a list of jib numbers starting at 1st place, no commas ' A code can be placed 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. ' The Z flag penalty code (ZPG) may be followed by a number, ' again no spaces, which is the percentage penalty to add. ' If not on the list for a race, a yacht scores DNS. ' REVISION HISTORY ' 99/10/08 Released to home page ' 99/10/09 Fatal errors keep I/O screen displayed ' Added full results table, yachts by races ' 99/10/10 Corrected comment on median calculation -- it's on zero discards ' Allow for race 'positions' up to 10 beyond event entry DECLARE SUB disptable () DECLARE SUB writeout () DECLARE SUB resolvetie () DECLARE SUB orderdisclist (ind%) DECLARE SUB scormeth () DECLARE SUB listplace () DECLARE SUB listpoint () DECLARE SUB calcmed (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%, debug, progress COMMON SHARED result%(), rescode$(), index%(), numrace%, desc$, numentry% COMMON SHARED yracepos%(), ytotpoints(), numdisc%, dataset$, filein$, fileout$ COMMON SHARED yjibno%(), yfinalpos%(), scoresys%, pointval(), tiesys% COMMON SHARED disclist(), median(), finishlist%(), yracecode$() COMMON SHARED DNCpos%(), DNSpos%(), OCSpos%(), DNFpos%(), RETpos%() COMMON SHARED DSQpos%(), DNDpos%(), OOTpos%(), BFDpos%() COMMON SHARED ytie$(), yracepoints(), numstart%(), numfinish%() 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 logic ' -3 shows tie resolution logic 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 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 ' The result% array simply lists the sail numbers in finishing position DIM result%(maxrace%, maxentry%) ' Penalty and other codes (which immediately follow the jib number) are: ' DSQ Disqualified Event Entry + 1 ' DND Disqualification not discardable Event Entry + 1 ' BFD Black flag disqualification Event Entry + 1 ' DNC Did not come to the starting area Event Entry + 1 ' DNS Did not start Event Entry + 1 ' OCS On the course side at the start Event Entry + 1 ' DNF Did not finish Race Starters + 1 ' OOT Out of time Race Starters + 1 ' RET Retired after finishing Race Finishers + 1 ' NOTE The RET penalty here is relatively lenient. It is for genuine ' finishers who later retire. Non-finishers should be given DNF. ' Be careful not to give RET to OCS or OOT yachts... ' RDGxxx Redress given ' If xxx is given, these are the redress points. ' If xxx is not given, the program asks later. ' ZPGxx Z flag penalty given ' If xx is specified, it is the percentage penalty applied ' If xx is not given, the program asks later ' ' The rescode$ array records the raw results codes from the data file DIM rescode$(maxrace%, maxentry%) ' The penalty positions associated with each code. ' Their values are set in the "buildind" module. DIM DNCpos%(maxrace%), DNSpos%(maxrace%), OCSpos%(maxrace%), DNFpos%(maxrace%) DIM RETpos%(maxrace%), DSQpos%(maxrace%), DNDpos%(maxrace%), OOTpos%(maxrace%) DIM BFDpos%(maxrace%) ' The yracepos% array records the position of each yacht in each race ' The position is either the position of the yacht's jib ' number in race, or 'entry+1' otherwise ' NOTE An RDG code does not affect position, so place that yacht's ' jib number in the correct place in the race results 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% + 10) ' Set up the discards array DIM disclist(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 DIM numstart%(maxrace%), numfinish%(maxrace%) CLS PRINT "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" PRINT " REGATTA CALCULATOR" PRINT "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" PRINT PRINT "The program requires an input pre-prepared data file (*.DAT) of the" PRINT "sail numbers (and any penalty codes) in finishing order for each race." PRINT PRINT "Current setup is for:" PRINT maxrace%; " races "; maxentry%; " entrants sail "; PRINT "numbers from 1 to "; maxsailno%; " "; maxdisc%; " discards." 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 ' Allocate (raw) places CALL alloc ' Define the scoring system CALL scormeth ' Calculate discards & final scores CALL discard ' Write event places file CALL eventres ' Display results DO PRINT PRINT "1: Results (output) file contents" PRINT "2: Individual yacht result in detail" PRINT "3: List of finishing positions" PRINT "4: List of total points" PRINT "5: Redefine the required scoring system" PRINT "6: Assign redress, recalculate discards & final scores" PRINT "7: All yachts in detail" PRINT "8: Full results table, yachts by races" 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 CALL scormeth CALL discard CALL eventres CASE 6 CALL discard CALL eventres CASE 7 i% = 0 DO i% = i% + 1 sail% = yjibno%(i%) CALL dispyacht(sail%) INPUT "--- :Next <0>:Exit ---"; a$ LOOP UNTIL ((i% >= numentry%) OR (a$ = "0")) CASE 8 CALL disptable 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 "... to continue to quit ..."; x$ STOP RESUME NEXT END SUB alloc ' Allocate a position to each yacht for each race IF ((progress > 0) OR (debug > 0)) THEN PRINT "Allocating places "; FOR race% = 1 TO numrace% IF ((progress > 0) OR (debug > 0)) THEN PRINT " R"; race%; ":"; place% = 1 i% = 1 sail% = result%(race%, i%) DO UNTIL sail% = 0 code$ = rescode$(race%, 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 "Placed "; yracepos%(ind%, race%); " and "; place% INPUT "... 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 ' If not, increment place% for next yacht 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%) CASE "DNS": yracepos%(ind%, race%) = DNSpos%(race%) CASE "OCS": yracepos%(ind%, race%) = OCSpos%(race%) CASE "DNF": yracepos%(ind%, race%) = DNFpos%(race%) CASE "RET": yracepos%(ind%, race%) = RETpos%(race%) CASE "DSQ": yracepos%(ind%, race%) = DSQpos%(race%) CASE "DND": yracepos%(ind%, race%) = DNDpos%(race%) CASE "RDG": place% = place% + 1 CASE "ZPG": place% = place% + 1 CASE "OOT": yracepos%(ind%, race%) = OOTpos%(race%) CASE "BFD": yracepos%(ind%, race%) = BFDpos%(race%) CASE ELSE PRINT "Unrecognised code in race"; race%; " for "; sail%; PRINT "apparently placed"; place% END SELECT i% = i% + 1 sail% = result%(race%, i%) IF progress > 0 THEN PRINT "."; LOOP sail% = 1 DO ind% = index%(sail%) IF ind% > 0 THEN ' If the yacht is not mentioned as a finisher, ' give it the DNS position ' Note complications when the software allows for heats... IF yracepos%(ind%, race%) = 0 THEN yracepos%(ind%, race%) = DNSpos%(race%) yracecode$(ind%, race%) = "DNS" END IF IF debug > 0 THEN PRINT sail%; "/"; yracepos%(ind%, race%); " "; END IF sail% = sail% + 1 LOOP UNTIL sail% > maxsailno% 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 numentry% = 0 IF ((progress > 0) OR (debug > 0)) THEN PRINT "Building index "; FOR race% = 1 TO numrace% IF debug > 0 THEN PRINT " R"; race%; ":"; place% = 0 DO place% = place% + 1 sail% = result%(race%, place%) IF sail% <> 0 THEN ' Is this a previously unknown yacht? IF index%(sail%) = 0 THEN ' Yes, so give it an index numentry% = numentry% + 1 IF debug > 0 THEN PRINT sail%; "("; numentry%; ") "; IF progress > 0 THEN PRINT "."; index%(sail%) = numentry% IF numentry% > maxentry% THEN PRINT "Too many entrants!" INPUT "... to quit ..."; x$ STOP END IF END IF END IF LOOP UNTIL sail% = 0 IF debug > 0 THEN PRINT " "; ' Begin by assuming that, if a yacht is listed, it started at least. ' Note the number of yachts listed numstart%(race%) = place% - 1 ' Calculate the number of starters and finishers for the race by ignoring ' certain codes igs% = 0: igf% = 0 FOR place% = 1 TO numstart%(race%) IF LEN(rescode$(race%, place%)) > 0 THEN c$ = MID$(rescode$(race%, place%), 1, 3) ELSE c$ = "" SELECT CASE c$ ' These codes indicate non-starters CASE "DNC": igs% = igs% + 1 CASE "DNS": igs% = igs% + 1 CASE "OCS": igs% = igs% + 1 ' These codes indicate non-finishers CASE "DNF": igf% = igf% + 1 CASE "RET": igf% = igf% + 1 CASE "DSQ": igf% = igf% + 1 CASE "DND": igf% = igf% + 1 CASE "OOT": igf% = igf% + 1 CASE "BFD": igf% = igf% + 1 ' Do nothing with these codes CASE "RDG" CASE "ZPG" CASE "" ' Unrecognised CASE ELSE PRINT "Unrecognised code in race"; race%; " for "; sail%; PRINT "apparently placed"; place% END SELECT NEXT place% ' Reduce the count of the number of starters appropriately numstart%(race%) = numstart%(race%) - igs% ' Set number of finishers as number of starters less those ignored numfinish%(race%) = numstart%(race%) - igf% NEXT race% PRINT PRINT "The program found "; numentry%; " entrants." IF progress > 1 THEN PRINT " Race: "; FOR race% = 1 TO numrace% PRINT USING "####"; race%; NEXT race% PRINT PRINT "Starters "; FOR race% = 1 TO numrace% PRINT USING "####"; numstart%(race%); NEXT race% PRINT PRINT "Finishers"; FOR race% = 1 TO numrace% PRINT USING "####"; numfinish%(race%); NEXT race% PRINT END IF ' 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 ' A later version of this program will allow you to dynamically assign ' positions as required, rather than fixed in this way FOR race% = 1 TO numrace% DNCpos%(race%) = numentry% + 1 DNSpos%(race%) = numentry% + 1 OCSpos%(race%) = numentry% + 1 DSQpos%(race%) = numentry% + 1 DNDpos%(race%) = numentry% + 1 BFDpos%(race%) = numentry% + 1 DNFpos%(race%) = numstart%(race%) + 1 OOTpos%(race%) = numstart%(race%) + 1 RETpos%(race%) = numfinish%(race%) + 1 NEXT race% 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 bound% = numentry% 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 calcmed (medval) ' Calculate a median ' There are "numrace%" unordered points in the "median" array ' When ordered, discount the first/last "numdisc%" points ' according to the scoring system in use, "scoresys%", ' and then calculate the median value, "medval" ' Classic bubble sort bound% = numrace% 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 midpt = (numrace% + 1) / 2 i% = INT(midpt) i = i% IF ABS(midpt - i) > .01 THEN itsodd% = 1 ELSE itsodd% = 0 IF ((scoresys% < 3) OR (scoresys% = 5)) THEN midpt = midpt - (numdisc% / 2) ELSE midpt = midpt + (numdisc% / 2) END IF IF debug = -1 THEN PRINT "Midpt="; midpt; " itsodd="; itsodd% IF debug = -1 THEN FOR i% = 1 TO numrace% 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$) REM REM Extract the data from "line$" 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% ' 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" OR MID$(text$, 1, 3) = "ZPG" THEN ' OK, the rest consists of the number ELSE PRINT "Warning, bad code of <"; text$; "> found." END IF END SELECT END SUB SUB discard ' Ask for number of discards ' Wish list: calculate the number of discards given the number of races PRINT SELECT CASE numrace% CASE 0 TO 3: nd% = 0 CASE 4 TO 8: nd% = 1 CASE 9 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 DO PRINT "Number of discards (max="; maxdisc%; " Suggested default="; nd%; ") "; INPUT numdisc% LOOP UNTIL numdisc% <= maxdisc% IF numdisc% < 1 THEN numdisc% = nd% IF ((progress > 0) OR (debug > 0)) THEN PRINT "Calculating discards and points "; ind% = 1 DO sail% = yjibno%(ind%) IF debug > 0 THEN PRINT " "; sail%; "("; IF progress > 0 THEN PRINT "."; ' Prime the discard list FOR i% = 1 TO numdisc% disclist(ind%, i%) = 0 NEXT i% ytotpoints(ind%) = 0 ' Allocate points for the position in the race ' Calculate the total points for the yacht 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 ' Now the problems begin... 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" ' Apply the redress points given 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 "Enter them now, or enter 0 to specify them later "; INPUT rp IF rp > 0 THEN yracecode$(ind%, race%) = yracecode$(ind%, race%) + STR$(rp) END IF END IF IF rp > 0 THEN yracepoints(ind%, race%) = rp IF debug = -2 THEN PRINT "Rp "; rp; CASE "ZPG" ' Apply the percentage penalty given i% = LEN(yracecode$(ind%, race%)) IF i% > 3 THEN zp = VAL(MID$(yracecode$(ind%, race%), 4, i%)) ELSE zp = 0 END IF IF zp < .001 THEN PRINT PRINT "No ZPG percentage specified for jib no "; yjibno%(ind%); " in race "; race% PRINT "Enter it now, or enter 0 to specify it later: "; INPUT zp IF zp > 0 THEN yracecode$(ind%, race%) = yracecode$(ind%, race%) + STR$(zp) END IF END IF IF zp > 0 THEN yracepoints(ind%, race%) = (1! + zp / 100!) * yracepoints(ind%, race%) IF debug = -2 THEN PRINT "Zp "; zp; CASE "OOT" CASE "BFD" CASE "RET" CASE ELSE PRINT "Unknown code <"; c$; ">! "; END SELECT END IF ytotpoints(ind%) = ytotpoints(ind%) + yracepoints(ind%, race%) NEXT race% ' Calculate the discards race% = 1 DO IF yracecode$(ind%, race%) = "DND" THEN ' Ignore this one 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%) ' 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 "/"; 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% > numentry% 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 "... ..."; x$ PRINT CASE 13 PRINT coun% = coun% + 1 IF coun% > 22 THEN PRINT INPUT "... ..."; 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 USING "#####"; race%; NEXT race% PRINT " Total" lines% = 0 FOR place% = 1 TO numentry% 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" OR c$ = "ZPG" 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 "--- to continue ---"; x$ END IF NEXT place% IF lines% > 0 THEN INPUT "--- to continue ---"; x$ END IF IF somezred% = 1 THEN PRINT "(!) NOTICE: An RDG or ZPG has not been allocated a value" INPUT "... ..."; 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 USING "######"; race%; NEXT race% FOR n% = 1 TO numdisc% PRINT USING "######"; -n%; NEXT n% PRINT PRINT "Positn: "; FOR race% = 1 TO numrace% PRINT USING "######"; yracepos%(ind%, race%); NEXT race% PRINT PRINT "Points: "; FOR race% = 1 TO numrace% PRINT USING "####.#"; yracepoints(ind%, race%); median(race%) = 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" OR c$ = "ZPG" 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" OR c$ = "ZPG" 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 or ZPG 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. ' The average points are calculated AFTER discards ' Otherwise, run the program with zero discards avg = ytotpoints(ind%) / (numrace% - numdisc%) PRINT USING "######.#"; avg; ' The median points are calculated assuming ZERO discards CALL calcmed(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 numentry% yfinalpos%(i%) = 0 NEXT i% ' Calculate event overall positions FOR place% = 1 TO numentry% SELECT CASE scoresys% CASE 1, 2, 5 ' Just think of a big number here to start with... score = (numentry% + 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% > numentry% 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% > numentry% yfinalpos%(bestind%) = place% END SELECT NEXT place% ' Resolve any ties CALL resolvetie ' Write the *.OUT file CALL writeout 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 initial ' Initialise the various arrays ' NB Results codes can't be initialised until ' "buildind" establishes the value of "numentry%" FOR i% = 1 TO maxrace% FOR j% = 1 TO maxentry% result%(i%, j%) = 0 NEXT j% NEXT i% FOR i% = 1 TO maxentry% FOR j% = 1 TO maxrace% yracepos%(i%, j%) = 0 yracepoints(i%, j%) = 0 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% 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 = numentry% cols% = INT(1! + e / 20!) FOR c% = 1 TO cols% PRINT " Posn Jib Total "; NEXT c% PRINT IF numentry% > 20 THEN rows% = 20 ELSE rows% = numentry% FOR r% = 1 TO rows% FOR c% = 1 TO cols% place% = r% + 20 * (c% - 1) IF place% <= numentry% 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" OR c$ = "ZPG" 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 or ZPG has not been allocated a value" INPUT "... ..."; 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 = numentry% cols% = INT(1! + e / 20!) FOR c% = 1 TO cols% PRINT " Jib Total Posn "; NEXT c% PRINT IF numentry% > 20 THEN rows% = 20 ELSE rows% = numentry% FOR r% = 1 TO rows% FOR c% = 1 TO cols% ind% = r% + 20 * (c% - 1) IF ind% <= numentry% 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" OR c$ = "ZPG" 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 or ZPG has not been allocated a value" INPUT "... ..."; 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%) disclist(ind%, j%) = disclist(ind%, j% + 1) disclist(ind%, j% + 1) = temp END IF NEXT j% bound% = t% LOOP UNTIL t% = 0 END SUB SUB readfile ' Read the *.DAT file prompt$ = "race results" extn$ = ".DAT" file$ = "" CALL getfile(file$, prompt$, extn$) IF file$ = "" THEN PRINT "Invalid file name!" INPUT "... to quit ..."; x$ END END IF dataset$ = file$ filein$ = dataset$ + extn$ ' The file has: ' A one line title (race name & date, probably) ' The number of races, on the next line ' The results of each race, one race 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 "; filename$; " opened" INPUT #1, desc$ IF debug > 0 THEN PRINT desc$ INPUT #1, numrace% IF numrace% > maxrace% THEN PRINT "Too many races!" INPUT "... to quit ..."; x$ STOP END IF IF numrace% < 1 THEN PRINT "Apparently "; numrace%; " races specified!" INPUT "... 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% STEP 1 IF ((progress > 0) OR (debug > 0)) THEN PRINT " R"; race%; ":"; place% = 1 INPUT #1, line$ length% = LEN(line$) strt% = 0 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 "... to quit ..."; x$ STOP END IF result%(race%, place%) = sail% rescode$(race%, place%) = text$ place% = place% + 1 LOOP UNTIL strt% >= length% NEXT race% PRINT CLOSE #1 END SUB SUB resolvetie ' Resolve ties DIM count%(2), ylist%(maxsailno%), ylistreas%(maxsailno%) IF progress > 0 THEN PRINT "Resolving ties "; ' Clear the tie indicator array FOR ind% = 1 TO numentry% 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 numentry% 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% > numentry%) 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% > numentry%) 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% >= numentry% IF bestpos% >= numentry% 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 errors% = 0 DO 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% >= numentry% 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 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% >= numentry% IF progress > 0 THEN PRINT END SUB SUB scormeth ' Ask for the scoring method to be used ' At present, this code is commented out and the low points system used '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)) scoresys% = 1 ' 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)) tiesys% = 2 PRINT PRINT "Scoring method is 'Low points'" PRINT "Ties are broken (RRS A2.3) by best result" ' Assign the points value of a position SELECT CASE scoresys% CASE 1 FOR i% = 1 TO numentry% + 10 pointval(i%) = i% NEXT i% CASE 2 FOR i% = 1 TO numentry% + 10 pointval(i%) = i% NEXT i% pointval(1) = .7 CASE 3 FOR i% = 1 TO numentry% pointval(i%) = numentry% - i% + 1 NEXT i% pointval(numentry% + 1) = 0 CASE 4 FOR i% = 1 TO numentry% pointval(i%) = 100! - i% * 100! / numentry% NEXT i% pointval(numentry% + 1) = 0 CASE 5 FOR i% = 1 TO numentry% + 10 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 outcome" extn$ = ".OUT" file$ = dataset$ CALL getfile(file$, prompt$, extn$) IF file$ = "" THEN PRINT "Invalid file name!" INPUT "... 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 numentry% 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, ":" CLOSE #2 END SUB