linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adding counter support.

Browse Source 
r1343 | ffr | 2006-12-04 09:46:43 +1100 (Mon, 04 Dec 2006) | 2 lines
This commit is contained in:
Ferdi Franceschini
2006-12-04 09:46:43 +11:00
committed by Douglas Clowes
parent 31f0fca6f5
commit 602a1a5f1b
6 changed files with 273 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files

130
site_ansto/instrument/hipadaba/ParList.tcl
View File

@@ -1,52 +1,94 @@
set countParList [list \
setpreset USER Float\
getpreset READ_ONLY Float\
setexponent USER Float\
getexponent READ_ONLY Float\
setmode USER Float\
getmode READ_ONLY Float\
setexponent USER Float\
getcounts READ_ONLY Float\
getmonitor READ_ONLY Float\
count USER Float\
status READ_ONLY Text\
gettime READ_ONLY Float\
getthreshold READ_ONLY Float\
setthreshold USER Float\
send MANAGER Text\
]
# Defines lists of parameters for SICS device objects which are useful for a
# GUI client operating on a get/set paradigm.
set motParList [list \
position USER Float\
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\
]
# 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 virtmotParList [list \
position USER Float\
]
set scanParList [list \
]
set hmParList [list \
]

7
site_ansto/instrument/hipadaba/gen_hipadaba.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.1 $
# $Date: 2006-11-06 21:34:20 $
# $Revision: 1.2 $
# $Date: 2006-12-03 22:46:43 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
@@ -10,8 +10,9 @@ source hipadaba_support.tcl
InstallHdb
source hipadaba_configuration.tcl
# PROTOTYPE for hlist -xml command
proc xhlist {opt args} {
set fh [open InstXML.tcl];
set fh [open InstXML.xml];
set InstXML [read $fh];
close $fh;
clientput $InstXML "value"

50
site_ansto/instrument/hipadaba/gen_hipadaba_config.tcl
View File

@@ -1,11 +1,20 @@
#!/usr/bin/tclsh
# $Revision: 1.2 $
# $Date: 2006-11-22 06:32:35 $
# $Revision: 1.3 $
# $Date: 2006-12-03 22:46:43 $
# Author: Douglas Clowes (dcl@ansto.gov.au)
# Last revision by $Author: dcl $
# Last revision by $Author: ffr $
# 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];
set infile $instName/motor_configuration.tcl
# 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} {}
@@ -33,20 +42,39 @@ proc MakeConfigurableMotor {name} {
uplevel #0 "proc $name {args} {}"
}
puts $fh "# autogenerated from $infile"
puts $fh "# Output Date: [clock format [clock seconds] -format "%Y-%m-%d %H:%M:%S"]"
puts $fh "# Source Date: [clock format [file mtime $infile] -format "%Y-%m-%d %H:%M:%S"]"
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 "# Defines hashes which map motor names to arrays"
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 "# Enumerate the categories"
puts $fh "# Generate hipadaba nodes for the paths in the hpaths file"
puts $fh {foreach hp $hpaths { hmake $hp spy none }}
puts $fh ""
puts $fh "# Enumerate the motors"
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 $infile
source $instName/$infile;
}
if 0 {
foreach m $motors {

15
site_ansto/instrument/hipadaba/gen_hpdbxml.tcl
View File

@@ -1,9 +1,20 @@
#!/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 ];
@@ -13,8 +24,10 @@ proc genXML {instrument} {
instrumentXML $instrument;
cd $instPath($instrument);
# hipadaba_configuration.tcl is generated by gen_hipadaba_config.tcl
source hipadaba_configuration.tcl;
set fh [open InstXML.tcl w];
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;

81
site_ansto/instrument/hipadaba/hipadaba_support.tcl
View File

@@ -1,30 +1,73 @@
# Makes hipadaba scripts for sics devices.
# 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
proc makeHdbCounter {hpath treename sicsname} {
global countParList;
append Name $hpath "/" $treename
eval hmake $Name spy none
foreach {name priv type} $countParList {
set parName [format "%s/%s" $Name $name]
eval hmakescript $parName \"$sicsname $name\" \"$sicsname $name\" float
# 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} {
global motParList;
append motName $hpath "/" $treename
eval hmake $motName spy none
eval hmakescript "$motName/position" \"$sicsname\" \"run $sicsname\" float
foreach {name priv type} $motParList {
set parName [format "%s/%s" $motName $name]
eval hmakescript $parName \"$sicsname $name\" \"$sicsname $name\" float
}
::deviceType::Motor::hdbMakeScript $hpath $treename $sicsname;
}
proc makeHdbVirtMotor {hpath treename sicsname} {
append motName $hpath "/" $treename
eval hmake $motName spy none
eval hmakescript "$motName/position" \"$sicsname\" \"run $sicsname\" float
::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} {
}

82
site_ansto/instrument/hipadaba/hpdbxml.tcl
View File

@@ -1,6 +1,14 @@
# Commands to generate xml tags for instrument description file
package require tdom;
set tags [list part device property];
# 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} {
@@ -31,7 +39,7 @@ proc instrumentXML {instrument} {
proc hpathNode {hpath} {
global root;
set partsList [split [string trimleft $hpath /] /];
# make selectNodes argumet
# make selectNodes argument
set snarg "{/";
foreach pid $partsList {
set p [subst -nocommand {/part[@id='$pid']}];
@@ -41,36 +49,80 @@ proc hpathNode {hpath} {
set node [eval "$root selectNodes $snarg"];
return $node;
}
proc makeHdbMotor {hpath treename sicsname} {
global motParList;
# 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 {
device id $treename {
foreach {name priv type} $motParList {
property privilege $priv dataType $type id $name;
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 makeHdbVirtMotor {hpath treename sicsname} {
global virtmotParList;
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 {
device id $treename {
foreach {name priv type} $virtmotParList {
property privilege $priv dataType $type id $name;
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} {
@@ -82,8 +134,10 @@ proc makeHdbHM {hpath treename sicsname} {
}
$node appendFromScript {
device id $treename {
foreach {name priv type} $hmParList {
property privilege $priv dataType $type id $name;
foreach {name priv type value} $hmParList {
property privilege $priv dataType $type id $name {
foreach v $value { val {text_node $v}}
}
}
}
}