# 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 ... \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 ...\nmeasure single points" hola_desc makeitem steps "hola steps \nmeasure with steps, starting from last value" hola_desc makeitem logsteps "hola logsteps \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 ", '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 " } 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 \[\] 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" }