#! /bin/sh # Trick. tcl sees next line as a comment continuation, sh does not. \ exec wish "$0" ${1+"$@"} # # SIDResults # # Ken. Hanson # Started: 2008/02/27 # set SIDRVersion "0.89o" # Last modified 2012/01/19 # # This program is used to generate web-ready results from an # Orienteering meet managed by e-punch. # In particular, it takes the raw output from an e-punch # results box, as well as a list of control codes defining # each course, and generates a list of results (including # assignment of competators to courses, placement, split times, # etc) in a web-ready format. # set debug 0 ;# 0: No debug. 1: Basic monitoring. 2: Higher level. 3: Highest normal output level. 4: Very specific test case debug level. # -------------------------------------------------------------------------------------------------------------------------------------------------------------------- # Major Todo: # # # # # Read start/control/finish box files. # Convention for saving: Save in event subdirectory. Start.csv, NN.csv, Finish.csv # Will need to determine start of this day (previous days not having been cleared). # Use time discontinuities (i.e. jump back in time) # Determine runners out on course based on start box punches and current download box file. # For runners currently out, look at all currently read control box files. # Output for all runners still out: all controls known punched, in order, with time. # Also maintain a list of controls known to not have been visited by these runners. # Estimate course they were running. # Note: Be generous regarding mispunches; most interested in extrapolation from last known punch. # Output estimated next controls, both known not punched and not known. # Sample output: # Joe Lost Start 41 42 43 44 45 46 47 Guess # 12:51:48 12:58:03 ???? 13:15:29 ???? NO NO ???? Red? # Thus, Joe is somewhere between 43 and 45. We will know more when control 44 comes in and we can read it. # # Splits: Use mmm:ss # # # Modify results for MP # e.g. output all punch times for the course that are in order, even if one was missed on the way. # Is still scored as DNF, and stop giving a place for them following the MP, but can still look at # their time to that control. # # Save edits # Maintain list of all "edit" alterations to each record. # For each alterable field, have a bit for "has been edited"? # Allow saving an edit file. # Allow reading and applying an edit file. # # Deal easily with re-renting a stick (i.e. same number, multiple names) # Possibly store all names read for this number, and give menu to select from. # Easy way to jump between multiple instances of same stick number. # # Line in courses.txt to specify Location,Date heading. # # Read any RawData*.csv # # Button to toggle error sections out of the way. # # Include text entry box for course comments. # # Duplicate: Check if a "duplicate" is a complete course. May want to raise a warning, since # the shorter could be a completed course, while the longer is a second course attemped # without first clearing the stick. # # Directions for making the script run in a standalone mode (or build a standalone wrapper) # Allow renaming of SINames files (button, file requestor). # Message when changing name from what is stored on stick # Weed out if name on stick contains string "RENTAL" # Allow editing of # Artificial start, punch time, finish, etc # Add runner # Allow skipping controls # By individual # Allow comments in SINames (to identify event this file is associated with, for example) # Check for a frameshift in the raw data input (likely resulting from a comma # located inside of a field, for example city: "Durham, NC" which will get read as two fields). # Check day-of-week (likeliest place to spot the frameshift) # If frameshifted, just give an error and stop processing that line # # # Minor Todo: # Rewrite code. Untangle the routines to make the flow easier to read and manage. # Implement LCS for guessing course on DNFs. http://en.wikipedia.org/wiki/Longest_common_subsequence_problem # Visibly identify lines which have been edited. (Grey out. Button to highlight all edited lines. * somewhere on line. ...) # Have deleted entries (in the still visible section) indicated as deleted somehow (field to put a "*" in ??) # Endless error checking # Check for MP (i.e. if didn't finish course, try to match course with single allowed skipped control) # Case of someone not clearing, then downloading multiple times (currently doesn't remove multiples if person didn't clear) # Allow selection from ErrorMsg log as well as from results window. # Build refidx list for ErrorMsg region # Add refs to all logs into ErrorMsg # Add selection code for error window # Bind arrowkeys in results area (so scrolling selection line by arrows will change selections). # Variable field widths (particularly for the name field). # Look at directory defaults (i.e. possible to feed a default?). Default to working directory when reasonable. # Fix the wriggles. (Have partially contained. Would like to eliminate completely.) # Build a courses.txt file on the fly. # Use completed courses to guess at likely courses for that day. # Menu selector with classic defaults to choose from (White, ... Blue, Sprint-A, Sprint-B) # Input box for Length in km # Delete button for spurious courses # Save button to write (then use) courses.txt from what is there. # # Change list (started late, so many early changes not logged here) # 080227 Program started by Ken. Hanson. At this time, all changes by KH unless noted otherwise. # vvvvvv Most changes in this time period not logged. # 080314 SIDR 0.10 ? # 080314 SIDR 0.20 ? # 080314 SIDR 0.30 ? # 080316 SIDR 0.40 ? # 080326 SIDR 0.50 ? # 080731 SIDR 0.60 First public release # 080902 Changes to allow any of multiple default filenames for basic inputs. # SIDR 0.70 # ^^^^^^ Most changes in this time period not logged. # 080916 Added html version of output. # SIDR 0.80 # 081218 Mihai Ibanescu: Patch to modify html output. Cleans up some ugly html, and # improves ability to work with WordPress system now used for club results. # SIDR 0.82 # 090123 Fixed bug in duplicate entry clearing. Was previously (unintentionally) clearing # first entry of duplicates regardless of which entry was of shorter length. # 090224 Modified editing line to include SI-Card number, start, and finish times # to make it easier to correlate entries here with what is on the paper registration form. # 090225 Added count of total number of starts to output. # 090227 Added timeshifting, to adjust the time setting on individual controls (or all numbered controls). # SIDR 0.83 # 100301 High level rewrite, to clean up file input program logic. # Preparation for reading RawData appends (to handle realtime generation of results) # SIDR 0.84 # 111107 Added option to skip a control (e.g. for a Goat style course). # SIDR 0.85 # 111216 Added option to throw out a control, removing the time for the legs before and after the bad control. # SIDR 0.86 # 111217 Major additions. # Now display version number in the tk window to aid keeping track of what version a user is running. # Modified editing line to include total time on course, finished/dnf, and real punched controls list. # Added editing of final result. # Added treatment of Score-O type events. # Have started additions for use of the software during an A-Meet. # Done. New input and output files Done. # New file type: Event. (Changed->AMeet mode, and courses.txt options) Done # Read competitors Done # Start an event mode. Done # Way to change which event/day is being processed (i.e. change AMeetEvent) Done # Gracefully handle AMeetEvent ranges Done # Write csv results/rankings from early events Done # Read csv results/rankings from early events Done # Read both days Done # File management: RawDownloadEnnn.*, only read for current event Done # Day1+Day2 Done (but needs extensive error checking) # Done. Results modified to take into account A-meet constraints Done. # Class according to registration, if possible Done # Output warning if someone changes courses (i.e. run something other than registered for) Done # USChamps eligibility and multiple results sets Done # Output registered competitors even if they have no download yet Done # Screen map hikes from published results. Done # Done. Live updates. Done. # Add button to enter live updates mode. Done # Scan directory for new (unread) Raw files Done # Add button to prompt new scan. Done # Open simple server socket. Use input to prompt new scan. Done # Add timer to prompt new scan. Done # Done. New output forms. Triggered by some combination of event mode and live update mode. Done. # Output web page, then update screen in readable text form, every time. Done # New web page variations (for compact results display at event). Done # Done. Determine when top three finish times cannot be altered by remaining unfinished runners. Done. # Read start times file. Done # Remember the conversion from HH:MM form to HH:MM:SS form Done # Calculate when best possible finish time could not beat 3rd place, assuming given start. (Might not happen) # Continuously update approximate time out on course for unfinished runners Done, want clearer output than SS/US # Remember to set AlwaysRecalcOnTimerEvent to force continuous updates Done, but want better control(s) # 130109 Released 0.89o, which recognises the new version of the header files now found on results downloads. # Still cleaning up code toward SIDR 0.90 # Some globals # set OvertimeLimit "3:00:00" ;# This is the max time for a finish result. Anything over will be an OVT. # In default filename settings below, if there are both "...Filename" and "...Filenames" versions, the # singular version is obsolete; code will now check for each name in ...Filenames and use the first # such name which exists as a file in the working directory. set DefaultRawFilename "RawData.csv" ;# This default no longer used. See below. set DefaultCourseFilename "courses.txt" ;# This default no longer used. See below. set DefaultCourseFilenames {"courses.txt" "Courses.txt" "course" "Course" "course.txt" "Course.txt"} set DefaultNumToNameFilename "SINames" ;# This default no longer used. See below. set DefaultNumToNameFilenames {"SINames" "SInames" "SINames.txt" "SInames.txt" "SINamesEvent" "SINamesEvent.txt"} set DefaultGlobalNumToNameFNs {"SINames" "SInames" "SINames.txt" "SInames.txt" "SINamesGlobal" "SINamesGlobal.txt"} set DefaultCompetitorsDBFilenames {"Competitors" "Competitors.txt"} # set CompetitorsDBForm 2 ;# 1: Name,Club,Elig,SI1,Class1,...SIN,ClassN # 2: Name,Club,YOB,Elig,SI1,Class1,...SIN,ClassN,Firstname,Lastname set DefaultStarttimesDBFilenames {"Starttimes" "Starttimes.txt"} set DefaultTimeshiftFNs {"Timeshift" "timeshift" "Timeshift.txt" "timeshift.txt"} set DefaultOutputFilename "Results.txt" set DefaultOutputHTMLFilename "Results.html" set weboutputdir "" ;# Artem's web server: /var/www/day1 and /var/www/day2 # set weboutputdir "/var/www/day1/" # set weboutputdir "/var/www/day2/" set DoRsync 0 ;# Activate the rsync to the webserver on every update set MakeWebpageRefresh 0 ;# Boolean. 0: Simple web page. 1: Web page does auto-refresh (useful with live updates) set WebpageRefreshTime 10 ;# Seconds. Only used if MakeWebpageRefresh == 1 set ShowLegend 0 ;# Explain SS, US set HTMLTitle "Date, Location" set HTMLType 1 ;# 0: Simple. 1: Column flow. #set NameFieldLen 42 ;# original default 26 # NameFieldLen($courseidx) This is the size of the largest name on this course (or NameFieldLenMax) # NameFieldLenCN($coursename) This version is used for multi-column output. (The checks for who is on each course are slightly different in each case.) set NameFieldLenDefault 10 ;# Starts here. Can set an effective fixed length by making this equal to NameFieldLenMax set NameFieldLenMax 42 ;# won't increase beyond this length, even if someone's name (likely a team) is longer than this) #set NameFieldLenDefault 20 ;# Uncomment these, and comment out the above, for fixed name length sizes #set NameFieldLenMax 20 ;# set NameFieldLen(-1) $NameFieldLenDefault set ScreenSize 3 ;# 1 Smallest. 2 Good for my laptop. 3 Good for my desktop. switch $ScreenSize { 1 { set ResultsAreaHeight 40 set ErrorAreaHeight 3 set PutFileNamesOnScreen 0 } 2 { set ResultsAreaHeight 47 set ErrorAreaHeight 4 set PutFileNamesOnScreen 0 } 3 { set ResultsAreaHeight 60 set ErrorAreaHeight 8 set PutFileNamesOnScreen 1 } default { set ResultsAreaHeight 60 ;# Default to a large screen size. (Assume someone is trying to set ScreenSize to something large, rather than 0 or negative.) set ErrorAreaHeight 8 set PutFileNamesOnScreen 1 } } set ExtendedEditArea 1 ;# Boolean. Extra line for information from currently selected download. # Some settings set OutputRealPunches 1 ;# Whether or not to include the string of punches actually visited. Even if set to 1 here, will get turned off later if AMeetMode is 1. set HideErrors 0 ;# Whether or not to hide the error message window and raw results set OutputHTML 0 ;# Whether the output is HTML or plain text. set AlwaysRecalcOnTimerEvent 1 ;# Whether or not to recalc results on a timer event, even if there are no new downloads # Note: If OutputHTML==1, then HideErrors should ==1. # This will be enforced inside CalcResults, but left optional elsewhere. set AMeetMode 0 ;# Set to 1 if this is an A-Meet, rather than a local event set AMeetEvent 1 ;# The event number (count from 1) that results are currently being processed for set AMeetNumEvents 1 ;# The number of events associated with this A-Meet set LiveUpdates 0 ;# Set to 1 if new web output should be continuously saved as changes occur set timerset 0 ;# Is a timer event currently waiting set UpdatePeriod 5000 ;# Time, in ms, between updates when in live update mode set OutputTimeSinceStart 1 ;# Should we output time since/until start for competitors, using Starttimes database # OutputColString(event) ;# The string from the @defevent line of courses.txt. Will be used to setup the following, once the current event is known. set NumOutputColumns 0 ;# Used for outputing multiple day's events at one time. # UseOutputColumns(event) ;# If 0, then use normal, non-columned output # OutputEvents($col) A list of events to sum together in column $col # OutputColumnName($event,$col) The name to be printed at the top of the given column, for the given event. Used only in multicolumn output # OutputColName($col) This isn't used anywhere in the code. It gets assignments, but is never output. Obsolete. set OutputColumnHeaders 0 ;# Boolean. If 0, don't use OutputColumnName(e,c) (it is empty anyway). If 1, we have at least one column name header to output. # OutColumnToSortBy Which event column to sort by in the output # OutColForNameType "In" or "After". # OutColForName A column, from 0 to NumOutputColumns. After 0 places the name first, After NumOutputColumns places name last, # After any other places name after that column, In 0 is undefined, in any other column does "place (eligplace) name time" for that col. # Here is a convenient place to keep documentation on the important global variables # # The Download Box entries. # db(Use,$i) Boolean. 0: Skip/delete this entry. 1: Normal, this is an active entry # db(Dup,$i) Boolean. # db(DupSIChecked,$i) Boolean. 0: Have not checked this DL SICard for a duplicate yet. 1: Have checked. Will only check for positive indices. # db(Registered,$i) Does this download appear to be registered (i.e. have an entry in the Competitors database), A-Meet specific # db(SICard,$i) SI Card number # db(Name,$i) Runner's name # db(NumPunches,$i) Number of real punches registered for this downloaded run # db(RealPunches,$i) List, all control code numbers, in order punched, regardless of course relevance # db(RealPunchTime,$i) List, time of each punch in RealPunches list # db(ClearTime,$i) Time the card was cleared. Used for cleansing duplicate downloads from results. # db(ClearCN,$i) Control number of box used to clear. Used to rule out simul clears from diff boxes. # db(StartTime,$i) Start time, hh:mm:ss form # db(FinishTime,$i) Finish time, hh:mm:ss form # db(TotalTime,$i) FinishTime - StartTime, in hh:mm:ss format, regardless of course finish, etc. May be corrected if controls are thrown out. # db(EditResult,$i) This is a value that can be entered by the program user to override what would otherwise be the result. Allows SPW, DSQ, etc. # db(FinalResult,$i) Result (this event): Time, Pseudotime-since-start, DNF, OVT, user edit, DSQ etc. Takes into account all factors. # db(Course,$i) Index of course assigned to this entry. May be a guess or imposed by user input # db(Finished,$i) Boolean. Did this entry finish the course as set in db(Course,$i) # db(NumCPunches,$i) Number of valid controls punched on the course assigned this entry # db(CPunches,$i) List, control code numbers of punched controls on the course assigned this entry # db(CPunchTime,$i) List, time of each punch in CPunches list # The CPunches list will be basically a cleaned up version of the RealPunches list. # i.e. CPunches will not contain punches not on the course, or punches after # any skipped control. # db(ElapsedTime,$i) List, elapsed time to each punch in CPunches list, plus finish # db(SplitTime,$i) List, split times for each punch in CPunches list, plus finish # db(CourseResults,$i) List of all courses (by name) for which we have a ColResult generated, i.e. all courses for which this entry ran, for which we need output # db(ColResult,$c,$i) Result (time, or DNF, "", etc) for column c of output. Obsolete. See the version which includes course # db(ColResult,$course,$col,$i) Result (time, or DNF, "", etc) for the given course, for column col of output # db(ColPlace,$course,$col,$i) Place (1,2,3,... or ""), as calculated and saved for a previous event # db(ColPlaceElig, ... Place ... elig. # db(DelayedWarnings,$i)List, any warnings to go to the error log only after duplicates have been cleared. # # Note that normal indices into db are positive. # Negative indices into db are "fake" entries; these are not real downloads. Instead, negative indices are for competitors at an AMeet # who have registered, but have not yet downloaded. (We keep the fake db entries even after they download; they just won't be used.) # Index -1 is not used (this is reserved for "not found" types of values). # Index 0 is not used either (for legacy reasons). # set NumEntries 0 ;# The indices in db will range from 1 to NumEntries-1 (or there are none) set MaxCompIdx -1 ;# The indices in db which are negative willrange from -2 down to MaxCompIdx (which will be negative). # NameLookup($num) The name of the person associated with SIcard number $num # # Comps List of competitor names # Comp(Club,$name) Orienteering club # Comp(YOB,$name) Year of birth. This entry will be blank ("") if using input form 1 # Comp(Elig,$name) Eligibility for (USChamps, ...) # Comp(Firstname,$name) First name (useful for generating some output results). Note: First/Last name splitting will be uncertain if using input form 1 # Comp(Lastname,$name) Last name (useful for generating some output results). # Comp(Name,$n,$sicard) Name, indexed by event n and SICard (SICard to Name) # Comp(SICard,$n,$name) SICard number, event n (events count from 1) # Comp(Class,$n,$name) Class, event n (name, not index) # Comp(ResultPlace,$n,$name) Result place for event n. "" if no info. 1,2,... if placed, " " if a DNF, DNS, etc # Comp(ResultEPlace,$n,$name) Reault place for event n, out of only elig runners. "" if not elig, or no info, ... # Comp(ResultTime,$n,$name) Result time for event n. "" if no info. Time value (hh:mm:ss) if finished. DNF, DNS, etc if not finished. # Comp(ResultClass,$n,$name) Class (name) for which the result was obtained (stored here just in case it is different from expected) # Comp(ResultClassIdx,$n,$name) Class (index) ... # Comp(DBIdx,$name) Index to download result in db for this competitor; if no download yet, will be a negative value into a faked db record. # # Starttime($name) Scheduled start time, as read from Starttimes file # # NumCourses Number of courses. Note that courses are indexed from -1 "Unknown" to NumCourses-1 # CourseName($c) The name of course indexed by $c. Includes an index of -1: "Unknown" # CourseNames A list of all course names. Do: set courseindex [lsearch $CourseNames $coursename] for the reverse. # CourseControls($c) List, control codes for this course # CourseLength($c) The length of this course, assumed to be in km (for calculating min/km) # CourseType($c) 0:Normal, 1:Score-O # CourseTimePenalty($c) # CourseAllowedSkips($c)The number of allowed skipped controls on this course (e.g. for a Goat style course, where one control can be chosen to be skipped) # # ControlSkippable($n) Where $n is a control number. If exists, and is eq "yes", then this control may be skipped. # This is used to account for controls that go bad, get stolen, etc in the middle of an event. # ControlThrownOut($n,$c) Where $n is a control number, and $c is a course name or "All". If exists, and is eq "yes", then # this control is thrown out of the indicated course (or all courses). The time for any leg before # or after this control will be thrown out, and the control is skippable. # ControlValue($n) The point value of control number $n (in a Score-O). Not guaranteed to exist for all controls. # # EvNNumCourses($event), EvNCourseName($event,$c), EvNCourseNames($event), ... EvNControlValue($event,$n) # The EvN versions of the variables all start with the index $event, and are the stored values for the given event. # # EditIdx The entry index of the item currently being edited. -1 if none. # # rawlist This is our internal copy of the contents of the RawData.csv file. # Stored as a list of strings. # Should get processed by ProcessRaw into the entries in db(). # NumRawLines Total number of lines in rawlist. # NumRawLinesProcessed Number of lines in rawlist which have been processed into db() entries. # resultslist A list of strings, each of which is a line of the final results output. # Use LogResult to add items to the resultslist, rather than adding them manually. # ridxref The index into db() which the corresponding resultslist line is associated with. # e.g. if the 3rd line in resultslist came from db(...,15), then the 3rd line of ridxref should be 15. # rawoutlist A list of strings, each of which is a line of the raw results output. # This is the "working" output, i.e. the things the user needs to see when processing results, # but which noone needs to see in the final output. # Should contain an entry for each line in rawlist which was processed (i.e. ignoring comments and header). # This is where, for example, we go to get entries to "undelete". # Use LogRawResult to add items to rawoutlist. # rawidxref Analogous to ridxref, but for rawoutlist. # # DLFilesRead Names of download files already read in. # DLFilesMTime($fname) The "last modified time" for the files in DownloadFilesRead, at the time that file was read. Index by filename (tail) # set NumStartEntries 0 ;# This is number of entries derived from reading the start box, not total starts set NumRawLines 0 set NumRawLinesProcessed 0 #------------------------------------------------------------------------------------------------------ # Some basic routines # proc GreaterOf {a b} { # Return whichever value is greater of a,b if {$a > $b} { return $a } else { return $b } } proc IsNum {maybenum} { # return 1 if maybenum appears to be a valid number, [+-](0-9)* [.][0-9]* # Allow leading and trailing spaces return 1 } proc IsInt {maybeint} { # return 1 if maybeint appears to be a valid integer # Note, for these purposes, we allow leading zeros (without assuming this means octal, i.e. 08 and 09 are valid), # as well as allowing leading and trailing spaces. return [regexp {^\d*$} [string trim $maybeint]] } proc IsTime {Time} { # Return 1 if the given string is a valid time, 0 if not. # The following are valid times: # 0 1:00 1:00:00 # as well as some more unusual forms: # 0001 -1 -0 :1 :00001 1:000001 1000:101:0 # set Time [string trim $Time] ;# Trim whitespace from both ends if {$Time eq ""} {return 0} ;# A null (or only whitespace) value is not a time if { [regexp {^[-]?[0-9]+$} $Time] || \ [regexp {^[-]?[0-9]*:[0-9]+$} $Time] || \ [regexp {^[-]?[0-9]*:[0-9]+:[0-9]+$} $Time] \ } { return 1 } else { return 0 } } proc IsDNF {time} { # Return 1 if time is any of the many possible DNF like results (DNF, ----, "", DSQ, etc). # Return 0 if time is just a normal time (i.e. does not match any of the known non-time values) # Note: We trim the given $time value, removing any whitespace from beginning and end, before checking against the DNF types. # Note that some of these are not "real" values. For example, NOI (no information) is used here, but is not an IOF/OUSA reasult. set DNFTypes {"Throw" "Skip" "----" "" " " " " "NoFinish" "NoDL" \ "DNF" "DNS" "DSQ" "OVT" "MSP" "MP" "SPW" "NOI" \ "Dnf" "Dns" "Dsq" "Ovt" "Msp" "Mp" "Spw" "Noi" \ "dnf" "dns" "dsq" "ovt" "msp" "mp" "spw" "noi"} if {[lsearch $DNFTypes [string trim $time]] != -1} { # Time matches one of the DNF types return 1 } # It is also possible that the time is a TimeTillStart or TimeSinceStart pseudotime. This is also a form of DNF. if {[regexp {.* US$} $time]} { return 1 } if {[regexp {.* SS$} $time]} { return 1 } # Time isn't one of the DNF types, so return 0 # i.e. we don't actually check if it is a valid time, only that it is not a DNF type return 0 } proc IsNoDL {time} { # Return 1 if time is any of the possible No Download results # Return 0 otherwise. (Might be a DNF, might be a real time.) if {$time eq "NoDL"} { return 1 } # It is also possible that the time is a TimeTillStart or TimeSinceStart pseudotime. This is also a form of DNF. if {[regexp {.* US$} $time]} { return 1 } if {[regexp {.* SS$} $time]} { return 1 } return 0 } proc IsDNFNotNoDL {time} { # Return 1 if time is any of the possible DNF like results EXCEPT for a No Download type result. # Return 0 otherwise (i.e. if a real finish or a No Download). if {[IsDNF $time]} { if {[IsNoDL $time]} { return 0 } else { return 1 } } else { return 0 } } proc SplitOnSpace {line} { # Split the given line into a list of elements by splitting on single spaces. # e.g. '1 2 3' -> {{1} {2} {} {3}} # Also allow quoting, # e.g. '1 2 "One element" 3 4,5,"6 and 7"' -> {{1} {2} {One element} {3} {4,5,6 and 7}} set returnstring [split $line " "] return $returnstring # Quoting doesn't work yet. TODO # This routine isn't working, even for nonquotable. the #defevent seems to be giving trouble somehow (a reserved return characteristic?) # To do quoting: # while(split into three parts, before first quote, between first and second quote, after second quote) # replace all spaces in middle group with <>, remove quotes, stick everything back together and get ready to repeat # until there aren't any quotes left # split on spaces # for each item in splitlist, replace all <> with spaces # } #------------------------------------------------------------------------------------------------------ # Set up some scrollable areas # proc ScrolledListbox {f args} { frame $f listbox $f.list \ -xscrollcommand [list ScrollSet $f.xscroll [list grid $f.xscroll -row 1 -column 0 -sticky we]] \ -yscrollcommand [list ScrollSet $f.yscroll [list grid $f.yscroll -row 0 -column 1 -sticky ns]] eval {$f.list configure} $args scrollbar $f.xscroll -orient horizontal -command [list $f.list xview] scrollbar $f.yscroll -orient vertical -command [list $f.list yview] grid $f.list -sticky news grid rowconfigure $f 0 -weight 1 grid columnconfigure $f 0 -weight 1 return $f.list } proc ScrollSet {scrollbar geoCmd offset size} { if {$offset != 0.0 || $size != 1.0} { eval $geoCmd ;# Make sure it is visible } $scrollbar set $offset $size } #------------------------------------------------------------------------------------------------------ # Time handling routines # # All times are strings, in the form of hh:mm:ss # The following are all valid: 12:34:56 09:34:56 9:34:56 34:56 4:56 15 03 3 # Any truncations are assumed off the left end, i.e. will always contain at least one # digit of seconds. # If time-of-day, hh will be in 24 hour form. # Any time returned will have the same format, with left side 0's changed to spaces # i.e. 00:03:08 -> " 3:08" proc SimpleTest {} { # Leave this here for quick testing of routines. if {0} { foreach time {"12:05:36" "02:15" "36" "0"} { set trunctime [HHMMSSToHHMMTime $time] puts "$time -> -$trunctime-" } } if {0} { foreach testint {"1" "10" "01" " 10" " 12 " "a" "1a2"} { puts "Testing ($testint): [IsInt $testint]." } } if {0} { foreach time {"01" "02:01" "02:00" "1:03:00" "1:03:01"} { set min [TimeToMin $time] puts "Convert $time to $min" } } if {0} { foreach time {"01" "02:01" "02:00" "1:03:00" "1:03:01" "DNF" "OVT" " " "-01" "-02:10" "1a2" " 12:05:36" "12:05:37 "} { puts "Testing IsTime($time): [IsTime $time]" } } } proc IsTimeOld {Time} { # Obsolete function. The current IsTime is located elsewhere (near IsDNF) # Return 1 if the given string is a valid time, 0 if not. <-- Not true at this time. Intended for later. # Actually, right now it doesn't return anything, and nothing calling this checks for a return value. # We just output a warning about a bad time value for now, to help in finding the offending value when it occurs. # TODO set Time [string trim $Time] set SplitStr [split $Time :] switch [llength $SplitStr] { 3 { set Hours [lindex $SplitStr 0]; set Minutes [lindex $SplitStr 1]; set Seconds [lindex $SplitStr 2] } 2 { set Hours 0; set Minutes [lindex $SplitStr 0]; set Seconds [lindex $SplitStr 1] } 1 { set Hours 0; set Minutes 0; set Seconds [lindex $SplitStr 0] } default {puts "Bad time 1: $Time"} } if {![string is digit $Hours]} { puts "Bad time a: -$Time-. -$Hours-" } if {![string is digit $Minutes]} { puts "Bad time b: -$Time-. -$Minutes-" } if {![string is digit $Seconds]} { puts "Bad time c: -$Time-. -$Seconds-" } } proc StripLeadingZeros {Time} { # Take a time (or integer) and strip leading insignificant characters, i.e. 0's, :'s, etc # Leave leading spaces intact (i.e. don't change the length of the string). # # This is inefficient. # Could do better using regexp matching; do this if performance becomes problematic. set FoundSig 0 ;# Have we gotten to a significant character yet, i.e. 0-9, ., etc set LenLimit [expr [string length $Time] - 1] ;# Don't check last char for {set i 0} {$i < $LenLimit} {incr i} { switch -regexp -- [string index $Time $i] { {[ +-]} {} {[0:]} {set Time [string replace $Time $i $i " "]} default {set FoundSig 1} } if {$FoundSig} {break} } return $Time } proc TimeToShortTime {Time} { # Convert a time string in hh:mm:ss to mmm:ss if {$Time eq "Throw" || $Time eq "Skip" || $Time eq "----" || $Time eq ""} { return $Time } set Seconds [TimeToSec $Time] set Minutes [expr {int([expr {$Seconds / 60}])}] set Seconds [expr {$Seconds - $Minutes * 60}] set Output [format "%03u:%02u" $Minutes $Seconds] # Now just strip off the leading 0's (and unneeded ":"'s) # Search for the first character not a space, 0, or : # then change every character before that one to a space. set Output [StripLeadingZeros $Output] return $Output } proc HHMMToHHMMSSTime {Time} { # Convert a time string in hh:mm to hh:mm:00 return "$Time:00" } proc HHMMSSToHHMMTime {Time} { # Convert a time string in hh:mm:ss to hh:mm by truncation of seconds. # To line up with other time values, leave spaces as the last three characters, i.e. over the :ss set SplitStr [split $Time :] set Hours 0; set Minutes 0; set Seconds 0 ;# Initialize, just to prevent a crash in case of bad data. switch [llength $SplitStr] { 3 { set Hours [lindex $SplitStr 0]; set Minutes [lindex $SplitStr 1]; } 2 { set Hours 0; set Minutes [lindex $SplitStr 0]; } 1 { set Hours 0; set Minutes 0; } default {puts "Bad time1: $Time, treated as 00:00:00. Be suspicious of results."; ErrorMsg "Bad time: $Time, treated as 00:00:00. Be suspicious of results."} } set Hours [StripLeadingZeros $Hours] set Minutes [StripLeadingZeros $Minutes] set Seconds [StripLeadingZeros $Seconds] set TruncTimeInSec [expr {$Hours * 3600 + $Minutes * 60 + $Seconds}] if {$TruncTimeInSec == 0} { # return "0 " return "0" } else { # return [StripLeadingZeros [format "%02u:%02u " $Hours $Minutes]] return [StripLeadingZeros [format "%02u:%02u" $Hours $Minutes]] } } proc TimeToMin {Time} { # Convert a time string in hh:mm:ss form to minutes, rounding up, e.g. 0:00 -> 0 minutes, 0:01 -> 1 minute set SplitStr [split $Time :] set Hours 0; set Minutes 0; set Seconds 0 switch [llength $SplitStr] { 3 { set Hours [lindex $SplitStr 0]; set Minutes [lindex $SplitStr 1]; set Seconds [lindex $SplitStr 2] } 2 { set Hours 0; set Minutes [lindex $SplitStr 0]; set Seconds [lindex $SplitStr 1] } 1 { set Hours 0; set Minutes 0; set Seconds [lindex $SplitStr 0] } default {puts "Bad time2: $Time, treated as 00:00:00. Be suspicious of results."; ErrorMsg "Bad time: $Time, treated as 00:00:00. Be suspicious of results."} } set Hours [StripLeadingZeros $Hours] set Minutes [expr {[StripLeadingZeros $Minutes] + (60 * $Hours)}] set Seconds [StripLeadingZeros $Seconds] if {$Seconds > 0} { incr Minutes } return $Minutes } proc TimeToSec {Time} { # Convert a time string in hh:mm:ss form to seconds. set SplitStr [split $Time :] set Hours 0; set Minutes 0; set Seconds 0 ;# Initialize, just to prevent a crash in case of bad data. switch [llength $SplitStr] { 3 { set Hours [lindex $SplitStr 0]; set Minutes [lindex $SplitStr 1]; set Seconds [lindex $SplitStr 2] } 2 { set Hours 0; set Minutes [lindex $SplitStr 0]; set Seconds [lindex $SplitStr 1] } 1 { set Hours 0; set Minutes 0; set Seconds [lindex $SplitStr 0] } default {puts "Bad time2: $Time, treated as 00:00:00. Be suspicious of results."; ErrorMsg "Bad time: $Time, treated as 00:00:00. Be suspicious of results."} } # IsTime $Time set Hours [StripLeadingZeros $Hours] set Minutes [StripLeadingZeros $Minutes] set Seconds [StripLeadingZeros $Seconds] return [expr {$Hours * 3600 + $Minutes * 60 + $Seconds}] } proc SecToTime {Seconds} { # Convert seconds into a time string in hh:mm:ss form, with leading 0's changed to spaces. set InSeconds $Seconds set Hours [expr {int ([expr {$Seconds / 3600}])}] set Seconds [expr {$Seconds - $Hours * 3600}] set Minutes [expr {int([expr {$Seconds / 60}])}] set Seconds [expr {$Seconds - $Minutes * 60}] set Output [format "%02u:%02u:%02u" $Hours $Minutes $Seconds] #puts "SecToTime: $InSeconds -> $Hours $Minutes $Seconds -> $Output" # Now just strip off the leading 0's (and unneeded ":"'s) # Search for the first character not a space, 0, or : # then change every character before that one to a space. set Output [StripLeadingZeros $Output] return $Output } proc TimeSubtract {Time1 Time2} { # Give the result of Time1 - Time2 in hh:mm:ss form. #puts "Subtracting: $Time1 - $Time2" #if {$Time1 == "" || $Time2 == ""} return "" #if {$Time1 eq "Throw" || $Time1 eq "Skip" || $Time1 eq "----" || $Time2 eq "Throw" || $Time2 eq "Skip" || $Time2 eq "----"} return "" if {[IsDNF $Time1] || [IsDNF $Time2]} return "" set Seconds1 [TimeToSec $Time1] set Seconds2 [TimeToSec $Time2] set Diff [expr {$Seconds1 - $Seconds2}] return [SecToTime $Diff] # If we wanted, we could write the ugly: # return [SecToTime [expr {[TimeToSec $Time1] - [TimeToSec $Time2]}]] } proc TimeAdd {Time1 Time2} { # Give the result of Time1 + Time2 in hh:mm:ss form. # (I don't think we need this function; all time match in this program is subtraction. # However, I wrote the routine for something else, and include it here in case it becomes # useful in the future.) # (Postscript: It turns out we did need the function after all.) #if {$Time1 == "" || $Time2 == ""} return "" if {[IsDNF $Time1] || [IsDNF $Time2]} return "" set Seconds1 [TimeToSec $Time1] set Seconds2 [TimeToSec $Time2] set Sum [expr {$Seconds1 + $Seconds2}] return [SecToTime $Sum] } proc TimeCompare {Time1 Time2} { # Compare Time1 and Time2, return -1:Time1 smaller, 0:Same, or 1:Time2 smaller # Note: the "time" might be a value of "Skip" or "----" or "" due to a skipped control. A real time is always less than a skip. # We use a false time of 99999 seconds (more than one day) for a "Skip" just to make the coding a little easier #if {$Time1 eq "Throw" || $Time1 eq "Skip" || $Time1 eq "----" || $Time1 eq "" || $Time1 eq "NoFinish"} openbrace if {[IsDNF $Time1]} { set Seconds1 99999 } else { set Seconds1 [TimeToSec $Time1] } #if {$Time2 eq "Throw" || $Time2 eq "Skip" || $Time2 eq "----" || $Time2 eq "" || $Time2 eq "NoFinish"} openbrace if {[IsDNF $Time2]} { set Seconds2 99999 } else { set Seconds2 [TimeToSec $Time2] } if {$Seconds1 == $Seconds2} { return 0 } if {$Seconds1 < $Seconds2 } { return -1 } else { return 1 } } proc DNFCompare {Time1 Time2} { # Compare Time1 and Time2, both expected to actually be DNFs. # -1:Time1 smaller (higher in results), 0:Same, 1:Time2 smaller (higher in results) # Place No Download below DNF in results. if {[IsDNFNotNoDL $Time1] && [IsNoDL $Time2]} { return "-1"} if {[IsDNFNotNoDL $Time2] && [IsNoDL $Time1]} { return "1"} return 0 } proc CurrentTime {} { # Return the current time, according to the setting of the computer's clock. # Will return a string of the form hh:mm:ss return [clock format [clock seconds] -format "%H:%M:%S"] } #------------------------------------------------------------------------------------------------------ # Line to Skip # proc LineToSkip {line} { # Boolean # Returns 1 if this looks like a line to skip from an input file # Returns 0 if this is a "real" data line # # Sorts of lines which trigger a skip: # Comment. Begins with "#" # Blank line. # Download box header line (or any other line beginning with "No.,read at,SI-Card") if {[string range $line 0 0] eq "#"} { # Comment return 1 } if {[string length $line] == 0} { # Blank line return 1 } if {[string first "No.,read at,SI-Card" $line] != -1} { # Download box header line, the original version return 1 } if {[string first "No.,Read at,SI-Card" $line] != -1} { # Download box header line; observed 12/09/23 return 1 } # Doesn't match any pattern of a "skippable" line. return 0 } #------------------------------------------------------------------------------------------------------ # Read Number to Name Database # # There will likely be multiple files containing information to attach names # to SI Card numbers. One would be located one level up from the working directory, # and would contain those names which will be permenantly associated with a # given SI Card (i.e. for someone who owns an old card which does not store # names internally). Another file would be in the working directory, and would # contain temporary name associations, for example for rented sticks. # Each file should have one line per entry, with the stick number followed by # one space followed by the full name. # DO NOT INCLUDE ANY SPACES PRIOR TO THE SI CARD NUMBER. # DO NOT INCLUDE ANY BLANK LINES. # Each line should start with a card number and end with a name. # No attempt will be made to separate first from last names. # # If multiple entries exist for a given SI Card number, the last entered name will # be used, i.e. the day-of-event file will be used over the global file, and # names entered later in the file will be used over those entered earlier in the file. # BUG NOTE: This causes a problem in the case of multiple people using the same # SI-Card on the same day; this can happen easily if sticks are rented, an early runner returns # leaving their stick to be rented out a second time that day. # # Note that it is possible to use multiple number to name lookup files. # Reading in one does not clear the effects of reading a previous one. # proc ReadNumToName { {fname "DefaultFileRequestor"} } { global NameLookup # If no arguments, give file requestor; allow file selection # else, pass through with file taken from argument if {$fname eq "DefaultFileRequestor"} { # If we get here, ReadNumToName was either called with no arguments, # or with our strange default value. Throw up a file requestor for # the user to select the file from. set numtonamefilename [tk_getOpenFile] } else { # We were handed a filename. Do what we can with it. set numtonamefilename $fname } # Check whether file exists and looks valid # Read num to name file if [catch {open $numtonamefilename r} numtonamefilehandle] { puts stderr "File opening error, trying to open: $numtonamefilename." ErrorMsg "File opening error, trying to open: $numtonamefilename." } else { foreach line [split [read -nonewline $numtonamefilehandle] \n] { set worklinelist [split $line] ;# Splits on whitespace: , , (should be no nl) set name [join [lrange $worklinelist 1 end]] if {[info exists NameLookup([lindex $worklinelist 0])]} { # This SI number already has a name associated with it, which we are # about to overwrite with the more recent name. Give a warning message. ErrorMsg "Warning: Changing name for #[lindex $worklinelist 0]: $NameLookup([lindex $worklinelist 0]) -> $name" } set NameLookup([lindex $worklinelist 0]) $name } close $numtonamefilehandle } } #------------------------------------------------------------------------------------------------------ # Increase the value of AMeetNumEvents # proc IncreaseAMeetNumEvents { newAMeetNumEvents } { global AMeetNumEvents Comp Comps # Increase the value of AMeetNumEvents, and handle initialization of default values in the Comp database variable # (only making new values for values which do not already exist, i.e. not overwriting in case something # was already there, which can happen while reading the competitor database) if {$newAMeetNumEvents > $AMeetNumEvents} { foreach $name $Comps { set i [expr {$AMeetNumEvents + 1}] while {$i <= $newAMeetNumEvents} { if {![info exists Comp(SICard,$i,$name)]} { # (We are making the assumption that these are initialized all together, i.e. if one doesn't exist, then none do) # However, do one last check for the presence of the first, default value if {![info exists Comp(SICard,1,$name)] || ![Comp(Class,1,$name)]} { puts "ERROR: No default values for one of SINum,Class for competitor $name." } else { set Comp(Name,$i,$Comp(SICard,1,$name)) $CompName set Comp(SICard,$i,$name) $Comp(SICard,1,$name) set Comp(Class,$i,$name) $Comp(Class,1,$name) set Comp(ResultPlace,$i,$name) "" set Comp(ResultEPlace,$i,$name) "" set Comp(ResultTime,$i,$name) "" set Comp(ResultClass,$i,$name) "" set Comp(ResultClassIdx,$i,$name) "" } ;# if (default values exist) } ;# if ($i values exist) incr i } ;# while } ;# foreach name set AMeetNumEvents $newAMeetNumEvents } ;# if (really need to increase anything } #------------------------------------------------------------------------------------------------------ # Read competitor database # # A competitor database is not necessary for a normal, local event. # This is only useful for an A-Meet type of event. # The fields are comma separated values. The number of fields depends on the number of sub-events. # The values are as follows. # # Name, Club, SpecialRankingsEligible, SICardEvent1, ClassEvent1, SICardEvent2, ClassEvent2 ... # # Note that in most cases, you expect the SICard and Class to be the same for all sub-events; # you expect almost full duplication of these columns. However, the data are placed here like this # in order to more easily handle those odd cases in which someone changes SICards mid-event, or runs in # an unexpected class due to unforseen circumstances. # # As an alternative, we allow empty fields for event 2, event 3,... indicating to use the value from event 1. # Thus, we only fill the extra fields if something changes. proc ReadCompetitorsDB {fname} { global Comps Comp MaxCompIdx AMeetEvent AMeetNumEvents global db CourseNames global debug # # Competitors file: # Firstname Lastname,CLUB,Elig(1or0),SINumber1,Class1,SINumber2,Class2... # # Note: There is a ReadCompetitorsDB2 for a different set of fields. This version is most useful for our meet; the other information # isn't really relevant to us. However, for reporting results of an A-Meet, other people are interested in other information, and we # might as well have this program do that rather than managing it by hand after the event, thus the multiple forms. # set NumberOfEventsByFields -1 ;# This is the maximum number of events we have seen suggested by the fields present in the competitors file, ;# i.e. how many SINum,Class pairs occurred (at least once). if {$AMeetEvent > $AMeetNumEvents} { set AMeetNumEvents $AMeetEvent } if [catch {open $fname r} fnamefilehandle] { puts stderr "File opening error, trying to open $fname." ErrorMsg "File opening error, trying to open $fname." } else { set Neg -1 ;# This will be a negative index into db foreach line [split [read -nonewline $fnamefilehandle] \n] { incr Neg -1 ;# Count down with these indices. First will be -2. (-1 is used for "not found" in several places) set worklinelist [split $line ,] if {[llength $worklinelist] >= 5} { set name [lindex $worklinelist 0] set club [lindex $worklinelist 1] set eligible [lindex $worklinelist 2] set numevents [expr { ([llength $worklinelist] - 3) / 2 }] ;# This is the number on this line to be read. if { [expr { ([llength $worklinelist] - 3) % 2 } ] != 0} { # We are expecting an even number of fields following the eligible field, but it is odd. ErrorMsg "ERROR: Missing a field in competitors file: $line" continue } if {$NumberOfEventsByFields == -1 || $NumberOfEventsByFields < $numevents} { set NumberOfEventsByFields $numevents } lappend Comps $name set Comp(Club,$name) $club set Comp(Elig,$name) $eligible set Comp(DBIdx,$name) $Neg ;# This is a negative number until this competitor downloads something set db(Use,$Neg) 1 ;# Set up the "fake", negative db index for this undownloaded competitor set db(Dup,$Neg) 0 set db(DupSIChecked,$Neg) 0 ;# This is a negative index. This value should stay 0. set db(Registered,$Neg) 1 set db(SICard,$Neg) "" ;# For now. Will set a value below. set db(Name,$Neg) $name set db(NumPunches,$Neg) 0 set db(RealPunches,$Neg) {} set db(RealPunchTime,$Neg) {} set db(ClearTime,$Neg) "" set db(ClearCN,$Neg) "" set db(StartTime,$Neg) "" set db(FinishTime,$Neg) "" set db(TotalTime,$Neg) "" set db(EditResult,$Neg) "" set db(FinalResult,$Neg) "NOI" set db(Course,$Neg) -1 ;# For now. Will set a value below. set db(Finished,$Neg) 0 set db(NumCPunches,$Neg) 0 set db(CPunches,$Neg) {} set db(CPunchTime,$Neg) {} set db(ElapsedTime,$Neg) {} set db(SplitTime,$Neg) {} set db(DelayedWarnings,$Neg) {} if {$debug >= 1} {puts "Setting db: $Neg $db(Name,$Neg)"} #puts "CD: $name, $club, $eligible" set i 1 while {$i <= [GreaterOf $AMeetNumEvents $numevents]} { if {$i <= $numevents} { set sicard($i) [lindex $worklinelist [expr {1 + 2*$i}]] set class($i) [lindex $worklinelist [expr {2 + 2*$i}]] } else { set sicard($i) "" set class($i) "" } if { $sicard($i) eq "" } { set sicard($i) $sicard(1) } if { $class($i) eq "" } { set class($i) $class(1) } set Comp(Name,$i,$sicard($i)) $name ;# SICard to Name set Comp(SICard,$i,$name) $sicard($i) ;# Name to SICard (less useful) set Comp(Class,$i,$name) $class($i) set Comp(ResultPlace,$i,$name) "" ;# Default set Comp(ResultEPlace,$i,$name) "" ;# Default set Comp(ResultTime,$i,$name) "" ;# Default set Comp(ResultClass,$i,$name) "" ;# Default set Comp(ResultClassIdx,$i,$name) "" ;# Default incr i } set db(SICard,$Neg) $Comp(SICard,$AMeetEvent,$name) set db(Course,$Neg) [lsearch $CourseNames $Comp(Class,$AMeetEvent,$name)] } else { # Not enough fields ErrorMsg "ERROR: Missing fields in competitors file: $line" } } } set MaxCompIdx $Neg if {$NumberOfEventsByFields > $AMeetNumEvents} { IncreaseAMeetNumEvents $NumberOfEventsByFields } } proc ReadCompetitorsDB2 {fname} { global Comps Comp MaxCompIdx AMeetEvent AMeetNumEvents global db CourseNames global debug # # Competitors file, version 2: # Name,CLUB,YOB,Elig(1or0),SINumber1,Class1,SINumber2,Class2,...SINumberN,ClassN,Firstname,Lastname # # Note: There is a ReadCompetitorsDB for a different set of fields. # This version is most useful for reporting results of an A-Meet, (other people are interested in different information than ourselves), # and we might as well have this program do that rather than managing it by hand after the event, thus the multiple forms. # set NumberOfEventsByFields -1 ;# This is the maximum number of events we have seen suggested by the fields present in the competitors file, ;# i.e. how many SINum,Class pairs occurred (at least once). if {$AMeetEvent > $AMeetNumEvents} { set AMeetNumEvents $AMeetEvent } if [catch {open $fname r} fnamefilehandle] { puts stderr "File opening error, trying to open $fname." ErrorMsg "File opening error, trying to open $fname." } else { set Neg -1 ;# This will be a negative index into db foreach line [split [read -nonewline $fnamefilehandle] \n] { incr Neg -1 ;# Count down with these indices. First will be -2. (-1 is used for "not found" in several places) set worklinelist [split $line ,] if {[llength $worklinelist] >= 8} { set name [lindex $worklinelist 0] set club [lindex $worklinelist 1] set yob [lindex $worklinelist 2] set eligible [lindex $worklinelist 3] set firstname [lindex $worklinelist end-1] set lastname [lindex $worklinelist end] set numevents [expr { ([llength $worklinelist] - 6) / 2 }] ;# This is the number on this line to be read. if { [expr { ([llength $worklinelist] - 6) % 2 } ] != 0} { # We are expecting an even number of fields following the eligible field, but it is odd. ErrorMsg "ERROR: Missing a field in competitors file: $line" continue } if {$NumberOfEventsByFields == -1 || $NumberOfEventsByFields < $numevents} { set NumberOfEventsByFields $numevents } lappend Comps $name set Comp(Club,$name) $club set Comp(YOB,$name) $yob set Comp(Elig,$name) $eligible set Comp(Firstname,$name) $firstname set Comp(Lastname,$name) $lastname set Comp(DBIdx,$name) $Neg ;# This is a negative number until this competitor downloads something set db(Use,$Neg) 1 ;# Set up the "fake", negative db index for this undownloaded competitor set db(Dup,$Neg) 0 set db(DupSIChecked,$Neg) 0 ;# This is a negative index. This value should stay 0. set db(Registered,$Neg) 1 set db(SICard,$Neg) "" ;# For now. Will set a value below. set db(Name,$Neg) $name set db(NumPunches,$Neg) 0 set db(RealPunches,$Neg) {} set db(RealPunchTime,$Neg) {} set db(ClearTime,$Neg) "" set db(ClearCN,$Neg) "" set db(StartTime,$Neg) "" set db(FinishTime,$Neg) "" set db(TotalTime,$Neg) "" set db(EditResult,$Neg) "" set db(FinalResult,$Neg) "NOI" set db(Course,$Neg) -1 ;# For now. Will set a value below. set db(Finished,$Neg) 0 set db(NumCPunches,$Neg) 0 set db(CPunches,$Neg) {} set db(CPunchTime,$Neg) {} set db(ElapsedTime,$Neg) {} set db(SplitTime,$Neg) {} set db(DelayedWarnings,$Neg) {} if {$debug >= 1} {puts "Setting db: $Neg $db(Name,$Neg)"} #puts "CD: $name, $club, $eligible" set i 1 while {$i <= [GreaterOf $AMeetNumEvents $numevents]} { if {$i <= $numevents} { set sicard($i) [lindex $worklinelist [expr {2 + 2*$i}]] set class($i) [lindex $worklinelist [expr {3 + 2*$i}]] } else { set sicard($i) "" set class($i) "" } if { $sicard($i) eq "" } { set sicard($i) $sicard(1) } if { $class($i) eq "" } { set class($i) $class(1) } set Comp(Name,$i,$sicard($i)) $name ;# SICard to Name set Comp(SICard,$i,$name) $sicard($i) ;# Name to SICard (less useful) set Comp(Class,$i,$name) $class($i) set Comp(ResultPlace,$i,$name) "" ;# Default set Comp(ResultEPlace,$i,$name) "" ;# Default set Comp(ResultTime,$i,$name) "" ;# Default set Comp(ResultClass,$i,$name) "" ;# Default set Comp(ResultClassIdx,$i,$name) "" ;# Default if {$debug >= 3} {puts " $Comp(SICard,$i,$name) $Comp(Class,$i,$name)"} incr i } set db(SICard,$Neg) $Comp(SICard,$AMeetEvent,$name) set db(Course,$Neg) [lsearch $CourseNames $Comp(Class,$AMeetEvent,$name)] } else { # Not enough fields ErrorMsg "ERROR: Missing fields in competitors file: $line" } } } set MaxCompIdx $Neg if {$NumberOfEventsByFields > $AMeetNumEvents} { IncreaseAMeetNumEvents $NumberOfEventsByFields } } #------------------------------------------------------------------------------------------------------ # Read Start Times file # # Note: This is not likely to be used at a regular local event; this is more likely to be used # at an A-Meet, where starts are scheduled. # # Make certain this routine is called after reading the competitors database. # # The start times file should contain lines of comma separated values, of the form: # Competitor Name, HH:MM # one line per competitor. proc ReadStarttimesDB {fname} { global Comps Starttime if [catch {open $fname r} fnamefilehandle] { puts stderr "File opening error, trying to open $fname." ErrorMsg "File opening error, trying to open $fname." } else { # Clear the old Starttime first, and make sure every competitor has something here foreach CompetitorName $Comps { set Starttime($CompetitorName) "" ;# Use "" as a default starttime } ;# foreach CompetitorName $Comps foreach line [split [read -nonewline $fnamefilehandle] \n] { set worklinelist [split $line ,] if {[llength $worklinelist] == 2} { set name [lindex $worklinelist 0] set time [lindex $worklinelist 1] # Convert time as read here, which will be in minutes form, to a 00 seconds form. set time [HHMMToHHMMSSTime $time] set Starttime($name) $time #puts "Starttime for $name at $time. Trunc: [HHMMSSToHHMMTime $time]" } else { ErrorMsg "WARNING: Wrong number of fields in Starttimes file: $line" continue } ;# if length worklinelist } ;# foreach line } ;# catch open fname } #------------------------------------------------------------------------------------------------------ # Write EventResultsCSV file # proc WriteEventResultsCSV {} { global AMeetMode AMeetEvent ResultCSVOutput ResultECSVOutput ResultOUSAOutput workingdir if {!$AMeetMode} { return } if {$ResultCSVOutput != {}} { set outfilename [format "EventResultA%d.csv" $AMeetEvent] set outfilename [tk_getSaveFile -initialfile [file tail $outfilename] -initialdir $workingdir] if [catch {open $outfilename w} outfile] { puts stderr "File opening error on writing $outfilename." ErrorMsg "File opening error on writing $outfilename." } else { foreach line $ResultCSVOutput { puts $outfile $line } close $outfile } } if {$ResultECSVOutput != {}} { set outfilename [format "EventResultE%d.csv" $AMeetEvent] set outfilename [tk_getSaveFile -initialfile [file tail $outfilename] -initialdir $workingdir] if [catch {open $outfilename w} outfile] { puts stderr "File opening error on writing $outfilename." ErrorMsg "File opening error on writing $outfilename." } else { foreach line $ResultECSVOutput { puts $outfile $line } close $outfile } } if {$ResultOUSAOutput != {}} { set outfilename [format "EventResultOUSADay%d.csv" $AMeetEvent] set outfilename [tk_getSaveFile -initialfile [file tail $outfilename] -initialdir $workingdir] if [catch {open $outfilename w} outfile] { puts stderr "File opening error on writing $outfilename." ErrorMsg "File opening error on writing $outfilename." } else { foreach line $ResultOUSAOutput { puts $outfile $line } close $outfile } } } #------------------------------------------------------------------------------------------------------ # Read EventResultsCSV files # proc ReadEventResultsCSV { dir fname } { global Comp AMeetEvent CourseNames EvNCourseNames # set CurrentClass "" if {[regexp {^EventResult(A|E)(.*).csv$} $fname match eventtype eventnum]} { if [catch {open [file join $dir $fname] r} filehandle] { puts stderr "File opening error: $fname." ErrorMsg "File opening error: $fname." } else { # Read the file foreach line [split [read -nonewline $filehandle] \n] { # If the file isn't broken, we should have one of three types of lines: # 1) Blank line. Do nothing. This was only to improve human readability # 2) Line with no commas. This is a class header. Use this as the new current class being read. # 3) Line with 3 commas (4 fields): Place, Name, Club, Time(or DNF, DNS, ...) if {$line != ""} { set worklinelist [split $line ,] if {[llength $worklinelist] == 1} { set CurrentClass [lindex $worklinelist 0] } elseif {[llength $worklinelist] == 4} { set place [lindex $worklinelist 0] set name [lindex $worklinelist 1] set club [lindex $worklinelist 2] set time [lindex $worklinelist 3] switch $eventtype { "A" {set Comp(ResultPlace,$eventnum,$name) $place} "E" {set Comp(ResultEPlace,$eventnum,$name) $place} } set Comp(ResultTime,$eventnum,$name) $time set Comp(ResultClass,$eventnum,$name) $CurrentClass # RNOW # I am not certain we really want the original index for the class; it seem the name is more useful. # However, here it is. set Comp(ResultClassIdx,$eventnum,$name) [lsearch $EvNCourseNames($eventnum) $Comp(Class,$eventnum,$name)] } else { puts "Problem in file: $fname. Line has wrong number of fields: $line." ErrorMsg "Problem in file: $fname. Line has wrong number of fields: $line." } } } close $filehandle CalcResults } } } proc LookForEventResultsFiles {} { global workingdir # Look for any files of the form EventResult*.csv, and read these set pwd [pwd] ;# Store the pwd (previously used directory) if {[catch {cd $workingdir} err]} { ;# Change to the defined working directory puts $err return } foreach fnamematch [glob -nocomplain -- "EventResult*.csv"] { ReadEventResultsCSV $workingdir $fnamematch } cd $pwd ;# Reset back to the previous directory } #------------------------------------------------------------------------------------------------------ # Read Timeshift file # # Control file: Timeshift # One line per control to be time shifted. Starts with control number, or Start, Finish, All # Following control identifier, +00:00:00 or -00:00:00 # This indicates a time to add or subtract from the time reported by that box. # For example, if the Start box is found to be 4 minutes early, use: # Start +00:04:00 # Start +4:00 Any of these three are valid, but the first is preferred # Start 4:00 # For a DST shift in which start and finish were updated but normal controls were not # AllControls +01:00:00 or # AllControls -01:00:00 depending on which way the shift is proc ReadTimeshift {fname} { global timeshift array unset timeshift if [catch {open $fname r} timeshiftfilehandle] { puts "1aside" puts stderr "File opening error: Timeshift file." # No more error message than this. Never really need this file. } else { ErrorMsg "Reading Timeshift file $fname" foreach line [split [read -nonewline $timeshiftfilehandle] \n] { set fields [split $line] ;# Splits on whitespace: , , (should be no nl) set controlfield [lindex $fields 0] set timefield [join [lindex $fields 1 end]] if {[string match "-*" $timefield]} { set timeshift($controlfield,Add) 0 set timefield [string range $timefield 1 end] ;# strip leading - } elseif {[string match "+*" $timefield]} { set timeshift($controlfield,Add) 1 set timefield [string range $timefield 1 end] ;# strip leading + } else { set timeshift($controlfield,Add) 1 } set timeshift($controlfield) $timefield } close $timeshiftfilehandle } } #------------------------------------------------------------------------------------------------------ # Set Working Directory # proc SetWorkingDirectory { {dirname "DefaultDirRequestor"} } { global rawdatafilename workingdir coursefilename global DefaultRawFilename global DefaultCourseFilename DefaultCourseFilenames global DefaultNumToNameFilename DefaultNumToNameFilenames global DefaultGlobalNumToNameFNs global DefaultCompetitorsDBFilenames CompetitorsDBForm global DefaultStarttimesDBFilenames global DefaultTimeshiftFNs # Call with either zero or one arguments; if none, then give a file requestor # to select the working directory; if one, then use that directory if possible. # Then, check the selected working directory to see if it contains likely # default files to use for course descriptions or the raw results file # (only use these defaults if we have no values for these filenames yet). # Give file requestor; allow directory selection if {$dirname eq "DefaultDirRequestor"} { # If we get here, SetWorkingDirectory likely called with no args. # Give a file requestor to let the user select something set workingdir [tk_chooseDirectory] } else { # SetWorkingDirectory called with an arg. # Use that as the working directory. set workingdir $dirname } # Check whether dir exists and appears valid (writable, etc) # TODO # Check for a default raw datafile # ReadRawData with given default raw datafile if {$rawdatafilename eq ""} { if {[file exists [file join $workingdir $DefaultRawFilename]]} { ReadRawData [file join $workingdir $DefaultRawFilename] } } # Check for a default course description file # ReadCourses with given course description file # Old version: #if {$coursefilename eq ""} { # if {[file exists [file join $workingdir $DefaultCourseFilename]]} { # ReadCourses [file join $workingdir $DefaultCourseFilename] # } # } if {$coursefilename eq ""} { foreach TryThisFilename $DefaultCourseFilenames { if {[file exists [file join $workingdir $TryThisFilename]]} { ReadCourses [file join $workingdir $TryThisFilename] break } } } # Check for a runners database (i.e. name to SI Card mapping) # First, read in the default global number to names database (i.e. one directory up) set parentdir [file dirname $workingdir] # Old version: #if {[file exists [file join $parentdir $DefaultNumToNameFilename]]} { # ReadNumToName [file join $parentdir $DefaultNumToNameFilename] # } #set SpecFilename $DefaultNumToNameFilename #append SpecFilename "Global" #if {[file exists [file join $parentdir $SpecFilename]]} { # ReadNumToName [file join $parentdir $SpecFilename] # } foreach TryThisFilename $DefaultGlobalNumToNameFNs { if {[file exists [file join $parentdir $TryThisFilename]]} { ReadNumToName [file join $parentdir $TryThisFilename] } } # Now, read in the local one (i.e. in the current working directory) # Old version: #if {[file exists [file join $workingdir $DefaultNumToNameFilename]]} { # ReadNumToName [file join $workingdir $DefaultNumToNameFilename] # } #set SpecFilename $DefaultNumToNameFilename #append SpecFilename "Event" #if {[file exists [file join $parentdir $SpecFilename]]} { # ReadNumToName [file join $parentdir $SpecFilename] # } foreach TryThisFilename $DefaultNumToNameFilenames { if {[file exists [file join $workingdir $TryThisFilename]]} { ReadNumToName [file join $workingdir $TryThisFilename] break } } # Read in an A-Meet competitors database, if one exists foreach TryThisFilename $DefaultCompetitorsDBFilenames { if {[file exists [file join $workingdir $TryThisFilename]]} { switch $CompetitorsDBForm { 1 { ReadCompetitorsDB [file join $workingdir $TryThisFilename] } 2 { ReadCompetitorsDB2 [file join $workingdir $TryThisFilename] } } break } } # Read in a start times database, if one exists foreach TryThisFilename $DefaultStarttimesDBFilenames { if {[file exists [file join $workingdir $TryThisFilename]]} { ReadStarttimesDB [file join $workingdir $TryThisFilename] break } } # Check for a timeshift file foreach TryThisFilename $DefaultTimeshiftFNs { if {[file exists [file join $workingdir $TryThisFilename]]} { ReadTimeshift [file join $workingdir $TryThisFilename] break } } # Try to process if {$dirname eq "DefaultDirRequestor"} { # Only try to process in this case; otherwise, this proc was called from somewhere # which will call the processing itself. TryToProcess } } #------------------------------------------------------------------------------------------------------ # Read Raw Datafile # proc ReadRawData { {fname "DefaultFileRequestor"}} { global rawdatafilename workingdir rawlist NumRawLines NumRawLinesProcessed global GTGRaw # If no arguments, give file requestor; allow file selection # else, pass through with file taken from argument if {$fname eq "DefaultFileRequestor"} { # If we get here, ReadRawData likely called with no args. # Give a file requestor to select the file from. set rawdatafilename [tk_getOpenFile] } else { # Use the arg we were passed set rawdatafilename $fname } # Check whether file exists and looks valid # TODO # If working dir is not yet set, set to file's dir #if {$workingdir eq ""} { # set workingdir [file dirname $rawdatafilename] # } if {$workingdir eq ""} { SetWorkingDirectory [file dirname $rawdatafilename] } # Read file into an internal list if [catch {open $rawdatafilename r} rawfilehandle] { puts stderr "File opening error: RawData.csv." ErrorMsg "File opening error: RawData.csv." } else { # First, clear in case we already read another raw results file set rawlist [list] set NumRawLines 0 set NumRawLinesProcessed 0 foreach line [split [read -nonewline $rawfilehandle] \n] { lappend rawlist $line incr NumRawLines } close $rawfilehandle set GTGRaw 1 } # Try to process if {$fname eq "DefaultFileRequestor"} { # Only try to process in this case; otherwise, this proc was called from somewhere # which will call the processing itself. TryToProcess } } #------------------------------------------------------------------------------------------------------ # Read Raw Datafile for Append # proc ReadRawDataForAppend { {fname "DefaultFileRequestor"}} { global rawdataappendfilename workingdir rawlist NumRawLines NumRawLinesProcessed global GTGRaw # Still need tracking: # Track rawlist size? # Will also need to set this up to read as non-blocking # If no arguments, give file requestor; allow file selection # else, pass through with file taken from argument if {$fname eq "DefaultFileRequestor"} { # If we get here, ReadRawDataForAppend likely called with no args. # Give a file requestor to select the file from. set rawdataappendfilename [tk_getOpenFile] } else { # Use the arg we were passed set rawdataappendfilename $fname } # Check whether file exists and looks valid # TODO # If working dir is not yet set, set to file's dir #if {$workingdir eq ""} { # set workingdir [file dirname $rawdataappendfilename] # } if {$workingdir eq ""} { SetWorkingDirectory [file dirname $rawdataappendfilename] } # Read file into an internal list if [catch {open $rawdataappendfilename r} rawfilehandle] { puts stderr "File opening error: RawDataAppend.csv." ErrorMsg "File opening error: RawDataAppend.csv." } else { # Biggest difference here from ReadRawData: We don't clear rawlist, # whereas ReadRawData does that right here. foreach line [split [read -nonewline $rawfilehandle] \n] { lappend rawlist $line incr NumRawLines } close $rawfilehandle set GTGRaw 1 } # Try to process if {$fname eq "DefaultFileRequestor"} { # Only try to process in this case; otherwise, this proc was called from somewhere # which will call the processing itself. TryToProcess $NumRawLinesProcessed } } #------------------------------------------------------------------------------------------------------ # Look for new Raw Datafiles (i.e. new download files) to read # proc LookForNewDownloads {} { global rawdatafilename workingdir rawlist NumRawLinesProcessed global GTGRaw global DLFilesRead DLFilesMTime global timerset AlwaysRecalcOnTimerEvent global AMeetEvent global debug set NeedToRestartTimer 0 if {$timerset} { # Cancel the currently pending timer, so it can't trigger while we are already in here. CancelTimer set NeedToRestartTimer 1 } set AnythingToProcess 0 set pwd [pwd] ;# Store the pwd (previously used directory) if {[catch {cd $workingdir} err]} { ;# Change to the defined working directory puts $err return } # foreach fnamematch [glob -nocomplain -- "RawDownload*"] Original form foreach fnamematch [glob -nocomplain -- "RawDownloadE*?.*"] { if {[regexp {RawDownloadE([0-9]*)[.].*} $fnamematch match eventnum] && $eventnum == $AMeetEvent} { if {[lsearch $DLFilesRead $fnamematch] == -1 || $DLFilesMTime($fnamematch) != [file mtime [file join $workingdir $fnamematch]]} { # This is a new download file, or is one read before but since modified if {$debug >= 1} {puts "Reading: $fnamematch"} lappend DLFilesRead $fnamematch set DLFilesMTime($fnamematch) [file mtime [file join $workingdir $fnamematch]] ReadRawDataForAppend [file join $workingdir $fnamematch] set AnythingToProcess 1 } else { # This file has been read before #puts "Old file: $fnamematch" } ;# if lsearch ... } else { # This is a raw download for a different event. Do not read. } ;# if regexp ... } ;# foreach fnamematch cd $pwd ;# Reset back to the previous directory # Note: We may need to call TryToProcess regardless of whether anything here has changed; in the case # of timed updates, we want to recalc on every timer trigger, even if there are no new downloads, # in order to update estimated time on course based on scheduled start times. if {$AnythingToProcess || $AlwaysRecalcOnTimerEvent} { TryToProcess $NumRawLinesProcessed } if {$NeedToRestartTimer} { ScheduleTimer } } #------------------------------------------------------------------------------------------------------ # Server socket misc # # We open a server socket here. # The way this works is, the program that is reading the download box will write a download file # every time a download occurs. It will then connect to this server (or stay connected) and # send us a brief indication that a new download file is available. # proc OpenNewDownloadServerSocket {} { global NewDLSocket set NewDLSocket(main) [socket -server NewDLAccept 13372] #puts "Setting up socket." } proc NewDLAccept {sock addr port} { global NewDLSocket puts "Accept socket connection: $sock from $addr port $port" set NewDLSocket(addr,$sock) [list $addr $port] fconfigure $sock -buffering line fileevent $sock readable [list HandleSocketInput $sock] } proc HandleSocketInput {sock} { global NewDLSocket if {[eof $sock] || [catch {gets $sock line}]} { # end of file or abnormal connection drop close $sock puts "Closed socket $NewDLSocket(addr,$sock)" unset NewDLSocket(addr,$sock) } else { # Right now, we don't do anything with the information in $line # Whatever is sent, we use this as a ping to check for new download files to read LookForNewDownloads } } proc CloseNewDLSocket {} { global NewDLSocket if {[info exists NewDLSocket(main)]} { close $NewDLSocket(main) unset NewDLSocket(main) } } #------------------------------------------------------------------------------------------------------ # Timer misc # proc ScheduleTimer { {timems "Use Default"} } { global timerid timerset UpdatePeriod if {$timems eq "Use Default"} { set timems $UpdatePeriod } set timerid [after $timems HandleTimer] set timerset 1 } proc HandleTimer {} { global timerid timerset set timerset 0 LookForNewDownloads ScheduleTimer } proc CancelTimer {} { global timerid timerset if {$timerset} { after cancel $timerid } set timerset 0 } #------------------------------------------------------------------------------------------------------ # Enter/Exit Live Updates mode # proc EnterLiveUpdatesMode {} { global LiveUpdates if {$LiveUpdates} { CloseNewDLSocket } set LiveUpdates 1 OpenNewDownloadServerSocket ScheduleTimer } proc ExitLiveUpdatesMode {} { global LiveUpdates if {$LiveUpdates} { CloseNewDLSocket } CancelTimer set LiveUpdates 0 } #------------------------------------------------------------------------------------------------------ # Read Start/Finish/Control boxes # proc ReadAndProcessBoxData {} { global workingdir global db NumEntries global sb NumStartEntries global NameLookup # This routine is not directly analogous to ReadRawData above. # The above routine reads the data dump from a download box and stores that "file" in memory. # This routine reads data dumps from start/finish/control boxes and -processes- them. # For each file (start.csv, finish.csv, all existing nn.csv or ControlNN.csv): # Read file into an internal list (which will not last past this routine) # Process #puts "Read start.csv" set startfname [file join $workingdir "Start.csv"] if {[file exists $startfname]} { if [catch {open $startfname r} rawfilehandle] { puts stderr "File opening error: Start.csv." ErrorMsg "File opening error: Start.csv." } else { # First, clear in case we already read another box file set rawstartlist [list] foreach line [split [read -nonewline $rawfilehandle] \n] { # lappend rawstartlist $line # Build this in reverse order, i.e. lines will be reversed. set rawstartlist [linsert $rawstartlist 0 $line] } close $rawfilehandle } } #puts "Read finish.csv" set finishfname [file join $workingdir "Finish.csv"] if {[file exists $finishfname]} { if [catch {open $finishfname r} rawfilehandle] { puts stderr "File opening error: Finish.csv." ErrorMsg "File opening error: Finish.csv." } else { # First, clear in case we already read another box file set rawfinishlist [list] foreach line [split [read -nonewline $rawfilehandle] \n] { # lappend rawfinishlist $line # Reverse order set rawfinishlist [linsert $rawfinishlist 0 $line] } close $rawfilehandle } } # Now process #puts "Process starts" # First, clear array unset sb set NumStartEntries 0 set index -1 foreach line $rawstartlist { incr index if {[string match *No,SI_card,Wd,Punch* $line]} { # This is just a header line. Ignore it. } else { # Process the entry # Split into parts set splitlinelist [split $line ,] incr NumStartEntries set sb(Use,$index) 1 ;# Set to 0 to skip/delete this entry set sb(Dup,$index) 0 set sb(SICard,$index) [lindex $splitlinelist 1] #puts "SI: $sb(SICard,$index)" set sb(Name,$index) "" # Check if we have a number-to-name listing for this card number: if {[info exists NameLookup($sb(SICard,$index))]} { set sb(Name,$index) $NameLookup($sb(SICard,$index)) } #puts "($index) $sb(SICard,$index) $sb(Name,$index)" set sb(StartTime,$index) [lindex $splitlinelist 3] set sb(FinishTime,$index) "" set sb(TotalTime,$index) "" set sb(Finished,$index) 0 # Now, make the list of all punches we read off control boxes for this start entry set sb(RealPunches,$index) {} set sb(RealPunchTime,$index) {} # Have now gotten all information for this entry from the start box file. # # Want to check whether we already have a download for this start. If so, don't use this entry # (since the download would have the most information). # So, loop over all db entries, looking for one with our SICard and StartTime: # Problem: Some db(StartTime entries have been corrected for 12->24 hour, and will thus miss this check. TODO # Under some rare circumstances, others will slip through. Have not yet determined why. for {set i 1} {$i < $NumEntries} {incr i} { if {$db(Use,$i) == 1 && $db(SICard,$i) == $sb(SICard,$index) && $db(StartTime,$i) eq $sb(StartTime,$index)} { set sb(Use,$index) 0 break } # if {$db(SICard,$i) == $sb(SICard,$index)} { # puts "Card: $db(SICard,$i). db:$db(StartTime,$i) sb:$sb(StartTime,$index)" # } } } } ;# foreach line rawstartlist #puts "Process finishes" foreach line $rawfinishlist { # Remember: We are processing these in reverse order from what they are in the original finish box dump # We want to look through the starts (also processed in reverse order) and look for the first one we # find which has a start time before our own time (otherwise, that must be for a subsequent run that day). if {[string match *No,SI_card,Wd,Punch* $line]} { # Looks like a header line. Just skip it. continue } set splitlinelist [split $line ,] set ThisSICard [lindex $splitlinelist 1] set ThisTime [lindex $splitlinelist 3] # Now, loop through the starts for {set i 0} {$i < $NumStartEntries} {incr i} { if {$sb(SICard,$i) eq $ThisSICard && [TimeCompare $sb(StartTime,$i) $ThisTime] == -1} { # Note: We do not check above whether sb(Use,$i) == 1; this is because # we might not be using due to the existence of a usable download record, # but we still need to use this finish time. set sb(FinishTime,$i) $ThisTime set sb(TotalTime,$i) [TimeSubtract $sb(FinishTime,$i) $sb(StartTime,$i)] set sb(Finished,$i) 1 break } } } } #------------------------------------------------------------------------------------------------------ # Read Course Descriptions # # RNOWV proc ReadCourses { {fname "DefaultFileRequestor"} } { global workingdir coursefilename global NumCourses CourseName CourseNames CourseControls CourseLength global CourseAllowedSkips ControlSkippable ControlThrownOut global CourseType ControlValue CourseTimePenalty global HTMLTitle global AMeetMode AMeetEvent AMeetNumEvents global NameFieldLen NameFieldLenDefault global OutputColName OutputColumnName OutputColumnHeaders OutputColString NumOutputColumns UseOutputColumns OutputEvents OutColumnToSortBy global GTGCourse # If no arguments, give file requestor; allow file selection # else, pass through with file taken from argument if {$fname eq "DefaultFileRequestor"} { # If we get here, ReadCourses was either called with no arguments, # or with our strange default value. Throw up a file requestor for # the user to select the file from. set coursefilename [tk_getOpenFile] } else { # We were handed a filename. Do what we can with it. set coursefilename $fname } # Check whether file exists and looks valid # Read course description file if [catch {open $coursefilename r} coursefilehandle] { puts stderr "File opening error." ErrorMsg "File opening error." } else { # First, clear in case we already read another course file ## set NumCourses 0 ## set CourseName(-1) "Unknown" ## set CourseNames {} ClearCourse set AMeetEvent 0 ;# Use this to indicate it has not been set yet set CurrentEvent 0 ;# This is the event we are reading in courses for, until told otherwise by a @defevent command # CurrentEvent will be 0 only until a single course line is read in, at which point we will move it to 1. set OutputColString(1) 1 set OutputColName(1) "" set UseOutputColumns(1) 0 foreach line [split [read -nonewline $coursefilehandle] \n] { # NumCourses is an index for now (is off by one at this point as actual NumCourses) if {$line eq ""} { continue } if {[string first "#" $line] == 0} { # This line in the course file is a comment line. # Log the line as a message, and then ignore it. ErrorMsg $line } elseif {[string first "!" $line] == 0} { # Special line: Control to skip. set SpecialControl [string range $line 1 end] # puts "Special control: $SpecialControl" set ControlSkippable($SpecialControl) "yes" ErrorMsg "Control $SpecialControl is set to Skipable/Optional on all courses for all runners" # This control should now act as an optional control on all courses for all runners } elseif {[string first "-" $line] == 0} { # Special line: Control to throw out set worklinelist [split $line " "] if {[llength $worklinelist] == 1} { set ThrownControl [string range [lindex $worklinelist 0] 1 end] set ControlThrownOut($ThrownControl,All) "yes" ErrorMsg "Will throw out control $ThrownControl on all courses" } else { set ThrownControl [string range [lindex $worklinelist 0] 1 end] set ThrownOnCourse [string range $line [expr [string first " " $line] +1] end] set ControlThrownOut($ThrownControl,$ThrownOnCourse) "yes" ErrorMsg "Will throw out control $ThrownControl on course $ThrownOnCourse" } # This control should now be thrown out of any of the courses indicated } elseif {[string first "@" $line] == 0} { # Special line: General command line. # Possible commands to follow the @: # # skip # throwout # throwout # value # value ,,..., # timeshift TODO # htmltitle # ameet # eventnum <number: 1,2...> # numofevents <number: 1,2,3,...> # defevent <number: 1,2...> illdefined: <name of event> <columns of output> # defcolnames <number: 1,2...> name 1,name 2,name 3 # # Note: Use only a single space to separate items on the line. # No space between @ and command (e.g. @skip 35, not @ skip 35) # set worklinelist [split $line " "] # # SKIP if {[lindex $worklinelist 0] eq "@skip"} { if {[llength $worklinelist] == 2} { set SpecialControl [lindex $worklinelist 1] set ControlSkippable($SpecialControl) "yes" ErrorMsg "Control $SpecialControl is set to Skipable/Optional on all courses for all runners" # This control should now act as an optional control on all courses for all runners } else { ErrorMsg "Course file error. Problem with skip control, too many items on this line: $line" } # # THROWOUT } elseif {[lindex $worklinelist 0] eq "@throwout"} { if {[llength $worklinelist] == 2} { set ThrownControl [lindex $worklinelist 1] puts "Throw out: $ThrownControl" set ControlThrownOut($ThrownControl,All) "yes" } elseif {[llength $worklinelist] > 2} { set ThrownControl [lindex $worklinelist 1] set ThrownOnCourse [string range $line [expr [string first " " $line 10] +1] end] puts "Throw out: $ThrownControl on course $ThrownOnCourse" set ControlThrownOut($ThrownControl,$ThrownOnCourse) "yes" ErrorMsg "Will throw out control $ThrownControl on course $ThrownOnCourse" } else { ErrorMsg "Course file error. Problem with throwout control, not enough information on this line: $line" } # # VALUE } elseif {[lindex $worklinelist 0] eq "@value"} { if {[llength $worklinelist] == 3} { set ControlNumField [lindex $worklinelist 1] set Value [lindex $worklinelist 2] set ControlNums [split $ControlNumField ,] foreach ControlNum $ControlNums { set ControlValue($ControlNum) $Value } } else { ErrorMsg "ERROR: Course file error, problem with control value. Expect @value <cn> <value>. Problem line: $line" } # # TIMESHIFT } elseif {[lindex $worklinelist 0] eq "@timeshift"} { # # HTMLTITLE } elseif {[lindex $worklinelist 0] eq "@htmltitle"} { set HTMLTitle [string range $line 11 end] ErrorMsg "Entering A-Meet mode." # # AMEET } elseif {[lindex $worklinelist 0] eq "@ameet"} { set AMeetMode 1 ErrorMsg "Entering A-Meet mode." # # EVENTNUM } elseif {[lindex $worklinelist 0] eq "@eventnum" } { if {[llength $worklinelist] == 2} { set AMeetEvent [lindex $worklinelist 1] ErrorMsg "Setting event number to $AMeetEvent." if {$AMeetNumEvents < $AMeetEvent} { set AMeetNumEvents $AMeetEvent } } # NUMOFEVENTS # } elseif {[lindex $worklinelist 0] eq "@numofevents" } { if {[llength $worklinelist] == 2} { set num [lindex $worklinelist 1] if {$num >= $AMeetNumEvents} { # We will not set this value lower, as it may already have been forced a default value somewhere set AMeetNumEvents $num ErrorMsg "Setting number of events at this A-Meet to $AMeetNumEvents" } } # DEFEVENT # } elseif {[lindex $worklinelist 0] eq "@defevent" } { # set worklinelist [SplitOnSpace $line] ;# Use the quotable split if {[llength $worklinelist] < 2} { ErrorMsg "ERROR: Must at least define an event number: $line" } else { set num [lindex $worklinelist 1] ErrorMsg "Reading courses for event number $num" if {$CurrentEvent != 0} { SetEvNCourseFromCourse $CurrentEvent } set CurrentEvent $num ClearCourse if {[llength $worklinelist] == 2} { set OutputColName($num) "Event $num" ;# Name defaults to Event N } else { set OutputColName($num) [lindex $worklinelist 2] if {[llength $worklinelist] == 3} { set OutputColString($num) $num ;# Default to just output the current event set UseOutputColumns($num) 0 } else { set OutputColString($num) [lindex $worklinelist 3] set UseOutputColumns($num) 1 } } # Note that we only place the column definitions into the variable OutputColString($event). This will get parsed later, once # we know what the current event is. # puts "DEFEVENT. Event: $CurrentEvent. Name: $OutputColName($num). OutputString: $OutputColString($num)." } # DEFCOLNAMES # } elseif {[lindex $worklinelist 0] eq "@defcolnames" } { if {[llength $worklinelist] < 2} { ErrorMsg "ERROR: Must at least define an event number: $line" } else { set num [lindex $worklinelist 1] ErrorMsg "Reading column headers for event number $num" set ColNamesList [split [string range $line [expr {14 + [string length $num]}] end] ","] set col 0 foreach name $ColNamesList { set OutputColumnHeaders 1 ;# There is at least one column header, so set to 1. We place this here to handle the case of a null list. set OutputColumnName($num,$col) $name incr col } } # # (DEFAULT) } else { # This is not a recognised command ErrorMsg "Course file error, command not recognised: $line" } } else { # Hopefuly this is a normal course line. (If not, we will have an error.) set worklinelist [split $line =] if {[llength $worklinelist] == 3} { if {$CurrentEvent == 0} { set CurrentEvent 1 } set CourseName($NumCourses) [lindex $worklinelist 0] lappend CourseNames $CourseName($NumCourses) set NameFieldLen($NumCourses) $NameFieldLenDefault set CourseAllowedSkips($NumCourses) 0 ;# Start out assuming no skipping of controls set CourseType($NumCourses) 0 ;# Start out assuming a Normal course set CourseControls($NumCourses) [split [lindex $worklinelist 1] ,] if {[set pos [lsearch $CourseControls($NumCourses) "score"]] != -1} { set CourseControls($NumCourses) [lreplace $CourseControls($NumCourses) $pos $pos] ;# Remove "score" from the controls list set CourseType($NumCourses) 1 ;# Score-O RNOWS # Now, do an early check on the validity of the Time Penalty string. Expect an odd number of comma separated fields in that string. if { [expr {[llength [split [lindex $worklinelist 2] ,]] % 2}] != 1} { ErrorMsg "ERROR: Expect an odd number of comma separated elements in Time Penalty string. $CourseName($NumCourses): [lindex $worklinelist 2]" } } if {[string first "skip" [lindex $CourseControls($NumCourses) end]] != -1} { set CourseAllowedSkips($NumCourses) [string replace [lindex $CourseControls($NumCourses) end] 0 3] set CourseControls($NumCourses) [lrange $CourseControls($NumCourses) 0 end-1] # puts $CourseControls($NumCourses) # puts "Skip $CourseAllowedSkips($NumCourses)" } switch $CourseType($NumCourses) { 0 { set CourseLength($NumCourses) [lindex $worklinelist 2] ; set CourseTimePenalty($NumCourses) "" } 1 { set CourseTimePenalty($NumCourses) [lindex $worklinelist 2] ; set CourseLength($NumCourses) "" } default { ErrorMsg "Unrecognised course type: $CourseType($NumCourses)" } } incr NumCourses } else { ErrorMsg "Problem in course file: $line" } } ;# else. Normal course line } ;# foreach line close $coursefilehandle if {$CurrentEvent == 0} { ErrorMsg "WARNING: No courses defined." } else { SetEvNCourseFromCourse $CurrentEvent if {$AMeetEvent == 0} { set AMeetEvent $CurrentEvent } ;# Use the last read course (or the only read course) as the default. SetCourseFromEvNCourse $AMeetEvent SetupOutputCols $AMeetEvent } set GTGCourse 1 BuildCourseEditMenu $CourseNames } ;# (opened file) # Try to use this file's dir as a working dir if we don't already have one if {$workingdir eq ""} { SetWorkingDirectory [file dirname $coursefilename] } # Try to process if {$fname eq "DefaultFileRequestor"} { # Only try to process in this case; otherwise, this proc was called from somewhere # which will call the processing itself. TryToProcess } } #------------------------------------------------------------------------------------------------------ # Try to process # proc TryToProcess { {Startfrom 0} } { global GTGRaw GTGCourse # Check whether we have a raw datafile in memory # Check whether we have a course description in memory # (Don't worry about having a working directory; this is problem for output routine.) # If pass all checks, process entire raw file # # The one optional (defaults to 0) argument argument to this routine is the Startfrom, # which is passed to ProcessRaw directly. if {$GTGRaw && $GTGCourse} { ProcessRaw $Startfrom } } #------------------------------------------------------------------------------------------------------ # Process Raw # proc ProcessRaw { {Startfrom 0} } { global rawlist NumRawLinesProcessed global db NumEntries CourseName NameLookup global GTGResults global NameFieldLen NameFieldLenMax global AMeetMode AMeetEvent Comp global debug # global dbSICard dbName dbNumPunches dbRealPunches dbRealPunchTime dbUse # This routine processes the entire raw file. # The file is already read into memory, and sits in rawlist. # The raw data will be processed here into db() # # We treat each line of the raw data file as a separate entry (each line in the raw data # file corresponds to a different download at the download box). There is no assuption that # a given name or SICardNumber will be unique (the same stick could be rented out multiple # times at an event to different people, or the same person could run more than one course # in an event; each is a separate entry here). # In those cases in which someone accidentally downloaded more than once (and this happens frequently, # sometimes with multiple full downloads, sometimes with several partial downloads finished off with # one good one), we mark the superfluous downloads as entries to not be used. The assumption is made # that if there are multiple download entries share the same clear time and clear box number, then # they are duplicate downloads, and an effort is made to only keep the "best" of the duplicates. # # We can either call this routine with 0 arguments, in which case Startfrom defaults to 0, or # one argument: Startfrom, which is the line in rawlist at which processing should begin (the assumption # being that lines before that point have already been processed). if {$debug >= 2} {puts "In ProcessRaw"} # Start with clearing results (in case was processed before) if {$Startfrom == 0} { if {$debug >= 3} {puts " PR: A"} # array unset db # We can't clear the db array anymore, since we are using the negative indices for registered competitors ClearResultsAndRaw if {$debug >= 3} {puts " PR: B"} set NumEntries 0 set index 0 ;# We will skip index 0 (legacy code issues). First item will be at index 1 } else { set index $NumEntries } set RawLine 0 if {$debug >= 3} {puts " PR: C"} # Parse each item in internal raw file # Attempt to apply previous edits to entry TODO # Generate internal entry for item not skipped (where skipped = comments, blank lines, etc) foreach line $rawlist { if {$debug >= 4} {puts "Processing line: $line"} incr RawLine if {$RawLine <= $Startfrom || [LineToSkip $line]} { # If we get here, this was either a header, comment, or blank line # or alternately, it is a line which was previously processed and which we are # skipping now on a subsequent pass through rawlist. # Do nothing. } else { if {$RawLine > $NumRawLinesProcessed} { set NumRawLinesProcessed $RawLine } incr index # Process the entry # Check whether this line looks like a partial read # (i.e. matches the first part of another line) # Match everything up until ",,,,,,,,<end>" # # The following works, but may not be the best approach. # regexp {^(.*?)[,]*$} $line match sub1 #ErrorMsg "Match: $match" #ErrorMsg "Sub1: $sub1" # Instead, continue with the read. # See if that matches the first <length> of any line from this point on (or in entire file?) # If the length of the other is more than the full line length of this one, then set Use to 0 # # Sanitize the line # Check for even number of " and matching {}, or just strip all three characters TODO # Check for appropriate number of , (use count from header) TODO # Split into parts set splitlinelist [split $line ,] incr NumEntries set db(Use,$index) 1 ;# Set to 0 to skip/delete this entry set db(Dup,$index) 0 set db(DupSIChecked,$index) 0 ;# We will perform the check later set db(Registered,$index) 0 ;# Assume not, for now set db(SICard,$index) [lindex $splitlinelist 2] if {$debug >= 4} {puts "SI: $db(SICard,$index)"} set db(Name,$index) "[lindex $splitlinelist 5] [lindex $splitlinelist 6]" # Check if we have a number-to-name listing for this card number: if {[info exists NameLookup($db(SICard,$index))]} { # As this is written, we do a replacement of the name if we had this card number # in any num to name database we read in, even if the name stored on the stick was # a good one. Might want to change this at some time. # pseudocode: if db(Name,$index) != "" && !contains "RENTAL", then warning: changing name from on stick: db() -> NameLookup() set db(Name,$index) $NameLookup($db(SICard,$index)) } if {$debug >= 4} {puts "($index) $db(SICard,$index) $db(Name,$index)"} # If this is an A-meet, check the Competitors database for a number-to-name listing, and use that instead if available if {$AMeetMode && [info exists Comp(Name,$AMeetEvent,$db(SICard,$index))]} { set db(Name,$index) $Comp(Name,$AMeetEvent,$db(SICard,$index)) set db(Registered,$index) 1 if {$Comp(DBIdx,$db(Name,$index)) < 0} { set db(Use,$Comp(DBIdx,$db(Name,$index))) 0 ;# No longer use the fake, negative index into db } elseif {($Comp(DBIdx,$db(Name,$index)) > 0) && ($db(StartTime,$Comp(DBIdx,$db(Name,$index))) ne [AdjTime Start [lindex $splitlinelist 24]])} { ErrorMsg "WARNING: SICard #$db(SICard,$index) ($db(Name,$index)) has multiple distinct downloads." } set Comp(DBIdx,$db(Name,$index)) $index ;# Note that this could be wrong if we have duplicates; will fix in CheckAndClearMultipleDownloads } # Here are the fields from the original raw data file. # (Start numbering at 0) # 2:SICard Number 5:First name 6:Last name # 16:CLR_CN,day,time 19:CHKnum,day,time 22:STnum,day,time 25:FInum,day,time # 28:numpunches # 29:1,, 32:2,, ... will continue to the max punches in this download set set db(ClearCN,$index) [lindex $splitlinelist 16] set db(ClearTime,$index) [lindex $splitlinelist 18] set db(StartTime,$index) [AdjTime Start [lindex $splitlinelist 24]] set db(FinishTime,$index) [AdjTime Finish [lindex $splitlinelist 27]] set db(NumPunches,$index) [lindex $splitlinelist 28] set punchlist "" # Now, make the list of all punches recorded on the SI Card for this download set db(RealPunches,$index) {} set db(RealPunchTime,$index) {} for {set i 0} {$i < $db(NumPunches,$index)} {incr i} { set controlnum [lindex $splitlinelist [expr {29 + 3*$i}]] set punchlist [format "%s %s" $punchlist $controlnum] lappend db(RealPunches,$index) $controlnum # The day would be ...30 + ... May want to check whether any days seem different. TODO lappend db(RealPunchTime,$index) [AdjTime $controlnum [lindex $splitlinelist [expr {31 + 3*$i}]]] } # Set a couple of defaults set db(TotalTime,$index) "" set db(EditResult,$index) "" ;# Note: A null value here, "", indicates that no edit has been made. set db(FinalResult,$index) "NOI" ;# No Information set db(Course,$index) -1 # Do sanity checking on time values. Correct what is possible (12->24hr, etc). if {$debug >= 4} {puts "Calling DoSanityCheck"} DoTimeSanityCheck $index if {$debug >= 4} {puts "Post DoSanityCheck"} if {$db(Use,$index)} { # Now it should be safer to do time calculation if {$db(FinishTime,$index) != ""} { set db(TotalTime,$index) [TimeSubtract $db(FinishTime,$index) $db(StartTime,$index)] } else { set db(TotalTime,$index) "NoFinish" } # Make the best guess as to the course this entry was running. if {$debug >= 4} {puts "Calling GuessCourse"} GuessCourse $index # GuessCourse sets db(,$index) for Course, Finished, NumCPunches, CPunches and CPunchTime # Now, set a few strings for output to the raw results list. if { $db(Course,$index) == -1} { set Course "Unknown" } else { set Course $CourseName($db(Course,$index)) } if { $db(Finished,$index) } { set FinishedString "+" } else { set FinishedString "-" } if {$debug >= 4} {puts "Calling AdjustNameFieldLen"} AdjustNameFieldLen $index set RawOutLine [format "%5s %-9s%-*s%-11s%s%s %s" \ [format "(%d)" $index] $db(SICard,$index) $NameFieldLenMax $db(Name,$index) $Course $FinishedString $db(TotalTime,$index) $punchlist] LogRawResult $RawOutLine $index } else { # We appear to have had some problem with times which was unresolvable. Give a minimal raw output. set db(Course,$index) -1 set db(Finished,$index) 0 set RawOutLine [format "%5s %-9s%-*s %s" \ [format "(%d)" $index] $db(SICard,$index) $NameFieldLenMax $db(Name,$index) $punchlist] LogRawResult $RawOutLine $index } # Now that this entry is in the raw output, do the check for multiple downloads if {$debug >= 4} {puts "Calling CheckAndClear..."} CheckAndClearMultipleDownloads $index if {$debug >= 4} {puts "Post CheckAndClear..."} } if {$debug >= 4} {puts " PR: D"} } ;# foreach line if {$debug >= 4} {puts " PR: E"} # db(Use,$i) Boolean. 0: Skip/delete this entry. 1: Normal, this is an active entry # db(Dup,$i) Boolean. 0: Normal entry. 1: This was set to not use because it is a duplicate # db(DupSIChecked,$i) Boolean. # db(SICard,$i) SI Card number # db(Name,$i) Runner's name # db(NumPunches,$i) Number of real punches registered for this downloaded run # db(RealPunches,$i) List, all control code numbers, in order punched, regardless of course relevance # db(RealPunchTime,$i) List, time of each punch in RealPunches list # db(ClearTime,$i) Time the card was cleared. Used for cleansing duplicate downloads from results. # db(ClearCN,$i) Control number of box used to clear. Used to rule out simul clears from diff boxes. # db(StartTime,$i) Start time, hh:mm:ss form # db(FinishTime,$i) Finish time, hh:mm:ss form # db(TotalTime,$i) FinishTime - StartTime, in hh:mm:ss format, regardless of course finish, etc # db(Course,$i) Index of course assigned to this entry. May be a guess or imposed by user input # db(Finished,$i) Boolean. Did this entry finish the course as set in db(Course,$i) # db(NumCPunches,$i) Number of valid controls punched on the course assigned this entry # db(CPunches,$i) List, control code numbers of punched controls on the course assigned this entry # db(CPunchTime,$i) List, time of each punch in CPunches list # The CPunches list will be basically a cleaned up version of the RealPunches list. # i.e. CPunches will not contain punches not on the course, or punches after # any skipped control. # db(ElapsedTime,$i) List, elapsed time to each punch in CPunches list, plus finish # db(SplitTime,$i) List, split times for each punch in CPunches list, plus finish # db(DelayedWarnings,) List, any warnings to go to the error log only after duplicates have been cleared. OutputDelayedWarnings # Now, try to read individual start/finish/control boxes. Process these if any exist. #puts "Call ReadAndProcessBoxData" #ReadAndProcessBoxData #puts "Returned from ReadAndProcessBoxData" # The input file has been read. Now calculate results for the first time to give the # user the first approximation of the results (will later calculate results again after every edit). set GTGResults 1 if {$debug >= 3} {puts "Calling CalcResults"} CalcResults } #------------------------------------------------------------------------------------------------------ # Output Raw Results # proc OutputRawResults {} { global rawlist # Simplistic proc: Just turn raw data into output data # First, clear the old ClearResultsAndRaw # Now, just move the raw data over foreach line $rawlist { LogResult $line } } #------------------------------------------------------------------------------------------------------ # Variable changes # # Some variables, when changed, require a number of other checks, initializations, and changes to sets of other variables. # The routines collected here tend to manage these alterations. proc AdjustNameFieldLen {index} { global db NameFieldLen NameFieldLenMax if {[info exists NameFieldLen($db(Course,$index))]} { if {[string length $db(Name,$index)] > $NameFieldLen($db(Course,$index))} { if {[string length $db(Name,$index)] <= $NameFieldLenMax} { set NameFieldLen($db(Course,$index)) [string length $db(Name,$index)] } else { set NameFieldLen($db(Course,$index)) $NameFieldLenMax } } } else { set NameFieldLen($db(Course,$index)) [string length $db(Name,$index)] } } proc ClearCourse {} { global NumCourses CourseName CourseNames global CourseControls CourseLength CourseType CourseTimePenalty global CourseAllowedSkips ControlSkippable ControlThrownOut # Clear the current, working course (presumably in preparation of reading in again). set NumCourses 0 set CourseName(-1) "Unknown" set CourseNames {} if [info exists CourseControls] { array unset CourseControls } if [info exists CourseLength] { array unset CourseLength } if [info exists CourseType] { array unset CourseType } if [info exists CourseTimePenalty] { array unset CourseTimePenalty } if [info exists CourseAllowedSkips] { array unset CourseAllowedSkips } if [info exists ControlSkippable] { array unset ControlSkippable } if [info exists ControlThrownOut] { array unset ControlThrownOut } } proc ClearEvNCourse { event } { global EvNNumCourses EvNCourseName EvNCourseNames global EvNCourseControls EvNCourseLength EvNCourseType EvNCourseTimePenalty global EvNCourseAllowedSkips EvNControlSkippable EvNControlThrownOut set EvNNumCourses($event) 0 set EvNCourseName($event,-1) "Unknown" set EvNCourseNames($event) {} foreach index [array names EvNCourseControls] { regexp {(.+),(.+)} $index match indexevent indexremainder if {$indexevent == $event} { array unset EvNCourseControls($index) } } foreach index [array names EvNCourseLength] { regexp {(.+),(.+)} $index match indexevent indexremainder if {$indexevent == $event} { array unset EvNCourseLength($index) } } foreach index [array names EvNCourseType] { regexp {(.+),(.+)} $index match indexevent indexremainder if {$indexevent == $event} { array unset EvNCourseType($index) } } foreach index [array names EvNCourseTimePenalty] { regexp {(.+),(.+)} $index match indexevent indexremainder if {$indexevent == $event} { array unset EvNCourseTimePenalty($index) } } foreach index [array names CourseAllowedSkips] { regexp {(.+),(.+)} $index match indexevent indexremainder if {$indexevent == $event} { array unset CourseAllowedSkips($index) } } foreach index [array names ControlSkippable] { regexp {(.+),(.+)} $index match indexevent indexremainder if {$indexevent == $event} { array unset ControlSkippable($index) } } foreach index [array names ControlThrownOut] { regexp {(.+),(.+),(.+)} $index match indexevent indexcontrol indexcourse if {$indexevent == $event} { array unset ControlThrownOut($index) } } } proc SetEvNCourseFromCourse { event } { global NumCourses CourseName CourseNames global CourseControls CourseLength CourseType CourseTimePenalty global CourseAllowedSkips ControlSkippable ControlThrownOut global EvNNumCourses EvNCourseName EvNCourseNames global EvNCourseControls EvNCourseLength EvNCourseType EvNCourseTimePenalty global EvNCourseAllowedSkips EvNControlSkippable EvNControlThrownOut set EvNNumCourses($event) $NumCourses set EvNCourseName($event,-1) $CourseName(-1) set EvNCourseNames($event) $CourseNames for {set c 0} {$c < $NumCourses} {incr c} { set EvNCourseName($event,$c) $CourseName($c) set EvNCourseControls($event,$c) $CourseControls($c) set EvNCourseLength($event,$c) $CourseLength($c) set EvNCourseType($event,$c) $CourseType($c) set EvNCourseTimePenalty($event,$c) $CourseTimePenalty($c) set EvNCourseAllowedSkips($event,$c) $CourseAllowedSkips($c) } foreach index [array names ControlSkippable] { set EvNControlSkippable($event,$index) $ControlSkippable($index) ;# index here is a simple $n } foreach index [array names ControlThrownOut] { set EvNControlThrownOut($event,$index) $ControlThrownOut($index) ;# Note that index here will be a $n,$c like variable } } proc SetCourseFromEvNCourse { event } { global NumCourses CourseName CourseNames global CourseControls CourseLength CourseType CourseTimePenalty global CourseAllowedSkips ControlSkippable ControlThrownOut global EvNNumCourses EvNCourseName EvNCourseNames global EvNCourseControls EvNCourseLength EvNCourseType EvNCourseTimePenalty global EvNCourseAllowedSkips EvNControlSkippable EvNControlThrownOut # ClearCourse set NumCourses $EvNNumCourses($event) set CourseName(-1) $EvNCourseName($event,-1) set CourseNames $EvNCourseNames($event) for {set c 0} {$c < $EvNNumCourses($event)} {incr c} { set CourseName($c) $EvNCourseName($event,$c) set CourseControls($c) $EvNCourseControls($event,$c) set CourseLength($c) $EvNCourseLength($event,$c) set CourseType($c) $EvNCourseType($event,$c) set CourseTimePenalty($c) $EvNCourseTimePenalty($event,$c) set CourseAllowedSkips($c) $EvNCourseAllowedSkips($event,$c) } foreach index [array names EvNControlSkippable] { regexp {(.+),(.+)} $index match indexevent indexcontrol if {$indexevent == $event} { set ControlSkippable($indexcontrol) $EvNControlSkippable($indexevent,$indexcontrol) } } foreach index [array names EvNControlThrownOut] { regexp {(.+),(.+),(.+)} $index match indexevent indexcontrol indexcourse if {$indexevent == $event} { set ControlThrownOut($indexcontrol,$indexcourse) $EvNControlThrownOut($indexevent,$indexcontrol,$indexcourse) } } } proc DisconnectCompFromDB {name index} { global db Comp global NumEntries MaxCompIdx # Disconnect the Comp(name) entry from the db(index) entry. # Also, guess a new course for db(index) since this is now treated as a nonregistered competitor (and thus the course default will be different) set HaveRepointed 0 # First, look for another db entry with the oldname, and try pointing to that for {set i 1} {$i < $NumEntries} {incr i} { if {$i != $index && $db(Name,$i) eq $name} { set Comp(DBIdx,$name) $i set HaveRepointed 1 } } if {!$HaveRepointed} { # Didn't have a DL with oldname; look for the old negative index into db for Comp to point to for {set i -2} {$i >= $MaxCompIdx} {incr i -1} { if {$db(Name,$i) eq $name} { set Comp(DBIdx,$name) $i set HaveRepointed 1 } } } if {!$HaveRepointed} { ErrorMsg "WARNING: Unable to locate index for Comp entry ($name) to repoint to." } else { GuessCourse $index } } proc SetupOutputCols {event} { global OutputColName OutputColumnName OutputColString NumOutputColumns UseOutputColumns OutputEvents OutColumnToSortBy OutColForNameType OutColForName global debug # Note: Column definitions vary by context. When defined by the user in defevent, cols are numbered starting with 1. # When referenced in arrays within the code, cols are numbered starting with 0. # The definitions in OutColForName refer to the columns as seen by the user, even though the user will never see this number. # set ColDefList [split $OutputColString($event) ","] # ColDefList should contain one element for each column (plus a possible pseudo-column if name placement will be between columns) # Each of those elements should be either a single event number, of a summation of events e.g. 2+3 set NumOutputColumns [llength $ColDefList] set OutColumnToSortBy [expr $NumOutputColumns - 1] ;# Default to sorting by last column. Count from 0. set OutColForNameType "After" set OutColForName 0 ;# Default to After 0, i.e. placing the name before any place(place)time columns. set Column 0 foreach columndef $ColDefList { # First, check for a name definition. This could result in columndef ending up "" after removing the name (which would make this is a pseudo-column). if {[set firstidx [string first "name" $columndef]] != -1} { set OutColForName [expr $Column + 1] set OutColForNameType "In" ;# This might change depending on whether this columndef is otherwise empty # Remove the "name" keyword. set columndef [string replace $columndef $firstidx [expr {$firstidx+3}]] } if {$columndef ne ""} { # This is a real column (i.e. there was something more than "name" in this columndef) # columndef is the single event number or summation of event numbers for $Column of output if {[set firstidx [string first "sort" $columndef]] != -1} { set OutColumnToSortBy $Column set columndef [string replace $columndef $firstidx [expr {$firstidx+3}]] } set OutputEvents($Column) {} foreach event [split $columndef "+"] { lappend OutputEvents($Column) $event } if {![info exists OutputColumnName($event,$Column)]} { # Set a default column name, if nothing exists here. # Note: We will only get defaults for the current event, but we don't expect to use a column name for other events. set OutputColumnName($event,$Column) "" } incr Column } else { # The only way to get a "" columndef here is if "name" were the only original content. We set to "After", and do not incr Column set OutColForNameType "After" set OutColForName [expr $OutColForName - 1] } ;# if $columndef ne "" } ;# foreach columndef if {$debug >= 2} {puts "OutColForName: $OutColForNameType $OutColForName"} } proc SetupOutputColResults {index} { global db Comp CourseName global OutputEvents NumOutputColumns UseOutputColumns global AMeetEvent global TimeNow Starttime OutputTimeSinceStart global OvertimeLimit global debug # This routine will, for the given index (may be positive or negative, i.e. if negative, this is # someone who has not downloaded yet), determine the result (time or some variety of DNF) for each # output column. It will add results if relevant, or determine that it cannot add. if {$debug >= 3} {puts "In SetupOutputColResults, index $index"} foreach course $db(CourseResults,$index) { # Each $course here is a course which was run by this index on at least one event for which we are generating output. # We will generate a set of column data for each such course. for {set col 0} {$col < $NumOutputColumns} {incr col} { set db(ColResult,$course,$col,$index) "init" foreach event $OutputEvents($col) { if {$debug >= 3} {puts "course: $course, col: $col"} if { (($event == $AMeetEvent) || ($UseOutputColumns($AMeetEvent) == 0)) && \ ( $CourseName($db(Course,$index)) eq $course) } { if {$debug >= 3} {puts "x1"} # Just the result of the current download. Might be wrong, for several possible DNF types. # We used to generate a psuedotime here; now that is done elsewhere set eventtime $db(FinalResult,$index) if {$debug >= 3} {puts "x2"} } else { if {$debug >= 3} {puts "y1"} # Try to look it up from a previous event. This will only work for entries in Comp if {[info exists Comp(ResultTime,$event,$db(Name,$index))] && \ ($Comp(ResultClass,$event,$db(Name,$index)) eq $course) } { set eventtime $Comp(ResultTime,$event,$db(Name,$index)) } else { # We don't have an entry in Comp (we would at least have a default value in there), so this is likely a non-registered download set eventtime "----" } if {$debug >= 3} {puts "y2"} } if {$debug >= 3} {puts "eventtime: $eventtime"} if {$db(ColResult,$course,$col,$index) eq "init"} { set db(ColResult,$course,$col,$index) $eventtime } else { set db(ColResult,$course,$col,$index) [TimeAdd $db(ColResult,$course,$col,$index) $eventtime] } } if {$debug >= 3} {puts "out."} if {[llength $OutputEvents($col)] == 1} { if {[lindex $OutputEvents($col) 0] == $AMeetEvent} { # Only one event for this column, and it is the current event. set db(ColPlace,$course,$col,$index) "C" if {[info exists Comp(Elig,$db(Name,$index))] && $Comp(Elig,$db(Name,$index))} { set db(ColPlaceElig,$course,$col,$index) "C" } else { set db(ColPlaceElig,$course,$col,$index) "" } } else { # Only one event for this column, and it was either previously read or hasn't been run yet. if {[info exists Comp(ResultPlace,[lindex $OutputEvents($col) 0],$db(Name,$index))]} { set db(ColPlace,$course,$col,$index) $Comp(ResultPlace,[lindex $OutputEvents($col) 0],$db(Name,$index)) set db(ColPlaceElig,$course,$col,$index) $Comp(ResultEPlace,[lindex $OutputEvents($col) 0],$db(Name,$index)) } else { set db(ColPlace,$course,$col,$index) "" set db(ColPlaceElig,$course,$col,$index) "" } } } elseif {[llength $OutputEvents($col)] == 0} { # 0 events for this column. set db(ColPlace,$course,$col,$index) "" set db(ColPlaceElig,$course,$col,$index) "" } else { # Multiple events for this column. set db(ColPlace,$course,$col,$index) "C" set db(ColPlaceElig,$course,$col,$index) "C" } } ;# for col 0 to <NumOutputColumns } } proc SortOutputColLists {} { global db global NumOutputColumns UseOutputColumns OutColumnToSortBy global OutColPlace OutColTime OutColPlaceElig OutColTimeElig global FullCourseNamesList global OCCoursename OCCol ;# These two OC variables will be used in the CompareColResults function to determine which result to compare for the given indices ;# (They should not be modified elsewhere, but they need to be available for inspection.) global debug # if {$debug >= 3} {puts "In SortOutputColLists"} foreach OCCoursename $FullCourseNamesList { for {set OCCol 0} {$OCCol < $NumOutputColumns} {incr OCCol} { if {$debug >= 3} {puts "Course: $OCCoursename, Col: $OCCol"} set OutColPlace($OCCoursename,$OCCol) [lsort -command CompareColResults $OutColPlace($OCCoursename,$OCCol)] set OutColTime($OCCoursename,$OCCol) [lsort -command TimeCompare $OutColTime($OCCoursename,$OCCol)] set OutColPlaceElig($OCCoursename,$OCCol) [lsort -command CompareColResults $OutColPlaceElig($OCCoursename,$OCCol)] set OutColTimeElig($OCCoursename,$OCCol) [lsort -command TimeCompare $OutColTimeElig($OCCoursename,$OCCol)] } } if {$debug >= 3} {puts "Leaving SortOutputColLists"} } proc OutputResultsForCourse {coursename} { global db Comp global CourseNames CourseName CourseControls CourseLength CourseTimePenalty CourseType global NumOutputColumns UseOutputColumns OutputColName OutputColumnName OutputColumnHeaders OutputEvents OutColumnToSortBy OutColForNameType OutColForName global OutColPlace OutColTime OutColPlaceElig OutColTimeElig global FinishOrder FinishOrderElig ElapsedTimes ElapsedTimesElig global CompWithNoDL EligCompWithNoDL global NameFieldLen NameFieldLenCN global ResultCSVOutput ResultECSVOutput ResultOUSAOutput global OutputTimeSinceStart Starttime TimeNow global OutputHTML AMeetMode AMeetEvent global HTMLType PreHTMLHeader PostHTMLHeader PreHTMLResult PostHTMLResult global OvertimeLimit global debug if {$debug >= 3} {puts "Generate results for course $coursename"} # Just return if no entries under this course if {$FinishOrder($coursename) == {}} { if {$debug >=3} {puts "no entries"} return } if {$debug >= 3} {puts "O.A"} set CourseIndex [lsearch $CourseNames $coursename] if {$debug >= 3} {puts "O.B"} if {$coursename ne "Unknown" && $CourseIndex == -1} { ErrorMsg "WARNING: Unusual Course case; outputting course not in current event. " } if {$debug >= 3} {puts "O.C"} # Output header for the course if {$coursename eq "Unknown"} { LogResult "" LogResult "Unknown Course. Cannot guess course for the following runners:" } else { if {$debug >= 3} {puts "O.C i.0"} if {$debug >= 3} {puts " Course: $coursename $CourseIndex"} if {$debug >= 3} {puts " Type: $CourseType($CourseIndex)"} if {$debug >= 3} {puts " Controls: $CourseControls($CourseIndex)"} if {$debug >= 3} {puts " Length: $CourseLength($CourseIndex)"} if {$debug >= 3} {puts " Name: $CourseName($CourseIndex)"} if {$OutputHTML} { LogResult "" if {$AMeetMode} { # We are mixing classes and courses here, so the word "Course:" looks strange. It looke better to just leave it out in this case. set WordCourse "" } else { set WordCourse "Course" } switch $CourseType($CourseIndex) { 0 { LogResult [format "%s<strong>%s%s: %d KP %s km</strong>%s" $PreHTMLHeader \ $CourseName($CourseIndex) $WordCourse [llength $CourseControls($CourseIndex)] $CourseLength($CourseIndex) $PostHTMLHeader] } 1 { LogResult [format "%s<strong>%s%s: %d KP. Time Penalty: %s</strong>%s" $PreHTMLHeader \ $CourseName($CourseIndex) $WordCourse [llength $CourseControls($CourseIndex)] [PenaltyToText $CourseTimePenalty($CourseIndex)] $PostHTMLHeader ] LogResult "" } } ;# switch if {$HTMLType == 0} { LogResult "<pre>" } if {$CourseType($CourseIndex) == 1} { LogResult [format "%s%s%s" $PreHTMLResult " Pnts-Pnlt=Total Time" $PostHTMLResult] } } else { if {$debug >= 3} {puts "O.C i.1"} LogResult "" switch $CourseType($CourseIndex) { 0 { LogResult [format "%s Course: %d KP %s km " \ $CourseName($CourseIndex) [llength $CourseControls($CourseIndex)] $CourseLength($CourseIndex)] } 1 { LogResult [format "%s Course: %d KP. Time Penalty: %s" \ $CourseName($CourseIndex) [llength $CourseControls($CourseIndex)] [PenaltyToText $CourseTimePenalty($CourseIndex)]] LogResult "" LogResult " Pnts-Pnlt=Total Time" } } ;# switch } if {$debug >= 3} {puts "O.C i.2"} LogResult "" if {$AMeetMode} { if {$debug >= 3} {puts "O.C i.3"} # Also create course(class) header output for EventResultsAN.csv file lappend ResultCSVOutput [format ""] lappend ResultCSVOutput [format "%s" $CourseName($CourseIndex)] if {$FinishOrderElig($coursename) != {} || $EligCompWithNoDL($coursename) != {}} { # Also create one for the Elig file lappend ResultECSVOutput [format ""] lappend ResultECSVOutput [format "%s" $CourseName($CourseIndex)] } } } if {$debug >= 3} {puts "Outputting column header names"} # Output column header names, if any exist. if {$OutputColumnHeaders && $coursename ne "Unknown"} { set ColHeader "" for {set col 0} {$col < $NumOutputColumns} {incr col} { if {($OutColForNameType eq "After") && ($OutColForName == $col)} { set ColHeader [format "%s %*s" $ColHeader [expr {$NameFieldLenCN($coursename) + 3}] " "] } # The length of any given column is: 18 + (NameFieldLenCN($coursename) + 1), if the name is in that column set ExtraForName 0 if {($OutColForNameType eq "In") && ([expr $OutColForName-1] == $col)} { set ExtraForName [expr {$NameFieldLenCN($coursename) + 5}] } set ColLength [expr {18 + $ExtraForName}] set ColHeader [format "%s%-*s" $ColHeader $ColLength $OutputColumnName($AMeetEvent,$col)] } LogResult [format "%s%s%s" $PreHTMLResult $ColHeader $PostHTMLResult] } if {$debug >= 3} {puts "O.D"} # Now, output all entries under this course if {$coursename ne "Unknown"} { if {$debug >= 3} {puts " O.D i.0"} if {$debug >= 3} {puts " Sort: $OutColumnToSortBy"} if {$debug >= 3} {puts " Coursename: $coursename"} if {$debug >= 3} {puts "OutColPlace: $OutColPlace($coursename,$OutColumnToSortBy)"} foreach index $OutColPlace($coursename,$OutColumnToSortBy) { if {$debug >= 3} {puts "index $index"} set Outstr "" # We need to be careful here. OutColForName(Type) is misleading; the column referenced there is the one seen by the user, i.e. counting from 1. # Because our column indices count from 0, "After 0" really looks like "Before 0" when thinking about the indices, and "In N" looks like "In N-1". if {$debug >= 3} {puts " NameFieldLenCN: $NameFieldLenCN($coursename)"} set Namestr [format "%-*s " $NameFieldLenCN($coursename) $db(Name,$index)] for {set col 0} {$col < $NumOutputColumns} {incr col} { # First, check whether we need to calculate a place for this column if {$db(ColPlace,$coursename,$col,$index) eq "C"} { set db(ColPlace,$coursename,$col,$index) [expr {[lsearch $OutColTime($coursename,$col) $db(ColResult,$coursename,$col,$index)] + 1}] } if {$db(ColPlaceElig,$coursename,$col,$index) eq "C"} { if {[info exists Comp(Elig,$db(Name,$index))] && $Comp(Elig,$db(Name,$index))} { set db(ColPlaceElig,$coursename,$col,$index) [expr {[lsearch $OutColTimeElig($coursename,$col) $db(ColResult,$coursename,$col,$index)] + 1}] } else { set db(ColPlaceElig,$coursename,$col,$index) "" } } # Note: The above is wrong if the result is a DNF. if {[IsDNF $db(ColResult,$coursename,$col,$index)]} { set db(ColPlace,$coursename,$col,$index) "" set db(ColPlaceElig,$coursename,$col,$index) "" } if {($OutColForNameType eq "In") && ([expr $OutColForName-1] == $col)} { # Place the name inside of this column if {$OutColPlaceElig($coursename,$col) == {}} { set Colstr [format " %3s %s%8s" $db(ColPlace,$coursename,$col,$index) $Namestr $db(ColResult,$coursename,$col,$index)] } else { set Colstr [format "%3s%3s %s%8s" $db(ColPlaceElig,$coursename,$col,$index) $db(ColPlace,$coursename,$col,$index) $Namestr \ $db(ColResult,$coursename,$col,$index)] } } else { # Ordinary column (no name, just place(s) and result) if {$OutColPlaceElig($coursename,$col) == {}} { set Colstr [format " %3s%8s" $db(ColPlace,$coursename,$col,$index) $db(ColResult,$coursename,$col,$index)] } else { set Colstr [format "%3s%3s%8s" $db(ColPlaceElig,$coursename,$col,$index) $db(ColPlace,$coursename,$col,$index) $db(ColResult,$coursename,$col,$index)] } } ;# if In $col if {($OutColForNameType eq "After") && ($OutColForName == $col)} { if {$Outstr eq ""} { set Outstr [format "%s%s" $Namestr $Colstr] ;# We save those first few spaces if this is the first column } else { set Outstr [format "%s %s%s" $Outstr $Namestr $Colstr] } } else { if {$Outstr eq ""} { set Outstr [format "%s" $Colstr] ;# We save those first few spaces if this is the first column } else { set Outstr [format "%s %s" $Outstr $Colstr] } } ;# if After(Before) $col } ;# for col if {($OutColForNameType eq "After") && ($OutColForName == $NumOutputColumns)} { set Outstr [format "%s %s" $Outstr $Namestr] } LogResult [format "%s%s%s" $PreHTMLResult $Outstr $PostHTMLResult] $index # Now, work out the CSV output, if necessary if {$debug >= 3} {puts "Pre CSV misc"} if {$AMeetMode && $db(Registered,$index) && $coursename eq $CourseName($db(Course,$index))} { if {$debug >= 3} {puts "Inside CSV misc"} # Have to include the check for course; do not want output for any course but the one run this event for this index. if {![IsDNF $db(FinalResult,$index)]} { if {$debug >= 3} {puts " CSV misc a"} # Finished set ResultStringCSV $db(FinalResult,$index) set PlaceNumCSV [expr {[lsearch $ElapsedTimes($coursename,[llength $CourseControls($CourseIndex)]) \ $db(FinalResult,$index)] + 1}] set PlaceNumEligCSV [expr {[lsearch $ElapsedTimesElig($coursename,[llength $CourseControls($CourseIndex)]) \ $db(FinalResult,$index)] + 1}] ;# Note: This will be 0 if not elig, but we never use this unless they are elig } else { # Didn't finish if {$debug >= 3} {puts " CSV misc b"} set ResultStringCSV $db(FinalResult,$index) set PlaceNumCSV "-" set PlaceNumEligCSV "-" } lappend ResultCSVOutput [format "%s,%s,%s,%s" $PlaceNumCSV $db(Name,$index) $Comp(Club,$db(Name,$index)) $ResultStringCSV] if {$Comp(Elig,$db(Name,$index))} { lappend ResultECSVOutput [format "%s,%s,%s,%s" $PlaceNumEligCSV $db(Name,$index) $Comp(Club,$db(Name,$index)) $ResultStringCSV] } # Work out the details for the O-USA rankings reporting. if {$debug >= 2} {puts "Working on OUSA reporting for: $db(Name,$index)"} set name $db(Name,$index) # Now, determine the result classifier that they want to use: (0=OK, 1=DNS, 2=DNF, 3=MP, 4=DQ, 5=OT) if {[IsTime $db(FinalResult,$index)]} { set resultclassifier "OK" } elseif {[IsNoDL $db(FinalResult,$index)]} { set resultclassifier "DNS" } elseif {$db(FinalResult,$index) eq "OVT"} { set resultclassifier "OT" } elseif {[IsDNF $db(FinalResult,$index)]} { set resultclassifier "DNF" } else { set resultclassifier "" } if {$debug >= 3} {puts "OUSA: A"} if {$Comp(Club,$name) eq "None"} { set club "" } else { set club $Comp(Club,$name) } if {$debug >= 3} {puts "OUSA: B"} lappend ResultOUSAOutput [format "%s,%s,%s,%s,%s,%s,%s" $Comp(Lastname,$name) $Comp(Firstname,$name) $Comp(YOB,$name) $db(TotalTime,$index) $resultclassifier \ $club $CourseName($db(Course,$index)) ] # Note: We stop here, even though Valerie (or whoever) wants additional fields following class: Course,km,m,NumOfControlsOnCourse # We will do a post processing from the class to append those other fields on the end, but not in this program (we don't even know the climb here). # Sometime, it would be nice to have a class->course conversion, which would make this step more automatic. if {$debug >= 3} {puts "OUSA: C"} } ;# if AMeetMode && Registered && coursename if {$debug >= 3} {puts "Post CSV"} } } else { # The coursename is "Unknown". Output minimal information. foreach index $FinishOrder($coursename) { LogResult [format "%s%-*s%s" $PreHTMLResult $NameFieldLen($CourseIndex) $db(Name,$index) $PostHTMLResult] $index } } if {$debug >= 3} {puts "O.Z"} } proc GenerateFinalResult {index} { global db AMeetMode OvertimeLimit OutputTimeSinceStart Starttime TimeNow # Work out the final result for the runner with the given index. # This should take into account everything stored in db (start to finish time, punches, etc), assuming the given course. # It should also take into account any stored edit (i.e. db(EditResult,$index)), which overrides any other result. # If this is an A-meet, and this is a non-downloaded registered competitor, we might generate a pseudo-time (time since/until start). # The final result will be stored in db(FinalResult,$index) if {$index < 0 && $OutputTimeSinceStart && [info exists Starttime($db(Name,$index))]} { # No download, and we should generate a pseudo time since/until start if {[TimeCompare $TimeNow $Starttime($db(Name,$index))] == -1} { set db(FinalResult,$index) "[HHMMSSToHHMMTime [TimeSubtract $Starttime($db(Name,$index)) $TimeNow]] US" } else { set db(FinalResult,$index) "[HHMMSSToHHMMTime [TimeSubtract $TimeNow $Starttime($db(Name,$index))]] SS" } ;# if (before or after scheduled starttime) } elseif {$index < 0} { # We don't have a download, and won't be generating a pseudotime set db(FinalResult,$index) "NoDL" } else { # We have a real download to work with if {$db(Finished,$index)} { # Finished if {!($AMeetMode && [TimeCompare $OvertimeLimit $db(TotalTime,$index)] == -1)} { # Not overtime (or overtime at a local meet where we don't apply the check) set db(FinalResult,$index) $db(TotalTime,$index) } else { # Finished, but overtime set db(FinalResult,$index) "OVT" } ;# if not overtime } else { # Did not finish set db(FinalResult,$index) "DNF" } ;# if finished } ;# if (we need to generate a pseudotime since start) # Now that we have done all of that, we might still override the "real" result with a user edit if {$db(EditResult,$index) ne ""} { # Need to do a check that what is in EditResult is either a real time or a real dnf, just to be sure if {[IsTime $db(EditResult,$index)] || [IsDNF $db(EditResult,$index)]} { set db(FinalResult,$index) $db(EditResult,$index) # If the edit result is a time, we will need to adjust Elapsed and Split time lists to reflect the new effective finish time if {[IsTime $db(EditResult,$index)]} { FixElapsedAndSplitTimes $index } } } } proc FixElapsedAndSplitTimes {index} { global db global debug # The given index has been edited to produce a FinalResult which is a time. # We need to make sure that the db(ElapsedTime,) and db(SplitTime,) lists reflect this forced finish time. # Likely only the last entry needs to be adjusted, unless the edited finish time is moved back in time so far that it preceeds some control punch time, # in which case that punch time will be set equal to the finish time (which prevents the "time traveller" errors we otherwise get). if {$debug >= 3} {puts "In FixElapsed"} if {$debug >= 3} {puts "FixElapsedAndSplitTime: Pre db(ElapsedTime,): $db(ElapsedTime,$index)"} set OutputWarning 0 ;# We output a warning in one condition, but only once if {![IsTime $db(FinalResult,$index)]} { return } set db(ElapsedTime,$index) [lreplace $db(ElapsedTime,$index) end end $db(FinalResult,$index)] ;# Make the last element equal to the FinalResult if {$debug >= 3} {puts "FixElapsedAndSplitTime: 1st db(ElapsedTime,): $db(ElapsedTime,$index)"} # Now, check for time traveller errors in ElapsedTime. Also, build SplitTime from differences in new ElapsedTime list set db(SplitTime,$index) {} for {set i 0} { $i < [llength $db(ElapsedTime,$index)]} {incr i} { if { $i < [expr {[llength $db(ElapsedTime,$index)] - 1}] } { # Only need the time traveller test out to second to last index, but need the splits to the end if {[TimeCompare [lindex $db(ElapsedTime,$index) $i] $db(FinalResult,$index)] == 1} { set db(ElapsedTime,$index) [lreplace $db(ElapsedTime,$index) $i $i $db(FinalResult,$index)] set OutputWarning 1 } } if {$i == 0} { lappend db(SplitTime,$index) [lindex $db(ElapsedTime,$index) 0] ;# 1st split time = 1st elapsed time } else { ;# nth split time = nth elapsed - n-1th elapsed time ;# Index 0 1 2 3 ... n-1 end ;# Elapsed C1 C2 C3 C4 Cn finish ;# Split st,C1 C1,C2 C2,C3 C3,C4 Cn-1,Cn Cn,finish lappend db(SplitTime,$index) [TimeSubtract [lindex $db(ElapsedTime,$index) $i] [lindex $db(ElapsedTime,$index) [expr $i-1]]] } } ;# for ... if {$OutputWarning} { ErrorMsg "WARNING: This edit results in broken split times (new edited finish is before a control punch). " } if {$debug >= 3} {puts "FixElapsedAndSplitTime: Fin db(ElapsedTime,): $db(ElapsedTime,$index)"} if {$debug >= 3} {puts "FixElapsedAndSplitTime: Fin db(SplitTime,): $db(SplitTime,$index)"} if {$debug >= 3} {puts "Leaving FixElapsed"} } # RNOW3 #------------------------------------------------------------------------------------------------------ # Set punch strings, etc # proc SetCoursePunchMisc {index Course Finished NumPunched GoodPunches GoodPunchTime} { global db global ControlThrownOut CourseName CourseType # Since both FindCorrectPunches and GuessCourse need to set similar variables, do both here. # We can also calculate the elapsed and split time strings here. # # Note: There is really no good way to handle a skipped control which immediately follows a control that # was thrown out. We do not try to handle that here. If it happens, the code will likely crash. # However, the case of two (or more) thrown out controls in a row (or otherwise) is handled neatly. # # First, the easy ones: set db(Course,$index) $Course set db(Finished,$index) $Finished ;# ... but see below; might still not have punched "Finish" set db(NumCPunches,$index) $NumPunched set db(CPunches,$index) $GoodPunches set db(CPunchTime,$index) $GoodPunchTime # Now, start working out the misc elapsed and split time lists set db(ElapsedTime,$index) {} set db(SplitTime,$index) {} set LastPunchTime $db(StartTime,$index) set ThrownControlsCorrection 0 ;# Any time removed due to thrown out controls will be accumulated here. set InAThrownLeg 0 ;# While in a region of the course that was thrown out, set to 1 foreach PunchTime $db(CPunchTime,$index) Control $db(CPunches,$index) { # We need the control only to check if this leg is thrown out. if {$InAThrownLeg} { # We are in a leg which has been thrown out. Look for the next good control. if {![info exists ControlThrownOut($Control,All)] && \ ![info exists ControlThrownOut($Control,$CourseName($Course))]} { # So, we have gotten to a non-thrown out control set InAThrownLeg 0 # calc the time delta from the lastpunchtime to now, set TimeDelta [TimeSubtract $PunchTime $LastPunchTime] # add the delta to the throwncontrolscorrection # Note: Because the LastPunchTime should already have been corrected for any previous thrown deltas, # our newly calculated delta should account for all thrown time to this point. set ThrownControlsCorrection $TimeDelta # We make time stand still; e.g. split time is 0, elapsed time is same as for last good point lappend db(ElapsedTime,$index) [TimeSubtract $LastPunchTime $db(StartTime,$index)] lappend db(SplitTime,$index) "0:00" # update lastpunchtime # Note: LastPunchTime should remain the same, since the effect of throwing out the control is # to make the time at the current good control equal to the time at the last good control. } else { ;# else, this next control is thrown out also # We make time stand still; e.g. split time is 0, elapsed time is same as for last good point # lappend db(ElapsedTime,$index) [TimeSubtract $LastPunchTime $db(StartTime,$index)] lappend db(ElapsedTime,$index) "Throw" lappend db(SplitTime,$index) "0:00" } ;# if the next control is good } else { ;# else not in the middle of a thrown leg if {( [info exists ControlThrownOut($Control,All)] || \ [info exists ControlThrownOut($Control,$CourseName($Course))] ) && \ $CourseType($Course) != 1} { # The next control was thrown out on this course. set InAThrownLeg 1 # We make time stand still; e.g. split time is 0, elapsed time is same as for last good point # lappend db(ElapsedTime,$index) [TimeSubtract $LastPunchTime $db(StartTime,$index)] lappend db(ElapsedTime,$index) "Throw" lappend db(SplitTime,$index) "0:00" } else { ;# this is the normal case, no involvement of thrown legs, etc if {$PunchTime ne "skip"} { # This was a normal punch; $PunchTime should be the time the control was punched. # Might want to save some trouble by saving these now in ShortTime form. TODO # # First, currect the current punch time for any thrown out controls set PunchTime [TimeSubtract $PunchTime $ThrownControlsCorrection] lappend db(ElapsedTime,$index) [TimeSubtract $PunchTime $db(StartTime,$index)] lappend db(SplitTime,$index) [TimeSubtract $PunchTime $LastPunchTime] set LastPunchTime $PunchTime } else { # Looks like this was a valid skip. The course is still good, but there was no punch at this control # Enter some placeholder info here lappend db(ElapsedTime,$index) "Skip" lappend db(SplitTime,$index) "" # Leave LastPunchTime alone, since we have nothing to update it with yet. } } ;# if the next control is thrown } ;# if InAThrownLeg } ;# foreach PunchTime if {$db(FinishTime,$index) eq ""} { # Looks like they didn't punch finish, even though all other controls might be punched. # There is a possibility of implementing mercy elsewhere (around CalcResults, likely), # since the person clearly found download and thus the failed finish punch was a fluke. TODO # However, for now, we set Finished to false. set db(Finished,$index) 0 } if {$db(Finished,$index)} { # Work out the final split/elapsed for the leg to the finish set CorrectedFinishTime [TimeSubtract $db(FinishTime,$index) $ThrownControlsCorrection] lappend db(ElapsedTime,$index) [TimeSubtract $CorrectedFinishTime $db(StartTime,$index)] lappend db(SplitTime,$index) [TimeSubtract $CorrectedFinishTime $LastPunchTime] set db(TotalTime,$index) [TimeSubtract $CorrectedFinishTime $db(StartTime,$index)] } } #------------------------------------------------------------------------------------------------------ # Find correct punches # proc FindCorrectPunches {index {course -1} } { global db NumCourses CourseName CourseControls CourseType CourseAllowedSkips ControlSkippable ControlThrownOut # For the given entry, and the given course (or for the # course assigned to that entry if no second argument), # and the list of real punches stored for that entry, determine # the list of correct punches, punch times, and various split # times for that course. # Will either: # If course -1 (i.e. default 2nd arg): Store these results in the appropriate db location. # or # If handed course: Return these values in a big return list. if {$course == -1} { # Looks like a default course. Use what is stored for this entry in db. set CourseIndex $db(Course,$index) } else { set CourseIndex $course } if {$CourseType($CourseIndex) == 0} { # Normal course set NumPunched 0 ;# Number of good punches on course being checked set PunchIndex 0 ;# Index into list of all punches by this runner, points last Official Punch so far set GoodPunches {} ;# List of all valid punches on course being checked. set GoodPunchTime {} ;# (This will be what we use for calculating splits from, eventually.) set NumToPunch [llength $CourseControls($CourseIndex)] set AllowedSkipsLeft $CourseAllowedSkips($CourseIndex) foreach Control $CourseControls($CourseIndex) { # Once skipped controls are coded for, this will be where the skip occurs # Now, checking from the point of the last good punch, look for the next needed punch on this course if { [set NewPunch [lsearch -start $PunchIndex $db(RealPunches,$index) $Control]] != -1} { # Good punch; continue set PunchIndex $NewPunch lappend GoodPunches $Control lappend GoodPunchTime [lindex $db(RealPunchTime,$index) $PunchIndex] incr NumPunched if {$NumPunched == $NumToPunch} { # Looks like they finished this course. Can wrap things up now set Finished 1 } } elseif {$AllowedSkipsLeft > 0} { # Didn't punch, but the runner is still allowed a skip. This will use up one of our allowed skipped controls. incr AllowedSkipsLeft -1 ;# decriment by one, e.g. "use up" one skip # Don't change PunchIndex, since we haven't punched anything for this control lappend GoodPunches $Control ;# Treat a valid skip as a good punch, e.g. act as though we punched it lappend GoodPunchTime "skip" incr NumPunched if {$NumPunched == $NumToPunch} { # Looks like they finished this course. Can wrap things up now set Finished 1 } } elseif {[info exists ControlSkippable($Control)] && $ControlSkippable($Control) eq "yes"} { # This control is effectively optional. Just treat it as a good, skipped control. # This isn't counted as a "skip" for the course. # Don't change PunchIndex, since we haven't punched anything for this control lappend GoodPunches $Control ;# Treat a valid skip as a good punch, e.g. act as though we punched it lappend GoodPunchTime "skip" incr NumPunched if {$NumPunched == $NumToPunch} { # Looks like they finished this course. Can wrap things up now set Finished 1 } } elseif {[info exists ControlThrownOut($Control,All)] && $ControlThrownOut($Control,All) eq "yes" || \ [info exists ControlThrownOut($Control,$CourseName($CourseIndex))] && $ControlThrownOut($Control,$CourseName($CourseIndex)) eq "yes"} { # This control was thrown out, and is thus skippable. # This control is effectively optional. Just treat it as a good, skipped control. # This isn't counted as a "skip" for the course. # Don't change PunchIndex, since we haven't punched anything for this control lappend GoodPunches $Control ;# Treat a valid skip as a good punch, e.g. act as though we punched it lappend GoodPunchTime "skip" incr NumPunched if {$NumPunched == $NumToPunch} { # Looks like they finished this course. Can wrap things up now set Finished 1 } } else { # Missed a punch; didn't finish this course set Finished 0 break } ;# if punch matches } ;# foreach control on course(courseindex) } elseif {$CourseType($CourseIndex) == 1} { # Score-O set Finished 1 set NumPunched $db(NumPunches,$index) set GoodPunches $db(RealPunches,$index) set GoodPunchTime $db(RealPunchTime,$index) } if {$course == -1} { # Again, a default course. We want to change the locations in db. SetCoursePunchMisc $index $CourseIndex $Finished $NumPunched $GoodPunches $GoodPunchTime } else { # We are calling from GuessCourse. Return the results in a monster return list. return [list $Finished $NumPunched $GoodPunches $GoodPunchTime] } } #------------------------------------------------------------------------------------------------------ # GuessCourse # proc GuessCourse {index} { global db NumCourses CourseName CourseNames CourseControls global CourseType global AMeetMode AMeetEvent Comp # (Used to) Return a list: {BestGuessOfCourseIndex FinishedBoolean NumPunchedOnThisCourse PunchList PunchTimeList} # Now: Just sets the values itself. # # We look for the best match of course. A completed course (all controls punched in order) is preferred to a non-completed course. # When selecting between two completed courses (if, for example, one course is a subset of another), preference is given to the # later described course. (In other words, it is best to list courses in courses.txt such that longer courses are later in the file.) # A completed normal course is preferred to a score-o. # If no normal courses are completed, preference is given to a score-o which produces the greatest score. # If two score-o courses produce the same score, preference is given to the later listed one. set Finished 0 ;# Boolean set BestGuessCourse -1 ;# Will still be -1 at end if didn't punch any controls set NumPunchedOnBestMatchCourse 0 ;# Num punched on the best match of course set BestScore -9999999999 ;# Best score so far. Let us hope noone ever gets a score this low. set BestScoreOn -1 ;# Index of course with best score-o score set CourseFromRegistration 0 ;# Course was derived from registration information set CourseChangeWarning 0 ;# Need to raise a warning about changing a course from what was registered for set OfficialPunches {} ;# List of all valid punches on best match of course set OfficialPunchTime {} ;# Time associated with given punch # Want to check that index is in use, and that some courses have been read # TODO # If this is an A-meet, we first go through everything once with the registered class course. # We will later loop through the courses to see if there is a better match than what was registered for. if {$AMeetMode && [info exists Comp(Class,$AMeetEvent,$db(Name,$index))]} { set CourseIndex [lsearch $CourseNames $Comp(Class,$AMeetEvent,$db(Name,$index))] if {$CourseIndex != -1} { set cplist [FindCorrectPunches $index $CourseIndex] #puts "Setting $db(Name,$index)'s course to $Comp(Class,$AMeetEvent,$db(Name,$index))" set Finished [lindex $cplist 0] set NumPunched [lindex $cplist 1] ;# Number of good punches on course being checked set GoodPunches [lindex $cplist 2] ;# List of all valid punches on course being checked set GoodPunchTime [lindex $cplist 3] ;# List of times associated with GoodPunches set NumToPunch [llength $CourseControls($CourseIndex)] set BestGuessCourse $CourseIndex set NumPunchedOnBestMatchCourse $NumPunched set OfficialPunches $GoodPunches set OfficialPunchTime $GoodPunchTime set CourseFromRegistration 1 } else { set CourseChangeWarning 1 } } # Loop over courses in reverse if {!$Finished} { for {set CourseIndex [expr {$NumCourses - 1}]} {$CourseIndex >= 0} {incr CourseIndex -1} { if {$CourseType($CourseIndex) != 0} { # This loop is only for normal courses (i.e. not score-o, etc) continue } set cplist [FindCorrectPunches $index $CourseIndex] set Finished [lindex $cplist 0] set NumPunched [lindex $cplist 1] ;# Number of good punches on course being checked set GoodPunches [lindex $cplist 2] ;# List of all valid punches on course being checked set GoodPunchTime [lindex $cplist 3] ;# List of times associated with GoodPunches set NumToPunch [llength $CourseControls($CourseIndex)] if {$Finished && ($NumPunched > $NumPunchedOnBestMatchCourse)} { set BestGuessCourse $CourseIndex set NumPunchedOnBestMatchCourse $NumPunched set OfficialPunches $GoodPunches set OfficialPunchTime $GoodPunchTime #puts "Changing C1 $db(Name,$index)'s course to $CourseName($CourseIndex)" if {$CourseFromRegistration} { set CourseChangeWarning 1 } break } else { # Apparently missed a punch. # Have they punched the most controls on this course, as compared to other courses? if {$NumPunched > $NumPunchedOnBestMatchCourse} { # ... then this is our best guess (so far) for the course this runner was intending to run set BestGuessCourse $CourseIndex set NumPunchedOnBestMatchCourse $NumPunched set OfficialPunches $GoodPunches set OfficialPunchTime $GoodPunchTime #puts "Changing C2 $db(Name,$index)'s course to $CourseName($CourseIndex)" if {$CourseFromRegistration} { set CourseChangeWarning 1 } } } } } # If haven't found a completed normal course, look for the best score-o course, if one exists if {!$Finished} { for {set CourseIndex 0} {$CourseIndex < $NumCourses} {incr CourseIndex} { if {$CourseType($CourseIndex) == 1} { set score [ScoreTotal $index $CourseIndex] if {$score >= $BestScore} { set BestScore $score set BestScoreOn $CourseIndex } } } ;# for courseindex if {$BestScoreOn != -1} { # Looks like they were on a score-o. set BestGuessCourse $BestScoreOn set Finished 1 set NumPunchedOnBestMatchCourse $db(NumPunches,$index) set OfficialPunches $db(RealPunches,$index) set OfficialPunchTime $db(RealPunchTime,$index) } } ;# if not finished, 2nd round if {$CourseChangeWarning} { ErrorMsg "WARNING: $db(Name,$index) changed course from (registered): $Comp(Class,$AMeetEvent,$db(Name,$index)) to (best guess): $CourseName($BestGuessCourse)" } # Old version returned the relevant values in a list #return [list $BestGuessCourse $Finished $NumPunchedOnBestMatchCourse $OfficialPunches $OfficialPunchTime] # New version calls another function which sets these values in db SetCoursePunchMisc $index $BestGuessCourse $Finished $NumPunchedOnBestMatchCourse $OfficialPunches $OfficialPunchTime } #------------------------------------------------------------------------------------------------------ # Score-O # proc ValueOfControl {cn CourseIndex} { global CourseControls ControlValue if {[info exists ControlValue($cn)] && [lsearch $CourseControls($CourseIndex) $cn] != -1} { # (Only worth points if it is on this course, and has a value assigned) return $ControlValue($cn) } else { return 0 } } proc ScorePoints {index {CourseIndex -1}} { global db set score 0 if {$CourseIndex == -1} { set CourseIndex $db(Course,$index) } set ScoredAlready {} foreach controlnumber $db(RealPunches,$index) { if {[lsearch $ScoredAlready $controlnumber] == -1} { # Only score each control once (i.e. ignore subsequent punches of the same control) incr score [ValueOfControl $controlnumber $CourseIndex] lappend ScoredAlready $controlnumber } } return $score } proc ScorePenalty {index {CourseIndex -1}} { global db CourseTimePenalty if {$CourseIndex == -1} { set CourseIndex $db(Course,$index) } if {![info exists CourseTimePenalty($CourseIndex)]} { return 0 } set worklist [split $CourseTimePenalty($CourseIndex) ,] set length [llength $worklist] set min [TimeToMin $db(TotalTime,$index)] ;# This is total minutes on the course, rounded up set mindone 0 ;# This is the minutes for which penalties have already been applied set minleft $min ;# This is the minutes for which penalties have not been added yet set penalty 0 ;# ... to start if { [expr {$length % 2}] != 1} { return 0 } for {set i 0} {$i < [expr { ($length-1)/2 }]} {incr i} { # working with [lindex $worklist [expr {$i*2}]] and [lindex $worklist [expr {$i*2 + 1}]] set thispenalty [lindex $worklist [expr {$i*2}]] set uptotheseminutes [lindex $worklist [expr {$i*2 + 1}]] if {$min < $uptotheseminutes} { return [expr {$penalty + $minleft * $thispenalty}] } else { incr penalty [expr {($uptotheseminutes - $mindone) * $thispenalty}] set mindone $uptotheseminutes set minleft [expr {$min - $mindone}] } } return [expr {$penalty + $minleft * [lindex $worklist end]}] } proc ScoreTotal {index {CourseIndex -1}} { return [expr {[ScorePoints $index $CourseIndex] - [ScorePenalty $index $CourseIndex]}] } proc PenaltyToText {penalty} { # Turn the comma separated penalty string of the form: 0,60,1,65,2,70,10 # into a natural language text string of the form: 60 minutes, then 1 pt/min to 65min, then 2 pt/min to 70min, then 10 pt/min. set worklist [split $penalty ,] set length [llength $worklist] set TextString "" ;# Start here and build up. if { [expr {$length % 2}] != 1} { return "" } if {$length == 1} { if {[lindex $worklist 0] == 0} { set TextString "No time constraints." } else { set TextString "[lindex $worklist 0] pt/min." } return $TextString } if {[lindex $worklist 0] == 0} { set TextString "[lindex $worklist 1] minutes" } else { set TextString "[lindex $worklist 0] pt/min for the first [lindex $worklist 1]min" } for {set i 1} {$i < [expr { ($length-1)/2 }]} {incr i} { # working with [lindex $worklist [expr {$i*2}]] and [lindex $worklist [expr {$i*2 + 1}]] set TextString "$TextString, then [lindex $worklist [expr {$i*2}]] pt/min to [lindex $worklist [expr {$i*2 + 1}]]min" } set TextString "$TextString, then [lindex $worklist end] pt/min." } #------------------------------------------------------------------------------------------------------ # Check and Clear Multiple Downloads # proc CheckAndClearMultipleDownloads {index} { global db NumEntries rawlist global Comp global debug # Do this by checking for duplicate clear times; in such cases, keep the line with # the greatest length (i.e. most information). # Note that it is possible to imagine pathological cases in which neither download # is complete, which would not be handled well here. # # Note that we could possibly improve this routine slightly by also checking that the SICard # number matches. At the moment, I cannot imagine a circumstance in which there are multiple # clears at the same time and at the same box. # (In retrospect, two different physical boxes can be programmed with the same box number; i.e. # with multiple clear boxes they could all be called "number 4". The check for SICard number should # be included.) (Now implemented.) if {$debug >= 3} {puts "In CheckAndClearMultipleDownloads"} if {![info exists db(ClearTime,$index)] || ![info exists db(ClearCN,$index)]} { # Some problem with our own cleartime/cn. Just exit. return } if {$db(ClearTime,$index) == ""} { # Did not clear. No good way to check this here, so just exit. return } if {$debug >= 4} {puts "CCMD: A"} set TurnOffIndex 0 ;# This will be an index to be cleared as a partial download. # Loop over all entries (really only those raw processed until this point in time) for {set i 1} {$i < $NumEntries} {incr i} { if {$debug >= 4} {puts "CCMD: B, index: $i"} if {$i == $index} { # We are looking at our own entry here. # (Best to go through all entries rather than to NumEntries-1, in case this # gets called from a time other than during the first processing of raw input). continue } if {$db(Use,$i) == 0} { # We are looking at an entry that was already cleared. Don' t bother looking at it more. continue } #if {![info exists db(ClearTime,$i)]} { puts "ClearTime i:$i" } #if {![info exists db(ClearTime,$index)]} { puts "ClearTime index:$index" } #if {![info exists db(ClearCN,$i)]} { puts "ClearCN i:$i" } #if {![info exists db(ClearCN,$index)]} { puts "ClearCN index:$index" } # if {$debug >= 4} {puts "CCMD: C"} if {![info exists db(ClearTime,$i)] || ![info exists db(ClearTime,$index)] || \ ![info exists db(ClearCN,$i)] || ![info exists db(ClearCN,$index)]} { # Can't compare, so just move on continue } if {$debug >= 4} {puts "CCMD: D"} if {$db(ClearTime,$i) eq $db(ClearTime,$index) && $db(ClearCN,$i) eq $db(ClearCN,$index) && $db(SICard,$i) eq $db(SICard,$index)} { if {$debug >= 4} {puts "CCMD: E"} # Same clear times from the same box for the same stick. This has to be a duplicate download. set ilen [string length [lindex $rawlist $i]] set indexlen [string length [lindex $rawlist $index]] if {$debug >= 4} {puts "CCMD: F"} if {$ilen < $indexlen} { set TurnOffIndex $i } elseif {$indexlen < $ilen} { set TurnOffIndex $index } else { # Both same size. Set earlier read to not use. if {$i < $index} { set TurnOffIndex $i } else { set TurnOffIndex $index } ;# if i < index } ;# if ilen < indexlen if {$debug >= 4} {puts "CCMD: G"} if {$TurnOffIndex != 0} { if {$debug >= 4} {puts "CCMD: H"} if {$db(Use,$TurnOffIndex) != 0} { # (If it had been zero, no need to turn it off again.) set db(Use,$TurnOffIndex) 0 set db(Dup,$TurnOffIndex) 1 ErrorMsg "Dup Cleared($TurnOffIndex): [lindex $rawlist $TurnOffIndex]" if {$debug >= 4} {puts "CCMD: I"} # Check whether we need to modify the index pointer in Comp, if one exists if {$TurnOffIndex == $index} { set KeepIndex $i } else { set KeepIndex $index } if {$debug >=1} { ErrorMsg "Keep Dup($KeepIndex) : [lindex $rawlist $KeepIndex]" ErrorMsg "Clear $db(ClearTime,$TurnOffIndex), $db(ClearTime,$KeepIndex). ClearCN $db(ClearCN,$TurnOffIndex), $db(ClearCN,$KeepIndex) \ SICard $db(SICard,$TurnOffIndex), $db(SICard,$KeepIndex)" } if {$debug >= 4} {puts "CCMD: J"} if {$debug >= 3} { puts "CCMD: Jb. TurnOff: $TurnOffIndex. Keep: $KeepIndex. ($db(Name,$TurnOffIndex))" if {[info exists Comp(DBIdx,$db(Name,$TurnOffIndex))]} { puts " Comp(DBIdx,): $Comp(DBIdx,$db(Name,$TurnOffIndex))" } } if {[info exists Comp(DBIdx,$db(Name,$TurnOffIndex))] && $TurnOffIndex == $Comp(DBIdx,$db(Name,$TurnOffIndex))} { set Comp(DBIdx,$db(Name,$TurnOffIndex)) $KeepIndex if {$debug >= 3} {puts "CCMD: Jc."} } } ;# if not already turned off if {$debug >= 4} {puts "CCMD: K"} set TurnOffIndex 0 ;# Reset it } ;# if TurnOffIndex != 0 if {$debug >= 4} {puts "CCMD: L"} } ;# if (time and cn the same) if {$debug >= 4} {puts "CCMD: Z"} } ;# for (over NumEntries) if {$debug >= 4} {puts "CCMD: Exiting"} } #------------------------------------------------------------------------------------------------------ # Sanity Checking # proc DoTimeSanityCheck {index} { global db # We assume that all possible has been processed from the raw datafile into the following: # db(StartTime,$index) Start time # db(RealPunchTime,$index) List of actual punch times # db(FinishTime,$index) Finish time # (If we wanted, we could also check clear time, but old cards don't store this, and I cannot # think of a reason yet to care about whether the clear is "good". TODO?) # Check that time proceeds in a monotonically increasing manner # i.e. Start time < 1st punch time < 2nd punch time < ... < Last punch time < Finish time # If not, do what is possible to fix: # The most common problem is likely to be with old SI cards which store 12 hour time, when # someone's times go from 11:xx to 00:xx. # Recognise by travel backward in time by > 6 hours # Solve by adding 12 hours to any such 6+ hour step backward in time. # # If we see a problem with times, want to give a warning message. However, we do not want to # give warnings when this is a duplicate entry. As a result, we will save any possible warning # messages, and then print out the stored warnings only for those entries which are not duplicates, # i.e. db(Dup,$i) != 1, after processing the entire raw file. # if {![info exists db(StartTime,$index)] || ![info exists db(RealPunchTime,$index)] || ![info exists db(FinishTime,$index)]} { # Something hasn't been set in db yet. Give warning, set to not use, and return. DelayedErrorMsg $index "Problem with time in $index. Removing entry. Look carefully at this entry." # That isn't a terribly informative error message. However, if we get that error message, something # has gone very wrong and someone needs to look closely at this anyway. set db(Use,$index) 0 return } if { $db(StartTime,$index) eq ".929" || $db(StartTime,$index) eq "" } { # No start on this entry. For now skip it. May want to do something better with these. TODO DelayedErrorMsg $index "Skipping ($index) $db(SICard,$index) $db(Name,$index) (No start.)" set db(Use,$index) 0 return } # Check that time moves consistently forward, i.e. each successive time point is later than the one before. # (If not, we have some problem, such as a 12 hour time rollover, a DST bug, a mis-set clock, etc.) set TwelveHrWarning 0 ;# Will toggle to 1 if we need to put a warning about 12->24hr conversion set TimeMark $db(StartTime,$index) ;# This time point will move forward, from start, through punches, to finish if {$db(RealPunchTime,$index) != {} && [lindex $db(RealPunchTime,$index) end] != {}} { # We have number of punches greater than 0, and all punch times (actually just last one) were read. foreach PunchTime $db(RealPunchTime,$index) { # Check that this new time is later than the previous mark if {[TimeCompare $TimeMark $PunchTime] == 1} { # Looks like a supposedly later punch occurred "earlier in time". Likely a clock problem of some sort. if {[TimeCompare $TimeMark [TimeAdd $PunchTime "6:00:00"]] == 1 && \ [TimeCompare $TimeMark [TimeAdd $PunchTime "12:00:00"]] != 1} { # This means that the mark (previous time) is more than 6 hours ahead of the punch (new time), but <= 12 hours ahead. # Likely to be a 12hr rollover. Add 12 hours to the result. # The next command replaces the value at the first location in the list matching $PunchTime, with "$PunchTime + 12" lset db(RealPunchTime,$index) [lsearch $db(RealPunchTime,$index) $PunchTime] [TimeAdd $PunchTime "12:00:00"] set TwelveHrWarning 1 set PunchTime [TimeAdd $PunchTime "12:00:00"] } else { # Likely some clock problem, but the sort is difficult to determine. # Give a warning, and set it to not use. DelayedErrorMsg $index "Clock Problem at a control. ($index) $db(SICard,$index) $db(Name,$index). $TimeMark > $PunchTime Skipping entry." set db(Use,$index) 0 return } } # Now move the mark forward set TimeMark $PunchTime } } ;# if (have some punch times) if {$db(FinishTime,$index) != ""} { # We have a finish punch. # Check that the finish time is later than the previous mark if {[TimeCompare $TimeMark $db(FinishTime,$index)] == 1} { # Looks like the finish occurred "earlier in time" than the previous punch (last control, or start if no controls) if {[TimeCompare $TimeMark [TimeAdd $db(FinishTime,$index) "6:00:00"]] == 1 && \ [TimeCompare $TimeMark [TimeAdd $db(FinishTime,$index) "12:00:00"]] != 1} { # This means that the mark (previous time) is more than 6 hours ahead of the finish (new time), but <= 12 hours ahead. # Likely to be a 12hr rollover. Add 12 hours to the finish. set db(FinishTime,$index) [TimeAdd $db(FinishTime,$index) "12:00:00"] set TwelveHrWarning 1 } else { # Likely some clock problem, but the sort is difficult to determine. # Give a warning, and set to not use this entry. DelayedErrorMsg $index "Clock Problem at finish. ($index) $db(SICard,$index) $db(Name,$index). Skipping entry." set db(Use,$index) 0 return } } # Would move the mark forward here, if there were anything else to do with it. } ;# if (have a finish time) if {$TwelveHrWarning} { DelayedErrorMsg $index "12hr -> 24hr conversion applied to ($index) $db(SICard,$index) $db(Name,$index)." } } #------------------------------------------------------------------------------------------------------ # Adjust time # proc AdjTime {control origtime} { global timeshift # Given a control number (or "Start" or "Finish") and its original time, return an adjusted time # according to the timeshift file. # These adjustments are to correct for time synchronization problems in a control # (for example, if the clock on the start box is 4 minutes behind all other boxes, # you can use this to add 4 minutes to every start box punch). set shifttime $origtime # if Start or Finish # if exists, add/subtract shift # else # if all exists, add/subtract all shift # if control exists, add/subtract control shift if {$control eq "Start" || $control eq "Finish"} { if {[info exists timeshift($control)]} { if {$timeshift($control,Add)} { set shifttime [TimeAdd $shifttime $timeshift($control)] } else { set shifttime [TimeSubtract $shifttime $timeshift($control)] } } } else { ;# This is a control. Add any All-shift, plus any shift for this control if {[info exists timeshift(All)]} { if {$timeshift(All,Add)} { set shifttime [TimeAdd $shifttime $timeshift(All)] } else { set shifttime [TimeSubtract $shifttime $timeshift(All)] } } if {[info exists timeshift($control)]} { if {$timeshift($control,Add)} { set shifttime [TimeAdd $shifttime $timeshift($control)] } else { set shifttime [TimeSubtract $shifttime $timeshift($control)] } } } return $shifttime } #------------------------------------------------------------------------------------------------------ # Should Output # proc ShouldOutput {index} { global db Comp AMeetEvent global OutputHTML AMeetMode # Determine whether this indexed db entry should be output. # Reasons to not output: # This is a duplicate entry, or has otherwise been deleted. # This is an A-Meet, the entry is not registered, and we are screening such finishers. # This is a non-downloaded Comp, whose class is "NC" (not competing), i.e. there will be no result for this person # Return: 0 if should not output, 1 if should output if {![info exists db(Use,$index)]} { return 0 } if {!$db(Use,$index)} { return 0 } if {$AMeetMode && $OutputHTML && !$db(Registered,$index)} { return 0 } if {$index < 0 && [info exists Comp(Class,$AMeetEvent,$db(Name,$index))] && $Comp(Class,$AMeetEvent,$db(Name,$index)) eq "NC"} { return 0 } return 1 } #------------------------------------------------------------------------------------------------------ # Compare results # proc CompareResults {r1 r2} { global db CourseType # Compares two runners, presumed to be on the same course. r1 and r2 are entry indexes into db # Return -1 if r1 is above r2 in results, 1 if r2 is above r1, and 0 if they tied. # Finishers always ranked above DNF # Finishers ranked by time # DNFs ranked first by number of good controls punched, then by time # if {![info exists db(Use,$r1)] || ![info exists db(Use,$r2)]} { puts stderr "Comparing results index, at least one of which does not exist: $r1 $r2" return 0 } if {$CourseType($db(Course,$r1)) == 0} { # Normal course if {![IsDNF $db(FinalResult,$r1)] && [IsDNF $db(FinalResult,$r2)]} { return "-1" } if {![IsDNF $db(FinalResult,$r2)] && [IsDNF $db(FinalResult,$r1)]} { return "1" } if {![IsDNF $db(FinalResult,$r1)] && ![IsDNF $db(FinalResult,$r2)]} { # Both finished return [TimeCompare $db(FinalResult,$r1) $db(FinalResult,$r2)] } else { # Both DNFed if {$db(NumCPunches,$r1) == $db(NumCPunches,$r2)} { # Same number of valid punches. Eventually sort by time to last good punch return "0" ;# TODO } if {$db(NumCPunches,$r1) > $db(NumCPunches,$r2)} { return "-1" } else { return "1" } } } elseif {$CourseType($db(Course,$r1)) == 1} { # Score-O set s1 [ScoreTotal $r1] set s2 [ScoreTotal $r2] if {$s1 > $s2} { return "-1" } elseif {$s2 > $s1} { return "1" } else { # Same score, sort by total time if {[info exists db(TotalTime,$r1)] && [info exists db(TotalTime,$r2)]} { return [TimeCompare $db(TotalTime,$r1) $db(TotalTime,$r2)] } else { # Someone's time doesn't exist (possibly didn't punch finish). Just return an equal result. return "0" } } } ;# if course type } proc CompareColResults {r1 r2} { global db EvNCourseType EvNCourseNames OutputEvents global OCCoursename OCCol # Compares two runners, presumed to be on the same course. r1 and r2 are entry indexes into db # These indices came out of an OutColPlace list, indicated by OCCoursename and OCCol # Return -1 if r1 is above r2 in results, 1 if r2 is above r1, and 0 if they tied. # Finishers always ranked above DNF # Finishers ranked by time # DNFs ranked first by number of good controls punched, then by time # We would like to resolve ties by examination of other event's results. This may or may not happen. # if {![info exists db(Use,$r1)] || ![info exists db(Use,$r2)]} { puts stderr "Comparing results index, at least one of which does not exist: $r1 $r2" return 0 } # Figure out what event these results are from, for purposes of determining event type. # Note: If events are summing for output, it would be a good idea that they all be of the same type; we will only # be looking here at the type of the first in the summation. It is the user's job to make sure they are all the same. set event [lindex $OutputEvents($OCCol) 0] ;# Get the first event used in generating this column. # Also need a course index for the lookup. set courseindex [lsearch $EvNCourseNames($event) $OCCoursename] if {$courseindex == -1} { ErrorMsg "ERROR: Unable to find course $OCCoursename in event $event while comparing results. Sorting will be adversely impacted." return 0 } # Now, lookup the results we are comparing for runner indices r1 and r2. # For a regular course, these will be either a time or some form of DNF. # For a score-o, these will be a score or DNF (if they didn't actually compete in the score-o, for example). set result1 $db(ColResult,$OCCoursename,$OCCol,$r1) set result2 $db(ColResult,$OCCoursename,$OCCol,$r2) # Now, start the comparison if {$EvNCourseType($event,$courseindex) == 0} { # Normal course if {![IsDNF $result1] && [IsDNF $result2]} { return "-1" } if {![IsDNF $result2] && [IsDNF $result1]} { return "1" } if {![IsDNF $result1] && ![IsDNF $result2]} { # Both finished return [TimeCompare $result1 $result2] } else { # Both DNFed #return [DNFCompare $result1 $result2] # Note: Because of the order in which the "indices to output" list is built, the NoDL's will always appear below the DNFs # We can do a little better though. If the sort column is a sum of two days, the DNF could be due to a DNF on a day different from the current one. # By sorting again on the current result, we will place (DNF-sum, finished-current) above (DNF-sum, DNF-current). return [CompareResults $r1 $r2] #return "0" ;# We could distinguish between different DNFs by comparing other event's results. TODO } } elseif {$EvNCourseType($event,$courseindex) == 1} { # Score-O # The results are a score, not a time. DNF is still possible (SPW, DNS, etc). if {![IsDNF $result1] && [IsDNF $result2]} { return "-1" } if {![IsDNF $result2] && [IsDNF $result1]} { return "1" } if {![IsDNF $result1] && ![IsDNF $result2]} { if {$result1 > $result2} { return "-1" } elseif {$result2 > $result1} { return "1" } else { # Same score, sort by some other method return "0" ;# TODO } } } ;# if course type } #------------------------------------------------------------------------------------------------------ # Calc Results # proc CalcResults {} { global db NumEntries MaxCompIdx global NumCourses CourseName CourseNames CourseControls CourseLength CourseType CourseTimePenalty global EvNNumCourses EvNCourseName EvNCourseNames EvNCourseControls EvNCourseLength EvNCourseType EvNCourseTimePenalty global FullCourseNamesList global sb NumStartEntries global EditIdx rbox ;# We need these to reset the editing selections after a re-calc global OutputRealPunches OutputHTML HideErrors OutputTimeSinceStart global HTMLTitle global HTMLType PreHTMLHeader PostHTMLHeader PreHTMLResult PostHTMLResult global MakeWebpageRefresh WebpageRefreshTime global GTGResults global NameFieldLenDefault NameFieldLenMax NameFieldLen NameFieldLenCN global LiveUpdates AMeetMode AMeetEvent Comps Comp CourseNames Starttime global TimeNow global ResultCSVOutput ResultECSVOutput ResultOUSAOutput global FinishOrder FinishOrderElig ElapsedTimes ElapsedTimesElig global NumOutputColumns UseOutputColumns OutputEvents OutColumnToSortBy OutputColName OutputColumnName OutputColumnHeaders global OutColPlace OutColTime OutColPlaceElig OutColTimeElig global CompWithNoDL EligCompWithNoDL global OvertimeLimit global ShowLegend global debug # This routine will calculate the final results (runner ranking for each course, detailed split # comparisons, etc) and display them. # It will also display a raw output for use in debugging, which will be easily removed for final web publishing. # This routine will need to be re-called any time any significant change has been made in editing # any record (e.g. runner's course changed, control skip added, etc). # # Note: We will get into some trouble in this output when the number of finishers on a course exceeds 99; # there will be room for all digits, but there will be some missing spacing between regular and elig places, and # will have to redo the formats to leave room for the extra digit in that case. # I choose to leave it this way, for now, to conserve the extra screen space (which already scrolls # over a wide horizontal range for the advanced splits). # There are a few routines which blindly call this routine to update the output section. # Just check this variable to see whether we have anything yet to output. if {$GTGResults == 0} {return} if {$debug >= 3} {puts "preA"} # Before we do anything, take care of autowriting html output, if in live update mode # Note: In live update mode, we stay with txt (instead of html) mode most of the time; # we only shift briefly into html mode for the auto-output. if {$LiveUpdates && ! $OutputHTML } { #puts "Live updates. Writing html version first." # Will call again to write the html version first, and save it, then come back here and output the screen version set OutputHTML 1 CalcResults set OutputHTML 0 } if {$debug >= 3} {puts "preB"} # First, clear the previous output ... # Note that we will ignore the HideErrors variable if outputting html, and always act as though it were true. # (I doubt anyone will ever want to see the raw output in the final web results.) if {$OutputHTML || $HideErrors} { # ... completely. ClearResults } else { # ... and start with just the raw output ClearResultsToRaw } set NumStartsTotal 0 ;# Count of total number of starts today. Note: At an A-meet this will be only registered starts. set NumRegStartsTotal 0 ;# Count of total number of registered starts today. set TimeNow [CurrentTime] ;# Use this time for all updates this round set ResultCSVOutput {} ;# Clear, in preparation for building a new output set. This is the list of CSV output lines. set ResultECSVOutput {} ;# Clear, in preparation for building a new output set set ResultOUSAOutput {} ;# Clear. This is the list of CSV lines we report to OUSA for rankings. if {$AMeetMode} { set OutputRealPunches 0 ;# Do not output the real punch string for an A-meet, even we told it to elsewhere. } if {$UseOutputColumns($AMeetEvent) == 0} { set HTMLType 0 ;# Can't use column flow for a normal, local style event. (Need to duplicate some code to make this happen.) } if {$HTMLType == 1 && $OutputHTML} { set PreHTMLHeader "<div class=\"cls-section\">" set PostHTMLHeader "</div>" set PreHTMLResult "<div class=\"cls-item\"><pre>" set PostHTMLResult "</pre></div>" } else { set PreHTMLHeader "" set PostHTMLHeader "" set PreHTMLResult "" set PostHTMLResult "" } if {$debug >= 3} {puts "preC"} # Output the html header code if necessary if {$OutputHTML} { LogResult "<html>" LogResult "<head>" if {$MakeWebpageRefresh == 1} { LogResult "<meta http-equiv=\"refresh\" content=\"$WebpageRefreshTime\">" } LogResult "<title>$HTMLTitle" LogResult "" LogResult "" if {$HTMLType == 1} { LogResult "" } LogResult "" LogResult "" LogResult "

