217 lines
6.4 KiB
Tcl
217 lines
6.4 KiB
Tcl
# Some useful functions for SICS configuration.
|
|
|
|
# $Revision: 1.4 $
|
|
# $Date: 2007-07-22 05:23:41 $
|
|
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
|
# Last revision by $Author: ffr $
|
|
|
|
source util/extra_utility.tcl
|
|
source util/command.tcl
|
|
|
|
# Returns attribute name and value
|
|
proc getatt {sicsobj att} {
|
|
lindex [split [tolower_sicslist $sicsobj $att] =] 1
|
|
}
|
|
|
|
# Utility fucntion for setting the home and upper and lower
|
|
# limits for a motor
|
|
proc setHomeandRange {args} {
|
|
set usage "
|
|
Usage: setHomeandRange -motor motName -home homeVal -lowrange low -uprange high
|
|
eg
|
|
setHomeandRange -motor mchi -home 90 -lowrange 5 -uprange 7
|
|
this sets the home position to 90 degreess for motor mchi
|
|
with the lower limit at 85 and the upper limit at 97
|
|
"
|
|
if {$args == ""} {clientput $usage; return}
|
|
array set params $args
|
|
set motor $params(-motor)
|
|
set home $params(-home)
|
|
set lowlim [expr $home - $params(-lowrange)]
|
|
set uplim [expr $home + $params(-uprange)]
|
|
|
|
uplevel 1 "$motor softlowerlim $lowlim"
|
|
uplevel 1 "$motor softupperlim $uplim"
|
|
uplevel 1 "$motor home $home"
|
|
}
|
|
|
|
# Use this to create an array of named parameters to initialise motors.
|
|
proc params {args} {
|
|
upvar 1 "" x;
|
|
if [info exists x] {unset x}
|
|
foreach {k v} $args {set x([string tolower $k]) $v}
|
|
}
|
|
|
|
# Parse motor readings for virtual motor scripts.
|
|
proc SplitReply { text } {
|
|
set l [split $text =]
|
|
return [string trim [lindex $l 1]]
|
|
}
|
|
|
|
# Sets motor position reading to pos by adjusting the softzero
|
|
proc setpos {motor pos} {
|
|
set currPos [SplitReply [$motor]]
|
|
set oldZero [SplitReply [$motor softzero]]
|
|
set newZero [expr $currPos - $pos + $oldZero]
|
|
uplevel #0 "$motor softzero $newZero"
|
|
}
|
|
|
|
proc getinfo {object} {
|
|
set wc [format "%s_*" $object];
|
|
set objlist [sicslist match $wc];
|
|
foreach v $objlist {
|
|
if { [SplitReply [sicslist $v type]]== "SicsVariable"} {
|
|
clientput [$v];
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
# Convenience function for setting klass group and name attributes
|
|
# on sics object metadata
|
|
proc set_sicsobj_atts {sobj aklass agroup aname acontrol adata} {
|
|
sicslist setatt $sobj klass $aklass;
|
|
if {$agroup != "@none"} {
|
|
sicslist setatt $sobj group $agroup;
|
|
}
|
|
sicslist setatt $sobj long_name $aname;
|
|
sicslist setatt $sobj control $acontrol;
|
|
sicslist setatt $sobj data $adata;
|
|
}
|
|
|
|
## TODO put all the utility macros in the utility namespace
|
|
namespace eval utility {
|
|
namespace export instname;
|
|
variable instrument_name;
|
|
set instrument_name "";
|
|
|
|
# Convenience command for getting unadorned instrument name
|
|
proc instname {} {
|
|
variable instrument_name;
|
|
set instrument_name [SplitReply [instrument]];
|
|
proc ::utility::instname {} {
|
|
variable instrument_name;
|
|
return $instrument_name;
|
|
}
|
|
return $instrument_name;
|
|
}
|
|
|
|
# Initialise the attributes of sobj
|
|
# to make it ready for adding to the hdb tree.
|
|
proc mkData {sobj name aklass args} {
|
|
sicslist setatt $sobj long_name $name
|
|
sicslist setatt $sobj nxalias $sobj
|
|
sicslist setatt $sobj klass $aklass
|
|
switch [getatt $sobj type] {
|
|
"sicsvariable" {
|
|
sicslist setatt $sobj kind hobj
|
|
sicslist setatt $sobj data true
|
|
sicslist setatt $sobj control true
|
|
sicslist setatt $sobj nxsave true
|
|
sicslist setatt $sobj privilege internal
|
|
sicslist setatt $sobj mutable false
|
|
}
|
|
default {
|
|
error "ERROR [info level -1] -> [info level 0]"
|
|
}
|
|
}
|
|
array set attval $args
|
|
foreach att {kind data control nxsave privilege nxalias mutable} {
|
|
if {[info exists attval($att)]} {
|
|
sicslist setatt $sobj $att $attval($att)
|
|
}
|
|
}
|
|
}
|
|
# Sets the privilege attribute when making a SICS variable
|
|
# access = spy, user, manager, internal, readonly
|
|
proc mkVar {name type access {along_name x} {anxsave x} {aklass x} {acontrol x} {adata x}} {
|
|
array set sicsAccess {spy spy user user manager mugger internal internal readonly internal}
|
|
VarMake $name $type $sicsAccess($access);
|
|
sicslist setatt $name privilege $access;
|
|
sicslist setatt $name kind hobj;
|
|
sicslist setatt $name mutable false
|
|
if {$access != "internal"} {
|
|
sicslist setatt $name data $adata
|
|
sicslist setatt $name control $acontrol
|
|
sicslist setatt $name nxsave $anxsave
|
|
sicslist setatt $name klass $aklass
|
|
sicslist setatt $name long_name $along_name
|
|
}
|
|
}
|
|
|
|
proc about {option args} {
|
|
return [info $option $args];
|
|
}
|
|
}
|
|
|
|
namespace import ::utility::*;
|
|
Publish getinfo spy
|
|
Publish setpos user
|
|
Publish SplitReply user
|
|
Publish instname user
|
|
|
|
proc debug {args} {
|
|
clientput $args
|
|
}
|
|
proc echo {args} {
|
|
clientput $args
|
|
}
|
|
|
|
proc ::utility::set_sobj_attributes {} {
|
|
sicslist setatt getinfo privilege internal
|
|
sicslist setatt setpos privilege internal
|
|
sicslist setatt SplitReply privilege internal
|
|
sicslist setatt instname privilege internal
|
|
}
|
|
|
|
proc ::utility::set_histomem_attributes {} {
|
|
foreach hm [sicslist type histmem] {
|
|
sicslist setatt $hm nxalias $hm
|
|
sicslist setatt $hm mutable true
|
|
}
|
|
}
|
|
proc ::utility::set_motor_attributes {} {
|
|
# Bug: SICS-57 on Jira
|
|
# The first entry in [sicslist type motor] is 'motor' when
|
|
# we run the sicslist command on initialisation. This is because
|
|
# The 'Motor' command has type motor, so we skip it with lrange.
|
|
foreach m [lrange [sicslist type motor] 1 end] {
|
|
sicslist setatt $m kind hobj
|
|
sicslist setatt $m data true
|
|
sicslist setatt $m control true
|
|
sicslist setatt $m nxsave true
|
|
sicslist setatt $m mutable true
|
|
sicslist setatt $m units [SplitReply [$m units]]
|
|
sicslist setatt $m long_name [SplitReply [$m long_name]]
|
|
set mpart [split [SplitReply [$m part] ] .]
|
|
sicslist setatt $m klass [lindex $mpart 0]
|
|
if {[llength $mpart] == 2} {
|
|
sicslist setatt $m group [lindex $mpart 1]
|
|
}
|
|
sicslist setatt $m nxalias $m
|
|
switch [expr int([SplitReply [$m accesscode]])] {
|
|
0 {sicslist setatt $m privilege internal}
|
|
1 {sicslist setatt $m privilege manager}
|
|
2 {sicslist setatt $m privilege user}
|
|
3 {sicslist setatt $m privilege spy}
|
|
}
|
|
}
|
|
foreach m [sicslist type configurablevirtualmotor] {
|
|
sicslist setatt $m kind hobj
|
|
sicslist setatt $m data true
|
|
sicslist setatt $m control true
|
|
sicslist setatt $m nxsave true
|
|
sicslist setatt $m privilege user
|
|
sicslist setatt $m nxalias $m
|
|
sicslist setatt $m mutable true
|
|
}
|
|
}
|
|
|
|
# Retuns plain value of hdb node property
|
|
proc ::utility::hgetplainprop {hpath prop} {
|
|
return [string trim [lindex [split [hgetprop $hpath $prop] =] 1] ]
|
|
}
|
|
proc ::utility::hlistplainprop {hpath} {
|
|
return [string trim [join [split [hlistprop $hpath] =] ]]
|
|
}
|