--- capa/capa51/GUITools/scorer.tcl 1999/10/28 16:32:07 1.2 +++ capa/capa51/GUITools/scorer.tcl 2000/02/22 18:10:27 1.12 @@ -153,6 +153,7 @@ proc runScorer { setFile } { configureOptions $num loadScorerConfig $num Centre_Dialog $scorerWin default +# trace variable gScorer(quit.$num) w "scorerClose $num 0" } ########################################################### @@ -165,7 +166,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 +412,8 @@ proc insertQuest { num where } { } } renumberScorerQuest $num + update + $gScorer(quest.$num) see $where } ########################################################### @@ -506,6 +509,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 } @@ -760,7 +764,7 @@ proc initScorer { num } { proc getLine { num } { global gScorer - scorerMessage $num "Getting Responses" + scorerMessage $num "\nGetting Responses" set done 0 while { ! $done } { @@ -796,7 +800,7 @@ proc oneResponse { response max which } ########################################################### ########################################################### proc parseLine { num answerLine answerStruct } { - global gScorer + global gScorer gMult upvar $answerStruct parsedIn set result "" @@ -826,6 +830,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 +853,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 +888,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 +947,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 +966,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] } } } @@ -1026,7 +1049,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 +1265,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 +1310,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 +1325,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 +1380,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 +1567,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 +1579,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