[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.9

version 1.8, 2000/02/22 18:10:27 version 1.9, 2000/03/22 21:08:02
Line 1536  proc getSet { pid set followupCommand {s Line 1536  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 1554  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 1564  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 1588  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 1598  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 1611  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 1647  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 2052  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]" 
     }      }
  }   }
Removed from v.1.8  
changed lines
  Added in v.1.9

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