78 lines
1.7 KiB
Tcl
78 lines
1.7 KiB
Tcl
namespace eval slope {} {
|
|
variable tbuffer
|
|
variable vbuffer
|
|
}
|
|
|
|
proc stdConfig::slope {srcnode {omitzero 0}} {
|
|
variable hostport none
|
|
variable name
|
|
variable node
|
|
variable tbuffer
|
|
variable vbuffer
|
|
controller syncedprot
|
|
|
|
obj slope upd
|
|
|
|
dolater 0 hset $node/node $srcnode
|
|
|
|
kids $name {
|
|
node node out -text
|
|
prop check slope::setnode $omitzero
|
|
prop write stdSct::complete
|
|
|
|
node unit par 60
|
|
prop help "unit=60: mainunits/minutes, unit=1: mainunits/sec"
|
|
node ref par 0
|
|
node bufperiod par 300
|
|
}
|
|
}
|
|
|
|
proc slope::setnode {omitzero} {
|
|
variable tbuffer
|
|
variable vbuffer
|
|
|
|
[sct controller] updatescript [sct target] "slope::update_value [sct parent] $omitzero"
|
|
sct update [sct target]
|
|
set tbuffer([sct parent]) [list]
|
|
set vbuffer([sct parent]) [list]
|
|
}
|
|
|
|
proc slope::update_value {sn omitzero val} {
|
|
variable tbuffer
|
|
variable vbuffer
|
|
|
|
if {$val == 0 && $omitzero} {
|
|
return
|
|
}
|
|
# sn: slope node
|
|
set tbuf $tbuffer($sn)
|
|
set vbuf $vbuffer($sn)
|
|
set now [DoubleTime]
|
|
lappend tbuf $now
|
|
lappend vbuf $val
|
|
set b [hvali $sn/bufperiod]
|
|
while {[lindex $tbuf 0] < $now - $b} {
|
|
set tbuf [lrange $tbuf 1 end]
|
|
set vbuf [lrange $vbuf 1 end]
|
|
}
|
|
set tbuffer($sn) $tbuf
|
|
set vbuffer($sn) $vbuf
|
|
set l [llength $tbuf]
|
|
if {$l < 3 || [lindex $tbuf end] - [lindex $tbuf 0] < $b / 4} {
|
|
updateerror $sn "not enough data"
|
|
return
|
|
}
|
|
set nom 0
|
|
set div 0
|
|
set i 0
|
|
for {set i 0} {$i * 2 < $l} {incr i} {
|
|
set j [expr $l - $i - 1]
|
|
set dt [expr [lindex $tbuf $j] - [lindex $tbuf $i]]
|
|
set nom [expr $nom + ([lindex $vbuf $j] - [lindex $vbuf $i]) * $dt]
|
|
set div [expr $div + $dt * $dt]
|
|
incr i
|
|
}
|
|
set slope [expr ($nom / $div) * [hval $sn/unit]]
|
|
updateval $sn $slope
|
|
}
|