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" }