Obsolete since MKs visit.
r1459 | ffr | 2007-02-12 11:57:49 +1100 (Mon, 12 Feb 2007) | 2 lines
This commit is contained in:
Ferdi Franceschini
committed by
Douglas Clowes
Douglas Clowes
parent
9e2b5f71bb
commit
22354b9836
@@ -1,94 +0,0 @@
|
||||
# Defines lists of parameters for SICS device objects which are useful for a
|
||||
# GUI client operating on a get/set paradigm.
|
||||
|
||||
# Using namespaces to create complex heirarchical data structures
|
||||
# deviceType::<device>{deviceType, primaryProperty, parList}
|
||||
namespace eval deviceType {
|
||||
namespace eval Motor {
|
||||
set deviceType Motor;
|
||||
set primaryProperty {position USER Float {} };
|
||||
set parList [list \
|
||||
accesscode MANAGER Float {}\
|
||||
failafter MANAGER Float {}\
|
||||
fixed USER Float {}\
|
||||
hardlowerlim MANAGER Float {}\
|
||||
hardupperlim MANAGER Float {}\
|
||||
ignorefault MANAGER Float {}\
|
||||
interruptmode MANAGER Float {}\
|
||||
maxretry MANAGER Float {}\
|
||||
movecount MANAGER Float {}\
|
||||
precision MANAGER Float {}\
|
||||
sign MANAGER Float {}\
|
||||
softlowerlim USER Float {}\
|
||||
softupperlim USER Float {}\
|
||||
softzero USER Float {}\
|
||||
accel USER Float {}\
|
||||
decel USER Float {}\
|
||||
home MANAGER Float {}\
|
||||
maxaccel READ_ONLY Float {}\
|
||||
maxdecel READ_ONLY Float {}\
|
||||
maxspeed READ_ONLY Float {}\
|
||||
speed USER Float {}\
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
namespace eval ConfigurableVirtualMotor {
|
||||
set deviceType ConfigurableVirtualMotor;
|
||||
set primaryProperty {position USER Float {} };
|
||||
set parList [list \
|
||||
]
|
||||
}
|
||||
|
||||
namespace eval SingleCounter {
|
||||
set deviceType SingleCounter;
|
||||
set primaryProperty {counts READ_ONLY Float {}};
|
||||
|
||||
proc counting {counterName args} {
|
||||
variable Start Stop
|
||||
switch $args {
|
||||
start {
|
||||
set preset [$counterName getpreset];
|
||||
set preset [string trim [lindex [split $preset =] 1]];
|
||||
$counterName count $preset;
|
||||
}
|
||||
stop {
|
||||
$counterName stop;
|
||||
}
|
||||
}
|
||||
}
|
||||
publish ::deviceType::SingleCounter::counting user;
|
||||
|
||||
set parList [list \
|
||||
counting USER Text {start stop}\
|
||||
preset USER Float {}\
|
||||
setexponent USER Float {}\
|
||||
getexponent READ_ONLY Float {}\
|
||||
mode USER Text {monitor timer}\
|
||||
setexponent USER Float {}\
|
||||
getmonitor READ_ONLY Float {}\
|
||||
status READ_ONLY Text {}\
|
||||
gettime READ_ONLY Float {}\
|
||||
getthreshold READ_ONLY Float {}\
|
||||
setthreshold USER Float {} ]
|
||||
}
|
||||
|
||||
namespace eval HistMem {
|
||||
set deviceType HistMem;
|
||||
set primaryProperty {enable USER Text {} };
|
||||
set parList [list \
|
||||
]
|
||||
}
|
||||
}
|
||||
set countParList $::deviceType::SingleCounter::parList
|
||||
set motParList $::deviceType::Motor::parList
|
||||
set virtmotParList $::deviceType::ConfigurableVirtualMotor::parList
|
||||
|
||||
|
||||
set scanParList [list \
|
||||
]
|
||||
|
||||
set hmParList [list \
|
||||
]
|
||||
|
||||
|
||||
@@ -1,26 +0,0 @@
|
||||
gen_hipadaba_config.tcl
|
||||
Generates hipadaba_configuration.tcl script from the device
|
||||
configuration files (eg motor_configuration.tcl) for an instrument.
|
||||
|
||||
gen_hipadaba.tcl <deployed to ics hosts>
|
||||
This script is sourced by the SICS configuration file at runtime to
|
||||
install hipadaba and create the hpaths and hipadaba scripts.
|
||||
|
||||
gen_hpdbxml.tcl
|
||||
Uses tdom to create the instrument xml file by sourcing the
|
||||
hipadaba_configuration.tcl script which executes the the hmake and
|
||||
makeHdb<device> commands defined in hpdbxml.tcl.
|
||||
|
||||
hipadaba_support.tcl
|
||||
Defines the makeHdb<device> commands which create hipadaba nodes along
|
||||
with their read and write scripts. The makeHdb<device> commands
|
||||
are called by sourcing the hipadaba_configuration.tcl script when SICS
|
||||
is launched.
|
||||
|
||||
hpdbxml.tcl
|
||||
Defines the hmake and makeHdb<device> commands which create the XML DOM nodes
|
||||
for the instrument description file InstXML.xml
|
||||
|
||||
ParList.tcl
|
||||
Defines lists of parameters for SICS device objects which are useful for a GUI
|
||||
client operating on a get/set paradigm.
|
||||
@@ -1,21 +0,0 @@
|
||||
# $Revision: 1.2 $
|
||||
# $Date: 2006-12-03 22:46:43 $
|
||||
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
||||
# Last revision by: $Author: ffr $
|
||||
|
||||
source hipadaba_support.tcl
|
||||
#-------------------------------------------------------------------------
|
||||
# Install the SICS Hipadaba
|
||||
#-------------------------------------------------------------------------
|
||||
InstallHdb
|
||||
source hipadaba_configuration.tcl
|
||||
|
||||
# PROTOTYPE for hlist -xml command
|
||||
proc xhlist {opt args} {
|
||||
set fh [open InstXML.xml];
|
||||
set InstXML [read $fh];
|
||||
close $fh;
|
||||
clientput $InstXML "value"
|
||||
}
|
||||
publish xhlist spy
|
||||
|
||||
@@ -1,89 +0,0 @@
|
||||
#!/usr/bin/tclsh
|
||||
# $Revision: 1.6 $
|
||||
# $Date: 2006-12-10 23:52:58 $
|
||||
# Author: Douglas Clowes (dcl@ansto.gov.au)
|
||||
# Last revision by $Author: dcl $
|
||||
|
||||
# Generates the hipadaba_configuration.tcl file for the
|
||||
# specified instrument.
|
||||
# Usage: from the "instrument" directory do
|
||||
# ./hipadaba/gen_hipadaba_config.tcl <instdir>
|
||||
# where <instdir> is the directory name of an instrument.
|
||||
|
||||
set instName [lindex $argv 0];
|
||||
# TODO The list of configuration files should be read in from
|
||||
# a file in the instrument directory.
|
||||
|
||||
# List of configuration files for SICS device objects.
|
||||
set infileList {motor_configuration.tcl counter.tcl}
|
||||
set fh [open $instName/hipadaba_configuration.tcl w]
|
||||
|
||||
proc publish {args} {}
|
||||
|
||||
if 1 {
|
||||
# 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}
|
||||
}
|
||||
proc setHomeandRange {args} {}
|
||||
proc SplitReply { text } {}
|
||||
proc setpos {motor pos} {}
|
||||
} else {
|
||||
source utility.tcl
|
||||
}
|
||||
|
||||
proc Motor {name type parms} {
|
||||
puts $::fh [format "%s(%s) %s %s" {makeHdbMotor $motor_hpath} $name $name $name]
|
||||
uplevel #0 "proc $name {args} {}"
|
||||
}
|
||||
proc MakeConfigurableMotor {name} {
|
||||
puts $::fh [format "%s(%s) %s %s" {makeHdbVirtMotor $motor_hpath} $name $name $name]
|
||||
uplevel #0 "proc $name {args} {}"
|
||||
}
|
||||
|
||||
proc MakeCounter {name args} {
|
||||
puts $::fh [format "%s(%s) %s %s" {makeHdbCounter $counter_hpath} $name $name $name]
|
||||
uplevel #0 "proc $name {args} {}"
|
||||
}
|
||||
|
||||
puts $fh "# Autogenerated by $argv0"
|
||||
puts $fh "# Date: [clock format [clock seconds] -format "%Y-%m-%d %H:%M:%S"]"
|
||||
puts $fh ""
|
||||
puts $fh "# This file serves a dual purpose: "
|
||||
puts $fh "# 1. At deployment time the gen_hpdbxml.tcl script creates the"
|
||||
puts $fh "# instrument description XML file (InstXML.xml) using the"
|
||||
puts $fh "# versions of the hmake and makeHdb<device> commands"
|
||||
puts $fh "# implemented in the hpdbxml.tcl script."
|
||||
puts $fh "# 2. At runtime, when SICS is launched, the gen_hipadaba.tcl script"
|
||||
puts $fh "# will create the hipadaba paths and scripts by using the"
|
||||
puts $fh "# versions of the makeHdb<device> commands implemented in the"
|
||||
puts $fh "# hipadaba_support.tcl script."
|
||||
puts $fh ""
|
||||
puts $fh "# Defines hashes which map SICS device object names to hipadaba paths"
|
||||
puts $fh "source hpaths.tcl"
|
||||
puts $fh ""
|
||||
puts $fh "# Generate hipadaba nodes for the paths in the hpaths file"
|
||||
puts $fh {foreach hp $hpaths { hmake $hp spy none }}
|
||||
puts $fh ""
|
||||
|
||||
foreach infile $infileList {
|
||||
puts $fh ""
|
||||
puts $fh ""
|
||||
puts $fh "# autogenerated from $instName/$infile"
|
||||
puts $fh "# Source Date: [clock format [file mtime $instName/$infile] -format "%Y-%m-%d %H:%M:%S"]"
|
||||
|
||||
source $instName/$infile;
|
||||
}
|
||||
|
||||
if 0 {
|
||||
foreach m $motors {
|
||||
puts [format "%s(%s) %s %s" {makeHdbMotor $motor_hpath} $name $name $name]
|
||||
}
|
||||
foreach m $vmotors {
|
||||
puts [format "%s(%s) %s %s" {makeHdbVirtMotor $motor_hpath} $name $name $name]
|
||||
}
|
||||
}
|
||||
|
||||
close $fh
|
||||
@@ -1,39 +0,0 @@
|
||||
#!/usr/bin/tclsh
|
||||
# Generates the instrument description XML file "InstXML.xml"
|
||||
# by first installing the hmake and makeHdb<device> commands
|
||||
# defined in the hpdbxml.tcl script, and then sourcing the
|
||||
# hipadaba_configuration.tcl script to call them and create the DOM.
|
||||
|
||||
set instName [lindex $argv 0];
|
||||
|
||||
proc clientput {msg code} {puts $msg}
|
||||
# Load the parameter lists required by hpdbxml.tcl
|
||||
rename ::unknown _unknown
|
||||
proc ::unknown {args} {}
|
||||
source hipadaba/ParList.tcl
|
||||
rename ::unknown ""
|
||||
rename _unknown ::unknown
|
||||
#Install the hmake and makeHdb<device> commands which generate
|
||||
# the XML DOM.
|
||||
source hipadaba/hpdbxml.tcl
|
||||
array set accesscode [list 0 READ_ONLY 1 MANAGER 2 USER 3 SPY ];
|
||||
|
||||
proc genXML {instrument} {
|
||||
global doc;
|
||||
array set instPath [list echidna hrpd wombat hipd koala qld quokka sans platypus reflectometer pelican pas taipan tas kowari rsd];
|
||||
|
||||
instrumentXML $instrument;
|
||||
cd $instPath($instrument);
|
||||
|
||||
# hipadaba_configuration.tcl is generated by gen_hipadaba_config.tcl
|
||||
source hipadaba_configuration.tcl;
|
||||
set fh [open InstXML.xml w];
|
||||
puts -nonewline $fh "<?xml version = '1.0' encoding = 'UTF-8'?>";
|
||||
puts -nonewline $fh [$doc asXML -indent none];
|
||||
close $fh;
|
||||
}
|
||||
|
||||
|
||||
if {$tcl_interactive==0} {
|
||||
genXML $instName;
|
||||
}
|
||||
@@ -1,77 +0,0 @@
|
||||
# Defines the makeHdb<device> commands which create hipadaba nodes along
|
||||
# with their read and write scripts. The makeHdb<device> commands are called
|
||||
# by sourcing the hipadaba_configuration.tcl script when SICS is launched.
|
||||
|
||||
source ParList.tcl
|
||||
|
||||
# Common code for making Motor and ConfigurableVirtualMotor hdb scripts.
|
||||
set hdbMakeAnyMotorScript {
|
||||
append devPath $hpath "/" $treename
|
||||
eval hmake $devPath spy none
|
||||
foreach {ppName ppPriv ppType ppVal} $primaryProperty {
|
||||
eval hmakescript "$devPath/$ppName" \"$sicsname\" \"run $sicsname\" $ppType;
|
||||
}
|
||||
foreach {name priv type value} $parList {
|
||||
eval hmakescript "$devPath/$name" \"$sicsname $name\" \"$sicsname $name\" $type
|
||||
}
|
||||
}
|
||||
|
||||
# These commands make a hipadaba script in their devices namespace
|
||||
proc ::deviceType::Motor::hdbMakeScript {hpath treename sicsname} {
|
||||
variable parList;
|
||||
variable primaryProperty;
|
||||
global hdbMakeAnyMotorScript;
|
||||
eval $hdbMakeAnyMotorScript;
|
||||
}
|
||||
|
||||
proc ::deviceType::ConfigurableVirtualMotor::hdbMakeScript {hpath treename sicsname} {
|
||||
variable parList;
|
||||
variable primaryProperty;
|
||||
global hdbMakeAnyMotorScript;
|
||||
eval $hdbMakeAnyMotorScript;
|
||||
}
|
||||
|
||||
proc ::deviceType::SingleCounter::hdbMakeScript {hpath treename sicsname} {
|
||||
variable parList;
|
||||
variable primaryProperty;
|
||||
|
||||
append devPath $hpath "/" $treename;
|
||||
eval hmake $devPath spy none;
|
||||
|
||||
foreach {ppName ppPriv ppType ppVal} $primaryProperty {
|
||||
eval hmakescript "$devPath/$ppName" \"$sicsname getcounts\" \"\" $ppType
|
||||
}
|
||||
|
||||
foreach {name priv type value} $parList {
|
||||
switch $name {
|
||||
counting {
|
||||
set cmd ::deviceType::SingleCounter::counting
|
||||
eval hmakescript "$devPath/$name" \"\" \"$cmd $sicsname\" $type
|
||||
}
|
||||
default {
|
||||
eval hmakescript "$devPath/$name" \"$sicsname $name\" \"$sicsname $name\" $type
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
# These commands will be called when the hipadaba configuration file is sourced
|
||||
proc makeHdbMotor {hpath treename sicsname} {
|
||||
::deviceType::Motor::hdbMakeScript $hpath $treename $sicsname;
|
||||
}
|
||||
|
||||
proc makeHdbVirtMotor {hpath treename sicsname} {
|
||||
::deviceType::ConfigurableVirtualMotor::hdbMakeScript $hpath $treename $sicsname;
|
||||
}
|
||||
|
||||
proc makeHdbCounter {hpath treename sicsname} {
|
||||
::deviceType::SingleCounter::hdbMakeScript $hpath $treename $sicsname;
|
||||
}
|
||||
|
||||
#FIXME implement makeHdbHM
|
||||
proc makeHdbHM {hpath treename sicsname} {
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc hdbReadOnly {} {
|
||||
error "Parameter is READ ONLY"
|
||||
}
|
||||
@@ -1,144 +0,0 @@
|
||||
# Commands to generate xml tags for instrument description file
|
||||
package require tdom;
|
||||
|
||||
# To add a new element in the instrument xml file do the following,
|
||||
# 1. Add the element name to the tags list
|
||||
# 2. Modify the hdbMakeXML procedures that should use the new element
|
||||
|
||||
# This is a list of the xml tags in an instrument xml file.
|
||||
set tags [list part device property val];
|
||||
foreach tag $tags {dom createNodeCmd elementNode $tag}
|
||||
dom createNodeCmd textNode text_node;
|
||||
|
||||
# hmake path priv dataType [length]
|
||||
proc hmake {hpath priv dataType args} {
|
||||
global doc root part;
|
||||
set parent $root;
|
||||
foreach pid [split [string trimleft $hpath /] /] {
|
||||
set node [eval "$parent selectNodes {//part\[@id='$pid'\]}"];
|
||||
if {$node == ""} {
|
||||
set child [$doc createElement part];
|
||||
$child setAttribute id $pid;
|
||||
$parent appendChild $child;
|
||||
set parent $child;
|
||||
} else {
|
||||
set parent $node;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc instrumentXML {instrument} {
|
||||
global doc root
|
||||
set doc [dom createDocumentNS commonj.sdo sdo:datagraph];
|
||||
set root [$doc createElementNS http://www.psi.ch/sics/hipadaba hipadaba:Instrument];
|
||||
$root setAttribute label $instrument;
|
||||
[$doc documentElement] appendChild $root;
|
||||
}
|
||||
|
||||
# Return node corresponding to hpath
|
||||
proc hpathNode {hpath} {
|
||||
global root;
|
||||
set partsList [split [string trimleft $hpath /] /];
|
||||
# make selectNodes argument
|
||||
set snarg "{/";
|
||||
foreach pid $partsList {
|
||||
set p [subst -nocommand {/part[@id='$pid']}];
|
||||
set snarg [append snarg $p];
|
||||
}
|
||||
set snarg [append snarg "}"];
|
||||
set node [eval "$root selectNodes $snarg"];
|
||||
return $node;
|
||||
}
|
||||
|
||||
# This code is shared by Motor and ConfigurableVirtualMotor objects.
|
||||
set hdbMakeAnyMotorXML {
|
||||
set node [hpathNode $hpath];
|
||||
if {$node == ""} {
|
||||
clientput "$hpath doesn't exist" error;
|
||||
return 1;
|
||||
}
|
||||
$node appendFromScript {
|
||||
foreach {ppName ppPriv ppType ppValue} $primaryProperty {}
|
||||
device id $treename deviceType $deviceType primaryProperty $ppName {
|
||||
property privilege $ppPriv dataType $ppType id $ppName {
|
||||
foreach v $ppValue { val {text_node $v}}
|
||||
}
|
||||
foreach {name priv type value} $parList {
|
||||
property privilege $priv dataType $type id $name {
|
||||
foreach v $value { val {text_node $v}}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc ::deviceType::Motor::hdbMakeXML {hpath treename sicsname} {
|
||||
variable parList;
|
||||
variable deviceType;
|
||||
variable primaryProperty;
|
||||
global hdbMakeAnyMotorXML;
|
||||
eval $hdbMakeAnyMotorXML;
|
||||
}
|
||||
|
||||
proc ::deviceType::ConfigurableVirtualMotor::hdbMakeXML {hpath treename sicsname} {
|
||||
variable parList;
|
||||
variable deviceType;
|
||||
variable primaryProperty;
|
||||
global hdbMakeAnyMotorXML;
|
||||
eval $hdbMakeAnyMotorXML;
|
||||
}
|
||||
|
||||
proc ::deviceType::SingleCounter::hdbMakeXML {hpath treename sicsname} {
|
||||
variable parList;
|
||||
variable deviceType;
|
||||
variable primaryProperty;
|
||||
set node [hpathNode $hpath];
|
||||
if {$node == ""} {
|
||||
clientput "$hpath doesn't exist" error;
|
||||
return 1;
|
||||
}
|
||||
$node appendFromScript {
|
||||
foreach {ppName ppPriv ppType ppValue} $primaryProperty {}
|
||||
device id $treename deviceType $deviceType primaryProperty $ppName {
|
||||
property privilege $ppPriv dataType $ppType id $ppName {
|
||||
foreach v $ppValue { val {text_node $v}}
|
||||
}
|
||||
foreach {name priv type value} $parList {
|
||||
property privilege $priv dataType $type id $name {
|
||||
foreach v $value { val {text_node $v}}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc makeHdbMotor {hpath treename sicsname} {
|
||||
::deviceType::Motor::hdbMakeXML $hpath $treename $sicsname;
|
||||
}
|
||||
|
||||
proc makeHdbVirtMotor {hpath treename sicsname} {
|
||||
::deviceType::ConfigurableVirtualMotor::hdbMakeXML $hpath $treename $sicsname;
|
||||
}
|
||||
|
||||
proc makeHdbCounter {hpath treename sicsname} {
|
||||
::deviceType::SingleCounter::hdbMakeXML $hpath $treename $sicsname;
|
||||
}
|
||||
|
||||
proc makeHdbHM {hpath treename sicsname} {
|
||||
global hmParList;
|
||||
set node [hpathNode $hpath];
|
||||
if {$node == ""} {
|
||||
clientput "$hpath doesn't exist" error;
|
||||
return 1;
|
||||
}
|
||||
$node appendFromScript {
|
||||
device id $treename {
|
||||
foreach {name priv type value} $hmParList {
|
||||
property privilege $priv dataType $type id $name {
|
||||
foreach v $value { val {text_node $v}}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user