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 ... # 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