[BACK]Return to common.tcl CVS log [TXT] [DIR] Up to [LON-CAPA] / capa / capa51 / GUITools

Diff for /capa/capa51/GUITools/common.tcl between versions 1.5 and 1.8

version 1.5, 2000/01/05 21:11:15 version 1.8, 2000/02/22 18:10:27
Line 568  proc parseCapaConfig { {num "" } { path Line 568  proc parseCapaConfig { {num "" } { path
  "answers_command *= *" -   "answers_command *= *" -
  "dvips_command *= *" -   "dvips_command *= *" -
                 "xdvi_command *= *" -                  "xdvi_command *= *" -
    "mail_command *= *" -
  "IMP_color *= *" -   "IMP_color *= *" -
  "comment_color *= *" -   "comment_color *= *" -
  "exam_path *= *" -   "exam_path *= *" -
  "quiz_path *= *" -   "quiz_path *= *" -
  "supp_path *= *" -   "supp_path *= *" -
    "correction_path *= *" -
  "default_try_val *= *" -   "default_try_val *= *" -
  "default_prob_val *= *" -   "default_prob_val *= *" -
  "default_hint_val *= *" -   "default_hint_val *= *" -
    "homework_weight *= *" -
    "quiz_weight *= *" -
    "exam_weight *= *" -
    "final_weight *= *" -
    "correction_weight *= *" -
    "final_exam_set_number *= *" -
    "homework_count *= *" -
    "quiz_count *= *" -
  "others_path *= *" {    "others_path *= *" { 
     set gCapaConfig($prefix[lindex $aline 0]) [lindex $aline end]       set gCapaConfig($prefix[lindex $aline 0]) [lindex $aline end] 
  }   }
Line 1221  proc multipleChoice { window message cho Line 1231  proc multipleChoice { window message cho
     }      }
   
     bind $setWin <Return> "set gPromptMC(ok) 1"      bind $setWin <Return> "set gPromptMC(ok) 1"
       bind $setWin <Double-1> "set gPromptMC(ok) 1"
     Centre_Dialog $setWin default      Centre_Dialog $setWin default
     update idletasks      update idletasks
     focus $setWin      focus $setWin
Line 1235  proc multipleChoice { window message cho Line 1246  proc multipleChoice { window message cho
     }      }
     capaGrab release $setWin      capaGrab release $setWin
     destroy $setWin      destroy $setWin
       update idletasks
     if { $gPromptMC(ok) == 1 } {      if { $gPromptMC(ok) == 1 } {
  foreach selection $select { lappend result [lindex $choices $selection] }   foreach selection $select { lappend result [lindex $choices $selection] }
  if { [llength $result] == 1 } { set result [lindex $result 0] }   if { [llength $result] == 1 } { set result [lindex $result 0] }
Line 1432  proc pickSections { sectionsToPickFrom { Line 1444  proc pickSections { sectionsToPickFrom {
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc pickSections { setsToPickFrom mode {title "Select Sets"} {window ""}} {  proc pickSets { setsToPickFrom mode {title "Select Sets"} {window ""}} {
     global gPromptPSets      global gPromptPSets
           
       if { $setsToPickFrom == "" } { 
    displayMessage "No available sets."
    return "Cancel" 
       }
     set dialog [toplevel $window.pickSets -borderwidth 10]      set dialog [toplevel $window.pickSets -borderwidth 10]
     wm title $dialog "Which Sets"      wm title $dialog "Which Sets"
   
Line 1464  proc pickSections { setsToPickFrom mode Line 1480  proc pickSections { setsToPickFrom mode
     pack configure $listboxFrame.scroll -fill y            pack configure $listboxFrame.scroll -fill y      
   
     foreach set $setsToPickFrom {      foreach set $setsToPickFrom {
  $setList insert end [format "%3d" $set   $setList insert end [format "%3d" $set]
     }      }
   
     button $buttonFrame.yes -text Continue -command {set gPromptPSets(yes) 1} \      button $buttonFrame.yes -text Continue -command {set gPromptPSets(yes) 1} \
Line 1475  proc pickSections { setsToPickFrom mode Line 1491  proc pickSections { setsToPickFrom mode
     button $buttonFrame.cancel -text Cancel -command { set gPromptPSets(yes) 0 } \      button $buttonFrame.cancel -text Cancel -command { set gPromptPSets(yes) 0 } \
     -underline 0      -underline 0
     bind $dialog <Destroy> "set gPromptPSets(yes) 0"      bind $dialog <Destroy> "set gPromptPSets(yes) 0"
       bind $dialog <Double-1> "set gPromptPSets(yes) 1"
   
     pack $buttonFrame.yes $buttonFrame.spacer \      if { $mode == "single" } {
  $buttonFrame.selectall $buttonFrame.cancel -side left   pack $buttonFrame.yes $buttonFrame.cancel -side left
       } else {
    pack $buttonFrame.yes $buttonFrame.spacer \
       $buttonFrame.selectall $buttonFrame.cancel -side left
       }
           
     bind $dialog <Alt-Key> break      bind $dialog <Alt-Key> break
           
Line 1494  proc pickSections { setsToPickFrom mode Line 1515  proc pickSections { setsToPickFrom mode
  set selectionList [ $setList curselection ]   set selectionList [ $setList curselection ]
  set setsToDo ""   set setsToDo ""
  foreach selection $selectionList {   foreach selection $selectionList {
     append setsToDo "[lindex [$setList get $selection] 0] "      lappend setsToDo [string trim [lindex [$setList get $selection] 0]]
  }   }
  destroy $dialog   destroy $dialog
  return $setsToDo   return $setsToDo
Line 1631  proc lunique __LIST { Line 1652  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 } {  proc splitline { line maxLength } {
     set length [string length $line]      set length [string length $line]
     set lines [expr $length/$maxLength + 1]      set lines [expr $length/$maxLength + 1]
Line 1776  proc limitEntry { window max type {newva Line 1806  proc limitEntry { window max type {newva
     return 1      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 - - { 
    incr total_total [lindex $weights $i] 
       }
       default { 
    incr total_total [lindex $weights $i] 
    puts "Unknown character [lindex $scores $i]" 
       }
    }
       }
       break
    }
    set aline [gets $fileId]
       }
       close $fileId
       return $total_total
   }
   
Removed from v.1.5  
changed lines
  Added in v.1.8

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