943 lines
25 KiB
Tcl
943 lines
25 KiB
Tcl
# secop driver 4 (v1.0): modules/accesibles are JSON objects, datatype is flat JSON object, renamed to datainfo
|
|
|
|
namespace eval secop {} {
|
|
}
|
|
|
|
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 name
|
|
|
|
set addon _MAIN_
|
|
|
|
controller secop3 timeout=60
|
|
prop commerror secop::errorscript_
|
|
prop connection_lost 0
|
|
prop check secop::check
|
|
prop read secop::read
|
|
prop write secop::write
|
|
prop node_built 0
|
|
prop restart_on_reconnect [expr {$restart ne "no"}]
|
|
|
|
prop startcmd *IDN?
|
|
prop end_fast 0
|
|
prop secopPath /$name
|
|
prop active 0
|
|
prop shownUnits $shownUnits
|
|
prop sepUnits $sepUnits
|
|
|
|
set node $node/tasks
|
|
prop start secop::start
|
|
|
|
pollperiod 0.001 0.001
|
|
obj SECoP -text wr
|
|
|
|
prop read secop::readmsg_
|
|
prop test secop::test
|
|
prop check secop::checkmsg
|
|
prop write secop::writemsg
|
|
prop cmd ""
|
|
|
|
variable ctrl
|
|
variable path
|
|
hsetprop /sics/$ctrl ignore_no_response 1
|
|
|
|
}
|
|
|
|
proc secop::errorscript_ {} {
|
|
if {[string match {ASCERR: no response*} [sct result]]} {
|
|
sct send ping
|
|
return secop::update_
|
|
}
|
|
sct connection_lost 1
|
|
[sct controller] poll [sct secopPath] 5
|
|
error [sct result]
|
|
}
|
|
|
|
proc secop::checkmsg {} {
|
|
# variable MQ[sct]
|
|
# upvar 0 MQ[sct] mq
|
|
# if {![info exists mq]} {
|
|
# # create message queue
|
|
# set mq [list]
|
|
# }
|
|
# if {[llength $mq] > 0} {
|
|
# set next [lindex $mq 0]
|
|
# set mq [lrange $mq 1 end]
|
|
# lappend mq [sct target]
|
|
# sct target $next
|
|
# }
|
|
|
|
return ""
|
|
}
|
|
|
|
proc secop::writemsg {} {
|
|
sct send [sct target]
|
|
return secop::update_
|
|
}
|
|
|
|
proc secop::readmsg_ {} { # ending with _: invisible on debug
|
|
if {[sct connection_lost]} {
|
|
[sct controller] poll [sct] 0.001
|
|
sct connection_lost 0
|
|
return [secop::start]
|
|
}
|
|
sct send ""
|
|
return secop::update_
|
|
}
|
|
|
|
proc secop::test {} {
|
|
clientput test
|
|
return idle
|
|
}
|
|
|
|
proc secop::check {} {
|
|
if {[silent "" sct secopar] eq ""} return
|
|
set value [sct target]
|
|
set validator [silent "" sct validator]
|
|
if {$validator ne ""} {
|
|
lappend validator $value
|
|
set value [eval $validator]
|
|
}
|
|
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]
|
|
}
|
|
|
|
proc secop::queuedwrite {msg} {
|
|
sct changed [DoubleTime]
|
|
# send message on /secop node
|
|
sct sent_message $msg
|
|
sct send $msg
|
|
return secop::update_
|
|
}
|
|
|
|
proc secop::read {} {
|
|
# this should be polled and check for errors on _secop
|
|
set status [silent 0 sct status]
|
|
if {$status eq "run" && _secop_in_error} {
|
|
clientput "[sct] FAULT"
|
|
sct status posfault
|
|
}
|
|
# this should not be called
|
|
clientput "WHY? secop::read [sct] [sct controller]"
|
|
return idle
|
|
}
|
|
|
|
proc secop::write {} {
|
|
# this does nothing, as the check script only is doing the work
|
|
# clientput "secop::write [sct] [sct controller]"
|
|
return idle
|
|
}
|
|
|
|
proc secop::get {} {
|
|
error "secop::get is obsolete"
|
|
sct send ""
|
|
return secop::update_
|
|
}
|
|
|
|
proc secop::check_double {datainfo value} {
|
|
set min [silent -inf dict get $datainfo min]
|
|
set max [silent inf dict get $datainfo max]
|
|
set absolute_resolution [silent 0 dict get $datainfo absolute_resolution]
|
|
set relative_resolution [silent 1.2e-7 dict get $datainfo relative_resolution]
|
|
set prec [expr max($absolute_resolution, $relative_resolution * abs($value))]
|
|
if {$value < $min} {
|
|
if {$value >= $min - $prec} {
|
|
return $min
|
|
}
|
|
} elseif {$value > $max} {
|
|
if {$value <= $max + $prec} {
|
|
return $max
|
|
}
|
|
} else {
|
|
return $value
|
|
}
|
|
error "[sct]: value must be within \[$min, $max\]"
|
|
}
|
|
|
|
proc secop::check_int {datainfo value} {
|
|
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} {
|
|
error "[sct]: string length must be within \[$min, $max\]"
|
|
}
|
|
return [format {"%s"} $value]
|
|
}
|
|
|
|
|
|
proc secop::check_bool {datainfo value} {
|
|
switch -- [string tolower $value] {
|
|
off - false - no - 0 {
|
|
return 0
|
|
}
|
|
on - true - yes - 1 {
|
|
return 1
|
|
}
|
|
}
|
|
error "[sct]: illegal value for boolean: $value"
|
|
}
|
|
|
|
proc secop::check_tuple {datainfo value} {
|
|
set items [list]
|
|
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 ""}} {
|
|
set path [topath $secopar [silent "" dict get $desc group]]
|
|
array set props $desc
|
|
# lassign [silent "" set props(datainfo)] secoptype0 datadesc
|
|
set datadesc [silent "" set props(datainfo)]
|
|
set secoptype0 [dict get $datadesc type]
|
|
if {$secoptype0 eq "tuple" && [string match *:status $secopar]} {
|
|
set members [dict get $datadesc members]
|
|
# lassign $validator_args members
|
|
set text_path [regsub {status_code$} $path status_text]
|
|
make_par0 text $text_path $secopar $desc
|
|
hsetprop $text_path width 24
|
|
set datadesc [lindex $members 0]
|
|
set secoptype [dict get $datadesc type]
|
|
#lassign [lindex $members 0] secoptype datadesc
|
|
set status_node 1
|
|
} else {
|
|
set secoptype $secoptype0
|
|
set status_node 0
|
|
}
|
|
switch -- $secoptype {
|
|
double {set type float}
|
|
int - enum {set type int}
|
|
string {
|
|
set type text
|
|
# can not use SICS drivable for string
|
|
set kind ""
|
|
}
|
|
bool - tuple - array - struct {set type text}
|
|
none {set type none}
|
|
default {
|
|
clientput "unknown type for $secopar (use text): $secoptype ($datadesc)"
|
|
set type text
|
|
}
|
|
}
|
|
make_par0 $type $path $secopar $desc $kind
|
|
hsetprop $path secoptype $secoptype0
|
|
if {$status_node} {
|
|
hsetprop $path nonewline 1
|
|
}
|
|
lassign [split $path /] nul obj par
|
|
set fmtunit ""
|
|
if {[lsearch [list enum int double] $secoptype0] >= 0} {
|
|
set fmtunit ""
|
|
if {[catch {set unit [dict get $datadesc unit]}]} {
|
|
set unit 1
|
|
} else {
|
|
set fmtunit [format { [%s]} $unit]
|
|
}
|
|
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} {
|
|
set sepUnits [silent "" sct sepUnits]
|
|
if {$sepUnits ne ""} {
|
|
set unit "${unit}_$sepUnits"
|
|
}
|
|
GraphAdd $path $unit $label
|
|
}
|
|
}
|
|
}
|
|
if {[info exists props(description)]} {
|
|
set addlines [lassign [split $props(description) "\n"] firstline]
|
|
hsetprop $path help [join [linsert $addlines 0 "$firstline$fmtunit"] "\n"]
|
|
unset props(description)
|
|
}
|
|
switch -- $secoptype {
|
|
enum {
|
|
set enumprop [list]
|
|
set wid 8
|
|
set sorted [list]
|
|
set members [dict get $datadesc members]
|
|
|
|
foreach {name value} $members {
|
|
lappend sorted [list $value $name]
|
|
}
|
|
foreach value_name [lsort -integer -index 0 $sorted] {
|
|
lassign $value_name value name
|
|
lappend enumprop "$name=$value"
|
|
set wid [expr max($wid,[string length $name])]
|
|
}
|
|
hsetprop $path enum [join $enumprop ,]
|
|
if {[silent "" hgetpropval $path type] eq "drivable"} {
|
|
hsetprop $path visible readonly
|
|
}
|
|
if {$wid > 8} {
|
|
hsetprop $path width $wid
|
|
}
|
|
hsetprop $path label $par
|
|
}
|
|
bool {
|
|
hsetprop $path enum 1
|
|
hsetprop $path validator [list secop::check_bool $datadesc]
|
|
}
|
|
double {
|
|
hsetprop $path validator [list secop::check_double $datadesc]
|
|
}
|
|
int {
|
|
hsetprop $path validator [list secop::check_int $datadesc]
|
|
}
|
|
string - tuple - struct - array {
|
|
set type [dict get $datadesc type]
|
|
hsetprop $path width 36
|
|
hsetprop $path validator [list secop::check_$type $datadesc]
|
|
}
|
|
}
|
|
return $path
|
|
}
|
|
|
|
proc secop::make_par0 {type path secopar desc {kind std}} {
|
|
array set props $desc
|
|
# clientput "$path $desc"
|
|
set readonly [silent 0 set props(readonly)]
|
|
if {$readonly} {
|
|
set priv internal
|
|
} else {
|
|
set priv user
|
|
}
|
|
if {[silent "" hinfo $path] ne ""} {
|
|
error "$path exists already!"
|
|
}
|
|
lassign [split $path /] nul obj par
|
|
if {$par eq ""} {
|
|
if {$kind eq "driv"} {
|
|
dynsctdriveobj $obj float user SECoP [sct controller]
|
|
hfactory $path link $obj
|
|
hsetprop $obj checklimits secop::checklimits
|
|
# hsetprop $obj checkstatus secop::checkstatus
|
|
hsetprop $obj halt secop::halt
|
|
# allow start without run:
|
|
hsetprop $obj check secop::checklimits
|
|
hsetprop $obj write secop::complete_run
|
|
set readonly 0
|
|
hsetprop $obj sicscommand "run $obj"
|
|
} else {
|
|
# clientput "OBJ $obj $type"
|
|
dynsicsobj $obj SECoP $priv $type
|
|
hfactory $path link $obj
|
|
}
|
|
hsetprop $path group $obj
|
|
hsetprop $path s_group $obj
|
|
hsetprop $path objectPath $path
|
|
hsetprop /sics/[sct controller] p_$secopar:value $path
|
|
} else {
|
|
if {$par eq "status"} {
|
|
set path /$obj/status_code
|
|
}
|
|
# clientput "PAR $path $type [array get props]"
|
|
hfactory $path plain $priv $type
|
|
if {[info exists props(visibility)]} {
|
|
if {$props(visibility) >= 3} {
|
|
hsetprop $path visible false
|
|
}
|
|
}
|
|
}
|
|
hsetprop $path secopar $secopar
|
|
if {$par eq ""} {
|
|
hsetprop $path secop_id $secopar:value
|
|
} else {
|
|
hsetprop $path secop_id $secopar
|
|
}
|
|
hsetprop /sics/[sct controller] p_$secopar $path
|
|
if {!$readonly} {
|
|
[sct controller] write $path
|
|
} else {
|
|
[sct controller] connect $path
|
|
}
|
|
# logsetup $path 1
|
|
logsetup $path 5
|
|
if {[info exists props(value)]} {
|
|
if {[catch {hupdate /$path $props(value)} msg]} {
|
|
clientput $msg
|
|
}
|
|
unset props(value)
|
|
}
|
|
if {![catch {set fmtstr [dict get $props(datainfo) fmtstr]}]} {
|
|
hsetprop $path fmtstr $fmtstr
|
|
}
|
|
foreach {prop item} [array get props] {
|
|
hsetprop $path s_$prop $item
|
|
}
|
|
}
|
|
|
|
proc secop::make_cmd {secopar desc {first 0}} {
|
|
array set props $desc
|
|
set path [topath $secopar [silent "" dict get $desc group]]
|
|
set cmd [join [lassign [split $path /] _ obj] /]
|
|
set datadesc $props(datainfo)
|
|
set argument None
|
|
catch {
|
|
set argument [dict get $datadesc argument]
|
|
}
|
|
if {$argument eq "None"} {
|
|
$obj makescriptfunc $cmd "secop::check_cmd [sct secopPath] $secopar" user
|
|
hsetprop $path newline $first
|
|
hsetprop $path secopar $secopar
|
|
hsetprop $path sicscommand "$obj $cmd"
|
|
if {[info exists props(visibility)]} {
|
|
if {$props(visibility) >= 3} {
|
|
hsetprop $path visible false
|
|
}
|
|
}
|
|
} else {
|
|
dict set desc datainfo $argument
|
|
make_par $secopar $desc
|
|
set maintype [dict get $argument type]
|
|
#lassign $argument maintype datadesc
|
|
if {$maintype eq "double" || $maintype eq "int" || $maintype eq "bool"} {
|
|
hsetprop $path check "secop::check_cmd_num [sct secopPath] $secopar"
|
|
} else {
|
|
hsetprop $path check "secop::check_cmd_text [sct secopPath] $secopar"
|
|
}
|
|
}
|
|
}
|
|
|
|
proc secop::check_cmd {secopPath secopar} {
|
|
hset $secopPath "do $secopar"
|
|
}
|
|
|
|
proc secop::check_cmd_num {secopPath secopar} {
|
|
hset $secopPath [format {do %s %.15g} $secopar [sct target]]
|
|
sct update [sct target]
|
|
}
|
|
|
|
proc secop::check_cmd_text {secopPath secopar} {
|
|
hset $secopPath [format {do %s "%s"} $secopar [sct target]]
|
|
sct update [sct target]
|
|
}
|
|
|
|
proc secop::make_module {obj desc} {
|
|
clientput "MAKE_MODULE $obj"
|
|
set secopObj [string range [sct secopPath] 1 end]
|
|
set addon _MAIN_
|
|
foreach a [addon_list items] {
|
|
if {[addon_$a exists $secopObj]} {
|
|
set addon $a
|
|
}
|
|
}
|
|
if {$addon ne "_MAIN_"} {
|
|
addon_$addon makeitem $obj
|
|
}
|
|
if {[obj_list exists $obj]} {
|
|
clientput "$obj exists already"
|
|
return
|
|
}
|
|
obj_list makeitem $obj /$obj
|
|
|
|
array unset modprop
|
|
set parlist [list]
|
|
set pardict [dict create]
|
|
foreach {key item} $desc {
|
|
switch $key {
|
|
accessibles {
|
|
# foreach acsitm $item {
|
|
# lassign $acsitm parname pardesc
|
|
# dict set pardict $parname $pardesc
|
|
# }
|
|
foreach {parname pardesc} $item {
|
|
dict set pardict $parname $pardesc
|
|
}
|
|
}
|
|
default {
|
|
set modprop($key) $item
|
|
}
|
|
}
|
|
}
|
|
if {[dict exists $pardict value]} {
|
|
set value [dict get $pardict value]
|
|
dict unset pardict value
|
|
} else {
|
|
set value [dict create datainfo {type none}]
|
|
}
|
|
set classes [silent "" set modprop(interface_classes)]
|
|
if {$classes eq ""} {
|
|
set classes [silent "" set modprop(interface_class)]
|
|
}
|
|
if {[string match "* Drivable *" " $classes "]} {
|
|
set path [make_par $obj $value driv]
|
|
} else {
|
|
set path [make_par $obj $value]
|
|
}
|
|
if {[info exists modprop(visibility)] && $modprop(visibility) >= 3} {
|
|
hdelprop $path group
|
|
}
|
|
foreach {prop val} [array get modprop] {
|
|
if {[string match _* $prop]} {
|
|
set prop [string range $prop 1 end]
|
|
}
|
|
hsetprop $obj sm_$prop $val
|
|
}
|
|
device_layout makeitem /$obj [silent 0 set modprop(layoutpos)]
|
|
|
|
set groups [dict create]
|
|
foreach {parname pardesc} $pardict {
|
|
if {[dict exists $pardesc group]} {
|
|
dict set groups [dict get $pardesc group] 1
|
|
}
|
|
}
|
|
foreach g [dict keys $groups] {
|
|
clientput "GROUP $g"
|
|
hfactory $obj/$g plain user none
|
|
hsetprop $obj/$g group "group $g"
|
|
}
|
|
set shortcmds [list]
|
|
foreach {parname pardesc} $pardict {
|
|
set datadesc [dict get $pardesc datainfo]
|
|
set secoptype [dict get $datadesc type]
|
|
#lassign $datainfo secoptype datadesc
|
|
if {$secoptype eq "command"} {
|
|
if {[catch {set argument [dict get $datadesc argument]}]} {
|
|
set argument None
|
|
}
|
|
if {$argument ne "None"} {
|
|
# only commands with arguments
|
|
make_cmd $obj:$parname $pardesc 1
|
|
} else {
|
|
lappend shortcmds $parname $pardesc
|
|
}
|
|
} else {
|
|
make_par $obj:$parname $pardesc
|
|
}
|
|
}
|
|
# then commands without arguments, on one line
|
|
set first 1
|
|
foreach {parname pardesc} $shortcmds {
|
|
make_cmd $obj:$parname $pardesc $first
|
|
set first 0
|
|
}
|
|
}
|
|
|
|
proc secop::make_node {desc} {
|
|
array unset nodeprop
|
|
set modlist [list]
|
|
foreach {key item} $desc {
|
|
switch $key {
|
|
modules {
|
|
set modlist $item
|
|
}
|
|
default {
|
|
set nodeprop($key) $item
|
|
}
|
|
}
|
|
}
|
|
foreach {modname moddesc} $modlist {
|
|
make_module $modname $moddesc
|
|
}
|
|
foreach {prop val} [array get nodeprop] {
|
|
sct sn_$prop $val
|
|
}
|
|
sort_layout
|
|
}
|
|
|
|
proc secop::topath {secopar {pargroup ""}} {
|
|
lassign [split [string tolower $secopar] :] module parameter
|
|
if {$parameter eq "value" || $parameter eq ""} {
|
|
return "/$module"
|
|
}
|
|
if {$parameter eq "status"} {
|
|
set parameter status_code
|
|
}
|
|
if {[string match {_*} $parameter]} {
|
|
set parameter [string range $parameter 1 end]
|
|
}
|
|
if {$pargroup ne ""} {
|
|
return "/$module/$pargroup/$parameter"
|
|
}
|
|
return "/$module/$parameter"
|
|
}
|
|
|
|
proc secop::update_ {} {
|
|
if {[silent "" sct result] eq ""} {
|
|
return idle
|
|
}
|
|
set sent_message [silent "" sct sent_message]
|
|
set message_to_client ""
|
|
|
|
lassign "[sct result]" messagetype par val
|
|
set path [silent "" hgetpropval /sics/[sct controller] p_$par]
|
|
lassign [split $par :] obj param
|
|
#if {![sct active] && $messagetype ne "update"} {
|
|
# clientput "MSG: $messagetype $par"
|
|
#}
|
|
#if {[string match "f*" $par] && $messagetype eq "changed"} {
|
|
# clientput "MSG: [sct result]"
|
|
#}
|
|
switch -glob $messagetype {
|
|
update - changed {
|
|
# clientput "*** [DoubleTime]: [sct result]"
|
|
#if {[sct] ne "/secop"} {
|
|
# clientput "[sct] is not /secop, why?"
|
|
#}
|
|
if {$messagetype eq "changed"} {
|
|
if {[string match *:target $par]} {
|
|
hsetprop /$obj writestatus done
|
|
hsetprop /$obj changetime 0
|
|
}
|
|
hsetprop $path changed 0
|
|
catch {hdelprop $path secoprequested}
|
|
if {[lrange $sent_message 0 1] eq [list change $par]} {
|
|
set message_to_client [sct result]
|
|
}
|
|
# clientput "CH $path [sct result]"
|
|
} else {
|
|
if {[DoubleTime] < [silent 0 hgetpropval $path changed] + 10} {
|
|
# ignore updates of variables during change
|
|
clientput "ignore [sct result]"
|
|
return idle
|
|
}
|
|
if {[lrange $sent_message 0 1] eq [list read $par]} {
|
|
set message_to_client [sct result]
|
|
}
|
|
}
|
|
lassign $val value qual
|
|
#if {$par eq "drv:value"} {
|
|
# clientput "drv $value"
|
|
#}
|
|
if {[silent 0 hgetpropval $path secoptype] eq "tuple" &&
|
|
[string match *:status $par]} {
|
|
if {[llength $value] > 2} {
|
|
set text_value [lrange $value 1 end]
|
|
} else {
|
|
set text_value [lindex $value 1]
|
|
}
|
|
set objpath [sct parent $path]
|
|
lassign $value value
|
|
if {$value != 0} {
|
|
hsetprop $objpath group [hgetpropval $objpath s_group]
|
|
set shown 1
|
|
} else { # disabled
|
|
catch {hdelprop $objpath group}
|
|
set shown 0
|
|
}
|
|
set writestatus [silent done hgetpropval $objpath writestatus]
|
|
set changetime [silent 0 hgetpropval $objpath changetime]
|
|
if {$value < 100 || $value >= 400} { # error
|
|
# updateerror $objpath $text_value
|
|
# catch {
|
|
# updateerror $objpath/target $text_value
|
|
# }
|
|
if {[silent 0 hgetpropval $objpath status] eq "run"} {
|
|
hsetprop $objpath status posfault
|
|
}
|
|
} else {
|
|
# if {[silent idle hgetpropval $objpath status] eq "run" && $writestatus ne "done"
|
|
# && ($value < 300 || $value >= 390)} {
|
|
# clientput "$objpath/target changed, but status not BUSY: $value $text_value ($writestatus)"
|
|
# set value 300
|
|
# set text_value "target changed ($text_value)"
|
|
# }
|
|
if {$value < 300 || $value >= 390} { # not busy or finalizing
|
|
hsetprop $objpath status idle
|
|
}
|
|
catch {
|
|
updateval $objpath/target [hvali $objpath/target]
|
|
}
|
|
}
|
|
if {$text_value ne [hvali $objpath/status_text] } {
|
|
if {$value == 200} {
|
|
clientput "WARNING: $objpath $text_value"
|
|
}
|
|
}
|
|
GraphItem shown $objpath $shown
|
|
if {[silent "" hgetpropval $objpath/target logger_name] ne ""} {
|
|
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]
|
|
if {[catch {updateval $text_path $text_value}]} {
|
|
clientput "cannot update $text_path to $text_value"
|
|
clientput "MSG([sct result])"
|
|
}
|
|
}
|
|
if {[catch {updateval $path $value} msg]} {
|
|
if {$value eq "None"} {
|
|
hsetprop $path geterror None
|
|
} else {
|
|
clientput "cannot update $path to $value"
|
|
clientput $msg
|
|
}
|
|
} elseif {[string match *:target $par]} {
|
|
if {[string match 1* [silent 0 hval /$obj/status_code]]} {
|
|
hsetprop /$obj target $value
|
|
}
|
|
}
|
|
catch {
|
|
hsetprop $path timestamp [dict get $qual t]
|
|
}
|
|
}
|
|
pong {
|
|
if {[lindex $sent_message 0] eq "ping"} {
|
|
set message_to_client [sct result]
|
|
}
|
|
}
|
|
done {
|
|
hsetprop /$obj done_$param 1
|
|
if {[lrange $sent_message 0 2] eq [list do $par]} {
|
|
set message_to_client [sct result]
|
|
} else {
|
|
clientput "done $par $val"
|
|
}
|
|
}
|
|
active {
|
|
if {[lindex $sent_message 0] eq "activate"} {
|
|
set message_to_client [sct result]
|
|
}
|
|
set act [silent 0 sct activate_stick]
|
|
if {$act} {
|
|
sct activate_stick 0
|
|
dolater 0 activate_stick
|
|
} else {
|
|
set act [silent 0 sct activate_addon]
|
|
if {$act} {
|
|
sct activate_addon 0
|
|
dolater 0 activate_addon
|
|
} else {
|
|
clientlog ACTIVE
|
|
}
|
|
}
|
|
set act [silent 0 sct activate_stick]
|
|
if {$act} {
|
|
sct activate_stick 0
|
|
dolater 0 activate_stick
|
|
} else {
|
|
set act [silent 0 sct activate_addon]
|
|
if {$act} {
|
|
sct activate_addon 0
|
|
dolater 0 activate_addon
|
|
}
|
|
}
|
|
sct active 1
|
|
sct end_fast 0
|
|
}
|
|
describing {
|
|
set olddesc describing_[string map {/ _} [sct]]
|
|
variable $olddesc
|
|
if {[sct node_built]} {
|
|
set restart [sct restart_on_reconnect]
|
|
if {$val ne [silent 0 set $olddesc]} {
|
|
clientput "description changed"
|
|
set restart 1
|
|
}
|
|
if {$restart} {
|
|
secop::restart
|
|
return idle
|
|
}
|
|
clientput "description unchanged"
|
|
}
|
|
do_as_manager {
|
|
make_node $val
|
|
}
|
|
sct send activate
|
|
set $olddesc $val
|
|
sct node_built 1
|
|
[sct controller] poll [sct] 0.001
|
|
return secop::update_
|
|
}
|
|
error_update {
|
|
lassign $val etype erepr
|
|
set etext $erepr
|
|
regexp {.*'(.*)'} $erepr -> etext
|
|
hsetprop $path geterror "${etype}: $etext"
|
|
}
|
|
error_* {
|
|
clientlog $val
|
|
lassign $val etype etext
|
|
set requesttype [string range $messagetype 6 end]
|
|
if {$requesttype eq "change" && $path ne ""} {
|
|
hsetprop $path changed 0
|
|
}
|
|
lassign $sent_message sent_type sent_par
|
|
if {$requesttype eq $sent_message && $par eq $sent_par} {
|
|
set message_to_client [sct result]
|
|
} else {
|
|
clientput "ERROR: $path $etext"
|
|
}
|
|
}
|
|
default {
|
|
if {[string match "*,*" $messagetype]} {
|
|
clientput IDN=[sct result]
|
|
clientput "send describe"
|
|
sct send describe
|
|
sct active 0
|
|
return secop::update_
|
|
}
|
|
if {$sent_message ne ""} {
|
|
set message_to_client [sct result]
|
|
} else {
|
|
# show untreated message
|
|
clientput [sct result]
|
|
}
|
|
}
|
|
}
|
|
if {$message_to_client ne ""} {
|
|
# clientput "[sct]:\n> $sent_message\n< $message_to_client"
|
|
sct sent_message ""
|
|
sct sent_time 1e20
|
|
} elseif {[DoubleTime] > [silent 1e20 sct sent_time] + 10} {
|
|
clientput "timeout waiting for response to $sent_message"
|
|
sct sent_message ""
|
|
sct sent_time 1e20
|
|
}
|
|
#if {[DoubleTime] < [sct end_fast]} {
|
|
# return secop::get
|
|
#}
|
|
# [sct controller] queue [sct] read secop::get
|
|
return idle
|
|
}
|
|
|
|
proc secop::checklimits {} {
|
|
# for whatever strange reason checklimits is called twice
|
|
# in addition again as write script of the obj node
|
|
# do this only once
|
|
set ws [silent 0 sct writestatus]
|
|
if {$ws ne "checked" && $ws ne "start" ||
|
|
[sct target] != [silent "x" hgetpropval [sct]/target target]} {
|
|
hset [sct]/target [sct target]
|
|
sct writestatus checked
|
|
sct changetime [DoubleTime]
|
|
sct status run
|
|
}
|
|
}
|
|
|
|
proc secop::checkstatus {} {
|
|
# obsolete
|
|
set ws [silent 0 sct writestatus]
|
|
set status [hvali [sct]/status_code]
|
|
if {[string match 3* $status]} {
|
|
set result run
|
|
} elseif {[string match 4* $status]} {
|
|
set result posfault
|
|
} else {
|
|
if {$ws ne "done"} {
|
|
set result run
|
|
} else {
|
|
set result idle
|
|
}
|
|
}
|
|
sct status $result
|
|
return $result
|
|
}
|
|
|
|
proc secop::complete_run {} {
|
|
sct print "run [sct objectName] to [sct target]"
|
|
return idle
|
|
}
|
|
|
|
proc secop::halt {} {
|
|
if {[silent 1 sct sm_general_stop]} {
|
|
sct done_stop 0
|
|
[sct objectName] stop
|
|
[sct controller] poll [sct] 0.1 read secop::finish_halt
|
|
sct stop_issued [DoubleTime]
|
|
} else {
|
|
sct writestatus done
|
|
sct changetime 0
|
|
sct status idle
|
|
}
|
|
return idle
|
|
}
|
|
|
|
proc secop::finish_halt {} {
|
|
if {[DoubleTime] > [sct stop_issued] + 10} {
|
|
clientput "[sct] stop timeout"
|
|
} elseif {[sct done_stop] == 0} {
|
|
return idle
|
|
}
|
|
sct writestatus done
|
|
sct changetime 0
|
|
sct status idle
|
|
return unpoll
|
|
}
|
|
|
|
proc secop::start {} {
|
|
if {[sct restart_on_reconnect] && [sct node_built]} {
|
|
secop::restart
|
|
return idle
|
|
}
|
|
sct send *IDN?
|
|
clientput "RECONNECT, send *IDN?"
|
|
return secop::update_
|
|
}
|
|
|
|
proc secop::restart {} {
|
|
# device newdevice [samenv name]
|
|
device makeitem action rebuild
|
|
sct rebuild_addon 1
|
|
}
|
|
|
|
proc secop::describe {} {
|
|
sct send describe
|
|
return secop::describing
|
|
}
|
|
|
|
proc secop::describing {} {
|
|
#obsolete?
|
|
lassign [sct result] messagetype par val
|
|
switch $messagetype {
|
|
describing {
|
|
do_as_manager {
|
|
make_node $val
|
|
}
|
|
}
|
|
default {
|
|
clientput "ignore $messagetype $par ..."
|
|
}
|
|
}
|
|
sct send activate
|
|
sct end_fast [expr [DoubleTime] + 5]
|
|
return secop::update_
|
|
}
|
|
|
|
proc secop_send {args} {
|
|
hset /secop $args
|
|
hsetprop /secop sent_message $args
|
|
hsetprop /secop sent_time [DoubleTime]
|
|
}
|
|
|
|
publishLazy secop_send
|