add archive (files probably no longer used)
here we can find old files
This commit is contained in:
l_samenv
47
tcl/archive/startup/Datafile.tcl
Normal file
47
tcl/archive/startup/Datafile.tcl
Normal file
@ -0,0 +1,47 @@
|
||||
######################################
|
||||
proc DataFile {fname dt criterium} {
|
||||
set fd [open $fname a]
|
||||
puts $fd "# Time Temp Curr Volt"
|
||||
puts $fd "# sec K pA V "
|
||||
|
||||
set t0 [clock clicks -milliseconds]
|
||||
set time [expr ([clock clicks -milliseconds] - $t0) * 0.001]
|
||||
set temp [result tt ts]
|
||||
set curr [result kth]
|
||||
set volt [result kth volt]
|
||||
set nr 0
|
||||
hsetprop tt updateperiod $dt
|
||||
while {[expr $criterium]} {
|
||||
|
||||
set time [expr ([clock clicks -milliseconds] - $t0) * 0.001]
|
||||
set temp [result tt ts]
|
||||
set curr [result kth]
|
||||
set volt [result kth volt]
|
||||
set nr [expr $nr + 1]
|
||||
|
||||
puts $fd "$time $temp $curr $volt"
|
||||
|
||||
if {$nr > 10 } {
|
||||
close $fd
|
||||
set nr 0
|
||||
set fd [open $fname a]
|
||||
}
|
||||
|
||||
wait $dt
|
||||
|
||||
|
||||
}
|
||||
clientput "...done!"
|
||||
close $fd
|
||||
hsetprop tt updateperiod 5
|
||||
|
||||
}
|
||||
|
||||
####################################
|
||||
##example
|
||||
#set fname "testfile.dat"
|
||||
#set dt 1
|
||||
#set criterium {$time < 8.0}
|
||||
|
||||
#DataFile $fname $dt $criterium
|
||||
###################################
|
||||
189
tcl/archive/startup/calib_ext.tcl
Normal file
189
tcl/archive/startup/calib_ext.tcl
Normal file
@ -0,0 +1,189 @@
|
||||
namespace eval calib {
|
||||
variable buf
|
||||
}
|
||||
|
||||
proc calib::next_temp {T} {
|
||||
variable buf
|
||||
|
||||
clientput "next_temp $T"
|
||||
tt tolerance [expr $T * 0.01]
|
||||
tt settle [expr $T + 60]
|
||||
run tt $T
|
||||
hsetprop /res @crit 0
|
||||
set buf(1) [list]
|
||||
set buf(2) [list]
|
||||
set buf(3) [list]
|
||||
set buf(4) [list]
|
||||
set buf(5) [list]
|
||||
set buf(6) [list]
|
||||
hsetprop /res @chanidx 0
|
||||
foreach channel [hgetpropval /res @channels] {
|
||||
hsetprop /res/s$channel/raw dif 1
|
||||
hsetprop /res/s$channel/raw endtime 0
|
||||
}
|
||||
}
|
||||
|
||||
proc calib::update_chan {value} {
|
||||
variable buf
|
||||
|
||||
if {[sct @crit] == 0} {
|
||||
if {[listexe] ne "Machine Idle"} {
|
||||
if {[hval /res/autoscan] == 0} {
|
||||
res autoscan 1
|
||||
}
|
||||
# stabilizing
|
||||
return
|
||||
}
|
||||
if {[result tt set] < 1.3 && [result tt set] > 311} {
|
||||
hepump valve 1
|
||||
hepump running 0
|
||||
calib::stop
|
||||
return
|
||||
}
|
||||
sct @crit 1
|
||||
res autoscan 0
|
||||
return
|
||||
}
|
||||
set i [sct @chanidx]
|
||||
set c [lindex [sct @channels] $i]
|
||||
if {$c != [sct @channel]} {
|
||||
if {$c != [hval /res]} {
|
||||
res s$c/active 1
|
||||
}
|
||||
return
|
||||
}
|
||||
set time [format %.3f [expr [DoubleTime] - [sct @basetime]]]
|
||||
lappend buf($c) $value
|
||||
if {[llength $buf($c)] >= [sct count]} {
|
||||
set mean [expr [::tcl::mathop::+ {*}$buf($c)] / double([llength $buf($c)])]
|
||||
set sum2 0
|
||||
foreach r $buf($c) {
|
||||
set sum2 [expr $sum2 + pow($r - $mean, 2)]
|
||||
}
|
||||
sct sigma [expr sqrt($sum2) / double([llength $buf($c)])]
|
||||
set buf($c) [list]
|
||||
set lastmean [sct lastmean]
|
||||
sct lastmean $mean
|
||||
set endtime [silent 0 sct endtime]
|
||||
if {$endtime > 0} {
|
||||
set interval [expr abs($time - $endtime) / 60.0]
|
||||
sct dif [expr (($mean - $lastmean) / double($mean)) / $interval]
|
||||
} else {
|
||||
sct dif 1
|
||||
}
|
||||
sct endtime $time
|
||||
clientput [format "time %.0f dif %.6f c %d interval %.2f R %.7g sigma %.7g" $time [sct dif] $c $interval $mean [sct sigma]]
|
||||
if {$c == [sct @calchan]} {
|
||||
set lastchan [lindex [sct @channels] [expr $i - 1]]
|
||||
hsetprop res/s$lastchan/raw refvalue [expr 0.5 * ($lastmean + $mean)]
|
||||
set maxdif 0
|
||||
foreach channel [sct @channels] {
|
||||
set dif [hgetpropval /res/s$channel/raw dif]
|
||||
if {abs($dif) > abs($maxdif)} {
|
||||
set maxdif $dif
|
||||
}
|
||||
}
|
||||
clientput "maxdif$i $maxdif"
|
||||
set save [sct @crit]
|
||||
if {$save == 1} {
|
||||
if {abs($maxdif) <= [sct @crit1]} {
|
||||
sct @nextsave $i
|
||||
sct @crit 2
|
||||
} else {
|
||||
set save 0
|
||||
}
|
||||
} else {
|
||||
if {$i == [sct @nextsave]} {
|
||||
sct @crit [expr $save + 1]
|
||||
} else {
|
||||
set save 0
|
||||
}
|
||||
}
|
||||
if {$save > 0} {
|
||||
catch {
|
||||
foreach channel [sct @channels] {
|
||||
if {$channel != [sct @calchan]} {
|
||||
set v [hgetpropval res/s$channel/raw lastmean]
|
||||
set rv [hgetpropval res/s$channel/raw refvalue]
|
||||
set sigma [hgetpropval res/s$channel/raw sigma]
|
||||
set endtime [hgetpropval res/s$channel/raw endtime]
|
||||
set fil [open [format [sct @basename] $save $channel] a]
|
||||
puts $fil [format "%.2f %.9g %.9g %.9g" $endtime $rv $v $sigma]
|
||||
close $fil
|
||||
}
|
||||
}
|
||||
} msg
|
||||
clientput SAVE/$save/$msg
|
||||
if {$save >= 3} {
|
||||
# finish T
|
||||
# next_temp [format %.3g [expr [result tt set] * 0.8912]]
|
||||
next_temp [format %.3g [expr [result tt set] * 1.778]]
|
||||
}
|
||||
}
|
||||
}
|
||||
incr i
|
||||
if {$i >= [llength [sct @channels]]} {
|
||||
set i 0
|
||||
}
|
||||
sct @chanidx $i
|
||||
res s[lindex [sct @channels] $i]/active 1
|
||||
}
|
||||
}
|
||||
|
||||
proc calib::set_chan {channel} {
|
||||
_res updatescript /res/s$channel/raw calib::update_chan
|
||||
hsetprop /res/s$channel/raw count 10
|
||||
hsetprop /res/s$channel/raw lastmean 0
|
||||
hsetprop /res/s$channel/raw dif 1
|
||||
}
|
||||
|
||||
proc calib::set_calchan {channel} {
|
||||
_res updatescript /res/s$channel/raw calib::update_chan
|
||||
hsetprop /res/s$channel/raw count 5
|
||||
hsetprop /res/s$channel/raw lastmean 0
|
||||
hsetprop /res/s$channel/raw dif 1
|
||||
}
|
||||
|
||||
proc calib::start {T args} {
|
||||
set calchan [lindex $args 0]
|
||||
|
||||
hsetprop /res @basetime [expr int([DoubleTime]/10) * 10]
|
||||
hsetprop /res @calchan $calchan
|
||||
hsetprop /res @chanidx 0
|
||||
hsetprop /res @crit 0
|
||||
# rel change / minute
|
||||
hsetprop /res @crit1 0.0005
|
||||
hsetprop /res @nextsave 0
|
||||
set_calchan $calchan
|
||||
set chanlist [list]
|
||||
foreach channel $args {
|
||||
if {$channel != $calchan} {
|
||||
set_chan $channel
|
||||
lappend chanlist $channel
|
||||
lappend chanlist $calchan
|
||||
}
|
||||
}
|
||||
hsetprop /res @channels $chanlist
|
||||
res autoscan 0
|
||||
hsetprop /res @basename "calib[clock format [clock seconds] -format "%Y-%m-%d"]_c%s_chan%s.dat"
|
||||
res s$calchan/active 1
|
||||
next_temp $T
|
||||
nv autoflow/getTemp calib::tmts
|
||||
}
|
||||
|
||||
proc calib::stop {} {
|
||||
foreach channel {1 2 3 4 5 6} {
|
||||
_res killupdatescript /res/s$channel/raw calib::update_chan
|
||||
}
|
||||
}
|
||||
|
||||
proc calib::tmts {} {
|
||||
set tm [silent 1 result tt tm]
|
||||
set ts [silent $tm hval /res/s[hgetpropval /res @calchan]]
|
||||
if {$ts < $tm} {
|
||||
return $ts
|
||||
} else {
|
||||
return $tm
|
||||
}
|
||||
}
|
||||
|
||||
82
tcl/archive/startup/ihelium3.tcl
Normal file
82
tcl/archive/startup/ihelium3.tcl
Normal file
@ -0,0 +1,82 @@
|
||||
proc ihelium3_chebychev {coef z} {
|
||||
# coef: Zu Zl a0 a1 a2 ...
|
||||
set a2_n [lassign $coef zu zl a0 a1]
|
||||
set x [expr (($z - $zl) - ($zu - $z)) / double($zu - $zl)]
|
||||
set tn_2 1
|
||||
set tn_1 $x
|
||||
set y [expr $a0 * 0.5 + $a1 * $x]
|
||||
lappend conv $y
|
||||
foreach an $a2_n {
|
||||
set tn [expr 2 * $x * $tn_1 - $tn_2]
|
||||
set y [expr $y + $an * $tn]
|
||||
lappend conv $y
|
||||
set tn_2 $tn_1
|
||||
set tn_1 $tn
|
||||
}
|
||||
# clientput "zl=$zl zu=$zu z=$z x=$x $conv"
|
||||
return $y
|
||||
}
|
||||
|
||||
proc ihelium3_calib {sensorno} {
|
||||
upvar #0 ihelium3_$sensorno cal
|
||||
|
||||
set fil [open calcurves/#CMP${sensorno}Coefftable.dat]
|
||||
foreach B {0 0.2 0.4 0.6 0.8 1 2 3 4 5 6 7} {
|
||||
set cal($B) [gets $fil]
|
||||
}
|
||||
close $fil
|
||||
|
||||
set fil [open calcurves/#CMP${sensorno}HT_Coeff.dat]
|
||||
set c [list]
|
||||
while {[gets $fil line] >= 0} {
|
||||
if {[string index $line 0] ne "#"} {
|
||||
lappend c [string trim $line]
|
||||
}
|
||||
}
|
||||
close $fil
|
||||
set cal(HT) $c
|
||||
}
|
||||
|
||||
proc ihelium3_res2temp {sensorno B R} {
|
||||
upvar #0 ihelium3_$sensorno cal
|
||||
|
||||
set r [expr log10($R)]
|
||||
# clientput r=$r
|
||||
if {$r < [lindex $cal(0) 1]} {
|
||||
set t [ihelium3_chebychev $cal(HT) $r]
|
||||
} else {
|
||||
set B [expr abs($B)]
|
||||
if {$B >= 7} {
|
||||
set B0 6
|
||||
set B1 7
|
||||
set w 1
|
||||
} else {
|
||||
if {$B >= 1} {
|
||||
set B0 [expr int($B)]
|
||||
set B1 [expr $B0 + 1]
|
||||
} else {
|
||||
set B0 [format %g [expr int($B * 5) * 0.2]]
|
||||
set B1 [format %g [expr $B0 + 0.2]]
|
||||
}
|
||||
set w [expr (sqrt($B) - sqrt($B0)) / (sqrt($B1) - sqrt($B0))]
|
||||
}
|
||||
set t0 [ihelium3_chebychev $cal($B0) $r]
|
||||
set t1 [ihelium3_chebychev $cal($B1) $r]
|
||||
set t [expr (1 - $w) * $t0 + $w * $t1]
|
||||
}
|
||||
return [expr pow(10, $t)]
|
||||
}
|
||||
|
||||
proc ihelium3_tab {sensorno r} {
|
||||
foreach B {0 0.2 0.4 0.6 0.8 1 2 3 4 5 6 7} {
|
||||
set T [list $B]
|
||||
foreach R $r {
|
||||
set tt [ihelium3_res2temp $sensorno $B $R]
|
||||
if {$tt < 0.4} {
|
||||
break
|
||||
}
|
||||
lappend T $tt
|
||||
}
|
||||
clientput $T
|
||||
}
|
||||
}
|
||||
7
tcl/archive/startup/istartup.tcl
Normal file
7
tcl/archive/startup/istartup.tcl
Normal file
@ -0,0 +1,7 @@
|
||||
set instr [result instrument]
|
||||
if {[file exists istartup/${instr}.tcl]} {
|
||||
exe istartup/${instr}.tcl
|
||||
}
|
||||
if {[file exists istartup/${instr}_delayed.tcl]} {
|
||||
dolater 5 exe istartup/${instr}_delayed.tcl
|
||||
}
|
||||
56
tcl/archive/startup/mpms.tcl
Normal file
56
tcl/archive/startup/mpms.tcl
Normal file
@ -0,0 +1,56 @@
|
||||
#
|
||||
# Usage:
|
||||
#
|
||||
# mpms wait [<timeout> [<interval>]]
|
||||
#
|
||||
# wait for mpms script and return file content
|
||||
# timeout is a week by default, interval 1 second
|
||||
#
|
||||
# set text [mpms wait]
|
||||
#
|
||||
# alternative usage (polling):
|
||||
#
|
||||
# while {[mpms wait 1] ne ""} {
|
||||
# DO SOMETHING
|
||||
# }
|
||||
# set text [mpms wait]
|
||||
#
|
||||
# mpms continue
|
||||
#
|
||||
# continue mpms script (deleting the file)
|
||||
#
|
||||
|
||||
proc mpms {command {timeout 600000} {interval 1}} {
|
||||
global env
|
||||
|
||||
set path $env(HOME)/MPMS/ReqToExt.txt
|
||||
switch -- $command {
|
||||
wait {
|
||||
set start [DoubleTime]
|
||||
while 1 {
|
||||
if {[file exists $path]} {
|
||||
set fil [open $path r]
|
||||
set contents [read -nonewline $fil]
|
||||
close $fil
|
||||
return $contents
|
||||
}
|
||||
if {[DoubleTime] >= $start + $timeout} {
|
||||
return ""
|
||||
}
|
||||
wait $interval
|
||||
}
|
||||
}
|
||||
continue {
|
||||
if {[file exists $path]} {
|
||||
file delete $path
|
||||
return 1
|
||||
}
|
||||
return 0
|
||||
}
|
||||
default {
|
||||
error "what is $command ?"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
publishLazy mpms
|
||||
199
tcl/archive/startup/n2fill.tcl
Normal file
199
tcl/archive/startup/n2fill.tcl
Normal file
@ -0,0 +1,199 @@
|
||||
#
|
||||
# Automatic N2 refill
|
||||
#
|
||||
# watching state (2):
|
||||
# if lower sensor falls below startvalue for more than startdelay seconds,
|
||||
# start fill, go to fillstart state (3)
|
||||
# fillstart state (3):
|
||||
# wait fillmini seconds, then go to filling state
|
||||
# filling state (4):
|
||||
# if upper sensor goes beyond fillvalue for more than filldelay seconds,
|
||||
# stip fill, go to quiet state (1)
|
||||
# quiet state (1):
|
||||
# wait stopmini seconds, then go to watching state (2)
|
||||
|
||||
proc makeN2fill {} {
|
||||
makeobject n2fillPar array logged
|
||||
n2fillPar makeitem state 0
|
||||
n2fillPar makeitem lower "tt tm"
|
||||
n2fillPar makeitem upper "tt ts"
|
||||
n2fillPar makeitem startvalue 100
|
||||
n2fillPar makeitem stopvalue 100
|
||||
n2fillPar makeitem lasttime 0
|
||||
n2fillPar makeitem lastcron 0
|
||||
n2fillPar makeitem startdelay 10
|
||||
n2fillPar makeitem stopdelay 5
|
||||
n2fillPar makeitem fillmini 10
|
||||
n2fillPar makeitem stopmini 60
|
||||
n2fillPar makeitem instance 0
|
||||
n2fillPar makeitem errcnt 0
|
||||
obj_list makeitem n2fillPar "LN2 refill parameters"
|
||||
Layout n2fill
|
||||
}
|
||||
|
||||
proc n2fillLayout args {
|
||||
Group n2fill "LN2 refill"
|
||||
}
|
||||
|
||||
proc n2fillGroup args {
|
||||
showStatus n2fill
|
||||
RadioGroup n2fill
|
||||
Label "LN2 refill"
|
||||
NoNewline
|
||||
CheckBox active "n2fill on"
|
||||
if {[result n2fill on]} {
|
||||
NoNewline
|
||||
CheckBox fill "n2fill fill"
|
||||
}
|
||||
NoNewline
|
||||
Label "state: [result n2fill]"
|
||||
Newline
|
||||
Tip "upper sensor parameter name"
|
||||
Input "upper sensor" "n2fillPar upper"
|
||||
Tip "lower sensor parameter name"
|
||||
Input "lower sensor" "n2fillPar lower"
|
||||
Newline
|
||||
Tip "switch-off value on upper sensor"
|
||||
Input "stop value" "n2fillPar stopvalue"
|
||||
Tip "switch-on value on lower sensor"
|
||||
Input "start value" "n2fillPar startvalue"
|
||||
Newline
|
||||
Input "start delay" "n2fillPar startdelay"
|
||||
Input "stop delay" "n2fillPar stopdelay"
|
||||
Newline
|
||||
Tip "minimum switch-on time"
|
||||
Input "minimum fill time" "n2fillPar fillmini"
|
||||
Tip "minimum switch-off time"
|
||||
Input "minimum stop time" "n2fillPar stopmini"
|
||||
Newline
|
||||
}
|
||||
|
||||
proc n2state {state} {
|
||||
n2fillPar lasttime [clock seconds]
|
||||
if {$state > 2} {
|
||||
clientput "valve ON"
|
||||
tt send relay 2:2,1
|
||||
} else {
|
||||
clientput "valve OFF"
|
||||
tt send relay 2:2,0
|
||||
}
|
||||
n2fillPar state $state
|
||||
}
|
||||
|
||||
proc n2fill {{action none} {value none}} {
|
||||
set now [clock seconds]
|
||||
set lasttime [result n2fillPar lasttime]
|
||||
set uval [result eval [result n2fillPar upper]]
|
||||
set lval [result eval [result n2fillPar lower]]
|
||||
set state [result n2fillPar state]
|
||||
set errcnt [result n2fillPar errcnt]
|
||||
switch -- $action {
|
||||
none {
|
||||
switch -- $state {
|
||||
0 { return "n2fill = off (0)" }
|
||||
1 { return "n2fill = quiet (1)" }
|
||||
2 { return "n2fill = watching (2)" }
|
||||
3 { return "n2fill = fillstart (3)" }
|
||||
4 { return "n2fill = filling (4)" }
|
||||
}
|
||||
}
|
||||
cron {
|
||||
n2fillPar lastcron $now
|
||||
if {$value != [result n2fillPar instance]} {
|
||||
n2state 0
|
||||
error "n2fill instance $value stopped"
|
||||
}
|
||||
if {$uval < 420 && $uval > 65 && $lval < 420 && $lval > 65} {
|
||||
n2fillPar errcnt 0
|
||||
} else {
|
||||
incr errcnt
|
||||
if {$errcnt >= 5} {
|
||||
n2state 0
|
||||
error "illegal upper ($uval) or lower ($lval) temperature"
|
||||
}
|
||||
n2fillPar errcnt $errcnt
|
||||
return
|
||||
}
|
||||
switch -- $state {
|
||||
3 {
|
||||
if {$now > $lasttime + [result n2fillPar fillmini]} {
|
||||
n2state 4
|
||||
}
|
||||
}
|
||||
4 {
|
||||
if {$uval < [result n2fillPar stopvalue]} {
|
||||
if {$now > $lasttime + [result n2fillpar stopdelay]} {
|
||||
n2state 1
|
||||
}
|
||||
} else {
|
||||
n2fillpar lasttime $now
|
||||
}
|
||||
}
|
||||
1 {
|
||||
if {$now > $lasttime + [result n2fillPar stopmini]} {
|
||||
n2state 2
|
||||
}
|
||||
}
|
||||
2 {
|
||||
if {$lval > [result n2fillPar startvalue] && $lval < 250} {
|
||||
if {$now > $lasttime + [result n2fillpar startdelay]} {
|
||||
n2state 3
|
||||
}
|
||||
} else {
|
||||
n2fillpar lasttime $now
|
||||
}
|
||||
}
|
||||
default {
|
||||
error "n2fill stopped with state $state"
|
||||
}
|
||||
}
|
||||
}
|
||||
on {
|
||||
switch -- $value {
|
||||
1 {
|
||||
set instance [result n2fillPar instance]
|
||||
incr instance
|
||||
n2fillPar instance $instance
|
||||
sicscron 1 n2fill cron $instance
|
||||
n2state 2
|
||||
return "n2fill.on = 1"
|
||||
}
|
||||
0 {
|
||||
n2state 0
|
||||
return "n2fill.on = 0"
|
||||
}
|
||||
none {
|
||||
if {$now > [result n2fillPar lastcron] + 10} {
|
||||
return "n2fill.on = 0"
|
||||
}
|
||||
if {$state > 0} {
|
||||
return "n2fill.on = 1"
|
||||
} else {
|
||||
return "n2fill.on = 0"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
fill {
|
||||
switch -- $value {
|
||||
1 {
|
||||
n2state 4
|
||||
return "n2fill.fill = 1"
|
||||
}
|
||||
0 {
|
||||
n2state 2
|
||||
return "n2fill.fill = 1"
|
||||
}
|
||||
none {
|
||||
if {$state > 2} {
|
||||
return "n2fill.fill = 1"
|
||||
} else {
|
||||
return "n2fill.fill = 0"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
publishLazy n2fill spy
|
||||
33
tcl/archive/startup/nvstep.tcl
Normal file
33
tcl/archive/startup/nvstep.tcl
Normal file
@ -0,0 +1,33 @@
|
||||
namespace eval nvstep {
|
||||
}
|
||||
|
||||
proc nvstep::trans {value {val2 none}} {
|
||||
if {$value eq "inv"} {
|
||||
if {$val2 > 1.9} {
|
||||
return [expr $val2 * 100 - 180]
|
||||
}
|
||||
if {$val2 > 1.0} {
|
||||
return [expr 1.0 / (2 - $val2)]
|
||||
}
|
||||
return $val2
|
||||
}
|
||||
if {$val2 eq "none"} {
|
||||
if {$value > 10} {
|
||||
return [expr ($value + 180) * 0.01]
|
||||
}
|
||||
if {$value > 1} {
|
||||
return [expr 2 - 1.0 / $value]
|
||||
}
|
||||
return $value
|
||||
}
|
||||
error "illegal arguments: nvstep::trans $value $val2"
|
||||
}
|
||||
|
||||
proc nvstep::out {motpath {value none}} {
|
||||
if {$value eq "none"} {
|
||||
return [hvali $motpath]
|
||||
}
|
||||
if {[hgetpropval $motpath status] ne "run"} {
|
||||
hset $motpath $value
|
||||
}
|
||||
}
|
||||
434
tcl/archive/startup/secop.tcl
Normal file
434
tcl/archive/startup/secop.tcl
Normal file
@ -0,0 +1,434 @@
|
||||
namespace eval SECoP {} {
|
||||
}
|
||||
|
||||
proc SECoP::check_range {{low None} {high None}} {
|
||||
[sct controller] timeout 0.001
|
||||
if {$low ne "None" && [sct target] < $low} {
|
||||
error "value [sct target] must be >= $low"
|
||||
}
|
||||
if {$high ne "None" && [sct target] > $high} {
|
||||
error "value [sct target] must be <= $high"
|
||||
}
|
||||
}
|
||||
|
||||
proc SECoP::check_bool {} {
|
||||
[sct controller] timeout 0.001
|
||||
switch -- [string tolower [sct target]] {
|
||||
off - false - no - 0 - on - true - yes - 1 {
|
||||
return
|
||||
}
|
||||
}
|
||||
error "illegal value for boolean: [sct target]"
|
||||
}
|
||||
|
||||
proc SECoP::check_length {{low None} {high None}} {
|
||||
if {$low ne "None" && [string length [sct target]] < $low} {
|
||||
error "value [sct target] must not be shorter than $low"
|
||||
}
|
||||
if {$high ne "None" && [string length [sct target]] > $high} {
|
||||
error "value [sct target] must not be longer than $high"
|
||||
}
|
||||
}
|
||||
|
||||
proc SECoP::make_par {secopar desc {kind ""}} {
|
||||
set path [topath $secopar [silent "" dict get $desc group]]
|
||||
array set props $desc
|
||||
set validator_args [lassign [silent "" set props(datatype)] secoptype0]
|
||||
if {$secoptype0 eq "tuple" && [string match *:status $secopar]} {
|
||||
lassign $validator_args elements
|
||||
make_par0 text ${path}_text $secopar $desc
|
||||
hsetprop ${path}_text width 24
|
||||
set validator_args [lassign [lindex $elements 0] secoptype]
|
||||
set status_node 1
|
||||
} else {
|
||||
set secoptype $secoptype0
|
||||
set status_node 0
|
||||
}
|
||||
switch -- $secoptype {
|
||||
double {set type float}
|
||||
int - enum {set type int}
|
||||
string {
|
||||
set type text
|
||||
# can not use SICS drivable for string
|
||||
set kind ""
|
||||
}
|
||||
bool {set type text}
|
||||
none {set type none}
|
||||
default {
|
||||
clientput "unknown type for $secopar (use text): $secoptype ($props(datatype))"
|
||||
set type text
|
||||
}
|
||||
}
|
||||
make_par0 $type $path $secopar $desc $kind
|
||||
hsetprop $path secoptype $secoptype0
|
||||
if {$status_node} {
|
||||
hsetprop $path nonewline 1
|
||||
}
|
||||
switch -- $secoptype {
|
||||
enum {
|
||||
set enumprop [list]
|
||||
set wid 8
|
||||
foreach {name value} [lindex $validator_args 0] {
|
||||
lappend enumprop "$name=$value"
|
||||
set wid [expr max($wid,[string length $name])]
|
||||
}
|
||||
hsetprop $path enum [join $enumprop ,]
|
||||
if {$wid > 8} {
|
||||
hsetprop $path width $wid
|
||||
}
|
||||
}
|
||||
bool {
|
||||
hsetprop $path enum 1
|
||||
hsetprop $path validator SECoP::check_bool
|
||||
}
|
||||
double - int {
|
||||
hsetprop $path validator [concat SECoP::check_range $validator_args]
|
||||
}
|
||||
string {
|
||||
hsetprop $path width 16
|
||||
hsetprop $path validator [concat SECoP::check_range $validator_args]
|
||||
}
|
||||
}
|
||||
return $path
|
||||
}
|
||||
|
||||
proc SECoP::make_par0 {type path secopar desc {kind std}} {
|
||||
array set props $desc
|
||||
# clientput "$path $desc"
|
||||
set readonly [silent 0 set props(readonly)]
|
||||
if {$readonly} {
|
||||
set priv internal
|
||||
} else {
|
||||
set priv user
|
||||
}
|
||||
if {[silent "" hinfo $path] ne ""} {
|
||||
error "$path exists already!"
|
||||
}
|
||||
lassign [split $path /] nul obj par
|
||||
if {$par eq ""} {
|
||||
if {$kind eq "driv"} {
|
||||
dynsctdriveobj $obj float user SECoP [sct controller]
|
||||
hfactory $path link $obj
|
||||
hsetprop $obj checklimits SECoP::checklimits
|
||||
hsetprop $obj halt SECoP::halt
|
||||
# allow start without run:
|
||||
hsetprop $obj check SECoP::checklimits
|
||||
hsetprop $obj write SECoP::complete_run
|
||||
set readonly 0
|
||||
hsetprop $obj sicscommand "run $obj"
|
||||
} else {
|
||||
# clientput "OBJ $obj $type"
|
||||
dynsicsobj $obj SECoP $priv $type
|
||||
hfactory $path link $obj
|
||||
}
|
||||
hsetprop $path group $obj
|
||||
hsetprop $path objectPath $path
|
||||
hsetprop /sics/[sct controller] p_$secopar:value $path
|
||||
} else {
|
||||
if {$par eq "status"} {
|
||||
set path /$obj/s_status
|
||||
}
|
||||
# clientput "PAR $path $type"
|
||||
hfactory $path plain $priv $type
|
||||
if {[info exists props(visibility)]} {
|
||||
if {$props(visibility) >= 3} {
|
||||
hsetprop $path visible false
|
||||
}
|
||||
}
|
||||
}
|
||||
hsetprop $path secopar $secopar
|
||||
hsetprop /sics/[sct controller] p_$secopar $path
|
||||
if {!$readonly} {
|
||||
[sct controller] write $path
|
||||
} else {
|
||||
[sct controller] connect $path
|
||||
}
|
||||
logsetup $path 1
|
||||
if {[info exists props(value)]} {
|
||||
clientput "VALUE in descr $path"
|
||||
if {[catch {hupdate /$path $props(value)} msg]} {
|
||||
clientput $msg
|
||||
}
|
||||
unset props(value)
|
||||
}
|
||||
set fmtunit ""
|
||||
if {[info exists props(unit)]} {
|
||||
set fmtunit [format { [%s]} $props(unit)]
|
||||
if {$par eq "" || $par eq "target"} {
|
||||
if {[sct shownUnits] eq "ALL" || [lsearch [sct shownUnits] $props(unit)] >= 0} {
|
||||
GraphAdd $path $props(unit) [join [lrange [split $path /] 1 end] .]
|
||||
}
|
||||
}
|
||||
}
|
||||
if {[info exists props(description)]} {
|
||||
hsetprop $path help "$props(description)$fmtunit"
|
||||
unset props(description)
|
||||
}
|
||||
foreach {prop item} [array get props] {
|
||||
hsetprop $path s_$prop $item
|
||||
}
|
||||
}
|
||||
|
||||
proc SECoP::make_cmd {secopar desc {first 0}} {
|
||||
array set props $desc
|
||||
set path [topath $secopar [silent "" dict get $desc group]]
|
||||
set cmd [join [lassign [split $path /] _ obj] /]
|
||||
lassign [lindex [silent "" set props(datatype)] 1] secoptype validator
|
||||
if {$secoptype eq "None"} {
|
||||
$obj makescriptfunc $cmd "SECoP::check_cmd [sct secoppath] $secopar" user
|
||||
hsetprop $path newline $first
|
||||
hsetprop $path secopar $secopar
|
||||
hsetprop $path sicscommand "$obj $cmd"
|
||||
if {[info exists props(visibility)]} {
|
||||
if {$props(visibility) >= 3} {
|
||||
hsetprop $path visible false
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if {[llength $secoptype] == 1} {
|
||||
set secoptype [lindex $secoptype 0]
|
||||
}
|
||||
dict set desc datatype $secoptype
|
||||
make_par $secopar $desc
|
||||
lassign $secoptype maintype
|
||||
if {$maintype eq "double" || $maintype eq "int" || $maintype eq "bool"} {
|
||||
hsetprop $path check "SECoP::check_cmd_num [sct secoppath] $secopar"
|
||||
} else {
|
||||
hsetprop $path check "SECoP::check_cmd_text [sct secoppath] $secopar"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc SECoP::check_cmd {secoppath secopar} {
|
||||
hset $secoppath "do $secopar"
|
||||
}
|
||||
|
||||
proc SECoP::check_cmd_num {secoppath secopar} {
|
||||
hset $secoppath [format {do %s %.15g} $secopar [sct target]]
|
||||
sct update [sct target]
|
||||
}
|
||||
|
||||
proc SECoP::check_cmd_text {secoppath secopar} {
|
||||
hset $secoppath [format {do %s "%s"} $secopar [sct target]]
|
||||
sct update [sct target]
|
||||
}
|
||||
|
||||
proc SECoP::make_module {obj desc} {
|
||||
clientput "MAKE_MODULE $obj"
|
||||
if {[obj_list exists $obj]} {
|
||||
clientput "$obj exists already"
|
||||
return
|
||||
}
|
||||
obj_list makeitem $obj /$obj
|
||||
|
||||
array unset modprop
|
||||
set parlist [list]
|
||||
set pardict [dict create]
|
||||
foreach {key item} $desc {
|
||||
switch $key {
|
||||
accessibles {
|
||||
foreach acsitm $item {
|
||||
lassign $acsitm parname pardesc
|
||||
dict set pardict $parname $pardesc
|
||||
}
|
||||
}
|
||||
default {
|
||||
set modprop($key) $item
|
||||
}
|
||||
}
|
||||
}
|
||||
if {[dict exists $pardict value]} {
|
||||
set value [dict get $pardict value]
|
||||
dict unset pardict value
|
||||
} else {
|
||||
set value [dict create datatype none]
|
||||
}
|
||||
set classes [silent "" set modprop(interface_class)]
|
||||
if {[string match "* Drivable *" " $classes "]} {
|
||||
set path [make_par $obj $value driv]
|
||||
} else {
|
||||
set path [make_par $obj $value]
|
||||
}
|
||||
if {[info exists modprop(visibility)] && $modprop(visibility) >= 3} {
|
||||
hdelprop $path group
|
||||
}
|
||||
foreach {prop val} [array get modprop] {
|
||||
hsetprop $obj sm_$prop $val
|
||||
}
|
||||
device_layout makeitem /$obj [silent 0 set modprop(layoutpos)]
|
||||
|
||||
set groups [dict create]
|
||||
foreach {parname pardesc} $pardict {
|
||||
if {[dict exists $pardesc group]} {
|
||||
dict set groups [dict get $pardesc group] 1
|
||||
}
|
||||
}
|
||||
foreach g [dict keys $groups] {
|
||||
clientput "GROUP $g"
|
||||
hfactory $obj/$g plain user none
|
||||
hsetprop $obj/$g group "group $g"
|
||||
}
|
||||
set shortcmds [list]
|
||||
foreach {parname pardesc} $pardict {
|
||||
set datatype [dict get $pardesc datatype]
|
||||
if {[lindex $datatype 0] eq "command"} {
|
||||
if {[lindex $datatype 1] ne "None"} {
|
||||
# only commands with arguments
|
||||
make_cmd $obj:$parname $pardesc 1
|
||||
} else {
|
||||
lappend shortcmds $parname $pardesc
|
||||
}
|
||||
} else {
|
||||
make_par $obj:$parname $pardesc
|
||||
}
|
||||
}
|
||||
# then commands without arguments, on one line
|
||||
set first 1
|
||||
foreach {parname pardesc} $shortcmds {
|
||||
make_cmd $obj:$parname $pardesc $first
|
||||
set first 0
|
||||
}
|
||||
}
|
||||
|
||||
proc SECoP::make_node {desc} {
|
||||
array unset nodeprop
|
||||
set modlist [list]
|
||||
foreach {key item} $desc {
|
||||
switch $key {
|
||||
modules {
|
||||
set modlist $item
|
||||
}
|
||||
default {
|
||||
set nodeprop($key) $item
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach moditem $modlist {
|
||||
lassign $moditem modname moddesc
|
||||
make_module $modname $moddesc
|
||||
}
|
||||
foreach {prop val} [array get nodeprop] {
|
||||
sct sn_$prop $val
|
||||
}
|
||||
sort_layout
|
||||
}
|
||||
|
||||
proc SECoP::topath {secopar {pargroup ""}} {
|
||||
lassign [split [string tolower $secopar] :] module parameter
|
||||
if {$parameter eq "value" || $parameter eq ""} {
|
||||
return "/$module"
|
||||
}
|
||||
if {$parameter eq "status"} {
|
||||
set parameter s_status
|
||||
}
|
||||
if {[string match {_*} $parameter]} {
|
||||
set parameter [string range $parameter 1 end]
|
||||
}
|
||||
if {$pargroup ne ""} {
|
||||
return "/$module/$pargroup/$parameter"
|
||||
}
|
||||
return "/$module/$parameter"
|
||||
}
|
||||
|
||||
proc SECoP::msg_describing {secnode specifier val} {
|
||||
do_as_manager {
|
||||
make_node $val
|
||||
}
|
||||
$secnode activate
|
||||
}
|
||||
|
||||
proc SECoP::msg_changed {secnode par val} {
|
||||
variable sentto_$secnode
|
||||
if {[string match *:target $par]} {
|
||||
hsetprop /$obj writestatus done
|
||||
}
|
||||
hsetprop $path changed 0
|
||||
if {[lrange [set sentto_$secnode] 0 1] eq [list change $par]} {
|
||||
set message_to_client "change $par $val"
|
||||
}
|
||||
msg_update $secnode $par $val change
|
||||
}
|
||||
|
||||
proc SECoP::msg_update {secnode par val {action update}} {
|
||||
if {$action eq "update"} {
|
||||
if {[DoubleTime] < [silent 0 hgetpropval $path changed] + 10} {
|
||||
# ignore updates of variables during change
|
||||
# clientput "ignore [sct result]"
|
||||
return
|
||||
}
|
||||
if {[lrange $sent_message 0 1] eq [list read $par]} {
|
||||
set message_to_client "$action $par $val"
|
||||
}
|
||||
}
|
||||
lassign $val value qual
|
||||
if {[silent 0 hgetpropval $path secoptype] eq "tuple" &&
|
||||
[string match *:status $par]} {
|
||||
if {[llength $value] > 2} {
|
||||
set text_value [lrange $value 1 end]
|
||||
} else {
|
||||
set text_value [lindex $value 1]
|
||||
}
|
||||
set objpath [sct parent $path]
|
||||
set visible_old [silent true hgetpropval $objpath visible]
|
||||
if {$text_value ne "disabled"} {
|
||||
set visible_new true
|
||||
set shown 1
|
||||
} else {
|
||||
set visible_new false
|
||||
set shown 0
|
||||
}
|
||||
if {$visible_new ne $visible_old} {
|
||||
hsetprop $objpath visible $visible_new
|
||||
GraphItem shown $objpath $shown
|
||||
}
|
||||
lassign $value value
|
||||
if {[catch {updateval ${path}_text $text_value}]} {
|
||||
clientput "cannot update ${path}_text to $text_value"
|
||||
clientput "MSG($action $par $val)"
|
||||
}
|
||||
if {[string match *:status $par]} {
|
||||
if {[silent 0 hgetpropval /$obj writestatus] eq "start"} {
|
||||
set status run
|
||||
} elseif {[string match 3* $value]} {
|
||||
set status run
|
||||
} elseif {[string match 4* $value]} {
|
||||
set status posfault
|
||||
} else {
|
||||
set status idle
|
||||
}
|
||||
hsetprop /$obj status $status
|
||||
}
|
||||
}
|
||||
if {[catch {updateval $path $value} msg]} {
|
||||
if {$value eq "None"} {
|
||||
hsetprop $path geterror None
|
||||
} else {
|
||||
clientput "cannot update $path to $value"
|
||||
clientput $msg
|
||||
}
|
||||
} elseif {[string match *:target $par]} {
|
||||
# clientput [sct result]/[silent "" hgetpropval /$obj status]
|
||||
if {[silent "" hgetpropval /$obj status] eq "idle"} {
|
||||
hsetprop /$obj target $value
|
||||
}
|
||||
}
|
||||
catch {
|
||||
hsetprop $path timestamp [dict get $qual t]
|
||||
}
|
||||
}
|
||||
|
||||
proc SECoP::msg_pong {secnode args} {
|
||||
clientlog "pong $secnode $args"
|
||||
}
|
||||
|
||||
proc SECoP::msg_done {secnode args} {
|
||||
clientlog "done $secnode $args"
|
||||
}
|
||||
|
||||
proc SECoP::msg_active {secnode args} {
|
||||
clientlog "active $secnode $args"
|
||||
}
|
||||
|
||||
proc SECoP::msg_error {secnode args} {
|
||||
clientlog "error $secnode $args"
|
||||
}
|
||||
195
tcl/archive/startup/store.tcl
Normal file
195
tcl/archive/startup/store.tcl
Normal file
@ -0,0 +1,195 @@
|
||||
proc get_next_filename {} {
|
||||
set file [store file]
|
||||
set filepattern [file join [result exe batchpath] $file]
|
||||
set nameformat [string map "* [store numfmt]" $filepattern]
|
||||
if {$nameformat eq $filepattern} {
|
||||
# no * in filepattern
|
||||
if {![file exists $filepattern]} {
|
||||
# simple filename
|
||||
store path [file normalize $filepattern]
|
||||
return $filepattern
|
||||
}
|
||||
# insert * before . or at end
|
||||
set split [split $file .]
|
||||
if {[llength $split] == 1} {
|
||||
lappend split ""
|
||||
}
|
||||
set file [join [linsert $split end-1 *] .]
|
||||
store file $file
|
||||
set filepattern [file join [result exe batchpath] $file]
|
||||
set nameformat [string map "* [store numfmt]" $filepattern]
|
||||
set num 0
|
||||
store num 0
|
||||
} else {
|
||||
set num [store num]
|
||||
}
|
||||
set path [format $nameformat $num]
|
||||
if {$num == 0 || [file exists $path]} {
|
||||
# determine next num
|
||||
set n $num
|
||||
foreach p [glob -nocomplain $filepattern] {
|
||||
scan $p $nameformat n
|
||||
if {$n > $num} {
|
||||
set num $n
|
||||
}
|
||||
}
|
||||
incr num
|
||||
store num $num
|
||||
set path [format $nameformat $num]
|
||||
}
|
||||
store path [file normalize $path]
|
||||
return $path
|
||||
}
|
||||
|
||||
proc store {{command ""} args} {
|
||||
if {[sicsdescriptor store_array] ne "array"} {
|
||||
makeobject store_array array
|
||||
store_array makeitem numfmt %04d
|
||||
store_array makeitem file data.txt
|
||||
store_array makeitem path
|
||||
store_array makeitem vars
|
||||
store_array makeitem num 0
|
||||
}
|
||||
switch -- $command {
|
||||
open {
|
||||
store_array vars $args
|
||||
set f [open [get_next_filename] w]
|
||||
set i 1
|
||||
foreach var $args {
|
||||
puts $f [format "# col %d: %s (%s)" $i $var [GraphItem label $var]]
|
||||
incr i
|
||||
}
|
||||
close $f
|
||||
return "open [store path]"
|
||||
}
|
||||
put {
|
||||
set row [list]
|
||||
foreach var [split [store vars]] {
|
||||
lappend row [get_var_value $var]
|
||||
}
|
||||
set f [open [store path] a]
|
||||
puts $f [join $row "\t"]
|
||||
close $f
|
||||
}
|
||||
"" - list {
|
||||
set result [join {
|
||||
"store open <var1> <var2> ... # open file for storing named variables"
|
||||
"store put # write a row with values of variables"
|
||||
} "\n"]
|
||||
foreach key [store_array items] {
|
||||
append result "\nstore $key [result store_array $key]"
|
||||
}
|
||||
return $result
|
||||
}
|
||||
default {
|
||||
set l [llength $args]
|
||||
if {$l > 1} {
|
||||
error "Usage: store $command \[<$command>\]"
|
||||
}
|
||||
if {![store_array exists $command]} {
|
||||
error "what is 'store $command'?"
|
||||
}
|
||||
if {$l == 1} {
|
||||
if {$command eq "file" || $command eq "numfmt" } {
|
||||
store_array num 0
|
||||
}
|
||||
store_array $command $args
|
||||
}
|
||||
return "[result store_array $command]"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
namespace eval varscan {} {
|
||||
variable waittime 10
|
||||
variable cmd ""
|
||||
variable reltol 0
|
||||
variable digits 6
|
||||
|
||||
proc reltol {rel args} {
|
||||
variable reltol
|
||||
variable tolcmd
|
||||
|
||||
set reltol [expr abs($rel)]
|
||||
set tolcmd $args
|
||||
}
|
||||
|
||||
proc do {args} {
|
||||
variable waittime
|
||||
variable cmd
|
||||
variable last
|
||||
variable reltol
|
||||
variable tolcmd
|
||||
variable digits
|
||||
|
||||
foreach value $args {
|
||||
if {$reltol != 0} {
|
||||
eval "$tolcmd [format %.${digits}g [expr $reltol * $value]]"
|
||||
}
|
||||
set starttime [DoubleTime]
|
||||
clientput "$cmd $value"
|
||||
eval "$cmd $value"
|
||||
wait [expr max(0, $starttime + $waittime - [DoubleTime])]
|
||||
store put
|
||||
set last $value
|
||||
}
|
||||
}
|
||||
|
||||
proc linear {encode value} {
|
||||
return $value
|
||||
}
|
||||
|
||||
proc log {encode value} {
|
||||
variable digits
|
||||
if {$encode} {
|
||||
return [expr log10($value)]
|
||||
}
|
||||
return [format %.${digits}g [expr 10 ** $value]]
|
||||
}
|
||||
|
||||
proc dosteps {step endarg {func linear}} {
|
||||
variable last
|
||||
variable precision
|
||||
variable reltol
|
||||
variable digits
|
||||
|
||||
set end [$func 1 $endarg]
|
||||
set val [$func 1 $last]
|
||||
if {$end < $val} {
|
||||
set step [expr -abs($step)]
|
||||
} else {
|
||||
set step [expr abs($step)]
|
||||
}
|
||||
set precision [expr max(abs($step) * 0.1, $reltol)]
|
||||
set prec 0.1
|
||||
for {set digits 2} {$prec > $precision} {incr digits} {
|
||||
set prec [expr $prec * 0.1]
|
||||
}
|
||||
while 1 {
|
||||
set val [expr $val + $step]
|
||||
if {($end - $val) / $step < 0.5} {
|
||||
break
|
||||
}
|
||||
do [$func 0 $val]
|
||||
}
|
||||
do $endarg
|
||||
set digits 6
|
||||
}
|
||||
|
||||
proc waittime {wait} {
|
||||
variable waittime
|
||||
set waittime $wait
|
||||
}
|
||||
|
||||
proc command {args} {
|
||||
variable cmd
|
||||
set cmd $args
|
||||
}
|
||||
}
|
||||
|
||||
proc varscan {code} {
|
||||
namespace eval varscan $code
|
||||
}
|
||||
|
||||
publishLazy store
|
||||
publishLazy varscan
|
||||
Reference in New Issue
Block a user