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