Adding counter support.

r1343 | ffr | 2006-12-04 09:46:43 +1100 (Mon, 04 Dec 2006) | 2 lines

site_ansto/instrument/hipadaba/ParList.tcl

@@ -1,52 +1,94 @@
-set countParList [list \
+# Defines lists of parameters for SICS device objects which are useful for a
-      setpreset USER Float\
+# GUI client operating on a get/set paradigm.
-      getpreset READ_ONLY Float\
+
-      setexponent USER Float\
+# Using namespaces to create complex heirarchical data structures
-      getexponent READ_ONLY Float\
+# deviceType::<device>{deviceType, primaryProperty, parList}
-      setmode USER Float\
+namespace eval deviceType {
-      getmode READ_ONLY Float\
+  namespace eval Motor {
-      setexponent USER Float\
+    set deviceType Motor;
-      getcounts READ_ONLY Float\
+    set primaryProperty {position USER Float {} };
-      getmonitor READ_ONLY Float\
+    set parList [list \
-      count USER Float\
+      accesscode MANAGER Float {}\
-      status READ_ONLY Text\
+      failafter MANAGER Float {}\
-      gettime READ_ONLY Float\
+      fixed USER Float {}\
-      getthreshold READ_ONLY Float\
+      hardlowerlim MANAGER Float {}\
-      setthreshold USER Float\
+      hardupperlim MANAGER Float {}\
-      send MANAGER Text\
+      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 {}\
       ]
 
-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\
-]
 
-set virtmotParList [list \
+  namespace eval ConfigurableVirtualMotor {
-      position USER Float\
+    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 \
 ]
+
+

site_ansto/instrument/hipadaba/gen_hipadaba.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.1 $
+# $Revision: 1.2 $
-# $Date: 2006-11-06 21:34:20 $
+# $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"

site_ansto/instrument/hipadaba/gen_hipadaba_config.tcl

@@ -1,11 +1,20 @@
 #!/usr/bin/tclsh
-# $Revision: 1.2 $
+# $Revision: 1.3 $
-# $Date: 2006-11-22 06:32:35 $
+# $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"
+proc MakeCounter {name args} {
-puts $fh "# Output Date: [clock format [clock seconds] -format "%Y-%m-%d %H:%M:%S"]"
+  puts $::fh [format "%s(%s) %s %s" {makeHdbCounter $counter_hpath} $name $name $name]
-puts $fh "# Source Date: [clock format [file mtime $infile] -format "%Y-%m-%d %H:%M:%S"]"
+  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 {

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<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;

site_ansto/instrument/hipadaba/hipadaba_support.tcl

@@ -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} {
+# Common code for making Motor and ConfigurableVirtualMotor hdb scripts.
-	global countParList;
+set hdbMakeAnyMotorScript {
-	append Name $hpath "/" $treename
+	append devPath $hpath "/" $treename
-	eval hmake $Name spy none
+	eval hmake $devPath spy none
-	foreach {name priv type} $countParList {
+	foreach {ppName ppPriv ppType ppVal} $primaryProperty {
-		set parName [format "%s/%s" $Name $name]
+    eval hmakescript "$devPath/$ppName" \"$sicsname\" \"run $sicsname\" $ppType;
-		eval hmakescript $parName \"$sicsname $name\" \"$sicsname $name\" float
+  }
+	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;
+  ::deviceType::Motor::hdbMakeScript $hpath $treename $sicsname;
-	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
-	} 
 }
+
 proc makeHdbVirtMotor {hpath treename sicsname} {
-	append motName $hpath "/" $treename
+  ::deviceType::ConfigurableVirtualMotor::hdbMakeScript $hpath $treename $sicsname;
-	eval hmake $motName spy none
-	eval hmakescript "$motName/position" \"$sicsname\" \"run $sicsname\" float
 }
+
+proc makeHdbCounter {hpath treename sicsname} {
+  ::deviceType::SingleCounter::hdbMakeScript $hpath $treename $sicsname;
+}
+
 #FIXME implement makeHdbHM
 proc makeHdbHM {hpath treename sicsname} {
 }

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,37 +49,81 @@ 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 {ppName ppPriv ppType ppValue} $primaryProperty {}
-      foreach {name priv type} $motParList {
+    device id $treename deviceType $deviceType primaryProperty $ppName {
-        property privilege $priv dataType $type id $name;
+      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} {
+proc ::deviceType::Motor::hdbMakeXML  {hpath treename sicsname} {
-  global virtmotParList;
+  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 {ppName ppPriv ppType ppValue} $primaryProperty {}
-      foreach {name priv type} $virtmotParList {
+    device id $treename deviceType $deviceType primaryProperty $ppName {
-        property privilege $priv dataType $type id $name;
+      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;
@@ -82,8 +134,10 @@ proc makeHdbHM {hpath treename sicsname} {
   }
   $node appendFromScript {
     device id $treename {
-      foreach {name priv type} $hmParList {
+      foreach {name priv type value} $hmParList {
-        property privilege $priv dataType $type id $name;
+        property privilege $priv dataType $type id $name {
+          foreach v $value { val {text_node $v}}
+        } 
       }
     }
   }