--- capa/capa51/GUITools/scorer.tcl 1999/09/28 21:25:36 1.1.1.1 +++ capa/capa51/GUITools/scorer.tcl 2000/04/27 20:19:46 1.13 @@ -26,6 +26,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 +158,7 @@ proc runScorer { setFile } { configureOptions $num loadScorerConfig $num Centre_Dialog $scorerWin default +# trace variable gScorer(quit.$num) w "scorerClose $num 0" } ########################################################### @@ -165,7 +171,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 +417,8 @@ proc insertQuest { num where } { } } renumberScorerQuest $num + update + $gScorer(quest.$num) see $where } ########################################################### @@ -506,6 +514,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 } @@ -640,7 +649,7 @@ proc startScorer { num } { label $errors.num -textvariable gScorer(numerrors.$num) pack $errors.mesg $errors.num -side left - button $statusButtons.handleErrors -text "Handle Errors" \ + button $statusButtons.handleErrors -text "Save Errors" \ -command "handleErrorsScorer $num" button $statusButtons.printMsg -text "Print Messages" \ -command "printScorerMsg $num" @@ -760,7 +769,7 @@ proc initScorer { num } { proc getLine { num } { global gScorer - scorerMessage $num "Getting Responses" + scorerMessage $num "\nGetting Responses" set done 0 while { ! $done } { @@ -796,7 +805,7 @@ proc oneResponse { response max which } ########################################################### ########################################################### proc parseLine { num answerLine answerStruct } { - global gScorer + global gScorer gMult upvar $answerStruct parsedIn set result "" @@ -826,6 +835,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 +858,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 +893,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 +952,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 +971,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 +1043,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 +1059,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 +1275,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" @@ -1286,12 +1320,11 @@ proc scorerStudent { num } { finishScoring $num answerStruct return } - incr gScorer(student.$num) - update 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 ] } { @@ -1302,6 +1335,8 @@ proc scorerStudent { num } { displayError "An error occured when attempting to grade a student. The error is: $errorMsg" } } + incr gScorer(student.$num) + update after idle "scorerStudent $num" } @@ -1355,6 +1390,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,6 +1577,7 @@ proc scorerQuit { num } { global gScorer set gScorer(pause.$num) 1 set gScorer(quit.$num) 1 + #puts [trace vinfo gScorer(quit.$num)] catch {scorerMessage $num "Quitting. . . " info} } @@ -1552,11 +1589,12 @@ proc scorerQuit { num } { proc scorerClose { num {mustClose 0} {dummy ""} {dummy2 ""} {dummy3 ""}} { global gScorer - 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