366 lines
11 KiB
Tcl
366 lines
11 KiB
Tcl
# Helpers for OffLine data Acquisition
|
|
|
|
proc make_next_filename {} {
|
|
set file [hola file]
|
|
set filepattern [file join [result exe batchpath] $file]
|
|
set nameformat [string map "* [hola numfmt]" $filepattern]
|
|
if {$nameformat eq $filepattern} {
|
|
# no * in filepattern
|
|
if {![file exists $filepattern]} {
|
|
# simple filename
|
|
hola 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 *] .]
|
|
hola file $file
|
|
set filepattern [file join [result exe batchpath] $file]
|
|
set nameformat [string map "* [hola numfmt]" $filepattern]
|
|
set num 0
|
|
hola num 0
|
|
} else {
|
|
set num [hola 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
|
|
hola num $num
|
|
set path [format $nameformat $num]
|
|
}
|
|
hola path [file normalize $path]
|
|
return $path
|
|
}
|
|
|
|
proc hola_log_cvt {encode value} {
|
|
global hola_internal
|
|
variable digits
|
|
if {$encode} {
|
|
return [expr log10($value)]
|
|
}
|
|
return [expr 10 ** $value]
|
|
}
|
|
|
|
proc hola_get {var} {
|
|
global hola_internal
|
|
if {$var eq "soll"} {
|
|
set result $hola_internal(last)
|
|
} else {
|
|
set result [get_var_value $var]
|
|
}
|
|
catch {
|
|
set result [format %.14g $result]
|
|
}
|
|
if {$result eq ""} {
|
|
set result NaN
|
|
}
|
|
return $result
|
|
}
|
|
|
|
proc hola {{command ""} args} {
|
|
global hola_internal
|
|
# make sure scripts with endless loops do not block
|
|
wait 0
|
|
if {$command eq "reset"} {
|
|
silent 0 removeobject hola_desc
|
|
silent 0 removeobject hola_array
|
|
set command ""
|
|
}
|
|
set hola_version V2.2
|
|
if {[silent undef result hola_array version] ne $hola_version} {
|
|
if {[sicsdescriptor hola_array] eq "notfound"} {
|
|
makeobject hola_array array
|
|
}
|
|
if {[sicsdescriptor hola_desc] eq "notfound"} {
|
|
makeobject hola_desc array
|
|
}
|
|
hola_desc makeitem open "hola open <var1> <var2> ... \nopen file for storing named variables (use dot as separator)"
|
|
hola_desc makeitem store "hola store\nwrite a row with values of variables"
|
|
hola_desc makeitem vars "variables to store (readonly)"
|
|
hola_array makeitem vars soll
|
|
hola_desc makeitem file "base file name (readonly)"
|
|
hola_array makeitem file data.txt
|
|
hola_desc makeitem path "used file name (use 'exe batchpath' for subdirectory)"
|
|
hola_array makeitem path
|
|
hola_desc makeitem numfmt "format of file number"
|
|
hola_array makeitem numfmt %04d
|
|
hola_desc makeitem num "actually used file number"
|
|
hola_array makeitem num 0
|
|
hola_desc makeitem do "hola do <val1> <val2> <val3> ...\nmeasure single points"
|
|
hola_desc makeitem steps "hola steps <step> <endvalue>\nmeasure with steps, starting from last value"
|
|
hola_desc makeitem logsteps "hola logsteps <step> <endvalue>\nlogarithmic steps (base 10, a step of 1 is a factor 10)"
|
|
hola_desc makeitem command "command for changing scanned variable"
|
|
hola_array makeitem command "drive tt"
|
|
hola_desc makeitem reltol "value for relative tolerance (0: disabled)"
|
|
hola_array makeitem reltol 0
|
|
hola_desc makeitem tolcmd "command for setting tolerance"
|
|
hola_array makeitem tolcmd "tt tolerance"
|
|
hola_desc makeitem waittime "minimum time to wait (only used in special cases, use settletime else)"
|
|
hola_array makeitem waittime 1
|
|
hola_desc makeitem settletime "time to wait before measuring"
|
|
hola_array makeitem settletime 0
|
|
hola_desc makeitem measpars "measurement time for averaging (put to 0 for no averaging) and list of variables for calcualting stddev"
|
|
hola_array makeitem measpars 0
|
|
hola_desc makeitem pollperiod "minimum poll interval (identical values are not counted)"
|
|
hola_array makeitem pollperiod 0.1
|
|
hola_desc makeitem reset "hola reset\nreset to standard values"
|
|
hola_array makeitem version $hola_version
|
|
set hola_internal(last) 0
|
|
set hola_internal(digits) 6
|
|
}
|
|
switch -- $command {
|
|
open {
|
|
if {[lsearch $args soll] < 0} {
|
|
set args [concat soll $args]
|
|
}
|
|
hola_array vars $args
|
|
set sigmavars [lassign [hola measpars] measperiod]
|
|
set f [open [make_next_filename] w]
|
|
set i 1
|
|
foreach var $args {
|
|
if {$var eq "soll"} {
|
|
set desc "(desired value)"
|
|
} else {
|
|
set pvar /[join [split $var .] /]
|
|
set unit [GraphItem units $pvar]
|
|
if {$unit eq ""} {
|
|
set unit [GraphItem units $var]
|
|
set label [GraphItem label $var]
|
|
} else {
|
|
set label [GraphItem label $pvar]
|
|
}
|
|
set unit [lindex [split $unit _] 0]
|
|
set desc "($label/$unit)"
|
|
}
|
|
puts $f [format "# col %d: %s %s" $i $var $desc]
|
|
incr i
|
|
if {$measperiod > 0 && [lsearch $sigmavars $var] >= 0} {
|
|
puts $f [format "# col %d: sigma_%s" $i $var]
|
|
incr i
|
|
}
|
|
}
|
|
close $f
|
|
return "open [hola path]"
|
|
}
|
|
store {
|
|
set now [DoubleTime]
|
|
set starttime $now
|
|
set sigmavars [lassign [hola measpars] measperiod]
|
|
set row [list]
|
|
if {$measperiod == 0} {
|
|
foreach var [split [hola vars]] {
|
|
lappend row [hola_get $var]
|
|
}
|
|
} else {
|
|
foreach var [split [hola vars]] {
|
|
set data($var) [list [hola_get $var]]
|
|
}
|
|
set pollperiod [hola pollperiod]
|
|
set endwait $starttime
|
|
while {$now + $pollperiod < $starttime + $measperiod} {
|
|
set endwait [expr $endwait + $pollperiod]
|
|
wait [expr max(0,$endwait - $now)]
|
|
set now [DoubleTime]
|
|
foreach var [split [hola vars]] {
|
|
lappend data($var) [hola_get $var]
|
|
}
|
|
}
|
|
foreach var [split [hola vars]] {
|
|
set sample $data($var)
|
|
set n [expr double([llength $sample])]
|
|
if {[catch {
|
|
set mean [expr [eval [concat ::tcl::mathop::+ $sample]] / $n]
|
|
lappend row [format %.14g $mean]
|
|
}]} {
|
|
set mean NaN
|
|
lappend row NaN
|
|
}
|
|
if {[lsearch $sigmavars $var] >= 0} {
|
|
set ssum 0
|
|
set last -99e99
|
|
set cnt 0
|
|
if {$mean ne "NaN"} {
|
|
foreach s $sample {
|
|
set ssum [expr $ssum + ($s - $mean) ** 2]
|
|
if {$s != $last} {
|
|
set last $s
|
|
incr cnt
|
|
}
|
|
}
|
|
}
|
|
if {$cnt > 1} {
|
|
set sigma [expr sqrt($ssum / $n * $cnt / ($cnt - 1))]
|
|
} else {
|
|
set sigma 0
|
|
}
|
|
lappend row [format %.6g $sigma]
|
|
}
|
|
}
|
|
}
|
|
if {[hola path] eq ""} {
|
|
clientput "WRITE [join $row "\t"]"
|
|
} else {
|
|
set f [open [hola path] a]
|
|
puts $f [join $row "\t"]
|
|
close $f
|
|
}
|
|
}
|
|
store0 {
|
|
set row [list]
|
|
foreach var [split [hola vars]] {
|
|
lappend row [hola_get $var]
|
|
}
|
|
if {[hola path] eq ""} {
|
|
clientput "WRITE [join $row "\t"]"
|
|
} else {
|
|
set f [open [hola path] a]
|
|
puts $f [join $row "\t"]
|
|
close $f
|
|
}
|
|
}
|
|
do_internal {
|
|
if {[hola reltol] != 0} {
|
|
eval "[hola tolcmd] [format %.$hola_internal(digits)g [expr [hola reltol] * $args]]"
|
|
}
|
|
set starttime [DoubleTime]
|
|
set value [format %.$hola_internal(digits)g $args]
|
|
wait [hola settletime]
|
|
eval "[hola command] $value"
|
|
wait [expr max(0, $starttime + [hola waittime] - [DoubleTime])]
|
|
set hola_internal(last) $value
|
|
hola store
|
|
}
|
|
do {
|
|
set nargs 0
|
|
set todolist [list]
|
|
foreach value $args {
|
|
if {$nargs > 0} {
|
|
lappend todo $value
|
|
incr nargs -1
|
|
if {$nargs == 0} {
|
|
lappend todolist $todo
|
|
} elseif {$value == 0} {
|
|
error "step 0 is not allowed"
|
|
}
|
|
} elseif {[string first " $value " " steps logsteps "] >= 0} {
|
|
set todo [list hola $value]
|
|
set nargs 2
|
|
} else {
|
|
if {![string is double $value]} {
|
|
error "<number>, 'steps' or 'logsteps' expected, but got $value"
|
|
}
|
|
lappend todolist [list hola do_internal $value]
|
|
}
|
|
}
|
|
foreach cmd $todolist {
|
|
set hola_internal(digits) 15
|
|
eval $cmd
|
|
}
|
|
}
|
|
steps - logsteps {
|
|
if {[llength $args] != 2} {
|
|
error "Usage: hola $command <step> <end>"
|
|
}
|
|
lassign $args step end_value
|
|
set value $hola_internal(last)
|
|
if {$command eq "logsteps"} {
|
|
set end [hola_log_cvt 1 $end_value]
|
|
set value [hola_log_cvt 1 $value]
|
|
set precision [expr max(abs($step) * 0.4, [hola reltol])]
|
|
} else {
|
|
set end $end_value
|
|
set precision [expr min(abs($step)*0.1/max(abs($value),abs($end)), [hola reltol])]
|
|
}
|
|
if {$end < $value} {
|
|
set step [expr -abs($step)]
|
|
} else {
|
|
set step [expr abs($step)]
|
|
}
|
|
set prec 0.1
|
|
for {set digits 2} {$prec > $precision && $digits < 14} {incr digits} {
|
|
set prec [expr $prec * 0.1]
|
|
}
|
|
incr digits
|
|
set hola_internal(digits) $digits
|
|
while 1 {
|
|
set value [expr $value + $step]
|
|
if {($end - $value) / $step < 0.5} {
|
|
break
|
|
}
|
|
if {$command eq "logsteps"} {
|
|
hola do_internal [hola_log_cvt 0 $value]
|
|
} else {
|
|
hola do_internal $value
|
|
}
|
|
}
|
|
set hola_internal(digits) 15
|
|
hola do_internal $end_value
|
|
}
|
|
"" - list {
|
|
set result [list " replace \[<value>\] to set or omit to read a parameter\n"]
|
|
foreach key [hola_desc items] {
|
|
if {[hola_array exists $key]} {
|
|
set items [list "hola $key \[[result hola_array $key]\]" [result hola_desc $key]]
|
|
} else {
|
|
set items [split [result hola_desc $key] "\n"]
|
|
}
|
|
lappend result [join $items "\n "]
|
|
lappend result ""
|
|
}
|
|
return [join $result "\n"]
|
|
}
|
|
default {
|
|
set l [llength $args]
|
|
if {![hola_array exists $command]} {
|
|
error "what is 'hola $command'?"
|
|
}
|
|
if {$l > 0} {
|
|
if {$command eq "file" || $command eq "numfmt" } {
|
|
hola_array num 0
|
|
}
|
|
hola_array $command $args
|
|
}
|
|
return "[result hola_array $command]"
|
|
}
|
|
}
|
|
}
|
|
|
|
publishLazy hola
|
|
|
|
proc hola_wait {obj target {tolerance 1.0} {timeout 300} {settle 0}} {
|
|
# helper function for quicker convergence
|
|
set cnt 0
|
|
set settletime 0
|
|
set mindif 1e30
|
|
# do loop until no considerable progress within timeout
|
|
while {$cnt < $timeout} {
|
|
set dif [expr abs([result $obj] - $target)]
|
|
if {$dif < abs($tolerance)} {
|
|
incr settletime
|
|
if {$settletime > $settle} {
|
|
return
|
|
}
|
|
}
|
|
if {$dif < $mindif} {
|
|
set mindif [expr $dif - $tolerance]
|
|
set cnt 0
|
|
} else {
|
|
# no progress
|
|
incr cnt
|
|
}
|
|
wait 1
|
|
}
|
|
clientput "no progress within $timeout sec"
|
|
}
|