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