set gMaxSet 99 proc gradeSubjective {} { global gSubj if { [winfo exists .gradeSubjective] } { return } set var [tk_getOpenFile -title "Please select a capa.config file" -filetypes \ { { {Capa Config} {capa.config} } }] if { $var != "" } { set gSubj(dir) [file dirname $var] cd $gSubj(dir) } else { return } parseCapaConfig if { "" == [set gSubj(set) [getOneSet {} $gSubj(dir)]] } return if { "" == [set gSubj(quest) [getString {} "Which question?"]] } return set fileid [open "records/set$gSubj(set).db" r] gets $fileid aline gets $fileid aline set gSubj(max) [lindex [split $aline {}] [expr $gSubj(quest) - 1]] createGradeSubjWindow } proc createGradeSubjWindow {} { global gSubj set gradSubj [toplevel .gradesubjective] wm protocol $gradSubj WM_DELETE_WINDOW "subjDone" set info [frame $gradSubj.info] set grade [frame $gradSubj.grade] set gSubj(pictFrame) [set picts [frame $gradSubj.picts -borderwidth 4 -relief groove]] pack $info $grade -side top set msg [frame $info.msg] set id [frame $info.id] pack $msg $id -side left # set gSubj(msg) [text $msg.text -width 40 -height 8 -yscrollcommand "$msg.scroll set"] # scrollbar $msg.scroll -command "$msg.text yview" # pack $gSubj(msg) $msg.scroll -side left # pack configure $msg.scroll -fill y # $gSubj(msg) tag configure error -foreground red # $gSubj(msg) tag configure info -foreground #006c00 set msglist [frame $msg.msglist] set msgbutton [frame $msg.msgbutton] pack $msglist $msgbutton -side top pack configure $msgbutton -anchor w set gSubj(responseList) [listbox $msglist.list -width 40 -height 5 \ -yscrollcommand "$msglist.scroll set"] scrollbar $msglist.scroll -command "$msglist.text yview" pack $gSubj(responseList) $msglist.scroll -side left pack configure $msglist.scroll -fill y set gSubj(numresponse) 0 button $msgbutton.send -text Send -command subjSendResponse button $msgbutton.new -text New -command subjNewResponse button $msgbutton.delete -text Delete -command subjDeleteResponse button $msgbutton.view -text View -command subjViewResponse button $msgbutton.edit -text Edit -command subjEditResponse pack $msgbutton.send $msgbutton.new $msgbutton.delete $msgbutton.view \ $msgbutton.edit -side left set idlist [frame $id.idlist] set idbutton [frame $id.idbutton] pack $idlist $idbutton -side top pack configure $idbutton -anchor w set gSubj(idlist) [listbox $idlist.list -width 34 -height 5 \ -yscrollcommand "$idlist.scroll set"] scrollbar $idlist.scroll -command "$idlist.list yview" pack $idlist.list $idlist.scroll -side left pack configure $idlist.scroll -fill y button $idbutton.delete -text Delete -command subjDeleteId frame $idbutton.spacer -width 30 label $idbutton.l1 -text "\# Words:" label $idbutton.words -textvariable gSubj(numwords) pack $idbutton.delete $idbutton.spacer $idbutton.l1 $idbutton.words -side left set response [frame $grade.response] pack $response set scoreandcom [toplevel $gradSubj.scoreandcom] wm title $scoreandcom "Control Panel" wm protocol $gradSubj WM_DELETE_WINDOW "subjDone" set score [frame $scoreandcom.score] set command [frame $scoreandcom.command] set morebut [frame $scoreandcom.morebut] set stat [frame $scoreandcom.stat] pack $score $command $morebut $stat -side top set command1 [frame $command.command1] set command2 [frame $command.command2] pack $command1 $command2 -side left set top [frame $response.top] set bot [frame $response.bot] pack $top $bot -side top pack configure $bot -expand 0 -fill x set gSubj(response) [text $top.response -width 80 -height 21 \ -yscrollcommand "$top.scroll set" \ -xscrollcommand "$bot.scroll set"] scrollbar $top.scroll -command "$top.response yview" pack $gSubj(response) $top.scroll -side left pack configure $top.scroll -fill y scrollbar $bot.scroll -orient h -command "$top.response xview" pack $bot.scroll pack configure $bot.scroll -expand 0 -fill x wm geometry $gradSubj "-10+0" set score0 [frame $score.score0] set score1 [frame $score.score1] pack $score0 $score1 -side top for {set i 0} {$i < 10 } { incr i } { set parent [eval set "score[expr $i/5]"] set a [frame $parent.score$i -relief sunken -borderwidth 1] if { $gSubj(max) < $i} { radiobutton $a.score$i -text $i -variable gSubj(score) \ -value $i -state disabled } else { radiobutton $a.score$i -text $i -variable gSubj(score) -value $i } pack $parent.score$i $a.score$i -side left } set buttonwidth 8 set gSubj(wrap) 1;set gSubj(pict) 0 button $command1.setnext -text "Grade&Next" -command "subjSet;subjNext" \ -width $buttonwidth button $command2.set -text "Grade" -command subjSet -width $buttonwidth frame $command1.space1 -height 30 frame $command2.space2 -height 30 frame $command2.space22 -height 5 button $command1.next -text "Next" -command subjNext -width $buttonwidth button $command2.prev -text "Prev" -command subjPrev -width $buttonwidth button $command1.findid -text "Find ID" -command subjFindId -width $buttonwidth button $command2.addid -text "Add ID" -command subjAddId -width $buttonwidth button $command1.findname -text "Find Name" -command subjFindName -width $buttonwidth button $command2.goto -text "GoTo" -command subjGoto -width $buttonwidth button $command1.exit -text "Exit" -command subjDone -width $buttonwidth checkbutton $command2.wrap -text wrap -command subjWrap -variable gSubj(wrap) checkbutton $command2.pict -text pict -command subjPict -variable gSubj(pict) checkbutton $command1.done -text graded -variable gSubj(donestat) -state disabled pack $command1.setnext $command2.set $command1.space1 $command2.space2 \ $command1.next $command2.prev $command1.findid \ $command2.addid $command1.findname $command1.exit $command2.goto \ $command2.wrap $command2.pict $command1.done $command2.space22 button $morebut.print -text "Print Response" -command subjPrint \ -width [expr $buttonwidth*2] pack $morebut.print set gSubj(done) 0 set gSubj(togo) 0 set gSubj(secAvg) 0.0 set gSubj(sec) 0 set gSubj(pause) 0 label $stat.done -text Done: label $stat.donenum -textvariable gSubj(done) -width 4 label $stat.togo -text "To Go:" label $stat.togonum -textvariable gSubj(togo) -width 4 label $stat.sec -text Sec: label $stat.secnum -textvariable gSubj(sec) -width 4 label $stat.avgsec -text AvgSec: label $stat.avgsecnum -textvariable gSubj(avgsec) -width 4 checkbutton $stat.pause -variable gSubj(pause) -text "Pause" -command subjPause pack $stat.done $stat.donenum $stat.togo $stat.togonum -side left #not packed #$stat.sec $stat.secnum $stat.avgsec $stat.avgsecnum $stat.pause set gSubj(canvas) [canvas $picts.canvas -height 220 \ -xscrollcommand "$picts.scroll set"] scrollbar $picts.scroll -orient h -command "$picts.canvas xview" pack $picts.scroll $gSubj(canvas) -fill x subjInit } proc subjWrap {} { global gSubj if { $gSubj(wrap) } { $gSubj(response) configure -wrap char } else { $gSubj(response) configure -wrap none } } proc updateSecCount {} { global gSubj if { [catch {set gSubj(pause)}] } { return } if { !$gSubj(pause) } {set gSubj(sec) [expr {[clock seconds] - $gSubj(seconds)}]} after 300 updateSecCount } proc subjCheckForNew {} { global gSubj } proc subjRestore {} { global gSubj source gradingstatus subjCheckForNew set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}] cd $gSubj(dir) incr gSubj(current) -1 subjNext } proc subjSave {} { global gSubj set file [file join $gSubj(dir) records set$gSubj(set) \ problem$gSubj(quest) gradingstatus] set fileId [open $file w] puts $fileId "array set gSubj \"[array get gSubj]\"" close $fileId } proc subjDone {} { global gSubj subjSave unset gSubj destroy .gradesubjective } proc subjInit {} { global gSubj set dir [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest)] cd $dir if { [file exists gradingstatus] } { subjRestore } else { set gSubj(stunums) [lsort -dictionary [glob *]] cd $gSubj(dir) set gSubj(current) -1 set gSubj(totalsec) 0 set gSubj(seconds) [clock seconds] set fileId [open classl r] while { 1 } { set aline [gets $fileId] if { [eof $fileId]} {break} lappend gSubj(allstunum) [string toupper [string range $aline 14 22]] # lappend gSubj(allname) [string toupper [string range $aline 24 59]] lappend gSubj(allname) [string range $aline 24 59] } set gSubj(togo) [llength $gSubj(stunums)] subjNext } after 300 updateSecCount } #FIXME check Ids when adding them to the list of ids proc checkId { id } { global gSubj set score [getScore $gSubj(set) $gSubj(quest) $id] if { $score == "-" || $score == "0" } { return 1 } return 0 } proc subjPause {} { global gSubj if { !$gSubj(pause) } { set gSubj(seconds) [expr {[clock seconds] - $gSubj(sec)}] } } proc subjStatusUpdate {} { global gSubj set gSubj(done) [llength [array names gSubj "done.*.score"]] set total [llength $gSubj(stunums)] set gSubj(togo) [expr $total-$gSubj(done)] incr gSubj(totalsec) [expr {[clock seconds] - $gSubj(seconds)}] set gSubj(avgsec) [format %4.1f [expr $gSubj(totalsec)/double($gSubj(done))]] # puts $gSubj(avgsec) set gSubj(seconds) [clock seconds] } proc subjSet {} { global gSubj # if {$gSubj(togo) == 0} { return } if {$gSubj(score) == "" } { subjMessage "Please select a score." error; return } set idlist [subjGetIdList] foreach id $idlist { setScore $gSubj(set) $gSubj(quest) $id $gSubj(score) } set id [lindex $gSubj(stunums) $gSubj(current)] set gSubj(done.$id.idlist) $idlist set gSubj(done.$id.score) $gSubj(score) set gSubj(donestat) 1 subjStatusUpdate subjSave } proc subjNext {} { global gSubj set gSubj(score) "" set gSubj(pict) 0 subjPict incr gSubj(current) if { [llength $gSubj(stunums)] < $gSubj(current) } { incr gSubj(current) -1 } set id [lindex $gSubj(stunums) $gSubj(current)] $gSubj(response) delete 0.0 end $gSubj(idlist) delete 0 end if { $id != "" } { set file [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id] set fileId [open $file "r"] $gSubj(response) insert 0.0 [read $fileId [file size $file]] close $fileId subjInsertIds $id } append words [string trim [$gSubj(response) get 0.0 end-1c]] " " set ws [format " \t\n"] set gSubj(numwords) [regsub -all -- \[$ws\]+ $words {} b] wm title .gradesubjective "Grading Subjective, Set $gSubj(set), Prob $gSubj(quest), $id" if { [catch {set gSubj(score) $gSubj(done.$id.score)}] } { set gSubj(score) "" set gSubj(donestat) 0 update idletasks subjFindIds } else { set gSubj(donestat) 1 subjInsertIds $gSubj(done.$id.idlist) update idletasks } subjPicts } proc subjFindIds1 {} { global gSubj set text [$gSubj(response) get 0.0 end] set result "" foreach id $gSubj(allstunum) { if { [regexp -nocase -- $id $text] } { lappend result $id } } return $result } proc subjFindIds2 {} { global gSubj set text [string toupper [$gSubj(response) get 0.0 end]] set result "" if { [catch {lsearch $text a}] } { puts badlist; return subjFindIds1 } else { foreach id $gSubj(allstunum) { if { [lsearch -glob $text *$id*] != -1 } { lappend result $id } } } return $result } proc subjFindIds3 {} { global gSubj set text [string toupper [$gSubj(response) get 0.0 end]] set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"] set result "" foreach word $text { if { [lsearch -exact $gSubj(allstunum) $word] != -1 } { lappend result $word } } return $result } proc subjFindIds4 {} { global gSubj set text [string toupper [$gSubj(response) get 0.0 end]] set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"] set result "" foreach id $gSubj(allstunum) { if { [lsearch -exact $text $id] != -1 } { lappend result $id } } return $result } proc subjFindId {} { global gSubj puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]" subjPicts } proc subjFindIds {} { global gSubj # puts "4:[time {subjInsertIds [set ids [subjFindIds4]]} ]\t:[llength $ids]" subjInsertIds [set ids [subjFindIds4]] # puts "3:[time {set ids [subjFindIds3]} 2]\t:[llength $ids]" # puts "2:[time {set ids [subjFindIds2]} 2]\t:[llength $ids]" # puts "1:[time {set ids [subjFindIds1]} 2]\t:[llength $ids]" } proc subjFindName {} { global gSubj if {[catch {set text [string toupper [$gSubj(response) get sel.first sel.last]]}]} { set text [string toupper [$gSubj(response) get 0.0 end]] } set text [split $text "{}!@\#\$%^&*()_-+=|\\,.<>/?'\";:`~ \n\t"] set result "" set length [llength $gSubj(allname)] foreach word $text { if { [string length $word] == 0 } { continue } for { set i 0 } { $i < $length } { incr i } { set name [string toupper [lindex $gSubj(allname) $i]] if { [set find [lsearch -glob $name *$word*]] != -1 } { lappend result $i } } } set result [lunique $result] foreach index $result { lappend temp [list [lindex $gSubj(allstunum) $index] \ [lindex $gSubj(allname) $index]] } if {[catch {set temp [lsort $temp]}]} { displayMessage "No Student found." return } set selected [multipleChoice {} "Select which student you want." $temp 1] if {$selected == ""} { return } set done 0 if { [llength $selected] == 2 } { if { [lindex [lindex $selected 0] 0] == "" } { set selected [lindex $selected 0] set done 1 } } if { !$done } { foreach person $selected { lappend idlist [lindex $selected 0] } } subjInsertIds $idlist subjPicts } proc subjGetNameFromId { id } { global gSubj return [lindex $gSubj(allname) [lsearch $gSubj(allstunum) $id]] } proc subjGetIdList {} { global gSubj set list [$gSubj(idlist) get 0 end] set id "" foreach element $list { append id "[lindex $element 0] " } return $id } proc subjInsertIds { selected } { global gSubj set current [subjGetIdList] foreach person $selected {lappend current [lindex $person 0]} set current [lsort [lunique $current]] $gSubj(idlist) delete 0 end foreach id $current { $gSubj(idlist) insert end "$id [subjGetNameFromId $id]" } } proc subjDeleteId {} { global gSubj $gSubj(idlist) delete [$gSubj(idlist) curselection] subjPicts } proc subjAddId {} { global gSubj getOneStudent {} $gSubj(dir) id name if { $id == "" } { return } subjInsertIds $id } proc subjPrev {} { global gSubj if { $gSubj(current) > 0 } { incr gSubj(current) -2 subjNext } } proc subjMessage { mesg {tag normal} } { global gSubj displayMessage $message # $gSubj(msg) insert end "[clock format [clock seconds] -format {%I:%M:%S}] - $mesg\n" $tag # $gSubj(msg) see end } proc subjAddPict { id } { global gSubj set gif [file join $gSubj(dir) photo gif $id.gif] if { ![file exists $gif] } { return } lappend gSubj(imagelist) [set image [image create photo]] $image read $gif set a [llength $gSubj(imagelist)] $gSubj(canvas) create image [expr ($a-1)*200] 20 -image $image -anchor nw $gSubj(canvas) create text [expr ($a-1)*200] 10 -text $id -anchor nw $gSubj(canvas) create text [expr ($a-1)*200] 0 -text [subjGetNameFromId $id] \ -anchor nw $gSubj(canvas) configure -scrollregion "1 1 [expr ($a)*200] 200" update idletasks return $a } proc subjConvertPict { id } { global gSubj set gif [file join $gSubj(dir) photo gif $id.gif] set jpg [file join $gSubj(dir) photo jpg $id.jpg] if { ![file exists $gif] } { if { [file exists $jpg] } { exec djpeg -outfile $gif $jpg } } } proc subjPicts {} { global gSubj $gSubj(canvas) delete all catch { foreach image $gSubj(imagelist) { catch {image delete $image} } } set gSubj(imagelist) "" set idlist [subjGetIdList] foreach id $idlist { subjConvertPict $id set num [subjAddPict $id] } } proc subjPict {} { global gSubj if { $gSubj(pict) } { pack $gSubj(pictFrame) pack configure $gSubj(pictFrame) -fill x } else { pack forget $gSubj(pictFrame) } } proc subjPrint {} { global gSubj set lprCommand [getLprCommand quiztemp.txt] if {$lprCommand == "Cancel"} { return } set fileId [open "quiztemp.txt" w] set subid [lindex $gSubj(stunums) $gSubj(current)] if { $subid != "" } { set file [file join $gSubj(dir) records set$gSubj(set) \ problem$gSubj(quest) $subid] puts $fileId "Submitted at [clock format [file mtime $file ]]" puts $fileId "By Student:\n [string trimright [subjGetNameFromId $subid]] ($subid)" } if { [llength [subjGetIdList]] > 1 } { puts $fileId "Additional Authors:" foreach id [subjGetIdList] { if { $id == $subid } { continue } puts $fileId " [string trimright [subjGetNameFromId $id]] ($id)" } } puts $fileId "" puts -nonewline $fileId "[ $gSubj(response) get 0.0 end-1c ]" close $fileId set errorMsg "" set error [catch {set output [ eval "exec $lprCommand" ] } errorMsg ] if { $error == 1 } { displayError "An error occurred while printing: $errorMsg" } else { displayMessage "Print job sent to the printer.\n $output" } exec rm -f quiztemp.txt } proc subjGoto {} { global gSubj subjGetOneStudent {} $gSubj(dir) id name if { $id == "" } { return } if { [file exists [file join $gSubj(dir) records set$gSubj(set) problem$gSubj(quest) $id] ] } { set gSubj(current) [expr [lsearch $gSubj(stunums) $id] - 1] subjNext } else { displayMessage "Student $id did not submit an answer." } } proc subjGetUngraded {} { global gSubj set idlist "" foreach stunum $gSubj(stunums) { if {[catch {set gSubj(done.$stunum.score)}]} { lappend idlist $stunum } } return [multipleChoice {} "Select which student you want to grade." $idlist 1] } proc subjGetOneStudent { window path idVar nameVar {message "" } } { upvar $idVar id upvar $nameVar name set select [tk_dialog $window.dialog "$message Student select method" \ "Select student by:" "" "" "Student Number" \ "Student Name" "Not Yet Graded" "Cancel"] if { $select == 3 } { set id "" set name "" return } if { $select == 2 } { set id [subjGetUngraded] set name [subjGetNameFromId $id] return } set done 0 while { ! $done } { if { $select } { set search "name" } { set search "number" } set pattern [ getString $window "$message Please enter a student $search." ] if {$pattern == "" } { set done 1 set id "" set name "" continue } if { $select } { set matched_entries [findByStudentName $pattern $path] } else { set matched_entries [findByStudentNumber $pattern $path] } if { [llength $matched_entries] == 0 } { displayMessage "No student found. Please re-enter student $search." } elseif { [llength $matched_entries] == 1 } { set id [lindex [lindex $matched_entries 0] 0] set name [lindex [lindex $matched_entries 0] 1] set done 1 } elseif { [llength $matched_entries] < 30 } { set select [ multipleChoice $window \ "Matched Student Records, Select one" \ $matched_entries ] if { $select == "" } { set id ""; set name "" return } set id [lindex $select 0] set name [lindex $select 1] set done 1 } else { displayMessage "There were [llength $matched_entries], please enter more data to narrow the search." } } } ########################################################### # subjSendResponse ########################################################### ########################################################### ########################################################### proc subjSendResponse {} { global gSubj } ########################################################### # subjIndexResponse ########################################################### ########################################################### ########################################################### proc subjIndexResponse {} { global gSubj $gSubj(responseList) delete 0 end set i 0 foreach element [lsort -dictionary [array names gSubj "response.*"]] { regsub -all -- "\n\r\t" [string range $gSubj($element) 0 30] " " head $gSubj(responseList) insert end "[incr i]. $head" } } ########################################################### # subjSaveResponse ########################################################### ########################################################### ########################################################### proc subjSaveResponse {} { global gSubj set num [incr gSubj(numresponse)] set gSubj(response.$num) [$gSubj(responseEdit) get 0.0 end] destroy [winfo toplevel $gSubj(responseEdit)] subjIndexResponse } ########################################################### # subjNewResponse ########################################################### ########################################################### ########################################################### proc subjNewResponse {} { global gSubj gWindowMenu if { [winfo exists .addresponse] } { capaRaise .addresponse return } set response [toplevel .addresponse] $gWindowMenu add command -label "AddingResponse" -command "capaRaise $response" wm title $response "Adding a New Response" set textFrame [frame $response.text] set buttonFrame [frame $response.button] pack $textFrame $buttonFrame set gSubj(responseEdit) [text $textFrame.text -yscrollcommand \ "$textFrame.scroll set" -wrap char -height 15] scrollbar $textFrame.scroll -command "$textFrame.text yview" pack $textFrame.text $textFrame.scroll -side left -expand 1 pack configure $textFrame.scroll -fill y button $buttonFrame.save -text Save -command "subjSaveResponse" button $buttonFrame.forget -text Cancel -command "destroy $response" pack $buttonFrame.save $buttonFrame.forget -side left } ########################################################### # subjDeleteResponse ########################################################### ########################################################### ########################################################### proc subjDeleteResponse {} { global gSubj } ########################################################### # subjEditResponse ########################################################### ########################################################### ########################################################### proc subjEditResponse {} { global gSubj } ########################################################### # subjViewResponse ########################################################### ########################################################### ########################################################### proc subjViewResponse {} { global gSubj }