[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.8 and 1.11

version 1.8, 2000/02/22 18:10:27 version 1.11, 2000/08/07 20:47:29
Line 1 Line 1
   # functions common to all to main CAPA programs
   #  Copyright (C) 1992-2000 Michigan State University
   #
   #  The CAPA system is free software; you can redistribute it and/or
   #  modify it under the terms of the GNU General Public License as
   #  published by the Free Software Foundation; either version 2 of the
   #  License, or (at your option) any later version.
   #
   #  The CAPA system is distributed in the hope that it will be useful,
   #  but WITHOUT ANY WARRANTY; without even the implied warranty of
   #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   #  General Public License for more details.
   #
   #  You should have received a copy of the GNU General Public
   #  License along with the CAPA system; see the file COPYING.  If not,
   #  write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
   #  Boston, MA 02111-1307, USA.
   #
   #  As a special exception, you have permission to link this program
   #  with the TtH/TtM library and distribute executables, as long as you
   #  follow the requirements of the GNU GPL in regard to all of the
   #  software in the executable aside from TtH/TtM.
   
 set gMaxSet 99  set gMaxSet 99
 ###########################################################  ###########################################################
 # capaRaise  # capaRaise
Line 1536  proc getSet { pid set followupCommand {s Line 1559  proc getSet { pid set followupCommand {s
     if { $start } {       if { $start } { 
  set gGetSet($num.toprocess) $pid   set gGetSet($num.toprocess) $pid
  set gGetSet($num.command) $followupCommand   set gGetSet($num.command) $followupCommand
  foreach name [array names gGetSet {*.[alhu]*}] { unset gGetSet($name) }  
  if { [array names gGetSet exit] == "" } { set gGetSet(exit) 0 }   if { [array names gGetSet exit] == "" } { set gGetSet(exit) 0 }
     }      }
     if { [catch {set gCapaConfig(getSet.answers_command)}] } {parseCapaConfig getSet}      if { [catch {set gCapaConfig(getSet.answers_command)}] } {parseCapaConfig getSet}
     set command "$gCapaConfig(getSet.answers_command) $pid {} 1 $set"      set command "$gCapaConfig(getSet.answers_command) $pid {} 1 $set"
     foreach var [array names gCapaConfig $num.*] { unset gCapaConfig($var) }      foreach var [array names gCapaConfig $num.*] { unset gCapaConfig($var) }
     set fileId [open "|$command" "r"]      set fileId [open "|$command" "r"]
   #    puts "new command $num $fileId"
     fileevent $fileId readable "getSetLine $num $fileId"      fileevent $fileId readable "getSetLine $num $fileId"
     update idletasks      update idletasks
 }  }
Line 1554  proc getSet { pid set followupCommand {s Line 1577  proc getSet { pid set followupCommand {s
 ###########################################################  ###########################################################
 proc getSetQuestion { num fileId } {  proc getSetQuestion { num fileId } {
     global gGetSet       global gGetSet 
   #    puts -nonewline "$num $fileId "
     if { $gGetSet(exit) } {       if { $gGetSet(exit) } { 
  fileevent $fileId readable ""   fileevent $fileId readable ""
  catch {close $fileId}   catch {close $fileId}
Line 1563  proc getSetQuestion { num fileId } { Line 1587  proc getSetQuestion { num fileId } {
     set aline [gets $fileId]      set aline [gets $fileId]
     if { $aline != "" } {      if { $aline != "" } {
  switch [lindex [split $aline :] 0] {   switch [lindex [split $aline :] 0] {
     EQES { fileevent $fileId readable "getSetLine $num $fileId" }      EQES { 
     default { lappend gGetSet($num.$questNum.quest) $aline }  # 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 }      if { [eof $fileId] } { getSetEnd $fileId }
   #    puts ""
 }  }
   
 ###########################################################  ###########################################################
Line 1578  proc getSetQuestion { num fileId } { Line 1611  proc getSetQuestion { num fileId } {
 proc getSetLine { num fileId } {  proc getSetLine { num fileId } {
     global gGetSet       global gGetSet 
           
   #    puts -nonewline "$num $fileId "
     if { $gGetSet(exit) } {       if { $gGetSet(exit) } { 
  fileevent $fileId readable ""   fileevent $fileId readable ""
  catch {close $fileId}   catch {close $fileId}
Line 1587  proc getSetLine { num fileId } { Line 1621  proc getSetLine { num fileId } {
     if { $aline != "" } {      if { $aline != "" } {
  switch [lindex [split $aline :] 0] {   switch [lindex [split $aline :] 0] {
     ANS {       ANS { 
    set list [array name gGetSet "$num.*"]
   # puts -nonewline " ANS $aline :$list: "
  set questNum $gGetSet($num.questNum)   set questNum $gGetSet($num.questNum)
  set ans [string range $aline 4 end]   set ans [string range $aline 4 end]
  set length [llength $ans]   set length [llength $ans]
Line 1598  proc getSetLine { num fileId } { Line 1634  proc getSetLine { num fileId } {
     lappend gGetSet($num.$questNum.low) [lindex $ans 1]      lappend gGetSet($num.$questNum.low) [lindex $ans 1]
     lappend gGetSet($num.$questNum.high) [lindex $ans 2]      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 {      ERROR {
   # puts -nonewline " ERROR "
   fileevent $fileId readable ""    fileevent $fileId readable ""
  displayError "Answers returned invalid message: $aline"    displayError "Answers returned invalid message: $aline" 
  fileevent $fileId readable "getSetLine $num $fileId"   fileevent $fileId readable "getSetLine $num $fileId"
     }      }
     BQES {      BQES {
   # puts -nonewline " BQES "
   incr gGetSet($num.questNum)    incr gGetSet($num.questNum)
  fileevent $fileId readable "getSetQuestion $num $fileId"    fileevent $fileId readable "getSetQuestion $num $fileId" 
     }      }
     SET { set gGetSet($num.questNum) 0 }      SET { 
     default {}  # puts -nonewline " SET "
    set gGetSet($num.questNum) 0 
       }
       default { # puts "What's this: $aline" }
  }   }
       } else {
   # puts -nonewline "BLANK"
     }      }
     if { [eof $fileId] } { getSetEnd $num $fileId }      if { [eof $fileId] } { getSetEnd $num $fileId }
   #    puts ""
 }  }
   
 ###########################################################  ###########################################################
Line 1622  proc getSetLine { num fileId } { Line 1670  proc getSetLine { num fileId } {
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc getSetEnd { num fileId } {  proc getSetEnd { num fileId } {
     global gGetSet c      global gGetSet
     if { [eof $fileId] } {      if { [eof $fileId] } {
  catch {close $fileId}    catch {close $fileId} 
  set command $gGetSet($num.command)   set command $gGetSet($num.command)
   # puts [array name gGetSet "$num.*"]
   # parray gGetSet
  foreach var [array names gGetSet "$num.*"] {    foreach var [array names gGetSet "$num.*"] { 
     set var2 [join [lrange [split $var .] 1 end] .]      set var2 [join [lrange [split $var .] 1 end] .]
     set array($var2) $gGetSet($var)       set array($var2) $gGetSet($var) 
   #    puts "unset $var"
     unset gGetSet($var)      unset gGetSet($var)
  }   }
  eval "$command array"  # parray gGetSet
    eval $command [list [array get array]]
     }      }
 }  }
   
Line 2023  proc getTotal { stunum set } { Line 2075  proc getTotal { stunum set } {
  switch -- [lindex $scores $i] {   switch -- [lindex $scores $i] {
     e - E { }      e - E { }
     0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - y - Y - n - N - - {       0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - y - Y - n - N - - { 
  incr total_total [lindex $weights $i]    catch { incr total_total [lindex $weights $i] }
     }      }
     default {       default { 
  incr total_total [lindex $weights $i]    catch { incr total_total [lindex $weights $i] }
  puts "Unknown character [lindex $scores $i]"    puts "Unknown character [lindex $scores $i]" 
     }      }
  }   }
Line 2037  proc getTotal { stunum set } { Line 2089  proc getTotal { stunum set } {
     }      }
     close $fileId      close $fileId
     return $total_total      return $total_total
 }  
   
   }
Removed from v.1.8  
changed lines
  Added in v.1.11

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