Annotation of capa/capa51/GUITools/gradesubjective.tcl, revision 1.3

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>