$HTMLTitle

" LogResult "" LogResult "" } if {$debug >= 3} {puts "preC.2"} # Build a list of all course names. # This is necessary for an A-meet because the courses of previous days may have different names than the courses for # the current day. (We don't expect this, because "courses" will generally be actually classes. However, we need to be # prepared for the user building a course set which has this character.) # # While building this list, also initialize the NameFieldLenCN. # # First, the "Unknown" course set FullCourseNamesList {} lappend FullCourseNamesList "Unknown" set NameFieldLenCN("Unknown") $NameFieldLenDefault # Then, fill in the courses of the current event foreach coursename $CourseNames { lappend FullCourseNamesList $coursename set NameFieldLenCN($coursename) $NameFieldLenDefault } if {$debug >= 3} {puts "preC.3"} # Now, fill in any other courses from previous events not in the current event if {$AMeetMode} { # For an A-meet, we need to check through all other events which will appear in output columns, and add any courses not already in the list for {set col 0} {$col < $NumOutputColumns} {incr col} { if {$debug >= 3} {puts "col: $col"} foreach eventnum $OutputEvents($col) { if {$debug >= 3} {puts " eventnum: $eventnum"} # We will duplicate some effort here (already have the current event, and some events may occur multiple times), but it is a small loop foreach coursename $EvNCourseNames($eventnum) { if {$debug >= 3} {puts " coursename: $coursename"} if {[lsearch $FullCourseNamesList $coursename] == -1} { lappend FullCourseNamesList $coursename set NameFieldLenCN($coursename) $NameFieldLenDefault } } } } } if {$debug >= 3} {puts "preD"} # Build up various lists which sort into result order. Here are what the various lists are: # # FinishOrder($coursename) An index listing of all runners on the given course, sorted into finish order # FinishOrderElig($coursename) An index ..., for those runners with the "eligible" bit set, e.g. USChamps elig, etc # ElapsedTimes($coursename,$legnum) A listing of the times various people had for the elapsed time to a given leg # SplitTimes($coursename,$legnum) A listing of the times various people had for the split time for a given leg # Note: legnum 0 is the first leg. There is also a leg from last control to finish here. # ElapsedTimesElig(...) A listing of times for only those people who have the "eligible" bit set, e.g. USChamps elig, etc # CompWithNoDL($coursename) A list of all competitor idx who registered but we do not yet have a download for (i.e. still on course, DNS, ...) # # OutColPlace($coursename,$col) List of db indices, just like FinishOrder, but for the event(s) assocaited with the given $col of output # OutColTime($coursename,$col) List of finish times, like the last place of ElapsedTimes, but for the event(s) ... $col of output # # Note that these Elapsed/SplitTimes lists are a little odd. They are only the times; there is no record kept # of who the time belongs to. # However, we do not need that information; all that is important is where each time falls in the results, # e.g. time 3:45 is the third one in the list. Later, when we need to find out what place a particular runner # is in, we search the list for the first occurrance of their time, e.g. if George had a time of 3:45, we do a # search, find that time as the third element in the list, and know that he is in third place. (Remember that Tcl # numbers elements from 0, so 3:45 will show up with an index of 2 if it is the 3rd element in the list.) # if {$debug >= 3} {puts "A"} # Clear the sorted results lists foreach coursename $FullCourseNamesList { set CourseIndex [lsearch $CourseNames $coursename] if {$debug >= 3} {puts "coursename: $coursename CourseIndex: $CourseIndex"} set FinishOrder($coursename) {} ;# Index of runners on this course, sorted by final place set FinishOrderElig($coursename) {} ;# Index of runners on this course, sorted by final place, only those with special bit set set CompWithNoDL($coursename) {} ;# Index of registered competitors on the course, but who have no DL yet set EligCompWithNoDL($coursename) {} ;# Index of eligible competitors on the course, but who have no DL yet for {set col 0} {$col < $NumOutputColumns} {incr col} { if {$debug >= 3} {puts "col: $col"} set OutColPlace($coursename,$col) {} set OutColTime($coursename,$col) {} set OutColPlaceElig($coursename,$col) {} set OutColTimeElig($coursename,$col) {} } # Loop through the legs on this course (remembering to include the finish leg) if {$debug >= 3} {puts "A.0a"} if {$CourseIndex != -1} { for {set legnum 0} {$legnum <= [llength $CourseControls($CourseIndex)]} {incr legnum} { set ElapsedTimes($coursename,$legnum) {} set ElapsedTimesElig($coursename,$legnum) {} set SplitTimes($coursename,$legnum) {} } } } if {$debug >= 3} {puts "A.1"} # # # Go through every download result, and every registered competitor who has not downloaded, and build the times for each column of output # Also add each used index into the correct course results list (not yet sorted) # Determine all of the indices (positive and negative) into db for which output should be generated. # First, the normal downloads set OutputIdxs {} for {set index 1} {$index <= $NumEntries} {incr index} { if {[ShouldOutput $index]} { lappend OutputIdxs $index if {$AMeetMode && $db(Registered,$index)} { incr NumRegStartsTotal ;# Only increment this for the registered outputs. } } } set NumStartsTotal [llength $OutputIdxs] # Note: We will get a different answer to the "How many starts total" question depending on whether we are looking at the program screen while # running, or at the HTML output when at an A-meet. This is because non-registered starts will be included in the count on screen, but not in # the web output count. if {$debug >= 3} {puts "A.1b"} # Now, if this is an AMeet, the comps who haven't downloaded yet if {$AMeetMode} { for {set index -2} {$index >= $MaxCompIdx} {incr index -1} { if {[ShouldOutput $index]} { lappend OutputIdxs $index } } } if {$debug >= 3} {puts "A.1c"} foreach index $OutputIdxs { if {$debug >= 3} {puts " Index: $index"} GenerateFinalResult $index ;# This should produce the result output for this index for this event (i.e. Time, Time-since-start, DNF, OVT, user edit, etc) lappend FinishOrder($CourseName($db(Course,$index))) $index set db(CourseResults,$index) {} for {set col 0} {$col < $NumOutputColumns} {incr col} { # Figure out which courses this person needs a result line for (i.e. may have run Orange yesterday, and Yellow today, so they get a line in each). foreach event $OutputEvents($col) { # (We check each event for which a column of results is generated) if {$debug >= 3} {puts " col: $col, event: $event"} if {$event == $AMeetEvent} { # This is the current event; use the current guess for the course. if {$debug >= 3} { puts " $db(Course,$index)" puts " $CourseName($db(Course,$index))" puts " $db(CourseResults,$index)" puts " [lsearch {} "Red"]" set lsearchresult [lsearch $db(CourseResults,$index) $CourseName($db(Course,$index))] puts " lsearch result: $lsearchresult" } if {[info exists CourseName($db(Course,$index))] && $db(Course,$index) != -1 && [lsearch $db(CourseResults,$index) $CourseName($db(Course,$index))] == -1} { lappend db(CourseResults,$index) $CourseName($db(Course,$index)) } } else { # Was a previous event; look for it in Comp() if {[info exists Comp(ResultClass,$event,$db(Name,$index))] && ($Comp(ResultClass,$event,$db(Name,$index)) ne "") && \ [lsearch $db(CourseResults,$index) $Comp(ResultClass,$event,$db(Name,$index))] == -1} { # (We look at the class for which we have a result for that event) (... and don't already have a course listed as required) lappend db(CourseResults,$index) $Comp(ResultClass,$event,$db(Name,$index)) } } ;# if event == AMeetEvent # We might also include an entry for each class registered for, Comp(Class,$event,$db(Name,$index)) as well. } } ;# for col 0 to = 3} {puts "Setup pre. Index $index"} SetupOutputColResults $index ;# This routine will calculate the column results (time or some DNF variety) for each course, for each column of output if {$debug >= 3} {puts "Setup post."} # Now, make a second pass, and build each of the finish place lists in each of the needed courses # Also, handle the length of names (NameFieldLenCN) adjustments here. foreach course $db(CourseResults,$index) { for {set col 0} {$col < $NumOutputColumns} {incr col} { lappend OutColPlace($course,$col) $index lappend OutColTime($course,$col) $db(ColResult,$course,$col,$index) } ;# for col 0 to = 3} {puts "Entering str len NameFieldLenCN"} if {![info exists NameFieldLenCN($course)]} { # We shouldn't need this check, but leave it here anyway; it has caught at least one bug elsewhere. set NameFieldLenCN($course) $NameFieldLenDefault ErrorMsg "WARNING: NameFieldLenCN: Somehow missed Course: $course Index: $index Name: $db(Name,$index). CourseResults: '$db(CourseResults,$index)'" } if {[string length $db(Name,$index)] > $NameFieldLenCN($course)} { if {$debug >= 3} {puts "Inside str len NameFieldLenCN"} if {[string length $db(Name,$index)] <= $NameFieldLenMax} { if {$debug >= 3} {puts "Setting NameFieldLenCN a"} set NameFieldLenCN($course) [string length $db(Name,$index)] } else { if {$debug >= 3} {puts "Setting NameFieldLenCN b"} set NameFieldLenCN($course) $NameFieldLenMax } } ;# if (long name) } ;# foreach course if {[info exists Comp(Elig,$db(Name,$index))] && $Comp(Elig,$db(Name,$index))} { lappend FinishOrderElig($CourseName($db(Course,$index))) $index foreach course $db(CourseResults,$index) { for {set col 0} {$col < $NumOutputColumns} {incr col} { lappend OutColPlaceElig($course,$col) $index lappend OutColTimeElig($course,$col) $db(ColResult,$course,$col,$index) } } } # Obsolete. This is where this used to be calculated: # incr NumStartsTotal ;# Note: We also have starts below, derived from the Start box only # Thus, NumStartsTotal is downloads plus undownloaded comps. We always count registered comps as "starts" for these purposes. # Note: The check for whether to output or not used to be part of one giant loop. When that was split off, # we ended up with all of the relevant indices in OutputIdxs; we can just count the number of indices in that list for NumStartsTotal now. } if {$debug >= 3} {puts "A.1presort"} # Sort all of the output columns. Note that we will not necessarily use all of these; output results will be sorted by # the column chosen in the courses.txt file. We sort all of them in order to allow differentiation between "equal" results in the # sort column (e.g. different forms of DNF, no download, etc) using the sort result of a different column. SortOutputColLists if {$debug >= 3} {puts "A.1post"} # Debugging: Output the column info built so far if {$debug >= 2} { foreach index $OutputIdxs { foreach course $db(CourseResults,$index) { set Outstr [format "%3d %-20s" $index $db(Name,$index)] for {set col 0} {$col < $NumOutputColumns} {incr col} { set Outstr [format "%26s %2s %8s" $Outstr $db(ColPlace,$course,$col,$index) $db(ColResult,$course,$col,$index)] } puts "$Outstr" } } } if {$debug >= 3} {puts "A.2"} # Now, go through each leg of each course, adding to the Elapsed and Split Times lists. for {set CourseIndex 0} {$CourseIndex < $NumCourses} {incr CourseIndex} { set coursename $CourseName($CourseIndex) foreach index $FinishOrder($coursename) { # We aren't going through in sorted order yet (sort happens below), but we don't care at this point set legnum 0 foreach ElapsedTime $db(ElapsedTime,$index) SplitTime $db(SplitTime,$index) { # Note that there should be equal numbers of both elapsed and split times (for a given entry), # so one list won't run out before the other above lappend ElapsedTimes($coursename,$legnum) $ElapsedTime lappend SplitTimes($coursename,$legnum) $SplitTime incr legnum } ;# foreach Elap and Split } ;# foreach index on course # Now, do the same for the "elig" runners. # Don't bother with splits this time; since these are a subset of runners, their splits are already handled. foreach index $FinishOrderElig($coursename) { # We aren't going through in sorted order yet (sort happens below), but we don't care at this point set legnum 0 foreach ElapsedTime $db(ElapsedTime,$index) { lappend ElapsedTimesElig($coursename,$legnum) $ElapsedTime incr legnum } ;# foreach Elap } ;# foreach index on course (elig) } ;# for (loop by course) if {$debug >= 3} {puts "A.3"} # Now, sort the lists. Note that Course -1 (Unknown) is not sorted in any way. foreach coursename $FullCourseNamesList { set CourseIndex [lsearch $CourseNames $coursename] if {$CourseIndex != -1} { set FinishOrder($coursename) [lsort -command CompareResults $FinishOrder($coursename)] # Loop through the legs on this course (remembering to include the finish leg) for {set legnum 0} {$legnum <= [llength $CourseControls($CourseIndex)]} {incr legnum} { set ElapsedTimes($coursename,$legnum) [lsort -command TimeCompare $ElapsedTimes($coursename,$legnum)] set SplitTimes($coursename,$legnum) [lsort -command TimeCompare $SplitTimes($coursename,$legnum)] set ElapsedTimesElig($coursename,$legnum) [lsort -command TimeCompare $ElapsedTimesElig($coursename,$legnum)] } } } if {$debug >= 3} {puts "B"} # Now, make the lists for each course of competitors who have registered, but not downloaded yet foreach CompetitorName $Comps { if {$Comp(DBIdx,$CompetitorName) < 0} { lappend CompWithNoDL($Comp(Class,$AMeetEvent,$CompetitorName)) $Comp(DBIdx,$CompetitorName) # Modify the NameFieldLen, since these will appear in the output too AdjustNameFieldLen $Comp(DBIdx,$CompetitorName) # Also the elig list, if needed if {$Comp(Elig,$CompetitorName) == 1} { lappend EligCompWithNoDL($Comp(Class,$AMeetEvent,$CompetitorName)) $CompetitorName } } } if {$debug >= 3} {puts "C"} LogResult "" #LogResult "_________________________________________________________________________________" if {$OutputHTML} { # LogResult "Results" # New LogResult "
" LogResult "Results" if {$ShowLegend} { LogResult "
SS:  Time Since Start. Approximate time out on the course."
    LogResult "US:  Time Until Start. Approximate time until scheduled start.
