add archive (files probably no longer used)

here we can find old files

tcl/archive/startup/store.tcl

@@ -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