286 lines
8.4 KiB
Tcl
286 lines
8.4 KiB
Tcl
# Some useful functions for SICS configuration.
|
|
|
|
# $Revision: 1.6 $
|
|
# $Date: 2007-08-20 22:52:25 $
|
|
# 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 {
|
|
variable instrument_names [list echidna wombat kowari quokka platypus pelican taipan]
|
|
variable sics_port
|
|
set base_port 60000
|
|
set currbase $base_port
|
|
foreach inst $instrument_names {
|
|
array set sics_port [list\
|
|
telnet-$inst $currbase\
|
|
interrupt-$inst [expr {$currbase+1}]\
|
|
server-$inst [expr {$currbase+2}]\
|
|
quieck-$inst [expr {$currbase+3}]\
|
|
]
|
|
set currbase [expr {$currbase+100}]
|
|
}
|
|
namespace export instname;
|
|
namespace export get_portnum;
|
|
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 false} {aklass @none} {acontrol false} {adata false}} {
|
|
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];
|
|
}
|
|
}
|
|
|
|
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
|
|
}
|
|
}
|
|
proc ::utility::set_envcontrol_attributes {} {
|
|
foreach ec [sicslist type environment_controller] {
|
|
sicslist setatt $ec kind hobj
|
|
sicslist setatt $ec data true
|
|
sicslist setatt $ec control true
|
|
sicslist setatt $ec nxsave true
|
|
sicslist setatt $ec privilege user
|
|
sicslist setatt $ec nxalias $ec
|
|
sicslist setatt $ec mutable true
|
|
sicslist setatt $ec klass sample
|
|
}
|
|
}
|
|
|
|
# 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] =] ]]
|
|
}
|
|
|
|
proc ::utility::GetUID {userName} {
|
|
set fh [open /etc/passwd r]
|
|
while {[gets $fh tmpName] != -1} {
|
|
if {1 == [regexp "^$userName:" $tmpName]} {
|
|
close $fh
|
|
return [lindex [split $tmpName :] 2]
|
|
}
|
|
}
|
|
close $fh error "\"$userName\" not found in /etc/passwd"
|
|
}
|
|
|
|
##\brief Determine if list l1 begins with list l2
|
|
proc lstarts_with {l1 l2} {
|
|
foreach {e2} $l2 {e1} $l1 {
|
|
if {$e2 == ""} {return 1}
|
|
if {$e1 != $e2} {
|
|
return 0
|
|
}
|
|
}
|
|
return 1
|
|
}
|
|
|
|
##\brief Useful for converting port names to numbers for configuration parameters.
|
|
#
|
|
#\param port this can either be a port name or number
|
|
#\return always returns the port number
|
|
proc ::utility::get_portnum {port} {
|
|
global env tcl_platform
|
|
variable sics_port
|
|
if [string is integer $port] {
|
|
return $port
|
|
} else {
|
|
set home_path_list [split [string trim $env(HOME) /] /]
|
|
set pwd_path_list [split [string trim $env(PWD) /] /]
|
|
if [lstarts_with $pwd_path_list $home_path_list] {
|
|
return [expr $sics_port($port) + [::utility::GetUID $tcl_platform(user)]]
|
|
} else {
|
|
return [portnum $port]
|
|
}
|
|
}
|
|
}
|
|
|
|
namespace import ::utility::*;
|
|
Publish getinfo spy
|
|
Publish setpos user
|
|
Publish SplitReply user
|
|
Publish instname user
|
|
|