435 lines
12 KiB
Tcl
435 lines
12 KiB
Tcl
namespace eval SECoP {} {
|
|
}
|
|
|
|
proc SECoP::check_range {{low None} {high None}} {
|
|
[sct controller] timeout 0.001
|
|
if {$low ne "None" && [sct target] < $low} {
|
|
error "value [sct target] must be >= $low"
|
|
}
|
|
if {$high ne "None" && [sct target] > $high} {
|
|
error "value [sct target] must be <= $high"
|
|
}
|
|
}
|
|
|
|
proc SECoP::check_bool {} {
|
|
[sct controller] timeout 0.001
|
|
switch -- [string tolower [sct target]] {
|
|
off - false - no - 0 - on - true - yes - 1 {
|
|
return
|
|
}
|
|
}
|
|
error "illegal value for boolean: [sct target]"
|
|
}
|
|
|
|
proc SECoP::check_length {{low None} {high None}} {
|
|
if {$low ne "None" && [string length [sct target]] < $low} {
|
|
error "value [sct target] must not be shorter than $low"
|
|
}
|
|
if {$high ne "None" && [string length [sct target]] > $high} {
|
|
error "value [sct target] must not be longer than $high"
|
|
}
|
|
}
|
|
|
|
proc SECoP::make_par {secopar desc {kind ""}} {
|
|
set path [topath $secopar [silent "" dict get $desc group]]
|
|
array set props $desc
|
|
set validator_args [lassign [silent "" set props(datatype)] secoptype0]
|
|
if {$secoptype0 eq "tuple" && [string match *:status $secopar]} {
|
|
lassign $validator_args elements
|
|
make_par0 text ${path}_text $secopar $desc
|
|
hsetprop ${path}_text width 24
|
|
set validator_args [lassign [lindex $elements 0] secoptype]
|
|
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 {set type text}
|
|
none {set type none}
|
|
default {
|
|
clientput "unknown type for $secopar (use text): $secoptype ($props(datatype))"
|
|
set type text
|
|
}
|
|
}
|
|
make_par0 $type $path $secopar $desc $kind
|
|
hsetprop $path secoptype $secoptype0
|
|
if {$status_node} {
|
|
hsetprop $path nonewline 1
|
|
}
|
|
switch -- $secoptype {
|
|
enum {
|
|
set enumprop [list]
|
|
set wid 8
|
|
foreach {name value} [lindex $validator_args 0] {
|
|
lappend enumprop "$name=$value"
|
|
set wid [expr max($wid,[string length $name])]
|
|
}
|
|
hsetprop $path enum [join $enumprop ,]
|
|
if {$wid > 8} {
|
|
hsetprop $path width $wid
|
|
}
|
|
}
|
|
bool {
|
|
hsetprop $path enum 1
|
|
hsetprop $path validator SECoP::check_bool
|
|
}
|
|
double - int {
|
|
hsetprop $path validator [concat SECoP::check_range $validator_args]
|
|
}
|
|
string {
|
|
hsetprop $path width 16
|
|
hsetprop $path validator [concat SECoP::check_range $validator_args]
|
|
}
|
|
}
|
|
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 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 objectPath $path
|
|
hsetprop /sics/[sct controller] p_$secopar:value $path
|
|
} else {
|
|
if {$par eq "status"} {
|
|
set path /$obj/s_status
|
|
}
|
|
# clientput "PAR $path $type"
|
|
hfactory $path plain $priv $type
|
|
if {[info exists props(visibility)]} {
|
|
if {$props(visibility) >= 3} {
|
|
hsetprop $path visible false
|
|
}
|
|
}
|
|
}
|
|
hsetprop $path secopar $secopar
|
|
hsetprop /sics/[sct controller] p_$secopar $path
|
|
if {!$readonly} {
|
|
[sct controller] write $path
|
|
} else {
|
|
[sct controller] connect $path
|
|
}
|
|
logsetup $path 1
|
|
if {[info exists props(value)]} {
|
|
clientput "VALUE in descr $path"
|
|
if {[catch {hupdate /$path $props(value)} msg]} {
|
|
clientput $msg
|
|
}
|
|
unset props(value)
|
|
}
|
|
set fmtunit ""
|
|
if {[info exists props(unit)]} {
|
|
set fmtunit [format { [%s]} $props(unit)]
|
|
if {$par eq "" || $par eq "target"} {
|
|
if {[sct shownUnits] eq "ALL" || [lsearch [sct shownUnits] $props(unit)] >= 0} {
|
|
GraphAdd $path $props(unit) [join [lrange [split $path /] 1 end] .]
|
|
}
|
|
}
|
|
}
|
|
if {[info exists props(description)]} {
|
|
hsetprop $path help "$props(description)$fmtunit"
|
|
unset props(description)
|
|
}
|
|
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] /]
|
|
lassign [lindex [silent "" set props(datatype)] 1] secoptype validator
|
|
if {$secoptype 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 {
|
|
if {[llength $secoptype] == 1} {
|
|
set secoptype [lindex $secoptype 0]
|
|
}
|
|
dict set desc datatype $secoptype
|
|
make_par $secopar $desc
|
|
lassign $secoptype maintype
|
|
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"
|
|
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
|
|
}
|
|
}
|
|
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 datatype none]
|
|
}
|
|
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] {
|
|
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 datatype [dict get $pardesc datatype]
|
|
if {[lindex $datatype 0] eq "command"} {
|
|
if {[lindex $datatype 1] 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 moditem $modlist {
|
|
lassign $moditem modname moddesc
|
|
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 s_status
|
|
}
|
|
if {[string match {_*} $parameter]} {
|
|
set parameter [string range $parameter 1 end]
|
|
}
|
|
if {$pargroup ne ""} {
|
|
return "/$module/$pargroup/$parameter"
|
|
}
|
|
return "/$module/$parameter"
|
|
}
|
|
|
|
proc SECoP::msg_describing {secnode specifier val} {
|
|
do_as_manager {
|
|
make_node $val
|
|
}
|
|
$secnode activate
|
|
}
|
|
|
|
proc SECoP::msg_changed {secnode par val} {
|
|
variable sentto_$secnode
|
|
if {[string match *:target $par]} {
|
|
hsetprop /$obj writestatus done
|
|
}
|
|
hsetprop $path changed 0
|
|
if {[lrange [set sentto_$secnode] 0 1] eq [list change $par]} {
|
|
set message_to_client "change $par $val"
|
|
}
|
|
msg_update $secnode $par $val change
|
|
}
|
|
|
|
proc SECoP::msg_update {secnode par val {action update}} {
|
|
if {$action eq "update"} {
|
|
if {[DoubleTime] < [silent 0 hgetpropval $path changed] + 10} {
|
|
# ignore updates of variables during change
|
|
# clientput "ignore [sct result]"
|
|
return
|
|
}
|
|
if {[lrange $sent_message 0 1] eq [list read $par]} {
|
|
set message_to_client "$action $par $val"
|
|
}
|
|
}
|
|
lassign $val value qual
|
|
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]
|
|
set visible_old [silent true hgetpropval $objpath visible]
|
|
if {$text_value ne "disabled"} {
|
|
set visible_new true
|
|
set shown 1
|
|
} else {
|
|
set visible_new false
|
|
set shown 0
|
|
}
|
|
if {$visible_new ne $visible_old} {
|
|
hsetprop $objpath visible $visible_new
|
|
GraphItem shown $objpath $shown
|
|
}
|
|
lassign $value value
|
|
if {[catch {updateval ${path}_text $text_value}]} {
|
|
clientput "cannot update ${path}_text to $text_value"
|
|
clientput "MSG($action $par $val)"
|
|
}
|
|
if {[string match *:status $par]} {
|
|
if {[silent 0 hgetpropval /$obj writestatus] eq "start"} {
|
|
set status run
|
|
} elseif {[string match 3* $value]} {
|
|
set status run
|
|
} elseif {[string match 4* $value]} {
|
|
set status posfault
|
|
} else {
|
|
set status idle
|
|
}
|
|
hsetprop /$obj status $status
|
|
}
|
|
}
|
|
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]} {
|
|
# clientput [sct result]/[silent "" hgetpropval /$obj status]
|
|
if {[silent "" hgetpropval /$obj status] eq "idle"} {
|
|
hsetprop /$obj target $value
|
|
}
|
|
}
|
|
catch {
|
|
hsetprop $path timestamp [dict get $qual t]
|
|
}
|
|
}
|
|
|
|
proc SECoP::msg_pong {secnode args} {
|
|
clientlog "pong $secnode $args"
|
|
}
|
|
|
|
proc SECoP::msg_done {secnode args} {
|
|
clientlog "done $secnode $args"
|
|
}
|
|
|
|
proc SECoP::msg_active {secnode args} {
|
|
clientlog "active $secnode $args"
|
|
}
|
|
|
|
proc SECoP::msg_error {secnode args} {
|
|
clientlog "error $secnode $args"
|
|
}
|