4774 lines
121 KiB
Tcl
4774 lines
121 KiB
Tcl
namespace eval lsc {} {
|
|
}
|
|
|
|
source drivers/trun.tcl
|
|
|
|
proc lsc::errorScript {} {
|
|
if [catch {set op [sct objectPath]}] {
|
|
set op [sct objectPathDef]
|
|
}
|
|
invalidate_after_commerror $op
|
|
return [stdSct::errorScript]
|
|
}
|
|
|
|
#start action
|
|
proc lsc::start {} {
|
|
stdConfig::lsc_chk_end
|
|
sct synccmd "*OPC?"
|
|
sct send "*IDN?"
|
|
return lsc::start_idn
|
|
}
|
|
|
|
#start action, direct
|
|
proc lsc::start_idn {} {
|
|
set idn [sct result]
|
|
if {[string match LSCI,MODEL336* $idn]} {
|
|
set model 336
|
|
} elseif {[string match LSCI,MODEL350* $idn]} {
|
|
set model 350
|
|
} elseif {[string match LSCI,MODEL335* $idn]} {
|
|
set model 335
|
|
} elseif {[string match LSCI,MODEL340* $idn]} {
|
|
set model 340
|
|
} elseif {[string match LSCI,MODEL370* $idn]} {
|
|
set model 370
|
|
} elseif {[string match LSCI,MODEL372* $idn]} {
|
|
set model 372
|
|
} elseif {[string match LSCI,MODEL224* $idn]} {
|
|
set model 224
|
|
} else {
|
|
clientput "[sct sicsdev]: bad answer to startcmd: [sct result]"
|
|
return sync
|
|
}
|
|
if {$model ne [sct model]} {
|
|
clientput "[sct sicsdev]: automatic model detection not yet implemented $model != [sct model]"
|
|
return sync
|
|
}
|
|
# if {$idn eq [sct idn]} {
|
|
# sct send "KEYST?"
|
|
# return lsc::start_keyst
|
|
# }
|
|
sct idn $idn
|
|
sct print "connected to temperature controller $idn"
|
|
return unpoll
|
|
}
|
|
|
|
#start action, direct
|
|
#proc lsc::start_keyst {} {
|
|
# if {[sct result] != 0} {
|
|
# sct print "keyboard touched - need consistency check"
|
|
# }
|
|
# return unpoll
|
|
#}
|
|
|
|
proc lsc::startSend {} {
|
|
if {[string first ? [sct target]] < 0} {
|
|
sct send "[sct target];*OPC?"
|
|
} else {
|
|
sct send "[sct target]"
|
|
}
|
|
clientput "send = [sct send]"
|
|
return complete
|
|
}
|
|
|
|
#read action
|
|
proc lsc::read {cmd {idx 0}} {
|
|
sct send $cmd
|
|
return "lsc::update $idx"
|
|
}
|
|
|
|
#read action, update state
|
|
proc lsc::update {{idx 0}} {
|
|
set r [lindex [split [sct result] ","] $idx]
|
|
sct update $r
|
|
return [silent idle sct updateScript]
|
|
}
|
|
|
|
#read action
|
|
proc lsc::read_linear {channel} {
|
|
sct send LDAT?$channel
|
|
return update
|
|
}
|
|
|
|
#read action, update state
|
|
proc lsc::update_limited {min max} {
|
|
set res [sct result]
|
|
if {$res < $min || $res > $max} {
|
|
return idle
|
|
}
|
|
sct update $res
|
|
return [silent idle sct updateScript]
|
|
}
|
|
|
|
#write action
|
|
proc lsc::write {queryCmd {idx 0}} {
|
|
if {[sct remote] != [sct mode_remote]} {
|
|
sct send "MODE [sct mode_remote];MODE?"
|
|
return lsc::remotecheck
|
|
}
|
|
set pos [string first ? $queryCmd]
|
|
if {$pos < 1} {
|
|
error "lsc: $queryCmd has no question mark"
|
|
}
|
|
set setcmd [string replace [string trim $queryCmd] $pos $pos " "]
|
|
set l $idx
|
|
if {$pos == [string length $setcmd]-1} {
|
|
incr l -1
|
|
}
|
|
sct send "$setcmd[string repeat "," $l][sct target];$queryCmd"
|
|
return "lsc::update $idx"
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::remotecheck {} {
|
|
if {[sct result] != [sct mode_remote]} {
|
|
error "can not set to remote"
|
|
}
|
|
sct remote [sct mode_remote]
|
|
return write
|
|
}
|
|
|
|
#lsc_remoteoff action, slow poll
|
|
proc lsc::remoteoff {} {
|
|
if {[sct remote] != [sct mode_local]} {
|
|
sct send "MODE [sct mode_local];MODE?"
|
|
return lsc::remotefinish
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc lsc::readremote {} {
|
|
sct send "MODE?"
|
|
return lsc::updateremote
|
|
}
|
|
|
|
proc lsc::updateremote {} {
|
|
if {[sct result] == [sct mode_remote]} {
|
|
sct update 1
|
|
} else {
|
|
sct update 0
|
|
}
|
|
return idle
|
|
}
|
|
|
|
#lsc_remoteoff action, direct
|
|
proc lsc::remotefinish {} {
|
|
if {[sct result] != [sct mode_local]} {
|
|
error "can not set to local"
|
|
}
|
|
sct remote 1
|
|
return idle
|
|
}
|
|
|
|
# -- driveable stuff
|
|
|
|
#write action (for drive)
|
|
proc samenv_run {} {
|
|
hsetprop [sct driveValueNode] updateScript samenv_update_drive_value [sct]
|
|
sct progress samenv_progress
|
|
sct insideTime 0
|
|
sct reachTime [clock seconds]
|
|
sct secPerK 0
|
|
sct print "run [sct objectName] to [sct target]"
|
|
sct status run
|
|
sct lastTime 0
|
|
hset [sct driveSetNode] [sct target]
|
|
return idle
|
|
}
|
|
|
|
#progress action
|
|
proc samenv_progress {} {
|
|
if {[string equal idle [sct status]]} {
|
|
hdelprop [sct] progress
|
|
silent 0 hdelprop [sct] timeLeft
|
|
return idle
|
|
}
|
|
set target [sct target]
|
|
set is [sct insideTime]
|
|
set now [clock seconds]
|
|
set value [hvali [sct]]
|
|
set delta 0
|
|
set last [sct lastTime]
|
|
if {$last > 0} {
|
|
set delta [expr $now - $last]
|
|
}
|
|
sct lastTime $now
|
|
if {$delta == 0} {
|
|
return idle
|
|
}
|
|
set dif [expr abs($value - $target)]
|
|
set pro [hvali [sct]/deltaProgress]
|
|
set tmo [hvali [sct]/timeout]
|
|
if {$tmo > 0} {
|
|
if {$pro > 0} {
|
|
set secPerK [expr $tmo / double($pro)]
|
|
set r [expr $now + int($dif * $secPerK)]
|
|
set re [sct reachTime]
|
|
if {$secPerK != [sct secPerK]} {
|
|
# recalculate reachTime as sec/K limit has changed
|
|
sct secPerK $secPerK
|
|
set re $r
|
|
sct reachTime $re
|
|
} elseif {$r < $re} {
|
|
# reduce reachTime not too fast (reduce effect of reading errors)
|
|
set w [expr $delta / double($tmo)]
|
|
if {$w > 1} {
|
|
set w 1
|
|
}
|
|
set re [expr $re - ceil(($re - $r) * $w)]
|
|
sct reachTime $re
|
|
}
|
|
set tlim [expr $re - $dif * $secPerK]
|
|
} else {
|
|
set tlim [sct reachTime]
|
|
sct secPerK 0
|
|
}
|
|
if {$now > $tlim + $tmo + $is} {
|
|
sct print "WARNING: timeout when driving [sct objectName]"
|
|
sct status idle
|
|
return idle
|
|
} else {
|
|
sct timeLeft [expr int($tlim + $tmo + $is - $now)]
|
|
}
|
|
}
|
|
if {$dif < [hvali [sct]/tolerance]} {
|
|
incr is $delta
|
|
set settle [hvali [sct]/settle]
|
|
if {[sct insideTime] == 0 && $is > 0} {
|
|
if {$is < $settle} {
|
|
sct print "[sct objectName] inside tolerance, wait $settle sec to settle"
|
|
}
|
|
}
|
|
sct insideTime $is
|
|
if {$is >= $settle} {
|
|
sct print "[sct objectName] reached [sct target]"
|
|
sct status idle
|
|
return idle
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
#read action, updateScript state
|
|
proc samenv_update_drive_value {node} {
|
|
if {![string equal [sct] [hgetpropval $node driveValueNode]]} {
|
|
silent 0 hdelprop [sct] updateScript
|
|
return
|
|
}
|
|
updateval $node [hvali [sct]]
|
|
if {! [string equal 0 [silent 0 hgetpropval $node progress]]} {
|
|
[sct controllerName] queue $node progress progress
|
|
}
|
|
return idle
|
|
}
|
|
|
|
# -- calibration curve handling (helper functions)
|
|
|
|
proc lsc::read_cache {id} {
|
|
upvar #0 lsc::cache_$id cache
|
|
global logbase
|
|
|
|
set file $logbase/status/$id.cache
|
|
if {[file exists $file]} {
|
|
set fil [open $file r]
|
|
set cache(used) [split [gets $fil] ,]
|
|
for {set i [sct first_curveno]} {$i <= [sct last_curveno]} {incr i} {
|
|
set cache($i) [gets $fil]
|
|
}
|
|
close $fil
|
|
} else {
|
|
set used [list ]
|
|
for {set i [sct last_curveno]} {$i >= [sct first_curveno]} {incr i -1} {
|
|
set cache($i) empty
|
|
lappend used $i
|
|
}
|
|
set cache(used) $used
|
|
}
|
|
}
|
|
|
|
proc lsc::write_cache {id} {
|
|
upvar #0 lsc::cache_$id cache
|
|
global logbase
|
|
|
|
set fil [open $logbase/status/$id.tmp w]
|
|
puts $fil [join $cache(used) ,]
|
|
for {set i [sct first_curveno]} {$i <= [sct last_curveno]} {incr i} {
|
|
puts $fil $cache($i)
|
|
}
|
|
close $fil
|
|
file rename -force $logbase/status/$id.tmp $logbase/status/$id.cache
|
|
}
|
|
|
|
proc lsc::find_curve {id curve numVar} {
|
|
upvar #0 lsc::cache_$id cache
|
|
upvar $numVar nr
|
|
|
|
set nr [silent 0 sct std_$curve]
|
|
if {$nr != 0} {
|
|
return 1
|
|
}
|
|
if {! [info exists cache]} {
|
|
lsc::read_cache $id
|
|
}
|
|
set found 0
|
|
set nr 0
|
|
for {set num [sct first_curveno]} {$num <= [sct last_curveno]} {incr num} {
|
|
set e [split $cache($num) ,]
|
|
if {[string equal -nocase -length 10 [string trim [lindex $e 1]] $curve]} {
|
|
set nr $num
|
|
set found 1
|
|
break
|
|
}
|
|
if {[string equal [string range $cache($num) 0 3] User]} {
|
|
set nr $num
|
|
}
|
|
}
|
|
if {$nr == 0} {
|
|
set nr [lindex $cache(used) 0]
|
|
}
|
|
return $found
|
|
}
|
|
|
|
proc lsc::extend_curve {pointsVar fmt {end 0} {fact 2.0}} {
|
|
upvar $pointsVar points
|
|
|
|
if {$end == 0} {
|
|
set extS [lindex $points 0]
|
|
set extT [lindex $points 1]
|
|
set fixS [lindex $points 2]
|
|
set fixT [lindex $points 3]
|
|
} else {
|
|
set fixS [lindex $points end-3]
|
|
set fixT [lindex $points end-2]
|
|
set extS [lindex $points end-1]
|
|
set extT [lindex $points end]
|
|
}
|
|
if {$extT > $fixT} {
|
|
set newT [expr $extT * $fact]
|
|
if {$newT > 1500} {
|
|
set newT 1500
|
|
}
|
|
} else {
|
|
set newT [expr $extT / double($fact)]
|
|
}
|
|
if {$fmt > 3} {
|
|
set fixS [expr log10($fixS)]
|
|
set extS [expr log10($extS)]
|
|
}
|
|
if {$fmt > 4} {
|
|
set fixT [expr log10($fixT)]
|
|
set extT [expr log10($extT)]
|
|
set newT [expr log10($newT)]
|
|
}
|
|
set newS [expr $fixS + ($extS - $fixS) * ($newT - $fixT) / ($extT - $fixT)]
|
|
if {$fmt > 3} {
|
|
set newS [expr pow(10, $newS)]
|
|
}
|
|
if {$fmt > 4} {
|
|
set newT [expr pow(10, $newT)]
|
|
}
|
|
if {$end == 0} {
|
|
if {[llength $points] <= 390} {
|
|
set points [linsert $points 0 $newS $newT]
|
|
} else {
|
|
lset points 0 $newS
|
|
lset points 1 $newT
|
|
}
|
|
} else {
|
|
if {[llength $points] <= 390} {
|
|
lappend points $newS
|
|
lappend points $newT
|
|
} else {
|
|
lset points end-1 $newS
|
|
lset points end $newT
|
|
}
|
|
}
|
|
}
|
|
|
|
proc lsc::read_curve_340 {} {
|
|
set fd [open [sct Data_File] r]
|
|
set sn [sct Serial_Number]
|
|
sct loadfmt 0
|
|
while {[gets $fd line] >= 0} {
|
|
set s [split $line :]
|
|
if {[llength $s] != 2} {
|
|
break
|
|
}
|
|
set keyword [join [eval "list [lindex $s 0]"] _]
|
|
sct "$keyword" "[join [eval "list [lindex $s 1]"]]"
|
|
}
|
|
if {[string toupper $sn] ne [string toupper [sct Serial_Number]]} {
|
|
error "Serial_Number does not match: $sn (file), [sct Serial_Number] (contents)"
|
|
}
|
|
set points [list ]
|
|
set datafmt [string index [sct Data_Format] 0]
|
|
set sens0 -1.0e38
|
|
while {[gets $fd line] >= 0} {
|
|
set s [eval "list $line"]
|
|
if {[llength $s] == 3} {
|
|
set sens [lindex $s 1]
|
|
set temp [lindex $s 2]
|
|
switch -- $datafmt {
|
|
4 { set sens [expr pow(10.0, $sens)]}
|
|
5 {
|
|
set sens [expr pow(10.0, $sens)]
|
|
set temp [expr pow(10.0, $temp)]
|
|
}
|
|
}
|
|
if {$sens < $sens0} {
|
|
error "[sct Data_File]: table ordered incorrectly (sensor value must be increasing)"
|
|
}
|
|
set sens0 $sens
|
|
lappend points $sens $temp
|
|
} elseif {[llength $s] > 0} {
|
|
if {"[lindex $s 0]" != "No."} {
|
|
close $fd
|
|
error "syntax error in [sct Data_File]: $line"
|
|
}
|
|
}
|
|
}
|
|
close $fd
|
|
if {[string equal [sct intype] 0]} {
|
|
switch -- [string range [sct Sensor_Model] 0 1] {
|
|
DT { sct intype 1; sct intype336 1}
|
|
TG { sct intype 2 }
|
|
PT { sct intype 4; sct intype336 2}
|
|
RF { sct intype 6; sct intype336 2}
|
|
CG { sct intype 7 }
|
|
CX { sct intype 8; sct intype336 3}
|
|
RX { sct intype 9 }
|
|
GR { sct intype 10 }
|
|
default { error "unknown sensor type: [sct Sensor_Model]" }
|
|
}
|
|
}
|
|
if {$datafmt < 3} {
|
|
sct loadfmt $datafmt
|
|
} elseif {[silent 0 sct loadfmt] == 0} {
|
|
if {[sct model] eq "340"} {
|
|
sct loadfmt 5
|
|
} elseif {[sct model] eq "370" || [sct model] eq "372"} {
|
|
sct loadfmt 4
|
|
} elseif {[sct model] != 0} {
|
|
# model 0 is used in softcal
|
|
# 336 and compatible
|
|
switch [sct intype336] {
|
|
1 {sct loadfmt 2}
|
|
2 {sct loadfmt 3}
|
|
3 {sct loadfmt 4}
|
|
4 {sct loadfmt 1}
|
|
default {sct loadfmt 3}
|
|
}
|
|
}
|
|
}
|
|
# extension factor
|
|
set eb [silent -1 sct extendbeg]
|
|
set ee [silent -1 sct extendend]
|
|
if {[sct intype] == 8} {
|
|
# extend cernox by default
|
|
if {$eb < 0} {
|
|
set eb 2.0
|
|
}
|
|
if {$ee < 0} {
|
|
set ee 2.0
|
|
}
|
|
}
|
|
if {$eb > 1.0} {
|
|
lsc::extend_curve points [sct loadfmt] 0 $eb
|
|
}
|
|
if {$ee > 1.0} {
|
|
lsc::extend_curve points [sct loadfmt] 1 $ee
|
|
# it seems, that sometimes the last point is not used
|
|
# we add therefore a dummy point
|
|
lsc::extend_curve points [sct loadfmt] 1 1.01
|
|
}
|
|
hupdate [sct]/points [join $points]
|
|
return
|
|
}
|
|
|
|
proc lsc::sort_points {a b} {
|
|
if {[lindex $a 0] > [lindex $b 0]} {
|
|
return 1
|
|
} else {
|
|
return -1
|
|
}
|
|
}
|
|
|
|
proc lsc::read_curve_inp {} {
|
|
set fd [open [sct Data_File] r]
|
|
set sn [sct Serial_Number]
|
|
sct loadfmt 0
|
|
while {[gets $fd line] >= 0} {
|
|
set line [lindex [split $line !] 0]
|
|
set s [split $line =]
|
|
set keyword [string trim [lindex $s 0]]
|
|
if {[string index $keyword 0] eq "#"} {
|
|
set keyword [string trim [string range $keyword 1 end]]
|
|
}
|
|
if {[string equal curv $keyword]} {
|
|
break
|
|
}
|
|
if {[llength $s] == 2} {
|
|
set value [string trim [lindex $s 1]]
|
|
switch -- $keyword {
|
|
sens {
|
|
set keyword Serial_Number
|
|
}
|
|
unit {
|
|
set keyword Data_Format
|
|
switch -- $value {
|
|
mV { set value "1 (mV)" }
|
|
V { set value "2 (V)" }
|
|
Ohm { set value "3 (Ohm)"}
|
|
}
|
|
}
|
|
type {
|
|
if {[sct model] eq "336" || [sct model] eq "335" || [sct model] eq "224" || [sct model] eq "350"} {
|
|
set keyword intype336
|
|
switch -- [string tolower $value] {
|
|
si { set value 1 }
|
|
pt100 - pt250 - pt500 - pt1000 - pt2500 { set value 2 }
|
|
rhfe { set value 2 }
|
|
cernox - special { set value 3 }
|
|
tc { set value 4 }
|
|
}
|
|
} else {
|
|
set keyword intype
|
|
switch -- [string tolower $value] {
|
|
si { set value 1 }
|
|
gaalas { set value 3 }
|
|
pt100 - pt250 { set value 3 }
|
|
pt500 { set value 4 }
|
|
pt1000 - pt2500 { set value 5 }
|
|
rhfe { set value 0 ; sct intype 0,2,2,10,8 }
|
|
c { set value 7 }
|
|
cernox { set value 8 }
|
|
ruox { set value 9 }
|
|
ge { set value 10 }
|
|
tc { set value 12 }
|
|
}
|
|
}
|
|
sct Sensor_Type $value
|
|
}
|
|
excit - range - rang {
|
|
error "[sct Data_File]: replace 'excit' and 'range' by 'intype'"
|
|
}
|
|
form - intype - loadfmt - calibrange {
|
|
}
|
|
default {
|
|
error "[sct Data_File]: unknown keyword $keyword"
|
|
}
|
|
}
|
|
sct $keyword $value
|
|
}
|
|
}
|
|
if {[string toupper $sn] ne [string toupper [sct Serial_Number]]} {
|
|
error "Serial_Number does not match: $sn (file), [sct Serial_Number] (contents)"
|
|
}
|
|
set points [list ]
|
|
set datafmt [string index [sct Data_Format] 0]
|
|
while {[gets $fd line] >= 0} {
|
|
#set s [eval "list $line"]
|
|
#set s [split $line] # BAD: two spaces give empty entries!
|
|
set s $line
|
|
if {[llength $s] == 2} {
|
|
set sens [lindex $s 0]
|
|
set temp [lindex $s 1]
|
|
lappend points [list $sens $temp]
|
|
} elseif {[llength $s] > 0} {
|
|
error "syntax error in [sct Data_File]: $line"
|
|
}
|
|
}
|
|
close $fd
|
|
if {[lindex $points 0 0] > $sens} {
|
|
set points [lsort -command lsc::sort_points $points]
|
|
}
|
|
if {[lindex $points 0 1] > [lindex $points end 1]} {
|
|
sct SetPoint_Limit [lindex $points 0 1]
|
|
sct Temperature_coefficient "1 (Negative)"
|
|
} else {
|
|
sct SetPoint_Limit [lindex $points end 1]
|
|
sct Temperature_coefficient "2 (Positive)"
|
|
}
|
|
if {[sct model] eq "336" || [sct model] eq "335" || [sct model] eq "224" || [sct model] eq "350"} {
|
|
switch [sct intype] {
|
|
1 {sct intype336 1}
|
|
4 {sct intype336 2}
|
|
8 {sct intype336 3}
|
|
}
|
|
}
|
|
if {$datafmt < 3} {
|
|
sct loadfmt $datafmt
|
|
} elseif {[silent 0 sct loadfmt] == 0} {
|
|
if {[sct model] eq "340"} {
|
|
sct loadfmt 5
|
|
} elseif {[sct model] eq "336" || [sct model] eq "335" || [sct model] eq "224" || [sct model] eq "350"} {
|
|
switch [sct intype336] {
|
|
1 {sct loadfmt 2}
|
|
2 {sct loadfmt 3}
|
|
3 {sct loadfmt 4}
|
|
4 {sct loadfmt 1}
|
|
default {sct loadfmt 3}
|
|
}
|
|
} else {
|
|
sct loadfmt 4
|
|
}
|
|
}
|
|
hupdate [sct]/points [join $points]
|
|
return
|
|
}
|
|
|
|
proc lsc::read_curve {} {
|
|
lsc::check_visible [sct target]
|
|
if {[string match "manual*" [sct target]]} {
|
|
sct Serial_Number manual
|
|
return
|
|
}
|
|
switch [sct target] {
|
|
raw - abs - code - vacuum - undefined {
|
|
sct Serial_Number [sct target]
|
|
return
|
|
}
|
|
}
|
|
sct intype 0
|
|
sct compensation 1
|
|
set fileSplit [split [sct target] .]
|
|
set curve [lindex $fileSplit 0]
|
|
if {[llength $fileSplit] == 1} {
|
|
# no extension, try out to find a matching file
|
|
set file "calcurves/[string tolower $curve].std"
|
|
if {[file exists $file]} {
|
|
clientput "found $file"
|
|
catch {source $file}
|
|
if {[info exists nr([sct model])]} {
|
|
sct std_$curve $nr([sct model])
|
|
sct Serial_Number $curve
|
|
return
|
|
}
|
|
}
|
|
sct Serial_Number $curve
|
|
set file "calcurves/${curve}.inp"
|
|
if {[file exists $file]} {
|
|
clientput "found $file"
|
|
sct Data_File $file
|
|
lsc::read_curve_inp
|
|
return
|
|
}
|
|
set file "calcurves/[string tolower $curve].inp"
|
|
if {[file exists $file]} {
|
|
clientput "found $file"
|
|
sct Data_File $file
|
|
lsc::read_curve_inp
|
|
return
|
|
}
|
|
set file "calcurves/${curve}.340"
|
|
if {[file exists $file]} {
|
|
clientput "found $file"
|
|
sct Data_File $file
|
|
lsc::read_curve_340
|
|
return
|
|
}
|
|
set file "calcurves/[string toupper $curve].340"
|
|
if {[file exists $file]} {
|
|
clientput "found $file"
|
|
sct Data_File $file
|
|
lsc::read_curve_340
|
|
return
|
|
}
|
|
error "no calibration file found for $curve"
|
|
}
|
|
sct Serial_Number $curve
|
|
set file calcurves/[sct target]
|
|
if {! [file exists $file]} {
|
|
error "$file not found"
|
|
}
|
|
set type [lindex $fileSplit 1]
|
|
sct Data_File $file
|
|
lsc::read_curve_$type
|
|
}
|
|
|
|
proc lsc::crc_code {s} {
|
|
global lsc::crc_table
|
|
|
|
if {! [info exists lsc::crc_table]} {
|
|
set lsc::crc_table {}
|
|
|
|
for {set i 0} {$i < 256} {incr i} {
|
|
set r $i
|
|
set r [expr $r << 8]
|
|
for {set k 0} {$k < 8} {incr k} {
|
|
if {[expr {$r & 0x8000}] != 0} {
|
|
set r [expr ($r << 1) ^ 0x1021]
|
|
} else {
|
|
set r [expr $r << 1]
|
|
}
|
|
}
|
|
lappend lsc::crc_table [expr $r & 0xffff]
|
|
}
|
|
}
|
|
|
|
set crc 0
|
|
binary scan $s c* data
|
|
foreach {datum} $data {
|
|
set ndx [expr (($crc >> 8) ^ $datum) & 0xff]
|
|
set lkp [lindex $lsc::crc_table $ndx]
|
|
set crc [expr ($lkp ^ ($crc << 8)) & 0xffff]
|
|
}
|
|
|
|
set c 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_+-*&
|
|
set res [string index $c [expr $crc / 1681]]
|
|
append res [string index $c [expr ($crc / 41) % 41]]
|
|
append res [string index $c [expr $crc % 41]]
|
|
return $res
|
|
}
|
|
|
|
#write action
|
|
proc lsc::chk_control {} {
|
|
switch [sct model] {
|
|
340 {
|
|
sct send "CSET?1;CSET?2"
|
|
return lsc::chk_control_340
|
|
}
|
|
335 - 336 - 350 {
|
|
sct send "OUTMODE?1;OUTMODE?2;OUTMODE?3;OUTMODE?4"
|
|
return lsc::chk_control_336
|
|
}
|
|
}
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::chk_control_336 {} {
|
|
set output 1
|
|
foreach res [split [sct result] ";"] {
|
|
set resl [split $res ,]
|
|
set ch [lindex {None A B C D} [lindex $resl 1]]
|
|
if {[sct @channel] eq $ch] && [lindex $resl 0] % 4 != 0} {
|
|
# output mode was active (not 0 or 4) switch off
|
|
# hset [sct objectPath]/set 0
|
|
sct send "OUTMODE $output,0,$ch,0;*OPC?"
|
|
return write2
|
|
}
|
|
incr output
|
|
}
|
|
return write2
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::chk_control_340 {} {
|
|
set res [split [sct result] ";"]
|
|
set ch1 [split [lindex $res 0] ,]
|
|
set ch2 [split [lindex $res 1] ,]
|
|
if {[string equal [lindex $ch1 0] [sct @channel]] && [lindex $ch1 2]} {
|
|
# control loop1 was on on this channel -> switch off
|
|
## hset [sct objectPath]/set 0
|
|
## hsetprop [sct objectPath]/set geterror off
|
|
sct send "CSET 1,,,0,0;*OPC?"
|
|
return write2
|
|
} elseif {[string equal [lindex $ch2 0] [sct @channel]] && [lindex $ch2 2]} {
|
|
# control loop2 was on on this channel -> switch off
|
|
## hset [sct objectPath]/set 0
|
|
## hsetprop [sct objectPath]/set geterror off
|
|
sct send "CSET 2,,,0,0;*OPC?"
|
|
return write2
|
|
}
|
|
return write2
|
|
}
|
|
|
|
# -- calibration curve handling (action scripts)
|
|
|
|
proc lsc::check_visible {sensor} {
|
|
if {[silent 1 hgetpropval [sct parent] visible] eq "false"} {
|
|
if {$sensor ne "code" && $sensor ne "undefined"} {
|
|
hdelprop [sct parent] visible
|
|
hsetprop [sct parent] group "[sct shortname] sensor settings (channel [sct @channel])"
|
|
}
|
|
} else {
|
|
if {$sensor eq "code" || $sensor eq "undefined"} {
|
|
hsetprop [sct parent] visible false
|
|
hdelprop [sct parent] group
|
|
}
|
|
}
|
|
}
|
|
|
|
#read action, read status, curve node
|
|
proc lsc::detect_sensor {} {
|
|
set sensor [sctval [sct]]
|
|
lsc::check_visible $sensor
|
|
if {[string match "manual*" $sensor]} {
|
|
if {[sct model] eq "370" || [sct model] eq "372"} {
|
|
sct send "INSET?[sct @channel]"
|
|
return lsc::detect_sensor370
|
|
} else {
|
|
sct send "INCRV?[sct @channel]"
|
|
return lsc::detect_sensor2
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
#read action, direct
|
|
proc lsc::detect_sensor370 {} {
|
|
sct result [lindex [split [sct result] ,] 3]
|
|
lsc::detect_sensor2
|
|
}
|
|
|
|
#read action, direct
|
|
proc lsc::detect_sensor2 {} {
|
|
set curveno [sct result]
|
|
if {$curveno == 0} {
|
|
sct update "manual (raw)"
|
|
return idle
|
|
}
|
|
sct send "CRVHDR?$curveno"
|
|
return "lsc::detect_sensor3 $curveno"
|
|
}
|
|
|
|
#read action, direct
|
|
proc lsc::detect_sensor3 {curveno} {
|
|
if {$curveno <= [sct first_curveno]} {
|
|
set name [lindex [split [sct result] ,] 0]
|
|
} else {
|
|
set name [lindex [split [sct result] ,] 1]
|
|
}
|
|
sct update "manual ([string trim $name])"
|
|
return idle
|
|
}
|
|
|
|
# check if two curve header are equal
|
|
proc lsc::hdreq {hdr1 hdr2} {
|
|
set x1 [scan [string toupper [regsub -all " " $hdr1 ""]] {%[^,],%[^,],%d,%f,%d} n1 s1 f1 l1 c1]
|
|
set x2 [scan [string toupper [regsub -all " " $hdr2 ""]] {%[^,],%[^,],%d,%f,%d} n2 s2 f2 l2 c2]
|
|
if {$x1 != 5 || $x2 != 5} {
|
|
return 0
|
|
}
|
|
if {$n1 eq $n2 && $s1 eq $s2 && $f1 == $f2 && $l1 == $l2 && $c1 == $c2} {
|
|
return 1
|
|
}
|
|
return 0
|
|
}
|
|
|
|
#write action, write2 state
|
|
proc lsc::set_curve {} {
|
|
set sno [sct Serial_Number]
|
|
if {[string match "manual*" $sno]} {
|
|
return lsc::detect_sensor
|
|
}
|
|
if {[regexp (raw|abs) $sno]} {
|
|
sct update $sno
|
|
return stdSct::complete
|
|
}
|
|
if {$sno eq "code"} {
|
|
if {[sct model] eq "336" || [sct model] eq "335" || [sct model] eq "224" || [sct model] eq "350"} {
|
|
sct send "INTYPE [sct @channel],3,1,0,1,3;INNAME [sct @channel],code;*OPC?"
|
|
} elseif {[sct model] eq "340"} {
|
|
sct send "INSET [sct @channel],1,1;INTYPE [sct @channel],0,2,1,6,12;MNMX [sct @channel],1,3;*OPC?"
|
|
}
|
|
sct update $sno
|
|
return stdSct::complete
|
|
}
|
|
if {$sno eq "undefined"} {
|
|
sct update $sno
|
|
hsetprop [sct parent] geterror undefined
|
|
return idle
|
|
}
|
|
if {$sno eq "vacuum"} {
|
|
if {[sct model] ne "340"} {
|
|
error "vacuum available on 340 only"
|
|
}
|
|
sct send "INSET [sct @channel],1,0;LINEAR [sct @channel],2,1.6,3,1,-1.4;INTYPE [sct @channel],0,1,2,10,12;MNMX [sct @channel],1,4;*OPC?"
|
|
sct update $sno
|
|
return stdSct::complete
|
|
}
|
|
set id [lindex [split [sct idn] ,] 2]
|
|
set id [lindex [split $id /] 0]
|
|
|
|
if {[lsc::find_curve $id $sno nr]} {
|
|
if {$nr >= [sct first_curveno]} { # not a standard curve
|
|
sct print "[sct parent]: $sno is already loaded as no $nr ..."
|
|
}
|
|
}
|
|
sct curveno $nr
|
|
if {$nr < [sct first_curveno]} { # standard curve
|
|
return lsc::curve_ok;
|
|
}
|
|
sct send "CRVHDR?$nr"
|
|
return "lsc::check_header $id"
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::check_header {{id unknown}} {
|
|
upvar #0 lsc::cache_$id cache
|
|
if {[lsc::hdreq $cache([sct curveno]) [sct result]]} {
|
|
sct oldhdr [sct result]
|
|
return "lsc::install_curve $id"
|
|
}
|
|
sct print "[sct parent]: reload curve cache ..."
|
|
return "lsc::get_headers $id"
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::get_headers {id {num 0}} {
|
|
upvar #0 lsc::cache_$id cache
|
|
|
|
if {$num == 0} {
|
|
set i [sct first_curveno]
|
|
} else {
|
|
set i $num
|
|
foreach e [split [sct result] ";"] {
|
|
set cache($i) $e
|
|
incr i
|
|
}
|
|
}
|
|
set last [sct last_curveno]
|
|
if {$i <= $last} {
|
|
set num $i
|
|
set line ""
|
|
for { } {$i < $num+[sct max_query] && $i <= $last} {incr i} {
|
|
append line "CRVHDR?$i;"
|
|
}
|
|
sct send [string range $line 0 end-1]
|
|
return "lsc::get_headers $id $num"
|
|
}
|
|
set sno [sct Serial_Number]
|
|
if {[lsc::find_curve $id $sno nr]} {
|
|
sct print "[sct parent]: $sno is already loaded as no $nr ..."
|
|
}
|
|
sct oldhdr $cache($nr)
|
|
sct curveno $nr
|
|
return "lsc::install_curve $id"
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::install_curve {id} {
|
|
upvar #0 lsc::cache_$id cache
|
|
|
|
set curveno [sct curveno]
|
|
set idx 0
|
|
foreach nr $cache(used) {
|
|
if {$nr == $curveno} {
|
|
break
|
|
}
|
|
incr idx
|
|
}
|
|
set cache(used) [lreplace $cache(used) $idx $idx]
|
|
lappend cache(used) $curveno
|
|
|
|
set crc [string range $cache($curveno) 12 14]
|
|
set sno [string trim [lindex [split $cache($curveno) ,] 1]]
|
|
set pcrc [lsc::crc_code "[hvali [sct]/points] [sct loadfmt]"]
|
|
if {[string equal -nocase -length 10 $sno [sct Serial_Number]]} {
|
|
if {$crc eq $pcrc} {
|
|
return "lsc::load_header 2"
|
|
}
|
|
sct print "[sct parent]: curve points have changed ... ($crc != $pcrc)"
|
|
}
|
|
sct print "[sct parent]: download [sct Serial_Number] to no $curveno ..."
|
|
lsc::write_cache $id
|
|
return lsc::new_header
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::new_header {{try 0}} {
|
|
if {$try > 0} {
|
|
if {$try > 3} {
|
|
error "can not clear curve"
|
|
}
|
|
if {[string equal [string range [sct result] 0 3] User]} {
|
|
return "lsc::load_header 0"
|
|
}
|
|
}
|
|
incr try
|
|
set curveno [sct curveno]
|
|
sct send "CRVDEL $curveno;CRVHDR?$curveno"
|
|
return "lsc::new_header $try"
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::load_header {finish} {
|
|
set fmt [sct loadfmt]
|
|
set curveno [sct curveno]
|
|
set name [string range "[sct sensorname] " 0 11]
|
|
if {$finish} {
|
|
append name [lsc::crc_code "[hvali [sct]/points] $fmt"]
|
|
}
|
|
set sno [sct Serial_Number]
|
|
set slim [format "%.6g" [lindex [eval list [sct SetPoint_Limit]] 0]]
|
|
set coef [lindex [sct Temperature_coefficient] 0]
|
|
set hdr "$name,$sno,$fmt,$slim,$coef"
|
|
if {[sct model] eq "340" || [sct model] eq "370"} {
|
|
set shdr $hdr
|
|
} else {
|
|
set shdr "\"$name\",$sno,$fmt,$slim,$coef"
|
|
}
|
|
if {$finish > 0 } {
|
|
if {$finish == 2} {
|
|
sct print "[sct parent]: found curve $curveno,$name,$sno"
|
|
} else {
|
|
sct print "[sct parent]: finish curve $curveno,$name,$sno"
|
|
}
|
|
if {[lsc::hdreq $hdr [sct oldhdr]]} {
|
|
return [lsc::header_finish 1]
|
|
} else {
|
|
sct send "CRVHDR $curveno,$shdr;CRVHDR?$curveno"
|
|
return lsc::header_finish
|
|
}
|
|
}
|
|
sct send "CRVHDR $curveno,$shdr;CRVHDR?$curveno"
|
|
sct print "[sct parent]: load curve $curveno,$name,$sno"
|
|
return lsc::load_pnt
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::load_pnt {{num 0}} {
|
|
set curveno [sct curveno]
|
|
set points [eval list [hvali [sct]/points]]
|
|
set idx [expr $num * 2]
|
|
if {$idx >= [llength $points]} {
|
|
return "lsc::load_header 1"
|
|
}
|
|
set line ""
|
|
for {set i 0} {$i < [sct max_query]} {incr i} {
|
|
if {$idx >= [llength $points]} break
|
|
incr num
|
|
set sens [lindex $points $idx]
|
|
incr idx
|
|
set temp [lindex $points $idx]
|
|
incr idx
|
|
switch -- [sct loadfmt] {
|
|
4 { set sens [expr log10($sens)] }
|
|
5 {
|
|
set sens [expr log10($sens)]
|
|
set temp [expr log10($temp)]
|
|
}
|
|
}
|
|
set sens [format "%.6g" $sens]
|
|
set temp [format "%.6g" $temp]
|
|
append line "CRVPT $curveno,$num,$sens,$temp;"
|
|
}
|
|
sct send "${line}*OPC?"
|
|
return "lsc::load_pnt $num"
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::header_finish {{unchanged 0}} {
|
|
set id [lindex [split [sct idn] ,] 2]
|
|
set id [lindex [split $id /] 0]
|
|
upvar #0 lsc::cache_$id cache
|
|
|
|
if {$unchanged} {
|
|
set hdr [sct oldhdr]
|
|
} else {
|
|
set hdr [sct result]
|
|
}
|
|
set cache([sct curveno]) $hdr
|
|
lsc::write_cache $id
|
|
return lsc::curve_ok
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::curve_ok {} {
|
|
set curveno [sct curveno]
|
|
set coef [lindex [silent 1 sct Temperature_coefficient] 0]
|
|
set chan [sct @channel]
|
|
switch [sct model] {
|
|
335 - 336 - 224 {
|
|
if {$curveno <= 4} {
|
|
set intype 1
|
|
} elseif {$curveno <= 7} {
|
|
set intype 2
|
|
} elseif {$curveno <= 20} {
|
|
set intype 4
|
|
} else {
|
|
set intype [silent 3 sct intype336]
|
|
}
|
|
set diocur ""
|
|
if {$intype == 1} {
|
|
# set diode current to 10uA
|
|
set diocur "DIOCUR $chan,0;"
|
|
}
|
|
sct send "INTYPE $chan,$intype,1,0,[sct compensation],1;INCRV $chan,$curveno;INNAME $chan,\"[sct shortname]\";${diocur}*OPC?"
|
|
}
|
|
350 {
|
|
if {$curveno <= 4} {
|
|
set intype 1
|
|
} elseif {$curveno <= 7} {
|
|
set intype 2
|
|
} elseif {$curveno <= 12} {
|
|
set intype 3
|
|
} else {
|
|
set intype [silent 3 sct intype336]
|
|
}
|
|
set diocur ""
|
|
if {$intype == 1} {
|
|
# set diode current to 10uA
|
|
set diocur "DIOCUR $chan,0;"
|
|
}
|
|
sct send "INTYPE $chan,$intype,1,0,[sct compensation],1,0;INCRV $chan,$curveno;INNAME $chan,\"[sct shortname]\";${diocur}*OPC?"
|
|
clientput [sct send]
|
|
}
|
|
340 {
|
|
if {$curveno <= 3} {
|
|
set intype 1
|
|
} elseif {$curveno <= 4} {
|
|
set intype 3
|
|
} elseif {$curveno <= 10} {
|
|
set intype 12
|
|
} elseif {$curveno <= 11} {
|
|
set intype 1
|
|
} else {
|
|
set intype [silent 8 sct intype]
|
|
}
|
|
sct send "INTYPE $chan,$intype;MNMX $chan,1,1;INSET $chan,1,[sct compensation];INCRV $chan,$curveno;*OPC?"
|
|
sct std_intype $intype
|
|
if {[silent 0 sct neg_code]} {
|
|
sct neg_intype "0,2,1,6,12"
|
|
sct neg_cnt 1
|
|
}
|
|
}
|
|
370 - 372 {
|
|
set active [sctval [sct parent]/active]
|
|
set pause [sctval [sct parent]/pause]
|
|
set dwell [sctval [sct parent]/dwell]
|
|
sct send "INSET $chan,$active,$dwell,$pause,$curveno,$coef;*OPC?"
|
|
}
|
|
}
|
|
return lsc::curve_finish
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::curve_finish {} {
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::curve_finish {} {
|
|
sct print "[sct parent]: [sct target] installed at channel [sct @channel]."
|
|
sct update [sct target]
|
|
return idle
|
|
}
|
|
|
|
# -- configure linear input
|
|
|
|
#write action, write2 state
|
|
proc lsc::cfg_linear {} {
|
|
set slope 1
|
|
set offset 0
|
|
set type [sct target]
|
|
switch -- "$type" {
|
|
voltage { }
|
|
amilevel {
|
|
set slope 21.55
|
|
set offset 0
|
|
}
|
|
vacuum {
|
|
set slope 1.6
|
|
set offset -1.4
|
|
}
|
|
default {
|
|
set s [split [sct target] ,]
|
|
set slope [lindex $s 0]
|
|
set offset [lindex $s 1]
|
|
}
|
|
}
|
|
|
|
set c [sct @channel]
|
|
sct send "LINEAR $c,1,$slope,3,1,$offset;INTYPE $c,[sct intype];INSET $c,1;*OPC?"
|
|
return lsc::cfg_linear_ok
|
|
}
|
|
|
|
#write action direct
|
|
proc lsc::cfg_linear_ok {} {
|
|
sct print "[sct parent]: linear reading [sct target] installed at channel [sct @channel]."
|
|
sct update [sct target]
|
|
return idle
|
|
}
|
|
|
|
# -- display scripts
|
|
|
|
#write action
|
|
proc lsc::set_display {} {
|
|
|
|
set fld 0
|
|
set disp ""
|
|
set loopdisp 0
|
|
array set nam2num {A 1 B 2 C 3 D 4 C1 3 D1 4 C2 5 D2 6 C3 7 D3 8 C4 9 D4 10 C5 11 D5 12}
|
|
set stddisp 1
|
|
foreach entry [split [sct target] ,] {
|
|
set e [split $entry :]
|
|
if {[llength $e] > 1} {
|
|
set unit [lindex $e 1]
|
|
set chan [lindex $e 0]
|
|
if {$unit ne "K"} {
|
|
set stddisp 0
|
|
}
|
|
switch -- $unit {
|
|
K { set unit 1 }
|
|
C { set unit 2 }
|
|
S { set unit 3 }
|
|
L { set unit 4 }
|
|
}
|
|
if {[string tolower $chan] eq "loop"} {
|
|
set loopdisp $unit
|
|
} else {
|
|
incr fld
|
|
if {[sct model] eq "370"} {
|
|
if {$unit > 1} {
|
|
incr unit -1
|
|
}
|
|
append disp "DISPLOC $fld,$chan,$unit,6;"
|
|
} else {
|
|
if {[sct model] eq "336" || [sct model] eq "224" || [sct model] eq "350"} {
|
|
set chan $nam2num($chan)
|
|
} elseif {[sct model] eq "372"} {
|
|
if {$unit == 3} {
|
|
set unit 2
|
|
} elseif {$unit eq "Q"} {
|
|
set unit 3
|
|
}
|
|
}
|
|
append disp "DISPFLD $fld,$chan,$unit;"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
switch -- [sct model] {
|
|
340 {
|
|
if {$loopdisp ne "0"} {
|
|
append disp "CDISP 1,$loopdisp;"
|
|
}
|
|
append disp "DISPLAY $fld;DISPLAY?"
|
|
}
|
|
335 - 336 - 224 - 350 {
|
|
if {$fld <= 2} {
|
|
set fmode 0
|
|
set dmode 4
|
|
set fldmax 2
|
|
} elseif {$fld <= 4} {
|
|
set fmode 1
|
|
set dmode 4
|
|
set fldmax 4
|
|
} else {
|
|
set fmode 2
|
|
set dmode 4
|
|
set fldmax 8
|
|
}
|
|
while {$fld < $fldmax} {
|
|
incr fld
|
|
append disp "DISPFLD $fld,0,1;"
|
|
}
|
|
if {$loopdisp ne "0"} {
|
|
set dmode 4
|
|
} else {
|
|
set loopdisp 1
|
|
}
|
|
if {$stddisp} {
|
|
set disp "DISPLAY 5;*OPC?"
|
|
} else {
|
|
append disp "DISPLAY $dmode,$fmode,$loopdisp;*OPC?"
|
|
}
|
|
}
|
|
370 {
|
|
append disp "DISPLAY $fld;*OPC?"
|
|
}
|
|
372 {
|
|
append disp "DISPLAY 2,2,3;*OPC?"
|
|
}
|
|
}
|
|
sct send $disp
|
|
return lsc::finish_display
|
|
}
|
|
|
|
#write action, direct
|
|
proc lsc::finish_display {} {
|
|
sct update [sct target]
|
|
return idle
|
|
}
|
|
|
|
# -- curve config functions: TO BE CHECKED (must be in stdConfig, global lsc?)
|
|
|
|
proc lsc::linear {relpath channel type {intype 0}} {
|
|
|
|
# type might be voltage, amilevel, vacuum or <slope>,<offset>
|
|
|
|
global lsc
|
|
|
|
if {[string equal 0 $intype]} {
|
|
switch -- $channel {
|
|
C - D {
|
|
set intype "0,1,2,1,13"
|
|
}
|
|
default {
|
|
set intype "0,1,2,1,12"
|
|
}
|
|
}
|
|
}
|
|
set node $lsc(path)/$relpath
|
|
hfactory $node plain internal float
|
|
$lsc(controller) poll $node 5
|
|
logsetup $node
|
|
hsetprop $node read "lsc::read_linear $channel"
|
|
hsetprop $node update lsc::update
|
|
|
|
set lnode $lsc(path)/$relpath/linear
|
|
hfactory $lnode plain spy text
|
|
$lsc(controller) write $lnode
|
|
hsetprop $lnode write lsc::chk_control
|
|
hsetprop $lnode write2 lsc::cfg_linear
|
|
hsetprop $lnode intype $intype
|
|
hsetprop $lnode @channel $channel
|
|
hsetprop $lnode visible false
|
|
hset $lnode $type
|
|
lsc_display $channel L
|
|
}
|
|
|
|
proc stdConfig::lsc_display {channel unit} {
|
|
variable lsc
|
|
|
|
if {$unit == 0} {
|
|
#remove the channel from the list
|
|
set d [list]
|
|
foreach entry $lsc(display) {
|
|
set e [split $entry :]
|
|
if {[llength $e] > 1 && ! [string equal $channel [lindex $e 0]]} {
|
|
lappend d $entry
|
|
}
|
|
}
|
|
set lsc(display) $d
|
|
} else {
|
|
lappend lsc(display) "$channel:$unit"
|
|
}
|
|
}
|
|
|
|
|
|
#helper scripts for 370 (simulate several commands on one line)
|
|
proc lsc::split370 {nextscript} {
|
|
set send [split [sct send] ";"]
|
|
# these properties live on the controller
|
|
hsetprop /sics/[sct controllerName] next_script370 ""
|
|
hsetprop /sics/[sct controllerName] send_todo370 ""
|
|
hsetprop /sics/[sct controllerName] result_370 ""
|
|
sct next_script370 $nextscript
|
|
sct send [lindex $send 0]
|
|
sct send_todo370 [join [lrange $send 1 end] ";"]
|
|
sct result_370 ""
|
|
return lsc::next_send370
|
|
}
|
|
|
|
proc lsc::next_send370 {} {
|
|
if {[sct result_370] eq ""} {
|
|
sct result_370 [sct result]
|
|
} else {
|
|
sct result_370 "[sct result_370];[sct result]"
|
|
}
|
|
set send [split [sct send_todo370] ";"]
|
|
if {[llength $send] == 0} {
|
|
sct result [sct result_370]
|
|
return [sct next_script370]
|
|
}
|
|
sct send [lindex $send 0]
|
|
sct send_todo370 [join [lrange $send 1 end] ";"]
|
|
return lsc::next_send370
|
|
}
|
|
|
|
|
|
proc lsc::getT {} {
|
|
if {[sct model] eq "370" || [sct model] eq "372"} {
|
|
sct send "SCAN?"
|
|
return lsc::get370T1
|
|
}
|
|
set cmd ""
|
|
set cntval 0
|
|
foreach chan [sct channels] {
|
|
set sensor [sct channel_$chan]
|
|
if {[hvali $sensor/curve] ne "undefined"} {
|
|
append cmd "MDAT?$chan;"
|
|
incr cntval
|
|
}
|
|
}
|
|
sct cntval $cntval
|
|
set now [clock seconds]
|
|
set uperiod [silent 5 sct updateperiod]
|
|
if {$now/$uperiod > [silent 0 sct lastupdate]/$uperiod} {
|
|
sct lastupdate $now
|
|
sct doupdate 1
|
|
foreach chan [sct channels] {
|
|
set sensor [sct channel_$chan]
|
|
if {[hvali $sensor/curve] ne "undefined"} {
|
|
append cmd "RDGST?$chan;SRDG?$chan;"
|
|
}
|
|
}
|
|
} else {
|
|
sct doupdate 0
|
|
}
|
|
if {"$cmd" eq ""} {
|
|
return idle
|
|
}
|
|
sct send "${cmd}MNMXRST"
|
|
return lsc::updateT
|
|
}
|
|
|
|
proc lsc::minMaxFilteredMean {chan n_name mean_name m2_name} {
|
|
upvar $n_name n
|
|
upvar $mean_name mean
|
|
upvar $m2_name m2
|
|
|
|
set data [silent "" sct datar_$chan]
|
|
set n 0
|
|
if {$data eq ""} return
|
|
|
|
# calculate median of (mx - mn)
|
|
set mlist [list]
|
|
foreach {mn mx} $data {
|
|
lappend mlist [expr $mx - $mn]
|
|
}
|
|
set median [lindex [lsort -real $mlist] [expr [llength $mlist] / 2]]
|
|
set meandif [silent 0 sct meandif_$chan]
|
|
if {$meandif == 0} {
|
|
set meandif $median
|
|
}
|
|
if {$median > $meandif} {
|
|
set dl $median
|
|
} else {
|
|
set dl $meandif
|
|
}
|
|
set dl [expr $dl * 3 + abs([lindex $data end]) * 1e-5]
|
|
set sum 0
|
|
set n 0
|
|
set outlier ""
|
|
set outliercnt 0
|
|
foreach {mn mx} $data {
|
|
if {$mx - $mn <= $dl} {
|
|
set sum [expr $sum + $mn + $mx]
|
|
incr n 2
|
|
append outlier "$mn $mx "
|
|
} else {
|
|
append outlier "($mn $mx [format {%.6g*%.6g %.6g} [expr ($mx - $mn)/$dl] $dl $meandif]) "
|
|
incr outliercnt
|
|
}
|
|
}
|
|
sct meandif_$chan [expr $meandif * 0.9 + 0.1 * $median]
|
|
# if {$outliercnt > 0} {
|
|
# clientput "outlier $chan $outlier"
|
|
# }
|
|
set mean [expr $sum / double($n)]
|
|
set sum 0
|
|
foreach {mn mx} $data {
|
|
if {$mx - $mn <= $dl} {
|
|
set sum [expr $sum + pow($mn - $mean, 2) + pow($mx - $mean, 2)]
|
|
}
|
|
}
|
|
set m2 $sum
|
|
return
|
|
}
|
|
|
|
proc lsc::updateMean {chan stat} {
|
|
# not for model 370
|
|
if {0} {
|
|
# unfiltered, obsolete?
|
|
scan [silent "0,0,0" sct data_$chan] "%d,%g,%g" n mean m2
|
|
if {$n == 0} return
|
|
} else {
|
|
# filtered
|
|
set n 0
|
|
catch {
|
|
lsc::minMaxFilteredMean $chan n mean m2
|
|
}
|
|
sct datar_$chan ""
|
|
if {$n == 0} return
|
|
}
|
|
set sensor [sct channel_$chan]
|
|
if {$stat == 0 || $stat == 2} { # invalid reading is triggered for unknown reasons
|
|
updateval $sensor $mean
|
|
if {$n < 2} {
|
|
set n 2
|
|
}
|
|
updateval $sensor/stddev [expr sqrt($m2 / ($n - 1))]
|
|
} else {
|
|
if {$stat >= 128} {
|
|
set stat "units overrange"
|
|
} elseif {$stat >= 64} {
|
|
set stat "units zero"
|
|
} elseif {$stat >= 32} {
|
|
set stat "t overrange"
|
|
} elseif {$stat >= 16} {
|
|
set stat "t underrange"
|
|
} elseif {$stat >= 2} {
|
|
set stat "old reading"
|
|
} else {
|
|
set stat "invalid reading"
|
|
}
|
|
updateerror $sensor $stat 1
|
|
updateerror $sensor/stddev $stat 1
|
|
}
|
|
# reset sums
|
|
sct data_$chan "0,0,0"
|
|
}
|
|
|
|
proc lsc::addToMean {chan value} {
|
|
scan [silent "0,0,0" sct data_$chan] "%d,%g,%g" n mean m2
|
|
#online calculation of variance and average
|
|
if {$value != 0} {
|
|
incr n
|
|
set delta [expr double($value - $mean)]
|
|
set mean [expr $mean + $delta / $n]
|
|
set m2 [expr $m2 + $delta * ($value - $mean)]
|
|
}
|
|
sct data_$chan "$n,$mean,$m2"
|
|
}
|
|
|
|
proc lsc::updateT {} {
|
|
set res [split [sct result] ";"]
|
|
set i 0
|
|
set j [sct cntval]
|
|
foreach chan [sct channels] {
|
|
set sensor [sct channel_$chan]
|
|
if {[hvali $sensor/curve] eq "undefined"} {
|
|
hsetprop $sensor geterror undefined
|
|
hsetprop $sensor/raw geterror undefined
|
|
} else {
|
|
set pair [split [lindex $res $i] ,]
|
|
set min [lindex $pair 0]
|
|
set max [lindex $pair 1]
|
|
lsc::kink2real min max
|
|
|
|
# unfiltered mean (obsolete?)
|
|
if {$min != 0} {
|
|
lsc::addToMean $chan $min
|
|
}
|
|
lsc::addToMean $chan $max
|
|
|
|
# more robust way:
|
|
sct datar_$chan "[silent "" sct datar_$chan] $min $max"
|
|
if {[sct doupdate]} {
|
|
scan [lindex $res $j] %d stat
|
|
incr j
|
|
lsc::updateMean $chan $stat
|
|
set raw [lindex $res $j]
|
|
incr j
|
|
if {$stat >= 64} {
|
|
# units zero or units overflow
|
|
set raw 0
|
|
}
|
|
updateval $sensor/raw $raw
|
|
set neg_intype [silent 0 hgetpropval $sensor/curve neg_intype]
|
|
if {$neg_intype ne "0"} {
|
|
set neg_cnt [silent 1 hgetpropval $sensor/curve neg_cnt]
|
|
if {$raw < 0} {
|
|
if {$neg_cnt > 0} {
|
|
incr neg_cnt 1
|
|
if {$neg_cnt == 4} {
|
|
set neg_cnt -1
|
|
lappend sendcmd "INTYPE $chan,$neg_intype"
|
|
}
|
|
hsetprop $sensor/curve neg_cnt $neg_cnt
|
|
}
|
|
} else {
|
|
if {$neg_cnt < 0} {
|
|
incr neg_cnt -1
|
|
if {$neg_cnt == -4} {
|
|
set neg_cnt 1
|
|
sct send "INTYPE $chan,[silent 0 hgetpropval $sensor/curve std_intype]"
|
|
}
|
|
hsetprop $sensor/curve neg_cnt $neg_cnt
|
|
}
|
|
}
|
|
}
|
|
}
|
|
incr i
|
|
}
|
|
}
|
|
if {[sct priv] eq "internal"} { # read only T
|
|
# with a loop, this will be done in trun.tcl
|
|
sct update [result [sct getsample]]
|
|
}
|
|
if {[info exists sendcmd]} {
|
|
sct send "[join $sendcmd ";"];*OPC?"
|
|
return stdSct::complete
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc lsc::invalidate_old {{updatechan ""}} {
|
|
set now [clock seconds]
|
|
foreach c [sct channels] {
|
|
if {$c != $updatechan && \
|
|
[silent 0 hgetpropval [sct channel_$c] updatetime] < $now - 600} {
|
|
updateerror [sct channel_$c] old_reading
|
|
updateerror [sct channel_$c]/raw old_reading
|
|
}
|
|
}
|
|
}
|
|
|
|
proc lsc::invalidate_after_commerror {objectPath} {
|
|
set channels [hgetpropval $objectPath channels]
|
|
foreach c $channels {
|
|
set chan [hgetpropval $objectPath channel_$c]
|
|
if {[silent "" hgetpropval $chan geterror] eq ""} {
|
|
updateerror $chan no_connection
|
|
}
|
|
if {[silent "" hgetpropval $chan/raw geterror] eq ""} {
|
|
updateerror $chan/raw no_connection
|
|
}
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc lsc::get370T1 {} {
|
|
stdSct::scanf "%d,%d" chan auto
|
|
set now [DoubleTime]
|
|
set actchan [silent -1 sct actchan]
|
|
sct actchan $chan
|
|
set updatechan 0
|
|
set cpath [silent 0 sct channel_$chan]
|
|
if {$cpath eq "0"} {
|
|
sct print "[sct parent]: illegal channel $chan on [sct]"
|
|
}
|
|
if {$chan ne [silent 0 result [sct sicscommand]]} {
|
|
sct update $chan
|
|
}
|
|
set synchronized [sctval [sct]/autoscan/synchronized]
|
|
set pause [sctval $cpath/pause]
|
|
set oldauto [sctval [sct]/autoscan]
|
|
if {$chan ne $actchan} {
|
|
set apath [silent 0 sct channel_$actchan]
|
|
if {$apath ne "0"} {
|
|
if {$cpath ne "0" && [hvali $cpath/active]} {
|
|
set updatechan $actchan
|
|
}
|
|
}
|
|
if {$cpath ne "0"} {
|
|
sct lastupdate [expr $now + $pause]
|
|
}
|
|
} elseif {$cpath ne "0"} {
|
|
if {[hvali $cpath/active]} {
|
|
set filter [sctval $cpath/filter]
|
|
if {!$synchronized && $now > max([sct lastchange] + $pause + 1, [sct lastupdate] - 0.5) + $filter} {
|
|
# intermediate update
|
|
set updatechan $chan
|
|
}
|
|
}
|
|
}
|
|
if {$auto != $oldauto} {
|
|
updateval [sct]/autoscan $auto
|
|
sct lastchange $now
|
|
}
|
|
if {$updatechan == 0} {
|
|
return idle
|
|
}
|
|
set scmd ""
|
|
|
|
set filtertarget [silent 0 hgetpropval $cpath/filter target]
|
|
if {$filtertarget == 0} {
|
|
set filter [sctval $cpath/filter]
|
|
} else {
|
|
set filter $filtertarget
|
|
}
|
|
set dwell [sctval $cpath/dwell]
|
|
set scanint [expr $pause + $filter + [sctval $cpath/dwell]]
|
|
if {$chan != $actchan} {
|
|
sct lastchange $now
|
|
set synched [hgetpropval $cpath/filter synched]
|
|
if {$synchronized} {
|
|
if {[silent 0 sct lastChangeTarget] < $now - 10} {
|
|
# synchronize to a multiple of 10 if last changed has passed by more than 10 sec
|
|
sct lastChangeTarget [expr (($now + 8) / 10) * 10 + $scanint]
|
|
} else {
|
|
sct lastChangeTarget [expr [sct lastChangeTarget] + $scanint]
|
|
}
|
|
|
|
set f [expr [sct lastChangeTarget] - $now - $pause - $dwell]
|
|
if {$f < 1} {
|
|
set f 1
|
|
}
|
|
if {$synched == 0} {
|
|
hsetprop $cpath/filter target $filter
|
|
hsetprop $cpath/filter synched $filter
|
|
}
|
|
if {$f != [hgetpropval $cpath/filter synched]} {
|
|
hsetprop $cpath/filter synched $f
|
|
set scmd "FILTER $chan,1,$f,80;"
|
|
}
|
|
} elseif {$synched != 0} {
|
|
clientput "$cpath/filter $filter"
|
|
updateval $cpath/filter $filter
|
|
hsetprop $cpath/filter synched 0
|
|
hsetprop $cpath/filter target 0
|
|
set scmd "FILTER $chan,1,$filter,80;"
|
|
}
|
|
} else {
|
|
if {$now > [sct lastchange] + $scanint + 30} {
|
|
# timeout when scanning
|
|
set nextchan 0
|
|
if {$auto} {
|
|
# find next channel
|
|
foreach c [sct channels] {
|
|
if {[hvali [sct channel_$c]/active]} {
|
|
if {$c < $chan} {
|
|
if {$nextchan == 0 || ($nextchan < $chan && $c < $nextchan)} {
|
|
set nextchan $c
|
|
}
|
|
} elseif {$c == $chan} {
|
|
#do nothing
|
|
} elseif {$c < $nextchan || $nextchan < $chan} {
|
|
set nextchan $c
|
|
}
|
|
}
|
|
}
|
|
if {$nextchan != 0} {
|
|
sct print "[sct]: scan timeout, go from channel $chan to $nextchan"
|
|
set scmd "SCAN $nextchan,1;"
|
|
}
|
|
}
|
|
if {$nextchan == 0} {
|
|
# no other channel found
|
|
}
|
|
}
|
|
}
|
|
invalidate_old $updatechan
|
|
[sct controllerName] queue [sct channel_$chan] slow lsc::rdgrng[sct model]
|
|
|
|
# clientput "$now rd $scmd $updatechan"
|
|
sct send "${scmd}RDGST?$updatechan"
|
|
sct lastupdate $now
|
|
return "lsc::update370stat $updatechan"
|
|
}
|
|
|
|
proc lsc::wait4update {path} {
|
|
set properties {lastchange updatetime read_time}
|
|
foreach property $properties {
|
|
if {[silent "" hgetpropval $path $property] ne ""} {
|
|
set p [hgetpropval $path $property]
|
|
while {[hgetpropval $path $property] == $p} {
|
|
wait 0.5
|
|
}
|
|
return
|
|
}
|
|
}
|
|
error "$path has no one of the following properties: $properties"
|
|
}
|
|
|
|
proc lsc::update370stat {chan} {
|
|
variable lastreset
|
|
|
|
scan [sct result] %d stat
|
|
set sensor [sct channel_$chan]
|
|
if {$stat > 0} {
|
|
if {$stat & 1} {
|
|
set statxt "cs ovl"
|
|
} elseif {$stat & 2} {
|
|
set statxt "vcm ovl"
|
|
} elseif {$stat & 4} {
|
|
set statxt "vmix ovl"
|
|
} elseif {$stat & 8} {
|
|
set statxt "vdif ovl"
|
|
} elseif {$stat & 16} {
|
|
set statxt "r.over"
|
|
} elseif {$stat & 32} {
|
|
set statxt "r.under"
|
|
} elseif {$stat & 64} {
|
|
set statxt "t.over"
|
|
} elseif {$stat & 128} {
|
|
set statxt "t.under"
|
|
} else {
|
|
set statxt ""
|
|
}
|
|
if {[string index $statxt 0] == "t"} {
|
|
if {[regexp (raw|abs) [hvali $sensor/curve]]} {
|
|
silent 0 updateval $sensor/status 0
|
|
} else {
|
|
silent 0 updateval $sensor/status "$stat $statxt"
|
|
hsetprop $sensor geterror "$stat $statxt"
|
|
}
|
|
sct send "RDGR?$chan"
|
|
return "lsc::update370R $chan"
|
|
}
|
|
silent 0 updateval $sensor/status "$stat $statxt"
|
|
updateerror $sensor $statxt 1
|
|
updateerror $sensor/raw $statxt 1
|
|
set now [clock seconds]
|
|
if {$now < [silent 0 set lastreset] + 300} {
|
|
return idle
|
|
}
|
|
set lastreset $now
|
|
sct send "*OPC?;MONITOR 7"
|
|
sct print "[sct]: $statxt message on LS370 (chan $chan), send MONITOR 7 command"
|
|
return stdSct::complete
|
|
}
|
|
silent 0 updateval $sensor/status $stat
|
|
if {[regexp (raw|abs) [sctval $sensor/curve]]} {
|
|
sct send "RDGR?$chan"
|
|
return "lsc::update370R $chan"
|
|
}
|
|
sct send "RDGK?$chan"
|
|
return "lsc::update370T $chan"
|
|
}
|
|
|
|
proc lsc::update370T {chan} {
|
|
set sensor [sct channel_$chan]
|
|
updateval $sensor [sct result]
|
|
sct send "RDGR?$chan"
|
|
return "lsc::update370R $chan"
|
|
}
|
|
|
|
proc lsc::update370R {chan} {
|
|
set sensor [sct channel_$chan]
|
|
updateval $sensor/raw [sct result]
|
|
if {[sctval $sensor/curve] eq "raw"} {
|
|
updateval $sensor [sct result]
|
|
} elseif {[sctval $sensor/curve] eq "abs"} {
|
|
updateval $sensor [expr abs([sct result])]
|
|
}
|
|
hsetprop $sensor updatetime [clock seconds]
|
|
if {$chan != "A" && [sct model] eq "372" && [silent "" sct channel_A] ne ""} {
|
|
# channel A has to be read anyway
|
|
sct send "RDGST?A"
|
|
return "lsc::update370stat A"
|
|
}
|
|
return idle
|
|
}
|
|
|
|
#write action, write state
|
|
proc lsc::checkalarm {} {
|
|
set s [lindex [silent 999999 hgetpropval [sct parent]/curve SetPoint_Limit] 0]
|
|
if {[sct target] > $s} {
|
|
sct target $s
|
|
}
|
|
sct update [sct target]
|
|
switch [sct model] {
|
|
335 - 336 - 350 {
|
|
sct target [format "%.0f" [sct target]]
|
|
sct update [sct target]
|
|
sct requested [sct target]
|
|
sct write lsc::write336alarm
|
|
}
|
|
224 {
|
|
sct target [format "%.0f" [sct target]]
|
|
sct update [sct target]
|
|
sct requested [sct target]
|
|
sct write lsc::write224alarm
|
|
}
|
|
370 - 372 {
|
|
sct write lsc::write370alarm
|
|
}
|
|
340 {
|
|
sct write lsc::write340alarm
|
|
}
|
|
default {
|
|
error "unknown model"
|
|
}
|
|
}
|
|
}
|
|
|
|
proc lsc::write370alarm {} {
|
|
if {[sct target] == 0} {
|
|
set on 1
|
|
} else {
|
|
set on 0
|
|
}
|
|
sct send "ALARM [sct @channel],$on,1,[sct target],0,0,0;*OPC?"
|
|
return stdSct::complete
|
|
}
|
|
|
|
proc lsc::write340alarm {} {
|
|
if {[sct target] == 0} {
|
|
set on 0
|
|
} else {
|
|
set on 1
|
|
}
|
|
sct send "ALARM [sct @channel],$on,1,[sct target],-1e5,1,1;RELAY 1,1;*OPC?"
|
|
return stdSct::complete
|
|
}
|
|
|
|
proc lsc::write336alarm {} {
|
|
sct send "TLIMIT [sct @channel],[sct target];ALARM [sct @channel],0,3000,0,0,0,0,0;*OPC?"
|
|
return stdSct::complete
|
|
}
|
|
|
|
proc lsc::write224alarm {} {
|
|
if {[sct target] == 0} {
|
|
set on 0
|
|
} else {
|
|
set on 1
|
|
}
|
|
sct send "ALARM [sct @channel],$on,[sct target],0,1,0,0,1;*OPC?"
|
|
return stdSct::complete
|
|
}
|
|
|
|
proc lsc::check224relay {} {
|
|
switch -- [sct target] {
|
|
0 - 1 - A - B - C - D {
|
|
}
|
|
default {
|
|
error "illegal relay mode"
|
|
}
|
|
}
|
|
}
|
|
|
|
proc lsc::write224relay {} {
|
|
switch -- [sct target] {
|
|
0 - 1 {
|
|
set mode [sct target]
|
|
sct send "RELAY [sct relaynr],[sct target],A,1;*OPC?"
|
|
}
|
|
A - B - C - D {
|
|
set mode 2
|
|
sct send "RELAY [sct relaynr],2,[sct target],1;*OPC?"
|
|
}
|
|
default {
|
|
error "illegal relay mode"
|
|
}
|
|
}
|
|
return stdSct::complete
|
|
}
|
|
|
|
proc lsc::read224relay {} {
|
|
sct send "RELAY?[sct relaynr]"
|
|
return lsc::update224relay
|
|
}
|
|
|
|
proc lsc::update224relay {} {
|
|
stdSct::scanf {%d,%[^,],%d} mode channel type
|
|
if {$mode == 2} {
|
|
sct update $channel
|
|
} else {
|
|
sct update $mode
|
|
}
|
|
return idle
|
|
}
|
|
|
|
#read action, read state
|
|
proc lsc::getalarm {} {
|
|
switch [sct model] {
|
|
335 - 336 - 350 {
|
|
sct send "TLIMIT?[sct @channel]"
|
|
sct readfmt "%g"
|
|
return stdSct::update
|
|
}
|
|
370 - 372 {
|
|
sct send "ALARM?[sct @channel]"
|
|
return lsc::update370alarm
|
|
}
|
|
340 {
|
|
sct send "ALARM?[sct @channel]"
|
|
return lsc::update340alarm
|
|
}
|
|
224 {
|
|
sct send "ALARM?[sct @channel]"
|
|
return lsc::update224alarm
|
|
}
|
|
}
|
|
error "unknown model"
|
|
}
|
|
|
|
proc lsc::update370alarm {} {
|
|
stdSct::scanf {%d ,%d ,%g ,%g ,%g ,%d} on src hig low band latch
|
|
if {$on == 0} {
|
|
sct update 0
|
|
} else {
|
|
sct update $hig
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc lsc::update340alarm {} {
|
|
stdSct::scanf {%d,%d,%g,%g,%d,%d} on src hig low latch relay
|
|
if {$on == 0} {
|
|
sct update 0
|
|
} else {
|
|
sct update $hig
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc lsc::update224alarm {} {
|
|
stdSct::scanf {%d,%g,%g,%g,%d,%d,%d} on hig low dead latch audible display
|
|
if {$on == 0} {
|
|
sct update 0
|
|
} else {
|
|
sct update $hig
|
|
}
|
|
return idle
|
|
}
|
|
|
|
#read action, read state
|
|
proc lsc::getloop {} {
|
|
switch [sct model] {
|
|
335 {
|
|
sct send "OUTMODE?[sct @loop];HTRSET?[sct @loop];RANGE?[sct @loop]"
|
|
return lsc::updateloop_335
|
|
}
|
|
336 - 350 {
|
|
sct send "OUTMODE?[sct @loop];HTRSET?[sct @loop];RANGE?[sct @loop]"
|
|
return lsc::updateloop_336
|
|
}
|
|
372 {
|
|
sct send "OUTMODE?[sct @loop];HTRSET?[sct @loop];RANGE?[sct @loop]"
|
|
return lsc::updateloop_372
|
|
}
|
|
370 {
|
|
sct send "CMODE?;CSET?;HTRRNG?"
|
|
return [lsc::split370 lsc::updateloop_370]
|
|
}
|
|
340 {
|
|
sct send "CMODE?[sct @loop];CSET?[sct @loop];RANGE?;RELAYST?1"
|
|
return lsc::updateloop_340
|
|
}
|
|
}
|
|
}
|
|
|
|
#read action, update state
|
|
proc lsc::updateloop_335 {} {
|
|
stdSct::scanf {%d,%[0-9A-z],%d;%d,%d,%d,%g,%d;%d} mode channel powerup htyp rcode ccode maxcurrent cp range
|
|
set newmode [hvali [sct]/mode]
|
|
switch $mode {
|
|
1 - 2 - 5 {set newmode 1}
|
|
3 {set newmode 2}
|
|
default {
|
|
if {$newmode > 0} {
|
|
set newmode 0
|
|
}
|
|
}
|
|
}
|
|
if {$range == 0} {
|
|
if {$newmode > 0} {
|
|
set newmode 0
|
|
}
|
|
}
|
|
switch $channel {
|
|
1 {set channel A}
|
|
2 {set channel B}
|
|
3 {set channel C}
|
|
4 {set channel D}
|
|
}
|
|
updateval [sct]/mode $newmode
|
|
updateval [sct]/channel $channel
|
|
return idle
|
|
}
|
|
|
|
#read action, update state
|
|
proc lsc::updateloop_336 {} {
|
|
stdSct::scanf {%d,%[0-9A-z],%d;%d,%d,%g,%d;%d} mode channel powerup rcode ccode maxcurrent cp range
|
|
set newmode [hvali [sct]/mode]
|
|
switch $mode {
|
|
1 - 2 - 5 {set newmode 1}
|
|
3 {set newmode 2}
|
|
default {
|
|
if {$newmode > 0} {
|
|
set newmode 0
|
|
}
|
|
}
|
|
}
|
|
if {$range == 0} {
|
|
if {$newmode > 0} {
|
|
set newmode 0
|
|
}
|
|
}
|
|
switch $channel {
|
|
1 {set channel A}
|
|
2 {set channel B}
|
|
3 {set channel C}
|
|
4 {set channel D}
|
|
}
|
|
updateval [sct]/mode $newmode
|
|
updateval [sct]/channel $channel
|
|
return idle
|
|
}
|
|
|
|
#read action, update state
|
|
proc lsc::updateloop_372 {} {
|
|
stdSct::scanf {%d,%[0-9A-z],%d,%d,%d,%d;%g,%d,%g,%d;%d} mode channel powerup pol fil del rcode ccode maxcurrent cp range
|
|
set newmode [hvali [sct]/mode]
|
|
switch $mode {
|
|
3 - 5 - 6 {set newmode 1}
|
|
2 {set newmode 2}
|
|
default {
|
|
if {$newmode > 0} {
|
|
set newmode 0
|
|
}
|
|
}
|
|
}
|
|
if {$range == 0} {
|
|
if {$newmode > 0} {
|
|
set newmode 0
|
|
}
|
|
}
|
|
updateval [sct]/mode $newmode
|
|
updateval [sct]/channel $channel
|
|
return idle
|
|
}
|
|
|
|
#read action, update state
|
|
proc lsc::updateloop_340 {} {
|
|
stdSct::scanf {%d;%[A-Z],%d,%d,%d;%d;%d} mode channel units on powerup range relayst
|
|
set newmode [hvali [sct]/mode]
|
|
#clientput "Newmode [sct @loop] $newmode $mode"
|
|
switch $mode {
|
|
1 - 2 - 4 - 5 - 6 {
|
|
if {$on} {
|
|
set newmode 1
|
|
}
|
|
}
|
|
3 {set newmode 2}
|
|
default {
|
|
if {$newmode > 0} {
|
|
set newmode 0
|
|
}
|
|
}
|
|
}
|
|
if {($range == 0 && [sct @loop] == 1) || $on == 0} {
|
|
if {$newmode > 0} {
|
|
set newmode 0
|
|
}
|
|
}
|
|
#clientput "newmode [sct @loop] $newmode"
|
|
updateval [sct]/mode $newmode
|
|
updateval [sct]/channel $channel
|
|
if {$relayst == 0} {
|
|
return idle
|
|
}
|
|
sct send "ALARMST?A;ALARMST?B;ALARMST?C;ALARMST?D"
|
|
return lsc::updatealarms_340
|
|
}
|
|
|
|
proc lsc::updatealarms_340 {} {
|
|
stdSct::scanf {%d,%d;%d,%d;%d,%d;%d,%d} A n B n C n D n
|
|
set alist ""
|
|
foreach chan {A B C D} {
|
|
if {[set $chan]} {
|
|
append alist $chan
|
|
}
|
|
}
|
|
switch [string length $alist] {
|
|
0 { set err "alarm ? was triggered" }
|
|
1 { set err "alarm $alist triggered"}
|
|
default { set err "alarms $alist triggered"}
|
|
}
|
|
# switch off heater
|
|
hset [sct]/mode 0
|
|
if {[silent 0 hgetpropval [sct]/reg geterror] ne $err} {
|
|
sct print "[sct]: $err"
|
|
}
|
|
updateerror [sct]/reg $err 1
|
|
sct send "ALMRST;RELAY 1,1;*OPC?"
|
|
return stdSct::complete
|
|
}
|
|
|
|
#read action, update state
|
|
proc lsc::updateloop_370 {} {
|
|
stdSct::scanf "%d;%d,%d,%d,%d,%d,%d,%g;%d" mode channel filter units delay ccode hlim resist range
|
|
set oldmode [hvali [sct]/mode]
|
|
set newmode $oldmode
|
|
switch $mode {
|
|
1 - 2 {set newmode 1}
|
|
3 {set newmode 2}
|
|
default {
|
|
if {$newmode > 0} {
|
|
set newmode 0
|
|
}
|
|
}
|
|
}
|
|
if {$range == 0} {
|
|
if {$newmode > 0} {
|
|
set newmode 0
|
|
}
|
|
}
|
|
if {$newmode != $oldmode} {
|
|
clientput "[sct] mode readback $oldmode - > $newmode ([lindex {off controlling manual} $newmode])"
|
|
}
|
|
updateval [sct]/mode $newmode
|
|
updateval [sct]/channel $channel
|
|
set fix_range [silent 0 sct fix_range]
|
|
if {$fix_range > 0 && $newmode == 1 && $range != $fix_range} {
|
|
clientput "CMODE/CSET/HTRRNG result: [sct result]"
|
|
clientput "WARNING: [sct] range ($range) is not $fix_range - fix automatically"
|
|
sct send "CSET $channel,1,1,3,1,$fix_range,[sctval [sct]/resist];HTRRNG $fix_range;HTRRNG?"
|
|
return stdSct::complete
|
|
}
|
|
set power [format %.3g [hvali [sct]/power]]
|
|
if {$mode == 4 && $power != 0} {
|
|
# workaround: sometimes htr is switched to 100% instead of 0% when
|
|
# mode is off, then the following seems to help
|
|
if {[hgetpropval [sct]/power htr] < 0} {
|
|
# an other workaround: negative heater!
|
|
clientput "[sct] heater power negative: $power, please calm down!"
|
|
sct send "CMODE 3;MOUT 0;HTR?"
|
|
return stdSct::complete
|
|
}
|
|
if {[sct] eq "/tbf/set"} {
|
|
clientput "still heater still at $power, please calm down!"
|
|
} else {
|
|
clientput "[sct] heater still at $power, try to switch off"
|
|
}
|
|
sct send "CMODE 4;MOUT 0;HTR?"
|
|
return stdSct::complete
|
|
}
|
|
return idle
|
|
}
|
|
|
|
#helper script
|
|
proc lsc::take {relpath} {
|
|
upvar $relpath v
|
|
set t [silent none hgetpropval [sct]/$relpath target]
|
|
if {$t eq "none"} {
|
|
if {[catch {set v [hvali [sct]/$relpath]}]} {
|
|
if {[catch {set v}]} {
|
|
set v 0
|
|
}
|
|
}
|
|
return 0
|
|
}
|
|
updateval [sct]/$relpath $t
|
|
hdelprop [sct]/$relpath target
|
|
set v $t
|
|
return 1
|
|
}
|
|
|
|
#write action, write state
|
|
proc lsc::setloop {} {
|
|
switch [sct model] {
|
|
335 - 336 - 350 - 372 {
|
|
sct send "SETP?[sct @loop];RANGE?[sct @loop];KRDG?[sctval [sct]/channel];RAMP?[sct @loop]"
|
|
return lsc::setloop_new
|
|
}
|
|
370 {
|
|
sct send "SETP?;HTRRNG?;RDGK?[sctval [sct]/channel];RAMP?"
|
|
return [lsc::split370 lsc::setloop_370]
|
|
}
|
|
340 {
|
|
sct send "SETP?[sct @loop];RANGE?;KRDG?[sctval [sct]/channel];RAMP?[sct @loop]"
|
|
return lsc::setloop_340
|
|
}
|
|
default {
|
|
error "not yet implemented"
|
|
}
|
|
}
|
|
}
|
|
|
|
#write action, write state
|
|
proc lsc::setloop_new {} {
|
|
stdSct::scanf "%g;%d;%g;%d,%g" oldsetp oldrange oldvalue oldrampflag oldramp
|
|
set target [silent none sct target]
|
|
if {$target eq "none"} {
|
|
set target [hvali [sct]]
|
|
if {$target == 0} {
|
|
set target $oldsetp
|
|
}
|
|
} else {
|
|
sct update $target
|
|
hdelprop [sct] target
|
|
}
|
|
set cmd ""
|
|
set dohtrset 0
|
|
if {[lsc::take mode] | [lsc::take channel]} {
|
|
set dohtrset 1
|
|
set modepar $mode
|
|
if {$mode == 2} {
|
|
if {[sct model] ne "372"} {
|
|
set modepar 3
|
|
}
|
|
} elseif {$mode == 1} {
|
|
if {[sct model] eq "372"} {
|
|
set modepar 5
|
|
}
|
|
} elseif {$mode < 0} {
|
|
set mode 0
|
|
set modepar 0
|
|
}
|
|
if {[sct model] eq "372"} {
|
|
append cmd "OUTMODE [sct @loop],$modepar,$channel,0,0,1,5;" ;# what is a good delay setting? 5 sec?
|
|
} else {
|
|
append cmd "OUTMODE [sct @loop],$modepar,$channel,0;"
|
|
}
|
|
}
|
|
if {[lsc::take resist]} {
|
|
set dohtrset 1
|
|
}
|
|
if {[sct model] eq "372"} {
|
|
set minres 1
|
|
set maxres 2000
|
|
} else {
|
|
set minres 10
|
|
set maxres 1000
|
|
}
|
|
if {$resist < $minres} {
|
|
set resist $minres
|
|
updateval [sct]/resist $resist
|
|
} elseif {$resist > $maxres} {
|
|
set resist $maxres
|
|
updateval [sct]/resist $resist
|
|
}
|
|
if {$oldrange == 0 && $mode > 0} {
|
|
set dohtrset 1
|
|
}
|
|
if {[lsc::take maxpower]} {
|
|
set dohtrset 1
|
|
}
|
|
if {[lsc::take maxheater]} {
|
|
set dohtrset 1
|
|
set maxpower 0
|
|
}
|
|
if {$dohtrset} {
|
|
if {[scan $maxheater "%gmW%n" mw cnt] == 2} {
|
|
set maxpowerlim [expr 0.001 * $mw]
|
|
set maxcurrent [expr sqrt($maxpowerlim / double($resist))]
|
|
} elseif {[scan $maxheater "%gW%n" maxpowerlim cnt] == 2} {
|
|
set maxcurrent [expr sqrt($maxpowerlim / double($resist))]
|
|
} elseif {[scan $maxheater "%gA%n" maxcurrent cnt] == 2} {
|
|
set maxpowerlim [expr $maxcurrent * $maxcurrent * $resist]
|
|
} elseif {[scan $maxheater "%gmA%n" ma cnt] == 2} {
|
|
set maxcurrent [expr $ma * 0.001]
|
|
set maxpowerlim [expr $maxcurrent * $maxcurrent * $resist]
|
|
} elseif {[scan $maxheater "%g%s" maxpowerlim unit] == 1} {
|
|
updateval [sct]/maxheater "${maxpowerlim}W"
|
|
set maxcurrent [expr sqrt($maxpowerlim / double($resist))]
|
|
} else {
|
|
error "$maxheater missing maxheater unit (mW, W, mA, A)"
|
|
}
|
|
if {$maxpowerlim == 0} {
|
|
set maxpowerlim 1e-6
|
|
set maxcurrent 1e-6
|
|
}
|
|
updateval [sct]/maxpowerlim $maxpowerlim
|
|
set lp [hvali [sct]/linearpower]
|
|
set maxcurrentlim $maxcurrent
|
|
if {$lp == 0} {
|
|
if {$maxpower == 0} {
|
|
# maxheater was given, but not maxpower
|
|
set maxpower $maxpowerlim
|
|
}
|
|
set maxcurrent [expr $maxcurrent * sqrt($maxpower / $maxpowerlim)]
|
|
} else {
|
|
if {$lp < 0} {
|
|
set lp [expr abs($lp)]
|
|
hupdate [sct]/linearpower $lp
|
|
}
|
|
set lp [expr double($lp)]
|
|
if {$maxpower == 0} {
|
|
set maxpower $lp
|
|
}
|
|
set maxcurrent [expr $maxcurrent * $maxpower / $lp]
|
|
}
|
|
if {[sct model] eq "372"} {
|
|
if {[sct @loop] == 1} {
|
|
if {$resist > 35} {
|
|
set rescode 2
|
|
set lim 0.45
|
|
set vlim 22.4
|
|
} else {
|
|
set rescode 1
|
|
set lim 0.63
|
|
set vlim 15.8
|
|
}
|
|
} else {
|
|
set rescode $resist
|
|
set lim 0.1
|
|
set vlim 10
|
|
}
|
|
} else {
|
|
if {$resist > 35} {
|
|
set rescode 2
|
|
set lim 1
|
|
set vlim 50
|
|
} else {
|
|
set rescode 1
|
|
set lim 1.414213562
|
|
set vlim 35.4
|
|
}
|
|
if {[sct @loop] == 1} {
|
|
set lim 2
|
|
set vlim 50
|
|
}
|
|
}
|
|
if {$lim * $resist > $vlim} {
|
|
set lim [expr $vlim / double($resist)]
|
|
}
|
|
switch -- [sct model] {
|
|
350 {
|
|
set ranges {0.01 0.031623 0.1 0.31623 1.0}
|
|
}
|
|
372 {
|
|
if {[sct @loop] == 0} {
|
|
set ranges {0.00031623 0.001 0.0031623 0.01 0.031623 0.1 0.31623 1.0}
|
|
} else {
|
|
set ranges {1.0}
|
|
}
|
|
}
|
|
default {
|
|
set ranges {0.1 0.31623 1.0}
|
|
}
|
|
}
|
|
set curlim $maxcurrent
|
|
set range 0
|
|
set usercurrent $maxcurrent
|
|
if {$maxcurrent < 0.1 && [sct @loop] != 0} {
|
|
set range [expr [llength $ranges]]
|
|
set fact 1
|
|
while {$usercurrent < 0.1 && $range > 2} {
|
|
set usercurrent [expr $usercurrent * 10]
|
|
incr range -2
|
|
set fact [expr $fact * 0.1]
|
|
}
|
|
set usercurrent [format %.3f $usercurrent]
|
|
} else {
|
|
foreach fact $ranges {
|
|
incr range
|
|
set curlim [format %.3f [expr $maxcurrent / $fact]]
|
|
if {$curlim < $lim * 1.1} {
|
|
break
|
|
}
|
|
}
|
|
if {$curlim > $lim} {
|
|
set curlim $lim
|
|
} elseif {$curlim < 0.1} {
|
|
set curlim 0.1
|
|
}
|
|
set maxcurrent [expr $curlim * $fact]
|
|
}
|
|
updateval [sct]/maxcurrent [format %.3g $maxcurrent]
|
|
if {$lp == 0} {
|
|
updateval [sct]/maxpower [format %.3g [expr $resist * pow($maxcurrent, 2)]]
|
|
} else {
|
|
updateval [sct]/maxpower [format %.3g [expr $lp * $maxcurrent / $maxcurrentlim]]
|
|
}
|
|
if {[sct model] eq "335"} {
|
|
append cmd "HTRSET [sct @loop],0,$rescode,0,$usercurrent,1;"
|
|
} elseif {[sct @loop] == 0} {
|
|
# special case sample heater 372
|
|
append cmd "HTRSET 0,$rescode,0,0,1;"
|
|
} else {
|
|
append cmd "HTRSET [sct @loop],$rescode,0,$usercurrent,1;"
|
|
}
|
|
} else {
|
|
set range $oldrange
|
|
}
|
|
set ramp [silent $oldramp hgetpropval [sct]/ramp requested]
|
|
# clientput "[sct] RAMP: $oldramp -> $ramp ($oldsetp -> $target)"
|
|
set rangecmd "RANGE [sct @loop],$range;"
|
|
if {[sct model] eq "350"} {
|
|
set rampresolution 0.001
|
|
} else {
|
|
set rampresolution 0.1
|
|
}
|
|
if {$oldrange == 0 && $mode == 1 && $ramp > 0 && abs($oldvalue - $oldsetp) >= $rampresolution} {
|
|
# start a new ramp
|
|
sct print "[sct parent]: start new ramp from $oldvalue $mode"
|
|
sct send "${cmd}RAMP [sct @loop],0,$ramp;SETP?[sct @loop]"
|
|
sct old none
|
|
return "lsc::start_ramp $ramp $target $oldvalue {$rangecmd}"
|
|
}
|
|
if {$cmd ne ""} {
|
|
if {$dohtrset} {
|
|
append cmd $rangecmd
|
|
if {$mode <= 0} {
|
|
append cmd "MOUT [sct @loop],[silent 0 sct @manual_out];"
|
|
}
|
|
}
|
|
sct send "${cmd}*OPC?"
|
|
}
|
|
if {$mode > 1} {
|
|
# manual mode
|
|
if {[silent none hgetpropval [sct]/manualpower requested] eq "none"} {
|
|
hsetprop [sct]/manualpower target [hvali [sct]/power]
|
|
hsetprop [sct]/manualpower requested [hvali [sct]/power]
|
|
[sct controllerName] queue [sct]/manualpower write lsc::setmanualpower
|
|
}
|
|
return stdSct::complete
|
|
} elseif {$mode == 1} {
|
|
return "lsc::write_setp $target"
|
|
} else {
|
|
return stdSct::complete
|
|
}
|
|
}
|
|
|
|
proc lsc::roundPower {powname resist} {
|
|
upvar $powname pow
|
|
if {$pow > 0} {
|
|
set p [expr pow(10,floor(log10($pow / double($resist)) + 0.1)) * $resist]
|
|
if {$p != $pow} {
|
|
set pow $p
|
|
return 1
|
|
}
|
|
}
|
|
return 0
|
|
}
|
|
|
|
#write action, write state
|
|
proc lsc::setloop_370 {} {
|
|
stdSct::scanf "%g;%d;%g;%d,%s" oldsetp oldrange oldvalue oldrampflag oldramp
|
|
set target [silent none sct target]
|
|
if {$target eq "none"} {
|
|
set target [hvali [sct]]
|
|
if {$target == 0} {
|
|
set target $oldsetp
|
|
}
|
|
} else {
|
|
sct update $target
|
|
hdelprop [sct] target
|
|
}
|
|
set cmd ""
|
|
set dohtrset 0
|
|
if {[lsc::take mode]} {
|
|
set dohtrset 1
|
|
hsetprop [sct] heater_on [expr $mode > 0]
|
|
if {$mode < 0} {
|
|
set cmode 0
|
|
} else {
|
|
set cmode [lindex {4 1 3} $mode]
|
|
}
|
|
append cmd "CMODE $cmode;"
|
|
}
|
|
if {[lsc::take channel] | [lsc::take resist]} {
|
|
set dohtrset 1
|
|
}
|
|
if {$resist < 1} {
|
|
set resist 1
|
|
updateval [sct]/resist $resist
|
|
} elseif {$resist > 100000} {
|
|
set resist 100000
|
|
updateval [sct]/resist $resist
|
|
}
|
|
if {$oldrange == 0 && $mode > 0} {
|
|
set dohtrset 1
|
|
}
|
|
if {[lsc::take maxpower]} {
|
|
set dohtrset 1
|
|
}
|
|
if {[lsc::take maxheater]} {
|
|
set dohtrset 1
|
|
set maxpower 0
|
|
}
|
|
if {$dohtrset} {
|
|
set dohtrset 1
|
|
if {[scan $maxheater "%gmW%n" mw cnt] == 2} {
|
|
set maxpowerlim [expr 0.001 * $mw]
|
|
set maxcurrent [expr sqrt($maxpowerlim / double($resist))]
|
|
} elseif {[scan $maxheater "%gW%n" maxpowerlim cnt] == 2} {
|
|
set maxcurrent [expr sqrt($maxpowerlim / double($resist))]
|
|
} elseif {[scan $maxheater "%gA%n" maxcurrent cnt] == 2} {
|
|
set maxpowerlim [expr $maxcurrent * $maxcurrent * $resist]
|
|
} elseif {[scan $maxheater "%gmA%n" ma cnt] == 2} {
|
|
set maxcurrent [expr $ma * 0.001]
|
|
set maxpowerlim [expr $maxcurrent * $maxcurrent * $resist]
|
|
} elseif {[scan $maxheater "%g%s" maxpowerlim unit] == 1} {
|
|
updateval [sct]/maxheater "${maxpowerlim}W"
|
|
set maxcurrent [expr sqrt($maxpowerlim / double($resist))]
|
|
} else {
|
|
error "$maxheater missing maxheater unit (mW, W, mA, A)"
|
|
}
|
|
set lp [hvali [sct]/linearpower]
|
|
set maxcurrentlim $maxcurrent
|
|
updateval [sct]/maxpowerlim $maxpowerlim
|
|
if {$lp == 0} {
|
|
# round to next 'lower' possible value
|
|
if {[lsc::roundPower maxpowerlim $resist]} {
|
|
updateval [sct]/maxpowerlim $maxpowerlim
|
|
}
|
|
if {$maxpower == 0} {
|
|
set maxpower $maxpowerlim
|
|
}
|
|
set maxcurrent [expr $maxcurrent * sqrt($maxpower / $maxpowerlim)]
|
|
} else {
|
|
if {$lp < 0} {
|
|
set lp [expr abs($lp)]
|
|
hupdate [sct]/linearpower $lp
|
|
}
|
|
set lp [expr double($lp)]
|
|
if {$maxpower == 0} {
|
|
set maxpower $lp
|
|
}
|
|
set maxcurrent [expr $maxcurrent * $maxpower / $lp]
|
|
}
|
|
|
|
if {$maxcurrent < 3.0e-5} {
|
|
set maxcurrent 3.0e-5
|
|
}
|
|
set range [expr int(log10($maxcurrent) * 2 + 10.4)]
|
|
if {$range > 8} {
|
|
set range 8
|
|
}
|
|
set maxcurrent [expr pow(10,($range-10)*0.5)]
|
|
updateval [sct]/maxcurrent $maxcurrent
|
|
if {$lp == 0} {
|
|
updateval [sct]/maxpower [expr $resist * pow($maxcurrent, 2)]
|
|
} else {
|
|
set fact [format %.1g [expr $maxcurrent / $maxcurrentlim]]
|
|
updateval [sct]/maxpower [expr $fact * $lp]
|
|
}
|
|
append cmd "CSET $channel,1,1,3,1,$range,$resist;"
|
|
} else {
|
|
set range $oldrange
|
|
}
|
|
if {$oldrampflag == 0 && ($oldramp eq "+10.0000")} {
|
|
# old ramp might be temporarely off, format and value +10.0000 means permanently off
|
|
set oldramp 0
|
|
}
|
|
set ramp [silent $oldramp hgetpropval [sct]/ramp requested]
|
|
if {$oldrange == 0 && $mode == 1 && $ramp > 0 && abs($oldvalue - $oldsetp) >= 0.001} {
|
|
# start a new ramp
|
|
sct print "[sct parent]: start new ramp from $oldvalue $mode"
|
|
sct send "${cmd}RAMP 0,$ramp;SETP?"
|
|
sct old none
|
|
return "lsc::start_ramp370 $ramp $target $oldvalue $range"
|
|
}
|
|
if {$mode == 0} {
|
|
append cmd "SETP 0;"
|
|
}
|
|
if {$cmd ne ""} {
|
|
if {$dohtrset} {
|
|
append cmd "HTRRNG $range;"
|
|
sct htrrng $range
|
|
if {$mode <= 0} {
|
|
append cmd "MOUT 0;"
|
|
}
|
|
}
|
|
}
|
|
set oldmode [silent 0 sct oldmode]
|
|
sct oldmode $mode
|
|
set htr [silent -1 hgetpropval [sct]/power htr]
|
|
|
|
if {$mode == 2} {
|
|
# manual mode
|
|
if {[silent none hgetpropval [sct]/manualpower requested] eq "none"} {
|
|
hsetprop [sct]/manualpower target [hvali [sct]/power]
|
|
hsetprop [sct]/manualpower requested [hvali [sct]/power]
|
|
[sct controllerName] queue [sct]/manualpower write lsc::setmanualpower
|
|
}
|
|
sct send "${cmd}MOUT?"
|
|
if {$oldmode != 1} {
|
|
return stdSct::complete
|
|
}
|
|
# clientput "changed to manual"
|
|
# we wait for the LS370 to change MOUT when going to manual.
|
|
# if htr is 0, we would expect an MOUT value of 0, so probably no change - but
|
|
# luckily the value format changes on success!
|
|
return "lsc::wait4change MOUT? 50 {} idle"
|
|
|
|
} elseif {$mode == 1} {
|
|
# controlled mode
|
|
sct send "${cmd}SETP?"
|
|
if {$oldmode != 1} {
|
|
return "lsc::wait4change SETP? 50 {} lsc::write_setp $target"
|
|
}
|
|
# clientput "changed to control"
|
|
return "lsc::write_setp $target"
|
|
|
|
} else {
|
|
sct send "${cmd}HTR?"
|
|
return stdSct::complete
|
|
}
|
|
}
|
|
|
|
proc lsc::wait4change {cmd cnt old args} {
|
|
incr cnt -1
|
|
if {$cnt <= 0} {
|
|
# clientlog "too many tries while waiting for a change of $cmd ($old)"
|
|
return "$args"
|
|
}
|
|
set last_value [sct result]
|
|
if {$old ne ""} {
|
|
if {$old ne $last_value} {
|
|
# clientlog "$cmd answer changed from $old to $last_value"
|
|
return "$args"
|
|
}
|
|
}
|
|
sct send $cmd
|
|
set next [linsert $args 0 lsc::wait4change $cmd $cnt $last_value]
|
|
return $next
|
|
}
|
|
|
|
#proc lsc::waitforchange {cmd {old ""}} {
|
|
# set trycnt [sct trycnt]
|
|
# incr trycnt -1
|
|
# if {$trycnt <= 0} {
|
|
# return idle
|
|
# }
|
|
# set last_value [sct result]
|
|
# clientput "MOUT $last_value"
|
|
# if {$old ne ""} {
|
|
# if {$old ne $last_value} {
|
|
# return idle
|
|
# }
|
|
# }
|
|
# sct send $cmd
|
|
# return lsc::waitforchange $last_value
|
|
#}
|
|
|
|
proc lsc::htr340cur {n {curname 0} {rngname 0}} {
|
|
if {$curname ne "0"} {
|
|
upvar $curname cur
|
|
}
|
|
if {$rngname ne "0"} {
|
|
upvar $rngname rng
|
|
}
|
|
set htr340 {45 35 44 25 34 15 43 24 33 14 42 23 32 13 41 22 31 12 21 11}
|
|
scan [lindex $htr340 $n] %1s%1s cur rng
|
|
return [expr pow(2, $cur-3) * pow(10, $rng * 0.5 - 2.5)]
|
|
}
|
|
|
|
proc lsc::kink2real {args} {
|
|
set kink [silent 0 sct @kink]
|
|
if {$kink != 0} {
|
|
set kinkscale [sct @kinkscale]
|
|
foreach name $args {
|
|
upvar $name value
|
|
if {$value > $kink} {
|
|
set value [expr ($value - $kink) * $kinkscale + $kink]
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
proc lsc::real2kink {value} {
|
|
set kink [silent 0 sct @kink]
|
|
if {$kink != 0} {
|
|
set kinkscale [sct @kinkscale]
|
|
if {$value > $kink} {
|
|
return [expr ($value - $kink) / $kinkscale + $kink]
|
|
}
|
|
}
|
|
return $value
|
|
}
|
|
|
|
#write action, write state
|
|
proc lsc::setloop_340 {} {
|
|
variable heater340list
|
|
|
|
stdSct::scanf "%g;%d;%g;%d,%g" oldsetp oldrange oldvalue oldrampflag oldramp
|
|
lsc::kink2real oldsetp oldvalue
|
|
set target [silent none sct target]
|
|
if {$target eq "none"} {
|
|
set target [hvali [sct]]
|
|
if {$target == 0} {
|
|
set target $oldsetp
|
|
}
|
|
} else {
|
|
sct update $target
|
|
hdelprop [sct] target
|
|
}
|
|
set cmd ""
|
|
set dohtrset 0
|
|
if {[lsc::take mode] | [lsc::take channel]} {
|
|
set dohtrset 1
|
|
if {$mode == 2} { # manual
|
|
append cmd "CMODE [sct @loop],3;"
|
|
} elseif {$mode <= 0} { # off
|
|
append cmd "CSET [sct @loop],$channel,1,0,0;"
|
|
hsetprop [sct]/reg hide_off_error 1
|
|
} else { # controlling
|
|
# what about Celsius / raw ?, not implemented: zone, auto pid
|
|
append cmd "CSET [sct @loop],$channel,1,1,0;CMODE [sct @loop],1;ALMRST;"
|
|
}
|
|
}
|
|
if {[lsc::take resist]} {
|
|
set dohtrset 1
|
|
}
|
|
if {$resist < 10} {
|
|
set resist 10
|
|
updateval [sct]/resist $resist
|
|
} elseif {$resist > 1000} {
|
|
set resist 1000
|
|
updateval [sct]/resist $resist
|
|
}
|
|
if {$oldrange == 0 && $mode > 0} {
|
|
set dohtrset 1
|
|
}
|
|
if {[lsc::take maxpower]} {
|
|
set dohtrset 1
|
|
}
|
|
if {[lsc::take maxheater]} {
|
|
set dohtrset 1
|
|
set maxpower 0
|
|
}
|
|
if {$dohtrset} {
|
|
if {[scan $maxheater "%gmW%n" mw cnt] == 2} {
|
|
set maxpowerlim [expr 0.001 * $mw]
|
|
set maxcurrent [expr sqrt($maxpowerlim / double($resist))]
|
|
} elseif {[scan $maxheater "%gW%n" maxpowerlim cnt] == 2} {
|
|
set maxcurrent [expr sqrt($maxpowerlim / double($resist))]
|
|
} elseif {[scan $maxheater "%gA%n" maxcurrent cnt] == 2} {
|
|
set maxpowerlim [expr $maxcurrent * $maxcurrent * $resist]
|
|
} elseif {[scan $maxheater "%gmA%n" ma cnt] == 2} {
|
|
set maxcurrent [expr $ma * 0.001]
|
|
set maxpowerlim [expr $maxcurrent * $maxcurrent * $resist]
|
|
} elseif {[scan $maxheater "%g%s" maxpowerlim unit] == 1} {
|
|
updateval [sct]/maxheater "${maxpowerlim}W"
|
|
set maxcurrent [expr sqrt($maxpowerlim / double($resist))]
|
|
} else {
|
|
error "$maxheater missing maxheater unit (mW, W, mA, A)"
|
|
}
|
|
set lp [hvali [sct]/linearpower]
|
|
set maxcurrentlim $maxcurrent
|
|
if {$lp == 0} {
|
|
if {$maxpower == 0} {
|
|
set maxpower $maxpowerlim
|
|
}
|
|
set maxcurrent [expr $maxcurrent * sqrt($maxpower / $maxpowerlim)]
|
|
} else {
|
|
if {$maxpower == 0} {
|
|
set maxpower [expr abs($lp)]
|
|
}
|
|
if {$lp > 0} {
|
|
set maxcurrent [expr $maxcurrent * $maxpower / double($lp)]
|
|
} else { # hack: negative liner power for quadratic power
|
|
set maxcurrent [expr $maxcurrent * sqrt(abs($maxpower / double($lp)))]
|
|
}
|
|
}
|
|
if {[sct @loop] == 1} {
|
|
set vlim 55.0
|
|
set clim [expr $vlim / $resist]
|
|
|
|
if {$maxcurrent > 2} {
|
|
set maxcurrent 2
|
|
}
|
|
if {$maxcurrent > $clim} {
|
|
set mcurr $clim
|
|
} else {
|
|
set mcurr $maxcurrent
|
|
}
|
|
# find highest heater range with current < maxcurrent * 1.1
|
|
for {set i 0} {$i < 19} {incr i} {
|
|
if {[htr340cur $i] < $mcurr * 1.1} {
|
|
break
|
|
}
|
|
}
|
|
set current [htr340cur $i ncur range]
|
|
if {$maxcurrent > $clim * 1.05 && $current < $clim && $i > 0} {
|
|
# special case when voltage compliance limit is reached
|
|
incr i -1
|
|
set current [htr340cur $i ncur range]
|
|
}
|
|
set maxcurrent $current
|
|
append cmd "CLIMIT 1,[hvali [sct]/limit],0,0,$ncur,$range;CDISP 1,,$resist;"
|
|
set maxp [expr $resist * pow($maxcurrent, 2)]
|
|
if {$maxp > $vlim * $vlim / double($resist)} {
|
|
set maxpowerlim [expr $resist * pow($maxcurrent, 2)]
|
|
set maxp [expr $vlim * $vlim / double($resist)]
|
|
} elseif {$maxpower == $maxpowerlim} {
|
|
set maxpowerlim [expr $resist * pow($maxcurrent, 2)]
|
|
}
|
|
set maxpower $maxp
|
|
} else {
|
|
set range 1
|
|
set lim 0.1
|
|
set vlim 10
|
|
if {$lp == 0 && $maxcurrent > $lim} {
|
|
set maxcurrent $lim
|
|
}
|
|
append cmd "CLIMIT 2,[hvali [sct]/limit],0,0;"
|
|
}
|
|
if {$lp > 0} {
|
|
set maxpower [expr $lp * $maxcurrent / $maxcurrentlim]
|
|
} elseif {$lp < 0} {
|
|
set maxpower [expr abs($lp) * ($maxcurrent / $maxcurrentlim) ** 2]
|
|
}
|
|
updateval [sct]/maxpower $maxpower
|
|
updateval [sct]/maxcurrent $maxcurrent
|
|
updateval [sct]/maxpowerlim $maxpowerlim
|
|
} else {
|
|
set range $oldrange
|
|
}
|
|
|
|
set ramp [silent $oldramp hgetpropval [sct]/ramp requested]
|
|
if {[sct @loop] == 1} {
|
|
set rangecmd "RANGE $range;"
|
|
} else {
|
|
set rangecmd ""
|
|
}
|
|
# better criterium?: (oldrange == 0 || [hvali [sct]/power] == 0) && ...
|
|
if {$oldrange == 0 && $mode == 1 && $ramp > 0 && abs($oldvalue - $oldsetp) >= 0.1} {
|
|
# start a new ramp
|
|
sct print "[sct parent]: start new ramp from $oldvalue $mode"
|
|
sct send "${cmd}RAMP [sct @loop],0,$ramp;SETP?[sct @loop]"
|
|
sct old none
|
|
return "lsc::start_ramp $ramp $target $oldvalue {$rangecmd}"
|
|
}
|
|
if {$cmd ne ""} {
|
|
if {$dohtrset} {
|
|
append cmd $rangecmd
|
|
if {$mode <= 0} {
|
|
append cmd "MOUT [sct @loop],[silent 0 sct @manual_out];"
|
|
}
|
|
}
|
|
sct send "${cmd}*OPC?"
|
|
}
|
|
if {$mode > 1} {
|
|
# manual mode
|
|
if {[silent none hgetpropval [sct]/manualpower requested] eq "none"} {
|
|
hsetprop [sct]/manualpower target [hvali [sct]/power]
|
|
hsetprop [sct]/manualpower requested [hvali [sct]/power]
|
|
[sct controllerName] queue [sct]/manualpower write lsc::setmanualpower
|
|
}
|
|
return stdSct::complete
|
|
} elseif {$mode == 1} {
|
|
return "lsc::write_setp $target"
|
|
} else {
|
|
return stdSct::complete
|
|
}
|
|
}
|
|
|
|
proc lsc::write_setp {target} {
|
|
sct send "SETP [sct @looporblank][lsc::real2kink $target];*OPC?"
|
|
return stdSct::complete
|
|
}
|
|
|
|
proc lsc::start_ramp {ramp target oldvalue rangecmd {try 30}} {
|
|
set result [sct result]
|
|
lsc::kink2real result
|
|
if {[sct old] eq "none" && abs($result - $oldvalue) >= 0.1} {
|
|
sct old $result
|
|
} elseif {[sct old] != $result} {
|
|
# setpoint response has changed
|
|
sct send "${rangecmd}RAMP [sct @loop],1,$ramp;*OPC?"
|
|
return "lsc::write_setp $target"
|
|
}
|
|
# try again
|
|
if {$try <= 0} {
|
|
error "can not set ramp target to $oldvalue"
|
|
}
|
|
sct send "SETP [sct @loop],[real2kink $oldvalue];SETP?[sct @loop]"
|
|
incr try -1
|
|
return "lsc::start_ramp $ramp $target $oldvalue {$rangecmd} $try"
|
|
}
|
|
|
|
proc lsc::start_ramp370 {ramp target oldvalue range} {
|
|
set result [sct result]
|
|
if {[sct old] eq "none" && abs($result - $oldvalue) >= 0.001} {
|
|
sct old $result
|
|
} elseif {[sct old] != $result} {
|
|
# setpoint response has changed
|
|
sct send "HTRRNG $range;RAMP 1,$ramp;*OPC?"
|
|
return "lsc::write_setp $target"
|
|
}
|
|
# try again
|
|
sct send "SETP $oldvalue;SETP?"
|
|
return "lsc::start_ramp370 $ramp $target $oldvalue $range"
|
|
}
|
|
|
|
proc lsc::check_set {} {
|
|
set limit [hvali [sct]/limit]
|
|
set target [sct target]
|
|
if {$target > $limit} {
|
|
error "[sct sicscommand] beyond limit ($limit)[silent "" sct tlimit_message]"
|
|
}
|
|
if {[silent 0 sct internalset] eq "0"} {
|
|
if {[silent 0 sct setmaintarget] ne "0"} {
|
|
if {[catch {eval "[sct setmaintarget] $target"} msg]} {
|
|
clientlog "WARNING: $msg"
|
|
}
|
|
}
|
|
}
|
|
if {$target == 0} {
|
|
hsetprop [sct]/mode target 0
|
|
updateval [sct]/mode 0
|
|
hsetprop [sct]/reg hide_off_error 1
|
|
logsetup [sct] clear
|
|
} elseif {[hvali [sct]/mode] < 0} {
|
|
error "ERROR: heater disabled"
|
|
} elseif {[hvali [sct]/mode] != 1} {
|
|
hsetprop [sct]/mode target 1
|
|
updateval [sct]/mode 1
|
|
}
|
|
}
|
|
|
|
proc lsc::check_mode {} {
|
|
if {[sct target] < 0} {
|
|
updateerror [sct parent]/reg heater_disabled 1
|
|
} elseif {[sct target] == 0} {
|
|
updateerror [sct parent]/reg heater_off 1
|
|
} else {
|
|
hdelprop [sct parent]/reg geterror
|
|
}
|
|
lsc::write_up
|
|
}
|
|
|
|
proc lsc::check_resist {} {
|
|
set resist [sct target]
|
|
if {$resist < 10} {
|
|
set resist 10
|
|
sct target $resist
|
|
} elseif {$resist > 10000} {
|
|
set resist 10000
|
|
sct target $resist
|
|
}
|
|
lsc::write_up
|
|
}
|
|
|
|
proc lsc::write_up {{action write}} {
|
|
[sct controllerName] queue [sct parent] write $action
|
|
return
|
|
}
|
|
|
|
proc lsc::read_reg {} {
|
|
if {[sct model] eq "370"} {
|
|
set c [hvali [sct parent]/channel]
|
|
sct send "HTRRNG?"
|
|
return lsc::update1_reg370
|
|
# or using lsc::split370
|
|
# sct send "SETP?;HTRRNG?;RAMPST?;LDAT?$c"
|
|
# return [lsc::split370 lsc::update_reg370]
|
|
} elseif {[sct model] eq "340"} {
|
|
sct send "SETP?[sct @loop];RAMPST?[sct @loop];RANGE?;HTRST?"
|
|
return lsc::update_reg
|
|
} else {
|
|
sct send "SETP?[sct @loop];RAMPST?[sct @loop];RANGE?[sct @loop];HTRST?[sct @loop]"
|
|
return lsc::update_reg
|
|
}
|
|
}
|
|
|
|
proc lsc::update1_reg370 {} {
|
|
if {[sct result] == 0} {
|
|
# heater went off, check reason
|
|
sct send "HTRST?"
|
|
return lsc::update0_reg370
|
|
} else {
|
|
hsetprop [sct parent] heater_on 1
|
|
}
|
|
sct send "RAMPST?"
|
|
return lsc::update2_reg370
|
|
}
|
|
|
|
proc lsc::update0_reg370 {} {
|
|
if {[silent "" sct geterror] eq ""} {
|
|
# do not overwrite existing error
|
|
if {[sct result] == 1} {
|
|
updateerror [sct] open_heater_load
|
|
clientput "ERROR: open heater load [sct]"
|
|
} else {
|
|
updateerror [sct] off
|
|
if {[silent 0 hgetpropval [sct parent] heater_on]} {
|
|
clientput "ERROR: heater switched off [sct] [silent noerr hgetpropval [sct] geterror]"
|
|
}
|
|
}
|
|
}
|
|
hupdate [sct] 0
|
|
# updateval_u [sct] 0 0
|
|
updateval_u [sct parent] 0 0
|
|
return idle
|
|
}
|
|
|
|
proc lsc::update2_reg370 {} {
|
|
sct send "SETP?"
|
|
return "lsc::update3_reg370 [sct result]"
|
|
}
|
|
|
|
proc lsc::update3_reg370 {rampst} {
|
|
# update setpoint
|
|
updateval_u [sct parent] [sct result] 0
|
|
if {$rampst == 0} {
|
|
# we are not ramping
|
|
updateval_u [sct] [sct result] 0
|
|
return idle
|
|
}
|
|
set chan [hvali [sct parent]/channel]
|
|
# the linear function is for reading back the running setpoint
|
|
# linear with a factor of 0 seems not to be possible, the minimum is 0.001
|
|
sct send "LINEAR $chan,1,0.001,1,2,0;LDAT?$chan"
|
|
return lsc::update4_reg370
|
|
}
|
|
|
|
proc lsc::update4_reg370 {} {
|
|
# linear reading: 0.001 * tem + sp
|
|
# assume actual value is not far from running setpoint
|
|
sct update [expr [sct result] / 1.001]
|
|
return idle
|
|
}
|
|
|
|
proc lsc::update_reg370 {} {
|
|
error "invalid"
|
|
}
|
|
|
|
proc lsc::update_reg {} {
|
|
stdSct::scanf "%g;%d;%d;%d" setpoint rampst range htrst
|
|
lsc::kink2real setpoint
|
|
if {$rampst == 0} {
|
|
# if {[sctval [sct parent]/mode] == 0} {
|
|
# set setpoint 0
|
|
# }
|
|
# updateval_u [sct parent] $setpoint 0
|
|
}
|
|
if {[sct model] eq "340" && [sct @loop] == 2} {
|
|
# on a heater error, range is switched to 0, but what about loop 2?
|
|
set range 1
|
|
}
|
|
if {$range == 0 || $htrst != 0} {
|
|
if {[string match "*Not read yet*" [silent "" sct geterror]]} {
|
|
sct geterror "heater_off"
|
|
}
|
|
if {![string match "alarm*" [silent "" sct geterror]] && \
|
|
![string match "heater_*" [silent "" sct geterror]]} {
|
|
if {[sct @loop] == 2 && [sct model] eq "350" && $htrst == 2} {
|
|
# voltage compliance -> not really an error
|
|
} elseif {$htrst == 5 || ($htrst == 1 && [sct model] ne "340")} {
|
|
updateerror [sct] heater_circuit_open 1
|
|
clientput "ERROR: heater circuit open [sct]"
|
|
} elseif {$htrst == 6 || ($htrst == 2 && [sct model] ne "340")} {
|
|
updateerror [sct] heater_short_circuited 1
|
|
clientput "ERROR: heater short-circuited [sct]"
|
|
} elseif {$htrst != 0} {
|
|
updateerror [sct] heater_error_$htrst 1
|
|
clientput "ERROR: heater error $htrst [sct]"
|
|
} else {
|
|
updateerror [sct] heater_off 1
|
|
}
|
|
}
|
|
} else {
|
|
updateval_u [sct] $setpoint 0
|
|
sct hide_off_error 0
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc lsc::update_working_ramp {looppath} {
|
|
set old [sctval $looppath/wramp]
|
|
set ch [sctval $looppath/channel]
|
|
set reg [sctval $looppath/reg]
|
|
set t [silent $reg hval [hgetpropval [sct objectPath] channel_$ch]]
|
|
set s [sctval $looppath]
|
|
set smt [silent 0 hval $looppath/smooth]
|
|
set maxramp [sctval $looppath/ramp]
|
|
set htr [silent 50 hgetpropval $looppath/power htr]
|
|
set ramp_reg [silent 0 sct ramp_reg]
|
|
if {$smt == 0 || $s == 0} {
|
|
set new $maxramp
|
|
} else {
|
|
# ramp for parabolic approach (1% within smt) from reg
|
|
set dist [expr abs($reg - $s)]
|
|
if {abs($dist) < 0.05 * $s} {
|
|
# quadratic approach
|
|
set new [expr sqrt(abs($dist * 0.05 * $s)) / $smt]
|
|
} else {
|
|
# exponential approach
|
|
set new [expr abs($dist) / $smt]
|
|
}
|
|
if {$maxramp != 0 && $maxramp < $new} {
|
|
set new $maxramp
|
|
}
|
|
if {$reg > 0} {
|
|
if {$t > $reg * (1+0.01*$ramp_reg) && $reg > $s && $htr == 0 ||
|
|
$t < $reg * (1-0.01*$ramp_reg) && $reg < $s && $htr == 100} {
|
|
set new 0
|
|
sct ramp_reg 0
|
|
} else {
|
|
sct ramp_reg 1
|
|
}
|
|
} else {
|
|
sct ramp_reg 1
|
|
}
|
|
if {[sct model] eq "370" || [sct model] eq "372"} {
|
|
set new [format %.3f $new]
|
|
putIntoLimits new 0.001 10
|
|
} else {
|
|
set new [format %.1f $new]
|
|
putIntoLimits new 0.1 100
|
|
}
|
|
}
|
|
if {abs($new - $old) > 1e-5} {
|
|
hset $looppath/wramp $new
|
|
}
|
|
if {$new == 0 && $reg != $s && [silent 0 hval [sct parent $looppath/dblctrl]] == 0} {
|
|
hset $looppath $s
|
|
}
|
|
}
|
|
|
|
proc lsc::checkramp {} {
|
|
if {[hval [sct parent]/smooth] == 0} {
|
|
hset [sct parent]/wramp [sct target]
|
|
} else {
|
|
update_working_ramp [sct parent]
|
|
}
|
|
sct update [sct target]
|
|
}
|
|
|
|
proc lsc::setramp {} {
|
|
set ramp [expr abs([sct target])]
|
|
set rampflag 1
|
|
if {[sct model] eq "370"} {
|
|
set waitramp 0
|
|
if {$ramp < 0.001} {
|
|
if {$ramp == 0} {
|
|
set rampflag 0
|
|
# an overflow creates the special value and format +10.0000 on query
|
|
# else the format would be +010.000
|
|
# we use this to mark a permanently off ramp
|
|
set ramp 11
|
|
set waitramp 1
|
|
} else {
|
|
set ramp 0.001
|
|
}
|
|
} elseif {$ramp > 10} {
|
|
set ramp 10
|
|
}
|
|
set ramp [format "%.3f" $ramp]
|
|
sct send "RAMPST?;RAMP $rampflag,$ramp"
|
|
if {$ramp > 10} {
|
|
set ramp 0
|
|
}
|
|
sct requested $ramp
|
|
sct update $ramp
|
|
if {$waitramp} {
|
|
sct try 20
|
|
return lsc::wait_end_ramp370
|
|
}
|
|
} else {
|
|
if {[sct model] eq "350"} {
|
|
set rampresolution 0.001
|
|
set rampfmt "%.3f"
|
|
} else {
|
|
set rampresolution 0.1
|
|
set rampfmt "%.1f"
|
|
}
|
|
set setcmd ""
|
|
if {$ramp < $rampresolution} {
|
|
if {$ramp == 0} {
|
|
set rampflag 0
|
|
set setcmd "SETP [sct @looporblank][lsc::real2kink [sctval [sct parent]]];"
|
|
} else {
|
|
set ramp $rampresolution
|
|
}
|
|
}
|
|
set ramp [format $rampfmt $ramp]
|
|
sct requested $ramp
|
|
sct update $ramp
|
|
sct send "RAMP [sct @loop],$rampflag,$ramp;$setcmd*OPC?"
|
|
}
|
|
return stdSct::complete
|
|
}
|
|
|
|
proc lsc::wait_end_ramp370 {} {
|
|
if {[sct result] == 0 && [sct try] > 0} {
|
|
sct try [expr [sct try] - 1]
|
|
set setp [sctval [sct parent]]
|
|
sct send "SETP [hvali [sct parent]];SETP?"
|
|
return stdSct::complete
|
|
}
|
|
sct send "RAMPST?"
|
|
return lsc::wait_end_ramp370
|
|
}
|
|
|
|
proc lsc::getramp {} {
|
|
sct send "RAMP?[sct @loop]"
|
|
return lsc::updateRamp
|
|
}
|
|
|
|
proc lsc::updateRamp {} {
|
|
stdSct::scanf "%d,%g" flag ramp
|
|
if {$flag} {
|
|
if {[sctval [sct parent]/ramp] == 0} {
|
|
hset [sct parent]/ramp 0
|
|
}
|
|
} else {
|
|
sct update 0
|
|
}
|
|
return idle
|
|
}
|
|
|
|
#write action
|
|
proc lsc::setpid {} {
|
|
set cmd ""
|
|
catch {
|
|
set prop [hvali [sct]/prop]
|
|
set integ [hvali [sct]/integ]
|
|
set deriv [hvali [sct]/deriv]
|
|
lsc::take prop
|
|
lsc::take integ
|
|
lsc::take deriv
|
|
set cmd "PID [sct @looporblank]$prop,$integ,$deriv;"
|
|
set mout [silent [silent "" sct @manual_out] sct manual_output]
|
|
if {$mout ne ""} {
|
|
append cmd "MOUT [sct @looporblank]$mout;"
|
|
sct manual_output ""
|
|
}
|
|
}
|
|
sct send "${cmd}*OPC?"
|
|
return stdSct::complete
|
|
}
|
|
|
|
proc lsc::getpid {} {
|
|
sct send "PID?[sct @loop]"
|
|
return lsc::pidupdate
|
|
}
|
|
|
|
proc lsc::pidupdate {} {
|
|
set res [split [sct result] ,]
|
|
set p [lindex $res 0]
|
|
set i [lindex $res 1]
|
|
set d [lindex $res 2]
|
|
updateval [sct]/prop $p
|
|
updateval [sct]/integ $i
|
|
updateval [sct]/deriv $d
|
|
if {$p == 0 && $i == 0} {
|
|
sct send "PID [sct @loop],50,20,0;*OPC?"
|
|
return stdSct::complete
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc lsc::getpower {} {
|
|
if {[sct model] eq 340} {
|
|
if {[sct @loop] == 1} {
|
|
sct send "HTR?"
|
|
} else {
|
|
sct send "AOUT?2"
|
|
}
|
|
} elseif {[sct model] eq 336} {
|
|
if {[sct @loop] <= 2} {
|
|
sct send "HTR?[sct @loop]"
|
|
} else {
|
|
sct send "AOUT?[sct @loop]"
|
|
}
|
|
} elseif {[sct model] eq "372"} {
|
|
if {[sct @loop] == 0} {
|
|
sct send "HTR?"
|
|
} else {
|
|
sct send "AOUT?[sct @loop]"
|
|
}
|
|
} else {
|
|
sct send "HTR?[sct @loop]"
|
|
}
|
|
return lsc::updatepower
|
|
}
|
|
|
|
proc lsc::updatepower {} {
|
|
set lp [hvali [sct parent]/linearpower]
|
|
set htr [sct result]
|
|
sct htr $htr
|
|
set mout [silent 0 sct @manual_out]
|
|
if {$mout} {
|
|
set htr [expr ($htr - [silent 0 sct @manual_out]) / (1 - $mout * 0.01)]
|
|
}
|
|
update_working_ramp [sct parent]
|
|
set maxpower [hvali [sct parent]/maxpower]
|
|
if {$lp > 0} {
|
|
set power [expr $htr * 0.01 * $maxpower]
|
|
} elseif {$lp < 0} {
|
|
set power [expr ($htr * 0.01)**2 * $maxpower]
|
|
} else {
|
|
set resist [hvali [sct parent]/resist]
|
|
set power [expr pow($htr * 0.01 * [hvali [sct parent]/maxcurrent], 2) * $resist]
|
|
}
|
|
if {$htr < 0} {
|
|
set power 0
|
|
}
|
|
if {$power <= $maxpower} {
|
|
sct update $power
|
|
} else {
|
|
sct update $maxpower
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc lsc::check_manualpower {} {
|
|
if {[hvali [sct parent]/mode] < 0} {
|
|
error "ERROR: heater disabled"
|
|
} elseif {[hvali [sct parent]/mode] != 2} {
|
|
# like a hset [sct parent]/mode 2
|
|
hsetprop [sct parent]/mode target 2
|
|
updateval [sct parent]/mode 2
|
|
[sct controllerName] queue [sct parent] write lsc::setloop
|
|
}
|
|
}
|
|
|
|
proc lsc::setmanualpower {} {
|
|
set lp [hvali [sct parent]/linearpower]
|
|
if {$lp == 0} {
|
|
set resist [hvali [sct parent]/resist]
|
|
set maxcurrent [hvali [sct parent]/maxcurrent]
|
|
if {[sct target] < 0} {
|
|
set percent 0
|
|
} else {
|
|
set percent [expr 100 * sqrt([sct target]/double($resist)) / $maxcurrent]
|
|
}
|
|
} elseif {$lp > 0} {
|
|
set percent [expr 100 * [sct target] / double($lp)]
|
|
} else {
|
|
set percent [expr 100 * sqrt(abs([sct target] / double($lp)))]
|
|
}
|
|
set percent [format %.2f $percent]
|
|
sct send "MOUT [sct @looporblank]$percent;MOUT?[sct @looporblank]"
|
|
sct mout $percent
|
|
return lsc::updatemanualpower
|
|
}
|
|
|
|
proc lsc::getmanualpower {} {
|
|
sct send "MOUT?[sct @looporblank]"
|
|
return lsc::updatemanualpower
|
|
}
|
|
|
|
proc lsc::updatemanualpower {} {
|
|
stdSct::scanf "%g" mout
|
|
set lp [hvali [sct parent]/linearpower]
|
|
if {$lp == 0} {
|
|
set resist [hvali [sct parent]/resist]
|
|
set maxcurrent [hvali [sct parent]/maxcurrent]
|
|
set mp [expr pow($mout * 0.01 * $maxcurrent,2) * $resist]
|
|
} elseif {$lp > 0} {
|
|
set mp [expr $mout*0.01 * $lp]
|
|
} else {
|
|
set mp [expr ($mout*0.01) ** 2 * abs($lp)]
|
|
}
|
|
if {[silent 0 sct mout] == $mout} {
|
|
set mp [silent 0 sct target]
|
|
}
|
|
sct update [format "%.4g" $mp]
|
|
return idle
|
|
}
|
|
|
|
proc lsc::changeLinearpower {} {
|
|
if {[sct model] eq "370"} {
|
|
if {[sct target] == 0} {
|
|
lsc::finish370linearpower
|
|
return idle
|
|
}
|
|
sct send HTR?
|
|
return lsc::changeLinearpower370
|
|
}
|
|
sct update [sct target]
|
|
return idle
|
|
}
|
|
|
|
proc lsc::changeLinearpower370 {} {
|
|
sct oldhtr [sct result]
|
|
if {[sct oldhtr] == 0} {
|
|
lsc::finish370linearpower
|
|
}
|
|
sct send "CMODE 4;MOUT 0;HTRRNG?"
|
|
sct try 30
|
|
return lsc::wait370htroff
|
|
}
|
|
|
|
proc lsc::wait370htroff {} {
|
|
if {[sct result] != 0} {
|
|
if {[sct try] < 0} {
|
|
error "heater does not switch off after switching loop off"
|
|
}
|
|
sct try [expr [sct try] - 1]
|
|
sct send "CMODE 4;MOUT 0;HTRRNG?"
|
|
# sct send "HTRRNG?"
|
|
return lsc::wait370htroff
|
|
}
|
|
set htrrng [silent 7 hgetpropval [sct parent] htrrng]
|
|
sct send "HTRRNG $htrrng;CMODE 1;MOUT 0;HTR?"
|
|
sct try 90
|
|
return lsc::wait370htrchange
|
|
}
|
|
|
|
proc lsc::wait370htrchange {} {
|
|
if {[sct result] > 0.5 * [silent 0 sct oldhtr] && [sct try] > 0} {
|
|
sct try [expr [sct try] - 1]
|
|
sct send "HTR?"
|
|
return lsc::wait370htrchange
|
|
}
|
|
set mout [expr [silent 0 sct oldhtr] * [hvali [sct]] / double([sct target])]
|
|
hsetprop [sct parent]/power htr $mout
|
|
if {[sct target] <= [hvali [sct]]} {
|
|
# set mout later (with next pid change)
|
|
hsetprop [sct parent] manual_output $mout
|
|
set mout 0
|
|
} else {
|
|
hdelprop [sct parent] manual_output
|
|
}
|
|
sct send "MOUT $mout;SETP [sctval [sct parent]];HTR?"
|
|
return lsc::finish370linearpower
|
|
}
|
|
|
|
proc lsc::finish370linearpower {} {
|
|
sct update [sct target]
|
|
return idle
|
|
}
|
|
|
|
# get the temperature related to loop $path
|
|
proc lsc::get_temp_of {path} {
|
|
return [silent 0 hgetpropval $path temp_[sctval $path/channel]]
|
|
}
|
|
|
|
proc lsc::rdactive370 {} {
|
|
sct send "INSET?[sct @channel]"
|
|
return lsc::updactive370
|
|
}
|
|
|
|
proc lsc::updactive370 {} {
|
|
sct update [string index [sct result] 0]
|
|
return idle
|
|
}
|
|
|
|
proc lsc::wractive370 {} {
|
|
sct send "INSET?[sct @channel]"
|
|
return lsc::setactive370
|
|
}
|
|
|
|
proc lsc::setactive370 {} {
|
|
if {[sct target]} {
|
|
if {[hvali [sct]] == 0} {
|
|
updateerror [sct parent] not_read_yet 1
|
|
updateerror [sct parent]/raw not_read_yet 1
|
|
}
|
|
set f 1
|
|
} else {
|
|
set f 0
|
|
updateerror [sct parent] disabled 1
|
|
updateerror [sct parent]/raw disabled 1
|
|
}
|
|
sct update $f
|
|
sct send "SCAN?;INSET [sct @channel],$f[string range [sct result] 1 end]"
|
|
sct requested $f
|
|
return lsc::setchannel370
|
|
}
|
|
|
|
proc lsc::setchannel370 {} {
|
|
if {[sct target] == 0} {
|
|
return idle
|
|
}
|
|
stdSct::scanf "%d,%d" c auto
|
|
sct send "*OPC?;SCAN [sct @channel],$auto"
|
|
return stdSct::complete
|
|
}
|
|
|
|
proc lsc::rdgrng370 {} {
|
|
sct send "RDGRNG?[sct @channel]"
|
|
return lsc::wrrdgrng370
|
|
}
|
|
|
|
proc lsc::rdgrng372 {} {
|
|
sct send "INTYPE?[sct @channel]"
|
|
return lsc::wrrdgrng372
|
|
}
|
|
|
|
proc lsc::updateExcitation {path csoff mode exc} {
|
|
if {$csoff} {
|
|
updateval $path off
|
|
} elseif {$mode == 0} {
|
|
set value [expr pow(10.0, ($exc-1) * 0.5) * 2e-6]
|
|
updateval $path "[formatWithUnit $value]V"
|
|
} else {
|
|
set value [expr pow(10.0, ($exc-1) * 0.5) * 1e-12]
|
|
updateval $path "[formatWithUnit $value]A"
|
|
}
|
|
}
|
|
|
|
proc lsc::updateRange {path rng} {
|
|
set value [expr pow(10.0, ($rng-1) * 0.5) * 0.002]
|
|
updateval $path "[formatWithUnit $value]Ohm"
|
|
}
|
|
|
|
proc lsc::wrrdgrng370 {} {
|
|
stdSct::scanf "%d,%d,%d,%d,%d" mode exc rng auto csoff
|
|
return [lsc::setrdgrng37x $mode $exc $rng $auto $csoff]
|
|
}
|
|
|
|
proc lsc::wrrdgrng372 {} {
|
|
stdSct::scanf "%d,%d,%d,%d,%d,%d" mode exc auto rng csoff oldunit
|
|
if {[sctval [sct]/curve] eq "raw"} {
|
|
set unit 2
|
|
} else {
|
|
set unit 1
|
|
}
|
|
set doit [expr $unit != $oldunit]
|
|
return [lsc::setrdgrng37x $mode $exc $rng $auto $csoff $unit $doit]
|
|
}
|
|
|
|
proc lsc::setrdgrng37x {mode exc rng auto csoff {unit 0} {doit 0}} {
|
|
if {[lsc::take excitation]} {
|
|
set exmode [hval [sct]/excitation_mode]
|
|
switch -- $exmode {
|
|
1 {
|
|
set csoff 0
|
|
set mode 1
|
|
set exc [hval [sct]/excitation_num]
|
|
}
|
|
0 {
|
|
set csoff 0
|
|
set mode 0
|
|
set exc [hval [sct]/excitation_num]
|
|
}
|
|
default {set csoff 1}
|
|
}
|
|
set doit 1
|
|
}
|
|
if {[lsc::take range]} {
|
|
set rng [hval [sct]/range_num]
|
|
if {$doit == 0} {
|
|
set doit 2
|
|
}
|
|
}
|
|
if {[lsc::take autorange]} {
|
|
if {$autorange} {
|
|
set auto 1
|
|
} else {
|
|
set auto 0
|
|
}
|
|
set doit 1
|
|
} else {
|
|
set autorange $auto
|
|
}
|
|
updateExcitation [sct]/excitation $csoff $mode $exc
|
|
updateRange [sct]/range $rng
|
|
set o [sct objectPath]
|
|
foreach c [hgetpropval $o channels] {
|
|
set cp [hgetpropval $o channel_$c]
|
|
updateval $cp/autorange $autorange
|
|
}
|
|
if {$doit > 0} {
|
|
if {[sct model] eq "370"} {
|
|
sct send "RDGRNG [sct @channel],$mode,$exc,$rng,$auto,$csoff;*OPC?"
|
|
} else {
|
|
sct send "INTYPE [sct @channel],$mode,$exc,$auto,$rng,$csoff,$unit;*OPC?"
|
|
}
|
|
return stdSct::complete
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc lsc::checkExcitation {} {
|
|
if {[string tolower [sct requested]] eq "off"} {
|
|
updateExcitation [sct] 1 1 1
|
|
hupdate [sct parent]/excitation_mode 1
|
|
return
|
|
}
|
|
set value [parseValueUnit [sct requested] unit]
|
|
if {[string toupper $unit] eq "A" || [string toupper $unit] eq "AMP"} {
|
|
hupdate [sct parent]/excitation_mode 1
|
|
set exnum [expr round(log10($value/1e-12) * 2 + 1)]
|
|
if {$exnum > 22} {
|
|
set exnum 22
|
|
} elseif {$exnum <= 0} {
|
|
set exnum 1
|
|
}
|
|
hupdate [sct parent]/excitation_num $exnum
|
|
updateExcitation [sct] 0 1 $exnum
|
|
} elseif {[string toupper $unit] eq "V" || [string toupper $unit] eq "VOLT"} {
|
|
hupdate [sct parent]/excitation_mode 0
|
|
set exnum [expr round(log10($value/2e-6) * 2 + 1)]
|
|
if {$exnum > 12} {
|
|
set exnum 12
|
|
} elseif {$exnum <= 0} {
|
|
set exnum 1
|
|
}
|
|
hupdate [sct parent]/excitation_num $exnum
|
|
updateExcitation [sct] 0 0 $exnum
|
|
} else {
|
|
error "illegal unit for excitation: $unit"
|
|
}
|
|
}
|
|
|
|
proc lsc::checkRange {} {
|
|
set value [parseValueUnit [sct requested] unit]
|
|
if {[string toupper $unit] ne "OHM" && $unit ne ""} {
|
|
error "illegal unit for range: $unit"
|
|
}
|
|
set value [expr round(log10($value/0.002) * 2 + 1)]
|
|
if {$value > 22} {
|
|
set value 22
|
|
} elseif {$value < 1} {
|
|
set value 1
|
|
}
|
|
hupdate [sct parent]/range_num $value
|
|
updateRange [sct] $value
|
|
}
|
|
|
|
proc lsc::readFilter {} {
|
|
sct send "FILTER?[sct @channel]"
|
|
return lsc::updateFilter
|
|
}
|
|
|
|
proc lsc::updateFilter {} {
|
|
stdSct::scanf "%d,%d,%d" off value window
|
|
sct update $value
|
|
return idle
|
|
}
|
|
|
|
proc lsc::scanSettings {mode} {
|
|
sct send "INSET?[sct @channel]"
|
|
return "lsc::setScanSettings $mode"
|
|
}
|
|
|
|
proc lsc::setScanSettings {mode} {
|
|
stdSct::scanf "%d,%d,%d,%d,%d" active dwell pause curveno tempco
|
|
if {$mode ne "read"} {
|
|
set pause [silent $pause hgetpropval [sct parent]/pause requested]
|
|
set dwell [silent $pause hgetpropval [sct parent]/dwell requested]
|
|
}
|
|
updateval [sct parent]/pause $pause
|
|
updateval [sct parent]/dwell $dwell
|
|
if {$mode eq "pause"} {
|
|
if {[sctval [sct objectPath]/autoscan/pause] ne "$pause"} {
|
|
clientput "com pause [sctval [sct objectPath]/autoscan/pause] ne $pause"
|
|
updateval [sct objectPath]/autoscan/pause ""
|
|
}
|
|
}
|
|
if {$mode eq "dwell"} {
|
|
if {[sctval [sct objectPath]/autoscan/dwell] ne "$dwell"} {
|
|
clientput "com dwell [sctval [sct objectPath]/autoscan/dwell] ne $dwell"
|
|
updateval [sct objectPath]/autoscan/dwell ""
|
|
}
|
|
}
|
|
if {$mode ne "read"} {
|
|
sct send "INSET [sct @channel],$active,$dwell,$pause,$curveno,$tempco;*OPC?"
|
|
return stdSct::completeUpdate
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc lsc::checkCommon {par} {
|
|
set o [sct objectPath]
|
|
set pause [sctval [sct parent]/pause]
|
|
set dwell [sctval [sct parent]/dwell]
|
|
set interval [sctval [sct parent]/interval]
|
|
hupdate [sct parent]/dwell $dwell
|
|
hupdate [sct parent]/pause $pause
|
|
hupdate [sct parent]/interval $interval
|
|
if {$interval eq "" || $pause eq "" || $dwell eq ""} return
|
|
set filter [expr $interval - $pause - $dwell]
|
|
if {$filter < 1} {
|
|
sct print "WARNING: interval should be greater than pause + dwell ([sct])"
|
|
set filter 1
|
|
}
|
|
foreach c [hgetpropval $o channels] {
|
|
set cp [hgetpropval $o channel_$c]
|
|
hset $cp/pause $pause
|
|
hset $cp/dwell $dwell
|
|
hset $cp/filter $filter
|
|
}
|
|
}
|
|
|
|
proc lsc::writeAutoscan370 {} {
|
|
sct send "SCAN?"
|
|
hsetprop [sct parent] lastchange [DoubleTime]
|
|
return lsc::setAutoscan370
|
|
}
|
|
|
|
proc lsc::setAutoscan370 {} {
|
|
stdSct::scanf "%d,%d" chan auto
|
|
if {$auto == [sct target]} {
|
|
sct update [sct target]
|
|
return idle
|
|
}
|
|
sct send "SCAN $chan,[sct target];*OPC?"
|
|
return stdSct::completeUpdate
|
|
}
|
|
|
|
proc lsc::analog2_370 {} {
|
|
set volt [expr double([sct target]) / [sct maxuser] * [sct maxvolt]]
|
|
if {$volt > [sct maxvolt]} {
|
|
set volt [sct maxvolt]
|
|
}
|
|
# sct send "ANALOG 2,0,2,0,0,0,0,[expr 10 * $volt];ANALOG?2"
|
|
sct send "ANALOG 2,0,4,0,0,0,0,[expr 10 * $volt];ANALOG?2"
|
|
return "lsc::analog2still_370 [expr 10 * $volt]"
|
|
}
|
|
|
|
proc lsc::analog2still_370 {percent} {
|
|
sct send "STILL $percent;ANALOG?2"
|
|
return lsc::analog2upd_370
|
|
}
|
|
|
|
proc lsc::analog2rd_370 {} {
|
|
sct send "ANALOG?2"
|
|
return lsc::analog2upd_370
|
|
}
|
|
|
|
proc lsc::analog2upd_370 {} {
|
|
stdSct::scanf {%d,%d,%[^,],%d,%g,%g,%g} pol mode inp src hi lo value
|
|
sct update [expr $value * 0.1 / [sct maxvolt] * [sct maxuser]]
|
|
return idle
|
|
}
|
|
|
|
#proc lsc::outpulse370 {} {
|
|
# sct send "ANALOG 1,1,2,0,0,0,0,[sct target];*OPC?"
|
|
# return lsc::outpulse370b
|
|
#}
|
|
#
|
|
#proc lsc::outpulse370b {} {
|
|
# sct send "ANALOG 1,1,2,0,0,0,0,0;*OPC?"
|
|
# return stdSct::completeUpdate
|
|
#}
|
|
|
|
proc lsc::updatesensor370 {objpath value} {
|
|
if {[hvali [sct]/active]} {
|
|
set e [silent 0 sct geterror]
|
|
if {$e eq "0"} {
|
|
updateval $objpath $value
|
|
hsetprop $objpath updatetime [clock seconds]
|
|
} else {
|
|
updateerror $objpath $e 1
|
|
}
|
|
}
|
|
}
|
|
|
|
proc lsc::updateraw370 {path value} {
|
|
if {[hvali [sct parent]/active]} {
|
|
set e [silent 0 sct geterror]
|
|
if {$e eq "0"} {
|
|
updateval $path $value
|
|
hsetprop $path updatetime [clock seconds]
|
|
} else {
|
|
updateerror $path $e 1
|
|
}
|
|
}
|
|
}
|
|
|
|
proc lsc::updateactive370 {path value} {
|
|
if {$value && [hvali $path] == 1} {
|
|
hset $path 0
|
|
}
|
|
}
|
|
|
|
proc lsc::checklimit {path value {mode error}} {
|
|
set lim [hvali $path/set/limit]
|
|
if {$value > $lim} {
|
|
if {$mode eq "fix"} {
|
|
return $lim
|
|
}
|
|
error "$value above limit ($lim)[silent "" hgetpropval [sct]/set tlimit_message]"
|
|
}
|
|
return $value
|
|
}
|
|
|
|
#config script
|
|
proc stdConfig::lsc_sensor args {
|
|
# when sensor is "clone", the channel is linked with the last ls370 object
|
|
variable node
|
|
variable ctrl
|
|
variable path
|
|
variable lsc
|
|
variable ls370clone
|
|
global device_name
|
|
|
|
scanargs $args var -relpath -channel -sensor undefined -sensorname none \
|
|
-active 1 -filter 1 -dwell 1 -pause 3 -excitation 0 -range auto \
|
|
-is 0 -color auto -alarm auto
|
|
|
|
# add entry to the index of channel path names
|
|
hsetprop $path channel_$channel $path/$relpath
|
|
hsetprop $path channels "[hgetpropval $path channels]$channel "
|
|
|
|
node $relpath upd -secop=$relpath
|
|
prop @channel $channel
|
|
# prop write lsc::rdgrng370 # seems unused
|
|
prop geterror "not read yet"
|
|
|
|
if {$lsc(firstsensor) eq ""} {
|
|
set lsc(firstsensor) $relpath
|
|
}
|
|
if {$is eq "sample" || $sensorname eq "sample"} {
|
|
set lsc(samplesensor) $relpath
|
|
if {$color eq "auto"} {
|
|
set color blue
|
|
}
|
|
}
|
|
if {$is eq "main" || $sensorname eq "main" || $sensorname eq "VTI"} {
|
|
set lsc(mainsensor) $relpath
|
|
if {$color eq "auto"} {
|
|
set color red
|
|
}
|
|
}
|
|
|
|
if {$sensor eq "clone"} {
|
|
if {$lsc(model) ne "370"} {
|
|
error "clone implemented on Model 370 only"
|
|
}
|
|
set clone 1
|
|
set sensor [hgetpropval $ls370clone/$relpath/curve requested]
|
|
set sensorname [hgetpropval $ls370clone/$relpath/curve sensorname]
|
|
set active [expr ![hvali $ls370clone/$relpath/active]]
|
|
set color hidden
|
|
} else {
|
|
set clone 0
|
|
}
|
|
if {$sensorname eq "none"} {
|
|
set sensorname "[lindex [split $relpath /] end]"
|
|
}
|
|
if {[info exists ::stick_name] && $channel >= "C"} {
|
|
set devname "${::stick_name}_"
|
|
} elseif {[info exists ::device_name]} {
|
|
set devname "${::device_name}_"
|
|
} else {
|
|
set devname [silent "" result device name]_
|
|
}
|
|
set shortname [lindex [split $sensorname _] end]
|
|
set curvename "$devname$shortname"
|
|
kids "$sensorname sensor settings (channel $channel)" {
|
|
if {$lsc(model) eq "370" || $lsc(model) eq "372"} {
|
|
node active wr
|
|
prop enum inactive,active
|
|
prop lineend 0
|
|
prop read lsc::rdactive370
|
|
prop write lsc::wractive370
|
|
default $active
|
|
|
|
node autorange out
|
|
prop enum 1
|
|
# prop check lsc::write_up
|
|
prop write stdSct::completeUpdate
|
|
prop help "autorange (common for all channels)"
|
|
prop geterror "not read yet"
|
|
|
|
node range out -text
|
|
prop check lsc::checkRange
|
|
prop write stdSct::complete
|
|
prop help "resistance range in Ohm"
|
|
prop geterror "not read yet"
|
|
|
|
set rangenode $node
|
|
node range_num -int upd
|
|
|
|
if {$range ne "0"} {
|
|
catch {
|
|
hset $rangenode $range
|
|
} msg
|
|
}
|
|
|
|
node excitation out -text
|
|
prop check lsc::checkExcitation
|
|
prop write stdSct::complete
|
|
prop help "excitation with unit, i.e. 2uV or 3pA"
|
|
prop geterror "not read yet"
|
|
set enode $node
|
|
node excitation_num -int upd
|
|
|
|
node excitation_mode -int upd
|
|
prop enum voltage,current,off
|
|
|
|
if {$excitation ne "0"} {
|
|
catch {
|
|
hset $enode $excitation
|
|
} msg
|
|
# clientput "EXC $enode $msg"
|
|
}
|
|
|
|
node pause out -int
|
|
prop write lsc::scanSettings pause
|
|
prop help {pause time [sec] after channel change}
|
|
default $pause
|
|
|
|
node filter wr -int
|
|
prop writecmd "FILTER $channel,1,%d,80;*OPC?"
|
|
prop read lsc::readFilter
|
|
prop help {filter average time [sec]}
|
|
prop synched 0
|
|
default 1
|
|
|
|
if {$filter ne "none"} {
|
|
catch {
|
|
hset $node $filter
|
|
} msg
|
|
}
|
|
|
|
node dwell wr -int
|
|
prop write lsc::scanSettings dwell
|
|
prop read lsc::scanSettings read
|
|
prop help {dwell time [sec]. Total time per channel: pause + filter + dwell}
|
|
default $dwell
|
|
|
|
node status upd -text
|
|
}
|
|
|
|
node curve wr -text
|
|
prop width 32
|
|
prop read lsc::detect_sensor
|
|
prop sensorname $curvename
|
|
prop shortname $shortname
|
|
prop check lsc::read_curve
|
|
prop write lsc::set_curve
|
|
prop __save update
|
|
hfactory $node/points plain mugger floatvarar 1
|
|
if {$sensor eq "manual"} {
|
|
default "manual"
|
|
lsc_display $channel K
|
|
} elseif {$sensor eq "undefined"} {
|
|
default "undefined"
|
|
lsc_display $channel K
|
|
} elseif {$sensor eq "raw"} {
|
|
default "raw"
|
|
lsc_display $channel S
|
|
hset $node $sensor
|
|
} elseif {$sensor eq "vacuum"} {
|
|
default "vacuum"
|
|
lsc_display $channel L
|
|
if {$color eq "auto"} {
|
|
set color black
|
|
}
|
|
if {$color ne "hidden"} {
|
|
GraphAdd [lindex [split $path "/"] end-1].$relpath logP $sensorname $color
|
|
}
|
|
hset $node $sensor
|
|
} elseif {$sensor eq "code"} {
|
|
default "code"
|
|
set alarm 0
|
|
hset $node $sensor
|
|
} else {
|
|
hset $node $sensor
|
|
if {$is ne "hidden"} {
|
|
lsc_display $channel K
|
|
if {$color ne "hidden"} {
|
|
GraphAdd [lindex [split $path "/"] end-1].$relpath K T_$sensorname $color
|
|
}
|
|
}
|
|
}
|
|
|
|
node alarm wr
|
|
prop check lsc::checkalarm
|
|
prop write stdSct::complete
|
|
prop read lsc::getalarm
|
|
if {$alarm eq "auto"} {
|
|
hset $node 320
|
|
} else {
|
|
hset $node $alarm
|
|
}
|
|
|
|
if {$lsc(model) ne "370"} {
|
|
node stddev upd
|
|
}
|
|
|
|
node raw upd
|
|
|
|
}
|
|
if {$clone} {
|
|
$ctrl updatescript $path/$relpath "lsc::updatesensor370 $ls370clone/$relpath"
|
|
$ctrl updatescript $path/$relpath/raw "lsc::updateraw370 $ls370clone/$relpath/raw"
|
|
$ctrl updatescript $path/$relpath/active "lsc::updateactive370 $ls370clone/$relpath/active"
|
|
}
|
|
}
|
|
|
|
proc stdConfig::lsc_kink {kink kinkscale} {
|
|
variable path
|
|
variable lsc_kink $kink
|
|
variable lsc_kinkscale $kinkscale
|
|
|
|
# put warning after last parameter before sensors
|
|
hsetprop $path/settle warning "remark: ignore the values on the LakeShore display above $kink K"
|
|
hsetprop $path @kink $kink
|
|
hsetprop $path @kinkscale $kinkscale
|
|
}
|
|
|
|
proc stdConfig::lsc_analog args {
|
|
variable lsc
|
|
if {$lsc(model) ne "370" && $lsc(model) ne "372"} {
|
|
clientput "analog output not available"
|
|
return
|
|
}
|
|
scanargs $args var -maxvolt 10 -maxuser 100
|
|
set lsc(analog_maxvolt) $maxvolt
|
|
set lsc(analog_maxuser) $maxuser
|
|
}
|
|
|
|
proc stdConfig::lsc_loop args {
|
|
variable node
|
|
variable lsc
|
|
variable path
|
|
variable lsc_kink
|
|
variable lsc_kinkscale
|
|
|
|
scanargs $args var -relpath -channel -maxheater -resist -loop 1 \
|
|
-linearpower 0 -color auto -loopname "" -mout 0 -is 0
|
|
|
|
node $relpath wr
|
|
default 0
|
|
prop check lsc::check_set
|
|
prop write lsc::setloop
|
|
prop read lsc::getloop
|
|
prop setpid lsc::setpid
|
|
prop getpid lsc::getpid
|
|
prop warning $node/reg
|
|
if {$lsc(model) eq "370"} {
|
|
prop @loop ""
|
|
prop @looporblank ""
|
|
} else {
|
|
prop @loop $loop
|
|
prop @looporblank "$loop,"
|
|
}
|
|
if {$mout ne ""} {
|
|
prop @manual_out $mout
|
|
}
|
|
poll 10 slow getpid
|
|
|
|
if {$is eq "sample"} {
|
|
if {$loopname eq ""} {
|
|
set loopname samp
|
|
}
|
|
set lsc(setsample) "$path/$relpath"
|
|
}
|
|
kids "$relpath ($loopname control settings)" {
|
|
node mode -int out
|
|
prop enum disabled=-1,off=0,controlling=1,manual=2
|
|
prop check lsc::write_up
|
|
# prop check lsc::check_mode
|
|
prop write stdSct::completeUpdate
|
|
|
|
node reg rd
|
|
prop read lsc::read_reg
|
|
|
|
node ramp out
|
|
default 0
|
|
prop check lsc::checkramp
|
|
prop write stdSct::complete
|
|
prop help "maximum ramp in K/min (0: ramp off)"
|
|
|
|
node wramp wr
|
|
default 0
|
|
prop write lsc::setramp
|
|
prop read lsc::getramp
|
|
prop label "working ramp"
|
|
# do not show as writable in UI
|
|
prop priv USER
|
|
if {[info exists lsc_kink]} {
|
|
prop warning "remark: above $lsc_kink K, $lsc_kinkscale times the given ramp value is used"
|
|
}
|
|
|
|
node smooth par 0
|
|
prop help "smooth time (minutes)"
|
|
|
|
node channel -text out
|
|
prop check lsc::write_up
|
|
prop write stdSct::completeUpdate
|
|
|
|
node limit par 310
|
|
|
|
node resist out
|
|
prop check lsc::check_resist
|
|
prop write stdSct::completeUpdate
|
|
|
|
node maxheater -text out
|
|
prop check lsc::write_up
|
|
prop write stdSct::completeUpdate
|
|
prop help "maximum heater limit, units should be given without space: W, mW, A, mA"
|
|
|
|
node linearpower out
|
|
default $linearpower
|
|
prop write lsc::changeLinearpower
|
|
prop help "when not 0, it is the maximum effective power, and the power is linear to the heater output"
|
|
|
|
node maxpowerlim upd
|
|
prop help "the maximum power limit (before any booster or converter)"
|
|
|
|
node maxpower out
|
|
prop check lsc::write_up
|
|
prop write stdSct::complete
|
|
prop help {maximum power [W]}
|
|
|
|
node maxcurrent upd
|
|
prop help "the maximum current before any booster or converter"
|
|
|
|
node manualpower wr
|
|
prop check lsc::check_manualpower
|
|
prop write lsc::setmanualpower
|
|
prop read lsc::getmanualpower
|
|
|
|
node power rd
|
|
prop read lsc::getpower
|
|
prop htr 0
|
|
|
|
node prop out
|
|
prop help "bigger means more gain"
|
|
prop geterror "not read yet"
|
|
prop check lsc::write_up setpid
|
|
prop write stdSct::completeUpdate
|
|
|
|
node integ out
|
|
if {$lsc(model) eq "370"} {
|
|
prop help "\[sec\] bigger means slower"
|
|
} else {
|
|
prop help "bigger means faster"
|
|
}
|
|
prop geterror "not read yet"
|
|
prop check lsc::write_up setpid
|
|
prop write stdSct::completeUpdate
|
|
|
|
node deriv out
|
|
prop geterror "not read yet"
|
|
prop check lsc::write_up setpid
|
|
prop write stdSct::completeUpdate
|
|
}
|
|
|
|
hset $path/$relpath/mode 0
|
|
hset $path/$relpath/channel $channel
|
|
hset $path/$relpath/resist $resist
|
|
hset $path/$relpath/maxheater $maxheater
|
|
|
|
set dotpath [lindex [split $path "/"] end]
|
|
if {$color ne "hidden"} {
|
|
if {$loopname ne ""} {
|
|
set postfix "_$loopname"
|
|
} else {
|
|
set postfix ""
|
|
}
|
|
GraphAdd $dotpath.$relpath.power W Htr_pow$postfix $color
|
|
GraphAdd $dotpath.$relpath.reg K T_reg$postfix $color
|
|
}
|
|
}
|
|
|
|
#config script (basics)
|
|
proc stdConfig::lsc_init {model {term ""} {timeout 5}} {
|
|
variable lsc
|
|
variable node
|
|
variable path
|
|
|
|
if {$term eq ""} {
|
|
switch $model {
|
|
340 {set term "\r"}
|
|
370 {set term "\n"}
|
|
335 - 336 - 224 - 350 - 372 {set term "\n"}
|
|
default {error "unknown model: $model"}
|
|
}
|
|
} elseif {$model ne "340" && $model ne "335"} {
|
|
error "GPIB only with model 340 / 335"
|
|
}
|
|
set lsc(model) $model
|
|
if {[controller lsc "sendterminator=$term" timeout=$timeout writedelay=0.05]} {
|
|
controllerDesc "LakeShore $model temperature controller"
|
|
prop model $model
|
|
prop objectPathDef $stdConfig::base$stdConfig::name
|
|
hsetprop $node/tasks start lsc::start
|
|
hsetprop $node/tasks commerror lsc::errorScript
|
|
}
|
|
set lsc(display) ""
|
|
set lsc(firstsensor) ""
|
|
set lsc(mainsensor) ""
|
|
set lsc(samplesensor) ""
|
|
}
|
|
|
|
proc stdConfig::340_lsc {cfgscript {term ""} {timeout 5}} {
|
|
variable ctrl
|
|
variable node
|
|
variable path
|
|
variable lsc_run 0
|
|
variable name
|
|
|
|
lsc_init 340 $term
|
|
prop mode_remote 2
|
|
prop mode_local 1
|
|
prop remote 0
|
|
prop idn empty
|
|
prop first_curveno 21
|
|
prop last_curveno 60
|
|
prop max_query 5
|
|
|
|
set hasloop 0
|
|
set dbl 1
|
|
foreach term $cfgscript {
|
|
if {$term eq "lsc_loop"} {
|
|
set hasloop 1
|
|
} elseif {$term eq "fake_loop"} {
|
|
set hasloop 1
|
|
set dbl 0
|
|
}
|
|
}
|
|
if {$hasloop} {
|
|
obj lsc340 wr -drive
|
|
tdrive settings -getcmd 0 -setcmd set -log 1 -dbl $dbl -limitscript "lsc::checklimit $path"
|
|
prop label "set T"
|
|
poll 1 read lsc::getT
|
|
} else {
|
|
obj lsc340 upd
|
|
prop read stdSct::complete
|
|
poll 1 read lsc::getT
|
|
}
|
|
prop channels ""
|
|
hsetprop $node/send write lsc::startSend
|
|
set cfg "$cfgscript"
|
|
|
|
kids "temperature (LakeShore 340)" $cfg
|
|
lsc_end
|
|
|
|
node dout wr -int
|
|
prop write lsc::write340dio
|
|
prop read lsc::read340dio
|
|
|
|
node dinp upd -int
|
|
|
|
node remote rd
|
|
prop read lsc::readremote
|
|
prop enum 1
|
|
$ctrl poll $node 10 slow lsc::remoteoff
|
|
|
|
return "LakeShore Model 340"
|
|
}
|
|
|
|
proc stdConfig::340gpib_lsc {cfgscript} {
|
|
340_lsc $cfgscript "\n++read eoi\n"
|
|
}
|
|
|
|
proc stdConfig::335gpib_lsc {cfgscript} {
|
|
# used for completeness, 335 is used always with Prologix GPIB
|
|
335_lsc $cfgscript
|
|
}
|
|
|
|
proc stdConfig::370_lsc {cfgscript} {
|
|
variable ctrl
|
|
variable node
|
|
variable name
|
|
variable path
|
|
variable lsc
|
|
|
|
lsc_init 370
|
|
prop mode_remote 1
|
|
prop mode_local 0
|
|
prop remote 0
|
|
prop idn empty
|
|
prop first_curveno 1
|
|
prop last_curveno 20
|
|
prop max_query 1
|
|
|
|
obj lsc370 rd -int
|
|
prop label "scan channel"
|
|
prop channels ""
|
|
prop read lsc::getT
|
|
prop lastupdate 0
|
|
prop lastchange 0
|
|
poll 1 read read
|
|
hsetprop $node/send write lsc::startSend
|
|
set prescript {
|
|
node autoscan out -int
|
|
prop enum 1
|
|
prop write lsc::writeAutoscan370
|
|
default 1
|
|
|
|
kids "common scan settings" {
|
|
node synchronized -int par 0
|
|
prop enum 1
|
|
|
|
node interval out -text
|
|
prop check lsc::checkCommon interval
|
|
prop write stdSct::complete
|
|
default 10
|
|
|
|
node pause out -text
|
|
prop check lsc::checkCommon pause
|
|
prop write stdSct::complete
|
|
default 3
|
|
|
|
node dwell out -text
|
|
prop check lsc::checkCommon dwell
|
|
prop write stdSct::complete
|
|
default 1
|
|
|
|
}
|
|
}
|
|
set cfg "$prescript\n$cfgscript"
|
|
kids "$name (LakeShore 370)" $cfg
|
|
lsc_display 0 S
|
|
|
|
# node outpulse out
|
|
# prop write lsc::outpulse370
|
|
|
|
# for compatibility we configure the analog output anyway
|
|
# may be removed when DIL sticks are configured properly
|
|
if {![info exists lsc(analog_maxuser)]} {
|
|
set lsc(analog_maxuser) 100
|
|
set lsc(analog_maxvolt) 10
|
|
}
|
|
node analog2 wr
|
|
prop write lsc::analog2_370
|
|
prop read lsc::analog2rd_370
|
|
prop maxvolt $lsc(analog_maxvolt)
|
|
prop maxuser $lsc(analog_maxuser)
|
|
|
|
node remote rd
|
|
prop read lsc::readremote
|
|
prop enum 1
|
|
$ctrl poll $node 10 slow lsc::remoteoff
|
|
|
|
lsc_end
|
|
|
|
variable ls370clone $path
|
|
return "LakeShore Model 370"
|
|
}
|
|
|
|
proc stdConfig::372_lsc {cfgscript} {
|
|
variable ctrl
|
|
variable node
|
|
variable name
|
|
variable path
|
|
variable lsc
|
|
|
|
lsc_init 372
|
|
prop mode_remote 1
|
|
prop mode_local 0
|
|
prop remote 0
|
|
prop idn empty
|
|
prop first_curveno 21
|
|
prop last_curveno 59
|
|
prop max_query 1
|
|
|
|
obj lsc372 rd -int
|
|
prop label "scan channel"
|
|
prop channels ""
|
|
prop read lsc::getT
|
|
prop lastupdate 0
|
|
prop lastchange 0
|
|
poll 1 read read
|
|
hsetprop $node/send write lsc::startSend
|
|
set prescript {
|
|
node autoscan out -int
|
|
prop enum 1
|
|
prop write lsc::writeAutoscan370
|
|
default 1
|
|
|
|
kids "common scan settings" {
|
|
node synchronized -int par 0
|
|
prop enum 1
|
|
|
|
node interval out -text
|
|
prop check lsc::checkCommon interval
|
|
prop write stdSct::complete
|
|
default 10
|
|
|
|
node pause out -text
|
|
prop check lsc::checkCommon pause
|
|
prop write stdSct::complete
|
|
default 3
|
|
|
|
node dwell out -text
|
|
prop check lsc::checkCommon dwell
|
|
prop write stdSct::complete
|
|
default 1
|
|
|
|
}
|
|
}
|
|
set cfg "$prescript\n$cfgscript"
|
|
kids "$name (LakeShore 372)" $cfg
|
|
lsc_display 0 S
|
|
|
|
# node outpulse out
|
|
# prop write lsc::outpulse370
|
|
|
|
# for compatibility we configure the analog output anyway
|
|
# may be removed when DIL sticks are configured properly
|
|
if {![info exists lsc(analog_maxuser)]} {
|
|
set lsc(analog_maxuser) 100
|
|
set lsc(analog_maxvolt) 10
|
|
}
|
|
node analog2 wr
|
|
prop write lsc::analog2_370
|
|
prop read lsc::analog2rd_370
|
|
prop maxvolt $lsc(analog_maxvolt)
|
|
prop maxuser $lsc(analog_maxuser)
|
|
|
|
node remote rd
|
|
prop read lsc::readremote
|
|
prop enum 1
|
|
$ctrl poll $node 10 slow lsc::remoteoff
|
|
|
|
lsc_end
|
|
|
|
return "LakeShore Model 372"
|
|
}
|
|
|
|
proc stdConfig::335_lsc {cfgscript} {
|
|
variable ctrl
|
|
variable node
|
|
variable path
|
|
variable lsc_run 0
|
|
variable name
|
|
|
|
# Model 335 has no RS232 and no LAN -> we must use GPIB
|
|
lsc_init 335 "\n++read eoi\n"
|
|
prop mode_remote 1
|
|
prop mode_local 0
|
|
prop remote 0
|
|
prop idn empty
|
|
prop first_curveno 21
|
|
prop last_curveno 59
|
|
prop max_query 1
|
|
|
|
obj lsc335 wr -drive
|
|
tdrive settings -getcmd 0 -setcmd set -log 1 -dbl 1 -limitscript "lsc::checklimit $path"
|
|
prop channels ""
|
|
prop label "set T"
|
|
poll 1 read lsc::getT
|
|
hsetprop $node/send write lsc::startSend
|
|
|
|
set cfg "$cfgscript"
|
|
kids "temperature (LakeShore 335)" $cfg
|
|
lsc_end
|
|
|
|
node remote rd
|
|
prop read lsc::readremote
|
|
prop enum 1
|
|
$ctrl poll $node 10 slow lsc::remoteoff
|
|
|
|
return "LakeShore Model 335"
|
|
}
|
|
|
|
proc stdConfig::336_lsc {cfgscript {all_chan ""}} {
|
|
variable ctrl
|
|
variable node
|
|
variable path
|
|
variable lsc_run 0
|
|
variable name
|
|
|
|
lsc_init 336
|
|
prop mode_remote 1
|
|
prop mode_local 0
|
|
prop remote 0
|
|
prop idn empty
|
|
prop first_curveno 21
|
|
prop last_curveno 59
|
|
prop max_query 1
|
|
|
|
obj lsc336 wr -drive
|
|
tdrive settings -getcmd 0 -setcmd set -log 1 -dbl 1 -limitscript "lsc::checklimit $path"
|
|
prop channels ""
|
|
prop label "set T"
|
|
if {$all_chan ne ""} {
|
|
prop all_chan $all_chan
|
|
}
|
|
poll 1 read lsc::getT
|
|
hsetprop $node/send write lsc::startSend
|
|
|
|
set cfg "$cfgscript"
|
|
kids "temperature (LakeShore 336)" $cfg
|
|
lsc_end
|
|
|
|
node remote rd
|
|
prop read lsc::readremote
|
|
prop enum 1
|
|
$ctrl poll $node 10 slow lsc::remoteoff
|
|
return "LakeShore Model 336"
|
|
}
|
|
|
|
proc stdConfig::350_lsc {cfgscript} {
|
|
variable ctrl
|
|
variable node
|
|
variable path
|
|
variable lsc_run 0
|
|
variable name
|
|
|
|
lsc_init 350
|
|
prop mode_remote 1
|
|
prop mode_local 0
|
|
prop remote 0
|
|
prop idn empty
|
|
prop first_curveno 21
|
|
prop last_curveno 59
|
|
prop max_query 1
|
|
|
|
obj lsc350 wr -drive
|
|
# used mainly for heliox -> no double control
|
|
tdrive settings -getcmd 0 -setcmd set -log 1 -dbl 0 -limitscript "lsc::checklimit $path"
|
|
prop channels ""
|
|
prop label "set T"
|
|
poll 1 read lsc::getT
|
|
hsetprop $node/send write lsc::startSend
|
|
|
|
set cfg "$cfgscript"
|
|
kids "temperature (LakeShore 350)" $cfg
|
|
lsc_end
|
|
|
|
node remote rd
|
|
prop read lsc::readremote
|
|
prop enum 1
|
|
$ctrl poll $node 10 slow lsc::remoteoff
|
|
return "LakeShore Model 350"
|
|
}
|
|
|
|
proc stdConfig::224_lsc {cfgscript} {
|
|
variable ctrl
|
|
variable node
|
|
variable path
|
|
variable lsc_run 0
|
|
variable name
|
|
|
|
lsc_init 224
|
|
prop mode_remote 1
|
|
prop mode_local 0
|
|
prop remote 0
|
|
prop idn empty
|
|
prop first_curveno 21
|
|
prop last_curveno 59
|
|
prop max_query 1
|
|
|
|
obj lsc224 upd -none
|
|
prop channels ""
|
|
poll 1 read lsc::getT
|
|
hsetprop $node/send write lsc::startSend
|
|
|
|
set cfg "$cfgscript"
|
|
kids "temperature (LakeShore 224)" $cfg
|
|
lsc_end
|
|
|
|
node relay1 wr -text
|
|
prop help "may be 0,1,A,B,C,D for on,off or alarm channel"
|
|
prop relaynr 1
|
|
prop write lsc::check224relay
|
|
prop write lsc::write224relay
|
|
prop read lsc::read224relay
|
|
|
|
node relay2 wr -text
|
|
prop help "may be 0,1,A,B,C,D for on,off or alarm channel"
|
|
prop relaynr 2
|
|
prop write lsc::check224relay
|
|
prop write lsc::write224relay
|
|
prop read lsc::read224relay
|
|
|
|
node remote rd
|
|
prop read lsc::readremote
|
|
prop enum 1
|
|
$ctrl poll $node 10 slow lsc::remoteoff
|
|
|
|
return "LakeShore Model 224"
|
|
}
|
|
|
|
#config script (end)
|
|
proc stdConfig::lsc_end {} {
|
|
variable lsc
|
|
variable node
|
|
variable path
|
|
variable ctrl
|
|
|
|
node display out -text
|
|
# prop visible false
|
|
prop write lsc::set_display
|
|
prop width 32
|
|
hset $node [join $lsc(display) ,]
|
|
|
|
if {$lsc(mainsensor) eq ""} {
|
|
if {$lsc(firstsensor) eq ""} {
|
|
error "no sensor defined"
|
|
}
|
|
set lsc(mainsensor) $lsc(firstsensor)
|
|
}
|
|
if {$lsc(samplesensor) eq ""} {
|
|
set lsc(samplesensor) $lsc(mainsensor)
|
|
}
|
|
dolater 0 fix_stick_sensors
|
|
hsetprop $path getcmd "hvali $path/$lsc(mainsensor)"
|
|
hsetprop $path getsample "hvali $path/$lsc(samplesensor)"
|
|
if {[silent "" set lsc(setsample)] ne ""} {
|
|
hsetprop $path setsample $lsc(setsample)
|
|
}
|
|
|
|
if {$lsc(mainsensor) eq $lsc(samplesensor)} {
|
|
catch {
|
|
hsetprop $path/dblctrl visible false
|
|
hdelprop $path/dblctrl group
|
|
}
|
|
}
|
|
|
|
# disable unused channels
|
|
set disableCmd [list]
|
|
if {$lsc(model) eq "370"} {
|
|
foreach chan {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16} {
|
|
set chanpath [silent "" hgetpropval $path channel_$chan]
|
|
if {[sctval $chanpath/curve undefined] eq "undefined" } {
|
|
lappend disableCmd "INSET $chan,0,1,3,0,1"
|
|
}
|
|
}
|
|
} elseif {$lsc(model) eq "340"} {
|
|
foreach chan {A B C D} {
|
|
set chanpath [silent "" hgetpropval $path channel_$chan]
|
|
if {[sctval $chanpath/curve undefined] eq "undefined" } {
|
|
lappend disableCmd "INSET $chan,0,1"
|
|
lappend disableCmd "ALARM $chan,0,1,1e5,-1e5,0,0"
|
|
}
|
|
}
|
|
} elseif {$lsc(model) eq "336" || $lsc(model) eq "350"} {
|
|
clientlog "ALL_CHAN/$path [silent {A B C D} hgetpropval $path all_chan]"
|
|
foreach chan [silent {A B C D} hgetpropval $path all_chan] {
|
|
set chanpath [silent "" hgetpropval $path channel_$chan]
|
|
if {[sctval $chanpath/curve undefined] eq "undefined" } {
|
|
lappend disableCmd "INTYPE $chan,0,0,1,0,1"
|
|
lappend disableCmd "ALARM $chan,0,3000,0,0,0,0,0"
|
|
lappend disableCmd "TLIMIT $chan,0"
|
|
}
|
|
}
|
|
} elseif {$lsc(model) eq "224"} {
|
|
foreach chan {A B C1 C2 C3 C4 C5 D1 D2 D3 D4 D5} {
|
|
set chanpath [silent "" hgetpropval $path channel_$chan]
|
|
if {[sctval $chanpath/curve undefined] eq "undefined" } {
|
|
lappend disableCmd "INTYPE $chan,0,0,1,0,1"
|
|
lappend disableCmd "ALARM $chan,0,3000,0,0,0,0,0"
|
|
}
|
|
}
|
|
} elseif {$lsc(model) eq "335"} {
|
|
foreach chan {A B} {
|
|
if {[silent "" hgetpropval $path channel_$chan] eq ""} {
|
|
lappend disableCmd "INTYPE $chan,0,0,1,0,1"
|
|
}
|
|
}
|
|
}
|
|
$ctrl queue $path write "lsc::sendMulti $disableCmd"
|
|
|
|
array unset lsc
|
|
}
|
|
|
|
proc lsc::sendMulti {args} {
|
|
sct send "[join [lrange $args 0 4] ";"];*OPC?"
|
|
set next [lrange $args 5 end]
|
|
if {$next eq ""} {
|
|
return stdSct::complete
|
|
}
|
|
return "lsc::sendMulti $next"
|
|
}
|
|
|
|
proc lsc::write340dio {} {
|
|
set bits [expr [sct target] & 31]
|
|
sct send "DOUT 3,$bits;DIOST?"
|
|
return lsc::read340dio
|
|
}
|
|
|
|
proc lsc::read340dio {} {
|
|
set now [DoubleTime]
|
|
if {$now > [silent $now sct reset_time]} {
|
|
sct target [silent 1 sct reset_value]
|
|
hdelprop [sct] reset_time
|
|
clientput "[silent dout sct reset_item] reset to [silent 1 sct reset_value]"
|
|
return lsc::write340dio
|
|
}
|
|
sct send "DIOST?"
|
|
return lsc::update340dio
|
|
}
|
|
|
|
proc lsc::update340dio {{detect 0}} {
|
|
stdSct::scanf "%d,%d" dinp dout
|
|
if {($dinp | 3) == ($dout | 3)} {
|
|
# may be the heater switch is plugged
|
|
if {$dout != 2 && $dout != 1} {
|
|
# check it deeply
|
|
set high [expr $dout & 28]
|
|
if {$detect == 0} {
|
|
if {$high == 4 || $high == 8 || $high == 16} {
|
|
set detect $high
|
|
}
|
|
}
|
|
foreach b {4 8 16} {
|
|
if {($b & $detect) == 0} {
|
|
clientput "check bit $b"
|
|
set detect [expr $b | $detect]
|
|
sct send "DOUT 3,[expr $b + ($dout & 3)];DIOST?"
|
|
return "lsc::detect340dio [expr $b | $detect]"
|
|
}
|
|
}
|
|
sct unknown_aux 0
|
|
clientput "digital io inconsistent for heat switch, switched to main heater"
|
|
sct send "DOUT 3,1;DIOST?"
|
|
return lsc::read340dio
|
|
}
|
|
} elseif {$dinp == 63} {
|
|
sct unknown_aux 0
|
|
} else {
|
|
if {[silent 0 sct unknown_aux] == 0} {
|
|
clientput "ERROR: unknown device plugged to auxiliary port"
|
|
sct unknown_aux 1
|
|
}
|
|
}
|
|
sct update $dout
|
|
updateval [sct parent]/dinp $dinp
|
|
return idle
|
|
}
|
|
|
|
proc lsc::detect340dio {bits} {
|
|
sct send "DIOST?"
|
|
return "lsc::update340dio $bits"
|
|
}
|
|
|
|
proc stdConfig::lsc_chk_end {} {
|
|
variable lsc
|
|
if {[info exists lsc(display)]} {
|
|
array unset lsc
|
|
error "lsc_end was not called"
|
|
}
|
|
}
|
|
|
|
proc lsc_config {code} {
|
|
namespace eval stdConfig $code
|
|
stdConfig::lsc_end
|
|
}
|