Annotation of capa/capa51/GUITools/gradesubjective.tcl, revision 1.1
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]
! 34: set gSubj(pictFrame) [set picts [frame $gradSubj.picts -borderwidth 4 -relief groove]]
! 35: pack $info $grade -side top
! 36:
! 37: set msg [frame $info.msg]
! 38: set id [frame $info.id]
! 39: pack $msg $id -side left
! 40:
! 41: # set gSubj(msg) [text $msg.text -width 40 -height 8 -yscrollcommand "$msg.scroll set"]
! 42: # scrollbar $msg.scroll -command "$msg.text yview"
! 43: # pack $gSubj(msg) $msg.scroll -side left
! 44: # pack configure $msg.scroll -fill y
! 45: # $gSubj(msg) tag configure error -foreground red
! 46: # $gSubj(msg) tag configure info -foreground #006c00
! 47:
! 48: set msglist [frame $msg.msglist]
! 49: set msgbutton [frame $msg.msgbutton]
! 50: pack $msglist $msgbutton -side top
! 51: pack configure $msgbutton -anchor w
! 52:
! 53: set gSubj(response) [listbox $msglist.list -width 40 -height 5 \
! 54: -yscrollcommand "$msglist.scroll set"]
! 55: scrollbar $msglist.scroll -command "$msglist.text yview"
! 56: pack $gSubj(response) $msglist.scroll -side left
! 57: pack configure $msglist.scroll -fill y
! 58:
! 59: set gSubj(numresponse) 0
! 60:
! 61: button $msgbutton.send -text Send -command subjSendResponse
! 62: button $msgbutton.new -text New -command subjNewResponse
! 63: button $msgbutton.delete -text Delete -command subjDeleteResponse
! 64: button $msgbutton.view -text View -command subjViewResponse
! 65: button $msgbutton.edit -text Edit -command subjEditResponse
! 66: pack $msgbutton.send $msgbutton.new $msgbutton.delete $msgbutton.view \
! 67: $msgbutton.edit -side left
! 68:
! 69: set idlist [frame $id.idlist]
! 70: set idbutton [frame $id.idbutton]
! 71: pack $idlist $idbutton -side top
! 72: pack configure $idbutton -anchor w
! 73:
! 74: set gSubj(idlist) [listbox $idlist.list -width 34 -height 5 \
! 75: -yscrollcommand "$idlist.scroll set"]
! 76: scrollbar $idlist.scroll -command "$idlist.list yview"
! 77: pack $idlist.list $idlist.scroll -side left
! 78: pack configure $idlist.scroll -fill y
! 79:
! 80: button $idbutton.delete -text Delete -command subjDeleteId
! 81: pack $idbutton.delete
! 82:
! 83: set response [frame $grade.response]
! 84: pack $response
! 85:
! 86: set scoreandcom [toplevel $gradSubj.scoreandcom]
! 87: wm title $scoreandcom "Control Panel"
! 88: wm protocol $gradSubj WM_DELETE_WINDOW "subjDone"
! 89:
! 90: set score [frame $scoreandcom.score]
! 91: set command [frame $scoreandcom.command]
! 92: set morebut [frame $scoreandcom.morebut]
! 93: set stat [frame $scoreandcom.stat]
! 94: pack $score $command $morebut $stat -side top
! 95:
! 96: set command1 [frame $command.command1]
! 97: set command2 [frame $command.command2]
! 98: pack $command1 $command2 -side left
! 99:
! 100: set top [frame $response.top]
! 101: set bot [frame $response.bot]
! 102: pack $top $bot -side top
! 103: pack configure $bot -expand 0 -fill x
! 104:
! 105: set gSubj(response) [text $top.response -width 80 -height 21 \
! 106: -yscrollcommand "$top.scroll set" \
! 107: -xscrollcommand "$bot.scroll set"]
! 108: scrollbar $top.scroll -command "$top.response yview"
! 109: pack $gSubj(response) $top.scroll -side left
! 110: pack configure $top.scroll -fill y
! 111:
! 112: scrollbar $bot.scroll -orient h -command "$top.response xview"
! 113: pack $bot.scroll
! 114: pack configure $bot.scroll -expand 0 -fill x
! 115:
! 116: wm geometry $gradSubj "-10+0"
! 117:
! 118: set score0 [frame $score.score0]
! 119: set score1 [frame $score.score1]
! 120: pack $score0 $score1 -side top
! 121:
! 122: for {set i 0} {$i < 10 } { incr i } {
! 123: set parent [eval set "score[expr $i/5]"]
! 124: set a [frame $parent.score$i -relief sunken -borderwidth 1]
! 125: if { $gSubj(max) < $i} {
! 126: radiobutton $a.score$i -text $i -variable gSubj(score) \
! 127: -value $i -state disabled
! 128: } else {
! 129: radiobutton $a.score$i -text $i -variable gSubj(score) -value $i
! 130: }
! 131: pack $parent.score$i $a.score$i -side left
! 132: }
! 133:
! 134: set buttonwidth 8
! 135: set gSubj(wrap) 1;set gSubj(pict) 0
! 136: button $command1.setnext -text "Grade&Next" -command "subjSet;subjNext" \
! 137: -width $buttonwidth
! 138: button $command2.set -text "Grade" -command subjSet -width $buttonwidth
! 139: frame $command1.space1 -height 30
! 140: frame $command2.space2 -height 30
! 141: frame $command2.space22 -height 5
! 142: button $command1.next -text "Next" -command subjNext -width $buttonwidth
! 143: button $command2.prev -text "Prev" -command subjPrev -width $buttonwidth
! 144: button $command1.findid -text "Find ID" -command subjFindId -width $buttonwidth
! 145: button $command2.addid -text "Add ID" -command subjAddId -width $buttonwidth
! 146: button $command1.findname -text "Find Name" -command subjFindName -width $buttonwidth
! 147: button $command2.goto -text "GoTo" -command subjGoto -width $buttonwidth
! 148: button $command1.exit -text "Exit" -command subjDone -width $buttonwidth
! 149: checkbutton $command2.wrap -text wrap -command subjWrap -variable gSubj(wrap)
! 150: checkbutton $command2.pict -text pict -command subjPict -variable gSubj(pict)
! 151: checkbutton $command1.done -text graded -variable gSubj(donestat) -state disabled
! 152: pack $command1.setnext $command2.set $command1.space1 $command2.space2 \
! 153: $command1.next $command2.prev $command1.findid \
! 154: $command2.addid $command1.findname $command1.exit $command2.goto \
! 155: $command2.wrap $command2.pict $command1.done $command2.space22
! 156:
! 157: button $morebut.print -text "Print Response" -command subjPrint \
! 158: -width [expr $buttonwidth*2]
! 159: pack $morebut.print
! 160:
! 161: set gSubj(done) 0
! 162: set gSubj(togo) 0
! 163: set gSubj(secAvg) 0.0
! 164: set gSubj(sec) 0
! 165: set gSubj(pause) 0
! 166: label $stat.done -text Done:
! 167: label $stat.donenum -textvariable gSubj(done) -width 4
! 168: label $stat.togo -text "To Go:"
! 169: label $stat.togonum -textvariable gSubj(togo) -width 4
! 170: label $stat.sec -text Sec:
! 171: label $stat.secnum -textvariable gSubj(sec) -width 4
! 172: label $stat.avgsec -text AvgSec:
! 173: label $stat.avgsecnum -textvariable gSubj(avgsec) -width 4
! 174: checkbutton $stat.pause -variable gSubj(pause) -text "Pause" -command subjPause
! 175: pack $stat.done $stat.donenum $stat.togo $stat.togonum -side left
! 176: #not packed
! 177: #$stat.sec $stat.secnum $stat.avgsec $stat.avgsecnum $stat.pause
! 178:
! 179: set gSubj(canvas) [canvas $picts.canvas -height 220 \
! 180: -xscrollcommand "$picts.scroll set"]
! 181: scrollbar $picts.scroll -orient h -command "$picts.canvas xview"
! 182: pack $picts.scroll $gSubj(canvas) -fill x
! 183: subjInit
! 184: }
! 185:
! 186: proc subjWrap {} {
! 187: global gSubj
! 188: if { $gSubj(wrap) } {
! 189: $gSubj(response) configure -wrap char
! 190: } else {
! 191: $gSubj(response) configure -wrap none
! 192: }
! 193: }
! 194:
! 195: proc updateSecCount {} {
! 196: global gSubj
! 197:
! 198: if { [catch {set gSubj(pause)}] } { return }
! 199: if { !$gSubj(pause) } {set gSubj(sec) [expr {[clock seconds] - $gSubj(seconds)}]}
! 200: after 300 updateSecCount
! 201: }
! 202:
! 203: proc subjCheckForNew {} {
! 204: global gSubj
! 205: }
! 206:
! 207: proc subjRestore {} {
! 208: global gSubj
! 209: source gradingstatus
! 210: subjCheckForNew
! 211: set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}]
! 212: cd $gSubj(dir)
! 213: incr gSubj(current) -1
! 214: subjNext
! 215: }
! 216:
! 217: proc subjSave {} {
! 218: global gSubj
! 219: set file [file join $gSubj(dir) records set$gSubj(set) \
! 220: problem$gSubj(quest) gradingstatus]
! 221: set fileId [open $file w]
! 222: puts $fileId "array set gSubj \"[array get gSubj]\""
! 223: close $fileId
! 224: }
! 225:
! 226: proc subjDone {} {
! 227: global gSubj
! 228: subjSave
! 229: unset gSubj
! 230: destroy .gradesubjective
! 231: }
! 232:
! 233: proc subjInit {} {
! 234: global gSubj
! 235:
! 236: set dir [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest)]
! 237: cd $dir
! 238: if { [file exists gradingstatus] } { subjRestore } else {
! 239: set gSubj(stunums) [lsort -dictionary [glob *]]
! 240: cd $gSubj(dir)
! 241: set gSubj(current) -1
! 242: set gSubj(totalsec) 0
! 243: set gSubj(seconds) [clock seconds]
! 244: set fileId [open classl r]
! 245: while { 1 } {
! 246: set aline [gets $fileId]
! 247: if { [eof $fileId]} {break}
! 248: lappend gSubj(allstunum) [string toupper [string range $aline 14 22]]
! 249: # lappend gSubj(allname) [string toupper [string range $aline 24 59]]
! 250: lappend gSubj(allname) [string range $aline 24 59]
! 251: }
! 252: set gSubj(togo) [llength $gSubj(stunums)]
! 253: subjNext
! 254: }
! 255: after 300 updateSecCount
! 256: }
! 257:
! 258: #FIXME check Ids when adding them to the list of ids
! 259: proc checkId { id } {
! 260: global gSubj
! 261: set score [getScore $gSubj(set) $gSubj(quest) $id]
! 262: if { $score == "-" || $score == "0" } { return 1 }
! 263: return 0
! 264: }
! 265:
! 266: proc subjPause {} {
! 267: global gSubj
! 268: if { !$gSubj(pause) } { set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}] }
! 269: }
! 270:
! 271: proc subjStatusUpdate {} {
! 272: global gSubj
! 273:
! 274: set gSubj(done) [llength [array names gSubj "done.*.score"]]
! 275: set total [llength $gSubj(stunums)]
! 276: set gSubj(togo) [expr $total-$gSubj(done)]
! 277: incr gSubj(totalsec) [expr {[clock seconds] - $gSubj(seconds)}]
! 278: set gSubj(avgsec) [format %4.1f [expr $gSubj(totalsec)/double($gSubj(done))]]
! 279: # puts $gSubj(avgsec)
! 280: set gSubj(seconds) [clock seconds]
! 281: }
! 282:
! 283: proc subjSet {} {
! 284: global gSubj
! 285:
! 286: # if {$gSubj(togo) == 0} { return }
! 287: if {$gSubj(score) == "" } { subjMessage "Please select a score." error; return }
! 288: set idlist [subjGetIdList]
! 289: foreach id $idlist {
! 290: setScore $gSubj(set) $gSubj(quest) $id $gSubj(score)
! 291: }
! 292: set id [lindex $gSubj(stunums) $gSubj(current)]
! 293: set gSubj(done.$id.idlist) $idlist
! 294: set gSubj(done.$id.score) $gSubj(score)
! 295: set gSubj(donestat) 1
! 296: subjStatusUpdate
! 297: subjSave
! 298: }
! 299:
! 300: proc subjNext {} {
! 301: global gSubj
! 302:
! 303: set gSubj(score) ""
! 304: set gSubj(pict) 0
! 305: subjPict
! 306: incr gSubj(current)
! 307: if { [llength $gSubj(stunums)] < $gSubj(current) } { incr gSubj(current) -1 }
! 308: set id [lindex $gSubj(stunums) $gSubj(current)]
! 309:
! 310: $gSubj(response) delete 0.0 end
! 311: $gSubj(idlist) delete 0 end
! 312:
! 313: if { $id != "" } {
! 314: set file [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id]
! 315: set fileId [open $file "r"]
! 316: $gSubj(response) insert 0.0 [read $fileId [file size $file]]
! 317: close $fileId
! 318: subjInsertIds $id
! 319: }
! 320:
! 321: wm title .gradesubjective "Grading Subjective, Set $gSubj(set), Prob $gSubj(quest), $id"
! 322: if { [catch {set gSubj(score) $gSubj(done.$id.score)}] } {
! 323: set gSubj(score) ""
! 324: set gSubj(donestat) 0
! 325: update idletasks
! 326: subjFindIds
! 327: } else {
! 328: set gSubj(donestat) 1
! 329: subjInsertIds $gSubj(done.$id.idlist)
! 330: update idletasks
! 331: }
! 332: subjPicts
! 333: }
! 334:
! 335: proc subjFindIds1 {} {
! 336: global gSubj
! 337:
! 338: set text [$gSubj(response) get 0.0 end]
! 339: set result ""
! 340: foreach id $gSubj(allstunum) {
! 341: if { [regexp -nocase -- $id $text] } {
! 342: lappend result $id
! 343: }
! 344: }
! 345: return $result
! 346: }
! 347:
! 348: proc subjFindIds2 {} {
! 349: global gSubj
! 350:
! 351: set text [string toupper [$gSubj(response) get 0.0 end]]
! 352: set result ""
! 353: if { [catch {lsearch $text a}] } {
! 354: puts badlist; return subjFindIds1
! 355: } else {
! 356: foreach id $gSubj(allstunum) {
! 357: if { [lsearch -glob $text *$id*] != -1 } {
! 358: lappend result $id
! 359: }
! 360: }
! 361: }
! 362: return $result
! 363: }
! 364:
! 365: proc subjFindIds3 {} {
! 366: global gSubj
! 367:
! 368: set text [string toupper [$gSubj(response) get 0.0 end]]
! 369: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
! 370: set result ""
! 371: foreach word $text {
! 372: if { [lsearch -exact $gSubj(allstunum) $word] != -1 } {
! 373: lappend result $word
! 374: }
! 375: }
! 376: return $result
! 377: }
! 378:
! 379: proc subjFindIds4 {} {
! 380: global gSubj
! 381:
! 382: set text [string toupper [$gSubj(response) get 0.0 end]]
! 383: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
! 384: set result ""
! 385: foreach id $gSubj(allstunum) {
! 386: if { [lsearch -exact $text $id] != -1 } {
! 387: lappend result $id
! 388: }
! 389: }
! 390: return $result
! 391: }
! 392:
! 393: proc subjFindId {} {
! 394: global gSubj
! 395: puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]"
! 396: subjPicts
! 397: }
! 398:
! 399: proc subjFindIds {} {
! 400: global gSubj
! 401: # puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]"
! 402: subjInsertIds [set ids [subjFindIds4]]
! 403: # puts "3:[time {set ids [subjFindIds3]} 2]\t:[llength $ids]"
! 404: # puts "2:[time {set ids [subjFindIds2]} 2]\t:[llength $ids]"
! 405: # puts "1:[time {set ids [subjFindIds1]} 2]\t:[llength $ids]"
! 406:
! 407: }
! 408:
! 409: proc subjFindName {} {
! 410: global gSubj
! 411:
! 412: if {[catch {set text [string toupper [$gSubj(response) get sel.first sel.last]]}]} {
! 413: set text [string toupper [$gSubj(response) get 0.0 end]]
! 414: }
! 415: set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"]
! 416: set result ""
! 417: set length [llength $gSubj(allname)]
! 418: foreach word $text {
! 419: if { [string length $word] == 0 } { continue }
! 420: for { set i 0 } { $i < $length } { incr i } {
! 421: set name [string toupper [lindex $gSubj(allname) $i]]
! 422: if { [set find [lsearch -glob $name *$word*]] != -1 } {
! 423: lappend result $i
! 424: }
! 425: }
! 426: }
! 427: set result [lunique $result]
! 428: foreach index $result {
! 429: lappend temp [list [lindex $gSubj(allstunum) $index] \
! 430: [lindex $gSubj(allname) $index]]
! 431: }
! 432: if {[catch {set temp [lsort $temp]}]} {
! 433: displayMessage "No Student found."
! 434: return
! 435: }
! 436: set selected [multipleChoice {} "Select which student you want." $temp 1]
! 437: if {$selected == ""} { return }
! 438: set done 0
! 439: if { [llength $selected] == 2 } {
! 440: if { [lindex [lindex $selected 0] 0] == "" } {
! 441: set selected [lindex $selected 0]
! 442: set done 1
! 443: }
! 444: }
! 445: if { !$done } { foreach person $selected { lappend idlist [lindex $selected 0] } }
! 446: subjInsertIds $idlist
! 447: subjPicts
! 448: }
! 449:
! 450: proc subjGetNameFromId { id } {
! 451: global gSubj
! 452: return [lindex $gSubj(allname) [lsearch $gSubj(allstunum) $id]]
! 453: }
! 454:
! 455: proc subjGetIdList {} {
! 456: global gSubj
! 457: set list [$gSubj(idlist) get 0 end]
! 458: set id ""
! 459: foreach element $list {
! 460: append id "[lindex $element 0] "
! 461: }
! 462: return $id
! 463: }
! 464:
! 465: proc subjInsertIds { selected } {
! 466: global gSubj
! 467: set current [subjGetIdList]
! 468: foreach person $selected {lappend current [lindex $person 0]}
! 469: set current [lsort [lunique $current]]
! 470: $gSubj(idlist) delete 0 end
! 471: foreach id $current {
! 472: $gSubj(idlist) insert end "$id [subjGetNameFromId $id]"
! 473: }
! 474: }
! 475:
! 476: proc subjDeleteId {} {
! 477: global gSubj
! 478: $gSubj(idlist) delete [$gSubj(idlist) curselection]
! 479: subjPicts
! 480: }
! 481:
! 482: proc subjAddId {} {
! 483: global gSubj
! 484: getOneStudent {} $gSubj(dir) id name
! 485: if { $id == "" } { return }
! 486: subjInsertIds $id
! 487: }
! 488:
! 489: proc subjPrev {} {
! 490: global gSubj
! 491: if { $gSubj(current) > 0 } {
! 492: incr gSubj(current) -2
! 493: subjNext
! 494: }
! 495: }
! 496:
! 497: proc subjMessage { mesg {tag normal} } {
! 498: global gSubj
! 499: displayMessage $message
! 500: # $gSubj(msg) insert end "[clock format [clock seconds] -format {%I:%M:%S}] - $mesg\n" $tag
! 501: # $gSubj(msg) see end
! 502: }
! 503:
! 504: proc subjAddPict { id } {
! 505: global gSubj
! 506: set gif [file join $gSubj(dir) photo gif $id.gif]
! 507: if { ![file exists $gif] } { return }
! 508: lappend gSubj(imagelist) [set image [image create photo]]
! 509: $image read $gif
! 510: set a [llength $gSubj(imagelist)]
! 511: $gSubj(canvas) create image [expr ($a-1)*200] 20 -image $image -anchor nw
! 512: $gSubj(canvas) create text [expr ($a-1)*200] 10 -text $id -anchor nw
! 513: $gSubj(canvas) create text [expr ($a-1)*200] 0 -text [subjGetNameFromId $id] \
! 514: -anchor nw
! 515: $gSubj(canvas) configure -scrollregion "1 1 [expr ($a)*200] 200"
! 516: update idletasks
! 517: return $a
! 518: }
! 519:
! 520: proc subjConvertPict { id } {
! 521: global gSubj
! 522: set gif [file join $gSubj(dir) photo gif $id.gif]
! 523: set jpg [file join $gSubj(dir) photo jpg $id.jpg]
! 524: if { ![file exists $gif] } {
! 525: if { [file exists $jpg] } {
! 526: exec djpeg -outfile $gif $jpg
! 527: }
! 528: }
! 529: }
! 530:
! 531: proc subjPicts {} {
! 532: global gSubj
! 533:
! 534: $gSubj(canvas) delete all
! 535: catch { foreach image $gSubj(imagelist) { catch {image delete $image} } }
! 536: set gSubj(imagelist) ""
! 537: set idlist [subjGetIdList]
! 538: foreach id $idlist {
! 539: subjConvertPict $id
! 540: set num [subjAddPict $id]
! 541: }
! 542: }
! 543:
! 544: proc subjPict {} {
! 545: global gSubj
! 546: if { $gSubj(pict) } {
! 547: pack $gSubj(pictFrame)
! 548: pack configure $gSubj(pictFrame) -fill x
! 549: } else {
! 550: pack forget $gSubj(pictFrame)
! 551: }
! 552: }
! 553:
! 554: proc subjPrint {} {
! 555: global gSubj
! 556: set lprCommand [getLprCommand quiztemp.txt]
! 557: if {$lprCommand == "Cancel"} { return }
! 558:
! 559: set fileId [open "quiztemp.txt" w]
! 560: set subid [lindex $gSubj(stunums) $gSubj(current)]
! 561: if { $subid != "" } {
! 562: set file [file join $gSubj(dir) records set$gSubj(set) \
! 563: problem$gSubj(quest) $subid]
! 564: puts $fileId "Submitted at [clock format [file mtime $file ]]"
! 565: puts $fileId "By Student:\n [string trimright [subjGetNameFromId $subid]] ($subid)"
! 566: }
! 567: if { [llength [subjGetIdList]] > 1 } {
! 568: puts $fileId "Additional Authors:"
! 569: foreach id [subjGetIdList] {
! 570: if { $id == $subid } { continue }
! 571: puts $fileId " [string trimright [subjGetNameFromId $id]] ($id)"
! 572: }
! 573: }
! 574: puts $fileId ""
! 575: puts -nonewline $fileId "[ $gSubj(response) get 0.0 end-1c ]"
! 576: close $fileId
! 577:
! 578: set errorMsg ""
! 579: set error [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]
! 580:
! 581: if { $error == 1 } {
! 582: displayError "An error occurred while printing: $errorMsg"
! 583: } else {
! 584: displayMessage "Print job sent to the printer.\n $output"
! 585: }
! 586: exec rm -f quiztemp.txt
! 587: }
! 588:
! 589: proc subjGoto {} {
! 590: global gSubj
! 591: subjGetOneStudent {} $gSubj(dir) id name
! 592: if { $id == "" } { return }
! 593: if { [file exists [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id] ] } {
! 594: set gSubj(current) [expr [lsearch $gSubj(stunums) $id] - 1]
! 595: subjNext
! 596: } else {
! 597: displayMessage "Student $id did not submit an answer."
! 598: }
! 599: }
! 600:
! 601: proc subjGetUngraded {} {
! 602: global gSubj
! 603:
! 604: set idlist ""
! 605: foreach stunum $gSubj(stunums) {
! 606: if {[catch {set gSubj(done.$stunum.score)}]} {
! 607: lappend idlist $stunum
! 608: }
! 609: }
! 610: return [multipleChoice {} "Select which student you want to grade." $idlist 1]
! 611: }
! 612:
! 613: proc subjGetOneStudent { window path idVar nameVar {message "" } } {
! 614: upvar $idVar id
! 615: upvar $nameVar name
! 616:
! 617: set select [tk_dialog $window.dialog "$message Student select method" \
! 618: "Select student by:" "" "" "Student Number" \
! 619: "Student Name" "Not Yet Graded" "Cancel"]
! 620: if { $select == 3 } {
! 621: set id ""
! 622: set name ""
! 623: return
! 624: }
! 625: if { $select == 2 } {
! 626: set id [subjGetUngraded]
! 627: set name [subjGetNameFromId $id]
! 628: return
! 629: }
! 630: set done 0
! 631: while { ! $done } {
! 632: if { $select } { set search "name" } { set search "number" }
! 633: set pattern [ getString $window "$message Please enter a student $search." ]
! 634: if {$pattern == "" } {
! 635: set done 1
! 636: set id ""
! 637: set name ""
! 638: continue
! 639: }
! 640: if { $select } {
! 641: set matched_entries [findByStudentName $pattern $path]
! 642: } else {
! 643: set matched_entries [findByStudentNumber $pattern $path]
! 644: }
! 645: if { [llength $matched_entries] == 0 } {
! 646: displayMessage "No student found. Please re-enter student $search."
! 647: } elseif { [llength $matched_entries] == 1 } {
! 648: set id [lindex [lindex $matched_entries 0] 0]
! 649: set name [lindex [lindex $matched_entries 0] 1]
! 650: set done 1
! 651: } elseif { [llength $matched_entries] < 30 } {
! 652: set select [ multipleChoice $window \
! 653: "Matched Student Records, Select one" \
! 654: $matched_entries ]
! 655: if { $select == "" } {
! 656: set id ""; set name ""
! 657: return
! 658: }
! 659: set id [lindex $select 0]
! 660: set name [lindex $select 1]
! 661: set done 1
! 662: } else {
! 663: displayMessage "There were [llength $matched_entries], please enter more data to narrow the search."
! 664: }
! 665: }
! 666: }
! 667:
! 668: ###########################################################
! 669: # subjSendResponse
! 670: ###########################################################
! 671: ###########################################################
! 672: ###########################################################
! 673: proc subjSendResponse {} {
! 674: global gSubj
! 675: }
! 676:
! 677: proc subjIndexResponse {} {
! 678: global gSubj
! 679:
! 680: $gSubj(response) delete 0 end
! 681:
! 682: set i 0
! 683: foreach element [lsort -dictionary [array names gSubj "response.*"]] {
! 684: set head [string range $gSubj($element) 0 30]
! 685: $gSubj(response) insert end "[incr i]. $head"
! 686: }
! 687: }
! 688:
! 689: ###########################################################
! 690: # subjSaveResponse
! 691: ###########################################################
! 692: ###########################################################
! 693: ###########################################################
! 694: proc subjSaveResponse {} {
! 695: global gSubj
! 696:
! 697: set num [incr gSubj(numresponse)]
! 698: set gSubj(response.$num) [$gSubj(responseEdit) get 0.0 end]
! 699: subjIndexResponse
! 700: }
! 701:
! 702: ###########################################################
! 703: # subjNewResponse
! 704: ###########################################################
! 705: ###########################################################
! 706: ###########################################################
! 707: proc subjNewResponse {} {
! 708: global gSubj gWindowMenu
! 709:
! 710: if { [winfo exists .addresponse] } {
! 711: capaRaise .addresponse
! 712: return
! 713: }
! 714: set response [toplevel .addresponse]
! 715: $gWindowMenu add command -label "AddingResponse" -command "capaRaise $response"
! 716: wm title $response "Adding a New Response"
! 717:
! 718: set textFrame [frame $response.text]
! 719: set buttonFrame [frame $response.button]
! 720:
! 721: set gSubj(responseEdit) [text $textFrame.text -yscrollcommand \
! 722: "$textFrame.scroll set" -wrap char -height 15]
! 723: scrollbar $textFrame.scroll -command "$textFrame.text yview"
! 724: pack $textFrame.scroll $textFrame.text -side left -expand 1
! 725:
! 726: button $buttonFrame.save -text Save -command "subjSaveResponse"
! 727: button $buttonFrame.forget -text Cancel -command "destroy $response"
! 728: pack $buttonFrame.save $buttonFrame.forget -side left
! 729: }
! 730:
! 731: ###########################################################
! 732: # subjDeleteResponse
! 733: ###########################################################
! 734: ###########################################################
! 735: ###########################################################
! 736: proc subjDeleteResponse {} {
! 737: global gSubj
! 738: }
! 739:
! 740: ###########################################################
! 741: # subjEditResponse
! 742: ###########################################################
! 743: ###########################################################
! 744: ###########################################################
! 745: proc subjEditResponse {} {
! 746: global gSubj
! 747: }
! 748:
! 749: ###########################################################
! 750: # subjViewResponse
! 751: ###########################################################
! 752: ###########################################################
! 753: ###########################################################
! 754: proc subjViewResponse {} {
! 755: global gSubj
! 756: }
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