initial commit

tcl/drivers/softcal.tcl

@@ -0,0 +1,69 @@
+namespace eval softcal {
+}
+
+if {![namespace exists lsc]} {
+  source drivers/lsc.tcl
+}
+
+# software caibration
+proc stdConfig::softcal {respath curve} {
+  variable name
+  variable path
+  variable ctrl
+  
+  controller syncedprot
+
+  obj SOFTCAL rd
+  prop read softcal::read
+  prop respath $respath
+  prop geterror "invalid"
+  kids $name {
+
+    node logarithmic par 1
+    
+    node curve out -text
+    prop width 32
+    prop model 0
+    prop check softcal::curve
+    prop write stdSct::completeUpdate
+
+    kids hidden {
+      hfactory $path/points plain mugger floatvarar 1
+    }   
+
+  }
+  hset $path/curve $curve
+}
+
+proc softcal::curve {} {
+  if {[sct requested] ne "0"} {
+    lsc::read_curve
+  }
+}
+
+proc softcal::update {path r} {
+  if {[hval $path/logarithmic]} {
+    set t [interpolate [hvali $path/curve/points] 0 $r logx logy extrapolate]
+  } else {
+    set t [interpolate [hvali $path/curve/points] 0 $r extrapolate]
+  }
+  if {$t < 1e38} {
+    # do only when exp in interpolation did not overflow
+    updateval $path $t
+  } else {
+    updateerror $path "invalid"
+  }
+}
+
+proc softcal::read {} {
+  catch {
+    [sct controller] updatescript [sct respath] "softcal::update [sct]"
+  } msg
+  set err [silent "" hgetpropval [sct respath] geterror]
+  if {$err ne ""} {
+    updateerror [sct] $err
+  } else {
+    updateval [sct] [hvali [sct]]
+  }
+  return idle
+}