Annotation of capa/capa51/GUITools/scorer.tcl, revision 1.15
1.14 albertel 1: # automated scoring of bubble sheets
2: # Copyright (C) 1992-2000 Michigan State University
3: #
4: # The CAPA system is free software; you can redistribute it and/or
1.15 ! albertel 5: # modify it under the terms of the GNU General Public License as
1.14 albertel 6: # published by the Free Software Foundation; either version 2 of the
7: # License, or (at your option) any later version.
8: #
9: # The CAPA system is distributed in the hope that it will be useful,
10: # but WITHOUT ANY WARRANTY; without even the implied warranty of
11: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1.15 ! albertel 12: # General Public License for more details.
1.14 albertel 13: #
1.15 ! albertel 14: # You should have received a copy of the GNU General Public
1.14 albertel 15: # License along with the CAPA system; see the file COPYING. If not,
16: # write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
17: # Boston, MA 02111-1307, USA.
18: #
19: # As a special exception, you have permission to link this program
20: # with the TtH/TtM library and distribute executables, as long as you
21: # follow the requirements of the GNU GPL in regard to all of the
22: # software in the executable aside from TtH/TtM.
23:
1.1 albertel 24: ###########################################################
25: # scorer.output.num file looks like this
26: # classname setNum numQuest flags questiondescriptor
27: # flags come in the order of CheckPIN, AnonMode, (CheckSpaces, Gone)
28: # (SurveyMode, Gone) (SurveyHeader, Gone) (IdFormat, Gone)
29: # (CheckMultipleMarks, Gone) QueryAboutPID, (log gone)
30: ###########################################################
31:
32: ###########################################################
33: # scorerMessage
34: ###########################################################
35: ###########################################################
36: ###########################################################
37: proc scorerMessage { num mesg {tag normal} } {
38: global gScorer
39: $gScorer(status.$num) insert end "$mesg\n" $tag
40: $gScorer(status.$num) see end
41: # update
42: }
43:
44: ###########################################################
45: # scorerError
46: ###########################################################
47: ###########################################################
48: ###########################################################
49: proc scorerError { num errorCode args } {
50: global gScorer
51: switch $errorCode {
1.13 albertel 52: INVALID_CAPAID {
53: lappend gScorer(errortype.$num) $errorCode
54: lappend gScorer(errors.$num) [lindex $args 0]
55: scorerMessage $num "Student [lindex $args 1]'s paper had an unknown CapaID" error
56: }
1.1 albertel 57: LOTS_OF_ANON_MODE_MATCHES {
58: lappend gScorer(errortype.$num) $errorCode
59: lappend gScorer(errors.$num) [lindex $args 0]
60: scorerMessage $num "More than 6 Student IDs generate the closest match to the capaID specified on [lindex $args 1]'s paper" error
61: }
62: NO_CODE_IN_ANON_MODE {
63: lappend gScorer(errortype.$num) $errorCode
64: lappend gScorer(errors.$num) [lindex $args 0]
65: scorerMessage $num "There was no CapaID/CODE on [lindex $args 1]'s paper" error
66: }
67: NO_SUCH_STUDENT {
68: lappend gScorer(errortype.$num) $errorCode
69: lappend gScorer(errors.$num) [lindex $args 0]
70: scorerMessage $num "Unable to find [lindex $args 1] in classl" error
71: }
72: UNABLE_TO_PARSE {
73: lappend gScorer(errortype.$num) $errorCode
74: lappend gScorer(errors.$num) [lindex $args 0]
75: scorerMessage $num "An error occured while trying to parse the set for [lindex $args 1]'s paper" error
76: }
77: PINWRONG -
78: UNKNOWN_GRADING_METHOD -
79: CANT_OPEN_SB -
80: CANT_UPDATE_SB -
81: default {
82: displayError "$errorCode $args"
83: }
84: }
85: incr gScorer(numerrors.$num)
86: update
87: }
88:
89: ###########################################################
90: # runScorer
91: ###########################################################
92: ###########################################################
93: ###########################################################
94: proc runScorer { setFile } {
95: global gUniqueNumber gWindowMenu gFile gScorer
96:
97: set num [incr gUniqueNumber]
98:
99: set classDir [file dirname $setFile]
100: set gFile($num) $classDir
101: # puts "set gFile($num) to $gFile($num)"
102: set scorerWin [toplevel .beginScorer$num]
103: $gWindowMenu add command -label "ScorerConfig $classDir" \
104: -command "capaRaise \"$scorerWin\""
105: wm title $scorerWin $classDir
106:
107: set infoFrame [frame $scorerWin.infoFrame ]
108: set buttonFrame [frame $scorerWin.buttonFrame ]
109: set configFrame [frame $scorerWin.configFrame ]
110: pack $infoFrame $buttonFrame $configFrame -side top
111:
112: set classNameFrame [frame $infoFrame.classNameFrame]
113: set setNumFrame [frame $infoFrame.setNumFrame]
114: set scoreFileFrame [frame $infoFrame.scoreFileFrame]
115: pack $classNameFrame $setNumFrame $scoreFileFrame -side top -anchor w
116:
117: #classname
118: label $classNameFrame.label -text "Class Name:"
119: entry $classNameFrame.entry -textvariable gScorer(class.$num)\
120: -width 8
121: # button $classNameFrame.button -text "What Goes Here" \
122: -command "helpScorer className"
123: pack $classNameFrame.label $classNameFrame.entry -side left
124: set gScorer(class.$num) [file tail $classDir]
125:
126: #set number
127: set gScorer(set.$num) [string range [file rootname [file tail $setFile]] 3 end]
128: label $setNumFrame.label -text "Set Number:"
129: entry $setNumFrame.set -width 2 -textvariable gScorer(set.$num)
130: pack $setNumFrame.label $setNumFrame.set -side left
131:
132: #scoring file
133: label $scoreFileFrame.label -text "Scoring Office File:"
134: set entryFrame [frame $scoreFileFrame.entryFrame]
135: button $scoreFileFrame.select -text "Select File" \
136: -command "selectScoringFile $num"
137: pack $scoreFileFrame.label $entryFrame $scoreFileFrame.select -side left
138: entry $entryFrame.entry -textvariable gScorer(scoreFile.$num) \
139: -xscrollcommand "$entryFrame.scroll set"
140: scrollbar $entryFrame.scroll -orient h -command \
141: "$entryFrame.entry xview"
142: pack $entryFrame.entry $entryFrame.scroll
143: pack configure $entryFrame.scroll -fill x
144:
145: #buttons
146: button $buttonFrame.cancel -text Cancel -command "destroy $scorerWin\
147: removeWindowEntry \"ScorerConfig $classDir\""
148: button $buttonFrame.continue -text "Continue" \
149: -command "getScorerQuest $num"
150: button $buttonFrame.load -text "Load Previous Settings" \
151: -command "loadScorerConfig $num"
152: pack $buttonFrame.cancel $buttonFrame.continue $buttonFrame.load \
153: -side left
154:
155: #config options
156: #flag list is from scorer.h
157: foreach flaglist $gScorer(flags) {
158: set flag [lindex $flaglist 0]
159: set question [lindex $flaglist 1]
160: set oneVal [lindex $flaglist 2]
161: set zeroVal [lindex $flaglist 3]
162: set defaultVal [lindex $flaglist 4]
163: set frame($flag) [frame $configFrame.[string tolower $flag] \
164: -relief groove -borderwidth 2]
165: set gScorer($flag.frame.$num) $frame($flag)
166: pack $frame($flag) -side top -anchor w
167: set frame($flag.top) [frame $frame($flag).top]
168: set frame($flag.bot) [frame $frame($flag).bot]
169: pack $frame($flag.top) $frame($flag.bot) -side top -anchor w
170: label $frame($flag.top).label -text "$question" -anchor w -width 70
171: # button $frame($flag.top).help -text "Huh?" -command "helpScorerFlags $flag"
172: pack $frame($flag.top).label -side left
173: radiobutton $frame($flag.bot).one -variable gScorer($flag.$num) \
174: -value 1 -text $oneVal -command "configureOptions $num"
175: radiobutton $frame($flag.bot).zero -variable gScorer($flag.$num) \
176: -value 0 -text $zeroVal -command "configureOptions $num"
177: set gScorer($flag.$num) $defaultVal
178: pack $frame($flag.bot).one $frame($flag.bot).zero -side left
179: }
180: parseCapaConfig $num $gFile($num)
181: configureOptions $num
182: loadScorerConfig $num
183: Centre_Dialog $scorerWin default
1.5 albertel 184: # trace variable gScorer(quit.$num) w "scorerClose $num 0"
1.1 albertel 185: }
186:
187: ###########################################################
188: # loadScorerConfig
189: ###########################################################
190: ###########################################################
191: ###########################################################
192: proc loadScorerConfig { num } {
193: global gScorer gFile
194:
195: set filename [file join $gFile($num) records scorer.output.$gScorer(set.$num)]
196: if { [ catch { set fileId [ open $filename "r" ] } ] } {
1.10 albertel 197: displayMessage "Creating a new scorer.output file for set $gScorer(set.$num)."
1.1 albertel 198: return
199: }
200: set line [gets $fileId ]
201: close $fileId
202: set flags [lindex $line 3]
203: #When uncommenting or commenting the following lines make sure to update the actual
204: #index values
205: set gScorer(CheckPIN.$num) [string index $flags 0]
206: set gScorer(AnonMode.$num) [string index $flags 1]
207: # set gScorer(CheckSpaces.$num) [string index $flags 2]
208: # set gScorer(SurveyMode.$num) [string index $flags 3]
209: # set gScorer(SurveyHeader.$num) [string index $flags 4]
210: # set gScorer(IdFormat.$num) [string index $flags 5]
211: # set gScorer(CheckMultipleMarks.$num) [string index $flags 6]
212: set gScorer(QueryAboutPID.$num) [string index $flags 2]
213: # set gScorer(Form.$num) [string index $flags 8]
214: # set gScorer(log.$num) [string index $flags 9]
215: configureOptions $num
216: }
217:
218: ###########################################################
219: ###########################################################
220: ###########################################################
221: ###########################################################
222: proc configureOptions { num } {
223: global gScorer
224:
225: foreach frame [array names gScorer "*.frame.$num"] {
226: pack forget $gScorer($frame)
227: }
228:
229: # pack $gScorer(SurveyMode.frame.$num) -side top
230: # if { $gScorer(SurveyMode.$num) } {}
231: # pack $gScorer(SurveyHeader.frame.$num)
232: # {}
233: pack $gScorer(CheckPIN.frame.$num)
234: if { $gScorer(CheckPIN.$num) } {
235: pack $gScorer(AnonMode.frame.$num)
236: if { $gScorer(AnonMode.$num) } {
237: pack $gScorer(QueryAboutPID.frame.$num)
238: } else {
239: set gScorer(QueryAboutPID.$num) 0
240: }
241: } else {
242: set gScorer(AnonMode.$num) 0
243: }
244: # pack $gScorer(CheckSpaces.frame.$num)
245: # pack $gScorer(CheckMultipleMarks.frame.$num)
246: # pack $gScorer(IdFormat.frame.$num)
247: # {}
248: # pack $gScorer(Form.frame.$num)
249: # pack $gScorer(log.frame.$num)
250: }
251:
252: ###########################################################
253: # selectScoringFile
254: ###########################################################
255: ###########################################################
256: ###########################################################
257: proc selectScoringFile { num } {
258: global gScorer
259: if { "" != [ set temp [tk_getOpenFile] ] } {set gScorer(scoreFile.$num) $temp}
260: }
261:
262: ###########################################################
263: ###########################################################
264: ###########################################################
265: ###########################################################
266: proc helpScorerFlags { flag } {
267: global gUniqueNumber gWindowMenu
268:
269: set num [incr gUniqueNumber]
270: set helpWin [toplevel .beginScorer$num]
271: $gWindowMenu add command -label "HelpFlag $flag" \
272: -command "capaRaise \" $helpWin\""
273: wm title $helpWin $flag
274:
275: button $helpWin.dismiss -text Dismiss -command "destroy $helpWin"
276: message $helpWin.help -aspect 2000
277: set help ""
278: switch $flag {
279: # 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." }
280: # SurveyHeader { set help "If the Survey given include a header portion this will let ."}
281: CheckPIN { set help "bluh" }
282: AnonMode { set help "bluh" }
283: QueryAboutPID { set help "bluh" }
284: # CheckSpaces { set help "bluh" }
285: # CheckMultipleMarks { set help "bluh" }
286: # IdFormat { set help "bluh" }
287: # Form { set help "bluh" }
288: # log { set help "bluh" }
289: }
290: $helpWin.help configure -text "$help"
291: pack $helpWin.dismiss $helpWin.help
292: Centre_Dialog $helpWin default
293: }
294:
295: ###########################################################
296: # getScorerQuest
297: ###########################################################
298: ###########################################################
299: ###########################################################
300: proc getScorerQuest { num } {
301: global gUniqueNumber gWindowMenu gFile gScorer
302:
303: if { ![file readable $gScorer(scoreFile.$num)] } {
304: displayMessage "Please Select a readable scoring office report file before continuing."
305: return
306: }
307:
308: set classDir $gFile($num)
309:
310: set scorerWin ".beginScorer$num"
311:
312: set infoFrame $scorerWin.infoFrame
313: set buttonFrame $scorerWin.buttonFrame
314: set configFrame $scorerWin.configFrame
315: set classNameFrame $infoFrame.classNameFrame
316: set setNumFrame $infoFrame.setNumFrame
317: set scoreFileFrame $infoFrame.scoreFileFrame
318: set entryFrame $scoreFileFrame.entryFrame
319:
320: destroy $configFrame
321: pack [frame $configFrame]
322:
323: destroy $scoreFileFrame.select
324: $entryFrame.entry configure -state disabled
325: $classNameFrame.entry configure -state disabled
326: $setNumFrame.set configure -state disabled
327:
328: #disabeling the config options
329: set classNameFrame $infoFrame.classNameFrame
330: set setNumFrame $infoFrame.setNumFrame
331: $classNameFrame.entry configure -state disabled
332: $setNumFrame.set configure -state disabled
333:
334: $buttonFrame.continue configure -command "startScorer $num"
335: $buttonFrame.load configure -command "loadScorerQuest $num"
336:
337: #question
338: set questButFrame [ frame $configFrame.butFrame ]
339: set questLabelFrame [frame $configFrame.label ]
340: set questListFrame [ frame $configFrame.listFrame ]
341: pack $questButFrame $questLabelFrame $questListFrame
342: pack configure $questLabelFrame -anchor w
343:
344: button $questButFrame.add -text "Add" -command "addScorerQuest $num"
345: button $questButFrame.clone -text "Clone" -command "cloneScorerQuest $num"
346: button $questButFrame.rm -text "Remove" -command "rmScorerQuest $num"
347: button $questButFrame.change -text "Change" -command "changeScorerQuest $num"
348: pack $questButFrame.add $questButFrame.clone $questButFrame.rm \
349: $questButFrame.change -side left
350:
351: label $questLabelFrame.label -text "Num Type Points Leafs"
352: pack $questLabelFrame.label
353:
354: #listbox
355: set gScorer(questNum.$num) [ listbox $questListFrame.questNum \
356: -width 3 -height 20 \
357: -yscrollcommand "$questListFrame.scroll set" ]
358: set gScorer(quest.$num) [ listbox $questListFrame.quest -width 50 -height 20 \
359: -yscrollcommand "$questListFrame.scroll set"]
360: scrollbar $questListFrame.scroll -orient v -command \
361: "scrolltwo \"$questListFrame.quest yview\" \"$questListFrame.questNum yview\""
362: pack $questListFrame.scroll $questListFrame.quest \
363: $questListFrame.questNum -side right
364: pack configure $questListFrame.scroll -fill y
365: loadScorerQuest $num
366: update idletasks
367: Centre_Dialog $scorerWin default
368: }
369:
370: ###########################################################
371: # configQuestWin
372: ###########################################################
373: ###########################################################
374: ###########################################################
375: proc configQuestWin { num action {message ""} {max 1} } {
376: global gScorer
377:
378: if { ![winfo exists .scorerQuestWin$num] } { return }
379: set frame .scorerQuestWin$num.add.leaf
380:
381: switch $action {
382: hide
383: { pack forget $frame }
384: show
385: {
386: pack $frame
387: $frame.leafs configure -label $message
388: $frame.leafs configure -to $max
389: }
390: }
391: }
392:
393:
394: ###########################################################
395: # renumberScorerQuest
396: ###########################################################
397: ###########################################################
398: ###########################################################
399: proc renumberScorerQuest { num } {
400: global gScorer
401: $gScorer(questNum.$num) delete 0 end
402: set max [$gScorer(quest.$num) index end ]
403: for { set i 1 } { $i <= $max } { incr i } {
404: lappend numList $i
405: }
406: eval "$gScorer(questNum.$num) insert 0 $numList"
407: $gScorer(questNum.$num) yview [ $gScorer(quest.$num) nearest 5 ]
408: }
409:
410: ###########################################################
411: # insertQuest
412: ###########################################################
413: ###########################################################
414: ###########################################################
415: proc insertQuest { num where } {
416: global gScorer
417:
418: if { $where != "end" } { $gScorer(quest.$num) delete $where }
419: switch $gScorer(questType.$num) {
420: ONE_OUT_OF_10
421: -
422: ASSIGNED
423: -
424: SINGLE_DIGIT
425: -
426: STRING_MATCH
427: {
428: $gScorer(quest.$num) insert $where [format "%-13s %7s" \
429: $gScorer(questType.$num) $gScorer(questPoint.$num)]
430: }
431: GLE
432: -
433: TF
434: -
435: N_OUT_OF_M
436: {
437: $gScorer(quest.$num) insert $where [format "%-13s %7s %6s" \
438: $gScorer(questType.$num) $gScorer(questPoint.$num) \
439: $gScorer(questLeaf.$num)]
440: }
441: }
442: renumberScorerQuest $num
1.6 albertel 443: update
444: $gScorer(quest.$num) see $where
1.1 albertel 445: }
446:
447: ###########################################################
448: # addScorerQuest
449: ###########################################################
450: ###########################################################
451: ###########################################################
452: proc addScorerQuest { num {position end} } {
453: global gUniqueNumber gWindowMenu gFile gScorer
454:
455: if { [winfo exists .scorerQuestWin$num] } { return }
456: set questWin [ toplevel .scorerQuestWin$num ]
457:
458: if { ! [ info exists gScorer(questType.$num) ] } {
459: set gScorer(questType.$num) ONE_OUT_OF_10
460: }
461:
462: set buttonFrame [ frame $questWin.button ]
463: set optionFrame [ frame $questWin.add ]
464: pack $buttonFrame $optionFrame -side top
465:
466: set text Change
467: if { $position == "end" } {
468: set text Add
469: }
470: button $buttonFrame.done -text $text -command "insertQuest $num $position
471: destroy $questWin"
472: button $buttonFrame.cancel -text "Cancel" -command "destroy $questWin"
473: pack $buttonFrame.done $buttonFrame.cancel -side left
474:
475: set typeFrame [ frame $optionFrame.type ]
476: set pointFrame [ frame $optionFrame.point ]
477: set leafFrame [ frame $optionFrame.leaf ]
478: pack $typeFrame $pointFrame $leafFrame -side top
479:
480: radiobutton $typeFrame.oneoutof8 -text "One out of no more than 10" -value "ONE_OUT_OF_10" \
481: -variable gScorer(questType.$num) -command "configQuestWin $num hide"
482: radiobutton $typeFrame.gletype -text "GLE type" -value "GLE" \
483: -variable gScorer(questType.$num) \
484: -command "configQuestWin $num show \"Number of Leafs\" 3 "
485: radiobutton $typeFrame.tftype -text "TF type" -value "TF" \
486: -variable gScorer(questType.$num) \
487: -command "configQuestWin $num show \"Number of Leafs\" 5 "
488: radiobutton $typeFrame.assigned -text "Assigned score" -value "ASSIGNED" \
489: -variable gScorer(questType.$num) -command "configQuestWin $num hide "
490: radiobutton $typeFrame.noutofm -text "N out of M" -value "N_OUT_OF_M" \
491: -variable gScorer(questType.$num) \
492: -command "configQuestWin $num show \"What is the value of M\" 10 "
493: radiobutton $typeFrame.singledigit -text "Single digit" -value "SINGLE_DIGIT" \
494: -variable gScorer(questType.$num) -command "configQuestWin $num hide"
495: radiobutton $typeFrame.exactstring -text "Exact string matching" \
496: -value "STRING_MATCH" -variable gScorer(questType.$num) \
497: -command "configQuestWin $num hide"
498: pack $typeFrame.oneoutof8 $typeFrame.gletype $typeFrame.tftype \
499: $typeFrame.assigned $typeFrame.noutofm $typeFrame.singledigit \
500: $typeFrame.exactstring -side top -anchor w
501:
502: scale $pointFrame.points -from 0 -to 9 -variable gScorer(questPoint.$num) \
503: -label "Point Value" -orient h -length 300
504: pack $pointFrame.points
505:
506: scale $leafFrame.leafs -from 1 -to 10 -variable gScorer(questLeaf.$num) \
507: -label "Number of Leafs" -orient h -length 300
508: pack $leafFrame.leafs
509:
510: switch $gScorer(questType.$num) {
511: ONE_OUT_OF_10
512: -
513: ASSIGNED
514: -
515: SINGLE_DIGIT
516: -
517: STRING_MATCH { configQuestWin $num hide }
518: GLE { configQuestWin $num show "Number of Leafs" 3 }
519: TF { configQuestWin $num show "Number of Leafs" 5 }
520: N_OUT_OF_M { configQuestWin $num show "What is the value of M" 10 }
521: }
522: Centre_Dialog $questWin default
523: }
524:
525: ###########################################################
526: # cloneScorerQuest
527: ###########################################################
528: ###########################################################
529: ###########################################################
530: proc cloneScorerQuest { num } {
531: global gUniqueNumber gWindowMenu gFile gScorer
532:
533: if { [ $gScorer(quest.$num) curselection ] == "" } {
534: displayError "Please select an exisiting question to clone."
535: return
536: }
537:
538: set temp [ $gScorer(quest.$num) get [ $gScorer(quest.$num) curselection ] ]
539: $gScorer(quest.$num) insert end $temp
1.6 albertel 540: $gScorer(quest.$num) see end
1.1 albertel 541: renumberScorerQuest $num
542: }
543:
544: ###########################################################
545: # rmScorerQuest
546: ###########################################################
547: ###########################################################
548: ###########################################################
549: proc rmScorerQuest { num } {
550: global gUniqueNumber gWindowMenu gFile gScorer
551:
552: if { [winfo exists .scorerQuestWin$num] } { return }
553: if { [ $gScorer(quest.$num) curselection ] == "" } {
554: displayError "Please select an exisiting question to delete."
555: return
556: }
557: $gScorer(quest.$num) delete [$gScorer(quest.$num) curselection]
558: renumberScorerQuest $num
559: }
560:
561: ###########################################################
562: # changeScorerQuest
563: ###########################################################
564: ###########################################################
565: ###########################################################
566: proc changeScorerQuest { num } {
567: global gUniqueNumber gWindowMenu gFile gScorer
568:
569: if { [winfo exists .scorerQuestWin$num] } { return }
570: if { [ $gScorer(quest.$num) curselection ] == "" } {
571: displayError "Please select an exisiting question to change."
572: return
573: }
574:
575: set position [ $gScorer(quest.$num) curselection ]
576: set gScorer(questType.$num) [lindex [$gScorer(quest.$num) get $position ] 0 ]
577: set gScorer(questPoint.$num) [lindex [$gScorer(quest.$num) get $position ] 1 ]
578: set gScorer(questLeaf.$num) [lindex [$gScorer(quest.$num) get $position ] 2 ]
579: addScorerQuest $num $position
580: }
581:
582: ###########################################################
583: # startScorer
584: ###########################################################
585: ###########################################################
586: ###########################################################
587: proc startScorer { num } {
588: global gScorer gFile
589:
590: set scorerWin .beginScorer$num
591:
592: set filename [file join $gFile($num) records scorer.output.$gScorer(set.$num)]
593: if { [ catch { set fileId [ open $filename "w+" ] } ] } {
594: displayError "Unable to write to the scorer.output file. "
595: return
596: }
597: #When deleting or adding anything to the flags var make sure to update loadScorerConfig
598: # 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)
599: set flags $gScorer(CheckPIN.$num)$gScorer(AnonMode.$num)$gScorer(QueryAboutPID.$num)
600: set numQuestion [ $gScorer(quest.$num) index end ]
601: set questString ""
602: for { set i 0 } { $i < $numQuestion } { incr i } {
603: set line [ $gScorer(quest.$num) get $i ]
604: set gScorer(quest.$i.type.$num) [lindex $line 0]
605: switch [lindex $line 0 ] {
606: ONE_OUT_OF_10 { append questString a }
607: GLE { append questString b }
608: TF { append questString c }
609: ASSIGNED { append questString d }
610: N_OUT_OF_M { append questString e }
611: SINGLE_DIGIT { append questString f }
612: STRING_MATCH { append questString g }
613: }
614: append questString [lindex $line 1]
615: set gScorer(quest.$i.points.$num) [lindex $line 1]
616: if { [ lindex $line 2 ] == "" } {
617: set gScorer(quest.$i.leafs.$num) 1
618: append questString 1
619: } else {
620: set gScorer(quest.$i.leafs.$num) [lindex $line 2]
621: append questString [lindex $line 2]
622: }
623: }
624: set outputLine "$gScorer(class.$num) $gScorer(set.$num) $numQuestion $flags $questString"
625: puts $fileId [format "%-500s" $outputLine]
626: close $fileId
627: destroy $scorerWin.buttonFrame
628: destroy $scorerWin.configFrame
629:
630: set gScorer(student.$num) 0
631: set gScorer(numerrors.$num) 0
632:
633: set buttonFrame [frame $scorerWin.buttonFrame]
634: set statusFrame [frame $scorerWin.statusFrame]
635: pack $buttonFrame $statusFrame
636:
637: button $buttonFrame.pause -text Pause -command "pauseScorer $num"
638: button $buttonFrame.cont -text Continue -command "unpauseScorer $num"
639: button $buttonFrame.restart -text Restart -command "restartScorer $num"
640: button $buttonFrame.final -text "Update .sb" -command "scorerToSet $num"
641: button $buttonFrame.exit -text "Quit" -command "scorerQuit $num"
642: pack $buttonFrame.pause $buttonFrame.cont $buttonFrame.restart \
643: $buttonFrame.final $buttonFrame.exit -side left
644:
645:
646: message $statusFrame.mesg -text "Messages:" -aspect 2000
647: set statusText [frame $statusFrame.statusText]
648: set student [frame $statusFrame.student]
649: set errors [frame $statusFrame.errors]
650: set statusButtons [frame $statusFrame.button]
651: pack $statusFrame.mesg $statusFrame.statusText $statusFrame.student \
652: $statusFrame.errors $statusFrame.button
653: pack configure $statusFrame.mesg $statusFrame.student $statusFrame.errors \
654: -anchor w
655: pack configure $statusText -expand 1 -fill both
656:
657: set gScorer(status.$num) [text $statusText.text -wrap char \
658: -yscrollcommand "$statusText.scroll set"]
659: $gScorer(status.$num) tag configure error -foreground red
660: $gScorer(status.$num) tag configure info -foreground #006c00
661:
662: scrollbar $statusText.scroll -orient v -command "$statusText.text yview"
663: pack $statusText.text $statusText.scroll -side left
664: pack configure $statusText.scroll -fill y
665: pack configure $gScorer(status.$num) -expand 1 -fill both
666:
667: label $student.mesg -text "Students completed:"
668: label $student.num -textvariable gScorer(student.$num)
669: pack $student.mesg $student.num -side left
670:
671: label $errors.mesg -text "Errors To Be Handled:"
672: label $errors.num -textvariable gScorer(numerrors.$num)
673: pack $errors.mesg $errors.num -side left
674:
1.2 albertel 675: button $statusButtons.handleErrors -text "Save Errors" \
1.1 albertel 676: -command "handleErrorsScorer $num"
677: button $statusButtons.printMsg -text "Print Messages" \
678: -command "printScorerMsg $num"
679: button $statusButtons.saveMsg -text "Save Messages" \
680: -command "saveScorerMsg $num"
681: button $statusButtons.clearMsg -text "Clear Messages" \
682: -command "clearScorerMsg $num"
683: pack $statusButtons.handleErrors $statusButtons.printMsg \
684: $statusButtons.saveMsg -side left
685:
686: wm protocol $scorerWin WM_DELETE_WINDOW "usequit $num"
687: update idletasks
688: Centre_Dialog $scorerWin default
689: # set gScorer(quit.$num) 0
690: restartScorer $num
691: }
692:
693: ###########################################################
694: # usequit
695: ###########################################################
696: ###########################################################
697: ###########################################################
698: proc usequit { num } { scorerMessage $num "Please use the Quit Button." info }
699:
700: ###########################################################
701: # saveScorerMsg
702: ###########################################################
703: ###########################################################
704: ###########################################################
705: proc saveScorerMsg { num } {
706: global gScorer
707:
708: set file [tk_getSaveFile -title "Enter the name to save messages to."]
709: if { $file == "" } { return }
710: if { [catch {set fileId [open $file "w"] } ] } {
711: displayError "Unable to open $file"
712: return
713: }
714: set tag [getWhichTags "All {Errors Only} {NonErrors Only}" "{} error normal" "saved"]
715: puts -nonewline $fileId [getTextTagged $gScorer(status.$num) $tag ]
716: close $fileId
717: }
718:
719: ###########################################################
720: # printScorerMsg
721: ###########################################################
722: ###########################################################
723: ###########################################################
724: proc printScorerMsg { num } {
725: global gScorer gFile
726:
727: set file [file join $gFile($num) managertemp.txt]
728: set lprCommand [getLprCommand $file $num]
729: if { $lprCommand == "Cancel" } { return }
730: if { [catch {set fileId [open $file "w"] } ] } {
731: displayError "Unable to open $file"
732: return
733: }
734: set tag [getWhichTags "All {Errors Only} {NonErrors Only}" "{} error normal" printed]
735: puts -nonewline $fileId [getTextTagged $gScorer(status.$num) $tag ]
736: close $fileId
737: set errorMsg ""
738: set error [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]
739: exec rm -f $file
740: if { $error == 1 } {
741: displayError "An error occurred while printing: $errorMsg"
742: } else {
743: displayMessage "Print job sent to the printer.\n $output"
744: }
745: }
746:
747: ###########################################################
748: # initScorer
749: ###########################################################
750: ###########################################################
751: ###########################################################
752: proc initScorer { num } {
753: global gScorer gFile
754:
755: scorerMessage $num "Initializing. . ."
756:
757: if { ![info exists gScorer(in.$num)] || ( $gScorer(in.$num) == "" ) } {
758: if { [catch {set gScorer(in.$num) \
759: [ open $gScorer(scoreFile.$num) "r" ] } ] } {
760: displayError "Unable to open input file $gScorer(scoreFile.$num)"
761: exit
762: }
763: }
764:
765: set filename [file join $gFile($num) records scorer.output.$gScorer(set.$num)]
766: if { ![info exists gScorer(out.$num)] || ( $gScorer(out.$num) == "" ) } {
767: if { [catch {set gScorer(out.$num) [ open $filename "a+" ] } ] } {
768: displayError "Unable to open input file $filename"
769: exit
770: }
771: }
772:
773: scorerMessage $num "Building List of Students. . ."
774: update
775: set oldDir [pwd]
776: cd $gFile($num)
777:
778: #4 is the length of the CapaID
779: set a $gScorer(HalfSheet.CapaID)
780: set capaidplus [expr {[lindex $a 1] - [lindex $a 0] - 3}]
781: # puts "$capaidplus, $a"
782: set gScorer(studentList.$num) [buildStudentList $num $gScorer(class.$num) \
783: $gScorer(set.$num) $capaidplus]
784: cd $oldDir
785: }
786:
787: ###########################################################
788: # getLine
789: ###########################################################
790: ###########################################################
791: ###########################################################
792: proc getLine { num } {
793: global gScorer
794:
1.4 albertel 795: scorerMessage $num "\nGetting Responses"
1.1 albertel 796:
797: set done 0
798: while { ! $done } {
799: gets $gScorer(in.$num) aline
800: if { [eof $gScorer(in.$num) ] } { error EOF }
801: if { ![string match "#*" $aline] } {
802: set done 1
803: }
804: }
805: return $aline
806: }
807:
808: ###########################################################
809: # oneResponse
810: ###########################################################
811: ###########################################################
812: ###########################################################
813: proc oneResponse { response max which } {
814: upvar $which whichVar
815: set whichVar ""
816: set howmany 0
817: for { set i 0 } { $i < $max } { incr i } {
818: if { [string index "$response" $i] == "1" } {
819: lappend whichVar $i
820: incr howmany
821: }
822: }
823: return $howmany
824: }
825: ###########################################################
826: # parseLine
827: ###########################################################
828: ###########################################################
829: ###########################################################
830: proc parseLine { num answerLine answerStruct } {
1.12 albertel 831: global gScorer gMult
1.1 albertel 832: upvar $answerStruct parsedIn
833: set result ""
834:
835: scorerMessage $num "Understanding Responses"
836:
837: # Only support HalfSheets
838: # if { $gScorer(Form.$num) } {
839: # set sheet FullSheet
840: # } else {
841: # set sheet HalfSheet
842: # }
843: set sheet HalfSheet
844:
845: set parsedIn(orignalLine) "$answerLine"
846: foreach type { SerialNumber LastName FirstName MiddleInitial
847: StudentNumber Section CapaID } {
848: if { [ catch {set parsedIn($type) [string range "$answerLine" \
849: [lindex $gScorer($sheet.$type) 0] \
850: [lindex $gScorer($sheet.$type) 1] ] } ] } {
851: set parsedIn($type) ""
852: }
853: }
854: set letter "ABCDEFGHIJ"
855: set number "1234567890"
856: set offset [lindex $gScorer($sheet.Question) 0]
857: set maxQuest [lindex $gScorer($sheet.Question) 1]
858: set perQuest [lindex $gScorer($sheet.Question) 2]
859: set parsedIn(multiplemarks) 0
860: set parsedIn(spaces) 0
1.9 albertel 861: set parsedIn(maxQuest) $maxQuest
1.1 albertel 862: for { set i 0 } { $i < $maxQuest } { incr i } {
863: if { [ catch { set gScorer(quest.$i.type.$num) } ] } {
864: set parsedIn(maxQuest) $i
865: set gScorer(numQuest.$num) $i
866: break
867: }
868: set array $letter
869: set start [expr $i * $perQuest + $offset ]
870: set stop [expr $start + $perQuest - 1 ]
871: set response [string range "$answerLine" $start $stop]
872: switch $gScorer(quest.$i.type.$num) {
873: ASSIGNED -
874: SINGLE_DIGIT -
875: ONE_OUT_OF_10 {
876: if { $gScorer(quest.$i.type.$num) != "ONE_OUT_OF_10" } {
877: set array $number
878: }
879: set howmany [oneResponse "$response" $perQuest which]
880: if { $howmany == 1 } {
881: set parsedIn(answer.$i) [string index $array $which]
882: } else {
883: if { $howmany > 1 } {
1.12 albertel 884: set options ""
885: foreach possible $which {
886: append options "[string index $array $possible] "
887: }
888: set selected [multipleChoice . "There were multiple marks on\nPaper Number $parsedIn(SerialNumber)\nStudentNumber $parsedIn(StudentNumber)\nProblem Number [expr $i+1]" $options]
889: #puts ":$parsedIn(StudentNumber):$parsedIn(SerialNumber):[format %2d [expr $i+1]]:$selected:$options"
890: set parsedIn(answer.$i) $selected
891: #puts $parsedIn(answer.$i)
1.1 albertel 892: incr parsedIn(multiplemarks)
893: } else {
894: if { $howmany < 1 } {
895: set parsedIn(answer.$i) " "
896: incr parsedIn(spaces)
897: }
898: }
899: }
900: }
901: GLE -
902: TF {
903: if { $gScorer(quest.$i.type.$num) != "GLE" } {
904: set stepsize 2
905: } else {
906: set stepsize 3
907: }
908: set leafs $gScorer(quest.$i.leafs.$num)
909: for { set j 0 } { $j < $leafs } { incr j } {
910: set start [expr $j*$stepsize]
911: set stop [expr $start + $stepsize - 1]
912: set howmany [oneResponse [string range \
913: $response $start $stop] $perQuest which]
914: if { $howmany == 1 } {
915: append parsedIn(answer.$i) [string index $array \
916: [expr {$start + $which}]]
917: } else {
918: if { $howmany > 1 } {
1.12 albertel 919: set options ""
920: foreach possible $which {
921: append options "[string index $array [expr {$start + $possible}]] "
922: }
923: set selected [multipleChoice . "There were multiple marks on\nPaper Number $parsedIn(SerialNumber)\nStudentNumber $parsedIn(StudentNumber)\nProblem Number [expr $i+1]" $options]
924: #puts ":$parsedIn(StudentNumber):$parsedIn(SerialNumber):[format %2d [expr $i+1]]:$selected:$options"
925: append parsedIn(answer.$i) $selected
926: #puts $parsedIn(answer.$i)
1.1 albertel 927: incr parsedIn(multiplemarks)
928: } else {
929: if { $howmany < 1 } {
930: append parsedIn(answer.$i) " "
931: incr parsedIn(spaces)
932: }
933: }
934: }
935: }
936: }
937: N_OUT_OF_M -
938: STRING_MATCH {
939: set found 0
940: for { set j 0 } { $j < $perQuest } { incr j } {
941: set char [string index "$response" $j]
942: if { "$char" == 1 } {
943: append parsedIn(answer.$i) [string index $array $j]
944: incr found
945: }
946: }
947: if { ! $found } {
948: incr parsedIn(spaces)
949: set parsedIn(answer.$i) ""
950: }
951: }
952: }
953: }
954: #if there isn't a capaId already, treat the first four questions as
955: # capaID
956: # if { $parsedIn(CapaID) == "" && $gScorer(CheckPIN.$num) } {
957: # set pinWrong 0
958: # for {set j 0} {$j < 4} {incr j} {
959: # switch -regexp "$parsedIn(answer.$j)" {
960: # ^[A-J]$ {
961: # append parsedIn(CapaID) \
962: [string first $parsedIn(answer.$j) "ABCDEFGHIJ" ]
963: # }
964: # default {
965: # set pinWrong 1
966: # }
967: # }
968: # }
969: # if { $pinWrong } {
970: # scorerError $num PINWRONG parsedIn
971: # lappend result PINWRONG
972: # }
973: # }
974: # parray parsedIn
975: if { $result != "" } {
976: error "$result"
977: }
1.12 albertel 978: if { [catch {incr gMult $parsedIn(multiplemarks)}] } {
979: set gMult $parsedIn(multiplemarks)
980: }
981: # puts $gMult
1.1 albertel 982: }
983:
984: proc getAnswers2 { PID set maxQuest num } {
985: global gFile
986: set pwd [pwd]
987: cd $gFile($num)
988: set result [getAnswersFromSet $PID $set $maxQuest]
989: cd $pwd
990: return $result
991: }
992:
993: proc getAnswers { PID set maxQuest num } {
994: global gFile gCapaConfig
995: set pwd [pwd]
996: cd $gFile($num)
1.7 albertel 997: set temp [exec $gCapaConfig($num.answers_command) $PID {} 0 $set]
1.1 albertel 998: cd $pwd
999: set result ""
1000: foreach line [split $temp "\n"] {
1.11 albertel 1001: switch -- [lindex [split $line :] 0] {
1.1 albertel 1002: ANS { lappend result [string range $line 4 end] }
1003: }
1004: }
1005: return $result
1006: }
1007:
1008: ###########################################################
1009: # checkStudentNumber
1010: ###########################################################
1011: ###########################################################
1012: ###########################################################
1013: proc checkStudentNumber { num answerStructVar } {
1014: global gScorer gFile
1015: upvar $answerStructVar answerStruct
1016:
1017: # puts "Stunum1:$answerStruct(StudentNumber):"
1018: if { ![inClasslist $num $answerStruct(StudentNumber)] } {
1019: # puts "Stunum2:$answerStruct(StudentNumber):"
1020: set matched [findByStudentName [string trim $answerStruct(LastName)] $gFile($num)]
1021: if { [llength $matched] != 1 } {
1022: 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)"
1023: } else {
1024: set id [lindex [lindex $matched 0] 0]
1025: if { [makeSure "Unable to find bubbled id: $answerStruct(StudentNumber), name: $answerStruct(LastName) in classl, however I did find $matched. Use this one?"] != "Yes" } {
1026: 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)"
1027: } else {
1028: }
1029: }
1030: if { $id == "" } {
1031: scorerError $num NO_SUCH_STUDENT "$answerStruct(orignalLine)" \
1032: $answerStruct(StudentNumber)
1033: return 0
1034: } else {
1035: scorerMessage $num "Student Number $answerStruct(StudentNumber) not found in classl using $id instead." info
1036: set answerStruct(StudentNumber) $id
1037: }
1038: }
1039: # puts "Stunum3:$answerStruct(StudentNumber):"
1040: return 1
1041: }
1042:
1043: ###########################################################
1044: # handleStudent
1045: ###########################################################
1046: ###########################################################
1047: ###########################################################
1048: proc handleStudent { num answerStructVar} {
1049: global gScorer gFile
1050: upvar $answerStructVar answerStruct
1051:
1052: if { ![checkStudentNumber $num answerStruct] } { return 0 }
1053:
1054: scorerMessage $num "Finding Possible Students. . ."
1055: if { ! $gScorer(AnonMode.$num) } {
1056: set answerStruct(questionPID) $answerStruct(StudentNumber)
1057: } else {
1058: # puts "$answerStruct(StudentNumber):$answerStruct(CapaID):"
1059: if { [string trim $answerStruct(CapaID)] == "" } {
1060: scorerError $num NO_CODE_IN_ANON_MODE "$answerStruct(orignalLine)" \
1061: $answerStruct(StudentNumber)
1062: return 0
1063: }
1064: set answerStruct(questionPID) [getAnonModeID $num answerStruct]
1065: if { [llength $answerStruct(questionPID)] > 6 } {
1066: scorerError $num LOTS_OF_ANON_MODE_MATCHES "$answerStruct(orignalLine)" \
1067: $answerStruct(StudentNumber)
1068: return 0
1.13 albertel 1069: } else {
1070: if { [llength $answerStruct(questionPID)] == 0 } {
1071: scorerError $num INVALID_CAPAID "$answerStruct(orignalLine)" \
1072: $answerStruct(StudentNumber)
1073: return 0
1074: }
1.1 albertel 1075: }
1076: }
1077: set answerStruct(Name) "$answerStruct(LastName) $answerStruct(FirstName) $answerStruct(MiddleInitial)"
1078:
1079: scorerMessage $num "Getting Possible Answers for $answerStruct(StudentNumber), paper# $answerStruct(SerialNumber). . ."
1080: foreach questionPID $answerStruct(questionPID) {
1081: scorerMessage $num "Getting Answers for $questionPID. . ."
1082: if { [catch { set answerStruct(correct.$questionPID) \
1083: [getAnswers $questionPID $gScorer(set.$num) \
1084: $answerStruct(maxQuest) $num] } errorMsg ] } {
1.8 albertel 1085: catch {puts $errorMsg}
1.1 albertel 1086: scorerError $num UNABLE_TO_PARSE "$answerStruct(orignalLine)" \
1087: $answerStruct(StudentNumber)
1088: error UNABLE_TO_PARSE
1089: }
1090: # puts "$answerStruct(correct.$questionPID)"
1091: }
1092:
1093: scorerMessage $num "Grading Answers. . ."
1094: foreach questionPID $answerStruct(questionPID) {
1095: set answerStruct($questionPID.grade) [gradeSet $num answerStruct $questionPID]
1096: scorerMessage $num "Correct: $answerStruct($questionPID.correct) #correct: $answerStruct($questionPID.grade) PID: $questionPID"
1097: }
1098: scorerMessage $num "Given: $answerStruct($questionPID.given)"
1099: if { [llength $answerStruct(questionPID)] > 1 } {
1100: scorerMessage $num "Selecting Student. . ."
1101: if { $gScorer(QueryAboutPID.$num) } {
1102: set answerStruct(questionPID) \
1103: [getWhichAnon $num answerStruct $answerStruct(indices)]
1104: } else {
1105: set answerStruct(questionPID) \
1106: [pickAnonHighest $num answerStruct $answerStruct(indices)]
1107: }
1108: scorerMessage $num "Student $answerStruct(StudentNumber) selected $answerStruct(questionPID)'s paper." info
1109: }
1110: return 1
1111: }
1112:
1113: ###########################################################
1114: # gradeQuestion
1115: ###########################################################
1116: ###########################################################
1117: ###########################################################
1118: proc gradeQuestion { num questNum correct given answerStructVar } {
1119: global gScorer
1120: upvar $answerStructVar answerStruct
1121: set numRight 0
1122: switch $gScorer(quest.$questNum.type.$num) {
1123: ONE_OUT_OF_10 -
1124: GLE -
1125: TF -
1126: SINGLE_DIGIT {
1127: # scorerMessage $num "The correct answer: $correct, The student's answer: $given"
1128: set fmt "%-$gScorer(quest.$questNum.leafs.$num)s,"
1129: append answerStruct(correct) [format $fmt $correct]
1130: append answerStruct(given) [format $fmt $given]
1131: for { set leafs 0 } { $leafs < $gScorer(quest.$questNum.leafs.$num)
1132: } { incr leafs } {
1133: if { [string index $correct $leafs] ==
1134: [string index $given $leafs] } {
1135: incr numRight
1136: }
1137: }
1138: }
1139: ASSIGNED {
1140: # scorerMessage $num "The student got a $given out of $gScorer(quest.$questNum.points.$num) "
1141: append answerStruct(correct) "$gScorer(quest.$questNum.points.$num),"
1142: append answerStruct(given) "$given,"
1143: if { [catch {incr given 0}] } {
1144: set numRight 0
1145: } else {
1146: set numRight $given
1147: }
1148: }
1149: N_OUT_OF_M {
1150: # scorerMessage $num "The correct answer: $correct, The student's answer: $given"
1151: set fmt "%-$gScorer(quest.$questNum.leafs.$num)s,"
1152: append answerStruct(correct) [format $fmt $correct]
1153: append answerStruct(given) [format $fmt $given]
1154: set letters "ABCDEFGHIJ"
1155: set maxLeaf $gScorer(quest.$questNum.leafs.$num)
1156: for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
1157: if { [string first [string index $letters $leaf] $correct] != -1 } {
1158: set ansOn($leaf) 1
1159: } else {
1160: set ansOn($leaf) 0
1161: }
1162: }
1163: for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
1164: if { [string first [string index $letters $leaf] $given] != -1 } {
1165: set stuOn($leaf) 1
1166: } else {
1167: set stuOn($leaf) 0
1168: }
1169: }
1170: for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
1171: if { $ansOn($leaf) == $stuOn($leaf) } { incr numRight }
1172: }
1173: }
1174: STRING_MATCH {
1175: # scorerMessage $num "The correct answer: $correct, The student's answer: $given"
1176: set fmt "%-$gScorer(quest.$questNum.leafs.$num)s,"
1177: append answerStruct(correct) [format $fmt $correct]
1178: append answerStruct(given) [format $fmt $given]
1179: set letters "ABCDEFGHIJ"
1180: set maxLeaf 10
1181: for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
1182: if { [string first [string index $letters $leaf] $correct] != -1 } {
1183: set ansOn($leaf) 1
1184: } else {
1185: set ansOn($leaf) 0
1186: }
1187: }
1188: for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
1189: if { [string first [string index $letters $leaf] $given] != -1 } {
1190: set stuOn($leaf) 1
1191: } else {
1192: set stuOn($leaf) 0
1193: }
1194: }
1195: for { set leaf 0 } { $leaf < $maxLeaf } { incr leaf } {
1196: if { $ansOn($leaf) == $stuOn($leaf) } { incr numRight }
1197: }
1198: if { $numRight != $maxLeaf } { set numRight 0 }
1199: }
1200: default {
1201: scorerMessage $num "Unknown question type while grading,"
1202: }
1203: }
1204: return $numRight
1205: }
1206:
1207: ###########################################################
1208: # gradeSet
1209: ###########################################################
1210: ###########################################################
1211: ###########################################################
1212: proc gradeSet { num answerStructVar questionPID } {
1213: global gScorer
1214: upvar $answerStructVar answerStruct
1215:
1216: set numRight 0
1217: for { set i 0 } { $i < $answerStruct(maxQuest) } { incr i } {
1218: set correct [lindex $answerStruct(correct.$questionPID) $i]
1219: set given $answerStruct(answer.$i)
1220: set probRight [gradeQuestion $num $i $correct $given answerStruct]
1221: incr numRight $probRight
1222: append answerStruct($questionPID.numRight) $probRight
1223: }
1224: set answerStruct($questionPID.correct) $answerStruct(correct)
1225: set answerStruct(correct) ""
1226: set answerStruct($questionPID.given) $answerStruct(given)
1227: set answerStruct(given) ""
1228: return $numRight
1229: }
1230:
1231:
1232: ###########################################################
1233: # getScorerEntry
1234: ###########################################################
1235: ###########################################################
1236: ###########################################################
1237: proc getScorerEntry { num PID } {
1238: global gScorer
1239:
1240: set fileId $gScorer(out.$num)
1241: seek $fileId 0 start
1242: set done 0
1243: set found 0
1244: set aline ""
1245: set offset 0
1246: while { ! $done } {
1247: set readamt [gets $fileId aline]
1248: if { [eof $fileId] } { set done 0 ; break}
1249: if { 0 == [ string compare [string toupper [lindex $aline 0]] \
1250: [string toupper $PID] ] } {
1251: set done 1
1252: set found 1
1253: } else {
1254: #plus one because gets swallows the newline it reads
1255: set offset [expr $offset + $readamt + 1]
1256: }
1257: }
1258: if { ! $found } { set offset -$offset }
1259: return $offset
1260: }
1261:
1262: ###########################################################
1263: # setScorerEntry
1264: ###########################################################
1265: ###########################################################
1266: ###########################################################
1267: proc setScorerEntry { num aline offset } {
1268: global gScorer
1269:
1270: set fileId $gScorer(out.$num)
1271: seek $fileId [expr abs($offset)] start
1272: puts $fileId $aline
1273: }
1274:
1275: ###########################################################
1276: # setOutput
1277: ###########################################################
1278: ###########################################################
1279: ###########################################################
1280: proc setOutput { num answerStructVar} {
1281: global gScorer
1282: upvar $answerStructVar answerStruct
1283:
1284: #FIXME what if questions PID is empty
1285: set questionPID $answerStruct(questionPID)
1286: set out [format "%9s %-30s %s %4s %3s %s %s %s" $answerStruct(StudentNumber) \
1287: $answerStruct(Name) $answerStruct($questionPID.numRight) \
1288: $answerStruct($questionPID.grade) $answerStruct(Section) \
1289: $answerStruct($questionPID.given) $questionPID \
1290: $answerStruct(SerialNumber)]
1291: set offset [getScorerEntry $num $answerStruct(StudentNumber)]
1292: setScorerEntry $num "$out" $offset
1293: }
1294:
1295: ###########################################################
1296: # finishScoring
1297: ###########################################################
1298: ###########################################################
1299: ###########################################################
1300: proc finishScoring { num answerStructVar} {
1.12 albertel 1301: global gScorer gMult
1.1 albertel 1302: scorerMessage $num "Finishing . . ."
1.12 albertel 1303: #puts $gMult
1.1 albertel 1304: # puts "errors:"
1305: # puts "$gScorer(errors.$num)"
1306: scorerMessage $num "Finished, Feel free to Update .sb"
1307: if { [makeSure "Would you like to update the .sb file?"] == "Yes" } {
1308: scorerToSet $num
1309: }
1310: trace variable gScorer(quit.$num) w "scorerClose $num 0"
1311: }
1312:
1313: proc scorerStudentTime { num } {
1314: puts [ time "scorerStudent $num" ]
1315: }
1316:
1317: ###########################################################
1318: # scorerStudent
1319: ###########################################################
1320: ###########################################################
1321: ###########################################################
1322: proc scorerStudent { num } {
1323: global gScorer
1324:
1325: if { $gScorer(pause.$num) } {
1326: if { [array names gScorer quit.$num] != "" } {
1327: if { ![scorerClose $num] } {
1328: unset gScorer(quit.$num)
1329: set gScorer(pause.$num) 0
1330: } else {
1331: return
1332: }
1333: }
1334: if { $gScorer(pause.$num) == 1 } {
1335: scorerMessage $num "Pausing. . . " info
1336: set gScorer(pause.$num) 2
1337: }
1338: after 100 "scorerStudent $num"
1339: return
1340: }
1341: #getanswerline
1342: if { [ catch { set answer [ getLine $num ] } ] } {
1343: finishScoring $num answerStruct
1344: return
1345: }
1346: set gScorer(needToUpdateDB) 1
1347: #parseanswerline
1348: if { [catch {parseLine $num $answer answerStruct} errorMsg ] } {
1.12 albertel 1349: global errorInfo
1350: displayError "Error parsing line: $errorMsg $errorInfo"
1.1 albertel 1351: } else {
1352: #parse the set and grades it for any possiblely matching student
1353: if { ! [ catch { set result [handleStudent $num answerStruct]} errorMsg ] } {
1354: #write entry to outputfile if student was succesfully handled
1355: if { $result } { setOutput $num answerStruct }
1356: } else { #error handling Student
1357: global errorCode errorInfo
1358: displayError "An error occured when attempting to grade a student. The error is: $errorMsg"
1359: }
1360: }
1.4 albertel 1361: incr gScorer(student.$num)
1362: update
1.1 albertel 1363: after idle "scorerStudent $num"
1364: }
1365:
1366: ###########################################################
1367: # restartScorer
1368: ###########################################################
1369: ###########################################################
1370: ###########################################################
1371: proc restartScorer { num } {
1372: global gScorer
1373: if { ! [info exists gScorer(pause.$num) ] } {
1374: initScorer $num
1375: set gScorer(pause.$num) 0
1376: } else {
1377: }
1378: after idle "scorerStudent $num"
1379: }
1380:
1381: ###########################################################
1382: # pauseScorer
1383: ###########################################################
1384: ###########################################################
1385: ###########################################################
1386: proc pauseScorer { num } {
1387: global gScorer
1388: set gScorer(pause.$num) 1
1389: }
1390:
1391: ###########################################################
1392: # stopScorer
1393: ###########################################################
1394: ###########################################################
1395: ###########################################################
1396: proc stopScorer { num } {
1397: }
1398:
1399: ###########################################################
1400: # unpauseScorer
1401: ###########################################################
1402: ###########################################################
1403: ###########################################################
1404: proc unpauseScorer { num } {
1405: global gScorer
1406: set gScorer(pause.$num) 0
1407: }
1408:
1409: ###########################################################
1410: ###########################################################
1411: ###########################################################
1412: ###########################################################
1413: proc finalScorer { num method studentNumber numRight } {
1414: global gScorer
1415:
1.12 albertel 1416: #puts ":$numRight:"
1.1 albertel 1417: set answers ""
1418: for { set i 0 } { $i < $gScorer(numQuest.$num) } { incr i } {
1419: switch $gScorer(quest.$i.type.$num) {
1420: ONE_OUT_OF_10 -
1421: SINGLE_DIGIT {
1422: append answers [ expr [string index $numRight $i] * \
1423: $gScorer(quest.$i.points.$num) ]
1424: }
1425: GLE -
1426: TF -
1427: N_OUT_OF_M {
1428: set right [string index $numRight $i]
1429: set leafs $gScorer(quest.$i.leafs.$num)
1430: set points $gScorer(quest.$i.points.$num)
1431: set unit [expr double($points)/double($leafs)]
1432: if { $unit == 0 } { set unit $points }
1433: switch $method {
1434: CAPA {
1435: set score [expr int($points-(2*$unit*($leafs-$right)))]
1436: if { $score < 0 } { set score 0 }
1437: }
1438: Lenient {
1439: set score [expr int($points-($unit*($leafs-$right)))]
1440: }
1441: Strict {
1442: if { $right == $leafs } {
1443: set score $points
1444: } else {
1445: set score 0
1446: }
1447: }
1448: default {
1449: scorerError $num UNKNOWN_GRADING_METHOD $method
1450: }
1451: }
1452: append answers $score
1453: }
1454: STRING_MATCH -
1455: ASSIGNED {
1456: append answers [string index $numRight $i]
1457: }
1458: default {
1459: }
1460: }
1461: }
1462: return $answers
1463: }
1464:
1465: ###########################################################
1466: # scorerToSet2
1467: ###########################################################
1468: ###########################################################
1469: ###########################################################
1470: proc scorerToSet2 { num method } {
1471: global gScorer gFile
1472: destroy .getGradingMethod$num
1473:
1474: set processed 0
1475: set done 0
1476: set fileId $gScorer(out.$num)
1477: set setId $gScorer(set.$num)
1478: seek $fileId 0 start
1479:
1480: #remove the header line
1481: gets $fileId aline
1482:
1483: scorerMessage $num "Processing. . ."
1484: while { ! $done } {
1485: gets $fileId aline
1486: if { [eof $fileId] } {
1487: set done 1
1488: break
1489: }
1490: set studentNumber [lindex $aline 0]
1491: incr processed
1492: if { [ expr $processed % 100 ] == 0 } { scorerMessage $num $processed }
1493: update idletasks
1494: set cwd [pwd]
1495: cd $gFile($num)
1496: if { ![file exists [file join records set$setId.sb] ] } {
1497: if { ![file exists [file join records set$setId.db] ] } {
1498: cd $cwd
1499: scorerMessage $num "set$setId.db does not exist" error
1500: return
1501: } else {
1502: scorerMessage $num "Copying set$setId.db to set$setId.sb"
1503: if { [catch {file copy [file join records set$setId.db] \
1504: [file join records set$setId.sb] }] } {
1505: cd $cwd
1506: scorerMessage $num "Unable to create set$setId.sb from set$setId.db, please create it by hand" error
1507: return
1508: }
1509: }
1510: }
1511: if { [catch { set offset [ scorer_get_entry $studentNumber $setId ] } errors] } {
1512: cd $cwd
1513: scorerMessage $num "Error trying to read set$setId.sb" error
1514: return
1515: }
1516: cd $cwd
1517: set name [string range $aline 10 39]
1518: set numRight [lindex [string range $aline 40 end] 0]
1519: set entry(answers) [ finalScorer $num $method $studentNumber $numRight ]
1520: set entry(tries) ""
1521: for { set i 0 } { $i < $gScorer(numQuest.$num) } { incr i } {
1522: append entry(tries) ", 1"
1523: }
1524: set entry(tries) [string range $entry(tries) 1 end]
1525: set cwd [pwd]
1526: cd $gFile($num)
1527: if { [ catch { scorer_set_entry $studentNumber $setId $offset \
1528: $entry(answers) $entry(tries) } errors ] } {
1529: cd $cwd
1530: scorerMessage $num "Error trying to update set$setId.sb" error
1531: return
1532: }
1533: cd $cwd
1534: }
1535: scorerMessage $num "Finished updating. . ."
1536: update idletasks
1537:
1538: set gScorer(needToUpdateDB) 0
1539: if { [makeSure "Should I copy the updated set$setId.sb to set$setId.db"] == "Yes" } {
1540: if { [file exists [file join $gFile($num) records set$setId.db] ] } {
1541: if { [catch {file delete [file join $gFile($num) records set$setId.db]}]} {
1542: scorerMessage $num "An error occured while trying to copy. Please do this by hand." error
1543: }
1544: }
1545: if { [catch {file copy [file join $gFile($num) records set$setId.sb] \
1546: [file join $gFile($num) records set$setId.db] }] } {
1547: scorerMessage $num "An error occured while trying to copy. Please do this by hand." error
1548: }
1549: }
1550: scorerMessage $num "Done"
1551: }
1552:
1553: ###########################################################
1554: # scorerToSet
1555: ###########################################################
1556: ###########################################################
1557: ###########################################################
1558: proc scorerToSet { num } {
1559: global gScorer
1560:
1561: #getGradingMethod
1562: set gradeWindow [toplevel .getGradingMethod$num]
1563:
1564: set messageFrame [frame $gradeWindow.mesg]
1565: set capaFrame [frame $gradeWindow.capa]
1566: set lenientFrame [frame $gradeWindow.lenient]
1567: set strictFrame [frame $gradeWindow.strict]
1568: set cancelFrame [frame $gradeWindow.cancel]
1569: pack $messageFrame $capaFrame $lenientFrame $strictFrame $cancelFrame \
1570: -side top
1571:
1572: label $messageFrame.mesg -text "Please Select a Grading Method:"
1573: pack $messageFrame.mesg
1574:
1575: button $capaFrame.capa -text "CAPA Standard" -command "scorerToSet2 $num CAPA"
1576: # button $capaFrame.huh -text "Huh?"
1577: pack $capaFrame.capa -side left
1578:
1579: button $lenientFrame.lenient -text "Lenient Method" \
1580: -command "scorerToSet2 $num Lenient"
1581: # button $lenientFrame.huh -text "Huh?"
1582: pack $lenientFrame.lenient -side left
1583:
1584: button $strictFrame.strict -text "Strict Method" \
1585: -command "scorerToSet2 $num Strict"
1586: # button $strictFrame.huh -text "Huh?"
1587: pack $strictFrame.strict -side left
1588:
1589: button $cancelFrame.cancel -text "Cancel" -command "destroy $gradeWindow"
1590: pack $cancelFrame.cancel
1591: Centre_Dialog $gradeWindow default
1592: }
1593:
1594: ###########################################################
1595: # scorerQuit
1596: ###########################################################
1597: ###########################################################
1598: ###########################################################
1599: proc scorerQuit { num } {
1600: global gScorer
1601: set gScorer(pause.$num) 1
1602: set gScorer(quit.$num) 1
1.8 albertel 1603: #puts [trace vinfo gScorer(quit.$num)]
1.1 albertel 1604: catch {scorerMessage $num "Quitting. . . " info}
1605: }
1606:
1607: ###########################################################
1608: # scorerClose
1609: ###########################################################
1610: ###########################################################
1611: ###########################################################
1612: proc scorerClose { num {mustClose 0} {dummy ""} {dummy2 ""} {dummy3 ""}} {
1613: global gScorer
1614:
1.5 albertel 1615: set message "Are you sure you wish to close?"
1616: catch {
1617: if { $gScorer(needToUpdateDB) } {
1618: set message \
1619: "Are you sure you wish to close, you haven't yet updated the .sb file."
1620: }
1.1 albertel 1621: }
1622: if { (! $mustClose ) && [makeSure $message ] == "Cancel" } { return 0 }
1623: stopScorer $num
1624: destroy .beginScorer$num
1625: # freeStudentList $num
1626: return 1
1627: }
1628:
1629: ###########################################################
1630: # loadScorerQuest
1631: ###########################################################
1632: ###########################################################
1633: ###########################################################
1634: proc loadScorerQuest { num } {
1635: global gScorer gFile
1636:
1637: set filename [file join $gFile($num) records scorer.output.$gScorer(set.$num)]
1638: if { [ catch { set fileId [ open $filename "r" ] } ] } {
1639: displayError "The set $gScorer(set.$num) does not yet have an scorer.output file. "
1640: return
1641: }
1642: set line [gets $fileId ]
1643: close $fileId
1644: set numQuestions [lindex $line 2]
1645: set flags [lindex $line 4]
1646: $gScorer(quest.$num) delete 0 end
1647: for { set i 0 } { $i < $numQuestions } { incr i } {
1648: switch [string index $flags [expr $i * 3] ] {
1649: a { set gScorer(questType.$num) ONE_OUT_OF_10 }
1650: b { set gScorer(questType.$num) GLE }
1651: c { set gScorer(questType.$num) TF }
1652: d { set gScorer(questType.$num) ASSIGNED }
1653: e { set gScorer(questType.$num) N_OUT_OF_M }
1654: f { set gScorer(questType.$num) SINGLE_DIGIT }
1655: g { set gScorer(questType.$num) STRING_MATCH }
1656: }
1657: set gScorer(questPoint.$num) [string index $flags [expr $i * 3 + 1] ]
1658: set gScorer(questLeaf.$num) [string index $flags [expr $i * 3 + 2] ]
1659: insertQuest $num end
1660: }
1661: }
1662:
1663: ###########################################################
1664: # reScore
1665: ###########################################################
1666: ###########################################################
1667: ###########################################################
1668: proc reScore { file } {
1669: global gUniqueNumber gScorer gFile
1670: set num [incr gUniqueNumber]
1671: if { [catch {set gScorer(out.$num) [open $file "r"]}]} {
1672: displayError "Unable to open $file"
1673: return
1674: }
1675: set gScorer(set.$num) [lindex [split $file .] end]
1676: set gFile($num) [file dirname [file dirname $file]]
1677: set line [gets $gScorer(out.$num) ]
1678: set gScorer(numQuest.$num) [lindex $line 2]
1679: set flags [lindex $line 4]
1680: for { set i 0 } { $i < $gScorer(numQuest.$num) } { incr i } {
1681: switch [string index $flags [expr $i * 3] ] {
1682: a { set gScorer(quest.$i.type.$num) ONE_OUT_OF_10 }
1683: b { set gScorer(quest.$i.type.$num) GLE }
1684: c { set gScorer(quest.$i.type.$num) TF }
1685: d { set gScorer(quest.$i.type.$num) ASSIGNED }
1686: e { set gScorer(quest.$i.type.$num) N_OUT_OF_M }
1687: f { set gScorer(quest.$i.type.$num) SINGLE_DIGIT }
1688: g { set gScorer(quest.$i.type.$num) STRING_MATCH }
1689: }
1690: set gScorer(quest.$i.points.$num) [string index $flags [expr $i * 3 + 1] ]
1691: set gScorer(quest.$i.leafs.$num) [string index $flags [expr $i * 3 + 2] ]
1692: }
1693:
1694: set reScore [toplevel .reScore$num]
1695: wm title $reScore "ReScoring $file"
1696:
1697: set windowFrame [frame $reScore.windowFrame]
1698: set buttonFrame [frame $reScore.buttonFrame]
1699: pack $windowFrame $buttonFrame -side bottom
1700: pack configure $windowFrame -expand true -fill both
1701: pack configure $buttonFrame -anchor e
1702:
1703: scrollbar $windowFrame.scroll -orient vertical -command \
1704: "$windowFrame.text yview"
1705: set gScorer(status.$num) [text $windowFrame.text -yscrollcommand \
1706: "$windowFrame.scroll set" -wrap char -height 40]
1707: pack $windowFrame.scroll $gScorer(status.$num) -side left -expand 0
1708: pack configure $windowFrame.scroll -expand 0 -fill y
1709: pack configure $gScorer(status.$num) -expand true -fill both
1710:
1711: button $buttonFrame.ok -text Dismiss -command \
1712: "destroy $reScore
1713: catch {close $gScorer(out.$num)}"
1714: bind $reScore <Destroy> "catch {close $gScorer(out.$num)}"
1715: button $buttonFrame.save -text "Save Messages" -command "saveScorerMsg $num"
1716: button $buttonFrame.print -text "Print Messages" -command "printScorerMsg $num"
1717: pack $buttonFrame.print $buttonFrame.save $buttonFrame.ok -side left
1718:
1719: Centre_Dialog $reScore default
1720: update
1721: scorerToSet $num
1722: }
1723:
1724: #The flags struct is
1725: # name
1726: # question to ask
1727: # yes (1) response
1728: # no (0) response
1729: set gScorer(flags) \
1730: {
1731: {
1732: CheckPIN
1733: {Is there a capaID/CODE on the paper?}
1734: Yes
1735: No
1736: 1
1737: }
1738: {
1739: AnonMode
1740: {Is this an anonymous Exam?}
1741: Yes
1742: No
1743: 0
1744: }
1745: {
1746: QueryAboutPID
1747: {When finding multiple PIDs matching a capaID:}
1748: {Ask which to use}
1749: {Pick one with highest score}
1750: 0
1751: }
1752: }
1753: # {
1754: # SurveyMode
1755: # {What is being scanned?}
1756: # Survey
1757: # Exam/Quiz
1758: # 0
1759: # }
1760: # {
1761: # SurveyHeader
1762: # {Does the Survey have a header?}
1763: # Yes
1764: # No
1765: # 0
1766: # }
1767:
1768: # {
1769: # CheckSpaces
1770: # {Should scorer worry about blank questions?}
1771: # Yes
1772: # No
1773: # 0
1774: # }
1775: # {
1776: # CheckMultipleMarks
1777: # {Should scorer worry about multiple marks on single mark questions?}
1778: # Yes
1779: # No
1780: # 0
1781: # }
1782: # {
1783: # IdFormat
1784: # {What format is the student number in?}
1785: # A<number>
1786: # {Social Security}
1787: # 1
1788: # }
1789: # {
1790: # Form
1791: # {Which form size is being used? Select Half Sheet}
1792: # {Full sheet}
1793: # {Half Sheet}
1794: # 0
1795: # }
1796: # {
1797: # log
1798: # {When encountering errors: Select Query the User}
1799: # {Log them}
1800: # {Query the user}
1801: # 1
1802: # }
1803:
1804: #Counting from zero, first number is column of start of the field,
1805: #second number is end of the field. The Question field is an
1806: #exception first comes start of question responses then # of
1807: #responses, and then the number of bubbles per response
1808: #Full Sheet Specs
1809: set gScorer(FullSheet.SerialNumber) { 5 8 }
1810: set gScorer(FullSheet.LastName) { 40 49 }
1811: set gScorer(FullSheet.FirstName) { 50 54 }
1812: set gScorer(FullSheet.MiddleInitial) { 55 55 }
1813: set gScorer(FullSheet.StudentNumber) { 56 64 }
1814: set gScorer(FullSheet.Section) { 65 67 }
1815: set gScorer(FullSheet.CapaID) { }
1816: #No CapaID spot on full sheet
1817: set gScorer(FullSheet.Question) { 76 50 10 }
1818:
1819: #Half Sheet Specs
1820: set gScorer(HalfSheet.SerialNumber) { 5 8 }
1821: set gScorer(HalfSheet.LastName) { 40 49 }
1822: set gScorer(HalfSheet.FirstName) { 50 50 }
1823: set gScorer(HalfSheet.MiddleInitial) { }
1824: #No Middle Initial
1825: set gScorer(HalfSheet.StudentNumber) { 56 64 }
1826: set gScorer(HalfSheet.Section) { 65 67 }
1827: set gScorer(HalfSheet.CapaID) { 68 73 }
1828: 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