Annotation of capa/capa51/GUITools/gradesubjective.tcl, revision 1.7
1.1 albertel 1: set gMaxSet 99
2:
3: proc gradeSubjective {} {
4: global gSubj
5:
6: if { [winfo exists .gradeSubjective] } { return }
7: set var [tk_getOpenFile -title "Please select a capa.config file" -filetypes \
8: { { {Capa Config} {capa.config} } }]
9:
10: if { $var != "" } {
11: set gSubj(dir) [file dirname $var]
12: cd $gSubj(dir)
13: } else {
14: return
15: }
16: parseCapaConfig
17: if { "" == [set gSubj(set) [getOneSet {} $gSubj(dir)]] } return
18: if { "" == [set gSubj(quest) [getString {} "Which question?"]] } return
19: set fileid [open "records/set$gSubj(set).db" r]
20: gets $fileid aline
21: gets $fileid aline
22: set gSubj(max) [lindex [split $aline {}] [expr $gSubj(quest) - 1]]
23: createGradeSubjWindow
24: }
25:
26: proc createGradeSubjWindow {} {
27: global gSubj
28:
29: set gradSubj [toplevel .gradesubjective]
30: wm protocol $gradSubj WM_DELETE_WINDOW "subjDone"
31:
32: set info [frame $gradSubj.info]
33: set grade [frame $gradSubj.grade]
1.7 ! albertel 34: set keyword [frame $gradSubj.keyword]
1.1 albertel 35: set gSubj(pictFrame) [set picts [frame $gradSubj.picts -borderwidth 4 -relief groove]]
1.7 ! albertel 36: pack $info $grade $keyword -side top
1.1 albertel 37:
38: set msg [frame $info.msg]
39: set id [frame $info.id]
40: pack $msg $id -side left
41:
42: # set gSubj(msg) [text $msg.text -width 40 -height 8 -yscrollcommand "$msg.scroll set"]
43: # scrollbar $msg.scroll -command "$msg.text yview"
44: # pack $gSubj(msg) $msg.scroll -side left
45: # pack configure $msg.scroll -fill y
46: # $gSubj(msg) tag configure error -foreground red
47: # $gSubj(msg) tag configure info -foreground #006c00
48:
49: set msglist [frame $msg.msglist]
50: set msgbutton [frame $msg.msgbutton]
51: pack $msglist $msgbutton -side top
52: pack configure $msgbutton -anchor w
53:
1.2 albertel 54: set gSubj(responseList) [listbox $msglist.list -width 40 -height 5 \
55: -yscrollcommand "$msglist.scroll set"]
1.4 albertel 56: scrollbar $msglist.scroll -command "$msglist.list yview"
1.2 albertel 57: pack $gSubj(responseList) $msglist.scroll -side left
1.1 albertel 58: pack configure $msglist.scroll -fill y
59:
60: set gSubj(numresponse) 0
61:
62: button $msgbutton.send -text Send -command subjSendResponse
63: button $msgbutton.new -text New -command subjNewResponse
64: button $msgbutton.delete -text Delete -command subjDeleteResponse
65: button $msgbutton.view -text View -command subjViewResponse
66: button $msgbutton.edit -text Edit -command subjEditResponse
67: pack $msgbutton.send $msgbutton.new $msgbutton.delete $msgbutton.view \
68: $msgbutton.edit -side left
69:
70: set idlist [frame $id.idlist]
71: set idbutton [frame $id.idbutton]
72: pack $idlist $idbutton -side top
73: pack configure $idbutton -anchor w
74:
75: set gSubj(idlist) [listbox $idlist.list -width 34 -height 5 \
76: -yscrollcommand "$idlist.scroll set"]
77: scrollbar $idlist.scroll -command "$idlist.list yview"
78: pack $idlist.list $idlist.scroll -side left
79: pack configure $idlist.scroll -fill y
80:
81: button $idbutton.delete -text Delete -command subjDeleteId
1.3 albertel 82: frame $idbutton.spacer -width 30
83: label $idbutton.l1 -text "\# Words:"
84: label $idbutton.words -textvariable gSubj(numwords)
85: pack $idbutton.delete $idbutton.spacer $idbutton.l1 $idbutton.words -side left
1.1 albertel 86:
87: set response [frame $grade.response]
88: pack $response
89:
90: set scoreandcom [toplevel $gradSubj.scoreandcom]
91: wm title $scoreandcom "Control Panel"
1.5 albertel 92: wm protocol $scoreandcom WM_DELETE_WINDOW "subjDone"
1.1 albertel 93:
94: set score [frame $scoreandcom.score]
95: set command [frame $scoreandcom.command]
96: set morebut [frame $scoreandcom.morebut]
97: set stat [frame $scoreandcom.stat]
98: pack $score $command $morebut $stat -side top
99:
100: set command1 [frame $command.command1]
101: set command2 [frame $command.command2]
102: pack $command1 $command2 -side left
103:
104: set top [frame $response.top]
105: set bot [frame $response.bot]
106: pack $top $bot -side top
107: pack configure $bot -expand 0 -fill x
108:
109: set gSubj(response) [text $top.response -width 80 -height 21 \
110: -yscrollcommand "$top.scroll set" \
111: -xscrollcommand "$bot.scroll set"]
112: scrollbar $top.scroll -command "$top.response yview"
113: pack $gSubj(response) $top.scroll -side left
114: pack configure $top.scroll -fill y
115:
116: scrollbar $bot.scroll -orient h -command "$top.response xview"
117: pack $bot.scroll
118: pack configure $bot.scroll -expand 0 -fill x
119:
1.7 ! albertel 120: set left [frame $keyword.left]
! 121: set left2 [frame $keyword.left2]
! 122: set right [frame $keyword.right]
! 123: pack $left $left2 $right -side left
! 124:
! 125: set gSubj(keyword) [text $right.keyword -width 60 -height 5 \
! 126: -yscrollcommand "$right.scroll set" ]
! 127: scrollbar $right.scroll -command "$right.response yview"
! 128: pack $gSubj(keyword) $right.scroll -side left
! 129: pack configure $right.scroll -fill y
! 130:
! 131: button $left.add -command "subjAddKeyword" -text "Add"
! 132: button $left2.addsp -command "subjAddKeywordSpelling" -text "Add Sp"
! 133: button $left.delete -command "subjDeleteKeyword" -text "Delete"
! 134: button $left2.see -command "subjSeeKeyword" -text "See Sp"
! 135: pack $left.add $left2.addsp $left.delete $left2.see -side top
! 136:
1.1 albertel 137: wm geometry $gradSubj "-10+0"
138:
139: set score0 [frame $score.score0]
140: set score1 [frame $score.score1]
141: pack $score0 $score1 -side top
142:
143: for {set i 0} {$i < 10 } { incr i } {
144: set parent [eval set "score[expr $i/5]"]
145: set a [frame $parent.score$i -relief sunken -borderwidth 1]
146: if { $gSubj(max) < $i} {
147: radiobutton $a.score$i -text $i -variable gSubj(score) \
148: -value $i -state disabled
149: } else {
150: radiobutton $a.score$i -text $i -variable gSubj(score) -value $i
151: }
152: pack $parent.score$i $a.score$i -side left
153: }
154:
155: set buttonwidth 8
156: set gSubj(wrap) 1;set gSubj(pict) 0
157: button $command1.setnext -text "Grade&Next" -command "subjSet;subjNext" \
158: -width $buttonwidth
159: button $command2.set -text "Grade" -command subjSet -width $buttonwidth
160: frame $command1.space1 -height 30
161: frame $command2.space2 -height 30
162: frame $command2.space22 -height 5
163: button $command1.next -text "Next" -command subjNext -width $buttonwidth
1.7 ! albertel 164: button $command1.prev -text "Prev" -command subjPrev -width $buttonwidth
! 165: button $command1.goto -text "GoTo" -command subjGoto -width $buttonwidth
! 166: button $command1.exit -text "Exit" -command subjDone -width $buttonwidth
! 167: button $command2.findid -text "Find ID" -command subjFindId -width $buttonwidth
1.1 albertel 168: button $command2.addid -text "Add ID" -command subjAddId -width $buttonwidth
1.7 ! albertel 169: button $command2.findname -text "Find Name" -command subjFindName -width $buttonwidth
1.1 albertel 170: checkbutton $command2.wrap -text wrap -command subjWrap -variable gSubj(wrap)
171: checkbutton $command2.pict -text pict -command subjPict -variable gSubj(pict)
172: checkbutton $command1.done -text graded -variable gSubj(donestat) -state disabled
173: pack $command1.setnext $command2.set $command1.space1 $command2.space2 \
1.7 ! albertel 174: $command1.next $command1.prev $command2.findid \
! 175: $command2.addid $command2.findname $command1.goto $command1.exit \
1.1 albertel 176: $command2.wrap $command2.pict $command1.done $command2.space22
177:
178: button $morebut.print -text "Print Response" -command subjPrint \
179: -width [expr $buttonwidth*2]
180: pack $morebut.print
181:
182: set gSubj(done) 0
183: set gSubj(togo) 0
184: set gSubj(secAvg) 0.0
185: set gSubj(sec) 0
186: set gSubj(pause) 0
187: label $stat.done -text Done:
188: label $stat.donenum -textvariable gSubj(done) -width 4
189: label $stat.togo -text "To Go:"
190: label $stat.togonum -textvariable gSubj(togo) -width 4
191: label $stat.sec -text Sec:
192: label $stat.secnum -textvariable gSubj(sec) -width 4
193: label $stat.avgsec -text AvgSec:
194: label $stat.avgsecnum -textvariable gSubj(avgsec) -width 4
195: checkbutton $stat.pause -variable gSubj(pause) -text "Pause" -command subjPause
196: pack $stat.done $stat.donenum $stat.togo $stat.togonum -side left
197: #not packed
198: #$stat.sec $stat.secnum $stat.avgsec $stat.avgsecnum $stat.pause
199:
200: set gSubj(canvas) [canvas $picts.canvas -height 220 \
201: -xscrollcommand "$picts.scroll set"]
202: scrollbar $picts.scroll -orient h -command "$picts.canvas xview"
203: pack $picts.scroll $gSubj(canvas) -fill x
204: subjInit
205: }
206:
207: proc subjWrap {} {
208: global gSubj
209: if { $gSubj(wrap) } {
210: $gSubj(response) configure -wrap char
211: } else {
212: $gSubj(response) configure -wrap none
213: }
214: }
215:
216: proc updateSecCount {} {
217: global gSubj
218:
219: if { [catch {set gSubj(pause)}] } { return }
220: if { !$gSubj(pause) } {set gSubj(sec) [expr {[clock seconds] - $gSubj(seconds)}]}
221: after 300 updateSecCount
222: }
223:
224: proc subjCheckForNew {} {
225: global gSubj
226: }
227:
1.5 albertel 228: proc checkGSubj {} {
229: global gSubj
230: if {[catch {set gSubj(stunums)}]} {
231: cd [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest)]
232: set gSubj(stunums) [lsort -dictionary [glob *]]
233: if { [set num [lsearch $gSubj(stunums) gradingstatus]] != -1} {
234: set gSubj(stunums) [lreplace $gSubj(stunums) $num $num]
235: }
236: cd $gSubj(dir)
237: }
238: if {[catch {set gSubj(current)}]} {set gSubj(current) -1}
239: if {[catch {set gSubj(totalsec)}]} {set gSubj(totalsec) 0}
240: if {[catch {set gSubj(seconds)}]} {set gSubj(seconds) [clock seconds]}
241: if {[catch {set gSubj(togo)}]} {set gSubj(togo) [llength $gSubj(stunums)]}
242: if {[catch {set gSubj(allstunum)}] ||
243: [catch {set gSubj(allname)}] ||
244: [catch {set gSubj(allemail)}] } {
245: subjInitAllLists
246: }
247: }
248:
1.1 albertel 249: proc subjRestore {} {
250: global gSubj
251: source gradingstatus
252: subjCheckForNew
253: set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}]
254: cd $gSubj(dir)
1.5 albertel 255: if { [catch {incr gSubj(current) -1}]} { set gSubj(current) -1 }
1.4 albertel 256: if { $gSubj(redoalllists) } { subjInitAllLists; set gSubj(redoalllists) 0 }
1.5 albertel 257: checkGSubj
1.4 albertel 258: subjIndexResponse
1.1 albertel 259: subjNext
260: }
261:
262: proc subjSave {} {
263: global gSubj
264: set file [file join $gSubj(dir) records set$gSubj(set) \
265: problem$gSubj(quest) gradingstatus]
266: set fileId [open $file w]
1.4 albertel 267: puts $fileId "array set gSubj \{[array get gSubj]\}"
1.1 albertel 268: close $fileId
269: }
270:
271: proc subjDone {} {
272: global gSubj
1.5 albertel 273: if { [catch {subjSave}] } {
274: displayMessage "Unable to save."
275: }
1.1 albertel 276: unset gSubj
277: destroy .gradesubjective
278: }
279:
1.4 albertel 280: proc subjInitAllLists {} {
281: global gSubj
282: set i 0
283: catch {unset gSubj(allstunum)}
284: catch {unset gSubj(allname)}
285: catch {unset gSubj(allemail)}
286: set fileId [open classl r]
287: while { 1 } {
288: incr i
289: set aline [gets $fileId]
290: if { [eof $fileId]} {break}
291: lappend gSubj(allstunum) [string toupper [string range $aline 14 22]]
292: #lappend gSubj(allname) [string toupper [string range $aline 24 59]]
293: lappend gSubj(allname) [string range $aline 24 59]
294: lappend gSubj(allemail) [string range $aline 60 99]
295: }
296: }
297:
1.1 albertel 298: proc subjInit {} {
299: global gSubj
300:
301: set dir [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest)]
302: cd $dir
1.4 albertel 303: set gSubj(redoalllists) 0
1.1 albertel 304: if { [file exists gradingstatus] } { subjRestore } else {
305: set gSubj(stunums) [lsort -dictionary [glob *]]
306: cd $gSubj(dir)
307: set gSubj(current) -1
308: set gSubj(totalsec) 0
309: set gSubj(seconds) [clock seconds]
1.4 albertel 310: subjInitAllLists
1.1 albertel 311: set gSubj(togo) [llength $gSubj(stunums)]
312: subjNext
313: }
314: after 300 updateSecCount
315: }
316:
317: #FIXME check Ids when adding them to the list of ids
318: proc checkId { id } {
319: global gSubj
320: set score [getScore $gSubj(set) $gSubj(quest) $id]
321: if { $score == "-" || $score == "0" } { return 1 }
322: return 0
323: }
324:
325: proc subjPause {} {
326: global gSubj
327: if { !$gSubj(pause) } { set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}] }
328: }
329:
330: proc subjStatusUpdate {} {
331: global gSubj
332:
333: set gSubj(done) [llength [array names gSubj "done.*.score"]]
334: set total [llength $gSubj(stunums)]
335: set gSubj(togo) [expr $total-$gSubj(done)]
336: incr gSubj(totalsec) [expr {[clock seconds] - $gSubj(seconds)}]
337: set gSubj(avgsec) [format %4.1f [expr $gSubj(totalsec)/double($gSubj(done))]]
338: # puts $gSubj(avgsec)
339: set gSubj(seconds) [clock seconds]
340: }
341:
342: proc subjSet {} {
343: global gSubj
344:
345: # if {$gSubj(togo) == 0} { return }
346: if {$gSubj(score) == "" } { subjMessage "Please select a score." error; return }
347: set idlist [subjGetIdList]
348: foreach id $idlist {
349: setScore $gSubj(set) $gSubj(quest) $id $gSubj(score)
350: }
351: set id [lindex $gSubj(stunums) $gSubj(current)]
352: set gSubj(done.$id.idlist) $idlist
353: set gSubj(done.$id.score) $gSubj(score)
354: set gSubj(donestat) 1
355: subjStatusUpdate
356: subjSave
357: }
358:
359: proc subjNext {} {
360: global gSubj
361:
362: set gSubj(score) ""
363: set gSubj(pict) 0
364: subjPict
365: incr gSubj(current)
366: if { [llength $gSubj(stunums)] < $gSubj(current) } { incr gSubj(current) -1 }
367: set id [lindex $gSubj(stunums) $gSubj(current)]
368:
369: $gSubj(response) delete 0.0 end
370: $gSubj(idlist) delete 0 end
371:
372: if { $id != "" } {
373: set file [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id]
374: set fileId [open $file "r"]
375: $gSubj(response) insert 0.0 [read $fileId [file size $file]]
376: close $fileId
377: subjInsertIds $id
378: }
379:
1.3 albertel 380: append words [string trim [$gSubj(response) get 0.0 end-1c]] " "
381: set ws [format " \t\n"]
382: set gSubj(numwords) [regsub -all -- \[$ws\]+ $words {} b]
1.1 albertel 383: wm title .gradesubjective "Grading Subjective, Set $gSubj(set), Prob $gSubj(quest), $id"
384: if { [catch {set gSubj(score) $gSubj(done.$id.score)}] } {
385: set gSubj(score) ""
386: set gSubj(donestat) 0
387: update idletasks
388: subjFindIds
389: } else {
390: set gSubj(donestat) 1
391: subjInsertIds $gSubj(done.$id.idlist)
392: update idletasks
393: }
394: subjPicts
395: }
396:
397: proc subjFindIds1 {} {
398: global gSubj
399:
400: set text [$gSubj(response) get 0.0 end]
401: set result ""
402: foreach id $gSubj(allstunum) {
403: if { [regexp -nocase -- $id $text] } {
404: lappend result $id
405: }
406: }
407: return $result
408: }
409:
410: proc subjFindIds2 {} {
411: global gSubj
412:
413: set text [string toupper [$gSubj(response) get 0.0 end]]
414: set result ""
415: if { [catch {lsearch $text a}] } {
416: puts badlist; return subjFindIds1
417: } else {
418: foreach id $gSubj(allstunum) {
419: if { [lsearch -glob $text *$id*] != -1 } {
420: lappend result $id
421: }
422: }
423: }
424: return $result
425: }
426:
427: proc subjFindIds3 {} {
428: global gSubj
429:
430: set text [string toupper [$gSubj(response) get 0.0 end]]
431: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
432: set result ""
433: foreach word $text {
434: if { [lsearch -exact $gSubj(allstunum) $word] != -1 } {
435: lappend result $word
436: }
437: }
438: return $result
439: }
440:
441: proc subjFindIds4 {} {
442: global gSubj
443:
444: set text [string toupper [$gSubj(response) get 0.0 end]]
445: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
446: set result ""
447: foreach id $gSubj(allstunum) {
448: if { [lsearch -exact $text $id] != -1 } {
449: lappend result $id
450: }
451: }
452: return $result
453: }
454:
455: proc subjFindId {} {
456: global gSubj
457: puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]"
458: subjPicts
459: }
460:
461: proc subjFindIds {} {
462: global gSubj
463: # puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]"
464: subjInsertIds [set ids [subjFindIds4]]
465: # puts "3:[time {set ids [subjFindIds3]} 2]\t:[llength $ids]"
466: # puts "2:[time {set ids [subjFindIds2]} 2]\t:[llength $ids]"
467: # puts "1:[time {set ids [subjFindIds1]} 2]\t:[llength $ids]"
468:
469: }
470:
471: proc subjFindName {} {
472: global gSubj
473:
474: if {[catch {set text [string toupper [$gSubj(response) get sel.first sel.last]]}]} {
475: set text [string toupper [$gSubj(response) get 0.0 end]]
476: }
477: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
478: set result ""
479: set length [llength $gSubj(allname)]
480: foreach word $text {
481: if { [string length $word] == 0 } { continue }
482: for { set i 0 } { $i < $length } { incr i } {
483: set name [string toupper [lindex $gSubj(allname) $i]]
484: if { [set find [lsearch -glob $name *$word*]] != -1 } {
485: lappend result $i
486: }
487: }
488: }
489: set result [lunique $result]
490: foreach index $result {
491: lappend temp [list [lindex $gSubj(allstunum) $index] \
492: [lindex $gSubj(allname) $index]]
493: }
494: if {[catch {set temp [lsort $temp]}]} {
495: displayMessage "No Student found."
496: return
497: }
498: set selected [multipleChoice {} "Select which student you want." $temp 1]
499: if {$selected == ""} { return }
500: set done 0
501: if { [llength $selected] == 2 } {
502: if { [lindex [lindex $selected 0] 0] == "" } {
503: set selected [lindex $selected 0]
504: set done 1
505: }
506: }
507: if { !$done } { foreach person $selected { lappend idlist [lindex $selected 0] } }
508: subjInsertIds $idlist
509: subjPicts
510: }
511:
512: proc subjGetNameFromId { id } {
513: global gSubj
514: return [lindex $gSubj(allname) [lsearch $gSubj(allstunum) $id]]
515: }
516:
517: proc subjGetIdList {} {
518: global gSubj
519: set list [$gSubj(idlist) get 0 end]
520: set id ""
521: foreach element $list {
522: append id "[lindex $element 0] "
523: }
524: return $id
525: }
526:
527: proc subjInsertIds { selected } {
528: global gSubj
529: set current [subjGetIdList]
530: foreach person $selected {lappend current [lindex $person 0]}
531: set current [lsort [lunique $current]]
532: $gSubj(idlist) delete 0 end
533: foreach id $current {
534: $gSubj(idlist) insert end "$id [subjGetNameFromId $id]"
535: }
536: }
537:
538: proc subjDeleteId {} {
539: global gSubj
540: $gSubj(idlist) delete [$gSubj(idlist) curselection]
541: subjPicts
542: }
543:
544: proc subjAddId {} {
545: global gSubj
546: getOneStudent {} $gSubj(dir) id name
547: if { $id == "" } { return }
548: subjInsertIds $id
549: }
550:
551: proc subjPrev {} {
552: global gSubj
553: if { $gSubj(current) > 0 } {
554: incr gSubj(current) -2
555: subjNext
556: }
557: }
558:
559: proc subjMessage { mesg {tag normal} } {
560: global gSubj
1.5 albertel 561: displayMessage $mesg
1.1 albertel 562: # $gSubj(msg) insert end "[clock format [clock seconds] -format {%I:%M:%S}] - $mesg\n" $tag
563: # $gSubj(msg) see end
564: }
565:
566: proc subjAddPict { id } {
567: global gSubj
568: set gif [file join $gSubj(dir) photo gif $id.gif]
569: if { ![file exists $gif] } { return }
570: lappend gSubj(imagelist) [set image [image create photo]]
571: $image read $gif
572: set a [llength $gSubj(imagelist)]
573: $gSubj(canvas) create image [expr ($a-1)*200] 20 -image $image -anchor nw
574: $gSubj(canvas) create text [expr ($a-1)*200] 10 -text $id -anchor nw
575: $gSubj(canvas) create text [expr ($a-1)*200] 0 -text [subjGetNameFromId $id] \
576: -anchor nw
577: $gSubj(canvas) configure -scrollregion "1 1 [expr ($a)*200] 200"
578: update idletasks
579: return $a
580: }
581:
582: proc subjConvertPict { id } {
583: global gSubj
584: set gif [file join $gSubj(dir) photo gif $id.gif]
585: set jpg [file join $gSubj(dir) photo jpg $id.jpg]
586: if { ![file exists $gif] } {
587: if { [file exists $jpg] } {
588: exec djpeg -outfile $gif $jpg
589: }
590: }
591: }
592:
593: proc subjPicts {} {
594: global gSubj
595:
596: $gSubj(canvas) delete all
597: catch { foreach image $gSubj(imagelist) { catch {image delete $image} } }
598: set gSubj(imagelist) ""
599: set idlist [subjGetIdList]
600: foreach id $idlist {
601: subjConvertPict $id
602: set num [subjAddPict $id]
603: }
604: }
605:
606: proc subjPict {} {
607: global gSubj
608: if { $gSubj(pict) } {
609: pack $gSubj(pictFrame)
610: pack configure $gSubj(pictFrame) -fill x
611: } else {
612: pack forget $gSubj(pictFrame)
613: }
614: }
615:
616: proc subjPrint {} {
617: global gSubj
618: set lprCommand [getLprCommand quiztemp.txt]
619: if {$lprCommand == "Cancel"} { return }
620:
621: set fileId [open "quiztemp.txt" w]
622: set subid [lindex $gSubj(stunums) $gSubj(current)]
623: if { $subid != "" } {
624: set file [file join $gSubj(dir) records set$gSubj(set) \
625: problem$gSubj(quest) $subid]
626: puts $fileId "Submitted at [clock format [file mtime $file ]]"
627: puts $fileId "By Student:\n [string trimright [subjGetNameFromId $subid]] ($subid)"
628: }
629: if { [llength [subjGetIdList]] > 1 } {
630: puts $fileId "Additional Authors:"
631: foreach id [subjGetIdList] {
632: if { $id == $subid } { continue }
633: puts $fileId " [string trimright [subjGetNameFromId $id]] ($id)"
634: }
635: }
636: puts $fileId ""
637: puts -nonewline $fileId "[ $gSubj(response) get 0.0 end-1c ]"
638: close $fileId
639:
640: set errorMsg ""
641: set error [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]
642:
643: if { $error == 1 } {
644: displayError "An error occurred while printing: $errorMsg"
645: } else {
646: displayMessage "Print job sent to the printer.\n $output"
647: }
648: exec rm -f quiztemp.txt
649: }
650:
651: proc subjGoto {} {
652: global gSubj
653: subjGetOneStudent {} $gSubj(dir) id name
654: if { $id == "" } { return }
655: if { [file exists [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id] ] } {
656: set gSubj(current) [expr [lsearch $gSubj(stunums) $id] - 1]
657: subjNext
658: } else {
659: displayMessage "Student $id did not submit an answer."
660: }
661: }
662:
663: proc subjGetUngraded {} {
664: global gSubj
665:
666: set idlist ""
667: foreach stunum $gSubj(stunums) {
668: if {[catch {set gSubj(done.$stunum.score)}]} {
669: lappend idlist $stunum
670: }
671: }
672: return [multipleChoice {} "Select which student you want to grade." $idlist 1]
673: }
674:
675: proc subjGetOneStudent { window path idVar nameVar {message "" } } {
676: upvar $idVar id
677: upvar $nameVar name
678:
679: set select [tk_dialog $window.dialog "$message Student select method" \
680: "Select student by:" "" "" "Student Number" \
681: "Student Name" "Not Yet Graded" "Cancel"]
682: if { $select == 3 } {
683: set id ""
684: set name ""
685: return
686: }
687: if { $select == 2 } {
688: set id [subjGetUngraded]
689: set name [subjGetNameFromId $id]
690: return
691: }
692: set done 0
693: while { ! $done } {
694: if { $select } { set search "name" } { set search "number" }
695: set pattern [ getString $window "$message Please enter a student $search." ]
696: if {$pattern == "" } {
697: set done 1
698: set id ""
699: set name ""
700: continue
701: }
702: if { $select } {
703: set matched_entries [findByStudentName $pattern $path]
704: } else {
705: set matched_entries [findByStudentNumber $pattern $path]
706: }
707: if { [llength $matched_entries] == 0 } {
708: displayMessage "No student found. Please re-enter student $search."
709: } elseif { [llength $matched_entries] == 1 } {
710: set id [lindex [lindex $matched_entries 0] 0]
711: set name [lindex [lindex $matched_entries 0] 1]
712: set done 1
713: } elseif { [llength $matched_entries] < 30 } {
714: set select [ multipleChoice $window \
715: "Matched Student Records, Select one" \
716: $matched_entries ]
717: if { $select == "" } {
718: set id ""; set name ""
719: return
720: }
721: set id [lindex $select 0]
722: set name [lindex $select 1]
723: set done 1
724: } else {
725: displayMessage "There were [llength $matched_entries], please enter more data to narrow the search."
726: }
727: }
728: }
729:
730: ###########################################################
731: # subjSendResponse
732: ###########################################################
733: ###########################################################
734: ###########################################################
735: proc subjSendResponse {} {
736: global gSubj
1.4 albertel 737:
738: if { "" == [set which [$gSubj(responseList) curselection]]} {
739: displayMessage "Please select a message to send."
740: return
741: }
742: incr which
1.5 albertel 743:
744: set message ""
1.4 albertel 745:
746: set stuList [$gSubj(idlist) get 0 end]
747: foreach stu $stuList {
748: set stu [lindex $stu 0]
749: set index [lsearch $gSubj(allstunum) $stu]
750: set name [lindex $gSubj(allname) $index]
751: set email [lindex $gSubj(allemail) $index]
752: puts "$name:[split $name ,]:[lindex [split $name ,] 1]:[lindex [lindex [split $name ,] 1] 0]:$index:$stu"
753: puts [lsearch $gSubj(allemail) albertel@pilot.msu.edu]
754: set first_name [lindex [lindex [split $name ,] 1] 0]
755: set last_name [lindex [split $name , ] 0]
756: set score $gSubj(score)
757: regsub -all -- \\\$last_name $gSubj(response.$which) $last_name message
758: regsub -all -- \\\$first_name $message $first_name message
759: regsub -all -- \\\$score $message $score message
760: # set message [subst -nobackslashes -nocommands $gSubj(response.$which)]
761: if { [regexp -- (^Subject:\[^\n\]*)(\n)(.*) $message matchvar subjline newline messagebody] } {
762: set message "$subjline Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest) \n$messagebody"
763: } else {
764: set message "Subject: Class [file tail $gSubj(dir)], Set $gSubj(set), Question $gSubj(quest) \n$message"
765: }
766: displayMessage "$message sent to $email"
767: exec echo $message | mail $email
768: }
1.1 albertel 769: }
770:
1.2 albertel 771: ###########################################################
772: # subjIndexResponse
773: ###########################################################
774: ###########################################################
775: ###########################################################
1.1 albertel 776: proc subjIndexResponse {} {
777: global gSubj
778:
1.2 albertel 779: $gSubj(responseList) delete 0 end
1.1 albertel 780:
781: set i 0
782: foreach element [lsort -dictionary [array names gSubj "response.*"]] {
1.4 albertel 783: regsub -all -- "\[\n\r\t\]+" [string range $gSubj($element) 0 37] " " head
784: $gSubj(responseList) insert end "[incr i].$head"
1.1 albertel 785: }
786: }
787:
788: ###########################################################
789: # subjSaveResponse
790: ###########################################################
791: ###########################################################
792: ###########################################################
793: proc subjSaveResponse {} {
794: global gSubj
795:
796: set num [incr gSubj(numresponse)]
1.4 albertel 797: set gSubj(response.$num) [$gSubj(responseNew) get 0.0 end-1c]
798: destroy [winfo toplevel $gSubj(responseNew)]
1.1 albertel 799: subjIndexResponse
1.4 albertel 800: $gSubj(responseList) selection set end
801: $gSubj(responseList) see end
1.1 albertel 802: }
803:
804: ###########################################################
805: # subjNewResponse
806: ###########################################################
807: ###########################################################
808: ###########################################################
809: proc subjNewResponse {} {
810: global gSubj gWindowMenu
811:
812: if { [winfo exists .addresponse] } {
813: capaRaise .addresponse
814: return
815: }
816: set response [toplevel .addresponse]
817: $gWindowMenu add command -label "AddingResponse" -command "capaRaise $response"
818: wm title $response "Adding a New Response"
819:
820: set textFrame [frame $response.text]
821: set buttonFrame [frame $response.button]
1.2 albertel 822: pack $textFrame $buttonFrame
1.1 albertel 823:
1.4 albertel 824: set gSubj(responseNew) [text $textFrame.text -yscrollcommand \
1.1 albertel 825: "$textFrame.scroll set" -wrap char -height 15]
826: scrollbar $textFrame.scroll -command "$textFrame.text yview"
1.2 albertel 827: pack $textFrame.text $textFrame.scroll -side left -expand 1
828: pack configure $textFrame.scroll -fill y
1.1 albertel 829:
830: button $buttonFrame.save -text Save -command "subjSaveResponse"
831: button $buttonFrame.forget -text Cancel -command "destroy $response"
832: pack $buttonFrame.save $buttonFrame.forget -side left
833: }
834:
835: ###########################################################
836: # subjDeleteResponse
837: ###########################################################
838: ###########################################################
839: ###########################################################
840: proc subjDeleteResponse {} {
841: global gSubj
1.4 albertel 842: if { [winfo exists .editresponse] } {
843: displayMessage "Please finish with editing the response, before deleting responses."
844: return
845: }
846: if { "" == [set which [$gSubj(responseList) curselection]]} { return }
847: incr which
848: if { [catch {unset gSubj(response.$which)}] } {
849: puts [array names gSubj response.*]
850: return
851: }
852: for {set i [expr $which + 1]} { [info exists gSubj(response.$i)] } {incr i} {
853: set j [expr $i - 1]
854: set gSubj(response.$j) $gSubj(response.$i)
855: unset gSubj(response.$i)
856: }
857: set gSubj(numresponse) [expr $i - 2]
858: subjIndexResponse
859: $gSubj(responseList) see [incr which -2]
1.1 albertel 860: }
861:
862: ###########################################################
863: # subjEditResponse
864: ###########################################################
865: ###########################################################
866: ###########################################################
867: proc subjEditResponse {} {
1.4 albertel 868: global gSubj gWindowMenu
869:
870: if { [winfo exists .editresponse] } { capaRaise .editresponse ; return }
871: if { "" == [set which [$gSubj(responseList) curselection]]} { return }
872: incr which
873:
874: set response [toplevel .editresponse ]
875: $gWindowMenu add command -label "EditingResponse" -command "capaRaise $response"
876: wm title $response "Editing a Response"
877:
878: set textFrame [frame $response.text]
879: set buttonFrame [frame $response.button]
880: pack $textFrame $buttonFrame
881:
882: set gSubj(responseEdit) [text $textFrame.text -yscrollcommand \
883: "$textFrame.scroll set" -wrap char -height 15]
884: scrollbar $textFrame.scroll -command "$textFrame.text yview"
885: pack $textFrame.text $textFrame.scroll -side left -expand 1
886: pack configure $textFrame.scroll -fill y
887: $gSubj(responseEdit) insert 0.0 $gSubj(response.$which)
888:
889: set gSubj(editresponsedone) 0
890: button $buttonFrame.save -text Save -command "set gSubj(editresponsedone) 1"
891: button $buttonFrame.forget -text Cancel -command "set gSubj(editresponsedone) 0"
892: pack $buttonFrame.save $buttonFrame.forget -side left
893: vwait gSubj(editresponsedone)
894: if { $gSubj(editresponsedone) } {
895: set gSubj(response.$which) [$gSubj(responseEdit) get 0.0 end-1c]
896: subjIndexResponse
897: $gSubj(responseList) selection set $which
898: $gSubj(responseList) see $which
899: }
900: destroy $response
1.1 albertel 901: }
902:
903: ###########################################################
904: # subjViewResponse
905: ###########################################################
906: ###########################################################
907: ###########################################################
908: proc subjViewResponse {} {
1.4 albertel 909: global gSubj gUniqueNumber gWindowMenu
910:
911: if { "" == [set which [$gSubj(responseList) curselection]]} { return }
912: incr which
913: set num [incr gUniqueNumber]
914:
915: set response [toplevel .viewresponse$num ]
916: $gWindowMenu add command -label "ViewingResponse $which" \
917: -command "capaRaise $response"
918: wm title $response "Viewing Response $which"
919:
920: set textFrame [frame $response.text]
921: set buttonFrame [frame $response.button]
922: pack $textFrame $buttonFrame
923:
924: text $textFrame.text -yscrollcommand "$textFrame.scroll set" -wrap char -height 15
925: scrollbar $textFrame.scroll -command "$textFrame.text yview"
926: pack $textFrame.text $textFrame.scroll -side left -expand 1
927: pack configure $textFrame.scroll -fill y
928: $textFrame.text insert 0.0 $gSubj(response.$which)
929: $textFrame.text configure -state disabled
930:
931: button $buttonFrame.forget -text Dismiss -command "destroy $response"
932: pack $buttonFrame.forget -side left
1.1 albertel 933: }
1.6 albertel 934:
935: ###########################################################
936: # subjAddKeyword
937: ###########################################################
938: ###########################################################
939: ###########################################################
940: proc subjAddKeyword {} {
941: global gSubj gUniqueNumber
942:
943: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to gradesubjective.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools