From 602a1a5f1bacdaf6958deccd13f07511fa55b180 Mon Sep 17 00:00:00 2001 From: Ferdi Franceschini Date: Mon, 4 Dec 2006 09:46:43 +1100 Subject: [PATCH] Adding counter support. r1343 | ffr | 2006-12-04 09:46:43 +1100 (Mon, 04 Dec 2006) | 2 lines --- site_ansto/instrument/hipadaba/ParList.tcl | 130 ++++++++++++------ .../instrument/hipadaba/gen_hipadaba.tcl | 7 +- .../hipadaba/gen_hipadaba_config.tcl | 50 +++++-- .../instrument/hipadaba/gen_hpdbxml.tcl | 15 +- .../instrument/hipadaba/hipadaba_support.tcl | 81 ++++++++--- site_ansto/instrument/hipadaba/hpdbxml.tcl | 82 +++++++++-- 6 files changed, 273 insertions(+), 92 deletions(-) diff --git a/site_ansto/instrument/hipadaba/ParList.tcl b/site_ansto/instrument/hipadaba/ParList.tcl index 99c5f4e1..1a7855b9 100644 --- a/site_ansto/instrument/hipadaba/ParList.tcl +++ b/site_ansto/instrument/hipadaba/ParList.tcl @@ -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::{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 \ ] + + diff --git a/site_ansto/instrument/hipadaba/gen_hipadaba.tcl b/site_ansto/instrument/hipadaba/gen_hipadaba.tcl index 985d26dc..cb35e278 100644 --- a/site_ansto/instrument/hipadaba/gen_hipadaba.tcl +++ b/site_ansto/instrument/hipadaba/gen_hipadaba.tcl @@ -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" diff --git a/site_ansto/instrument/hipadaba/gen_hipadaba_config.tcl b/site_ansto/instrument/hipadaba/gen_hipadaba_config.tcl index 61dc543e..6441d865 100644 --- a/site_ansto/instrument/hipadaba/gen_hipadaba_config.tcl +++ b/site_ansto/instrument/hipadaba/gen_hipadaba_config.tcl @@ -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 +# where 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 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 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 { diff --git a/site_ansto/instrument/hipadaba/gen_hpdbxml.tcl b/site_ansto/instrument/hipadaba/gen_hpdbxml.tcl index c4102697..01b49f36 100755 --- a/site_ansto/instrument/hipadaba/gen_hpdbxml.tcl +++ b/site_ansto/instrument/hipadaba/gen_hpdbxml.tcl @@ -1,9 +1,20 @@ #!/usr/bin/tclsh +# Generates the instrument description XML file "InstXML.xml" +# by first installing the hmake and makeHdb 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 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 ""; puts -nonewline $fh [$doc asXML -indent none]; close $fh; diff --git a/site_ansto/instrument/hipadaba/hipadaba_support.tcl b/site_ansto/instrument/hipadaba/hipadaba_support.tcl index ae7a1b18..2d012920 100644 --- a/site_ansto/instrument/hipadaba/hipadaba_support.tcl +++ b/site_ansto/instrument/hipadaba/hipadaba_support.tcl @@ -1,30 +1,73 @@ -# Makes hipadaba scripts for sics devices. +# Defines the makeHdb commands which create hipadaba nodes along +# with their read and write scripts. The makeHdb 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} { } diff --git a/site_ansto/instrument/hipadaba/hpdbxml.tcl b/site_ansto/instrument/hipadaba/hpdbxml.tcl index cb74a91d..b0aeff09 100644 --- a/site_ansto/instrument/hipadaba/hpdbxml.tcl +++ b/site_ansto/instrument/hipadaba/hpdbxml.tcl @@ -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,38 +49,82 @@ 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} { global hmParList; set node [hpathNode $hpath]; @@ -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}} + } } } }