[BACK]Return to scorer.tcl CVS log [TXT] [DIR] Up to [LON-CAPA] / capa / capa51 / GUITools

Diff for /capa/capa51/GUITools/scorer.tcl between versions 1.5 and 1.14

version 1.5, 1999/12/03 18:39:38 version 1.14, 2000/07/07 18:25:12
Line 1 Line 1
   # 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  # scorer.output.num file looks like this
 # classname setNum numQuest flags questiondescriptor  # classname setNum numQuest flags questiondescriptor
Line 26  proc scorerMessage { num mesg {tag norma Line 49  proc scorerMessage { num mesg {tag norma
 proc scorerError { num errorCode args } {  proc scorerError { num errorCode args } {
     global gScorer      global gScorer
     switch $errorCode {      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 {   LOTS_OF_ANON_MODE_MATCHES {
     lappend gScorer(errortype.$num) $errorCode      lappend gScorer(errortype.$num) $errorCode
     lappend gScorer(errors.$num) [lindex $args 0]      lappend gScorer(errors.$num) [lindex $args 0]
Line 166  proc loadScorerConfig { num } { Line 194  proc loadScorerConfig { num } {
           
     set filename [file join $gFile($num) records scorer.output.$gScorer(set.$num)]      set filename [file join $gFile($num) records scorer.output.$gScorer(set.$num)]
     if { [ catch { set fileId [ open $filename "r" ] } ] } {      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   return
     }      }
     set line [gets $fileId ]      set line [gets $fileId ]
Line 412  proc insertQuest { num where } { Line 440  proc insertQuest { num where } {
  }   }
     }      }
     renumberScorerQuest $num      renumberScorerQuest $num
       update
       $gScorer(quest.$num) see $where
 }  }
   
 ###########################################################  ###########################################################
Line 507  proc cloneScorerQuest { num } { Line 537  proc cloneScorerQuest { num } {
           
     set temp [ $gScorer(quest.$num) get [ $gScorer(quest.$num) curselection ] ]      set temp [ $gScorer(quest.$num) get [ $gScorer(quest.$num) curselection ] ]
     $gScorer(quest.$num) insert end $temp      $gScorer(quest.$num) insert end $temp
       $gScorer(quest.$num) see end
     renumberScorerQuest $num      renumberScorerQuest $num
 }  }
   
Line 797  proc oneResponse { response max which } Line 828  proc oneResponse { response max which }
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc parseLine { num answerLine answerStruct } {  proc parseLine { num answerLine answerStruct } {
     global gScorer      global gScorer gMult
     upvar $answerStruct parsedIn      upvar $answerStruct parsedIn
     set result ""      set result ""
   
Line 827  proc parseLine { num answerLine answerSt Line 858  proc parseLine { num answerLine answerSt
     set perQuest [lindex $gScorer($sheet.Question) 2]      set perQuest [lindex $gScorer($sheet.Question) 2]
     set parsedIn(multiplemarks) 0      set parsedIn(multiplemarks) 0
     set parsedIn(spaces) 0      set parsedIn(spaces) 0
       set parsedIn(maxQuest) $maxQuest
     for { set i 0 } { $i < $maxQuest } { incr i } {      for { set i 0 } { $i < $maxQuest } { incr i } {
  if { [ catch { set gScorer(quest.$i.type.$num) } ] } {   if { [ catch { set gScorer(quest.$i.type.$num) } ] } {
     set parsedIn(maxQuest) $i      set parsedIn(maxQuest) $i
Line 849  proc parseLine { num answerLine answerSt Line 881  proc parseLine { num answerLine answerSt
     set parsedIn(answer.$i) [string index $array $which]      set parsedIn(answer.$i) [string index $array $which]
  } else {   } else {
     if { $howmany > 1 } {       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)   incr parsedIn(multiplemarks)
     } else {      } else {
  if { $howmany < 1 } {    if { $howmany < 1 } { 
Line 877  proc parseLine { num answerLine answerSt Line 916  proc parseLine { num answerLine answerSt
  [expr {$start + $which}]]   [expr {$start + $which}]]
     } else {      } else {
  if { $howmany > 1 } {    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)      incr parsedIn(multiplemarks)
  } else {   } else {
     if { $howmany < 1 } {       if { $howmany < 1 } { 
Line 929  proc parseLine { num answerLine answerSt Line 975  proc parseLine { num answerLine answerSt
     if { $result != "" } {      if { $result != "" } {
  error "$result"   error "$result"
     }      }
       if { [catch {incr gMult $parsedIn(multiplemarks)}] } {
    set gMult $parsedIn(multiplemarks)
       }
   #    puts $gMult
 }  }
   
 proc getAnswers2 { PID set maxQuest num } {  proc getAnswers2 { PID set maxQuest num } {
Line 944  proc getAnswers { PID set maxQuest num } Line 994  proc getAnswers { PID set maxQuest num }
     global gFile gCapaConfig      global gFile gCapaConfig
     set pwd [pwd]      set pwd [pwd]
     cd $gFile($num)      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      cd $pwd
     set result ""      set result ""
     foreach line [split $temp "\n"] {      foreach line [split $temp "\n"] {
  switch [lindex [split $line :] 0] {   switch -- [lindex [split $line :] 0] {
     ANS { lappend result [string range $line 4 end] }      ANS { lappend result [string range $line 4 end] }
  }   }
     }      }
Line 1016  proc handleStudent { num answerStructVar Line 1066  proc handleStudent { num answerStructVar
     scorerError $num LOTS_OF_ANON_MODE_MATCHES "$answerStruct(orignalLine)" \      scorerError $num LOTS_OF_ANON_MODE_MATCHES "$answerStruct(orignalLine)" \
  $answerStruct(StudentNumber)   $answerStruct(StudentNumber)
     return 0      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)"      set answerStruct(Name) "$answerStruct(LastName) $answerStruct(FirstName) $answerStruct(MiddleInitial)"
   
     scorerMessage $num "Getting Possible Answers for $answerStruct(StudentNumber), paper#  $answerStruct(SerialNumber). . ."      scorerMessage $num "Getting Possible Answers for $answerStruct(StudentNumber), paper#  $answerStruct(SerialNumber). . ."
Line 1027  proc handleStudent { num answerStructVar Line 1082  proc handleStudent { num answerStructVar
  if { [catch { set answerStruct(correct.$questionPID) \   if { [catch { set answerStruct(correct.$questionPID) \
   [getAnswers $questionPID $gScorer(set.$num) \    [getAnswers $questionPID $gScorer(set.$num) \
        $answerStruct(maxQuest) $num] } errorMsg ] } {         $answerStruct(maxQuest) $num] } errorMsg ] } {
     puts $errorMsg      catch {puts $errorMsg}
     scorerError $num UNABLE_TO_PARSE "$answerStruct(orignalLine)" \      scorerError $num UNABLE_TO_PARSE "$answerStruct(orignalLine)" \
  $answerStruct(StudentNumber)   $answerStruct(StudentNumber)
     error UNABLE_TO_PARSE      error UNABLE_TO_PARSE
Line 1243  proc setOutput { num answerStructVar} { Line 1298  proc setOutput { num answerStructVar} {
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc finishScoring { num answerStructVar} {  proc finishScoring { num answerStructVar} {
     global gScorer      global gScorer gMult
     scorerMessage $num "Finishing . . ."      scorerMessage $num "Finishing . . ."
       #puts $gMult
 #    puts "errors:"  #    puts "errors:"
 #    puts "$gScorer(errors.$num)"  #    puts "$gScorer(errors.$num)"
     scorerMessage $num "Finished, Feel free to Update .sb"      scorerMessage $num "Finished, Feel free to Update .sb"
Line 1290  proc scorerStudent { num } { Line 1346  proc scorerStudent { num } {
     set gScorer(needToUpdateDB) 1      set gScorer(needToUpdateDB) 1
 #parseanswerline  #parseanswerline
     if { [catch {parseLine $num $answer answerStruct} errorMsg ] } {      if { [catch {parseLine $num $answer answerStruct} errorMsg ] } {
  displayError "Error parsing line: $errorMsg"   global errorInfo
    displayError "Error parsing line: $errorMsg $errorInfo"
     } else {      } else {
 #parse the set and grades it for any possiblely matching student  #parse the set and grades it for any possiblely matching student
  if { ! [ catch { set result [handleStudent $num answerStruct]} errorMsg ] } {   if { ! [ catch { set result [handleStudent $num answerStruct]} errorMsg ] } {
Line 1356  proc unpauseScorer { num } { Line 1413  proc unpauseScorer { num } {
 proc finalScorer { num method studentNumber numRight } {  proc finalScorer { num method studentNumber numRight } {
     global gScorer      global gScorer
   
       #puts ":$numRight:"
     set answers ""      set answers ""
     for { set i 0 } { $i < $gScorer(numQuest.$num) } { incr i } {      for { set i 0 } { $i < $gScorer(numQuest.$num) } { incr i } {
  switch $gScorer(quest.$i.type.$num) {   switch $gScorer(quest.$i.type.$num) {
Line 1542  proc scorerQuit { num } { Line 1600  proc scorerQuit { num } {
     global gScorer      global gScorer
     set gScorer(pause.$num) 1      set gScorer(pause.$num) 1
     set gScorer(quit.$num) 1      set gScorer(quit.$num) 1
     puts [trace vinfo gScorer(quit.$num)]      #puts [trace vinfo gScorer(quit.$num)]
     catch {scorerMessage $num "Quitting. . . " info}      catch {scorerMessage $num "Quitting. . . " info}
 }  }
   
Line 1554  proc scorerQuit { num } { Line 1612  proc scorerQuit { num } {
 proc scorerClose { num {mustClose 0} {dummy ""} {dummy2 ""} {dummy3 ""}} {  proc scorerClose { num {mustClose 0} {dummy ""} {dummy2 ""} {dummy3 ""}} {
     global gScorer      global gScorer
   
     puts "scorerClose"  
     set message "Are you sure you wish to close?"      set message "Are you sure you wish to close?"
     catch {      catch {
  if { $gScorer(needToUpdateDB) } {   if { $gScorer(needToUpdateDB) } {
Removed from v.1.5  
changed lines
  Added in v.1.14

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>