File:
[LON-CAPA] /
capa /
capa51 /
GUITools /
scorer.tcl
Revision
1.15:
download - view:
text,
annotated -
select for diffs
Mon Aug 7 20:47:29 2000 UTC (24 years, 3 months ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_X,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_1_3,
version_2_1_2,
version_2_1_1,
version_2_1_0,
version_2_12_X,
version_2_11_X,
version_2_11_5_msu,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1_tmcc,
version_1_99_1,
version_1_99_0_tmcc,
version_1_99_0,
version_1_3_X,
version_1_3_3,
version_1_3_2,
version_1_3_1,
version_1_3_0,
version_1_2_X,
version_1_2_99_1,
version_1_2_99_0,
version_1_2_1,
version_1_2_0,
version_1_1_X,
version_1_1_99_5,
version_1_1_99_4,
version_1_1_99_3,
version_1_1_99_2,
version_1_1_99_1,
version_1_1_99_0,
version_1_1_3,
version_1_1_2,
version_1_1_1,
version_1_1_0,
version_1_0_99_3,
version_1_0_99_2,
version_1_0_99_1,
version_1_0_99,
version_1_0_3,
version_1_0_2,
version_1_0_1,
version_1_0_0,
version_0_99_5,
version_0_99_4,
version_0_99_3,
version_0_99_2,
version_0_99_1,
version_0_99_0,
version_0_6_2,
version_0_6,
version_0_5_1,
version_0_5,
version_0_4,
stable_2002_spring,
stable_2002_july,
stable_2002_april,
stable_2001_fall,
release_5-1-3,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
conference_2003,
bz6209-base,
bz6209,
STABLE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
CAPA_5-1-6,
CAPA_5-1-5,
CAPA_5-1-4_RC1,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse,
BZ4492-feature_Support_horizontal_radioresponse,
BZ4492-Support_horizontal_radioresponse
- fixed license notices the reference the GNU GPL rather than the GNU LGPL
# 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 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
# General Public License for more details.
#
# You should have received a copy of the GNU 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
# flags come in the order of CheckPIN, AnonMode, (CheckSpaces, Gone)
# (SurveyMode, Gone) (SurveyHeader, Gone) (IdFormat, Gone)
# (CheckMultipleMarks, Gone) QueryAboutPID, (log gone)
###########################################################
###########################################################
# scorerMessage
###########################################################
###########################################################
###########################################################
proc scorerMessage { num mesg {tag normal} } {
global gScorer
$gScorer(status.$num) insert end "$mesg\n" $tag
$gScorer(status.$num) see end
# update
}
###########################################################
# scorerError
###########################################################
###########################################################
###########################################################
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]
scorerMessage $num "More than 6 Student IDs generate the closest match to the capaID specified on [lindex $args 1]'s paper" error
}
NO_CODE_IN_ANON_MODE {
lappend gScorer(errortype.$num) $errorCode
lappend gScorer(errors.$num) [lindex $args 0]
scorerMessage $num "There was no CapaID/CODE on [lindex $args 1]'s paper" error
}
NO_SUCH_STUDENT {
lappend gScorer(errortype.$num) $errorCode
lappend gScorer(errors.$num) [lindex $args 0]
scorerMessage $num "Unable to find [lindex $args 1] in classl" error
}
UNABLE_TO_PARSE {
lappend gScorer(errortype.$num) $errorCode
lappend gScorer(errors.$num) [lindex $args 0]
scorerMessage $num "An error occured while trying to parse the set for [lindex $args 1]'s paper" error
}
PINWRONG -
UNKNOWN_GRADING_METHOD -
CANT_OPEN_SB -
CANT_UPDATE_SB -
default {
displayError "$errorCode $args"
}
}
incr gScorer(numerrors.$num)
update
}
###########################################################
# runScorer
###########################################################
###########################################################
###########################################################
proc runScorer { setFile } {
global gUniqueNumber gWindowMenu gFile gScorer
set num [incr gUniqueNumber]
set classDir [file dirname $setFile]
set gFile($num) $classDir
# puts "set gFile($num) to $gFile($num)"
set scorerWin [toplevel .beginScorer$num]
$gWindowMenu add command -label "ScorerConfig $classDir" \
-command "capaRaise \"$scorerWin\""
wm title $scorerWin $classDir
set infoFrame [frame $scorerWin.infoFrame ]
set buttonFrame [frame $scorerWin.buttonFrame ]
set configFrame [frame $scorerWin.configFrame ]
pack $infoFrame $buttonFrame $configFrame -side top
set classNameFrame [frame $infoFrame.classNameFrame]
set setNumFrame [frame $infoFrame.setNumFrame]
set scoreFileFrame [frame $infoFrame.scoreFileFrame]
pack $classNameFrame $setNumFrame $scoreFileFrame -side top -anchor w
#classname
label $classNameFrame.label -text "Class Name:"
entry $classNameFrame.entry -textvariable gScorer(class.$num)\
-width 8
# button $classNameFrame.button -text "What Goes Here" \
-command "helpScorer className"
pack $classNameFrame.label $classNameFrame.entry -side left
set gScorer(class.$num) [file tail $classDir]
#set number
set gScorer(set.$num) [string range [file rootname [file tail $setFile]] 3 end]
label $setNumFrame.label -text "Set Number:"
entry $setNumFrame.set -width 2 -textvariable gScorer(set.$num)
pack $setNumFrame.label $setNumFrame.set -side left
#scoring file
label $scoreFileFrame.label -text "Scoring Office File:"
set entryFrame [frame $scoreFileFrame.entryFrame]
button $scoreFileFrame.select -text "Select File" \
-command "selectScoringFile $num"
pack $scoreFileFrame.label $entryFrame $scoreFileFrame.select -side left
entry $entryFrame.entry -textvariable gScorer(scoreFile.$num) \
-xscrollcommand "$entryFrame.scroll set"
scrollbar $entryFrame.scroll -orient h -command \
"$entryFrame.entry xview"
pack $entryFrame.entry $entryFrame.scroll
pack configure $entryFrame.scroll -fill x
#buttons
button $buttonFrame.cancel -text Cancel -command "destroy $scorerWin\
removeWindowEntry \"ScorerConfig $classDir\""
button $buttonFrame.continue -text "Continue" \
-command "getScorerQuest $num"
button $buttonFrame.load -text "Load Previous Settings" \
-command "loadScorerConfig $num"
pack $buttonFrame.cancel $buttonFrame.continue $buttonFrame.load \
-side left
#config options
#flag list is from scorer.h
foreach flaglist $gScorer(flags) {
set flag [lindex $flaglist 0]
set question [lindex $flaglist 1]
set oneVal [lindex $flaglist 2]
set zeroVal [lindex $flaglist 3]
set defaultVal [lindex $flaglist 4]
set frame($flag) [frame $configFrame.[string tolower $flag] \
-relief groove -borderwidth 2]
set gScorer($flag.frame.$num) $frame($flag)
pack $frame($flag) -side top -anchor w
set frame($flag.top) [frame $frame($flag).top]
set frame($flag.bot) [frame $frame($flag).bot]
pack $frame($flag.top) $frame($flag.bot) -side top -anchor w
label $frame($flag.top).label -text "$question" -anchor w -width 70
# button $frame($flag.top).help -text "Huh?" -command "helpScorerFlags $flag"
pack $frame($flag.top).label -side left
radiobutton $frame($flag.bot).one -variable gScorer($flag.$num) \
-value 1 -text $oneVal -command "configureOptions $num"
radiobutton $frame($flag.bot).zero -variable gScorer($flag.$num) \
-value 0 -text $zeroVal -command "configureOptions $num"
set gScorer($flag.$num) $defaultVal
pack $frame($flag.bot).one $frame($flag.bot).zero -side left
}
parseCapaConfig $num $gFile($num)
configureOptions $num
loadScorerConfig $num
Centre_Dialog $scorerWin default
# trace variable gScorer(quit.$num) w "scorerClose $num 0"
}
###########################################################
# loadScorerConfig
###########################################################
###########################################################
###########################################################
proc loadScorerConfig { num } {
global gScorer gFile
set filename [file join $gFile($num) records scorer.output.$gScorer(set.$num)]
if { [ catch { set fileId [ open $filename "r" ] } ] } {
displayMessage "Creating a new scorer.output file for set $gScorer(set.$num)."
return
}
set line [gets $fileId ]
close $fileId
set flags [lindex $line 3]
#When uncommenting or commenting the following lines make sure to update the actual
#index values
set gScorer(CheckPIN.$num) [string index $flags 0]
set gScorer(AnonMode.$num) [string index $flags 1]
# set gScorer(CheckSpaces.$num) [string index $flags 2]
# set gScorer(SurveyMode.$num) [string index $flags 3]
# set gScorer(SurveyHeader.$num) [string index $flags 4]
# set gScorer(IdFormat.$num) [string index $flags 5]
# set gScorer(CheckMultipleMarks.$num) [string index $flags 6]
set gScorer(QueryAboutPID.$num) [string index $flags 2]
# set gScorer(Form.$num) [string index $flags 8]
# set gScorer(log.$num) [string index $flags 9]
configureOptions $num
}
###########################################################
###########################################################
###########################################################
###########################################################
proc configureOptions { num } {
global gScorer
foreach frame [array names gScorer "*.frame.$num"] {
pack forget $gScorer($frame)
}
# pack $gScorer(SurveyMode.frame.$num) -side top
# if { $gScorer(SurveyMode.$num) } {}
# pack $gScorer(SurveyHeader.frame.$num)
# {}
pack $gScorer(CheckPIN.frame.$num)
if { $gScorer(CheckPIN.$num) } {
pack $gScorer(AnonMode.frame.$num)
if { $gScorer(AnonMode.$num) } {
pack $gScorer(QueryAboutPID.frame.$num)
} else {
set gScorer(QueryAboutPID.$num) 0
}
} else {
set gScorer(AnonMode.$num) 0
}
# pack $gScorer(CheckSpaces.frame.$num)
# pack $gScorer(CheckMultipleMarks.frame.$num)
# pack $gScorer(IdFormat.frame.$num)
# {}
# pack $gScorer(Form.frame.$num)
# pack $gScorer(log.frame.$num)
}
###########################################################
# selectScoringFile
###########################################################
###########################################################
###########################################################
proc selectScoringFile { num } {
global gScorer
if { "" != [ set temp [tk_getOpenFile] ] } {set gScorer(scoreFile.$num) $temp}
}
###########################################################
###########################################################
###########################################################
###########################################################
proc helpScorerFlags { flag } {
global gUniqueNumber gWindowMenu
set num [incr gUniqueNumber]
set helpWin [toplevel .beginScorer$num]
$gWindowMenu add command -label "HelpFlag $flag" \
-command "capaRaise \" $helpWin\""
wm title $helpWin $flag
button $helpWin.dismiss -text Dismiss -command "destroy $helpWin"
message $helpWin.help -aspect 2000
set help ""
switch $flag {
# SurveyMode { set help "An examination will include the student number on the answer sheet of the student who answered the questions, whereas a survey will have no student number at all." }
# SurveyHeader { set help "If the Survey given include a header portion this will let ."}
CheckPIN { set help "bluh" }
AnonMode { set help "bluh" }
QueryAboutPID { set help "bluh" }
# CheckSpaces { set help "bluh" }
# CheckMultipleMarks { set help "bluh" }
# IdFormat { set help "bluh" }
# Form { set help "bluh" }
# log { set help "bluh" }
}
$helpWin.help configure -text "$help"
pack $helpWin.dismiss $helpWin.help
Centre_Dialog $helpWin default
}
###########################################################
# getScorerQuest
###########################################################
###########################################################
###########################################################
proc getScorerQuest { num } {
global gUniqueNumber gWindowMenu gFile gScorer
if { ![file readable $gScorer(scoreFile.$num)] } {
displayMessage "Please Select a readable scoring office report file before continuing."
return
}
set classDir $gFile($num)
set scorerWin ".beginScorer$num"
set infoFrame $scorerWin.infoFrame
set buttonFrame $scorerWin.buttonFrame
set configFrame $scorerWin.configFrame
set classNameFrame $infoFrame.classNameFrame
set setNumFrame $infoFrame.setNumFrame
set scoreFileFrame $infoFrame.scoreFileFrame
set entryFrame $scoreFileFrame.entryFrame
destroy $configFrame
pack [frame $configFrame]
destroy $scoreFileFrame.select
$entryFrame.entry configure -state disabled
$classNameFrame.entry configure -state disabled
$setNumFrame.set configure -state disabled
#disabeling the config options
set classNameFrame $infoFrame.classNameFrame
set setNumFrame $infoFrame.setNumFrame
$classNameFrame.entry configure -state disabled
$setNumFrame.set configure -state disabled
$buttonFrame.continue configure -command "startScorer $num"
$buttonFrame.load configure -command "loadScorerQuest $num"
#question
set questButFrame [ frame $configFrame.butFrame ]
set questLabelFrame [frame $configFrame.label ]
set questListFrame [ frame $configFrame.listFrame ]
pack $questButFrame $questLabelFrame $questListFrame
pack configure $questLabelFrame -anchor w
button $questButFrame.add -text "Add" -command "addScorerQuest $num"
button $questButFrame.clone -text "Clone" -command "cloneScorerQuest $num"
button $questButFrame.rm -text "Remove" -command "rmScorerQuest $num"
button $questButFrame.change -text "Change" -command "changeScorerQuest $num"
pack $questButFrame.add $questButFrame.clone $questButFrame.rm \
$questButFrame.change -side left
label $questLabelFrame.label -text "Num Type Points Leafs"
pack $questLabelFrame.label
#listbox
set gScorer(questNum.$num) [ listbox $questListFrame.questNum \
-width 3 -height 20 \
-yscrollcommand "$questListFrame.scroll set" ]
set gScorer(quest.$num) [ listbox $questListFrame.quest -width 50 -height 20 \
-yscrollcommand "$questListFrame.scroll set"]
scrollbar $questListFrame.scroll -orient v -command \
"scrolltwo \"$questListFrame.quest yview\" \"$questListFrame.questNum yview\""
pack $questListFrame.scroll $questListFrame.quest \
$questListFrame.questNum -side right
pack configure $questListFrame.scroll -fill y
loadScorerQuest $num
update idletasks
Centre_Dialog $scorerWin default
}
###########################################################
# configQuestWin
###########################################################
###########################################################
###########################################################
proc configQuestWin { num action {message ""} {max 1} } {
global gScorer
if { ![winfo exists .scorerQuestWin$num] } { return }
set frame .scorerQuestWin$num.add.leaf
switch $action {
hide
{ pack forget $frame }
show
{
pack $frame
$frame.leafs configure -label $message
$frame.leafs configure -to $max
}
}
}
###########################################################
# renumberScorerQuest
###########################################################
###########################################################
###########################################################
proc renumberScorerQuest { num } {
global gScorer
$gScorer(questNum.$num) delete 0 end
set max [$gScorer(quest.$num) index end ]
for { set i 1 } { $i <= $max } { incr i } {
lappend numList $i
}
eval "$gScorer(questNum.$num) insert 0 $numList"
$gScorer(questNum.$num) yview [ $gScorer(quest.$num) nearest 5 ]
}
###########################################################
# insertQuest
###########################################################
###########################################################
###########################################################
proc insertQuest { num where } {
global gScorer
if { $where != "end" } { $gScorer(quest.$num) delete $where }
switch $gScorer(questType.$num) {
ONE_OUT_OF_10
-
ASSIGNED
-
SINGLE_DIGIT
-
STRING_MATCH
{
$gScorer(quest.$num) insert $where [format "%-13s %7s" \
$gScorer(questType.$num) $gScorer(questPoint.$num)]
}
GLE
-
TF
-
N_OUT_OF_M
{
$gScorer(quest.$num) insert $where [format "%-13s %7s %6s" \
$gScorer(questType.$num) $gScorer(questPoint.$num) \
$gScorer(questLeaf.$num)]
}
}
renumberScorerQuest $num
update
$gScorer(quest.$num) see $where
}
###########################################################
# addScorerQuest
###########################################################
###########################################################
###########################################################
proc addScorerQuest { num {position end} } {
global gUniqueNumber gWindowMenu gFile gScorer
if { [winfo exists .scorerQuestWin$num] } { return }
set questWin [ toplevel .scorerQuestWin$num ]
if { ! [ info exists gScorer(questType.$num) ] } {
set gScorer(questType.$num) ONE_OUT_OF_10
}
set buttonFrame [ frame $questWin.button ]
set optionFrame [ frame $questWin.add ]
pack $buttonFrame $optionFrame -side top
set text Change
if { $position == "end" } {
set text Add
}
button $buttonFrame.done -text $text -command "insertQuest $num $position
destroy $questWin"
button $buttonFrame.cancel -text "Cancel" -command "destroy $questWin"
pack $buttonFrame.done $buttonFrame.cancel -side left
set typeFrame [ frame $optionFrame.type ]
set pointFrame [ frame $optionFrame.point ]
set leafFrame [ frame $optionFrame.leaf ]
pack $typeFrame $pointFrame $leafFrame -side top
radiobutton $typeFrame.oneoutof8 -text "One out of no more than 10" -value "ONE_OUT_OF_10" \
-variable gScorer(questType.$num) -command "configQuestWin $num hide"
radiobutton $typeFrame.gletype -text "GLE type" -value "GLE" \
-variable gScorer(questType.$num) \
-command "configQuestWin $num show \"Number of Leafs\" 3 "
radiobutton $typeFrame.tftype -text "TF type" -value "TF" \
-variable gScorer(questType.$num) \
-command "configQuestWin $num show \"Number of Leafs\" 5 "
radiobutton $typeFrame.assigned -text "Assigned score" -value "ASSIGNED" \
-variable gScorer(questType.$num) -command "configQuestWin $num hide "
radiobutton $typeFrame.noutofm -text "N out of M" -value "N_OUT_OF_M" \
-variable gScorer(questType.$num) \
-command "configQuestWin $num show \"What is the value of M\" 10 "
radiobutton $typeFrame.singledigit -text "Single digit" -value "SINGLE_DIGIT" \
-variable gScorer(questType.$num) -command "configQuestWin $num hide"
radiobutton $typeFrame.exactstring -text "Exact string matching" \
-value "STRING_MATCH" -variable gScorer(questType.$num) \
-command "configQuestWin $num hide"
pack $typeFrame.oneoutof8 $typeFrame.gletype $typeFrame.tftype \
$typeFrame.assigned $typeFrame.noutofm $typeFrame.singledigit \
$typeFrame.exactstring -side top -anchor w
scale $pointFrame.points -from 0 -to 9 -variable gScorer(questPoint.$num) \
-label "Point Value" -orient h -length 300
pack $pointFrame.points
scale $leafFrame.leafs -from 1 -to 10 -variable gScorer(questLeaf.$num) \
-label "Number of Leafs" -orient h -length 300
pack $leafFrame.leafs
switch $gScorer(questType.$num) {
ONE_OUT_OF_10
-
ASSIGNED
-
SINGLE_DIGIT
-
STRING_MATCH { configQuestWin $num hide }
GLE { configQuestWin $num show "Number of Leafs" 3 }
TF { configQuestWin $num show "Number of Leafs" 5 }
N_OUT_OF_M { configQuestWin $num show "What is the value of M" 10 }
}
Centre_Dialog $questWin default
}
###########################################################
# cloneScorerQuest
###########################################################
###########################################################
###########################################################
proc cloneScorerQuest { num } {
global gUniqueNumber gWindowMenu gFile gScorer
if { [ $gScorer(quest.$num) curselection ] == "" } {
displayError "Please select an exisiting question to clone."
return
}
set temp [ $gScorer(quest.$num) get [ $gScorer(quest.$num) curselection ] ]
$gScorer(quest.$num) insert end $temp
$gScorer(quest.$num) see end
renumberScorerQuest $num
}
###########################################################
# rmScorerQuest
###########################################################
###########################################################
###########################################################
proc rmScorerQuest { num } {
global gUniqueNumber gWindowMenu gFile gScorer
if { [winfo exists .scorerQuestWin$num] } { return }
if { [ $gScorer(quest.$num) curselection ] == "" } {
displayError "Please select an exisiting question to delete."
return
}
$gScorer(quest.$num) delete [$gScorer(quest.$num) curselection]
renumberScorerQuest $num
}
###########################################################
# changeScorerQuest
###########################################################
###########################################################
###########################################################
proc changeScorerQuest { num } {
global gUniqueNumber gWindowMenu gFile gScorer
if { [winfo exists .scorerQuestWin$num] } { return }
if { [ $gScorer(quest.$num) curselection ] == "" } {
displayError "Please select an exisiting question to change."
return
}
set position [ $gScorer(quest.$num) curselection ]
set gScorer(questType.$num) [lindex [$gScorer(quest.$num) get $position ] 0 ]
set gScorer(questPoint.$num) [lindex [$gScorer(quest.$num) get $position ] 1 ]
set gScorer(questLeaf.$num) [lindex [$gScorer(quest.$num) get $position ] 2 ]
addScorerQuest $num $position
}
###########################################################
# startScorer
###########################################################
###########################################################
###########################################################
proc startScorer { num } {
global gScorer gFile
set scorerWin .beginScorer$num
set filename [file join $gFile($num) records scorer.output.$gScorer(set.$num)]
if { [ catch { set fileId [ open $filename "w+" ] } ] } {
displayError "Unable to write to the scorer.output file. "
return
}
#When deleting or adding anything to the flags var make sure to update loadScorerConfig
# set flags $gScorer(CheckPIN.$num)$gScorer(AnonMode.$num)$gScorer(CheckSpaces.$num)$gScorer(SurveyMode.$num)$gScorer(SurveyHeader.$num)$gScorer(IdFormat.$num)$gScorer(CheckMultipleMarks.$num)$gScorer(QueryAboutPID.$num)$gScorer(Form.$num)$gScorer(log.$num)
set flags $gScorer(CheckPIN.$num)$gScorer(AnonMode.$num)$gScorer(QueryAboutPID.$num)
set numQuestion [ $gScorer(quest.$num) index end ]
set questString ""
for { set i 0 } { $i < $numQuestion } { incr i } {
set line [ $gScorer(quest.$num) get $i ]
set gScorer(quest.$i.type.$num) [lindex $line 0]
switch [lindex $line 0 ] {
ONE_OUT_OF_10 { append questString a }
GLE { append questString b }
TF { append questString c }
ASSIGNED { append questString d }
N_OUT_OF_M { append questString e }
SINGLE_DIGIT { append questString f }
STRING_MATCH { append questString g }
}
append questString [lindex $line 1]
set gScorer(quest.$i.points.$num) [lindex $line 1]
if { [ lindex $line 2 ] == "" } {
set gScorer(quest.$i.leafs.$num) 1
append questString 1
} else {
set gScorer(quest.$i.leafs.$num) [lindex $line 2]
append questString [lindex $line 2]
}
}
set outputLine "$gScorer(class.$num) $gScorer(set.$num) $numQuestion $flags $questString"
puts $fileId [format "%-500s" $outputLine]
close $fileId
destroy $scorerWin.buttonFrame
destroy $scorerWin.configFrame
set gScorer(student.$num) 0
set gScorer(numerrors.$num) 0
set buttonFrame [frame $scorerWin.buttonFrame]
set statusFrame [frame $scorerWin.statusFrame]
pack $buttonFrame $statusFrame
button $buttonFrame.pause -text Pause -command "pauseScorer $num"
button $buttonFrame.cont -text Continue -command "unpauseScorer $num"
button $buttonFrame.restart -text Restart -command "restartScorer $num"
button $buttonFrame.final -text "Update .sb" -command "scorerToSet $num"
button $buttonFrame.exit -text "Quit" -command "scorerQuit $num"
pack $buttonFrame.pause $buttonFrame.cont $buttonFrame.restart \
$buttonFrame.final $buttonFrame.exit -side left
message $statusFrame.mesg -text "Messages:" -aspect 2000
set statusText [frame $statusFrame.statusText]
set student [frame $statusFrame.student]
set errors [frame $statusFrame.errors]
set statusButtons [frame $statusFrame.button]
pack $statusFrame.mesg $statusFrame.statusText $statusFrame.student \
$statusFrame.errors $statusFrame.button
pack configure $statusFrame.mesg $statusFrame.student $statusFrame.errors \
-anchor w
pack configure $statusText -expand 1 -fill both
set gScorer(status.$num) [text $statusText.text -wrap char \
-yscrollcommand "$statusText.scroll set"]
$gScorer(status.$num) tag configure error -foreground red
$gScorer(status.$num) tag configure info -foreground #006c00
scrollbar $statusText.scroll -orient v -command "$statusText.text yview"
pack $statusText.text $statusText.scroll -side left
pack configure $statusText.scroll -fill y
pack configure $gScorer(status.$num) -expand 1 -fill both
label $student.mesg -text "Students completed:"
label $student.num -textvariable gScorer(student.$num)
pack $student.mesg $student.num -side left
label $errors.mesg -text "Errors To Be Handled:"
label $errors.num -textvariable gScorer(numerrors.$num)
pack $errors.mesg $errors.num -side left
button $statusButtons.handleErrors -text "Save Errors" \
-command "handleErrorsScorer $num"
button $statusButtons.printMsg -text "Print Messages" \
-command "printScorerMsg $num"
button $statusButtons.saveMsg -text "Save Messages" \
-command "saveScorerMsg $num"
button $statusButtons.clearMsg -text "Clear Messages" \
-command "clearScorerMsg $num"
pack $statusButtons.handleErrors $statusButtons.printMsg \
$statusButtons.saveMsg -side left
wm protocol $scorerWin WM_DELETE_WINDOW "usequit $num"
update idletasks
Centre_Dialog $scorerWin default
# set gScorer(quit.$num) 0
restartScorer $num
}
###########################################################
# usequit
###########################################################
###########################################################
###########################################################
proc usequit { num } { scorerMessage $num "Please use the Quit Button." info }
###########################################################
# saveScorerMsg
###########################################################
###########################################################
###########################################################
proc saveScorerMsg { num } {
global gScorer
set file [tk_getSaveFile -title "Enter the name to save messages to."]
if { $file == "" } { return }
if { [catch {set fileId [open $file "w"] } ] } {
displayError "Unable to open $file"
return
}
set tag [getWhichTags "All {Errors Only} {NonErrors Only}" "{} error normal" "saved"]
puts -nonewline $fileId [getTextTagged $gScorer(status.$num) $tag ]
close $fileId
}
###########################################################
# printScorerMsg
###########################################################
###########################################################
###########################################################
proc printScorerMsg { num } {
global gScorer gFile
set file [file join $gFile($num) managertemp.txt]
set lprCommand [getLprCommand $file $num]
if { $lprCommand == "Cancel" } { return }
if { [catch {set fileId [open $file "w"] } ] } {
displayError "Unable to open $file"
return
}
set tag [getWhichTags "All {Errors Only} {NonErrors Only}" "{} error normal" printed]
puts -nonewline $fileId [getTextTagged $gScorer(status.$num) $tag ]
close $fileId
set errorMsg ""
set error [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]
exec rm -f $file
if { $error == 1 } {
displayError "An error occurred while printing: $errorMsg"
} else {
displayMessage "Print job sent to the printer.\n $output"
}
}
###########################################################
# initScorer
###########################################################
###########################################################
###########################################################
proc initScorer { num } {
global gScorer gFile
scorerMessage $num "Initializing. . ."
if { ![info exists gScorer(in.$num)] || ( $gScorer(in.$num) == "" ) } {
if { [catch {set gScorer(in.$num) \
[ open $gScorer(scoreFile.$num) "r" ] } ] } {
displayError "Unable to open input file $gScorer(scoreFile.$num)"
exit
}
}
set filename [file join $gFile($num) records scorer.output.$gScorer(set.$num)]
if { ![info exists gScorer(out.$num)] || ( $gScorer(out.$num) == "" ) } {
if { [catch {set gScorer(out.$num) [ open $filename "a+" ] } ] } {
displayError "Unable to open input file $filename"
exit
}
}
scorerMessage $num "Building List of Students. . ."
update
set oldDir [pwd]
cd $gFile($num)
#4 is the length of the CapaID
set a $gScorer(HalfSheet.CapaID)
set capaidplus [expr {[lindex $a 1] - [lindex $a 0] - 3}]
# puts "$capaidplus, $a"
set gScorer(studentList.$num) [buildStudentList $num $gScorer(class.$num) \
$gScorer(set.$num) $capaidplus]
cd $oldDir
}
###########################################################
# getLine
###########################################################
###########################################################
###########################################################
proc getLine { num } {
global gScorer
scorerMessage $num "\nGetting Responses"
set done 0
while { ! $done } {
gets $gScorer(in.$num) aline
if { [eof $gScorer(in.$num) ] } { error EOF }
if { ![string match "#*" $aline] } {
set done 1
}
}
return $aline
}
###########################################################
# oneResponse
###########################################################
###########################################################
###########################################################
proc oneResponse { response max which } {
upvar $which whichVar
set whichVar ""
set howmany 0
for { set i 0 } { $i < $max } { incr i } {
if { [string index "$response" $i] == "1" } {
lappend whichVar $i
incr howmany
}
}
return $howmany
}
###########################################################
# parseLine
###########################################################
###########################################################
###########################################################
proc parseLine { num answerLine answerStruct } {
global gScorer gMult
upvar $answerStruct parsedIn
set result ""
scorerMessage $num "Understanding Responses"
# Only support HalfSheets
# if { $gScorer(Form.$num) } {
# set sheet FullSheet
# } else {
# set sheet HalfSheet
# }
set sheet HalfSheet
set parsedIn(orignalLine) "$answerLine"
foreach type { SerialNumber LastName FirstName MiddleInitial
StudentNumber Section CapaID } {
if { [ catch {set parsedIn($type) [string range "$answerLine" \
[lindex $gScorer($sheet.$type) 0] \
[lindex $gScorer($sheet.$type) 1] ] } ] } {
set parsedIn($type) ""
}
}
set letter "ABCDEFGHIJ"
set number "1234567890"
set offset [lindex $gScorer($sheet.Question) 0]
set maxQuest [lindex $gScorer($sheet.Question) 1]
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
set gScorer(numQuest.$num) $i
break
}
set array $letter
set start [expr $i * $perQuest + $offset ]
set stop [expr $start + $perQuest - 1 ]
set response [string range "$answerLine" $start $stop]
switch $gScorer(quest.$i.type.$num) {
ASSIGNED -
SINGLE_DIGIT -
ONE_OUT_OF_10 {
if { $gScorer(quest.$i.type.$num) != "ONE_OUT_OF_10" } {
set array $number
}
set howmany [oneResponse "$response" $perQuest which]
if { $howmany == 1 } {
set parsedIn(answer.$i) [string index $array $which]
} else {
if { $howmany > 1 } {
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 } {
set parsedIn(answer.$i) " "
incr parsedIn(spaces)
}
}
}
}
GLE -
TF {
if { $gScorer(quest.$i.type.$num) != "GLE" } {
set stepsize 2
} else {
set stepsize 3
}
set leafs $gScorer(quest.$i.leafs.$num)
for { set j 0 } { $j < $leafs } { incr j } {
set start [expr $j*$stepsize]
set stop [expr $start + $stepsize - 1]
set howmany [oneResponse [string range \
$response $start $stop] $perQuest which]
if { $howmany == 1 } {
append parsedIn(answer.$i) [string index $array \
[expr {$start + $which}]]
} else {
if { $howmany > 1 } {
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 } {
append parsedIn(answer.$i) " "
incr parsedIn(spaces)
}
}
}
}
}
N_OUT_OF_M -
STRING_MATCH {
set found 0
for { set j 0 } { $j < $perQuest } { incr j } {
set char [string index "$response" $j]
if { "$char" == 1 } {
append parsedIn(answer.$i) [string index $array $j]
incr found
}
}
if { ! $found } {
incr parsedIn(spaces)
set parsedIn(answer.$i) ""
}
}
}
}
#if there isn't a capaId already, treat the first four questions as
# capaID
# if { $parsedIn(CapaID) == "" && $gScorer(CheckPIN.$num) } {
# set pinWrong 0
# for {set j 0} {$j < 4} {incr j} {
# switch -regexp "$parsedIn(answer.$j)" {
# ^[A-J]$ {
# append parsedIn(CapaID) \
[string first $parsedIn(answer.$j) "ABCDEFGHIJ" ]
# }
# default {
# set pinWrong 1
# }
# }
# }
# if { $pinWrong } {
# scorerError $num PINWRONG parsedIn
# lappend result PINWRONG
# }
# }
# parray parsedIn
if { $result != "" } {
error "$result"
}
if { [catch {incr gMult $parsedIn(multiplemarks)}] } {
set gMult $parsedIn(multiplemarks)
}
# puts $gMult
}
proc getAnswers2 { PID set maxQuest num } {
global gFile
set pwd [pwd]
cd $gFile($num)
set result [getAnswersFromSet $PID $set $maxQuest]
cd $pwd
return $result
}
proc getAnswers { PID set maxQuest num } {
global gFile gCapaConfig
set pwd [pwd]
cd $gFile($num)
set temp [exec $gCapaConfig($num.answers_command) $PID {} 0 $set]
cd $pwd
set result ""
foreach line [split $temp "\n"] {
switch -- [lindex [split $line :] 0] {
ANS { lappend result [string range $line 4 end] }
}
}
return $result
}
###########################################################
# checkStudentNumber
###########################################################
###########################################################
###########################################################
proc checkStudentNumber { num answerStructVar } {
global gScorer gFile
upvar $answerStructVar answerStruct
# puts "Stunum1:$answerStruct(StudentNumber):"
if { ![inClasslist $num $answerStruct(StudentNumber)] } {
# puts "Stunum2:$answerStruct(StudentNumber):"
set matched [findByStudentName [string trim $answerStruct(LastName)] $gFile($num)]
if { [llength $matched] != 1 } {
getOneStudent "" $gFile($num) id name "Unable to find student id: $answerStruct(StudentNumber), entered name is $answerStruct(LastName), $answerStruct(FirstName)." "Name on paper:$answerStruct(LastName), $answerStruct(FirstName), Number on Paper: $answerStruct(StudentNumber)"
} else {
set id [lindex [lindex $matched 0] 0]
if { [makeSure "Unable to find bubbled id: $answerStruct(StudentNumber), name: $answerStruct(LastName) in classl, however I did find $matched. Use this one?"] != "Yes" } {
getOneStudent "" $gFile($num) id name "Unable to find student id: $answerStruct(StudentNumber), entered name is $answerStruct(LastName), $answerStruct(FirstName)." "Name on paper:$answerStruct(LastName), $answerStruct(FirstName), Number on Paper: $answerStruct(StudentNumber)"
} else {
}
}
if { $id == "" } {
scorerError $num NO_SUCH_STUDENT "$answerStruct(orignalLine)" \
$answerStruct(StudentNumber)
return 0
} else {
scorerMessage $num "Student Number $answerStruct(StudentNumber) not found in classl using $id instead." info
set answerStruct(StudentNumber) $id
}
}
# puts "Stunum3:$answerStruct(StudentNumber):"
return 1
}
###########################################################
# handleStudent
###########################################################
###########################################################
###########################################################
proc handleStudent { num answerStructVar} {
global gScorer gFile
upvar $answerStructVar answerStruct
if { ![checkStudentNumber $num answerStruct] } { return 0 }
scorerMessage $num "Finding Possible Students. . ."
if { ! $gScorer(AnonMode.$num) } {
set answerStruct(questionPID) $answerStruct(StudentNumber)
} else {
# puts "$answerStruct(StudentNumber):$answerStruct(CapaID):"
if { [string trim $answerStruct(CapaID)] == "" } {
scorerError $num NO_CODE_IN_ANON_MODE "$answerStruct(orignalLine)" \
$answerStruct(StudentNumber)
return 0
}
set answerStruct(questionPID) [getAnonModeID $num answerStruct]
if { [llength $answerStruct(questionPID)] > 6 } {
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). . ."
foreach questionPID $answerStruct(questionPID) {
scorerMessage $num "Getting Answers for $questionPID. . ."
if { [catch { set answerStruct(correct.$questionPID) \
[getAnswers $questionPID $gScorer(set.$num) \
$answerStruct(maxQuest) $num] } errorMsg ] } {
catch {puts $errorMsg}
scorerError $num UNABLE_TO_PARSE "$answerStruct(orignalLine)" \
$answerStruct(StudentNumber)
error UNABLE_TO_PARSE
}
# puts "$answerStruct(correct.$questionPID)"
}
scorerMessage $num "Grading Answers. . ."
foreach questionPID $answerStruct(questionPID) {
set answerStruct($questionPID.grade) [gradeSet $num answerStruct $questionPID]
scorerMessage $num "Correct: $answerStruct($questionPID.correct) #correct: $answerStruct($questionPID.grade) PID: $questionPID"
}
scorerMessage $num "Given: $answerStruct($questionPID.given)"
if { [llength $answerStruct(questionPID)] > 1 } {
scorerMessage $num "Selecting Student. . ."
if { $gScorer(QueryAboutPID.$num) } {
set answerStruct(questionPID) \
[getWhichAnon $num answerStruct $answerStruct(indices)]
} else {
set answerStruct(questionPID) \
[pickAnonHighest $num answerStruct $answerStruct(indices)]
}
scorerMessage $num "Student $answerStruct(StudentNumber) selected $answerStruct(questionPID)'s paper." info
}
return 1
}
###########################################################
# gradeQuestion
###########################################################
###########################################################
###########################################################
proc gradeQuestion { num questNum correct given answerStructVar } {
global gScorer
upvar $answerStructVar answerStruct
set numRight 0
switch $gScorer(quest.$questNum.type.$num) {
ONE_OUT_OF_10 -
GLE -
TF -
SINGLE_DIGIT {
# scorerMessage $num "The correct answer: $correct, The student's answer: $given"
set fmt "%-$gScorer(quest.$questNum.leafs.$num)s,"
append answerStruct(correct) [format $fmt $correct]
append answerStruct(given) [format $fmt $given]
for { set leafs 0 } { $leafs < $gScorer(quest.$questNum.leafs.$num)
} { incr leafs } {
if { [string index $correct $leafs] ==
[string index $given $leafs] } {
incr numRight
}
}
}
ASSIGNED {
# scorerMessage $num "The student got a $given out of $gScorer(quest.$questNum.points.$num) "
append answerStruct(correct) "$gScorer(quest.$questNum.points.$num),"
append answerStruct(given) "$given,"
if { [catch {incr given 0}] } {
set numRight 0
} else {
set numRight $given
}
}
N_OUT_OF_M {
# scorerMessage $num "The correct answer: $correct, The student's answer: $given"
set fmt "%-$gScorer(quest.$questNum.leafs.$num)s,"
append answerStruct(correct) [format $fmt $correct]
append answerStruct(given) [format $fmt $given]
set letters "ABCDEFGHIJ"
set maxLeaf $gScorer(quest.$questNum.leafs.$num)
for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
if { [string first [string index $letters $leaf] $correct] != -1 } {
set ansOn($leaf) 1
} else {
set ansOn($leaf) 0
}
}
for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
if { [string first [string index $letters $leaf] $given] != -1 } {
set stuOn($leaf) 1
} else {
set stuOn($leaf) 0
}
}
for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
if { $ansOn($leaf) == $stuOn($leaf) } { incr numRight }
}
}
STRING_MATCH {
# scorerMessage $num "The correct answer: $correct, The student's answer: $given"
set fmt "%-$gScorer(quest.$questNum.leafs.$num)s,"
append answerStruct(correct) [format $fmt $correct]
append answerStruct(given) [format $fmt $given]
set letters "ABCDEFGHIJ"
set maxLeaf 10
for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
if { [string first [string index $letters $leaf] $correct] != -1 } {
set ansOn($leaf) 1
} else {
set ansOn($leaf) 0
}
}
for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
if { [string first [string index $letters $leaf] $given] != -1 } {
set stuOn($leaf) 1
} else {
set stuOn($leaf) 0
}
}
for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
if { $ansOn($leaf) == $stuOn($leaf) } { incr numRight }
}
if { $numRight != $maxLeaf } { set numRight 0 }
}
default {
scorerMessage $num "Unknown question type while grading,"
}
}
return $numRight
}
###########################################################
# gradeSet
###########################################################
###########################################################
###########################################################
proc gradeSet { num answerStructVar questionPID } {
global gScorer
upvar $answerStructVar answerStruct
set numRight 0
for { set i 0 } { $i < $answerStruct(maxQuest) } { incr i } {
set correct [lindex $answerStruct(correct.$questionPID) $i]
set given $answerStruct(answer.$i)
set probRight [gradeQuestion $num $i $correct $given answerStruct]
incr numRight $probRight
append answerStruct($questionPID.numRight) $probRight
}
set answerStruct($questionPID.correct) $answerStruct(correct)
set answerStruct(correct) ""
set answerStruct($questionPID.given) $answerStruct(given)
set answerStruct(given) ""
return $numRight
}
###########################################################
# getScorerEntry
###########################################################
###########################################################
###########################################################
proc getScorerEntry { num PID } {
global gScorer
set fileId $gScorer(out.$num)
seek $fileId 0 start
set done 0
set found 0
set aline ""
set offset 0
while { ! $done } {
set readamt [gets $fileId aline]
if { [eof $fileId] } { set done 0 ; break}
if { 0 == [ string compare [string toupper [lindex $aline 0]] \
[string toupper $PID] ] } {
set done 1
set found 1
} else {
#plus one because gets swallows the newline it reads
set offset [expr $offset + $readamt + 1]
}
}
if { ! $found } { set offset -$offset }
return $offset
}
###########################################################
# setScorerEntry
###########################################################
###########################################################
###########################################################
proc setScorerEntry { num aline offset } {
global gScorer
set fileId $gScorer(out.$num)
seek $fileId [expr abs($offset)] start
puts $fileId $aline
}
###########################################################
# setOutput
###########################################################
###########################################################
###########################################################
proc setOutput { num answerStructVar} {
global gScorer
upvar $answerStructVar answerStruct
#FIXME what if questions PID is empty
set questionPID $answerStruct(questionPID)
set out [format "%9s %-30s %s %4s %3s %s %s %s" $answerStruct(StudentNumber) \
$answerStruct(Name) $answerStruct($questionPID.numRight) \
$answerStruct($questionPID.grade) $answerStruct(Section) \
$answerStruct($questionPID.given) $questionPID \
$answerStruct(SerialNumber)]
set offset [getScorerEntry $num $answerStruct(StudentNumber)]
setScorerEntry $num "$out" $offset
}
###########################################################
# finishScoring
###########################################################
###########################################################
###########################################################
proc finishScoring { num answerStructVar} {
global gScorer gMult
scorerMessage $num "Finishing . . ."
#puts $gMult
# puts "errors:"
# puts "$gScorer(errors.$num)"
scorerMessage $num "Finished, Feel free to Update .sb"
if { [makeSure "Would you like to update the .sb file?"] == "Yes" } {
scorerToSet $num
}
trace variable gScorer(quit.$num) w "scorerClose $num 0"
}
proc scorerStudentTime { num } {
puts [ time "scorerStudent $num" ]
}
###########################################################
# scorerStudent
###########################################################
###########################################################
###########################################################
proc scorerStudent { num } {
global gScorer
if { $gScorer(pause.$num) } {
if { [array names gScorer quit.$num] != "" } {
if { ![scorerClose $num] } {
unset gScorer(quit.$num)
set gScorer(pause.$num) 0
} else {
return
}
}
if { $gScorer(pause.$num) == 1 } {
scorerMessage $num "Pausing. . . " info
set gScorer(pause.$num) 2
}
after 100 "scorerStudent $num"
return
}
#getanswerline
if { [ catch { set answer [ getLine $num ] } ] } {
finishScoring $num answerStruct
return
}
set gScorer(needToUpdateDB) 1
#parseanswerline
if { [catch {parseLine $num $answer answerStruct} 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 ] } {
#write entry to outputfile if student was succesfully handled
if { $result } { setOutput $num answerStruct }
} else { #error handling Student
global errorCode errorInfo
displayError "An error occured when attempting to grade a student. The error is: $errorMsg"
}
}
incr gScorer(student.$num)
update
after idle "scorerStudent $num"
}
###########################################################
# restartScorer
###########################################################
###########################################################
###########################################################
proc restartScorer { num } {
global gScorer
if { ! [info exists gScorer(pause.$num) ] } {
initScorer $num
set gScorer(pause.$num) 0
} else {
}
after idle "scorerStudent $num"
}
###########################################################
# pauseScorer
###########################################################
###########################################################
###########################################################
proc pauseScorer { num } {
global gScorer
set gScorer(pause.$num) 1
}
###########################################################
# stopScorer
###########################################################
###########################################################
###########################################################
proc stopScorer { num } {
}
###########################################################
# unpauseScorer
###########################################################
###########################################################
###########################################################
proc unpauseScorer { num } {
global gScorer
set gScorer(pause.$num) 0
}
###########################################################
###########################################################
###########################################################
###########################################################
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) {
ONE_OUT_OF_10 -
SINGLE_DIGIT {
append answers [ expr [string index $numRight $i] * \
$gScorer(quest.$i.points.$num) ]
}
GLE -
TF -
N_OUT_OF_M {
set right [string index $numRight $i]
set leafs $gScorer(quest.$i.leafs.$num)
set points $gScorer(quest.$i.points.$num)
set unit [expr double($points)/double($leafs)]
if { $unit == 0 } { set unit $points }
switch $method {
CAPA {
set score [expr int($points-(2*$unit*($leafs-$right)))]
if { $score < 0 } { set score 0 }
}
Lenient {
set score [expr int($points-($unit*($leafs-$right)))]
}
Strict {
if { $right == $leafs } {
set score $points
} else {
set score 0
}
}
default {
scorerError $num UNKNOWN_GRADING_METHOD $method
}
}
append answers $score
}
STRING_MATCH -
ASSIGNED {
append answers [string index $numRight $i]
}
default {
}
}
}
return $answers
}
###########################################################
# scorerToSet2
###########################################################
###########################################################
###########################################################
proc scorerToSet2 { num method } {
global gScorer gFile
destroy .getGradingMethod$num
set processed 0
set done 0
set fileId $gScorer(out.$num)
set setId $gScorer(set.$num)
seek $fileId 0 start
#remove the header line
gets $fileId aline
scorerMessage $num "Processing. . ."
while { ! $done } {
gets $fileId aline
if { [eof $fileId] } {
set done 1
break
}
set studentNumber [lindex $aline 0]
incr processed
if { [ expr $processed % 100 ] == 0 } { scorerMessage $num $processed }
update idletasks
set cwd [pwd]
cd $gFile($num)
if { ![file exists [file join records set$setId.sb] ] } {
if { ![file exists [file join records set$setId.db] ] } {
cd $cwd
scorerMessage $num "set$setId.db does not exist" error
return
} else {
scorerMessage $num "Copying set$setId.db to set$setId.sb"
if { [catch {file copy [file join records set$setId.db] \
[file join records set$setId.sb] }] } {
cd $cwd
scorerMessage $num "Unable to create set$setId.sb from set$setId.db, please create it by hand" error
return
}
}
}
if { [catch { set offset [ scorer_get_entry $studentNumber $setId ] } errors] } {
cd $cwd
scorerMessage $num "Error trying to read set$setId.sb" error
return
}
cd $cwd
set name [string range $aline 10 39]
set numRight [lindex [string range $aline 40 end] 0]
set entry(answers) [ finalScorer $num $method $studentNumber $numRight ]
set entry(tries) ""
for { set i 0 } { $i < $gScorer(numQuest.$num) } { incr i } {
append entry(tries) ", 1"
}
set entry(tries) [string range $entry(tries) 1 end]
set cwd [pwd]
cd $gFile($num)
if { [ catch { scorer_set_entry $studentNumber $setId $offset \
$entry(answers) $entry(tries) } errors ] } {
cd $cwd
scorerMessage $num "Error trying to update set$setId.sb" error
return
}
cd $cwd
}
scorerMessage $num "Finished updating. . ."
update idletasks
set gScorer(needToUpdateDB) 0
if { [makeSure "Should I copy the updated set$setId.sb to set$setId.db"] == "Yes" } {
if { [file exists [file join $gFile($num) records set$setId.db] ] } {
if { [catch {file delete [file join $gFile($num) records set$setId.db]}]} {
scorerMessage $num "An error occured while trying to copy. Please do this by hand." error
}
}
if { [catch {file copy [file join $gFile($num) records set$setId.sb] \
[file join $gFile($num) records set$setId.db] }] } {
scorerMessage $num "An error occured while trying to copy. Please do this by hand." error
}
}
scorerMessage $num "Done"
}
###########################################################
# scorerToSet
###########################################################
###########################################################
###########################################################
proc scorerToSet { num } {
global gScorer
#getGradingMethod
set gradeWindow [toplevel .getGradingMethod$num]
set messageFrame [frame $gradeWindow.mesg]
set capaFrame [frame $gradeWindow.capa]
set lenientFrame [frame $gradeWindow.lenient]
set strictFrame [frame $gradeWindow.strict]
set cancelFrame [frame $gradeWindow.cancel]
pack $messageFrame $capaFrame $lenientFrame $strictFrame $cancelFrame \
-side top
label $messageFrame.mesg -text "Please Select a Grading Method:"
pack $messageFrame.mesg
button $capaFrame.capa -text "CAPA Standard" -command "scorerToSet2 $num CAPA"
# button $capaFrame.huh -text "Huh?"
pack $capaFrame.capa -side left
button $lenientFrame.lenient -text "Lenient Method" \
-command "scorerToSet2 $num Lenient"
# button $lenientFrame.huh -text "Huh?"
pack $lenientFrame.lenient -side left
button $strictFrame.strict -text "Strict Method" \
-command "scorerToSet2 $num Strict"
# button $strictFrame.huh -text "Huh?"
pack $strictFrame.strict -side left
button $cancelFrame.cancel -text "Cancel" -command "destroy $gradeWindow"
pack $cancelFrame.cancel
Centre_Dialog $gradeWindow default
}
###########################################################
# scorerQuit
###########################################################
###########################################################
###########################################################
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}
}
###########################################################
# scorerClose
###########################################################
###########################################################
###########################################################
proc scorerClose { num {mustClose 0} {dummy ""} {dummy2 ""} {dummy3 ""}} {
global gScorer
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
destroy .beginScorer$num
# freeStudentList $num
return 1
}
###########################################################
# loadScorerQuest
###########################################################
###########################################################
###########################################################
proc loadScorerQuest { num } {
global gScorer gFile
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. "
return
}
set line [gets $fileId ]
close $fileId
set numQuestions [lindex $line 2]
set flags [lindex $line 4]
$gScorer(quest.$num) delete 0 end
for { set i 0 } { $i < $numQuestions } { incr i } {
switch [string index $flags [expr $i * 3] ] {
a { set gScorer(questType.$num) ONE_OUT_OF_10 }
b { set gScorer(questType.$num) GLE }
c { set gScorer(questType.$num) TF }
d { set gScorer(questType.$num) ASSIGNED }
e { set gScorer(questType.$num) N_OUT_OF_M }
f { set gScorer(questType.$num) SINGLE_DIGIT }
g { set gScorer(questType.$num) STRING_MATCH }
}
set gScorer(questPoint.$num) [string index $flags [expr $i * 3 + 1] ]
set gScorer(questLeaf.$num) [string index $flags [expr $i * 3 + 2] ]
insertQuest $num end
}
}
###########################################################
# reScore
###########################################################
###########################################################
###########################################################
proc reScore { file } {
global gUniqueNumber gScorer gFile
set num [incr gUniqueNumber]
if { [catch {set gScorer(out.$num) [open $file "r"]}]} {
displayError "Unable to open $file"
return
}
set gScorer(set.$num) [lindex [split $file .] end]
set gFile($num) [file dirname [file dirname $file]]
set line [gets $gScorer(out.$num) ]
set gScorer(numQuest.$num) [lindex $line 2]
set flags [lindex $line 4]
for { set i 0 } { $i < $gScorer(numQuest.$num) } { incr i } {
switch [string index $flags [expr $i * 3] ] {
a { set gScorer(quest.$i.type.$num) ONE_OUT_OF_10 }
b { set gScorer(quest.$i.type.$num) GLE }
c { set gScorer(quest.$i.type.$num) TF }
d { set gScorer(quest.$i.type.$num) ASSIGNED }
e { set gScorer(quest.$i.type.$num) N_OUT_OF_M }
f { set gScorer(quest.$i.type.$num) SINGLE_DIGIT }
g { set gScorer(quest.$i.type.$num) STRING_MATCH }
}
set gScorer(quest.$i.points.$num) [string index $flags [expr $i * 3 + 1] ]
set gScorer(quest.$i.leafs.$num) [string index $flags [expr $i * 3 + 2] ]
}
set reScore [toplevel .reScore$num]
wm title $reScore "ReScoring $file"
set windowFrame [frame $reScore.windowFrame]
set buttonFrame [frame $reScore.buttonFrame]
pack $windowFrame $buttonFrame -side bottom
pack configure $windowFrame -expand true -fill both
pack configure $buttonFrame -anchor e
scrollbar $windowFrame.scroll -orient vertical -command \
"$windowFrame.text yview"
set gScorer(status.$num) [text $windowFrame.text -yscrollcommand \
"$windowFrame.scroll set" -wrap char -height 40]
pack $windowFrame.scroll $gScorer(status.$num) -side left -expand 0
pack configure $windowFrame.scroll -expand 0 -fill y
pack configure $gScorer(status.$num) -expand true -fill both
button $buttonFrame.ok -text Dismiss -command \
"destroy $reScore
catch {close $gScorer(out.$num)}"
bind $reScore <Destroy> "catch {close $gScorer(out.$num)}"
button $buttonFrame.save -text "Save Messages" -command "saveScorerMsg $num"
button $buttonFrame.print -text "Print Messages" -command "printScorerMsg $num"
pack $buttonFrame.print $buttonFrame.save $buttonFrame.ok -side left
Centre_Dialog $reScore default
update
scorerToSet $num
}
#The flags struct is
# name
# question to ask
# yes (1) response
# no (0) response
set gScorer(flags) \
{
{
CheckPIN
{Is there a capaID/CODE on the paper?}
Yes
No
1
}
{
AnonMode
{Is this an anonymous Exam?}
Yes
No
0
}
{
QueryAboutPID
{When finding multiple PIDs matching a capaID:}
{Ask which to use}
{Pick one with highest score}
0
}
}
# {
# SurveyMode
# {What is being scanned?}
# Survey
# Exam/Quiz
# 0
# }
# {
# SurveyHeader
# {Does the Survey have a header?}
# Yes
# No
# 0
# }
# {
# CheckSpaces
# {Should scorer worry about blank questions?}
# Yes
# No
# 0
# }
# {
# CheckMultipleMarks
# {Should scorer worry about multiple marks on single mark questions?}
# Yes
# No
# 0
# }
# {
# IdFormat
# {What format is the student number in?}
# A<number>
# {Social Security}
# 1
# }
# {
# Form
# {Which form size is being used? Select Half Sheet}
# {Full sheet}
# {Half Sheet}
# 0
# }
# {
# log
# {When encountering errors: Select Query the User}
# {Log them}
# {Query the user}
# 1
# }
#Counting from zero, first number is column of start of the field,
#second number is end of the field. The Question field is an
#exception first comes start of question responses then # of
#responses, and then the number of bubbles per response
#Full Sheet Specs
set gScorer(FullSheet.SerialNumber) { 5 8 }
set gScorer(FullSheet.LastName) { 40 49 }
set gScorer(FullSheet.FirstName) { 50 54 }
set gScorer(FullSheet.MiddleInitial) { 55 55 }
set gScorer(FullSheet.StudentNumber) { 56 64 }
set gScorer(FullSheet.Section) { 65 67 }
set gScorer(FullSheet.CapaID) { }
#No CapaID spot on full sheet
set gScorer(FullSheet.Question) { 76 50 10 }
#Half Sheet Specs
set gScorer(HalfSheet.SerialNumber) { 5 8 }
set gScorer(HalfSheet.LastName) { 40 49 }
set gScorer(HalfSheet.FirstName) { 50 50 }
set gScorer(HalfSheet.MiddleInitial) { }
#No Middle Initial
set gScorer(HalfSheet.StudentNumber) { 56 64 }
set gScorer(HalfSheet.Section) { 65 67 }
set gScorer(HalfSheet.CapaID) { 68 73 }
set gScorer(HalfSheet.Question) { 76 50 10 }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to scorer.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools