--- capa/capa51/GUITools/common.tcl 1999/09/28 21:25:36 1.1.1.1 +++ capa/capa51/GUITools/common.tcl 2000/03/22 21:08:02 1.9 @@ -568,11 +568,24 @@ proc parseCapaConfig { {num "" } { path "answers_command *= *" - "dvips_command *= *" - "xdvi_command *= *" - + "mail_command *= *" - "IMP_color *= *" - "comment_color *= *" - "exam_path *= *" - "quiz_path *= *" - "supp_path *= *" - + "correction_path *= *" - + "default_try_val *= *" - + "default_prob_val *= *" - + "default_hint_val *= *" - + "homework_weight *= *" - + "quiz_weight *= *" - + "exam_weight *= *" - + "final_weight *= *" - + "correction_weight *= *" - + "final_exam_set_number *= *" - + "homework_count *= *" - + "quiz_count *= *" - "others_path *= *" { set gCapaConfig($prefix[lindex $aline 0]) [lindex $aline end] } @@ -1132,7 +1145,7 @@ proc getOneStudent { window path idVar n ########################################################### ########################################################### ########################################################### -proc getString { window message } { +proc getString { window message {type "any"}} { global gPrompt set setWin [toplevel $window.getstring] @@ -1143,7 +1156,8 @@ proc getString { window message } { set gPrompt(val) "" - entry $valFrame.val -textvariable gPrompt(val) + entry $valFrame.val -textvariable gPrompt(val) -validate key \ + -validatecommand "limitEntry %W -1 $type %P" pack $valFrame.val message $msgFrame.msg -text $message -aspect 3000 @@ -1179,7 +1193,7 @@ proc getString { window message } { proc multipleChoice { window message choices {single 1}} { global gPromptMC - set setWin [toplevel $window.getstring] + set setWin [toplevel $window.choice] set msgFrame [frame $setWin.msgFrame] set valFrame [frame $setWin.valFrame] @@ -1217,6 +1231,7 @@ proc multipleChoice { window message cho } bind $setWin "set gPromptMC(ok) 1" + bind $setWin "set gPromptMC(ok) 1" Centre_Dialog $setWin default update idletasks focus $setWin @@ -1231,6 +1246,7 @@ proc multipleChoice { window message cho } capaGrab release $setWin destroy $setWin + update idletasks if { $gPromptMC(ok) == 1 } { foreach selection $select { lappend result [lindex $choices $selection] } if { [llength $result] == 1 } { set result [lindex $result 0] } @@ -1424,6 +1440,92 @@ proc pickSections { sectionsToPickFrom { } ########################################################### +# pickSets +########################################################### +########################################################### +########################################################### +proc pickSets { setsToPickFrom mode {title "Select Sets"} {window ""}} { + global gPromptPSets + + if { $setsToPickFrom == "" } { + displayMessage "No available sets." + return "Cancel" + } + set dialog [toplevel $window.pickSets -borderwidth 10] + wm title $dialog "Which Sets" + + set infoFrame [frame $dialog.info ] + set setListFrame [frame $dialog.list -relief groove -borderwidth 5] + set buttonFrame [frame $dialog.buttons -bd 10] + pack $infoFrame $setListFrame $buttonFrame -side top -fill x + + message $infoFrame.msg -text $title -aspect 5000 + pack $infoFrame.msg + + set headerFrame [frame $setListFrame.head ] + set listboxFrame [frame $setListFrame.listboxframe] + pack $headerFrame $listboxFrame -side top + pack configure $headerFrame -anchor w + + message $headerFrame.msg -text "Set #" -aspect 5000 + pack $headerFrame.msg + + set setList [ listbox $listboxFrame.list \ + -yscrollcommand "$listboxFrame.scroll set" \ + -width 30 -height 10 -selectmode $mode ] + scrollbar $listboxFrame.scroll \ + -command "$listboxFrame.list yview" \ + -orient v + pack $setList $listboxFrame.scroll -side left + pack configure $listboxFrame.scroll -fill y + + foreach set $setsToPickFrom { + $setList insert end [format "%3d" $set] + } + + button $buttonFrame.yes -text Continue -command {set gPromptPSets(yes) 1} \ + -underline 0 + frame $buttonFrame.spacer -width 10 + button $buttonFrame.selectall -text "SelectAll" -command \ + "$setList selection set 0 end" + button $buttonFrame.cancel -text Cancel -command { set gPromptPSets(yes) 0 } \ + -underline 0 + bind $dialog "set gPromptPSets(yes) 0" + bind $dialog "set gPromptPSets(yes) 1" + + if { $mode == "single" } { + pack $buttonFrame.yes $buttonFrame.cancel -side left + } else { + pack $buttonFrame.yes $buttonFrame.spacer \ + $buttonFrame.selectall $buttonFrame.cancel -side left + } + + bind $dialog break + + Centre_Dialog $dialog default + update + + focus $dialog + capaRaise $dialog + capaGrab $dialog + vwait gPromptPSets(yes) + capaGrab release $dialog + bind $dialog "" + if {$gPromptPSets(yes)} { + set selectionList [ $setList curselection ] + set setsToDo "" + foreach selection $selectionList { + lappend setsToDo [string trim [lindex [$setList get $selection] 0]] + } + destroy $dialog + return $setsToDo + } else { + destroy $dialog + return Cancel + } +} + +########################################################### # getSet ########################################################### ########################################################### @@ -1434,13 +1536,13 @@ proc getSet { pid set followupCommand {s if { $start } { set gGetSet($num.toprocess) $pid set gGetSet($num.command) $followupCommand - foreach name [array names gGetSet {*.[alhu]*}] { unset gGetSet($name) } if { [array names gGetSet exit] == "" } { set gGetSet(exit) 0 } } if { [catch {set gCapaConfig(getSet.answers_command)}] } {parseCapaConfig getSet} - set command "$gCapaConfig(getSet.answers_command) $pid {} {} $set" + set command "$gCapaConfig(getSet.answers_command) $pid {} 1 $set" foreach var [array names gCapaConfig $num.*] { unset gCapaConfig($var) } set fileId [open "|$command" "r"] +# puts "new command $num $fileId" fileevent $fileId readable "getSetLine $num $fileId" update idletasks } @@ -1452,6 +1554,7 @@ proc getSet { pid set followupCommand {s ########################################################### proc getSetQuestion { num fileId } { global gGetSet +# puts -nonewline "$num $fileId " if { $gGetSet(exit) } { fileevent $fileId readable "" catch {close $fileId} @@ -1461,11 +1564,20 @@ proc getSetQuestion { num fileId } { set aline [gets $fileId] if { $aline != "" } { switch [lindex [split $aline :] 0] { - EQES { fileevent $fileId readable "getSetLine $num $fileId" } - default { lappend gGetSet($num.$questNum.quest) $aline } + EQES { +# puts -nonewline " EQES " + fileevent $fileId readable "getSetLine $num $fileId" + } + default { +# puts -nonewline " QES TEXT " + lappend gGetSet($num.$questNum.quest) $aline + } } + } else { +# puts -nonewline " QES BLANK " } if { [eof $fileId] } { getSetEnd $fileId } +# puts "" } ########################################################### @@ -1476,6 +1588,7 @@ proc getSetQuestion { num fileId } { proc getSetLine { num fileId } { global gGetSet +# puts -nonewline "$num $fileId " if { $gGetSet(exit) } { fileevent $fileId readable "" catch {close $fileId} @@ -1485,6 +1598,8 @@ proc getSetLine { num fileId } { if { $aline != "" } { switch [lindex [split $aline :] 0] { ANS { + set list [array name gGetSet "$num.*"] +# puts -nonewline " ANS $aline :$list: " set questNum $gGetSet($num.questNum) set ans [string range $aline 4 end] set length [llength $ans] @@ -1496,22 +1611,34 @@ proc getSetLine { num fileId } { lappend gGetSet($num.$questNum.low) [lindex $ans 1] lappend gGetSet($num.$questNum.high) [lindex $ans 2] } + set list [array name gGetSet "$num.*"] +# puts -nonewline " $ans :$list: " } - DONE { set gGetSet($num.maxprob) $gGetSet($num.questNum) } + DONE { +# puts -nonewline " DONE " + set gGetSet($num.maxprob) $gGetSet($num.questNum) } ERROR { +# puts -nonewline " ERROR " fileevent $fileId readable "" displayError "Answers returned invalid message: $aline" fileevent $fileId readable "getSetLine $num $fileId" } BQES { +# puts -nonewline " BQES " incr gGetSet($num.questNum) fileevent $fileId readable "getSetQuestion $num $fileId" } - SET { set gGetSet($num.questNum) 0 } - default {} + SET { +# puts -nonewline " SET " + set gGetSet($num.questNum) 0 + } + default { # puts "What's this: $aline" } } + } else { +# puts -nonewline "BLANK" } if { [eof $fileId] } { getSetEnd $num $fileId } +# puts "" } ########################################################### @@ -1520,16 +1647,20 @@ proc getSetLine { num fileId } { ########################################################### ########################################################### proc getSetEnd { num fileId } { - global gGetSet c + global gGetSet if { [eof $fileId] } { catch {close $fileId} set command $gGetSet($num.command) +# puts [array name gGetSet "$num.*"] +# parray gGetSet foreach var [array names gGetSet "$num.*"] { set var2 [join [lrange [split $var .] 1 end] .] set array($var2) $gGetSet($var) +# puts "unset $var" unset gGetSet($var) } - eval "$command array" +# parray gGetSet + eval $command [list [array get array]] } } @@ -1550,6 +1681,15 @@ proc lunique __LIST { } } +########################################################### +# lreverse +########################################################### +proc lreverse list { + set result "" + foreach element $list { set result [linsert $result 0 $element] } + return [concat $result] +} + proc splitline { line maxLength } { set length [string length $line] set lines [expr $length/$maxLength + 1] @@ -1685,12 +1825,245 @@ proc winprintText { num } { ########################################################### proc limitEntry { window max type {newvalue ""}} { after idle "$window config -validate key" - if {[string length $newvalue] > $max } { return 0 } + if {($max != -1) && ([string length $newvalue] > $max)} { return 0 } switch $type { any {} number { if {(![regexp ^\[0-9\]+$ $newvalue])&&($newvalue!="")} { return 0 } } - letter {if {(![regexp ^\[A-Za-z\]+$ $newvalue])&& ($newvalue!="")} { return 0 }} + letter { if {(![regexp ^\[A-Za-z\]+$ $newvalue])&& ($newvalue!="")} { return 0 }} + nospace {if {(![regexp "^\[^ \]+$" $newvalue])&& ($newvalue!="")} { return 0 }} } return 1 } +########################################################### +# getCapaID +########################################################### +########################################################### +########################################################### +proc getCapaID { setinfo stunum sectionnum {path .} } { + global gMaxSet + set pwd [pwd] + cd $path + set result "" + switch -regexp -- $setinfo { + ^[0-9]+$ { + set result [getSpecificCapaId $stunum $setinfo] + } + ^[0-9]+\.\.[0-9]+$ { + set range [split $setinfo .] + set low [lindex $range 0] + set high [lindex $range 2] + for { set i $low } { $i <= $high } { incr i } { + append result "[getSpecificCapaId $stunum $i] " + } + } + ^[0-9]+(,[0-9]+)+$ { + set list [split $setinfo ,] + foreach set $list { + append result "[getSpecificCapaId $stunum $set] " + } + } + all { + for { set i 1 } { $i <= $gMaxSet } { incr i } { + if { [file exists [file join records date$i.db]] } { + if { [isSetOpen $stunum $sectionnum $i] } { + append result "[getSpecificCapaId $stunum $i] " + } + } else { + break + } + } + } + default { + set result "UNKNOWN" + } + } + cd $pwd + set result [string trim $result] + return $result +} + +########################################################### +# getScores +########################################################### +########################################################### +########################################################### +proc getScores { setinfo stunum sectionnum {path .} {max 99} {limitVar none}} { + global gMaxSet + if { $limitVar != "none" } { upvar $limitVar limit } + set pwd [pwd] + cd $path + set result "0" + switch -regexp -- $setinfo { + ^[0-9]+$ { + if { $setinfo <= $max } { + set result [format "%4d" [getScore $stunum $setinfo]] + } + } + ^[0-9]+\.\.[0-9]+$ { + set range [split $setinfo .] + set low [lindex $range 0] + set high [lindex $range 2] + if { $high > $max } { set high $max } + for { set i $low } { $i <= $high } { incr i } { + incr result [getScore $stunum $i] + } + set result [format "%4d" $result] + } + ^[0-9]+(,[0-9]+)+$ { + set result "" + set list [split $setinfo ,] + foreach set $list { + if { $set > $max } { continue } + append result [format "%4d " [getScore $stunum $set]] + } + } + all { + for { set i 1 } { $i <= $max } { incr i } { + if { [file exists [file join records date$i.db]] } { + if { [isSetOpen $stunum $sectionnum $i] } { + incr result [getScore $stunum $i] + } + } else { + set result [format "%4d" $result] + break + } + } + set limit [expr {$i-1}] + } + default { + set result "UNKNOWN" + } + } + cd $pwd + set result [string trimright $result] + return $result +} + +########################################################### +# getScore +########################################################### +########################################################### +########################################################### +proc getScore { stunum set } { + set fileId [open [file join records set$set.db] r] + set total_score 0 + set aline [gets $fileId] + set weights [split [gets $fileId] {}] + set aline [gets $fileId] + set aline [gets $fileId] + while {! [eof $fileId]} { + if {[string toupper $stunum] == [string toupper [lindex [split $aline " "] 0]]} { + set scores [lindex [split [lindex [split $aline " "] 1] ","] 0] + set scores [split $scores {}] + for { set i 0 } { $i < [llength $scores] } { incr i } { + switch -- [lindex $scores $i] { + y - Y { incr total_score [lindex $weights $i] } + n - N - e - E - - { } + 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 { + # catching in case weights is not as long as the record + catch {incr total_score [lindex $scores $i]} + } + default { puts "Unknown character [lindex $scores $i]" } + } + } + break + } + set aline [gets $fileId] + } + close $fileId + return $total_score +} + +########################################################### +# getTotals +########################################################### +########################################################### +########################################################### +proc getTotals { setinfo stunum sectionnum {path .} {max 99} {limitVar none}} { + global gMaxSet + if { $limitVar != "none" } { upvar $limitVar limit } + set pwd [pwd] + cd $path + set result "0" + switch -regexp -- $setinfo { + ^[0-9]+$ { + if { $setinfo <= $max } { + set result [format "%4d" [getTotal $stunum $setinfo]] + } + } + ^[0-9]+\.\.[0-9]+$ { + set range [split $setinfo .] + set low [lindex $range 0] + set high [lindex $range 2] + if { $high > $max } { set high $max } + for { set i $low } { $i <= $high } { incr i } { + incr result [getTotal $stunum $i] + } + set result [format "%4d" $result] + } + ^[0-9]+(,[0-9]+)+$ { + set result "" + set list [split $setinfo ,] + foreach set $list { + if { $set > $max } { continue } + append result [format "%4d " [getTotal $stunum $set]] + } + } + all { + for { set i 1 } { $i <= $max } { incr i } { + if { [file exists [file join records date$i.db]] } { + if { [isSetOpen $stunum $sectionnum $i] } { + incr result [getTotal $stunum $i] + } + } else { + set result [format "%4d" $result] + break + } + } + set limit [expr {$i-1}] + } + default { + set result "UNKNOWN" + } + } + cd $pwd + set result [string trimright $result] + return $result +} + +########################################################### +# getTotal +########################################################### +########################################################### +########################################################### +proc getTotal { stunum set } { + set fileId [open [file join records set$set.db] r] + set total_total 0 + set aline [gets $fileId] + set weights [split [gets $fileId] {}] + set aline [gets $fileId] + set aline [gets $fileId] + while {! [eof $fileId]} { + if {[string toupper $stunum] == [string toupper [lindex [split $aline " "] 0]]} { + set scores [lindex [split [lindex [split $aline " "] 1] ","] 0] + set scores [split $scores {}] + for { set i 0 } { $i < [llength $scores] } { incr i } { + switch -- [lindex $scores $i] { + e - E { } + 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - y - Y - n - N - - { + catch { incr total_total [lindex $weights $i] } + } + default { + catch { incr total_total [lindex $weights $i] } + puts "Unknown character [lindex $scores $i]" + } + } + } + break + } + set aline [gets $fileId] + } + close $fileId + return $total_total +} \ No newline at end of file