" } if {$HTMLType == 1} { LogResult "
" } # New. } else { LogResult "_________________________________________________________________________________" LogResult "Results" } LogResult "" # Output results obtained from start/finish boxes #puts "Checking starts" if {$NumStartEntries > 0} { LogResult "" LogResult "Start box derived results (no full download):" } for {set i 0} {$i < $NumStartEntries} {incr i} { if {$sb(Use,$i) == 1} { LogResult [format " %8s %-*s %8s Start:%8s Finish:%8s" \ $sb(SICard,$i) $NameFieldLenMax $sb(Name,$i) $sb(TotalTime,$i) $sb(StartTime,$i) $sb(FinishTime,$i)] } # incr NumStartsTotal ;# These are in addition to normal entries, handled above. Obsolete. } #puts "Finished start/finish boxes." if {$debug >= 3} {puts "NumOutputColumns: $NumOutputColumns. UseOutputColumns: $UseOutputColumns($AMeetEvent)"} if {$debug >= 3} {puts "D"} # Loop over all courses. # Output the course name and other header information for this course. # Include "Unknown", for a place to put people who didn't punch very much. # foreach coursename $FullCourseNamesList { #for {set CourseIndex -1} {$CourseIndex < $NumCourses} {incr CourseIndex} if {$UseOutputColumns($AMeetEvent) == 0} { # Only outputting current event. This will be a local event style output. set CourseIndex [lsearch $CourseNames $coursename] if {$debug >= 3} {puts "E: Course Index $CourseIndex"} if {$CourseIndex == "-1"} { if {$FinishOrder($coursename) != {}} { LogResult "" LogResult [format "%s%s%s" $PreHTMLHeader "Unknown Course. Cannot guess course for the following runners:" $PostHTMLHeader] } else { # Don't output the "Unknown Course" heading if there are no unknowns. continue } } else { if {$debug >= 3} {puts "E.1"} if {$FinishOrder($coursename) != {} || $CompWithNoDL($coursename) != {}} { if {$debug >= 3} {puts "E.2"} # We only output headers for courses that someone was on, or if we have registered competitors on this course with no DL if {$OutputHTML} { if {$debug >= 3} {puts "E.3a"} LogResult "" if {$AMeetMode} { # We are mixing classes and courses here, so the word "Course:" looks strange. It looke better to just leave it out in this case. set WordCourse " " } else { set WordCourse "Course:" } switch $CourseType($CourseIndex) { 0 { LogResult [format "%s %s %d KP %s km" \ $CourseName($CourseIndex) $WordCourse [llength $CourseControls($CourseIndex)] $CourseLength($CourseIndex)] } 1 { LogResult [format "%s %s %d KP. Time Penalty: %s" \ $CourseName($CourseIndex) $WordCourse [llength $CourseControls($CourseIndex)] [PenaltyToText $CourseTimePenalty($CourseIndex)]] LogResult "" } } ;# switch LogResult "
"
          if {$CourseType($CourseIndex) == 1} {
                LogResult "    Pnts-Pnlt=Total   Time" 
            }
          # New.
          } else {
          if {$debug >= 3} {puts "E.3b"}
          LogResult ""
          switch $CourseType($CourseIndex) {
            0 { LogResult [format "%s Course: %d KP %s km " \
                  $CourseName($CourseIndex) [llength $CourseControls($CourseIndex)] $CourseLength($CourseIndex)] }
            1 { LogResult [format "%s Course: %d KP. Time Penalty: %s" \
                  $CourseName($CourseIndex) [llength $CourseControls($CourseIndex)] [PenaltyToText $CourseTimePenalty($CourseIndex)]] 
                LogResult ""
                LogResult "    Pnts-Pnlt=Total   Time" }
            } ;# switch
          }
        if {$debug >= 3} {puts "E.4"}
        LogResult ""
        if {$AMeetMode} {
          if {$debug >= 3} {puts "E.5"}
          # Also create course(class) header output for EventResultsAN.csv file
          lappend ResultCSVOutput [format ""]
          lappend ResultCSVOutput [format "%s" $CourseName($CourseIndex)]
          if {$debug >= 3} {puts "E.6"}
          if {$FinishOrderElig($coursename) != {} || $EligCompWithNoDL($coursename) != {}} {
            if {$debug >= 3} {puts "E.6a"}
            # Also create one for the Elig file
            lappend ResultECSVOutput [format ""]
            lappend ResultECSVOutput [format "%s" $CourseName($CourseIndex)]
            if {$debug >= 3} {puts "E.6b"}
            }
          if {$debug >= 3} {puts "E.7"}
          }
        } ;# if anyone on this course (or registered on this course)
      }
    # Now, print the entries (Place, name, and finish time) under this course
    #
    if {$debug >= 3} {puts "E.8"}
    foreach index $FinishOrder($coursename) {
      if {$debug >= 3} {puts "F: Index $index"}
      if {$CourseIndex == -1} {
        LogResult [format "       %-*s %s" $NameFieldLen($CourseIndex) $db(Name,$index) $db(RealPunches,$index) ] $index
        } elseif {$CourseType($CourseIndex) == 0} {
        # Normal Course
        if {![IsDNF $db(FinalResult,$index)]} {
          # Finished
          if {$debug >= 3} {puts "F.1"}
          set PlaceNum [expr {[lsearch $ElapsedTimes($coursename,[llength $CourseControls($CourseIndex)]) \
             $db(FinalResult,$index)] + 1}]
          set PlaceNumCSV $PlaceNum
          set PlaceNumElig [expr {[lsearch $ElapsedTimesElig($coursename,[llength $CourseControls($CourseIndex)]) \
             $db(FinalResult,$index)] + 1}] ;# Note: This will be 0 if not elig.
          set PlaceNumEligCSV $PlaceNumElig
          if {$PlaceNumElig == 0} {
            ;# if 0, this means they weren't in the list, and probably aren't eligible
            set PlaceNumElig ""
            set PlaceNumEligCSV " "
            }
          if {$debug >= 3} {puts "F.2"}
          set ResultString $db(FinalResult,$index)
          set ResultStringCSV $db(FinalResult,$index)
          if {$OutputRealPunches == 1} {
            set RealPunchesString $db(RealPunches,$index)
            } else {
            set RealPunchesString ""
            }
          if {$debug >= 3} {puts "F.3"}
          } else {
          # Didn't finish
          set PlaceNum ""
          set PlaceNumElig ""
          set ResultString [format "%8s" $db(FinalResult,$index)]	;# Was just: "     DNF"
          set PlaceNumCSV "-"
          set PlaceNumEligCSV "-"
          set ResultStringCSV $db(FinalResult,$index)
          if {$OutputRealPunches == 1} {
            set RealPunchesString $db(RealPunches,$index)
            } else {
            set RealPunchesString ""
            }
          } ;# if Finished,$index
      if {$debug >= 3} {puts "F.4"}
        if {$FinishOrderElig($coursename) == {}} {
          # No elig runners on this course. Don't include the elig place
          LogResult [format "   %3s %-*s %s     %s" $PlaceNum $NameFieldLen($CourseIndex) $db(Name,$index) $ResultString $RealPunchesString] $index
          } else {
          LogResult [format "%3s%3s %-*s %s     %s" $PlaceNumElig $PlaceNum $NameFieldLen($CourseIndex) $db(Name,$index) $ResultString $RealPunchesString] $index
          }
        if {$debug >= 3} {puts "F.5"}
        if {$AMeetMode && $db(Registered,$index)} {
          # Output for EventResults(A/E)N.csv file
          set Comp(ResultPlace,$AMeetEvent,$db(Name,$index)) $PlaceNumCSV
          set Comp(ResultTime,$AMeetEvent,$db(Name,$index))  $ResultStringCSV
          set Comp(ResultClass,$AMeetEvent,$db(Name,$index)) $CourseName($CourseIndex)
          set Comp(ResultClassIdx,$AMeetEvent,$db(Name,$index)) $CourseIndex
          lappend ResultCSVOutput [format "%s,%s,%s,%s" $PlaceNumCSV $db(Name,$index) $Comp(Club,$db(Name,$index)) $ResultStringCSV]
          if {$Comp(Elig,$db(Name,$index))} {
            set Comp(ResultEPlace,$AMeetEvent,$db(Name,$index)) $PlaceNumEligCSV
            lappend ResultECSVOutput [format "%s,%s,%s,%s" $PlaceNumEligCSV $db(Name,$index) $Comp(Club,$db(Name,$index)) $ResultStringCSV]
            } ;# if elig
          } ;# if registered ameet
        if {$debug >= 3} {puts "F.6"}
        } elseif {$CourseType($CourseIndex) == 1} {
        # Score-O
        set PlaceNum [expr {[lsearch $FinishOrder($coursename) $index] + 1}]
        set RealPunchesString $db(RealPunches,$index)
        LogResult [format "%3s %4s %4s %4s %s %-*s %s" $PlaceNum  [ScorePoints $index] [ScorePenalty $index] [ScoreTotal $index] \
           $db(TotalTime,$index) $NameFieldLen($CourseIndex) $db(Name,$index) $RealPunchesString] $index
        } ;# if (course type...)
      if {$debug >= 3} {puts "F.7"}
      } ;# foreach index
      # New
    if {$debug >= 3} {puts "G"}
    # Now output any registered competitors who have not yet downloaded
    #
    foreach index $CompWithNoDL($coursename) {
      if {$FinishOrderElig($coursename) == {}} {
        # No elig runners on this course. Use the plain spaced version
        LogResult [format " No DL %-*s  %s" $NameFieldLen($CourseIndex) $db(Name,$index) $db(FinalResult,$index)]
        } else {
        # Need space for the elig place (so that names will align)
        LogResult [format " No DL %-*s  %s" $NameFieldLen($CourseIndex) $db(Name,$index) $db(FinalResult,$index)]
        }
      } ;# foreach index $CompWithNoDL
    if {$OutputHTML && $FinishOrder($coursename) != {}} {
      LogResult "
" } # New. } else { # There are multiple output columns. This will be a multi-column, A-meet style output if {$debug >= 3} {puts "Calling OutputResultsForCourse"} OutputResultsForCourse $coursename } ;# if UseOutputColumns == 0 ... } ;# for CourseIndex looping over all courses including Unknown if {$debug >= 3} {puts "H"} LogResult "" if { !($AMeetMode && $OutputHTML) } { LogResult [format "Total of %d starts." $NumStartsTotal] } if {$NumRegStartsTotal > 0} { LogResult [format "Total of %d registered starts." $NumRegStartsTotal] } if {$debug >= 3} {puts "H1"} if {$HTMLType == 1 && $OutputHTML} { LogResult "
" ;# Turn off multicol } if {$debug >= 3} {puts "H2"} LogResult "" if {$OutputHTML} { LogResult "
" LogResult "Splits" if {$HTMLType == 1} { LogResult "

" } } else { LogResult "_________________________________________________________________________________" LogResult "Splits" } LogResult "" if {$debug >= 3} {puts "H3"} if {1} { # Loop over all courses a second time. Now outputting the detailed splits results. Skip "Unknown" this time. for {set CourseIndex 0} {$CourseIndex < $NumCourses} {incr CourseIndex} { set coursename $CourseName($CourseIndex) if {$FinishOrder($coursename) != {}} { # We only output headers for courses that someone was on LogResult "" if {$OutputHTML} { switch $CourseType($CourseIndex) { 0 { LogResult [format "%s Course: %d KP %s km" \ $CourseName($CourseIndex) [llength $CourseControls($CourseIndex)] $CourseLength($CourseIndex)] LogResult "
" }
        1 { LogResult [format "%s Course." \
                 $CourseName($CourseIndex)]
            LogResult "
" }
        }
      } else {
      switch $CourseType($CourseIndex) {
        0 { LogResult [format "%s Course: %d KP %s km " \
                 $CourseName($CourseIndex) [llength $CourseControls($CourseIndex)] $CourseLength($CourseIndex)] }
        1 { LogResult [format "%s Course. " \
                 $CourseName($CourseIndex)] }
        }
      }
    LogResult ""
    # Print header: Name Result Start 1.(CN1) 2.(CN2) ... N.(CNN) Finish
    switch $CourseType($CourseIndex) {
      0 { set HeaderStr [format "  # %-*s   Result   Start   " $NameFieldLen($CourseIndex) Name]
          for {set i 0} {$i < [llength $CourseControls($CourseIndex)]} {incr i} {
            append HeaderStr [format " %2s.(%3s) " [expr {$i + 1}] [lindex $CourseControls($CourseIndex) $i] ]
            }
          append HeaderStr "  Finish.           min/km" }
      1 { set HeaderStr [format "  # %-*s    Time    Start   " $NameFieldLen($CourseIndex) Name] }
      }
    LogResult $HeaderStr
    }
  # Now, print the entries, with detailed split information, under this course
  foreach index $FinishOrder($coursename) {
    if {$CourseType($CourseIndex) == 0} {
      #
      # Normal course splits
      #
      if {![IsDNF $db(FinalResult,$index)]} {
        set PlaceNum [expr {[lsearch $ElapsedTimes($coursename,[llength $CourseControls($CourseIndex)]) \
           $db(FinalResult,$index)] + 1}]
        set ResultString $db(FinalResult,$index)
        } else {
        set PlaceNum ""
        set ResultString $db(FinalResult,$index)
        }
      # First, the elapsed line --------------------------
      set OutStr [format "%3s %-*s %8s %8s " $PlaceNum $NameFieldLen($CourseIndex) $db(Name,$index) $ResultString $db(StartTime,$index)]
      set legnum 0
      foreach ElapTime $db(ElapsedTime,$index) {
        set ElapPlace [expr {[lsearch $ElapsedTimes($coursename,$legnum) $ElapTime] + 1}]
        if {$ElapTime eq "Throw" || $ElapTime eq "Skip" || $ElapTime eq "----" || $ElapTime eq ""} {set ElapPlace ""}
        append OutStr [format "%7s%3s" [TimeToShortTime $ElapTime] $ElapPlace]
        incr legnum
        }
      if {![IsDNF $db(FinalResult,$index)]} {
        append OutStr [format "%8s" $db(FinalResult,$index)]	;# Was ... [format "%8s" $ElapTime]
        }
      # Work out min/km, if possible
      set CLen $CourseLength($db(Course,$index))
      if {![IsDNF $db(FinalResult,$index)] && $CLen != "" && $CLen != 0} {
        append OutStr [format "   %6.2f" [expr ([TimeToSec $db(FinalResult,$index)]/60.0) / $CLen]]
        }
      LogResult $OutStr $index
      # Second, the splits line --------------------------
      set OutStr [format "%*s" [expr {$NameFieldLen($CourseIndex) + 23}] " "]	;# Just a convenient way to get a bunch of spaces
      set legnum 0
      foreach SplitTime $db(SplitTime,$index) {
        set SplitPlace [expr {[lsearch $SplitTimes($coursename,$legnum) $SplitTime] + 1}]
        if {$SplitTime eq "Throw" || $SplitTime eq "Skip" || $SplitTime eq "----" || $SplitTime eq ""} {set SplitPlace ""}
        append OutStr [format "%7s%3s" [TimeToShortTime $SplitTime] $SplitPlace]
        incr legnum
        }
      LogResult $OutStr $index
      # Third, the split delta line ----------------------
      set OutStr [format "%*s" [expr {$NameFieldLen($CourseIndex) + 23}] " "]	;# Just a convenient way to get a bunch of spaces
      set legnum 0
      foreach SplitTime $db(SplitTime,$index) {
        set SplitDelta [TimeSubtract $SplitTime [lindex $SplitTimes($coursename,$legnum) 0]]
        append OutStr [format "%7s%3s" [TimeToShortTime $SplitDelta] ""]
        incr legnum
        }
      LogResult $OutStr $index
      } elseif {$CourseType($CourseIndex) == 1} {
      #
      # Score-O splits
      #
#if {$debug >= 3} {puts "splitsA"}
      set PlaceNum [expr {[lsearch $FinishOrder($coursename) $index] + 1}]
      set ResultString $db(TotalTime,$index)
      # First, we output the controls punched line, for each person (since their ScoreO punches will likely all be differently ordered)
      set OutStr [format "%3s %-*s %8s %8s " $PlaceNum $NameFieldLen($CourseIndex) $db(Name,$index) $ResultString $db(StartTime,$index)]
      set ScoredAlready {}
      set CumulativeScore 0
#if {$debug >= 3} {puts "splitsB"}
      foreach ControlPunch $db(RealPunches,$index) {
#if {$debug >= 3} {puts "splitsC. Control $ControlPunch"}
        if {[lsearch $ScoredAlready $ControlPunch] == -1} {
          # Only score each control once (i.e. ignore subsequent punches of the same control)
          set ThisValue [ValueOfControl $ControlPunch $CourseIndex]
          lappend ScoredAlready $ControlPunch
          } else {
          set ThisValue 0
          }
        incr CumulativeScore $ThisValue		;# We don't use this yet, but it might be worth squeezing into the output some time
        append OutStr [format " %2s(%2s)   " $ControlPunch $ThisValue]
#if {$debug >= 3} {puts "splitsZ"}
        }
      if {$db(Finished,$index)} {
        append OutStr [format " Finish"]
        }
      LogResult $OutStr $index
      # Second, the elapsed line --------------------------
      set OutStr [format "%*s" [expr {$NameFieldLen($CourseIndex) + 23}] " "]	;# Just a convenient way to get a bunch of spaces
      set legnum 0
      foreach ElapTime $db(ElapsedTime,$index) {
        set ElapPlace ""
        if {$ElapTime eq "Throw" || $ElapTime eq "Skip" || $ElapTime eq "----" || $ElapTime eq ""} {set ElapPlace ""}
        append OutStr [format "%7s%3s" [TimeToShortTime $ElapTime] $ElapPlace]
        incr legnum
        }
#      if {$db(Finished,$index)} {
#        append OutStr [format "%8s" $ElapTime]
#        }
      LogResult $OutStr $index
      # Third, the splits line --------------------------
      set OutStr [format "%*s" [expr {$NameFieldLen($CourseIndex) + 23}] " "]	;# Just a convenient way to get a bunch of spaces
      set legnum 0
      foreach SplitTime $db(SplitTime,$index) {
        set SplitPlace ""
        if {$SplitTime eq "Throw" || $SplitTime eq "Skip" || $SplitTime eq "----" || $SplitTime eq ""} {set SplitPlace ""}
        append OutStr [format "%7s%3s" [TimeToShortTime $SplitTime] $SplitPlace]
        incr legnum
        }
      LogResult $OutStr $index
      } ;# Score-O splits
    } ;# foreach index on the course
    # New
    if {$OutputHTML && $FinishOrder($coursename) != {}} {
      LogResult "
"
      }
    # New. 
  } ;# for CourseIndex looping over all courses (except Unknown)
} ;# if {debug}

