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 , 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 }