Files
sea/tcl/drivers/secop_3.tcl
2022-08-22 14:59:00 +02:00

755 lines
20 KiB
Tcl

# secop driver 3 (v1.0 RC2): modules/accesibles are JSON objects, datatype is 1-element JSON object
namespace eval secop {} {
}
proc stdConfig::secop {{shownUnits ALL}} {
variable node
variable name
controller secop3 timeout=60
prop commerror secop::errorscript_
prop connection_lost 0
prop check secop::check
prop write secop::write
prop startcmd *IDN?
prop end_fast 0
prop secopPath /$name
prop active 0
prop shownUnits $shownUnits
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] 1
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 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 validator [silent {} sct validator]
eval $validator
lassign [split [hinfo [sct]] ","] type
if {$type eq "text"} {
set msg "change [sct secopar] \"[sct target]\""
} else {
set msg "change [sct secopar] [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::write {} {
# dummy write
# clientput "secop::write [sct] [hvali [sct]]"
return idle
}
proc secop::get {} {
error "secop::get is obsolete"
sct send ""
return secop::update_
}
proc secop::check_range {min max {absolute_resolution 0} {relative_resolution 0}} {
set prec [expr max($absolute_resolution, $relative_resolution * abs([sct target]))]
clientput "*** $prec [sct target] $max"
if {[sct target] < $min} {
if {[sct target] >= $min - $prec} {
sct target $min
return
}
} elseif {[sct target] > $max} {
if {[sct target] <= $max + $prec} {
sct target $max
return
}
} else {
return
}
error "[sct] value must be within \[$min, $max\]"
}
proc secop::check_length {min max} {
set len [string length [sct target]]
if {$len < $min || $len > $max} {
error "[sct] string length must be within \[$min, $max\]"
}
}
proc secop::check_bool {} {
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
lassign [silent "" set props(datatype)] secoptype0 datadesc
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
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 {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
}
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"} {
if {[sct shownUnits] eq "ALL" || [lsearch [sct shownUnits] $unit] >= 0} {
GraphAdd $path $unit
}
}
}
if {[info exists props(description)]} {
hsetprop $path help "$props(description)$fmtunit"
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 false
}
if {$wid > 8} {
hsetprop $path width $wid
}
}
bool {
hsetprop $path enum 1
hsetprop $path validator secop::check_bool
}
double {
set min [silent -inf dict get $datadesc min]
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 {
set min [silent -inf dict get $datadesc min]
set max [silent inf dict get $datadesc max]
hsetprop $path validator [concat secop::check_range $min $max]
}
string {
set min [silent -inf dict get $datadesc min]
set max [silent inf dict get $datadesc max]
hsetprop $path width 16
hsetprop $path validator [concat secop::check_length $min $max]
}
}
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
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)
}
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 [lindex $props(datatype) 1]
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 datatype $argument
make_par $secopar $desc
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"
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 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]
lassign $datatype 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_ {{wait_for {}}} {
if {$wait_for eq ""} {
set return_script idle
} else {
set return_script "secop::update_ $wait_for"
}
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
switch $messagetype {
update - changed {
# clientput "*** [DoubleTime]: [sct result]"
#if {[sct] ne "/secop"} {
# clientput "[sct] is not /secop, why?"
#}
#if {![sct active]} {
# clientput [sct result]
#}
if {$messagetype eq "changed"} {
if {[string match *:target $par]} {
hsetprop /$obj writestatus done
}
hsetprop $path changed 0
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 {[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 {
catch {hdelprop $objpath group}
set shown 0
}
if {$value < 100 || $value >= 400} { # error
updateerror $objpath $text_value
catch {
logsetup $objpath/target clear
}
if {[silent 0 hgetpropval $objpath status] eq "run"} {
hsetprop $objpath status posfault
}
} else {
if {$value >= 300} { # busy
hsetprop $objpath status run
} else {
hsetprop $objpath status idle
}
logsetup $objpath 1
}
GraphItem shown $objpath $shown
if {[silent "" hgetpropval $objpath/target logger_name] ne ""} {
GraphItem shown $objpath/target $shown
}
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 {
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]
} else {
clientput ACTIVE
}
sct active 1
sct end_fast 0
}
error {
lassign $val origin errortext
lassign $origin requesttype requestpar requestval
set path [silent "" hgetpropval /sics/[sct controller] p_$requestpar]
if {$requesttype eq "change" && $path ne ""} {
hsetprop $path changed 0
}
if {$origin eq $sent_message} {
set message_to_client [sct result]
} else {
clientput "ERROR: $path $errortext"
}
}
describing {
do_as_manager {
make_node $val
}
sct send activate
[sct controller] poll [sct] 0.001
return secop::update_
}
default {
if {[string match "*,*" $messagetype]} {
clientput IDN=[sct result]
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 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 {} {
[sct objectName] stop
sct writestatus done
sct status idle
# clientput HALT:[sct]
return idle
}
proc secop::start {} {
sct send *IDN?
return secop::update_
}
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