if {$OutputHTML} {
  LogResult ""
#  LogResult "
" LogResult "" LogResult "" } if {$LiveUpdates && $OutputHTML } { # Need to automatically write this web version to disk SaveResultsToFile } if {$ResultCSVOutput != {}} { .buttonrow2.writecsv configure -text "Write CSV Results" } HighlightAllLinesForEntry $EditIdx $rbox } #------------------------------------------------------------------------------------------------------ # # # Can ignore this section. This is where I was originally working out how to do results, most of # which eventually got changed to something else (the "possibly easier" part in the middle, if you care). # #forget recalc above. instead: # #Variables: #ElapsedOrder(coursenum,legnum) List of runnerindexes, in the order that they were at that elapsed time, # i.e. as of control number legnum. Note for maxleg+1 this will be the # final results ordering #SplitsOrder(coursenum,legnum) List of runnerindexes, in order that they finished the given split # #ElapsedPlaces(coursenum,legnum) List of place for runner by index into this and Elapsed/SplitOrder above # e.g. if ElapsedOrder() list is {5 3 4 7} and ElapsedPlaces() is {1 2 2 4}, # then 5 was in first place, 3 and 4 tied for second, and 7 was in fourth. #SplitsPlaces(coursenum,legnum) # # Possibly easier: # ElapsedTimes(coursenum,legnum) List of all elapsed times, sorted in order # When used, just search for the first match to own elapsed time for place number. # SplitTimes(coursenum,legnum) # # If a runner leaves a course (i.e. course is changed), remove their elapsed and split times from the lists. # It doesn't matter if there is a tie; just remove one time that matches theirs, and leave the rest sorted. # If generating and sorting these lists at results calc time, don't even need to do that much. # # #Procedures: #CalcSplits Given a runner with a course and the real punch times, determine elapsed and split times per leg # Call CalcSplits after calling GuessCourse or SetCourse # db(Elapsed,$index) The elapsed list # db(Splits,$index) The splits list #CalcRealPunches Arguments: runnerindex, course (can't use db(Course,index) if using from inside GuessCourse) # Take code from GuessCourse, move to individual procedure # #Insert and Delete to ElapsedOrder and SplitsOrder lists #Only two functions, InsertOrderList and DeleteOrderList; will handle both Elapsed and Splits lists #Hand it a runnerindex, it will determine the relevant course from db(..,runnerindex), then #carry out the insertion or deletion # #for SetCourse, then: #proc SetCourse {runnerindex,coursenum} #See if course is already set # If so, then DeleteOrderList runnerindex #set db(Course,runnerindex) coursenum #CalcRealPunches runnerindex #CalcSplits runnerindex #InsertOrderList runnerindex #------------------------------------------------------------------------------------------------------ # ToggleHTML # proc ToggleHTML {} { global OutputHTML if {$OutputHTML} { set OutputHTML 0 .buttonrow.html configure -text "Turn HTML On" } else { set OutputHTML 1 .buttonrow.html configure -text "Turn HTML Off" } CalcResults } #------------------------------------------------------------------------------------------------------ # Editing # proc UpdateEditIdxOutput {} { # Handle the updating of the edit line area. # This routine assumes that the EditIdx (global) is already set properly. global db CourseName EditIdx global CurrentEditName CurrentEditSICard CurrentEditStartTime CurrentEditEditResult CurrentEditFinishTime global CurrentEditTotalTime CurrentEditResult CurrentEditFinalResult global CurrentEditPunches global OvertimeLimit global AMeetMode if {$EditIdx != -1} { set Name $db(Name,$EditIdx) if {!$AMeetMode} { set CurrentEditSICard "SICard: $db(SICard,$EditIdx)" } else { if {$db(Registered,$EditIdx)} { set CurrentEditSICard "SICard: $db(SICard,$EditIdx) (Reg)" } else { set CurrentEditSICard "SICard: $db(SICard,$EditIdx) (NotReg)" } } set CurrentEditStartTime "St: $db(StartTime,$EditIdx)" set CurrentEditFinishTime "Fi: $db(FinishTime,$EditIdx)" if {!($db(Finished,$EditIdx) && [TimeCompare $OvertimeLimit $db(TotalTime,$EditIdx)] == -1)} { set CurrentEditTotalTime "Total: $db(TotalTime,$EditIdx)" } else { set CurrentEditTotalTime "Total: $db(TotalTime,$EditIdx) (OVT)" } set CurrentEditPunches "Real Punches: $db(RealPunches,$EditIdx)" if {$db(Finished,$EditIdx)} { set CurrentEditResult "Finished" } else { set CurrentEditResult "DNF" } if {$db(EditResult,$EditIdx) ne ""} { set CurrentEditEditResult "Edit: $db(EditResult,$EditIdx)" } else { set CurrentEditEditResult "" } set CurrentEditFinalResult "Final Result: $db(FinalResult,$EditIdx)" } else { set Name "(blank line)" set CurrentEditSICard "" set CurrentEditStartTime "" set CurrentEditFinishTime "" set CurrentEditTotalTime "" set CurrentEditResult "" set CurrentEditEditResult "" set CurrentEditFinalResult "" set CurrentEditPunches "" } #puts "Selected line for $EditIdx $Name" set CurrentEditName $Name if {$EditIdx != -1} { if {$db(Use,$EditIdx) != 0} { # i.e. we are using this entry. Give a delete button .editbox.remove configure -text "Delete" } else { # already not using this one. Give an un-delete button .editbox.remove configure -text "Undelete" } .editbox.coursemenu configure -text $CourseName($db(Course,$EditIdx)) } else { .editbox.coursemenu configure -text " " .editbox.remove configure -text " " } } proc ActivateSelectedLine {alist} { global db ridxref SelectedLine CourseName EditIdx global CurrentEditName CurrentEditSICard CurrentEditStartTime CurrentEditEditResult CurrentEditFinishTime global CurrentEditTotalTime CurrentEditResult CurrentEditFinalResult global CurrentEditPunches global OvertimeLimit global alistSave set SelectedLine [$alist curselection] # puts "Activate: $SelectedLine" if {$SelectedLine eq ""} { return } if {$SelectedLine > [llength $ridxref]} { # Clicked in window in region outside of data (i.e. past the end of the list). Just return. return } set EditIdx [lindex $ridxref $SelectedLine] UpdateEditIdxOutput HighlightAllLinesForEntry $EditIdx $alist # As we leave here, the global EditIdx is remembered. # This is the index of the entry that we have currently selected (or -1, if a "blank line") } proc HighlightAllLinesForEntry {HighlightIdx alist} { global ridxref # Highlight all lines associated with the given line # (unless the given line is "blank", i.e. a header or such) $alist selection clear 0 end if {$HighlightIdx != -1} { set i 0 foreach idx $ridxref { if {$idx == $HighlightIdx} { $alist selection set $i } incr i } } } proc HandleEditName {} { global db Comp Comps EditIdx CurrentEditName global NumEntries MaxCompIdx global debug if {$debug >= 3} {puts "In HandleEditName"} if {$EditIdx != -1} { set oldname $db(Name,$EditIdx) set newname $CurrentEditName ;# This isn't needed, but makes the other parts of this routine more clear set db(Name,$EditIdx) $CurrentEditName ErrorMsg "Changing name ($EditIdx) $db(SICard,$EditIdx) $oldname to $db(Name,$EditIdx)" AdjustNameFieldLen $EditIdx ;# Note: We will adjust upward, but not downward. Would have to loop through the course to catch that case. } # There are several possibilities to handle. # 1) We are changing the name away from someone who is registered. We will have to disconnect this db entry away from the Comp entry. # 2) We are changing the name to someone who registered. Make certain we don't already have a connection from Comp to some positive db entry, then connect. # Will also want to GuessCourse/FindCorrectPunches in both cases, since the default course is different for Comp vs non-reg. # First, check whether we are changing name away from a registered Comp entry if {$db(Registered,$EditIdx)} { if {$debug >= 3} {puts "HEN: 1a"} if {$debug >= 3} {puts "Comp(DBIdx): $Comp(DBIdx,$oldname), EditIdx: $EditIdx, Name: $oldname"} if {$Comp(DBIdx,$oldname) eq $EditIdx} { # That Comp entry needs to be pointed away from this db entry now DisconnectCompFromDB $oldname $EditIdx # Also, need to clear the db entry (we may be setting it back to another Comp later, though) set db(Registered,$EditIdx) 0 if {$debug >= 3} {puts "HEN: 1b"} } } # Now, check whether we are changing name to a registered Comp entry if {[lsearch $Comps $newname] != -1} { # The new name is the same as a registered entry in Comp # First, make certain we don't already have Comp(newname) pointing to a real download. If so, disconnect it and use this edit index. if {$Comp(DBIdx,$newname) > 0} { ErrorMsg "Changing to a name already in use. Using the new name for Comp connection." DisconnectCompFromDB $newname $Comp(DBIdx,$newname) set Comp(DBIdx,$newname) $EditIdx GuessCourse $EditIdx if {$debug >= 3} {puts "HEN: 2"} } } if {$debug >= 3} {puts "End of HandleEditName"} CalcResults } proc HandleEditResult {} { global db EditIdx CurrentEditEdit global alistSave if {$EditIdx != -1} { if {[IsTime $CurrentEditEdit] || [IsDNF $CurrentEditEdit]} { set db(EditResult,$EditIdx) $CurrentEditEdit ErrorMsg "Setting Edit Result for $db(Name,$EditIdx) ($EditIdx): $CurrentEditEdit" } else { ErrorMsg "ERROR: Edit Result rejected. $CurrentEditEdit is neither a time nor a valid DNF result." } } FindCorrectPunches $EditIdx ;# This might be necessary to fix Elapsed/Split times adjusted from a previous edit, so we do it here. CalcResults UpdateEditIdxOutput } proc BuildCourseEditMenu {courses} { global EditCourseMenu # Argument (courses) should be a list of course names, exactly as they appear in CourseNames # # First, clear the old menu $EditCourseMenu delete 0 end # Now, make a new menu entry for each element of $courses foreach course $courses { set cmd [list HandleEditCourse $course] $EditCourseMenu add command -label $course -command $cmd } } proc HandleEditCourse {tocourse} { global db ridxref SelectedLine CourseNames CourseName EditIdx # When this proc is called, the currently selected entry will be changed to course $tocourse if {$EditIdx != -1} { set CourseIdx [lsearch $CourseNames $tocourse] set db(Course,$EditIdx) $CourseIdx FindCorrectPunches $EditIdx ErrorMsg "Changing course of ($EditIdx) $db(SICard,$EditIdx) $db(Name,$EditIdx) to $CourseName($CourseIdx)" .editbox.coursemenu configure -text $CourseName($db(Course,$EditIdx)) AdjustNameFieldLen $EditIdx ;# Note: We will adjust upward, but not downward. Would have to loop through the course to catch that case. } CalcResults } proc HandleEditDelete {} { global db ridxref SelectedLine EditIdx # Procedure is slightly misnamed. Actually is a toggle delete. # i.e. we will undelete a deleted entry, or delete an undeleted entry. if {$EditIdx != -1} { if {$db(Use,$EditIdx) != 0} { # Is in use. Delete it. set db(Use,$EditIdx) 0 ErrorMsg "Removing ($EditIdx) $db(SICard,$EditIdx) $db(Name,$EditIdx) from results. " # Toggle the name of the button .editbox.remove configure -text "Undelete" } else { # Is not in use. Undelete it. set db(Use,$EditIdx) 1 ErrorMsg "Undeleting ($EditIdx) $db(SICard,$EditIdx) $db(Name,$EditIdx). " # Toggle the name of the button .editbox.remove configure -text "Delete" } } CalcResults } proc HandleChangeHTMLTitle {} { # The actual change occurs in the widgit with textvariable HTMLTitle. # That, in turn, calls here to make sure we handle any details required once the title is changed. CalcResults } proc FixKludge {} { global db # Fix Ruth Bromer's course for Lapihio event set db(Course,53) 3 CalcResults } proc DoSpecial {} { global db EditCourseMenu puts "Hit special." $EditCourseMenu delete 0 1 $EditCourseMenu add command -label NewLine1 -command {puts "Hit new line 1"} $EditCourseMenu add command -label NewLine2 -command {puts "Hit new line 2"} } #------------------------------------------------------------------------------------------------------ # Output results to file # proc SaveResultsToFile {} { global resultslist workingdir weboutputdir DefaultOutputFilename global OutputHTML DefaultOutputHTMLFilename LiveUpdates global DoRsync global debug if {$OutputHTML} { set outfilename $DefaultOutputHTMLFilename } else { set outfilename $DefaultOutputFilename } # Under normal conditions, open a file requester with the default already set. # However, under live update conditions, and outputing html, just automatically write to the default name if {$LiveUpdates && $OutputHTML && $weboutputdir ne ""} { # We are in live update mode. Don't give a requestor, just construct the filename from the default and web output directory # Note: We do not autowrite a .txt output when in live update mode, only the html # Have to check if a weboutput directory is set first, since we need that to construct the full path to our save file; # if no weboutput directory, make them use the file selector anyway. set outfilename [file join $weboutputdir $outfilename] } elseif {$LiveUpdates && $OutputHTML} { # We are in live update mode, but we don't have a web output directory. Generate, and save, one. set weboutputdir [tk_chooseDirectory] set outfilename [file join $weboutputdir $outfilename] } else { # The normal case. Give a requestor with a reasonable default. set outfilename [tk_getSaveFile -initialfile [file tail $outfilename] -initialdir $workingdir] } if [catch {open $outfilename w} outfile] { puts stderr "File opening error on write." ErrorMsg "File opening error on write." return } foreach line $resultslist { puts $outfile $line } close $outfile if {$DoRsync && $LiveUpdates && $OutputHTML} { # execute an rsync command to move the web output to an appropriate web server. # This needs to be hand coded here to choose an appropriate rsync command. # Here is some test code from another time. #set fileencoding macRoman #set infilename1 [file join . t1.txt] #set infilename2 [file join . t2.txt] #exec cat $infilename1 $infilename2 > t3.txt 2> /dev/null if {$debug >= 2} {puts "Update. rsync."} catch {exec rsync /Users/terese/Ken./Orienteering/OResults/120310AMeetBirkhead/Results.html \ rsync://192.168.99.99/day2/ 2> /dev/null} result # This is set up to use an rsync server, with day1/ and day2/ defined to deliver the file to the appropriate location if {$debug >= 1 && $result ne ""} {puts "rsync result: $result"} if {$debug >= 2} {puts "Done rsync."} } } #------------------------------------------------------------------------------------------------------ # Logging lines into the results window # proc ClearResultsAndRaw {} { global resultslist ridxref rawoutlist rawidxref # Note: This function doesn't clear the image in the window; that would be handled # automatically by just clearing the resultslist variable. Instead, what this does is # to clear all the variables associated with holding result output, including the "raw" output. # Use this routine to prepare to read a new results file, completely clearing the previous inputs. set resultslist {} set rawoutlist {} set ridxref {} set rawidxref {} } proc ClearResults {} { global resultslist ridxref rawoutlist rawidxref # Clear the results output. Do not include the raw output in the results, but do not # delete the raw output either. # Expect to use thie routine to toggle the raw output off (but leave it in order to toggle # back on at a later time). set resultslist {} set ridxref {} } proc ClearResultsToRaw {} { global resultslist ridxref rawoutlist rawidxref # Clear the current detailed results output, leaving only the "raw" output at the top. # Use this routine to clear the output in preparation for a new clean results calculation. set resultslist $rawoutlist set ridxref $rawidxref } proc LogResult {msg {index "-1"}} { global resultslist ridxref # Put a line into the results output. # Note that each line in the results output will be associated with some # entry index (blank lines, headers, etc will reference -1, the null entry), so # that on clicking into the results window it will be possible, from the line # clicked on, to look up what index this line refers to, and thus know what # entry is to be edited. This proc keeps track of these line index references. # As a result, it will be a "bad idea" to simply add lines to the resultslist # manually. # Keep this next line here; useful for debugging. #puts "$msg" lappend resultslist $msg lappend ridxref $index } proc LogRawResult {msg {index "-1"}} { global resultslist ridxref rawoutlist rawidxref # Log into the results window, but also save as "raw results". # The "raw" section is used mostly for debugging. # Keep this next line here; useful for debugging. #puts "$msg" lappend rawoutlist $msg lappend rawidxref $index LogResult $msg $index } #------------------------------------------------------------------------------------------------------ # Error Messages, Warnings, etc # proc ErrorMsg { {msg ""} } { global errormessage errorlist ebox # Output a message into the error listbox. # Used for errors and various warnings. #set errormessage $msg lappend errorlist $msg # Now scroll so that the end of the log error log is visible # (otherwise, we tend to see the old messages, not the new) $ebox see end } proc DelayedErrorMsg {index msg} { global db if {![info exists db(DelayedWarnings,$index)]} { set db(DelayedWarnings,$index) {} } lappend db(DelayedWarnings,$index) $msg } proc OutputDelayedWarnings {} { global db NumEntries # Output delayed warnings to ErrorMsg log # Loop through all entries, looking for any delayed warnings on entries that are still in use. for {set index 1} {$index <= $NumEntries} {incr index} { if {[info exists db(Dup,$index)]} { if {!$db(Dup,$index)} { if {[info exists db(DelayedWarnings,$index)]} { foreach warning $db(DelayedWarnings,$index) { ErrorMsg $warning } set db(DelayedWarnings,$index) {} ;# Clear the warnings. } } } } } #------------------------------------------------------------------------------------------------------ # Some button handlers # proc ToggleLiveUpdatesMode {} { global LiveUpdates if {$LiveUpdates} { # Currently in live updates mode. Turn it off. .buttonrow2.toggleliveupdatesmode configure -text "Turn on Live Updates" ExitLiveUpdatesMode } else { # Currently not in live updates mode. Turn it on. .buttonrow2.toggleliveupdatesmode configure -text "Turn off Live Updates" EnterLiveUpdatesMode } } #------------------------------------------------------------------------------------------------------ # Quit # proc HandleQuit {} { # Include any user protections we want ("Do you really want to quit", "Save first?", etc # TODO: No protections coded at this time. CloseNewDLSocket ;# We check in that routine whether the socket really exists # OK ... really quit now exit } #------------------------------------------------------------------------------------------------------ # Main section # # Main window title set windowtitle "SIDResults v$SIDRVersion" wm title . $windowtitle # The display will contain the following regions: # # .buttonrow A row of control buttons # .finfolines A set of lines containing info about what files are being used # (input files, defaults chosen, etc) # .errorline A line for outputting error and warning messages # .editrow A row with boxes for "line editing" a selected line from output # .resultsbox The main output region; a scrollable listbox containing the results # output as it currently appears # Set up the control area (the button row) frame .buttonrow -borderwidth 5 pack .buttonrow -side top -fill x button .buttonrow.setworkdir -text "Set Work Dir" -command SetWorkingDirectory button .buttonrow.setraw -text "Set Raw Datafile" -command ReadRawData button .buttonrow.setcoursefile -text "Set Course File" -command ReadCourses button .buttonrow.readappend -text "Read Append" -command ReadRawDataForAppend button .buttonrow.html -text "Turn HTML On" -command ToggleHTML button .buttonrow.output -text "Save Results" -command SaveResultsToFile button .buttonrow.quit -text Quit -command HandleQuit # Pack the buttons pack .buttonrow.setworkdir .buttonrow.setraw .buttonrow.setcoursefile .buttonrow.readappend -side left pack .buttonrow.quit .buttonrow.output .buttonrow.html -side right # A second button row frame .buttonrow2 -borderwidth 5 pack .buttonrow2 -side top -fill x button .buttonrow2.toggleliveupdatesmode -text "Turn on Live Updates" -command ToggleLiveUpdatesMode button .buttonrow2.checkfordl -text "Check" -command LookForNewDownloads button .buttonrow2.readappend -text "Read Append" -command ReadRawDataForAppend button .buttonrow2.writecsv -text "" -command WriteEventResultsCSV button .buttonrow2.readcsv -text "Read CSV Results" -command LookForEventResultsFiles # Pack the buttons pack .buttonrow2.toggleliveupdatesmode .buttonrow2.checkfordl .buttonrow2.readappend -side left pack .buttonrow2.readcsv .buttonrow2.writecsv -side right # Set up the file info lines if {$PutFileNamesOnScreen} { frame .finfolines pack .finfolines -side top -fill x frame .finfolines.wdir frame .finfolines.rawfile frame .finfolines.courses frame .finfolines.htmltitle pack .finfolines.wdir .finfolines.rawfile .finfolines.courses .finfolines.htmltitle -side top -fill x set flabelwidth 12 label .finfolines.wdir.label -width $flabelwidth -justify left -text "Working Dir: " label .finfolines.wdir.val -textvariable workingdir pack .finfolines.wdir.label .finfolines.wdir.val -side left label .finfolines.rawfile.label -width $flabelwidth -justify left -text "Raw File: " label .finfolines.rawfile.val -textvariable rawdatafilename pack .finfolines.rawfile.label .finfolines.rawfile.val -side left label .finfolines.courses.label -width $flabelwidth -justify left -text "Course Desc File: " label .finfolines.courses.val -textvariable coursefilename pack .finfolines.courses.label .finfolines.courses.val -side left label .finfolines.htmltitle.label -width $flabelwidth -justify left -text "HTML Page Title: " entry .finfolines.htmltitle.val -textvariable HTMLTitle -width 28 bind .finfolines.htmltitle.val HandleChangeHTMLTitle pack .finfolines.htmltitle.label .finfolines.htmltitle.val -side left } else { # These variables have to exist, but we won't really do anything with them. set rawdatafilename "" set coursefilename "" } # The Good-To-Go variables set GTGRaw 0 set GTGCourse 0 set GTGResults 0 # Set up error output scrollbox frame .errorbox pack .errorbox -side top -expand true -fill both set ebox [ScrolledListbox .errorbox.main -listvariable errorlist -width 100 -height $ErrorAreaHeight -font {courier 12 normal}] pack .errorbox.main -side left -expand true -fill both #grid .errorbox.main -sticky news #grid rowconfigure .errorbox 0 -weight 1 #grid columnconfigure .errorbox 0 -weight 1 # Set up a long text row # The width on the next label is set strangely to help with a yet untraced bug: the listboxes defined below # appear to become confused unless something forces the main window to be a little wider than they are trying # to be. (The bug appears associated with the addition of the scrollbars.) # # Hmmm ... we do not appear to really need this. Commenting out all 5 lines for now. #set tlabelwidth 100 #frame .textline #pack .textline -side top -fill x #label .textline.label -width $tlabelwidth -justify left -text " " #pack .textline.label -side left # Set up the editing row set SeletedLine 0 set EditIdx -1 frame .editbox pack .editbox -side top -expand true -fill both #label .editbox.name -textvariable CurrentEditName -width 28 entry .editbox.name -textvariable CurrentEditName -width 28 bind .editbox.name HandleEditName # Course editing # Start with a default set of course names. # (These will get changed after reading the real courses.) set CourseNames {Unknown White Yellow Orange Brown Green Red} #eval {tk_optionMenu .editbox.coursemenu UseCourse} $CourseNames #bind .editbox.coursemenu.menu <> {HandleEditCourse %W} # Would prefer to use tk_optionMenu, but there seems to be a bug in <> # Just build and manage the menu by hand: menubutton .editbox.coursemenu -text Course -menu .editbox.coursemenu.menu set EditCourseMenu [menu .editbox.coursemenu.menu] BuildCourseEditMenu $CourseNames # Final result editing label .editbox.editresulttxt -text "Edit Result:" entry .editbox.editresult -textvariable CurrentEditEdit -width 10 bind .editbox.editresult HandleEditResult # # button .editbox.remove -text " " -command HandleEditDelete #button .editbox.kludge -text "KLUDGE" -command FixKludge button .editbox.special -text "Special" -command DoSpecial #pack .editbox.name .editbox.coursemenu .editbox.remove .editbox.kludge -side left pack .editbox.name .editbox.coursemenu -side left pack .editbox.remove .editbox.editresult .editbox.editresulttxt -side right # A second line in the edit area. We won't be able to modify these items, but they provide useful information. frame .editbox2 pack .editbox2 -side top -expand true -fill both label .editbox2.sicard -textvariable CurrentEditSICard label .editbox2.starttime -textvariable CurrentEditStartTime label .editbox2.finishtime -textvariable CurrentEditFinishTime label .editbox2.totaltime -textvariable CurrentEditTotalTime label .editbox2.result -textvariable CurrentEditResult label .editbox2.eresult -textvariable CurrentEditEditResult label .editbox2.fresult -textvariable CurrentEditFinalResult pack .editbox2.sicard .editbox2.starttime .editbox2.finishtime .editbox2.totaltime .editbox2.result .editbox2.eresult .editbox2.fresult -side left # A third line of useful information. We don't always want it, but it can be useful to see the real punches. if {$ExtendedEditArea} { frame .editbox3 pack .editbox3 -side top -expand true -fill both label .editbox3.punches -textvariable CurrentEditPunches pack .editbox3.punches -side left } else { set CurrentEditPunches "" } # Set up the results area (the main scrollable listbox) frame .resultsbox pack .resultsbox -side top -expand true -fill both set rbox [ScrolledListbox .resultsbox.main -listvariable resultslist -selectmode single \ -width 100 -height $ResultsAreaHeight -font {courier 12 normal}] pack .resultsbox.main -side left -expand true -fill both #grid .resultsbox.main -sticky news #grid rowconfigure .resultsbox 0 -weight 1 #grid columnconfigure .resultsbox 0 -weight 1 bind $rbox [list ActivateSelectedLine %W] focus $rbox # Indicate that we have not yet read any live results download files set DLFilesRead {} array unset DLFilesMTime # Clear some other variables set Comps {} set ResultCSVOutput {} set ResultECSVOutput {} ClearResultsAndRaw SimpleTest # Everything is now under the control of the event handlers for the above-defined buttons. # At this point, we just let things run. #------------------------------------------------------------------------------------------------------