--- capa/capa51/GUITools/scorer.tcl	1999/12/01 18:22:00	1.4
+++ capa/capa51/GUITools/scorer.tcl	2000/07/07 18:25:12	1.14
@@ -1,3 +1,26 @@
+# automated scoring of bubble sheets
+#  Copyright (C) 1992-2000 Michigan State University
+#
+#  The CAPA system is free software; you can redistribute it and/or
+#  modify it under the terms of the GNU Library General Public License as
+#  published by the Free Software Foundation; either version 2 of the
+#  License, or (at your option) any later version.
+#
+#  The CAPA system is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+#  Library General Public License for more details.
+#
+#  You should have received a copy of the GNU Library General Public
+#  License along with the CAPA system; see the file COPYING.  If not,
+#  write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+#  Boston, MA 02111-1307, USA.
+#
+#  As a special exception, you have permission to link this program
+#  with the TtH/TtM library and distribute executables, as long as you
+#  follow the requirements of the GNU GPL in regard to all of the
+#  software in the executable aside from TtH/TtM.
+
 ###########################################################
 # scorer.output.num file looks like this
 # classname setNum numQuest flags questiondescriptor
@@ -26,6 +49,11 @@ proc scorerMessage { num mesg {tag norma
 proc scorerError { num errorCode args } {
     global gScorer
     switch $errorCode {
+	INVALID_CAPAID {
+	    lappend gScorer(errortype.$num) $errorCode
+	    lappend gScorer(errors.$num) [lindex $args 0]
+	    scorerMessage $num "Student [lindex $args 1]'s paper had an unknown CapaID" error
+	}
 	LOTS_OF_ANON_MODE_MATCHES {
 	    lappend gScorer(errortype.$num) $errorCode
 	    lappend gScorer(errors.$num) [lindex $args 0]
@@ -153,6 +181,7 @@ proc runScorer { setFile } {
     configureOptions $num
     loadScorerConfig $num
     Centre_Dialog $scorerWin default
+#    trace variable gScorer(quit.$num) w "scorerClose $num 0"
 }
 
 ###########################################################
@@ -165,7 +194,7 @@ proc loadScorerConfig { num } {
     
     set filename [file join $gFile($num) records scorer.output.$gScorer(set.$num)]
     if { [ catch { set fileId [ open $filename "r" ] } ] } {
-	displayError "The set \"$gScorer(set.$num)\" does not yet have an scorer.output file. "
+	displayMessage "Creating a new scorer.output file for set $gScorer(set.$num)."
 	return
     }
     set line [gets $fileId ]
@@ -411,6 +440,8 @@ proc insertQuest { num where } {
 	}
     }
     renumberScorerQuest $num
+    update
+    $gScorer(quest.$num) see $where
 }
 
 ###########################################################
@@ -506,6 +537,7 @@ proc cloneScorerQuest { num } {
     
     set temp [ $gScorer(quest.$num) get [ $gScorer(quest.$num) curselection ] ]
     $gScorer(quest.$num) insert end $temp
+    $gScorer(quest.$num) see end
     renumberScorerQuest $num
 }
 
@@ -796,7 +828,7 @@ proc oneResponse { response max which }
 ###########################################################
 ###########################################################
 proc parseLine { num answerLine answerStruct } {
-    global gScorer
+    global gScorer gMult
     upvar $answerStruct parsedIn
     set result ""
 
@@ -826,6 +858,7 @@ proc parseLine { num answerLine answerSt
     set perQuest [lindex $gScorer($sheet.Question) 2]
     set parsedIn(multiplemarks) 0
     set parsedIn(spaces) 0
+    set parsedIn(maxQuest) $maxQuest
     for { set i 0 } { $i < $maxQuest } { incr i } {
 	if { [ catch { set gScorer(quest.$i.type.$num) } ] } {
 	    set parsedIn(maxQuest) $i
@@ -848,7 +881,14 @@ proc parseLine { num answerLine answerSt
 		    set parsedIn(answer.$i) [string index $array $which]
 		} else {
 		    if { $howmany > 1 } { 
-			set parsedIn(answer.$i) " "
+			set options ""
+			foreach possible $which {
+			    append options "[string index $array $possible] "
+			}
+			set selected [multipleChoice . "There were multiple marks on\nPaper Number $parsedIn(SerialNumber)\nStudentNumber $parsedIn(StudentNumber)\nProblem Number [expr $i+1]" $options]
+			#puts ":$parsedIn(StudentNumber):$parsedIn(SerialNumber):[format %2d [expr $i+1]]:$selected:$options"
+			set parsedIn(answer.$i) $selected
+			#puts $parsedIn(answer.$i)
 			incr parsedIn(multiplemarks)
 		    } else {
 			if { $howmany < 1 } { 
@@ -876,7 +916,14 @@ proc parseLine { num answerLine answerSt
 							[expr {$start + $which}]]
 		    } else {
 			if { $howmany > 1 } { 
-			    append parsedIn(answer.$i) " "
+			    set options ""
+			    foreach possible $which {
+				append options "[string index $array [expr {$start + $possible}]] "
+			    }
+			    set selected [multipleChoice . "There were multiple marks on\nPaper Number $parsedIn(SerialNumber)\nStudentNumber $parsedIn(StudentNumber)\nProblem Number [expr $i+1]" $options]
+			    #puts ":$parsedIn(StudentNumber):$parsedIn(SerialNumber):[format %2d [expr $i+1]]:$selected:$options"
+			    append parsedIn(answer.$i) $selected
+			    #puts $parsedIn(answer.$i)
 			    incr parsedIn(multiplemarks)
 			} else {
 			    if { $howmany < 1 } { 
@@ -928,6 +975,10 @@ proc parseLine { num answerLine answerSt
     if { $result != "" } {
 	error "$result"
     }
+    if { [catch {incr gMult $parsedIn(multiplemarks)}] } {
+	set gMult $parsedIn(multiplemarks)
+    }
+#    puts $gMult
 }
 
 proc getAnswers2 { PID set maxQuest num } {
@@ -943,11 +994,11 @@ proc getAnswers { PID set maxQuest num }
     global gFile gCapaConfig
     set pwd [pwd]
     cd $gFile($num)
-    set temp [exec $gCapaConfig($num.answers_command) $PID {} 1 $set]
+    set temp [exec $gCapaConfig($num.answers_command) $PID {} 0 $set]
     cd $pwd
     set result ""
     foreach line [split $temp "\n"] {
-	switch [lindex [split $line :] 0] {
+	switch -- [lindex [split $line :] 0] {
 	    ANS { lappend result [string range $line 4 end] }
 	}
     }
@@ -1015,9 +1066,14 @@ proc handleStudent { num answerStructVar
 	    scorerError $num LOTS_OF_ANON_MODE_MATCHES "$answerStruct(orignalLine)" \
 		$answerStruct(StudentNumber)
 	    return 0
+	} else {
+	    if { [llength $answerStruct(questionPID)] == 0 } {
+		scorerError $num INVALID_CAPAID "$answerStruct(orignalLine)" \
+		    $answerStruct(StudentNumber)
+		return 0
+	    }
 	}
     }
-
     set answerStruct(Name) "$answerStruct(LastName) $answerStruct(FirstName) $answerStruct(MiddleInitial)"
 
     scorerMessage $num "Getting Possible Answers for $answerStruct(StudentNumber), paper#  $answerStruct(SerialNumber). . ."
@@ -1026,7 +1082,7 @@ proc handleStudent { num answerStructVar
 	if { [catch { set answerStruct(correct.$questionPID) \
 			  [getAnswers $questionPID $gScorer(set.$num) \
 			       $answerStruct(maxQuest) $num] } errorMsg ] } {
-	    puts $errorMsg
+	    catch {puts $errorMsg}
 	    scorerError $num UNABLE_TO_PARSE "$answerStruct(orignalLine)" \
 		$answerStruct(StudentNumber)
 	    error UNABLE_TO_PARSE
@@ -1242,8 +1298,9 @@ proc setOutput { num answerStructVar} {
 ###########################################################
 ###########################################################
 proc finishScoring { num answerStructVar} {
-    global gScorer
+    global gScorer gMult
     scorerMessage $num "Finishing . . ."
+    #puts $gMult
 #    puts "errors:"
 #    puts "$gScorer(errors.$num)"
     scorerMessage $num "Finished, Feel free to Update .sb"
@@ -1289,7 +1346,8 @@ proc scorerStudent { num } {
     set gScorer(needToUpdateDB) 1
 #parseanswerline
     if { [catch {parseLine $num $answer answerStruct} errorMsg ] } {
-	displayError "Error parsing line: $errorMsg"
+	global errorInfo
+	displayError "Error parsing line: $errorMsg $errorInfo"
     } else {
 #parse the set and grades it for any possiblely matching student
 	if { ! [ catch { set result [handleStudent $num answerStruct]} errorMsg ] } {
@@ -1355,6 +1413,7 @@ proc unpauseScorer { num } {
 proc finalScorer { num method studentNumber numRight } {
     global gScorer
 
+    #puts ":$numRight:"
     set answers ""
     for { set i 0 } { $i < $gScorer(numQuest.$num) } { incr i } {
 	switch $gScorer(quest.$i.type.$num) {
@@ -1541,7 +1600,7 @@ proc scorerQuit { num } {
     global gScorer
     set gScorer(pause.$num) 1
     set gScorer(quit.$num) 1
-    puts [trace vinfo gScorer(quit.$num)]
+    #puts [trace vinfo gScorer(quit.$num)]
     catch {scorerMessage $num "Quitting. . . " info}
 }
 
@@ -1553,12 +1612,12 @@ proc scorerQuit { num } {
 proc scorerClose { num {mustClose 0} {dummy ""} {dummy2 ""} {dummy3 ""}} {
     global gScorer
 
-    puts "scorerClose"
-    if { $gScorer(needToUpdateDB) } {
-	set message \
-	    "Are you sure you wish to close, you haven't yet updated the .sb file."
-    } else {
-	set message "Are you sure you wish to close?"
+    set message "Are you sure you wish to close?"
+    catch {
+	if { $gScorer(needToUpdateDB) } {
+	    set message \
+		"Are you sure you wish to close, you haven't yet updated the .sb file."
+	}
     }
     if { (! $mustClose ) && [makeSure $message ] == "Cancel" } { return 0 }
     stopScorer $num