70 lines
1.3 KiB
Tcl
70 lines
1.3 KiB
Tcl
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
|
|
}
|