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