linse/sea
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

secop improvements

Browse Source
This commit is contained in:
l_samenv
2023-03-31 10:31:55 +02:00
parent 66b2bbab3d
commit 2223077cf0
1 changed files with 109 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

166
tcl/drivers/secop_4.tcl
View File

@ -3,7 +3,10 @@
namespace eval secop {} { namespace eval secop {} {
} }
proc stdConfig::secop {{shownUnits ALL} {restart no}} { proc stdConfig::secop {{shownUnits ALL} {restart no} {sepUnits ""}} {
# shown units: restrict units shown
# restart: whether to restart on reconnect
# sepUnits: append sepUnits to unis for different graphic window
variable node variable node
variable name variable name
@ -23,6 +26,7 @@ proc stdConfig::secop {{shownUnits ALL} {restart no}} {
prop secopPath /$name prop secopPath /$name
prop active 0 prop active 0
prop shownUnits $shownUnits prop shownUnits $shownUnits
prop sepUnits $sepUnits
set node $node/tasks set node $node/tasks
prop start secop::start prop start secop::start
@ -48,7 +52,7 @@ proc secop::errorscript_ {} {
return secop::update_ return secop::update_
} }
sct connection_lost 1 sct connection_lost 1
[sct controller] poll [sct secopPath] 1 [sct controller] poll [sct secopPath] 5
error [sct result] error [sct result]
} }
@ -76,6 +80,7 @@ proc secop::writemsg {} {
proc secop::readmsg_ {} { # ending with _: invisible on debug proc secop::readmsg_ {} { # ending with _: invisible on debug
if {[sct connection_lost]} { if {[sct connection_lost]} {
[sct controller] poll [sct] 0.001
sct connection_lost 0 sct connection_lost 0
return [secop::start] return [secop::start]
} }
@ -90,14 +95,15 @@ proc secop::test {} {
proc secop::check {} { proc secop::check {} {
if {[silent "" sct secopar] eq ""} return if {[silent "" sct secopar] eq ""} return
set validator [silent {} sct validator] set value [sct target]
eval $validator set validator [silent "" sct validator]
lassign [split [hinfo [sct]] ","] type if {$validator ne ""} {
set msg "change [sct secopar] [sct target]" lappend validator $value
hsetprop [sct] secoprequested [sct target] set value [eval $validator]
if {[string match "f:*" [sct secopar]]} {
clientput "REQ: $msg"
} }
lassign [split [hinfo [sct]] ","] type
set msg "change [sct secopar] $value"
hsetprop [sct] secoprequested [sct target]
[sct controller] que [sct secopPath] write [list secop::queuedwrite $msg] [sct controller] que [sct secopPath] write [list secop::queuedwrite $msg]
} }
@ -133,44 +139,80 @@ proc secop::get {} {
return secop::update_ return secop::update_
} }
proc secop::check_range {min max {absolute_resolution 0} {relative_resolution 0}} { proc secop::check_double {datainfo value} {
set prec [expr max($absolute_resolution, $relative_resolution * abs([sct target]))] set min [silent -inf dict get $datainfo min]
if {[sct target] < $min} { set max [silent inf dict get $datainfo max]
if {[sct target] >= $min - $prec} { set absolute_resolution [silent 0 dict get $datainfo absolute_resolution]
sct target $min set relative_resolution [silent 1.2e-7 dict get $datainfo relative_resolution]
return set prec [expr max($absolute_resolution, $relative_resolution * abs($value))]
if {$value < $min} {
if {$value >= $min - $prec} {
return $min
} }
} elseif {[sct target] > $max} { } elseif {$value > $max} {
if {[sct target] <= $max + $prec} { if {$value <= $max + $prec} {
sct target $max return $max
return
} }
} else { } else {
return return $value
} }
error "[sct] value must be within \[$min, $max\]" error "[sct]: value must be within \[$min, $max\]"
} }
proc secop::check_string {min max} { proc secop::check_int {datainfo value} {
set len [string length [sct target]] return [check_double $datainfo $value]
}
proc secop::check_string {datainfo value} {
set len [string length $value]
set min [silent -inf dict get $datainfo minlen]
set max [silent inf dict get $datainfo maxlen]
if {$len < $min || $len > $max} { if {$len < $min || $len > $max} {
error "[sct] string length must be within \[$min, $max\]" error "[sct]: string length must be within \[$min, $max\]"
} }
sct target [format {"%s"} [sct target]] return [format {"%s"} $value]
} }
proc secop::check_bool {} {
switch -- [string tolower [sct target]] { proc secop::check_bool {datainfo value} {
off - false - no - 0 - on - true - yes - 1 { switch -- [string tolower $value] {
return off - false - no - 0 {
return 0
}
on - true - yes - 1 {
return 1
} }
} }
error "illegal value for boolean: [sct target]" error "[sct]: illegal value for boolean: $value"
} }
proc secop::check_tuple args { proc secop::check_tuple {datainfo value} {
sct target [format {[%s]} [join [sct target] ,]] set items [list]
clientput [sct target] foreach v $value dt [dict get $datainfo members] {
set type [dict get $dt type]
lappend items [check_$type $dt $v]
}
return [format {[%s]} [join $items ,]]
}
proc secop::check_array {datainfo value} {
set items [list]
set dt [dict get $datainfo members]
set type [dict get $dt type]
foreach v $value {
lappend items [check_$type $dt $v]
}
return [format {[%s]} [join $items ,]]
}
proc secop::check_struct {datainfo value} {
set items [list]
foreach {k dt} [dict get $datainfo members] {
set type [dict get $dt type]
set v [check_$type $dt [dict get $value $k]]
lappend items [format {"%s": %s} $k $v]
}
return [format {{%s}} [join $items ", "]]
} }
proc secop::make_par {secopar desc {kind ""}} { proc secop::make_par {secopar desc {kind ""}} {
@ -201,9 +243,8 @@ proc secop::make_par {secopar desc {kind ""}} {
# can not use SICS drivable for string # can not use SICS drivable for string
set kind "" set kind ""
} }
bool {set type text} bool - tuple - array - struct {set type text}
none {set type none} none {set type none}
tuple {set type text}
default { default {
clientput "unknown type for $secopar (use text): $secoptype ($datadesc)" clientput "unknown type for $secopar (use text): $secoptype ($datadesc)"
set type text set type text
@ -224,8 +265,17 @@ proc secop::make_par {secopar desc {kind ""}} {
set fmtunit [format { [%s]} $unit] set fmtunit [format { [%s]} $unit]
} }
if {$par eq "" || $par eq "target"} { if {$par eq "" || $par eq "target"} {
set label [join [split $secopar :] .]
set prevlabel [silent "" result graph_label [string tolower $label]]
if {$prevlabel ne ""} {
set label $prevlabel
}
if {[sct shownUnits] eq "ALL" || [lsearch [sct shownUnits] $unit] >= 0} { if {[sct shownUnits] eq "ALL" || [lsearch [sct shownUnits] $unit] >= 0} {
GraphAdd $path $unit [join [split $secopar :] .] set sepUnits [silent "" sct sepUnits]
if {$sepUnits ne ""} {
set unit "${unit}_$sepUnits"
}
GraphAdd $path $unit $label
} }
} }
} }
@ -251,7 +301,7 @@ proc secop::make_par {secopar desc {kind ""}} {
} }
hsetprop $path enum [join $enumprop ,] hsetprop $path enum [join $enumprop ,]
if {[silent "" hgetpropval $path type] eq "drivable"} { if {[silent "" hgetpropval $path type] eq "drivable"} {
hsetprop $path visible false hsetprop $path visible readonly
} }
if {$wid > 8} { if {$wid > 8} {
hsetprop $path width $wid hsetprop $path width $wid
@ -260,29 +310,18 @@ proc secop::make_par {secopar desc {kind ""}} {
} }
bool { bool {
hsetprop $path enum 1 hsetprop $path enum 1
hsetprop $path validator secop::check_bool hsetprop $path validator [list secop::check_bool $datadesc]
} }
double { double {
set min [silent -inf dict get $datadesc min] hsetprop $path validator [list secop::check_double $datadesc]
set max [silent inf dict get $datadesc max]
set absolute_resolution [silent 0 dict get $datadesc absolute_resolution]
set relative_resolution [silent 1.2e-7 dict get $datadesc relative_resolution]
hsetprop $path validator [concat secop::check_range $min $max $absolute_resolution $relative_resolution]
} }
int { int {
set min [silent -inf dict get $datadesc min] hsetprop $path validator [list secop::check_int $datadesc]
set max [silent inf dict get $datadesc max]
hsetprop $path validator [concat secop::check_range $min $max]
} }
string { string - tuple - struct - array {
set min [silent -inf dict get $datadesc min] set type [dict get $datadesc type]
set max [silent inf dict get $datadesc max] hsetprop $path width 36
hsetprop $path width 16 hsetprop $path validator [list secop::check_$type $datadesc]
hsetprop $path validator [concat secop::check_string $min $max]
}
tuple { # TODO: make it work for more complex than number tuples
set args [dict get $datadesc members]
hsetprop $path validator [linsert $args 0 secop::check_tuple]
} }
} }
return $path return $path
@ -349,12 +388,14 @@ proc secop::make_par0 {type path secopar desc {kind std}} {
# logsetup $path 1 # logsetup $path 1
logsetup $path 5 logsetup $path 5
if {[info exists props(value)]} { if {[info exists props(value)]} {
clientput "VALUE in descr $path"
if {[catch {hupdate /$path $props(value)} msg]} { if {[catch {hupdate /$path $props(value)} msg]} {
clientput $msg clientput $msg
} }
unset props(value) unset props(value)
} }
if {![catch {set fmtstr [dict get $props(datainfo) fmtstr]}]} {
hsetprop $path fmtstr $fmtstr
}
foreach {prop item} [array get props] { foreach {prop item} [array get props] {
hsetprop $path s_$prop $item hsetprop $path s_$prop $item
} }
@ -571,6 +612,7 @@ proc secop::update_ {} {
if {$messagetype eq "changed"} { if {$messagetype eq "changed"} {
if {[string match *:target $par]} { if {[string match *:target $par]} {
hsetprop /$obj writestatus done hsetprop /$obj writestatus done
hsetprop /$obj changetime 0
} }
hsetprop $path changed 0 hsetprop $path changed 0
catch {hdelprop $path secoprequested} catch {hdelprop $path secoprequested}
@ -609,6 +651,7 @@ proc secop::update_ {} {
set shown 0 set shown 0
} }
set writestatus [silent done hgetpropval $objpath writestatus] set writestatus [silent done hgetpropval $objpath writestatus]
set changetime [silent 0 hgetpropval $objpath changetime]
if {$value < 100 || $value >= 400} { # error if {$value < 100 || $value >= 400} { # error
# updateerror $objpath $text_value # updateerror $objpath $text_value
catch { catch {
@ -638,7 +681,12 @@ proc secop::update_ {} {
} }
GraphItem shown $objpath $shown GraphItem shown $objpath $shown
if {[silent "" hgetpropval $objpath/target logger_name] ne ""} { if {[silent "" hgetpropval $objpath/target logger_name] ne ""} {
GraphItem shown $objpath/target $shown if {[string match *Drivable* [silent "" hgetpropval $objpath sm_interface_classes]]
&& [silent "enum" hgetpropval $objpath/target secoptype] ne "enum"} {
GraphItem shown $objpath/target $shown
} else {
GraphItem shown $objpath/target 0
}
} }
set text_path [regsub {status_code$} $path status_text] set text_path [regsub {status_code$} $path status_text]
if {[catch {updateval $text_path $text_value}]} { if {[catch {updateval $text_path $text_value}]} {
@ -715,6 +763,7 @@ proc secop::update_ {} {
hsetprop $path geterror "${etype}: $etext" hsetprop $path geterror "${etype}: $etext"
} }
error_* { error_* {
clientlog $val
lassign $val etype etext lassign $val etype etext
set requesttype [string range $messagetype 6 end] set requesttype [string range $messagetype 6 end]
if {$requesttype eq "change" && $path ne ""} { if {$requesttype eq "change" && $path ne ""} {
@ -768,6 +817,7 @@ proc secop::checklimits {} {
[sct target] != [silent "x" hgetpropval [sct]/target target]} { [sct target] != [silent "x" hgetpropval [sct]/target target]} {
hset [sct]/target [sct target] hset [sct]/target [sct target]
sct writestatus checked sct writestatus checked
sct changetime [DoubleTime]
sct status run sct status run
} }
} }
@ -804,6 +854,7 @@ proc secop::halt {} {
sct stop_issued [DoubleTime] sct stop_issued [DoubleTime]
} else { } else {
sct writestatus done sct writestatus done
sct changetime 0
sct status idle sct status idle
} }
return idle return idle
@ -816,6 +867,7 @@ proc secop::finish_halt {} {
return idle return idle
} }
sct writestatus done sct writestatus done
sct changetime 0
sct status idle sct status idle
return unpoll return unpoll
} }