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