Merged new hdb and nexus code.

r2099 | ffr | 2007-07-22 15:23:41 +1000 (Sun, 22 Jul 2007) | 2 lines

site_ansto/instrument/MANIFEST.TXT

@@ -1,3 +1,4 @@
 server_config.tcl
 util
 gumxml.tcl
+config/hmm/anstohm_linked.xml

site_ansto/instrument/config/counter/counter_common_1.tcl

@@ -1 +1,23 @@
 bm SetExponent 0
+sicslist setatt bm privilege internal
+namespace eval monitor {
+  command count {text:timer,monitor mode float: preset} {
+    #FIXME remove dependency on hdb path
+    ::monitor::count -set feedback status BUSY
+    bm setmode $mode
+    bm count $preset
+    ::monitor::count -set feedback counts [SplitReply [bm getcounts]];
+    ::monitor::count -set feedback status IDLE
+    array set param [::data::gumtree_save -list param]
+    data axis 1 $param(run_number)
+    data data_set [::utility::hgetplainprop /instrument/monitor/counts sicsdev]
+    ::hdb::set_save /instrument/monitor true
+    ::hdb::set_save /data true
+    ::hdb::set_save /instrument/detector false
+  }
+  ::monitor::count -addfb int counts text status
+  ::monitor::count -set feedback status IDLE
+  array set fbarr [::monitor::count -list feedback]
+  ::utility::mkData $fbarr(counts) counts monitor privilege user mutable true
+  array unset fbarr
+}

site_ansto/instrument/config/hipadaba/common_hipadaba_configuration.tcl

@@ -1,102 +0,0 @@
-# Defines hashes which map SICS device object names to hipadaba paths
-InstallHdb
-#Usage: xhmake /a/b spy none {type part}
-proc xhmake {path priv dtype pKey pVal} {
-  global pathlist;
-  if {[info exists pathlist($path)] == 0} {
-    set basepath "";
-    foreach p [split [string trimleft $path / ] / ] {
-      if {[info exists pathlist($basepath/$p)] == 1} {
-        append basepath /$p;
-        continue;
-      }
-      hmake $basepath/$p $priv $dtype;
-      hsetprop $basepath/$p $pKey $pVal;
-      set pathlist($basepath/$p) 1;
-      append basepath /$p;
-    }
-  }
-}
-
-hmake /commands spy none
-set pathlist(/commands) 1
-hsetprop /commands type commandset
-hmake /graphics spy none 
-set pathlist(/graphics) 1
-hsetprop /graphics type graphset
-hsetprop /commands type commandset
-
-
-#TODO change this to hparts.tcl
-source $cfPath(hipadaba)/hpaths.tcl 
-set instrument [string tolower [SplitReply [Instrument]] ]
-hmake /$instrument spy none
-hsetprop /$instrument type instrument
-set pathlist(/$instrument) 1
-hmake /$instrument/status spy none
-set pathlist(/$instrument/status) 1
-hsetprop /$instrument/status type part
-
-# Generate hipadaba nodes for the paths in the hpaths file
-foreach hp $hpaths {
-  hmake /$instrument/$hp spy none;
-  hsetprop /$instrument/$hp type part;
-  set pathlist(/$instrument/$hp) 1;
-}
-
-#--- admin
-hmake /experiment user none
-set pathlist(/experiment) 1
-hattach /experiment title title
-hattach /experiment sample description
-hmake /experiment/user spy none
-hsetprop /experiment/user type part
-set pathlist(/experiment/user) 1
-hattach /experiment/user user name
-hattach /experiment/user email email
-hattach /experiment/user phone phone
-hattach /experiment dataFileName datafile 
-
-#--- Motors
-foreach {type path} $motor_hpath {
-  if {[info exists pathlist(/$instrument/$path)] == 0} {
-    hmake /$instrument/$path spy none;
-    hsetprop /$instrument/$path type part; 
-    set pathlist(/$instrument/$path) 1;
-  }
-}
-
-array set mot_Pdic $motor_hpath;
-foreach motor [sicslist type motor] {
-  if {$motor == "motor"} {continue}
-  set mpart [SplitReply [$motor part]];
-  foreach {type group} [split $mpart .] {};
-  set path $mot_Pdic($type);
-  if {$group != ""} {
-    append path /$group;
-  } 
-  xhmake /$instrument/$path spy none type part;
-  hattach /$instrument/$path $motor [SplitReply [$motor long_name]];
-}
-
-#--- Configurable Virtual Motors
-foreach {obj name part master_obj} $cvirtmotor_hpath {
-  set path /$instrument/$part
-  hattach $path $obj $name
-  foreach m $master_obj  {
-    hchain $path/$name $path/$m
-  }
-  #FIXME polling causes scans to abort
-  #sicspoll add $path/$name hdb 2
-}
-
-
-#------------- scan command
-::scancommand::commands_hpath_setup /commands
-::scancommand::graphics_hpath_setup /graphics
-::scancommand::init
-
-#------------- plc controller
-::plc::status_hpath_setup /$instrument/status
-
-unset pathlist;

site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl

@@ -0,0 +1,108 @@
+# Root (ie /) only provides the starting point for traversing the instrument dictionary.
+#set instrument_name [string trim [lindex  [split [instrument] =] 1]]
+set instrument_name instrument
+#  / {
+#    children {commands graphics instrument experiment }
+#    property {data true control true nxsave true klass NXentry}
+#  }
+
+# / Must be the first node in the list
+set instrument_dictionary [subst {
+  commands {
+    sobj {macro command}
+    privilege spy
+    datatype @none
+    property {data false control true nxsave false klass @none type commandset}
+  }
+  graphics {
+    sobj {@any graphics}
+    privilege spy
+    datatype @none
+    property {data true control true nxsave false klass @none type graphset}
+  }
+  instrument {
+    sobj {@any instrument}
+    privilege spy
+    datatype @none
+    property {data true control true nxsave false klass NXinstrument type instrument}
+  }
+  instrument/status {
+    privilege spy
+    sobj {@any plc}
+    datatype @none
+    property {data false control true nxsave false klass @none type part}
+  }
+  instrument/detector {
+    privilege spy
+    sobj {@any detector}
+    datatype @none
+    property {data true control true nxsave false klass NXdetector type part}
+  }
+  instrument/sample {
+    privilege spy
+    sobj {@any sample}
+    datatype @none
+    property {data true control true nxsave false klass NXsample type part}
+  }
+  instrument/collimator {
+    privilege spy
+    sobj {@any collimator}
+    datatype @none
+    property {data true control true nxsave false klass NXcollimator type part}
+  }
+  instrument/monitor {
+    privilege spy
+    sobj {@any monitor}
+    datatype @none
+    property {data true control true nxsave false klass NXmonitor type part}
+  }
+  instrument/monochromator {
+    privilege spy
+    sobj {@any monochromator @any crystal}
+    datatype @none
+    property {data true control true nxsave false klass NXcrystal type part}
+  }
+  instrument/slits {
+    privilege spy
+    sobj {@any aperture}
+    datatype @none
+    property {data true control true nxsave false klass NXfilter type part}
+  }
+  experiment {
+    privilege spy
+    sobj {@any user @any experiment}
+    datatype @none
+    property {data true control true nxsave false klass NXentry type part}
+  }
+  data {
+    privilege spy
+    sobj {@any data}
+    datatype @none
+    property {data true control false nxsave false klass NXdata type part datatype UNKNOWN}
+  }
+  data/data_set {
+    privilege spy
+    datatype @none
+    property {data true control false nxsave false klass @none type nxvgroup nxalias data_set link @none}
+  }
+  data/axis_1 {
+    privilege spy
+    datatype @none
+    property {data true control false nxsave false klass @none type nxvgroup nxalias axis_1 link @none}
+  }
+  data/axis_2 {
+    privilege spy
+    datatype @none
+    property {data true control false nxsave false klass @none type nxvgroup nxalias axis_2 link @none}
+  }
+  data/axis_3 {
+    privilege spy
+    datatype @none
+    property {data true control false nxsave false klass @none type nxvgroup nxalias axis_3 link @none}
+  }
+  data/axis_4 {
+    privilege spy
+    datatype @none
+    property {data true control false nxsave false klass @none type nxvgroup nxalias axis_4 link @none}
+  }
+}]

site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl

@@ -0,0 +1,434 @@
+## \file hipadaba_configuration_common.tcl
+# \brief Commands for building the hdb tree from sics object properties and an instrument dictionary.
+#
+# hobj policy: data=false control=parent nxsave=false klass=parent
+# subtree/group_path policy:  data=parent control=parent nxsave=parent klass=parent
+# type=macro & klass=command -> kind=command
+# type=macro & klass!=command -> kind=script
+
+source $cfPath(hipadaba)/instdict_specification.tcl
+source $cfPath(hipadaba)/common_instrument_dictionary.tcl
+
+InstallHdb 
+
+# TODO only use add_node to add hpaths and nodes,
+#   eg add_node / path beam_monitor_scan prop_list {data true ...}
+
+# eventid=source/type, type={parameter feedback graphics} eg hdb_bmonscan/feedback
+proc update_node {name eventid access} {
+  global nodeindex
+  upvar $name signal
+  hset $nodeindex($eventid) $signal($eventid)
+}
+
+proc add_hpath {basePath path {priv spy} {dtype none} {dlen ""}} {
+
+
+  set parent $basePath
+  array set prop_arr [::utility::hlistplainprop $basePath]
+  foreach child [split $path /] {
+    if {[lsearch [hlist $parent] $child] == -1} {
+      hmake $parent/$child $priv $dtype $dlen
+      if {$basePath != "/"} {
+        hsetprop $parent/$child data $prop_arr(data)
+        hsetprop $parent/$child control $prop_arr(control)
+        hsetprop $parent/$child nxsave $prop_arr(nxsave)
+        hsetprop $parent/$child klass @none
+        hsetprop $parent/$child type $prop_arr(type)
+      }
+    } 
+    if {$parent == "/"} {
+      set parent /$child
+    } else {
+      set parent $parent/$child
+    }
+  }
+  return $parent
+}
+
+proc add_cmd_par {hpath sobj name} {
+  hattach $hpath $sobj $name
+  #array set property [attlist $sobj]
+#  hsetprop $hpath/$name argtype $property(argtype)
+  foreach {prop pval} [attlist $sobj] {
+    hsetprop $hpath/$name $prop $pval
+  }
+  hsetprop $hpath/$name data false
+#  if {[info exists property(values)]} {
+#    hsetprop $hpath/$name values $property(values)
+#  }
+#  if {[info exists property(min)]} {
+#    hsetprop $hpath/$name min $property(min)
+#  }
+#  if {[info exists property(max)]} {
+#    hsetprop $hpath/$name max $property(max)
+#  }
+}
+
+proc add_feedback {hpath sobj name} {
+  hattach $hpath $sobj $name
+  foreach {prop pval} [attlist $sobj] {
+    hsetprop $hpath/$name $prop $pval
+  }
+  hsetprop $hpath/$name privilege READ_ONLY
+}
+
+# args is an optional set of properties as name/value pairs.
+# need node kind 
+proc add_node {basePath args} {
+  global nodeindex
+  array unset arg_array
+  array set arg_array $args;
+  
+  if {[info exists arg_array(path)] && [info exists arg_array(prop_list)]} {
+    add_hpath $basePath $arg_array(path)
+    if {$basePath == "/"} {
+      set node_path /$arg_array(path)
+    } else {
+      set node_path $basePath/$arg_array(path)
+    }
+  #  if {[info exists arg_array(prop_list)]} {
+      foreach {prop pval} $arg_array(prop_list) {
+        hsetprop $node_path $prop $pval
+      }
+  #  }
+    return $node_path
+  }
+
+  if {![info exists arg_array(dlen)]} {
+    set arg_array(dlen) ""
+  }
+  set gp_path [file dirname $arg_array(node)]
+  set node_name [file tail $arg_array(node)]
+  if {$gp_path != "."} {
+    add_hpath $basePath $gp_path
+    set basePath $basePath/$gp_path
+    hsetprop $basePath type part
+  }
+  if {[lsearch [hlist $basePath] $node_name] == -1} {
+  #TODO allow hdb nodes of type drivable countable environment
+    switch $arg_array(kind) {
+      command {
+        # A command is a macro, node=macro name 
+        set command $node_name
+        set cmd_path [add_command $basePath $command]
+        set node_path $cmd_path
+        # The extra arguments for add_node are supplied by the command parameters
+        # and command feedback procedures.
+        if {[string length [info procs ${command}_parameters]] > 0} {
+          ${command}_parameters add_node $cmd_path
+        } else {
+          $command -map param add_cmd_par $cmd_path 
+        }
+        if {[string length [info procs ${command}_feedback]] > 0} {
+          add_hpath $cmd_path feedback
+          hsetprop $cmd_path/feedback type part
+          ${command}_feedback add_node $cmd_path/feedback
+        } else {
+          add_hpath $cmd_path feedback
+          hsetprop $cmd_path/feedback type part
+          $command -map feedback add_feedback $cmd_path/feedback 
+        }
+      }
+      event {
+        # An event is a data array, node= a node path 
+        add_hpath $basePath $node_name $arg_array(priv) $arg_array(dtype) $arg_array(dlen)
+        set node_path $basePath/$node_name
+        set nodeindex($arg_array(eventid),$arg_array(node)) $node_path
+      }
+      hobj {
+        hattach $basePath $node_name $arg_array(long_name)
+        set node_path $basePath/$arg_array(long_name)
+        hsetprop $node_path data    [getatt $node_name data]
+        hsetprop $node_path control [getatt $node_name control]
+        hsetprop $node_path nxsave  [getatt $node_name nxsave]
+        hsetprop $node_path klass   [getatt $node_name klass]
+        foreach child [hlist $node_path] {
+          hsetprop $node_path/$child data    false
+          hsetprop $node_path/$child control [getatt $node_name control]
+          hsetprop $node_path/$child nxsave  false
+          hsetprop $node_path/$child klass   [getatt $node_name klass]
+        }
+      }
+      ilist {
+        set node_path $basePath
+        set ilist_proc $node_name
+        $ilist_proc add_node $node_path
+      }
+      script {
+        # A r/w pair of scripts, node = a node path
+        set node_path $basePath/$node_name
+        hmakescript $node_path $arg_array(rscript) $arg_array(wscript) $arg_array(dtype) $arg_array(dlen)
+      }
+    }
+    if {[info exists arg_array(prop_list)]} {
+      foreach {prop pval} $arg_array(prop_list) {
+        hsetprop $node_path $prop $pval
+      }
+    }
+    return $node_path
+  }
+}
+
+# Add command
+proc add_command {basePath command} {
+  array unset cmd_atts
+  array set cmd_atts [attlist $command]
+  if 0 {
+  if {[info exists cmd_atts(group)]} {
+    add_hpath $basePath $cmd_atts(group)
+    set basePath $basePath/$cmd_atts(group)
+    hsetprop $basePath type part
+  }
+  }
+  hcommand $basePath/$cmd_atts(long_name) $command
+  set cmd_ns [namespace qualifiers $command]
+  if {[llength [trace info variable ::${cmd_ns}::event]] == 0} {
+    trace add variable ::${cmd_ns}::event write update_node
+  }
+  set cmd_path $basePath/$cmd_atts(long_name)
+  hsetprop $cmd_path privilege $cmd_atts(privilege)
+  hsetprop $cmd_path type $cmd_atts(kind)
+  hsetprop $cmd_path data $cmd_atts(data)
+  hsetprop $cmd_path control $cmd_atts(control)
+  hsetprop $cmd_path klass $cmd_atts(klass)
+  hsetprop $cmd_path nxsave $cmd_atts(nxsave)
+  return $cmd_path
+} 
+
+# attlist <sicsobj> 
+# return a list of name value pairs for the sicsobj attributes
+proc attlist {sicsobj} {
+  foreach att [tolower_sicslist $sicsobj] {
+    lappend atts [split [string range $att 0 end-1] =]
+  }
+  return [join $atts] 
+}
+
+# List sics objects with the given sics type, klass and group
+proc sobjlist {atype aklass} {
+  global sobj_sicstype_list
+
+  switch $atype {
+    command,macro {
+      return [intersection [tolower_sicslist type macro] [tolower_sicslist klass $aklass] [tolower_sicslist kind command]]
+    }
+    script,macro {
+      return [intersection [tolower_sicslist type macro] [tolower_sicslist klass $aklass] [tolower_sicslist kind script]]
+    }
+    "@any" {
+      foreach st $sobj_sicstype_list {
+        lappend sobjects [tolower_sicslist type $st]
+      }
+      return [intersection [join $sobjects] [tolower_sicslist klass $aklass]]
+    }
+    default {
+      return [intersection [tolower_sicslist type $atype] [tolower_sicslist klass $aklass]]
+    }
+  }
+}
+
+proc getsobjatt {sicsobj attribute} {
+  string trim [lindex [join [split [tolower_sicslist $sicsobj $attribute] =]] 1]
+}
+
+
+# Add the given sics object (sobj) of sobjtype to the
+# given hipadaba path hpath.
+# hpath must exist.
+proc sobjadd {hpath sobj args} {
+  array unset sobjatt
+  array set sobjatt [attlist $sobj]
+  switch $sobjatt(type) {
+    motor - configurablevirtualmotor {
+      if {[info exists sobjatt(group)]} {
+        set hpath [add_hpath $hpath $sobjatt(group)]
+        hsetprop $hpath type part
+      }
+      if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
+#        hattach $hpath $sobj $sobjatt(long_name)
+#        hsetprop $hpath/$sobjatt(long_name) units $sobjatt(units)
+#        hsetprop $hpath/$sobjatt(long_name) long_name $sobjatt(long_name)
+      set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
+      hsetprop $node_path savecmd $sobjatt(savecmd)
+      hsetprop $node_path sdsinfo $sobjatt(sdsinfo)
+      hsetprop $node_path nxalias $sobjatt(nxalias)
+      hsetprop $node_path mutable $sobjatt(mutable)
+      } else {
+        clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
+      }
+    }
+    macro {
+      if {[info exists sobjatt(group)]} {
+        set hpath [add_hpath $hpath $sobjatt(group)]
+        hsetprop $hpath type part
+      }
+      if {[lsearch [hlist $hpath] $sobjatt(long_name)] != -1} {
+        clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
+      } else {
+        add_node $hpath kind $sobjatt(kind) node $sobj dtype $sobjatt(type) priv $sobjatt(privilege)
+      }
+    }
+    sicsvariable {
+      if {[info exists sobjatt(group)]} {
+        set hpath [add_hpath $hpath $sobjatt(group)]
+        hsetprop $hpath type part
+      } 
+      if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
+        set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
+        hsetprop $node_path sicsdev $sobj
+        hsetprop $node_path nxalias $sobj
+        hsetprop $node_path savecmd $sobjatt(savecmd)
+        hsetprop $node_path sdsinfo $sobjatt(sdsinfo)
+        hsetprop $node_path mutable $sobjatt(mutable)
+        hsetprop $node_path privilege $sobjatt(privilege)
+      } else {
+        clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
+      } 
+    }
+    node {
+    }
+    singlecounter {
+# TODO 
+      todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+    }
+    histmem {
+# TODO 
+      todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+      if {[info exists sobjatt(group)]} {
+        set hpath [add_hpath $hpath $sobjatt(group)]
+        hsetprop $hpath type part
+      } 
+      if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
+        set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
+        hsetprop $node_path savecmd $sobjatt(savecmd)
+        hsetprop $node_path sdsinfo $sobjatt(sdsinfo)
+        hsetprop $node_path nxalias $sobjatt(nxalias)
+        hsetprop $node_path mutable $sobjatt(mutable)
+        hsetprop $node_path sicsdev $sobj
+      } else {
+        clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
+      } 
+    }
+    nxscript {
+# TODO 
+      todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+    }
+    sicsdata  {
+# TODO 
+      todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+    }
+    scanobject {
+# TODO 
+      todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+    } 
+  } 
+}
+
+# sobjtypeadd <hpath> <sobjtype>
+# Traverses list of sics objects of given type and attaches the matching sics objects to the given hpath
+# Hipadaba node properties are constructed from the sobj attribute list.
+proc sobjtypeadd {hpath sobjtype given_klass} {
+  foreach {sobj} [sobjlist $sobjtype $given_klass] {
+    sobjadd $hpath $sobj
+  }
+}
+
+
+## \brief Remove empty instrument dictionary nodes 
+#
+# \param instdict name of the instrument dictionary structure
+#
+# Nodes which have no child nodes and no associated sics objects for the
+# current instrument are removed.
+proc prune {instdict} {
+  upvar $instdict dict
+  array set dictarr $dict
+  set candidates [array names dictarr]
+  # While there are candidates for removal remove the childless ones
+  # which have an empty sobj list
+  while {[expr [llength $candidates]] > 0} {
+    set new_candidates ""
+    foreach name $candidates {
+      array unset dictval 
+      array set dictval $dictarr($name)
+      if {[lsearch $dictval(property) nxvgroup] != -1} {
+        # Link targets are not candidates for pruning
+        continue
+      }
+      set sobjects ""
+      if {[info exists dictval(sobj)]} {
+        foreach {t k} $dictval(sobj) {
+          lappend sobjects [sobjlist $t $k]
+        }
+      }
+      if { [llength [join $sobjects]] == 0 } {
+        if {[llength [array get dictarr $name/*]] == 0} {
+          array unset dictarr $name
+        } else {
+          if {[lsearch $candidates $name/*] != -1} {
+            lappend new_candidates $name
+          }
+        }
+      }
+    }
+    set candidates $new_candidates
+  }
+  set dict [array get dictarr]
+  return
+}
+# 
+#TODO add data control nxsave nxtyp properties
+##\brief Traverse the instrument dictionary and construct the hipadaba database.
+#
+# \param instDict name of the instrument dictionary structure
+#
+# This command prunes the dictionary before building it.
+# \see prune
+proc buildHDB {instDict} {
+upvar #0 $instDict dictionary
+prune dictionary
+  foreach {n v} $dictionary {
+    array unset varr
+    array set varr $v
+    array unset property_array
+    array set property_array $varr(property)
+    add_node / path $n prop_list $varr(property)
+    if {[info exists varr(sobj)]} {
+      foreach {sicstype sobj_klass} $varr(sobj) {
+        sobjtypeadd /$n $sicstype $sobj_klass
+      }
+    }
+  }
+}
+
+namespace eval ::hdb {
+  proc set_save {hpath mode {top true}} {
+    if {$hpath != "/"} {
+      set hnode $hpath
+    } else {
+      foreach hp [hlist /] {
+        ::hdb::set_save /$hp $mode
+      }
+      return
+    }
+    if {[::utility::hgetplainprop $hnode data] == "false"} {
+      return
+    }
+    foreach hp [hlist $hnode] {
+      set_save $hnode/$hp $mode false
+    }
+    if {$top == "true"} { 
+      hsetprop $hnode nxsave $mode
+      if {$mode == "true"} {
+        set hp ""
+        foreach ps [lrange [split [string trim $hnode /] /] 0 end-1] {
+          set hp $hp/$ps
+          hsetprop $hp nxsave true
+        } 
+      }
+    } else {
+      hsetprop $hnode nxsave $mode
+    }
+  }
+}

site_ansto/instrument/config/hipadaba/instdict_specification.tcl

@@ -0,0 +1,130 @@
+# The attributes and values for sics objects and instrument dictionaries must comply
+# with the following lists.  
+
+set boolean {true false}
+# INSTRUMENT DICTIONARIES MUST PROVIDE THE FOLLOWING INFORMATION
+#set dict_property_list {
+#  data [subst {{$boolean}}]
+#  control [subst {{$boolean}}]
+#  nxsave [subst {{$boolean}}]
+#  nxtype [subst {{$nexus_classes}}]
+#}
+
+# SICS OBJECTS MUST PROVIDE THE FOLLOWING INFORMATION
+set sobj_klass_list {aperture attenuator collimator command crystal data detector experiment graphics monitor monochromator plc sample scan user}
+set sobj_sicstype_list {sicsvariable macro motor configurablevirtualmotor singlecounter histmem nxscript sicsdata scanobject}
+# Different kinds of things are added to the hdb in different ways.
+# command: This is something a client can run with hset /a/b/c start, it may have parameters and feedback.
+#          Parameters and feedback should be made available in 'ilists' named after the command.
+# ilist: An intelligent list, it's like a list comprehension that takes a closure as the mapping function.
+# event: This is an associative array which can be watched for modifications. You can use the array index
+#        to choose an action.
+# script: Supplies an rscript and a wscript to attach to a node for hgets and hsets.
+# hobj: Something that can be hattached to a node. {motor sicsvariable histmem}.
+set sobj_kind_list {command event hobj ilist script}
+set sobj_interfacelist [subst {drivable {$boolean} countable {$boolean} callback {$boolean} environment {$boolean} }]
+
+set privilege_list {spy user manager read_only internal}
+set  sobj_privilege [subst {privilege {$privilege_list}}]
+
+# This is a subset of the list of attributes which the
+# [sicslist <sobj>] command must return for the hdbbuilder
+# The 'data' and 'control' attributes need to be part of the metadata for
+# a sics object because you know how it could/should be used when you
+# create it.
+set sobj_attlist [subst {
+  $sobj_interfacelist
+  type [subst {{$sobj_sicstype_list}}]
+  klass [subst {{$sobj_klass_list}}]
+  long_name {text}
+  data [subst {{$boolean}}]
+  control [subst {{$boolean}}]
+  kind [subst {{$sobj_kind_list}}]
+  nxsave [subst {{$boolean}}]
+  $sobj_privilege
+}]
+
+# OBJECT SPECIFIC ATTRIBUTES
+set motor_attlist [subst {
+  $sobj_attlist
+  units alpha
+  savecmd {print}
+  nxalias {text}
+  mutable [subst {{$boolean}}]
+}] 
+
+set configurablevirtualmotor_attlist [subst {
+  $motor_attlist
+}] 
+
+set singlecounter_attlist [subst {
+  $sobj_attlist
+  mutable [subst {{$boolean}}]
+}] 
+
+set histmem_attlist [subst {
+  $sobj_attlist
+  mutable [subst {{$boolean}}]
+}] 
+
+set scanobject_attlist [subst {
+  $sobj_attlist
+}] 
+
+set sicsvariable_attlist [subst {
+  $sobj_attlist
+  mutable [subst {{$boolean}}]
+}] 
+
+# A macro can be attached to an hdb node as a command or a script
+set macro_attlist [subst {
+  $sobj_attlist
+}] 
+
+set nxscript_attlist [subst {
+  $sobj_attlist
+}] 
+
+set sicsdata_attlist [subst {
+  $sobj_attlist
+  mutable [subst {{$boolean}}]
+}] 
+
+# INSTRUMENT DICTIONARIES MUST PROVIDE THE FOLLOWING INFORMATION
+if 1 { 
+  set nexus_classes { NXaperture NXattenuator NXbeam_stop NXbeam NXbending_magnet NXcharacterizations NXcollimator NXcrystal NXdata NXdetector NXdisk_chopper NXentry NXenvironment NXevent_data NXfermi_chopper NXfilter NXflipper NXgeometry NXguide NXinsertion_device NXinstrument NXlog NXmirror NXmoderator NXmonitor NXnote NXorientation NXpositioner NXprocess NXroot NXsample NXsensor NXshape NXsource NXtranslation NXuser NXvelocity_selector}
+
+  set dict_privilege_list {
+  }
+# datatype can include rank and dimensions
+# @none is included to allow subtree nodes and leaves to be handled
+# uniformly.
+  set dict_datatype_list { @none NX_CHAR NX_FLOAT32 NX_INT32 }
+
+# link = name of an nxalias 
+  set dict_property_list [subst {
+      {data control nxsave} {$boolean}
+      klass {@none $nexus_classes}
+      type {commandset graphset instrument part nxvgroup}
+      nxalias text
+      link {@none text}
+      savecmd text
+  }]
+
+
+# hpath looks like /a/b/c/
+set regex_hpath {^(/)$|^([_a-z0-9]+)(/[_a-z0-9]+)*$}
+set instrument_dictionary [subst {
+  regex_hpath {
+    optional {
+      children {alpha alpha}
+      sobj {{@any $sobj_sicstype_list} {$sobj_klass_list}}
+    }
+    required {
+      privilege {$privilege_list}
+      datatype [subst {{$dict_datatype_list}}]
+      property [subst {{$dict_property_list}}]
+    }
+  }
+}]
+}

site_ansto/instrument/config/hmm/anstohm_linked.xml

@@ -0,0 +1,22 @@
+<?xml version = '1.0' encoding = 'UTF-8'?>
+<!-- Revised version MJL 2/07 -->
+<anstohm:anstohm filler="ansto1" >
+	<config_links>
+		<config_link filename="../HMconfig/Default/Server_defaults.xml" />
+		<config_link filename="../HMconfig/Default/[inst_defaults].xml" />
+	</config_links>
+	<config_fillers>
+		<config_filler instrument="[instname]">
+			<!-- Place your customizations of the default configuration in this section -->
+			<!-- (if any) in config_server or config_fillers sections here. -->
+			<!-- These will override the linked configuration data above. -->
+      [BAT_TABLE]
+      [CAT_TABLE]
+      [FAT_TABLE]
+      [NAT_TABLE]
+      [OAT_TABLE]
+      [SAT_TABLE]
+      [SRV_TABLE]
+		</config_filler>
+	</config_fillers>
+</anstohm:anstohm>

site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.14 $
+# $Revision: 1.15 $
-# $Date: 2007-05-08 04:58:51 $
+# $Date: 2007-07-22 05:23:40 $
 # Author: Mark Lesha (mle@ansto.gov.au)
 # Last revision by: $Author: ffr $
 
@@ -10,25 +10,27 @@
 #ffr MakeHM hmm anstohttp, move to inst specific config
 
 namespace eval histogram_memory {
-VarMake hmm_dim0 Int User
+  ::utility::mkVar hmm_user_configpath Text manager user_configpath false detector true false 
-VarMake hmm_dim1 Int User
+    hmm_user_configpath ../user_config/hmm
-VarMake hmm_dim2 Int User
+    ::utility::mkVar hmm_dim0 Int user dim0 true detector true true
-VarMake hmm_histmode Text User
+    ::utility::mkVar hmm_dim1 Int user dim1 true detector true true
-VarMake hmm_bank Int User
+    ::utility::mkVar hmm_dim2 Int user dim2 true detector true true
-VarMake hmm_rank Int User
+    ::utility::mkVar hmm_histmode Text user histmode true detector true true
-VarMake hmm_start Int User
+    ::utility::mkVar hmm_bank Int user bank false detector true false
-VarMake hmm_length Int User
+    ::utility::mkVar hmm_rank Int user rank true detector true true
-VarMake hmm_mode Text User
+    ::utility::mkVar hmm_start Int user start false detector true false
-VarMake _hmm_vert_axis Text User
+    ::utility::mkVar hmm_length Int user length false detector false false
-VarMake _hmm_hor_axis Text User
+    ::utility::mkVar hmm_mode Text user mode true detector true true
-VarMake _hmm_hor_axis_alias Text User
+    ::utility::mkVar _hmm_vert_axis Text user vert_axis true detector false true
-VarMake _hmm_vert_axis_alias Text User
+    ::utility::mkVar _hmm_hor_axis Text user hor_axis true detector false true
-VarMake _hmm_hor_channel_name Text User
+    ::utility::mkVar _hmm_hor_axis_alias Text user hor_axis_alias true detector false true
-_hmm_vert_axis y_pixel_offset
+    ::utility::mkVar _hmm_vert_axis_alias Text user vert_axis_alias true detector false true
-_hmm_vert_axis_alias dvaxis
+    ::utility::mkVar _hmm_hor_channel_name Text user hor_channel_name true detector false true
-_hmm_hor_axis polar_angle
+    _hmm_vert_axis y_pixel_offset
-_hmm_hor_axis_alias dtheta
+    _hmm_vert_axis_alias dvaxis
-_hmm_hor_channel_name horizontal_channel_number
+    _hmm_hor_axis polar_angle
+    _hmm_hor_axis_alias dtheta
+    _hmm_hor_channel_name horizontal_channel_number
 ##############################################
 # Creating the histogram memories in SICS
 ##############################################
@@ -41,16 +43,16 @@ _hmm_hor_channel_name horizontal_channel_number
 ##############################################
 # Configuring the histogram server
 ##############################################
- 
+
 # Procedure to read a single config (or any) file, return content as a string.
-proc returnconfigfile {filename} {
+    proc returnconfigfile {filename} {
-	set fh [open $filename]
+      set fh [open $filename]
-	set xml [read $fh]
+        set xml [read $fh]
-	#set xml [list [read $fh]]
+#set xml [list [read $fh]]
-	clientput $xml value
+        debug_msg $xml value
-	close $fh
+        close $fh
-	return $xml
+        return [subst $xml]
-}
+    }
 
 # Initialize the histogram server.
 # This call to hmm init (with init 1 configured) causes the histogram server
@@ -61,20 +63,20 @@ proc returnconfigfile {filename} {
 # during DAQ is not allowed.  This requires init of the hmm object to level 0.
 #
 # Making sure the histogram server is stopped, so we can load configuration.
-proc hmm_initialize {} {
+  proc hmm_initialize {} {
-hmm configure hmaddress http://das1-[SplitReply [instrument]]:8080
+    hmm configure hmaddress http://das1-[SplitReply [instrument]]:8080
-hmm configure username spy
+      hmm configure username spy
-hmm configure password 007
+      hmm configure password 007
-hmm configure hmDataPath ../HMData
+      hmm configure hmDataPath ../HMData
 
-hmm configure init 0
+      hmm configure init 0
-hmm init
+      hmm init
-hmm stop
+      hmm stop
 # Load the configuration to the histogram server.
-hmm configure init 1
+      hmm configure init 1
-hmm init
+      hmm init
 # Restore the init level to 0, subesquent inits will only upload specified FAT settings to histogram server.
-hmm configure init 0
+      hmm configure init 0
 
 ##############################################
 # Configuring the histogram memories in SICS
@@ -83,35 +85,35 @@ hmm configure init 0
 # Now issue stop to the server.
 # This not only makes sure it's stopped, but lets us see certain configuration variables
 # which get placed in the dictionary as part of the status checking done during the stop.
-hmm stop
+      hmm stop
-}
+  }
 # Here, define a function to let us read back the value of dictionary items from the hmm
 # such as OAT dimensions.
-proc hmmdictitemval {histomem dictitem} {
+  proc hmmdictitemval {histomem dictitem} {
-	set resp [$histomem configure $dictitem]
+    set resp [$histomem configure $dictitem]
-	set retn [lindex [split $resp " "] 2]
+      set retn [lindex [split $resp " "] 2]
-	return $retn
+      return $retn
-}
+  }
 
 # Configure histogram dimensions, mode, etc. using the dictionary variables.
 # For the dimensions, set the 'effective' OAT dimensions which are the
 # histogram period dimensions.  Do an init after to cause memory to be allocated.
-proc hmm_setup {mode bankNum rankNum nyc nxc ntc} {
+  proc hmm_setup {mode bankNum rankNum nyc nxc ntc} {
     hmm_histmode $mode
-    hmm_bank $bankNum
+      hmm_bank $bankNum
-    hmm_rank $rankNum
+      hmm_rank $rankNum
-    hmm configure histmode $mode
+      hmm configure histmode $mode
-    hmm configure bank $bankNum
+      hmm configure bank $bankNum
-    hmm configure rank $rankNum
+      hmm configure rank $rankNum
-    hmm_dim0 [hmmdictitemval hmm $nyc]
+      hmm_dim0 [hmmdictitemval hmm $nyc]
-    hmm_dim1 [hmmdictitemval hmm $nxc]
+      hmm_dim1 [hmmdictitemval hmm $nxc]
-    hmm_length [expr {[SplitReply [hmm_dim0]] * [SplitReply [hmm_dim1]]} ]
+      hmm_length [expr {[SplitReply [hmm_dim0]] * [SplitReply [hmm_dim1]]} ]
-    hmm_dim2 [hmmdictitemval hmm $ntc]
+      hmm_dim2 [hmmdictitemval hmm $ntc]
-    hmm configure dim0 [SplitReply [hmm_dim0]]
+      hmm configure dim0 [SplitReply [hmm_dim0]]
-    hmm configure dim1 [SplitReply [hmm_dim1]]
+      hmm configure dim1 [SplitReply [hmm_dim1]]
-    hmm configure dim2 [SplitReply [hmm_dim2]]
+      hmm configure dim2 [SplitReply [hmm_dim2]]
-    hmm init
+      hmm init
-}
+  }
 
 ##############################################
 # Create beam monitor counter 
@@ -178,36 +180,36 @@ proc hmm_setup {mode bankNum rankNum nyc nxc ntc} {
 #
 #
 # Call is:  scan2_runa <n>
-proc scan2_runa {n} {
+  proc scan2_runa {n} {
 # The termination condition is ignored, because the
 # histogram server controls the acquisition duration
 # directly in this case.
-	scan2 run $n timer 0
+    scan2 run $n timer 0
-}
+  }
 #
 # Call is:  scan2_runb <n>
-proc scan2_runb {n count_method count_size count_stop} {
+  proc scan2_runb {n count_method count_size count_stop} {
 # Commit the termination conditions to the histogram server.
 # hmm configure stores the values in the dictionary,
 # then hmm init causes them to be sent to the histogram server.
 # We just 'assume' they are successfully written.
-	hmm configure FAT_COUNT_METHOD $count_method
+    hmm configure FAT_COUNT_METHOD $count_method
-	hmm configure FAT_COUNT_SIZE $count_size
+      hmm configure FAT_COUNT_SIZE $count_size
-	hmm configure FAT_COUNT_STOP $count_stop
+      hmm configure FAT_COUNT_STOP $count_stop
-	hmm init
+      hmm init
 # The termination condition is ignored, because the
 # histogram server controls the acquisition duration
 # directly in this case. So, use 'timer 0' here.
-	scan2 run $n timer 0
+      scan2 run $n timer 0
-}
+  }
 
 # Simulated counter. No error rate.  Required for technical reasons...
 # This counter is used only to block execution till the bm count is actually reached,
 # for the scan example using hmc and bm objects to control the acquisition duration from SICS.
-MakeCounter blockctr SIM -1.0
+  MakeCounter blockctr SIM -1.0
-blockctr SetExponent 0
+    blockctr SetExponent 0
-blockctr SetMode timer
+    blockctr SetMode timer
-blockctr SetPreset 0
+    blockctr SetPreset 0
 
 # Later on we can add some motors to drive...
 #Motor som2 ASIM 0 100 -1.0 0.01
@@ -230,16 +232,16 @@ blockctr SetPreset 0
 # in to an argument of set_oat_offset to provide progressively
 # increasing offset, producing an overlapped histogram.
 #
-global oatoffset
+    global oatoffset
 #
 #Function to apply OAT offsets to the histogram server.
-proc set_oat_offset {oatoff_x oatoff_y oatoff_t} {
+    proc set_oat_offset {oatoff_x oatoff_y oatoff_t} {
-	hmm configure FAT_OFFSET_OAT_X $oatoff_x
+      hmm configure FAT_OFFSET_OAT_X $oatoff_x
-	hmm configure FAT_OFFSET_OAT_Y $oatoff_y
+        hmm configure FAT_OFFSET_OAT_Y $oatoff_y
-	hmm configure FAT_OFFSET_OAT_T $oatoff_t
+        hmm configure FAT_OFFSET_OAT_T $oatoff_t
-	hmm init
+        hmm init
-	return
+        return
-}
+    }
 
 ##############################################
 # Support for data acquisition
@@ -247,17 +249,17 @@ proc set_oat_offset {oatoff_x oatoff_y oatoff_t} {
 
 # A simple procedure to read the histogram data through SICS
 # and dump the data to a numbered file.
-proc savehistodata {histomem filename} {
+  proc savehistodata {histomem filename} {
-	set fh [open $filename "w"]
+    set fh [open $filename "w"]
 # To get the whole memory, we don't need to specify the start or end arguments.
 # But we need to specify the bank number, this sets the type of data to be read.
 #
-	set histodata [$histomem get [hmmdictitemval $histomem bank]]
+      set histodata [$histomem get [hmmdictitemval $histomem bank]]
 #	clientput $histodata value
-	puts -nonewline $fh $histodata
+      puts -nonewline $fh $histodata
-	close $fh
+      close $fh
-	return
+      return
-}
+  }
 
 ##############################################
 ##############################################
@@ -269,54 +271,61 @@ proc savehistodata {histomem filename} {
 # We use it to pause the histogram server, in order to commence the DAQ.
 # This 'primes' the DAE also (i.e. device drivers reboot the hardware,
 # buffering processes are started, etc.)
-proc prepare {} {
+  proc prepare {} {
 #clientput "Enter prepare" value
 #
 # Before configuring the bm, do a short count.
 # This will cause the counter to reconnect if it needs to...
-	bm count 0 timer
+    bm count 0 timer
 # Now configure the beam monitor counter for better performance.
 # (Set a high counter sample rate to get better accuracy).
-	bm send set scan=1
+      bm send set scan=1
-	bm send set sample=1000
+      bm send set sample=1000
 # Make sure the histogram server is stopped, this guarantees DAQ not in progress already.
-	hmm stop
+      hmm stop
 # Zero the OAT offsets (whether used or not).
-	global oatoffset
+      global oatoffset
-	set oatoffset 0
+      set oatoffset 0
-	set_oat_offset 0 0 0
+      set_oat_offset 0 0 0
 #
 #	stdscan prepare $scanobjectname $userobjectname
 #clientput "hmm pause being done..." value
 # Pause the histogram server, this primes the DAE for acqisition.
-	hmm pause
+      hmm pause
 #clientput "Exit prepare" value
-	return
+      return
-}
+  }
 
 # The count_bm_controlled callback gets called at the start of dataset acquisition.
 # We use it to perform the dataset acquisition, via the hmc object.
 # Note we do NOT call stdscan count, since we don't need to run the bm counter twice.
-proc count_bm_controlled  {mode preset} {
+  proc count_bm_controlled  {mode preset} {
+    ::histogram_memory::count -set feedback status BUSY
 #clientput "Enter count" value
 #stdscan count $scanobjectname $userobjectname $point $mode $preset
 # Start the acquisition, runs till the beam monitor terminates
 # and then enter paused mode (we have added fifth argument to allow this).
 # In fact, execution proceeds immediately (the hmc call doesn't block).
-	hmc start $preset $mode pause
+    hmc start $preset $mode pause
 # Now call the simulated counter.  This will cause execution to block
 # till the hmc acquisition actually finishes.  Otherwise, execution will
 # charge on regardless and the finish callback function gets called
 # before the last dataset acquisition has finished!
-	blockctr count 0
+      blockctr count 0
 #clientput "Exit count" value
-	return
+    ::histogram_memory::count -set feedback status IDLE
-}
+    array set param [::data::gumtree_save -list param]
+    data axis 1 $param(run_number)
+    data data_set hmm
+    ::hdb::set_save /instrument/detector true
+    ::hdb::set_save /data true
+    return
+  }
 
 # The count_hs_controlled callback gets called at the start of dataset acquisition.
 # We use it to perform the dataset acquisition, controlled by the histogram server.
 # Note we do NOT call stdscan count, since we don't need to run the bm counter twice.
-proc hs_count_hs_controlled {scanobjectname userobjectname point mode preset} {
+  proc hs_count_hs_controlled {scanobjectname userobjectname point mode preset} {
 #clientput "Enter count" value
 #stdscan count $scanobjectname $userobjectname $point $mode $preset
 # Start the acquisition, runs till the histogram server auto-terminates.
@@ -325,15 +334,15 @@ proc hs_count_hs_controlled {scanobjectname userobjectname point mode preset} {
 # The termination condition for the bm counter is just set to a large time period.
 # After the acquisition terminates, the beam monitor therefore has the correct
 # status reading and the 'Monitor' entry in the scan data table will be correct.
-	hmc start 1000000000 timer pause 1
+    hmc start 1000000000 timer pause 1
 # Now call the simulated counter.  This will cause execution to block
 # till the hmc acquisition actually finishes.  Otherwise, execution will
 # charge on regardless and the finish callback function gets called
 # before the last dataset acquisition has finished!
-	blockctr count 0
+      blockctr count 0
 #clientput "Exit count" value
-	return
+      return
-}
+  }
 
 # The collect callback gets called at the end of the dataset acquisition.
 # We can put stuff here to retrieve data collected at each scan point,
@@ -347,13 +356,13 @@ proc hs_count_hs_controlled {scanobjectname userobjectname point mode preset} {
 # Code for adjusting ancillaries, moving secondary motion stages etc. etc.
 # from point to point should probably be put into a drive callback function
 # (but not in this example script).
-proc hs_collect {scanobjectname userobjectname point} {
+  proc hs_collect {scanobjectname userobjectname point} {
 #clientput "Enter collect" value
-	set rslt [stdscan collect $scanobjectname $userobjectname $point]
+    set rslt [stdscan collect $scanobjectname $userobjectname $point]
 # Apply an OAT offset in the x direction (e.g. along tube number axis).
-	global oatoffset
+      global oatoffset
-	incr oatoffset
+      incr oatoffset
-	set_oat_offset $oatoffset 0 0
+      set_oat_offset $oatoffset 0 0
 # Checking the beam monitor
 #clientput [bm send read] value
 # At each scan point, read the total x-y histogram
@@ -361,18 +370,18 @@ proc hs_collect {scanobjectname userobjectname point} {
 # each dataset (when restarting from paused state),
 # so it represents the hstogram acquired per scan point.
 #clientput "Exit collect" value
-	return
+      return
-}
+  }
 
 # The finish callback gets called at the end of the scan.
 # We use it to stop the histogram server, terminating the dataset.
-proc finish {} {
+  proc finish {} {
 #clientput "Enter finish" value
 #	stdscan finish $scanobjectname $userobjectname
 #clientput "hmm stop being done..." value
-	hmm stop
+    hmm stop
 # Just in case someone expects zero OAT offsets later on ;)
-	set_oat_offset 0 0 0
+      set_oat_offset 0 0 0
 # Get and write the data from the main histogram to disk (filename "HistoData").
 # Sicne this is the first (and only) access to hmm data, it is retrieved from
 # the server and we don't need to do hmm init first to force update hmm memory.
@@ -380,14 +389,14 @@ proc finish {} {
 #	savehistodata hmm "../data/HistoData"
 #
 #clientput "Exit finish" value
-	return
+      return
-}
+  }
 
-proc count_withbm {mode preset} {
+  proc count_withbm {mode preset} {
-  prepare;
+    prepare;
-  count_bm_controlled $mode $preset;
+    count_bm_controlled $mode $preset;
-  finish;
+    finish;
-}
+  }
 
   proc init {} {
   }
@@ -401,17 +410,17 @@ proc count_withbm {mode preset} {
   }
 
   proc save {point } {
-    #TODO maybe add nxobj and point parameters.
+#TODO maybe add nxobj and point parameters.
-  set hor_axis [SplitReply [_hmm_hor_axis]]
+    set hor_axis [SplitReply [_hmm_hor_axis]]
-  set vert_axis [SplitReply [_hmm_vert_axis]]
+      set vert_axis [SplitReply [_hmm_vert_axis]]
 #    set point 0
-    if {$point == 0} {
+      if {$point == 0} {
-      nxcreatefile nexus_hmscan.dic;
+        nxcreatefile nexus_hmscan.dic;
-    } else {
+      } else {
-      nxreopenfile
+        nxreopenfile
-    }
+      }
     nxscript putattribute program_name run_mode hmmcount
-    hmm_save nxscript entry1 $point;
+      hmm_save nxscript entry1 $point;
     nxscript_data clear;
     nxscript_data putint 0 $point;
     nxscript putslab erun [list $point] [list 1] nxscript_data;
@@ -421,16 +430,150 @@ proc count_withbm {mode preset} {
     nxscript putattribute hmcounts axes run_number:$vert_axis:$hor_axis;
     nxclosefile;
   }
+  proc set_sobj_attributes {} {
+# set_sicsobj_atts sobj klass group name control data
+if 0 {
+    set_sicsobj_atts hmm_user_configpath detector hmm user_configpath true false;
+    set_sicsobj_atts hmm_dim0 detector hmm dim0 true true;
+    set_sicsobj_atts hmm_dim1 detector hmm dim1 true true;
+    set_sicsobj_atts hmm_dim2 detector hmm dim2 true true;
+    set_sicsobj_atts hmm_histmode detector hmm histmode true true;
+    set_sicsobj_atts hmm_bank detector hmm bank true false;
+    set_sicsobj_atts hmm_rank detector hmm rank true true;
+    set_sicsobj_atts hmm_start detector hmm start true false;
+    set_sicsobj_atts hmm_length detector hmm length false false;
+    set_sicsobj_atts hmm_mode detector hmm mode true true;
+    set_sicsobj_atts _hmm_vert_axis detector hmm vert_axis false true;
+    set_sicsobj_atts _hmm_hor_axis detector hmm hor_axis false true;
+    set_sicsobj_atts _hmm_hor_axis_alias detector hmm hor_axis_alias false true;
+    set_sicsobj_atts _hmm_vert_axis_alias detector hmm vert_axis_alias false true;
+    set_sicsobj_atts _hmm_hor_channel_name detector hmm hor_channel_name false true;
 }
 
-publish ::histogram_memory::finish user
+    # SICS commands
-#publish ::histogram_memory::hs_collect user
+    sicslist setatt blockctr privilege internal;
-publish ::histogram_memory::hs_count_hs_controlled user
+
-publish ::histogram_memory::count_bm_controlled user
+    # histogram memory macros
-publish ::histogram_memory::prepare user
+    sicslist setatt ::histogram_memory::finish  privilege internal;
-publish ::histogram_memory::set_oat_offset user
+    sicslist setatt ::histogram_memory::hs_count_hs_controlled  privilege internal;
-publish ::histogram_memory::scan2_runb user
+    sicslist setatt ::histogram_memory::count_bm_controlled  privilege internal;
-publish ::histogram_memory::scan2_runa user
+    sicslist setatt ::histogram_memory::prepare  privilege internal;
-publish ::histogram_memory::returnconfigfile user
+    sicslist setatt ::histogram_memory::set_oat_offset  privilege internal;
-publish ::histogram_memory::count_withbm user
+    sicslist setatt ::histogram_memory::scan2_runb  privilege internal;
-publish ::histogram_memory::save user
+    sicslist setatt ::histogram_memory::scan2_runa  privilege internal;
+    sicslist setatt ::histogram_memory::returnconfigfile  privilege internal;
+    sicslist setatt ::histogram_memory::count_withbm  privilege internal;
+    sicslist setatt ::histogram_memory::save  privilege internal;
+
+    set_sicsobj_atts hmm detector @none hmm_data true true;
+    sicslist setatt hmm privilege user
+    sicslist setatt hmm kind hobj
+    sicslist setatt hmm nxsave true
+  }
+}
+
+proc BAT_TABLE {args} {}
+proc CAT_TABLE {args} {}
+set hmm_xml(FAT_TABLE) ""
+proc FAT_TABLE {args} {
+  global hmm_xml
+  if {$args == ""} {return $hmm_xml(FAT_TABLE)}
+  array set param [string toupper $args]
+  set hmm_xml(FAT_TABLE) "<FAT\n"
+  foreach att {SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE} {
+    if {[info exists param($att)]} {
+      append hmm_xml(FAT_TABLE) "$att=\"$param($att)\"\n"
+    }
+  }
+  append hmm_xml(FAT_TABLE) "></FAT>"
+}
+proc NAT_TABLE {args} {}
+set hmm_xml(OAT_TABLE) ""
+proc OAT_TABLE {args} {
+  global hmm_xml
+  if {$args == ""} {return $hmm_xml(OAT_TABLE)}
+  array set param $args
+  set X_min -210; set X_max 210
+  set Y_min -110; set Y_max 110
+  set NOXCH [SplitReply [hmm configure dim0]]
+  set NOYCH [SplitReply [hmm configure dim1]]
+  set NOTCH [SplitReply [hmm configure dim2]]
+  foreach tag  {XTAG YTAG TTAG} {set $tag ""}
+  set hmm_xml(OAT_TABLE) {
+<OAT NO_OAT_X_CHANNELS=\"$NOXCH\" NO_OAT_Y_CHANNELS=\"$NOYCH\" NO_OAT_T_CHANNELS=\"$NOTCH\">
+  $XTAG
+  $YTAG
+  $TTAG
+</OAT>
+}
+  if {[info exists param(NTC)]} {
+    set NOTCH $param(NTC)
+  }
+  foreach coord {X Y T} {
+    if {[info exists param($coord)]} {
+      set ${coord}TAG "<$coord>$param($coord)</$coord>"
+      set bbnum [llength $param($coord)]
+        if {$bbnum > 2} {
+          set NO${coord}CH [expr $bbnum - 1]
+        } else {
+          if {$coord != "T"} {
+            set b0 [lindex $param($coord) 0]
+            set b1 [lindex $param($coord) 1]
+            set NO${coord}CH [expr {1+([set ${coord}_max] - [set ${coord}_min])/($b1 - $b0)}]
+          }
+        }
+    } 
+  }
+  FAT_TABLE SIZE_PERIOD [expr {$NOXCH*$NOYCH*$NOTCH}]
+  set hmm_xml(OAT_TABLE) [subst $hmm_xml(OAT_TABLE)]
+  return $hmm_xml(OAT_TABLE)
+}
+proc SAT_TABLE {args} {}
+proc SRV_TABLE {args} {}
+
+proc inst_defaults {} {
+  global  ::histogram_memory::hmm_def_filename
+  return $::histogram_memory::hmm_def_filename
+}
+proc dae_type {} {
+  global  ::histogram_memory::hmm_dae_type
+  return $::histogram_memory::hmm_dae_type
+}
+proc ::histogram_memory::configure_server {instdef dtype} {
+  variable hmm_def_filename
+  variable hmm_dae_type
+  set hmm_def_filename $instdef
+  set hmm_dae_type $dtype
+  set configuration "::histogram_memory::returnconfigfile config/hmm/anstohm_linked.xml"
+  debug_msg $configuration
+  hmm configure hmconfigscript $configuration
+  ::histogram_memory::hmm_initialize
+}
+Publish ::histogram_memory::finish user
+#Publish ::histogram_memory::hs_collect user
+Publish ::histogram_memory::hs_count_hs_controlled user
+Publish ::histogram_memory::count_bm_controlled user
+Publish ::histogram_memory::prepare user
+Publish ::histogram_memory::set_oat_offset user
+Publish ::histogram_memory::scan2_runb user
+Publish ::histogram_memory::scan2_runa user
+Publish ::histogram_memory::returnconfigfile user
+Publish ::histogram_memory::count_withbm user
+Publish ::histogram_memory::save user
+Publish BAT_TABLE user
+Publish CAT_TABLE user
+Publish FAT_TABLE user
+Publish NAT_TABLE user
+Publish OAT_TABLE user
+Publish SAT_TABLE user
+Publish SRV_TABLE user
+
+namespace eval ::histogram_memory {
+  command count {text:monitor,timer mode float: preset} {
+    ::histogram_memory::prepare
+    ::histogram_memory::count_bm_controlled $mode $preset;
+    ::histogram_memory::finish
+  } 
+  ::histogram_memory::count -addfb text status
+  ::histogram_memory::count -set feedback status IDLE
+}

site_ansto/instrument/config/nexus/nexus_in_hmm_common_1.dic

@@ -6,7 +6,7 @@ dradius=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS ra
 dheight=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS height -type NX_FLOAT32  -attr {units,mm}
 detangle_rad=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS arc -type NX_FLOAT32  -attr {units,radians}
 detangle_degrees=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS arc -type NX_FLOAT32  -attr {units,degrees} 
-dtheta=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS polar_angle -type NX_FLOAT32  -LZW -rank 2 -dim {-1,$(padim1)} -attr {units,degrees}
+dtheta=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS two_theta -type NX_FLOAT32  -LZW -rank 2 -dim {-1,$(padim1)} -attr {units,degrees}
 dvaxis=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS y_pixel_offset -type NX_FLOAT32 -LZW -rank 1 -dim {$(padim0)} -attr {units,mm}
 dhaxis=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS x_pixel_offset -type NX_FLOAT32 -LZW -rank 1 -dim {$(padim1)} -attr {units,mm} 
 drowindex=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS $(row_index_name) -type NX_INT32 -LZW -rank 1 -dim {$(padim0)}

site_ansto/instrument/config/nexus/nexus_in_scan_common_1.dic

@@ -9,6 +9,7 @@ scandata=/$(entryName),NXentry/data,NXdata/NXVGROUP
 scanhoraxis=/$(entryName),NXentry/data,NXdata/NXVGROUP
 scanvertaxis=/$(entryName),NXentry/data,NXdata/NXVGROUP
 scanvar=/$(entryName),NXentry/data,NXdata/NXVGROUP
+scantwotheta=/$(entryName),NXentry/scan_step,NXdata/SDS two_theta  -type NX_FLOAT32 -attr {units,degree} -attr {long_name,two_theta}
 scanstep=/$(entryName),NXentry/scan_step,NXdata/SDS value  -type NX_FLOAT32 -attr {units,degree} -attr {long_name,stepsize}
 #histogram=/$(entryName),NXentry/histogram,NXdata/NXVGROUP
 #scanvar=/$(entryName),NXentry/$(scan_variable),NXdata/NXVGROUP

site_ansto/instrument/config/nexus/nxscripts_common_1.tcl

@@ -1,3 +1,427 @@
+## TODO Put all the nexus macros in the nexus namespace
+MakeNXScript
+sicsdatafactory new nxscript_data
+namespace eval nexus {
+  variable nxdictionary
+
+  set exports [list newfile closefile save data]
+  eval namespace export $exports
+  datafilename
+  proc createfile {} {
+    global cfPath
+    variable nexusdic
+    variable state
+    variable  nxFileOpen;
+    set nxdict_path $cfPath(nexus)/$nexusdic
+    set file_type [SplitReply [SicsDataSuffix]]
+    array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml];
+    dataFileName [newFileName $file_type]
+    ::nexus::gen_nxdict $nexusdic
+    nxscript $nxmode($file_type) [SplitReply [dataFileName]] $nxdict_path;
+    set nxFileOpen true
+    set state(file,status) open
+  }
+
+  ## \brief Sets 'new file' state to true
+  proc newfile {{type deflt } {nxdic nexus.dic}} {
+    variable nexusdic
+    variable state
+    if {$type == "deflt"} {
+      set type [SplitReply [SicsDataSuffix]]
+    }
+    set state(file,new) true
+    set nexusdic $nxdic
+  }
+# Don't overwrite data from a previous SICS session
+  newfile
+
+  proc save_data {point} {
+    ::nexus::nxreopenfile
+    foreach child [hlist /] {
+      if {[::utility::hgetplainprop /experiment data] == "true"} {
+        ::nexus::savetree $child $point
+      }
+    }
+    ::nexus::nxclosefile
+  }
+  ## \brief save data collected by last data acquisition command.
+  #
+  # \param point experimental point number, this is the array index for mutable
+  # datasets in the nexus file. Optional, default = 0
+  #
+  # The save command will create a new file if the newfile state is set to true, or 
+  # if the datatype property != the currentfiletype property of the /data hdb node.
+  proc save {{point 0}} {
+    variable state
+    ::data::gumtree_save -set run_number $point
+    if {$state(file,new) == "true"} {
+      createfile
+      save_data $point
+      linkdata
+      hsetprop /data currentfiletype [::utility::hgetplainprop /data datatype]
+      set state(file,new) false
+    } else {
+      if {[::utility::hgetplainprop /data currentfiletype] != [::utility::hgetplainprop /data datatype]} {
+        createfile
+        save_data $point
+        linkdata
+        hsetprop /data currentfiletype [::utility::hgetplainprop /data datatype]
+        set state(file,new) false
+      }
+      save_data $point
+    }
+  }
+
+## \brief Reopen the current file.
+proc nxreopenfile {} {
+  global cfPath
+  variable  nxFileOpen
+  variable nexusdic
+  if {$nxFileOpen == "false"} {
+    nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic;
+    set nxFileOpen true;
+  }
+}
+
+## \brief Close the current file. You can reopen it with nxreopenfile
+#
+# \see nxreopenfile
+proc nxclosefile {} {
+  variable  nxFileOpen;
+  if {$nxFileOpen == "true"} {
+    nxscript close;
+    set nxFileOpen false;
+    set flist [split [SplitReply [dataFileName]] "/"];
+    set fname [lindex $flist [expr [llength $flist] - 1] ];
+    clientput "$fname updated" "event";
+  }
+}
+## \brief Records that a given data source should be linked to nexus data target.
+#
+# NOTE: If a link has already been recorded then it does nothing. This allows you to
+# override default links set by a command. eg A "count" command may link axis_1 to 
+# the run number but a "scan" command which uses the count command can link axis_1 to 
+# a scan variable.
+#
+# Usage:
+# data data_set datsource
+# Records that /data/data_set should be linked to datsource and sets a data type identifier
+# data axis 1|2|3|4 datsource 
+# Records that /data/axisn should be linked to datsource
+# data clear
+# Clears all link targets and sets the data type identifier to unknown
+proc data {args} {
+  set dpath /data
+  set opt [lindex $args 0]
+  switch $opt {
+    "axis" {
+      set axnum [lindex $args 1]
+      if {[string is integer $axnum] == 0} {
+        error "ERROR: [info level -1]->data, index for data axis should be an integer, not $axnum"
+      }
+      set hp $dpath/axis_$axnum
+      if {[::utility::hgetplainprop $hp link] == "@none"} {
+        hsetprop $hp link [lindex $args 2]
+        hsetprop $hp long_name [getatt [lindex $args 2] long_name]
+      }
+    }
+    "data_set" {
+      hsetprop $dpath datatype [lindex [info level -1] 0]
+      set hp $dpath/data_set
+      if {[::utility::hgetplainprop $hp link] == "@none"} {
+        hsetprop $hp link [lindex $args 1]
+        hsetprop $hp long_name [getatt [lindex $args 1] long_name]
+      }
+    }
+    "clear" {
+      foreach child [hlist $dpath] {
+        hsetprop $dpath/$child link @none
+        hsetprop $dpath/$child long_name @none
+      }
+    }
+    default {error "ERROR: [info level -1]->data, Unsupported option $opt"}
+  }
+}
+  # Internal commands
+  # All experimental data of interest is linked under the data group
+  proc linkdata {} {
+    array unset axes
+    set hpath /data
+    ::nexus::nxreopenfile
+    foreach child [hlist $hpath] {
+      array set p_arr [::utility::hlistplainprop $hpath/$child] 
+      if {$p_arr(data) == true && $p_arr(nxsave) == true} {
+        if {[info exists p_arr(nxalias)]} { 
+          if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
+            if {$p_arr(link) != "@none"} {
+              nxscript makelink $p_arr(nxalias) $p_arr(link)
+              switch -glob $child {
+                "axis_*" {
+                  set n [lindex [split $child _] 1]
+                  set axes($n) [::utility::hgetplainprop $hpath/$child long_name]
+                  nxscript putattribute $p_arr(link) axis $n
+                }
+                "data_set" {
+                  nxscript putattribute $p_arr(link) signal 1
+                  set data_set_alias $p_arr(link)
+                }
+                default {error "ERROR: [info level -1]->linkdata, Unsupported data path $hpath/$child"}
+              }
+            }
+          }
+        }
+      }
+    }
+    if {[info exists axes]} {
+      foreach n [lsort [array names axes]] {
+        nxscript putattribute $data_set_alias axes [set axes($n)]
+      }
+    }
+    ::nexus::nxclosefile
+    ::nexus::data clear
+  }
+
+  proc savetree {hpath {pt 0}} {
+    foreach child [hlist /$hpath] {
+      array unset p_arr
+      array set p_arr [::utility::hlistplainprop /$hpath/$child] 
+      if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
+        return
+      }
+      set data_type [lindex [split [hinfo /$hpath/$child] , ] 0]
+      if {$p_arr(data) == true && $p_arr(nxsave) == true } {
+        if {[info exists p_arr(savecmd)] && [info exists p_arr(nxalias)] } { 
+          if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true" } {
+            $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type point $pt
+          } else {
+            $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type
+          }
+        } elseif {[info exists p_arr(savecmd)] || [info exists p_arr(nxalias)]} {
+          error_msg "/$hpath/$child must have both 'savecmd' and 'nxalias' properties\nThe actual property list for /$hpath/$child is [array get p_arr]"
+        }
+        ::nexus::savetree $hpath/$child $pt
+      }
+    }
+  }
+
+
+  # Where do we get the SDS info from for tcl variables?
+  proc save_scalar {args} {
+  todo_msg "Save floats ints, use this for local variables, events and sicsvariable data"
+  # use putfloat $event(...) or uset putslab
+  }
+  proc save_sicsvar {svar nxarg args} {
+  todo_msg "Use this to save tcl arrays, good for beam monitor count arrays"
+  }
+
+
+  proc _gen_nxdict {hpath dict_path name nxc} {
+    variable nxdictionary
+    if {[::utility::hgetplainprop /$hpath data] == "false"} {
+      debug_msg "$hpath doesn't have a data property"
+      return
+    }
+    foreach child  [hlist /$hpath] {
+      if {[::utility::hgetplainprop /$hpath/$child data] == true} {
+        set nxclass [::utility::hgetplainprop /$hpath/$child klass]
+        if {[string range $nxc 0 1] == "NX"} {
+          ::nexus::_gen_nxdict $hpath/$child $dict_path/$name,$nxc $child $nxclass 
+        } else {
+          # else construct SDS name by replacing '/' with '_' in path
+          ::nexus::_gen_nxdict $hpath/$child $dict_path ${name}_$child $nxclass
+        }
+      }
+    }
+    array set p_arr [::utility::hlistplainprop /$hpath] 
+    set data_type [lindex [split [hinfo /$hpath] , ] 0]
+    if {$p_arr(data) == "true" && $p_arr(nxsave) == "true" && [info exists p_arr(nxalias)]} {
+      set alias $p_arr(nxalias)
+      if {[info exists p_arr(sdsinfo)]} {
+        if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true"} {
+          set nxdictionary($alias) "$dict_path/SDS $name [$p_arr(sdsinfo) $p_arr(sicsdev) $data_type mutable true]"
+        } else {
+          set nxdictionary($alias) "$dict_path/SDS $name [$p_arr(sdsinfo) $p_arr(sicsdev) $data_type mutable false]"
+        }
+      } elseif {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
+        set nxdictionary($alias) "$dict_path/NXVGROUP"
+      }
+    }
+  }
+  proc gen_nxdict {nexusdic} {
+    global cfPath
+    variable nxdictionary
+    set nxdict_path $cfPath(nexus)/$nexusdic
+    array unset nxdictionary 
+    foreach hp [hlist /] {
+      if {[::utility::hgetplainprop /$hp data] == true} {
+        set nxclass [::utility::hgetplainprop /$hp klass]
+        ::nexus::_gen_nxdict $hp /entry1,NXentry $hp $nxclass
+      }
+    }
+    set fh [open $nxdict_path w]
+    puts $fh "##NXDICT-1.0"
+    puts $fh padim0=0
+    puts $fh padim1=0
+    puts $fh padim2=0
+    foreach {n v} [array get nxdictionary] {
+      puts $fh "$n = $v"
+    }
+    close $fh
+  }
+  proc show_nxdict {} {
+    variable nxdictionary
+    clientput [array get nxdictionary]
+  }
+
+  proc set_sobj_attributes {} {
+    # SICS commands
+    sicslist setatt nxscript privilege internal;
+    # SICS data objects
+    sicslist setatt nxscript_data privilege internal;
+
+    # nexus macros
+    sicslist setatt nxcreatefile  privilege internal;
+    sicslist setatt addnxscanentry  privilege internal;
+    sicslist setatt bm_addnxscanentry  privilege internal;
+
+    # Set savecmd on SICS objects
+    foreach sobj [lrange [sicslist type motor] 1 end] { 
+      sicslist setatt $sobj savecmd ::nexus::motor::save
+      sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
+    }
+    foreach sobj [sicslist type configurablevirtualmotor] { 
+      sicslist setatt $sobj savecmd ::nexus::motor::save
+      sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
+    }
+    foreach sobj [sicslist type histmem] { 
+      sicslist setatt $sobj savecmd ::nexus::histmem::save
+      sicslist setatt $sobj sdsinfo ::nexus::histmem::sdsinfo
+    }
+    foreach sobj [sicslist type sicsvariable] {
+      sicslist setatt $sobj savecmd ::nexus::sicsvariable::save
+      sicslist setatt $sobj sdsinfo ::nexus::sicsvariable::sdsinfo
+    }
+    foreach sobj [sicslist type singlecounter] {
+      sicslist setatt $sobj savecmd ::nexus::singlecounter::save
+      sicslist setatt $sobj sdsinfo ::nexus::singlecounter::sdsinfo
+    }
+  }
+}
+namespace import ::nexus::*
+foreach expt $::nexus::exports {
+  publish $expt user
+  sicslist setatt $expt privilege internal
+}
+
+namespace eval ::nexus::histmem {
+  proc save {hm nxalias data_type args} {
+    set dim0 [SplitReply [$hm configure dim0]]
+    set dim1 [SplitReply [$hm configure dim1]]
+    set dim2 [SplitReply [$hm configure dim2]]
+    nxscript updatedictvar padim0 $dim0
+    nxscript updatedictvar padim1 $dim1 
+    nxscript updatedictvar padim2 $dim2 
+    set data_start 0
+    set datalen [expr {$dim0 * $dim1 * $dim2}]
+    set bank 0
+    if {[lindex $args 0] == "point"} {
+      set index [lindex $args 1]
+      nxscript putslab $nxalias [list $index 0 0 0] [list 1 $dim0 $dim1 $dim2] $hm $data_start $datalen $bank
+    } else {
+    }
+  }
+  proc sdsinfo {hm data_type args} {
+      array set param $args
+      array set hm_prop [attlist $hm]
+      if {$param(mutable) == true} {
+        return " -type NX_INT32 -LZW -rank 4 -dim {-1,\$(padim0),\$(padim1),\$(padim2)}"
+      } else {
+        return " -type NX_INT32 -LZW -rank 3 -dim {\$(padim0),\$(padim1),\$(padim2)}"
+      }
+  }
+}
+
+namespace eval ::nexus::motor {
+  # The save commands are called with the sobj name and nxalias
+  # The sdsinfo commands provide the SDS description for an nxdic
+
+  # save sphi alias float [point n]
+  proc save {motor nxalias data_type args} {
+    if {[lindex $args 0] == "point"} {
+      set index [lindex $args 1]
+        nxscript_data clear;
+        nxscript_data putfloat 0 [getVal [$motor] ]
+        nxscript putslab $nxalias [list $index] [list 1] nxscript_data
+    } else {
+      if {[getatt $motor type] == "motor"} {
+        nxscript putmot $nxalias $motor
+      } else {
+        nxscript putfloat $nxalias [SplitReply [$motor]]
+      }
+    }
+  }
+  proc sdsinfo {motor data_type args} {
+      array set param $args
+      array set mot_prop [attlist $motor]
+      set dtype [::nexus::hdb2nx_type $data_type]
+      if {$param(mutable) == true} {
+      return " -type $dtype -rank 1 -dim {-1} -attr {units,$mot_prop(units)} -attr {long_name,$mot_prop(long_name)}"
+      } else {
+      return " -type $dtype -attr {units,$mot_prop(units)} -attr {long_name,$mot_prop(long_name)}"
+      }
+  }
+}
+
+namespace eval ::nexus {
+  proc hdb2nx_type {dtype} { 
+    switch $dtype {
+      int {return NX_INT32}
+      float {return NX_FLOAT32}
+      text {return NX_CHAR}
+      default {error "ERROR: [info level -1]->hdb2nx_type, Unknown type $dtype"}
+    }
+  }
+}
+
+namespace eval ::nexus::sicsvariable {
+  proc save {svar nxalias data_type args} {
+    set val [SplitReply [$svar]]
+    if {[lindex $args 0] == "point"} {
+      set index [lindex $args 1]
+      nxscript_data clear;
+      switch $data_type {
+        int {nxscript_data putint 0 $val}
+        float {nxscript_data putfloat 0 $val}
+        default {error "ERROR: [info level -1]->::nexus::sicsvariable::save, unknown type $data_type"}
+      }
+      nxscript putslab $nxalias [list $index] [list 1] nxscript_data
+    } else {
+      switch $data_type {
+        int {nxscript putint $nxalias $val}
+        float {nxscript putfloat $nxalias $val}
+        text {nxscript puttext $nxalias $val}
+        default {error "ERROR: [info level -1]->::nexus::sicsvariable::save, unknown type $data_type"}
+      }
+    }
+  }
+  proc sdsinfo {svar data_type args} {
+    array set param $args
+    set dtype [::nexus::hdb2nx_type $data_type]
+    if {$param(mutable) == true} {
+    return " -type $dtype -rank 1 -dim {-1}"
+    } else {
+    return " -type $dtype"
+    }
+  }
+}
+namespace eval ::nexus::singlecounter {
+  proc save {counter nxalias data_type args} {
+    todo_msg "Save counter: $counter"
+  }
+  proc sdsinfo {counter data_type args} {
+    todo_msg "Get sdsinfo for counter: $counter"
+  }
+}
 # TODO Return filename from nxcreatefile and call nxreopen nxclose etc
 # TODO Make an nxscript namespace for all this.
 
@@ -9,57 +433,38 @@
 
 set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}]
 set nx_content_release_tag [lindex $tmpstr [expr [llength $tmpstr] - 1]]
-set tmpstr [string map {"$" ""} {$Revision: 1.24 $}]
+set tmpstr [string map {"$" ""} {$Revision: 1.25 $}]
 set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
 
-MakeNXScript
-sicsdatafactory new nxscript_data
 
 proc getVal {msg} {
   return [string trim [lindex [split $msg =] 1 ] ]
 }
 
-proc newFileName {} {
+proc newFileName {postfix} {
+array set inst_mnem {quokka QKK womba WBT echidna ECH kowari KWR koala KOL taipan TPN platypus PLP pelican PLN}
+
   sicsdatanumber incr; 
   set idNum [SplitReply [sicsdatanumber]];
   set dataPath [SplitReply [sicsdatapath]];
   set prefix [SplitReply [sicsdataprefix]];
-  set postfix [SplitReply [sicsdatapostfix]];
   set date_time_arr [split [sicstime] " "]
   set isodate [lindex $date_time_arr 0];
   set isotime [string map {: -} [lindex $date_time_arr 1]];
-  return [format "%s/%s_%sT%s_%05d%s" $dataPath $prefix $isodate $isotime $idNum $postfix];
+  return [format "%s/%s%07d.%s" $dataPath $inst_mnem([instname]) $idNum $postfix]
 }
 
 proc nxcreatefile {nxdic {type nx.hdf}} {
   global  nxFileOpen cfPath nexusdic;
-  SicsDataPostFix .$type;
 
   set nexusdic $nxdic
   array set nxmode [list nx.hdf create5 h5 create5 nx5 create5 xml createxml];
-  dataFileName [newFileName]
+  dataFileName [newFileName $type]
   nxscript $nxmode($type) [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic;
   set nxFileOpen true
 }
 
 
-proc nxreopenfile {} {
-  global  nxFileOpen cfPath nexusdic;
-  nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic;
-  set nxFileOpen true;
-}
-
-proc nxclosefile {} {
-  global  nxFileOpen;
-  if {$nxFileOpen == true} {
-    nxscript close;
-    set nxFileOpen false;
-    set flist [split [SplitReply [dataFileName]] "/"];
-    set fname [lindex $flist [expr [llength $flist] - 1] ];
-    clientput "$fname updated" "event";
-  }
-}
-
 set dradius 1.25
 set ndect 128
 set tubedia 0.0254
@@ -295,7 +700,21 @@ proc putslitmotors {nxobj point} {
   }
 }
 
-publish nxcreatefile user
+namespace eval data {
-publish addnxscanentry user
+  command gumtree_save {int: run_number} {
-publish bm_addnxscanentry user
+    save $run_number
+  }
+  sicslist setatt ::data::gumtree_save long_name save
+  array set param [::data::gumtree_save -list param]
+  ::utility::mkData $param(run_number) run_number instrument privilege READ_ONLY mutable true control false
+  command gumtree_type {text:nx.hdf,xml type} {
+    SicsDataSuffix $type
+  }
+  sicslist set ::data::gumtree_type long_name file_type
+  ::data::gumtree_type -set type [SplitReply [SicsDataSuffix]]
+}
+
+Publish nxcreatefile user
+Publish addnxscanentry user
+Publish bm_addnxscanentry user
 

site_ansto/instrument/config/scan/scan_common_1.tcl

@@ -1,10 +1,10 @@
 #TODO Define bmon and hmm scan commands in separate namespaces
-
 MakeScanCommand hmscan bm $cfPath(scan)/scan_common_1.hdd recover.bin
 MakeScanCommand bmonscan bm $cfPath(scan)/scan_common_1.hdd recover.bin
 MakeScanCommand scan2 bm $cfPath(scan)/scan_common_1.hdd recover.bin
 
-namespace eval scancommand {
+namespace eval scan {
+  variable event; 
 # List of counts
 variable bmoncounts_array
 variable bmoncounts_axis
@@ -13,87 +13,60 @@ variable bmonscanvar_axis_hpath
 # hpath to values from bmoncounts_array
 # we use this to get auto-notification on update of bmonscancounts_array_hpath
 variable bmonscancounts_array_hpath
-
-# bmonscan setup parameters and feedback variables.
-VarMake bmonscan_var_name Text User
-VarMake bmonscan_var_value Float User
-VarMake bmonscan_var_start Float User
-VarMake bmonscan_var_step Float User
-VarMake bmonscan_mode Text User
-VarMake bmonscan_preset Float User
-VarMake bmonscan_np_target Int User
-VarMake bmonscan_point_current Int User
-VarMake bmonscan_counts Int User
-VarMake bmonscan_numchannels Int User
-VarMake bmonscan_channel Int User
-
-# bmonscan graphdata variables.
-VarMake bmonscan_np_graphics_target Int User
-VarMake bmonscan_point_graphics_current Int User
-VarMake bmonscan_var_graphics_value Float User
-
-VarMake hmscan_var_name Text User
-VarMake hmscan_var_value Float User
-VarMake hmscan_var_start Float User
-VarMake hmscan_var_step Float User
-VarMake hmscan_mode Text User
-VarMake hmscan_preset Float User
-VarMake hmscan_np_target Int User
-VarMake hmscan_point_current Int User
-VarMake hmscan_numchannels Int User
-VarMake hmscan_channel Int User
-
 variable scanVariable scan_var scanVarStart 0 scanVarStep 1
   proc scan_collect {sobj uobj point} {
   }
 
   proc hmm_scan_prepare {sobj uobj} {
-    variable scanVarStart;
-    variable scanVarStep;
-    variable scanVariable;
     variable scan_pt_start_time
+    set nexusdic hmscan.dic
 
-    nxcreatefile nexus_hmscan.dic;
-    nxclosefile;
 #  stdscan prepare $sobj $uobj;
-    hmscan_np_target [SplitReply [$sobj np]]
+    ::scan::hdb_hmscan -set NP [SplitReply [$sobj np]]
     set vlist [split [$sobj getvarpar 0] = ];
-    set scanVariable [string trim [lindex [split [lindex $vlist 0] . ] 1]];
+    ::scan::hdb_hmscan -set scan_variable [string trim [lindex [split [lindex $vlist 0] . ] 1]]
-    set scanVarStart [lindex $vlist 1];
+    ::scan::hdb_hmscan -set scan_start [lindex $vlist 1];
-    set scanVarStep [lindex $vlist 2];
+    ::scan::hdb_hmscan -set scan_increment [lindex $vlist 2];
 
-    hmscan_var_name $scanVariable
-    hmscan_var_start $scanVarStart
-    hmscan_var_step $scanVarStep
     set scan_pt_start_time [sicstime]
+
+    #FIXME remove dependency on hdb path
+    ::scan::hdb_hmscan -set feedback status BUSY
+
     ::histogram_memory::prepare 
+    data axis 1 [::scan::hdb_hmscan -set scan_variable]
+    ::hdb::set_save / true
+    newfile [SplitReply [SicsDataSuffix]] $nexusdic 
   }
 
   proc hmm_count {sobj uobj point mode preset} {
-    hmscan_point_current  $point;
+    ::scan::hdb_hmscan -set mode $mode
-    hmscan_mode $mode;
+    ::scan::hdb_hmscan -set preset $preset;
-    hmscan_preset $preset;
+    ::scan::hdb_hmscan -set feedback scanpoint $point
-    set scanvar [SplitReply [hmscan_var_name]]
+    ::scan::hdb_hmscan -set feedback mode $mode; 
-    hmscan_var_value [SplitReply [$scanvar]]
+    ::scan::hdb_hmscan -set feedback preset $preset; 
+    ::scan::hdb_hmscan -set feedback scan_variable_value [SplitReply [[::scan::hdb_hmscan -set scan_variable]]]
     ::histogram_memory::count_bm_controlled $mode $preset; 
   }
 
   proc hmm_scan_finish {sobj uobj} {
     ::histogram_memory::finish;
-    nxreopenfile;
+    ::scan::hdb_hmscan -set feedback status IDLE
-    nxclosefile;
+    # Make sure that the next save command doesn't overwrite our scan data.
+    newfile [SplitReply [SicsDataSuffix]]
   }
 
   proc bm_scan_finish {sobj uobj} {
-#    stdscan finish $sobj $uobj;
+    ::scan::hdb_bmonscan -set feedback status IDLE
-    nxreopenfile;
+    # Make sure that the next save command doesn't overwrite our scan data.
-    nxclosefile;
+    newfile [SplitReply [SicsDataSuffix]]
   }
 #proc hmm_scan_finish {sobj uobj} {
 #  nxclosefile;
 #}
 
 # Add an nxentry for the current scan point
+#TODO Is this obsolete?
   proc write_nxentry {nxentryCmd point} {
     variable scanVarStart;
     variable scanVarStep;
@@ -101,44 +74,45 @@ variable scanVariable scan_var scanVarStart 0 scanVarStep 1
     variable scan_pt_start_time;
 
     set scanVarPos [expr {$scanVarStart + $point * $scanVarStep} ];
-    nxreopenfile;
+    save $point
+#    nxreopenfile;
 #    $nxentryCmd nxscript scan_[format "%05d" $point] $scanVariable $scanVarPos $scanVarStep $scan_pt_start_time;
-    $nxentryCmd nxscript entry1 $point $scanVariable $scanVarPos $scanVarStep $scan_pt_start_time;
+#    $nxentryCmd nxscript entry1 $point $scanVariable $scanVarPos $scanVarStep $scan_pt_start_time;
-    nxclosefile;
+#    nxclosefile;
   }
 
   proc bm_writepoint {sobj uobj pt} {
     variable bmoncounts_array
     set bmoncounts_array [string map {\{ "" \} ""} [SplitReply [bmonscan getcounts]]];
-    write_nxentry bm_addnxscanentry $pt;
+    save $pt
 
-    bmonscan_counts [SplitReply [bm getcounts]] 
+    ::scan::hdb_bmonscan -set feedback counts [SplitReply [bm getcounts]];
-    bmonscan_np_graphics_target [SplitReply [bmonscan_np_target]]
-    bmonscan_point_graphics_current [SplitReply [bmonscan_point_current]]
-    bmonscan_var_graphics_value [SplitReply [bmonscan_var_value]]
   }
 
 #TODO Feedback for Histogram memory scan
   proc hmm_writepoint {sobj uobj pt} {
-    write_nxentry hmm_addnxscanentry $pt;
+    # Write hdb tree
+    save $pt
   }
 
   proc donothing {args} {}
 
   proc bm_count {sobj uobj point mode preset} {
-    bmonscan_point_current $point
+    variable event;
-    bmonscan_mode $mode;
+    ::scan::hdb_bmonscan -set mode $mode
-    bmonscan_preset $preset;
+    ::scan::hdb_bmonscan -set preset $preset 
-    set scanvar [SplitReply [bmonscan_var_name]]
+    ::scan::hdb_bmonscan -set feedback scanpoint $point; 
-    bmonscan_var_value [SplitReply [$scanvar]]
+    ::scan::hdb_bmonscan -set feedback mode $mode; 
-    bm setmode $mode
+    ::scan::hdb_bmonscan -set feedback preset $preset; 
-    bm count $preset;
+    ::scan::hdb_bmonscan -set feedback scan_variable_value [SplitReply [[::scan::hdb_bmonscan -set scan_variable]]]
+    ::monitor::count $mode $preset
   }
 
   proc bm_scan_prepare {sobj uobj} {
-    variable scanVarStart;
+    variable event; 
-    variable scanVarStep;
+    variable nexusdic
-    variable scanVariable;
+    set nexusdic bmonscan.dic
+
     variable bmoncounts_array;
     variable bmoncounts_axis;
     variable scan_pt_start_time 
@@ -147,148 +121,68 @@ variable scanVariable scan_var scanVarStart 0 scanVarStep 1
 #TODO Parameterise varindex in some way
     set varindex 0;
 
-    nxcreatefile nexus_bmonscan.dic;
+    ::scan::hdb_bmonscan -set feedback filename [SplitReply [dataFileName]]
-    nxclosefile;
+    ::scan::hdb_bmonscan -set NP [SplitReply [$sobj np]];
-    bmonscan_np_target [SplitReply [$sobj np]];
+#    set event(hdb_bmonscan/graphics,dim) [::scan::hdb_bmonscan -set NP]
     set vlist [split [$sobj getvarpar $varindex] = ];
-    set scanVariable [string trim [lindex [split [lindex $vlist 0] . ] 1]];
+    ::scan::hdb_bmonscan -set scan_variable [string trim [lindex [split [lindex $vlist 0] . ] 1]];
-    set scanVarStart [lindex $vlist 1];
+    ::scan::hdb_bmonscan -set scan_start [lindex $vlist 1];
-    set scanVarStep [lindex $vlist 2];
+    ::scan::hdb_bmonscan -set scan_increment [lindex $vlist 2];
     set scanvar_pts [SplitReply [$sobj getvardata $varindex]]
     set bmoncounts_axis [string map {\{ "" \} ""} $scanvar_pts]
-    bmonscan_var_name $scanVariable
+    todo_msg "SET START TIME     set event(hdb_bmonscan,scan_pt_start_time) [sicstime]" 
-    bmonscan_var_start $scanVarStart
+
-    bmonscan_var_step $scanVarStep
+    ::scan::hdb_bmonscan -set feedback status BUSY
-    set scan_pt_start_time [sicstime]
+    #FIXME remove dependency on hdb path
+    
+    array set bm_fb [::scan::hdb_bmonscan -list feedback]
+    data axis 1 [::scan::hdb_bmonscan -set scan_variable]
+    ::hdb::set_save / true
+    ::hdb::set_save /instrument/detector false
+    newfile [SplitReply [SicsDataSuffix]] $nexusdic 
     #stdscan prepare $sobj $uobj;
   }
 
 
-  proc init {} {
-    variable bmoncounts_array;
-    variable bmoncounts_axis;
-    
-    bmonscan_numchannels [SplitReply [bmonscan getnumchan]]; 
-    bmonscan_channel 0;
-    bmonscan_np_target 0;
-    bmonscan_point_current 0;
 
-    hmscan_numchannels [SplitReply [hmscan getnumchan]];
+# group=beam_monitor_scan 
-    hmscan_channel 0;
+proc hdb_bmonscan_graphics {process args} {
-    hmscan_np_target 0;
+  set eid hdb_bmonscan/graphics
-    hmscan_point_current 0;
+  $process $args path beam_monitor_scan prop_list {data false control true nxsave false klass @none type graphdata viewer default rank 1}
-    set bmoncounts_array [list];
+  $process $args kind event node beam_monitor_scan/dim dtype int priv user eventid $eid;
-    set bmoncounts_axis [list];
+  $process $args kind event node beam_monitor_scan/point dtype int priv user eventid $eid;
-  }
+  $process $args kind event node beam_monitor_scan/lastaxis dtype float priv user eventid $eid;
-
+  $process $args kind event node beam_monitor_scan/lastdata dtype int priv user eventid $eid;
-  proc commands_hpath_setup {parent} {
+  $process $args kind script node beam_monitor_scan/axis dtype floatvarar dlen 100 priv user rscript "set ::scan::bmoncounts_axis" wscript hdbReadOnly prop_list {type axis}
-    set feedbackPath $parent/bmonscan/feedback 
+  $process $args kind script node beam_monitor_scan/data dtype floatvarar dlen 100 priv user rscript "set ::scan::bmoncounts_array" wscript hdbReadOnly prop_list {type data}
-
+} 
-    hcommand $parent/bmonscan hdb_bmonscan
-    hsetprop $parent/bmonscan type command
-    hsetprop $parent/bmonscan priv user
-    
-    hattach $parent/bmonscan bmonscan_var_name scan_variable
-    hsetprop $parent/bmonscan/scan_variable argtype drivable
-
-    hattach $parent/bmonscan bmonscan_var_start scan_start
-    hsetprop $parent/bmonscan/scan_start argtype float
-    
-    hattach $parent/bmonscan bmonscan_var_step scan_increment
-    hsetprop $parent/bmonscan/scan_increment argtype float
-
-    hattach $parent/bmonscan/ bmonscan_np_target NP
-    hsetprop $parent/bmonscan/NP argtype int
-
-    hmake $parent/bmonscan/mode user text
-    hsetprop $parent/bmonscan/mode argtype text
-    hsetprop $parent/bmonscan/mode values monitor,timer
-
-    hmake $parent/bmonscan/preset user float
-    hsetprop $parent/bmonscan/preset argtype float
-
-    hattach $parent/bmonscan/ bmonscan_channel channel
-    hsetprop $parent/bmonscan/channel argtype int
-    hsetprop $parent/bmonscan/channel min 0
-    hsetprop $parent/bmonscan/channel max [SplitReply [bmonscan getnumchan]]
-
-# Optional feedback node
-    hmake $feedbackPath spy none
-    hattach $feedbackPath dataFileName filename
-    hattach $feedbackPath bmonscan_mode  mode
-    hattach $feedbackPath bmonscan_preset preset
-    hmake $feedbackPath/scan_variable spy none
-    hattach $feedbackPath/scan_variable bmonscan_var_value value 
-    hmake $feedbackPath/NP spy none
-    hattach $feedbackPath/NP bmonscan_point_current current
-    hattach $feedbackPath bmonscan_counts counts;
-    foreach fbNode [hlist $feedbackPath] {
-      hsetprop $feedbackPath/$fbNode privilege READ_ONLY;
-    }
-#TODO Histogram memory scan command
-  }
-
-
-  proc graphics_hpath_setup {parent} {
-    variable bmonscanvar_axis_hpath
-    variable bmonscancounts_array_hpath
-    variable bmoncounts_array
-    variable bmoncounts_axis
-
-    set bmonscanvar_axis_hpath $parent/beam_monitor_scan/axis 
-    set bmonscancounts_array_hpath $parent/beam_monitor_scan/data 
-    set defdim 100
-    hmake $parent/beam_monitor_scan spy none;
-    hsetprop $parent/beam_monitor_scan type graphdata;
-    hsetprop $parent/beam_monitor_scan viewer default;
-    hsetprop $parent/beam_monitor_scan rank 1;
-    hattach $parent/beam_monitor_scan bmonscan_np_target dim;
-    hattach $parent/beam_monitor_scan bmonscan_point_graphics_current point;
-    hattach $parent/beam_monitor_scan bmonscan_var_graphics_value lastaxis 
-    hattach $parent/beam_monitor_scan bmonscan_counts lastdata 
-    hmakescript $bmonscanvar_axis_hpath "set ::scancommand::bmoncounts_axis" hdbReadOnly floatvarar $defdim
-    hsetprop $bmonscanvar_axis_hpath type axis
-    sicspoll del $bmonscanvar_axis_hpath
-    hmakescript $bmonscancounts_array_hpath "set ::scancommand::bmoncounts_array" hdbReadOnly floatvarar $defdim
-    hsetprop $bmonscancounts_array_hpath type data
-    sicspoll del $bmonscancounts_array_hpath
-
-#TODO histogram_memory_scan
-#    hmake $parent/histogram_memory_scan spy none;
-#    hsetprop $parent/histogram_memory_scan type graphdata;
-#    hsetprop $parent/histogram_memory_scan viewer default;
-#    hsetprop $parent/histogram_memory_scan rank 2;
-#    hattach $parent/histogram_memory_scan hmscan_np_target dim0;
-#    hattach $parent/histogram_memory_scan hmscan_np_target dim1;
-#    hattach $parent/histogram_memory_scan hmscan_point_current point;
-  }
 }
 
-publish ::scancommand::scan_collect user
+Publish ::scan::scan_collect user
-publish ::scancommand::write_nxentry user
+Publish ::scan::write_nxentry user
-publish ::scancommand::hmm_count user
+Publish ::scan::hmm_count user
-publish ::scancommand::hmm_scan_prepare user
+Publish ::scan::hmm_scan_prepare user
-publish ::scancommand::hmm_scan_finish user
+Publish ::scan::hmm_scan_finish user
-publish ::scancommand::hmm_writepoint user
+Publish ::scan::hmm_writepoint user
-publish ::scancommand::donothing user
+Publish ::scan::donothing user
 
-publish ::scancommand::bm_scan_prepare user
+Publish ::scan::bm_scan_prepare user
-publish ::scancommand::bm_scan_finish user
+Publish ::scan::bm_scan_finish user
-publish ::scancommand::bm_writepoint user
+Publish ::scan::bm_writepoint user
-publish ::scancommand::bm_count user
+Publish ::scan::bm_count user
 
 bmonscan configure script
-bmonscan function writeheader ::scancommand::donothing
+bmonscan function writeheader ::scan::donothing
-bmonscan function writepoint ::scancommand::bm_writepoint
+bmonscan function writepoint ::scan::bm_writepoint
-bmonscan function count ::scancommand::bm_count
+bmonscan function count ::scan::bm_count
-#bmonscan function collect ::scancommand::scan_collect
+#bmonscan function collect ::scan::scan_collect
-bmonscan function prepare ::scancommand::bm_scan_prepare
+bmonscan function prepare ::scan::bm_scan_prepare
-bmonscan function finish ::scancommand::bm_scan_finish
+bmonscan function finish ::scan::bm_scan_finish
 
 
-#scan2 function writeheader ::scancommand::donothing
+#scan2 function writeheader ::scan::donothing
-#scan2 function writepoint ::scancommand::nxaddpoint
+#scan2 function writepoint ::scan::nxaddpoint
-#scan2 function prepare ::scancommand::hmm_scan_prepare
+#scan2 function prepare ::scan::hmm_scan_prepare
 # Configure script mode, then we can configure all the scan callbacks.
 # The scan list command can be used to check that the callbacks
 # are properly defined. 
@@ -306,29 +200,57 @@ scan2 function finish  ::histogram_memory::hs_finish
 hmscan configure script
 #hmscan function prepare hdbprepare
 #hmscan function collect hdbcollect
-hmscan function writeheader ::scancommand::donothing
+hmscan function writeheader ::scan::donothing
-hmscan function writepoint ::scancommand::hmm_writepoint
+hmscan function writepoint ::scan::hmm_writepoint
-hmscan function count ::scancommand::hmm_count
+hmscan function count ::scan::hmm_count
-#hmscan function collect ::scancommand::scan_collect
+#hmscan function collect ::scan::scan_collect
-bmonscan function prepare ::scancommand::bm_scan_prepare
+hmscan function prepare ::scan::hmm_scan_prepare
-hmscan function prepare ::scancommand::hmm_scan_prepare
+hmscan function finish ::scan::hmm_scan_finish
-hmscan function finish ::scancommand::hmm_scan_finish
+
-# Wombat proc hdb_hmscan {scanvar scanstart scanincr scanend mode preset} {
+namespace eval scan {
-proc hdb_bmonscan {scanvar scanstart scanincr np mode preset channel} {
+command hdb_bmonscan { text:drivable scan_variable float: scan_start float: scan_increment int: NP text:monitor,timer mode float: preset int:0,2 channel} { 
+
     bmonscan clear
 #    bmonscan configure script
 
-    bmonscan add $scanvar $scanstart $scanincr
+    bmonscan add $scan_variable $scan_start $scan_increment
     bmonscan setchannel $channel;
-    set status [catch {bmonscan run $np $mode $preset} msg]
+    set status [catch {bmonscan run $NP $mode $preset} msg]
 #    bmonscan configure soft
     if {$status == 0} {
       return $msg
     } else {
-      clientput "hdb_bmonscan ERROR: $msg"
+      clientput "ERROR, [info level 0], $msg"
       error $msg
     }
+
+
 }
+::scan::hdb_bmonscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status
+::scan::hdb_bmonscan -set feedback status IDLE
+ 
 
-publish hdb_bmonscan user
 
+command hdb_hmscan { text:drivable scan_variable float: scan_start float: scan_increment int: NP text:monitor,timer mode float: preset int:0,2 channel} { 
+
+    hmscan clear
+
+    hmscan add $scan_variable $scan_start $scan_increment
+    hmscan setchannel $channel;
+    set status [catch {hmscan run $NP $mode $preset} msg]
+
+    if {$status == 0} {
+      return $msg
+    } else {
+      clientput "ERROR, [info level 0], $msg"
+      error $msg
+    }
+
+
+}
+::scan::hdb_hmscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status
+::scan::hdb_hmscan -set feedback status IDLE
+}
+publish ::scan::hdb_bmonscan_graphics user
+sicslist setatt ::scan::hdb_bmonscan long_name bmonscan
+sicslist setatt ::scan::hdb_hmscan long_name hmscan

site_ansto/instrument/reflectometer/Makefile

@@ -1,14 +1,5 @@
-cfPath=config/motors
+all:
-
-all: script_val
 	make -C config
 
-
-script_val: SVmotors
-
-
-SVmotors: $(cfPath)/motor_configuration.tcl 
-	../mksim_config.tcl -f $(cfPath)/motor_configuration.tcl > script_validator/$(cfPath)/motor_configuration.tcl
-
 clean:
 	make -C config clean

site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT

@@ -1,7 +1,10 @@
 config/plc/plc_common_1.tcl
 config/counter/counter_common_1.tcl
-config/hipadaba/common_hipadaba_configuration.tcl
+config/hipadaba/hipadaba_configuration_common.tcl
+config/hipadaba/common_instrument_dictionary.tcl
+config/hipadaba/instdict_specification.tcl
 config/hmm/hmm_configuration_common_1.tcl
+config/hmm/anstohm_linked.xml
 config/scan/scan_common_1.hdd
 config/scan/scan_common_1.tcl
 config/nexus/nxscripts_common_1.tcl

site_ansto/instrument/reflectometer/config/chopper/chopper.tcl

@@ -1,15 +1,4 @@
-#START SERVER CONFIGURATION SECTION
+if 0 {
-set sicsroot /usr/local/sics
-source dmc2280_util.tcl
-source server_config.tcl
-#END SERVER CONFIGURATION SECTION
-
-########################################
-# INSTRUMENT SPECIFIC CONFIGURATION
-VarMake Instrument Text Internal 
-Instrument Platypus 
-Instrument lock
-
 # Chopper NCS013 communications
 set chopper_controller(host) 137.157.202.130
 set chopper_controller(port) 10000
@@ -27,3 +16,11 @@ MakeChopper chopperController tcpdocho [params \
   password $chopper_controller(password) \
 ]
 ChopperAdapter chspeed chopperController speed 0 10
+}
+namespace eval ::chopper {
+  command set_freq {float: frequency} {
+    for {set i 0} {$i < $frequency} {incr i} {
+      clientput chop
+    }
+  }
+}

site_ansto/instrument/reflectometer/config/counter/counter.tcl

@@ -0,0 +1,17 @@
+set sim_mode [SplitReply [counter_simulation]]
+if {$sim_mode == "true"} {
+  MakeCounter bm SIM 0.0;
+} else {
+# Make and configure an ANSTO beam monitor counter.
+# This must be sourced before the hmm_configuration.tcl until we separate the scan setup from the hmm setup
+  MakeCounter bm anstomonitor [ params host "das1-[SplitReply [instrument]]" port "30000" ]
+}
+
+source $cfPath(counter)/counter_common_1.tcl
+unset sim_mode
+
+## TODO Put all the counter macros in the counter namespace
+namespace eval counter {
+  proc set_sobj_attributes {} {
+  }
+}

site_ansto/instrument/reflectometer/config/hipadaba/hipadaba_configuration.tcl

@@ -1 +1 @@
-source $cfPath(hipadaba)/common_hipadaba_configuration.tcl
+source $cfPath(hipadaba)/hipadaba_configuration_common.tcl

site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl

@@ -0,0 +1,84 @@
+set sim_mode [SplitReply [hmm_simulation]]
+if {$sim_mode == "true"} {
+  MakeHM hmm SIM;
+  namespace eval histogram_memory {
+    proc hmc {_start _preset _mode _pause} {
+      bm mode $_mode;
+      bm preset $_preset;
+      hmm countblock;
+    }
+  }
+} else {
+  MakeHM hmm anstohttp;
+  MakeHMControl_ANSTO hmc bm hmm;
+}
+
+source $cfPath(hmm)/hmm_configuration_common_1.tcl
+if {$sim_mode == "true"} {
+  proc ::histogram_memory::hmm_initialize {} {
+    hmm configure hmaddress http://das1-[SplitReply [instrument]]:8080;
+    hmm configure username spy;
+    hmm configure password 007;
+    hmm configure hmDataPath ../HMData;
+  }
+}
+# Configure to upload a complete configuration to the histogram server.
+# In this case it's the main config file plus the FAT, BAT and OAT files
+# in the same direcory as the SICS executable (for this example).
+# Alternatives:
+# - A partial config could be uploaded instead - e.g. just the main config file,
+# in that case the main config file points to a set of FAT, BAT OAT files
+# located on the server.
+# - The histogram server could configure itself from a config file set
+# kept on the local file system (not automated presently, manual control only)
+# - Or, no configuration at all could be uploaded, the
+# histogram server can configure itself using its default config files.
+proc ::histogram_memory::setmode {mode} {
+  hmm_mode $mode;
+  set sim_mode [SplitReply [hmm_simulation]];
+
+  switch $mode {
+    pulser {
+      if {$sim_mode == "true"} {
+        hmm configure oat_nyc_eff 1024;
+        hmm configure oat_nxc_eff 64;
+        hmm configure oat_ntc_eff 1;
+      }
+      _hmm_hor_channel_name tube_pair_number
+      _hmm_hor_axis tube_pair_number
+      _hmm_hor_axis_alias dcolindex
+      _hmm_vert_axis vertical_channel_number
+      _hmm_vert_axis_alias drowindex
+      hmm configure hmconfigscript "returnconfigfile [SplitReply [hmm_user_configpath]]/anstohm_full_MESYTEC_PULSER.xml"
+    }
+    calibration {
+      if {$sim_mode == "true"} {
+        hmm configure oat_nyc_eff 1024;
+        hmm configure oat_nxc_eff 64;
+        hmm configure oat_ntc_eff 1;
+      }
+      _hmm_hor_channel_name tube_pair_number
+      _hmm_hor_axis tube_pair_number
+      _hmm_hor_axis_alias dcolindex
+      _hmm_vert_axis vertical_channel_number
+      _hmm_vert_axis_alias drowindex
+      hmm configure hmconfigscript "returnconfigfile [SplitReply [hmm_user_configpath]]/anstohm_full_nofolding.xml"
+    }
+    normal -
+      default {
+        if {$sim_mode == "true"} {
+          hmm configure oat_nyc_eff 512;
+          hmm configure oat_nxc_eff 128;
+          hmm configure oat_ntc_eff 1;
+        }
+        _hmm_hor_channel_name horizontal_channel_number
+        _hmm_hor_axis polar_angle
+        _hmm_hor_axis_alias dtheta
+        _hmm_vert_axis vertical_channel_number
+        _hmm_vert_axis_alias drowindex
+        OAT_TABLE X {-210.5 -209.5} Y {-110.5 -109.5} T {0 20000} NTC 5
+        ::histogram_memory::configure_server  Filler_defaults FASTCOMTEC
+      }
+  }
+}
+

site_ansto/instrument/reflectometer/config/motors/motor_configuration.tcl

@@ -1,7 +1,7 @@
-# $Revision: 1.16 $
+# $Revision: 1.17 $
-# $Date: 2007-06-27 01:02:36 $
+# $Date: 2007-07-22 05:23:40 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
-# Last revision by: $Author: dcl $
+# Last revision by: $Author: ffr $
 
 # START MOTOR CONFIGURATION
 
@@ -178,6 +178,14 @@ set ss4l_HiRange 14.0
 set ss4u_HiRange 27.0
 set ss4d_HiRange 8.0
 }
+set slit1VGroup first/vertical
+set slit1HGroup first/horizontal
+set slit2VGroup second/vertical
+set slit2HGroup second/horizontal
+set slit3VGroup third/vertical
+set slit3HGroup third/horizontal
+set slit4VGroup fourth/vertical
+set slit4HGroup fourth/horizontal
 
 # set movecount high to reduce the frequency of
 # hnotify messages to a reasonable level
@@ -285,7 +293,7 @@ Motor st3vt $motor_driver_type [params \
   absEnc 1\
   absEncHome $st3vt_home\
   cntsPerX -8192]
-st3vt part aperture.3/vertical
+st3vt part aperture.$slit3VGroup
 st3vt long_name st3vt
 st3vt softlowerlim 0
 st3vt softupperlim 253
@@ -305,7 +313,7 @@ Motor st4vt $motor_driver_type [params \
   absEnc 1\
   absEncHome $st4vt_home\
   cntsPerX -8192]
-st4vt part aperture.4/vertical
+st4vt part aperture.$slit4VGroup
 st4vt long_name st4vt
 st4vt softlowerlim 0
 st4vt softupperlim 249
@@ -481,7 +489,7 @@ Motor ss1l $motor_driver_type [params \
   maxDecel 5\
   stepsPerX $slitStepRate\
   motorHome $ss1l_Home]
-ss1l part aperture.1/horizontal
+ss1l part aperture.$slit1HGroup
 ss1l long_name left
 ss1l softlowerlim $ss1l_LoRange
 ss1l softupperlim $ss1l_HiRange
@@ -499,7 +507,7 @@ Motor ss1r $motor_driver_type [params \
   maxDecel 5\
   stepsPerX -$slitStepRate\
   motorHome $ss1r_Home]
-ss1r part aperture.1/horizontal
+ss1r part aperture.$slit1HGroup
 ss1r long_name right
 ss1r softlowerlim $ss1r_LoRange
 ss1r softupperlim $ss1r_HiRange
@@ -517,7 +525,7 @@ Motor ss1u $motor_driver_type [params \
   maxDecel 5\
   stepsPerX -$slitStepRate\
   motorHome $ss1u_Home]
-ss1u part aperture.1/vertical
+ss1u part aperture.$slit1VGroup
 ss1u long_name upper
 ss1u softlowerlim $ss1u_LoRange
 ss1u softupperlim $ss1u_HiRange
@@ -535,7 +543,7 @@ Motor ss1d $motor_driver_type [params \
   maxDecel 5\
   stepsPerX $slitStepRate\
   motorHome $ss1d_Home]
-ss1d part aperture.1/vertical
+ss1d part aperture.$slit1VGroup
 ss1d long_name lower
 ss1d softlowerlim $ss1d_LoRange
 ss1d softupperlim $ss1d_HiRange
@@ -553,7 +561,7 @@ Motor ss2l $motor_driver_type [params \
   maxDecel 5\
   stepsPerX $slitStepRate\
   motorHome $ss2l_Home]
-ss2l part aperture.2/horizontal
+ss2l part aperture.$slit2HGroup
 ss2l long_name left
 ss2l softlowerlim $ss2l_LoRange
 ss2l softupperlim $ss2l_HiRange
@@ -571,7 +579,7 @@ Motor ss2r $motor_driver_type [params \
   maxDecel 5\
   stepsPerX -$slitStepRate\
   motorHome $ss2r_Home]
-ss2r part aperture.2/horizontal
+ss2r part aperture.$slit2HGroup
 ss2r long_name right
 ss2r softlowerlim $ss2r_LoRange
 ss2r softupperlim $ss2r_HiRange
@@ -589,7 +597,7 @@ Motor ss2u $motor_driver_type [params \
   maxDecel 5\
   stepsPerX -$slitStepRate\
   motorHome $ss2u_Home]
-ss2u part aperture.2/vertical
+ss2u part aperture.$slit2VGroup
 ss2u long_name upper
 ss2u softlowerlim $ss2u_LoRange
 ss2u softupperlim $ss2u_HiRange
@@ -607,7 +615,7 @@ Motor ss2d $motor_driver_type [params \
   maxDecel 5\
   stepsPerX $slitStepRate\
   motorHome $ss2d_Home]
-ss2d part aperture.2/vertical
+ss2d part aperture.$slit2VGroup
 ss2d long_name lower
 ss2d softlowerlim $ss2d_LoRange
 ss2d softupperlim $ss2d_HiRange
@@ -632,7 +640,7 @@ Motor ss3d $motor_driver_type [params \
   maxDecel 5\
   stepsPerX $slitStepRate\
   motorHome $ss3d_Home]
-ss3d part aperture.3/vertical
+ss3d part aperture.$slit3VGroup
 ss3d long_name lower
 ss3d softlowerlim $ss3d_LoRange
 ss3d softupperlim $ss3d_HiRange
@@ -650,7 +658,7 @@ Motor ss3u $motor_driver_type [params \
   maxDecel 5\
   stepsPerX -$slitStepRate\
   motorHome $ss3u_Home]
-ss3u part aperture.3/vertical
+ss3u part aperture.$slit3VGroup
 ss3u long_name upper
 ss3u softlowerlim $ss3u_LoRange
 ss3u softupperlim $ss3u_HiRange
@@ -668,7 +676,7 @@ Motor ss3l $motor_driver_type [params \
   maxDecel 5\
   stepsPerX $slitStepRate\
   motorHome $ss3l_Home]
-ss3l part aperture.3/horizontal
+ss3l part aperture.$slit3HGroup
 ss3l long_name left
 ss3l softlowerlim $ss3l_LoRange
 ss3l softupperlim $ss3l_HiRange
@@ -686,7 +694,7 @@ Motor ss3r $motor_driver_type [params \
   maxDecel 5\
   stepsPerX -$slitStepRate\
   motorHome $ss3r_Home]
-ss3r part aperture.3/horizontal
+ss3r part aperture.$slit3HGroup
 ss3r long_name right
 ss3r softlowerlim $ss3r_LoRange
 ss3r softupperlim $ss3r_HiRange
@@ -704,7 +712,7 @@ Motor ss4d $motor_driver_type [params \
   maxDecel 5\
   stepsPerX $slitStepRate\
   motorHome $ss4d_Home]
-ss4d part aperture.4/vertical
+ss4d part aperture.$slit4VGroup
 ss4d long_name lower
 ss4d softlowerlim $ss4d_LoRange
 ss4d softupperlim $ss4d_HiRange
@@ -722,7 +730,7 @@ Motor ss4u $motor_driver_type [params \
   maxDecel 5\
   stepsPerX -$slitStepRate\
   motorHome $ss4u_Home]
-ss4u part aperture.4/vertical
+ss4u part aperture.$slit4VGroup
 ss4u long_name upper
 ss4u softlowerlim $ss4u_LoRange
 ss4u softupperlim $ss4u_HiRange
@@ -740,7 +748,7 @@ Motor ss4l $motor_driver_type [params \
   maxDecel 5\
   stepsPerX $slitStepRate\
   motorHome $ss4l_Home]
-ss4l part aperture.4/horizontal
+ss4l part aperture.$slit4HGroup
 ss4l long_name left
 ss4l softlowerlim $ss4l_LoRange
 ss4l softupperlim $ss4l_HiRange
@@ -758,7 +766,7 @@ Motor ss4r $motor_driver_type [params \
   maxDecel 5\
   stepsPerX -$slitStepRate\
   motorHome $ss4r_Home]
-ss4r part aperture.4/horizontal
+ss4r part aperture.$slit4HGroup
 ss4r long_name right
 ss4r softlowerlim $ss4r_LoRange
 ss4r softupperlim $ss4r_HiRange
@@ -838,7 +846,7 @@ proc set_gap_offset {m1 m2 val} {
 }
 
 # make_gap_motors virt_width_motor virt_offset_motor real_high_motor real_low_motor
-proc make_gap_motors {vm1 vm2 m1 m2} {
+proc make_gap_motors {vm1 vm1_name vm2 vm2_name m1 m2 aunits agroup} {
   eval "proc get_$vm1 {} { get_gap_width $m1 $m2 }"
   set v {$var}
   eval "proc set_$vm1 {var} { set_gap_width $m1 $m2 $v }"
@@ -846,7 +854,9 @@ proc make_gap_motors {vm1 vm2 m1 m2} {
   $vm1 readscript get_$vm1
   $vm1 drivescript set_$vm1
 publish get_$vm1 user
+sicslist setatt get_$vm1 privilege internal
 publish set_$vm1 user
+sicslist setatt set_$vm1 privilege internal
 
   eval "proc get_$vm2 {} { get_gap_offset $m1 $m2 }"
   set v {$var}
@@ -855,19 +865,32 @@ publish set_$vm1 user
   $vm2 readscript get_$vm2
   $vm2 drivescript set_$vm2
 publish get_$vm2 user
+sicslist setatt get_$vm2 privilege internal
 publish set_$vm2 user
+sicslist setatt set_$vm2 privilege internal
+
+sicslist setatt $vm1 units $aunits
+sicslist setatt $vm1 klass aperture
+sicslist setatt $vm1 long_name $vm1_name
+sicslist setatt $vm1 group $agroup
+sicslist setatt $vm2 units $aunits
+sicslist setatt $vm2 klass aperture
+sicslist setatt $vm2 long_name $vm2_name
+sicslist setatt $vm2 group $agroup
 }
 
-make_gap_motors ss1vg ss1vo ss1u ss1d
+make_gap_motors ss1vg gap ss1vo offset ss1u ss1d mm $slit1VGroup
-make_gap_motors ss1hg ss1ho ss1r ss1l
+make_gap_motors ss1hg gap ss1ho offset ss1r ss1l mm $slit1HGroup
 
-make_gap_motors ss2vg ss2vo ss2u ss2d
+make_gap_motors ss2vg gap ss2vo offset ss2u ss2d mm $slit2VGroup
-make_gap_motors ss2hg ss2ho ss2r ss2l
+make_gap_motors ss2hg gap ss2ho offset ss2r ss2l mm $slit2HGroup
 
-make_gap_motors ss3vg ss3vo ss3u ss3d
+make_gap_motors ss3vg gap ss3vo offset ss3u ss3d mm $slit3VGroup
-make_gap_motors ss3hg ss3ho ss3r ss3l
+make_gap_motors ss3hg gap ss3ho offset ss3r ss3l mm $slit3HGroup
 
-make_gap_motors ss4vg ss4vo ss4u ss4d
+make_gap_motors ss4vg gap ss4vo offset ss4u ss4d mm $slit4VGroup
-make_gap_motors ss4hg ss4ho ss4r ss4l
+make_gap_motors ss4hg gap ss4ho offset ss4r ss4l mm $slit4HGroup
 
+proc motor_set_sobj_attributes {} {
+}
 # END MOTOR CONFIGURATION

site_ansto/instrument/reflectometer/config/scan/scan.tcl

@@ -1,8 +1 @@
-namespace eval scancommand {
+source $cfPath(scan)/scan_common_1.tcl
-  proc init {} {
-  }
-  proc commands_hpath_setup {parent} {
-  }
-  proc graphics_hpath_setup {parent} {
-  }
-}

site_ansto/instrument/reflectometer/platypus_configuration.tcl

@@ -1,11 +1,12 @@
-# $Revision: 1.10 $
+# $Revision: 1.11 $
-# $Date: 2007-07-11 22:49:33 $
+# $Date: 2007-07-22 05:23:40 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
-# Last revision by: $Author: dcl $
+# Last revision by: $Author: ffr $
 
 # Required by server_config.tcl 
-VarMake Instrument Text Internal 
+VarMake Instrument Text Internal
-Instrument Platypus 
+sicslist setatt Instrument privilege internal
+Instrument platypus 
 Instrument lock
 
 #START SERVER CONFIGURATION SECTION
@@ -16,19 +17,42 @@ source server_config.tcl
 
 ########################################
 # INSTRUMENT SPECIFIC CONFIGURATION
+#set hmm_mode normal
 
-fileeval $cfPath(chopper)/chopper.tcl
 fileeval $cfPath(motors)/motor_configuration.tcl
-#fileeval gen_hipadaba.tcl
 
 fileeval $cfPath(plc)/plc.tcl
 fileeval $cfPath(counter)/counter.tcl
 fileeval $cfPath(hmm)/hmm_configuration.tcl
 fileeval $cfPath(nexus)/nxscripts.tcl
 fileeval $cfPath(scan)/scan.tcl
+fileeval $cfPath(chopper)/chopper.tcl
 source $cfPath(hipadaba)/hipadaba_configuration.tcl
 source gumxml.tcl
 
-MakeStateMon
+#::histogram_memory::setmode pulser
+#::histogram_memory::setmode calibration
+::histogram_memory::setmode normal
+#::histogram_memory::hmm_initialize
+::histogram_memory::hmm_setup transparent 0 3 oat_nyc_eff  oat_nxc_eff oat_ntc_eff
+hmm_start 0
 
+MakeStateMon hmscan 
+
+proc instrument_set_sobj_attributes {} {
+
+    motor_set_sobj_attributes 
+    ::utility::set_motor_attributes
+    ::utility::set_histomem_attributes
+    ::utility::set_sobj_attributes
+    ::counter::set_sobj_attributes 
+    ::nexus::set_sobj_attributes 
+    ::histogram_memory::set_sobj_attributes 
+## TODO move the following to the new ansto gumxml.tcl
+    sicslist setatt getgumtreexml privilege internal
+}
+
+instrument_set_sobj_attributes 
+buildHDB instrument_dictionary
+#buildHDB [instname]_dictionary
 fileeval extraconfig.tcl

site_ansto/instrument/sans/Makefile

@@ -1,14 +1,5 @@
-cfPath=config/motors
+all:
-
-all: script_val
 	make -C config
 
-
-script_val: SVmotors
-
-
-SVmotors: $(cfPath)/motor_configuration.tcl 
-	../mksim_config.tcl -f $(cfPath)/motor_configuration.tcl > script_validator/$(cfPath)/motor_configuration.tcl
-
 clean:
 	make -C config clean

site_ansto/instrument/sans/config/INSTCFCOMMON.TXT

@@ -1,7 +1,10 @@
 config/plc/plc_common_1.tcl
 config/counter/counter_common_1.tcl
-config/hipadaba/common_hipadaba_configuration.tcl
+config/hipadaba/hipadaba_configuration_common.tcl
+config/hipadaba/common_instrument_dictionary.tcl
+config/hipadaba/instdict_specification.tcl
 config/hmm/hmm_configuration_common_1.tcl
+config/hmm/anstohm_linked.xml
 config/scan/scan_common_1.hdd
 config/scan/scan_common_1.tcl
 config/nexus/nxscripts_common_1.tcl

site_ansto/instrument/sans/config/counter/counter.tcl

@@ -1 +1,17 @@
-# TODO
+set sim_mode [SplitReply [counter_simulation]]
+if {$sim_mode == "true"} {
+  MakeCounter bm SIM 0.0;
+} else {
+# Make and configure an ANSTO beam monitor counter.
+# This must be sourced before the hmm_configuration.tcl until we separate the scan setup from the hmm setup
+  MakeCounter bm anstomonitor [ params host "das1-[SplitReply [instrument]]" port "30000" ]
+}
+
+source $cfPath(counter)/counter_common_1.tcl
+unset sim_mode
+
+## TODO Put all the counter macros in the counter namespace
+namespace eval counter {
+  proc set_sobj_attributes {} {
+  }
+}

site_ansto/instrument/sans/config/hipadaba/hipadaba_configuration.tcl

@@ -1 +1 @@
-source $cfPath(hipadaba)/common_hipadaba_configuration.tcl
+source $cfPath(hipadaba)/hipadaba_configuration_common.tcl

site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl

@@ -0,0 +1,84 @@
+set sim_mode [SplitReply [hmm_simulation]]
+if {$sim_mode == "true"} {
+  MakeHM hmm SIM;
+  namespace eval histogram_memory {
+    proc hmc {_start _preset _mode _pause} {
+      bm mode $_mode;
+      bm preset $_preset;
+      hmm countblock;
+    }
+  }
+} else {
+  MakeHM hmm anstohttp;
+  MakeHMControl_ANSTO hmc bm hmm;
+}
+
+source $cfPath(hmm)/hmm_configuration_common_1.tcl
+if {$sim_mode == "true"} {
+  proc ::histogram_memory::hmm_initialize {} {
+    hmm configure hmaddress http://das1-[SplitReply [instrument]]:8080;
+    hmm configure username spy;
+    hmm configure password 007;
+    hmm configure hmDataPath ../HMData;
+  }
+}
+# Configure to upload a complete configuration to the histogram server.
+# In this case it's the main config file plus the FAT, BAT and OAT files
+# in the same direcory as the SICS executable (for this example).
+# Alternatives:
+# - A partial config could be uploaded instead - e.g. just the main config file,
+# in that case the main config file points to a set of FAT, BAT OAT files
+# located on the server.
+# - The histogram server could configure itself from a config file set
+# kept on the local file system (not automated presently, manual control only)
+# - Or, no configuration at all could be uploaded, the
+# histogram server can configure itself using its default config files.
+proc ::histogram_memory::setmode {mode} {
+  hmm_mode $mode;
+  set sim_mode [SplitReply [hmm_simulation]];
+
+  switch $mode {
+    pulser {
+      if {$sim_mode == "true"} {
+        hmm configure oat_nyc_eff 1024;
+        hmm configure oat_nxc_eff 64;
+        hmm configure oat_ntc_eff 1;
+      }
+      _hmm_hor_channel_name tube_pair_number
+      _hmm_hor_axis tube_pair_number
+      _hmm_hor_axis_alias dcolindex
+      _hmm_vert_axis vertical_channel_number
+      _hmm_vert_axis_alias drowindex
+      hmm configure hmconfigscript "returnconfigfile [SplitReply [hmm_user_configpath]]/anstohm_full_MESYTEC_PULSER.xml"
+    }
+    calibration {
+      if {$sim_mode == "true"} {
+        hmm configure oat_nyc_eff 1024;
+        hmm configure oat_nxc_eff 64;
+        hmm configure oat_ntc_eff 1;
+      }
+      _hmm_hor_channel_name tube_pair_number
+      _hmm_hor_axis tube_pair_number
+      _hmm_hor_axis_alias dcolindex
+      _hmm_vert_axis vertical_channel_number
+      _hmm_vert_axis_alias drowindex
+      hmm configure hmconfigscript "returnconfigfile [SplitReply [hmm_user_configpath]]/anstohm_full_nofolding.xml"
+    }
+    normal -
+      default {
+        if {$sim_mode == "true"} {
+          hmm configure oat_nyc_eff 512;
+          hmm configure oat_nxc_eff 128;
+          hmm configure oat_ntc_eff 1;
+        }
+        _hmm_hor_channel_name horizontal_channel_number
+        _hmm_hor_axis polar_angle
+        _hmm_hor_axis_alias dtheta
+        _hmm_vert_axis vertical_channel_number
+        _hmm_vert_axis_alias drowindex
+        OAT_TABLE X {-210.5 -209.5} Y {-110.5 -109.5} T {0 20000} NTC 5
+        ::histogram_memory::configure_server  Filler_defaults FASTCOMTEC
+      }
+  }
+}
+

site_ansto/instrument/sans/config/motors/motor_configuration.tcl

@@ -1,7 +1,7 @@
-# $Revision: 1.2 $
+# $Revision: 1.3 $
-# $Date: 2007-07-20 00:05:00 $
+# $Date: 2007-07-22 05:23:40 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
-# Last revision by: $Author: dcl $
+# Last revision by: $Author: ffr $
 
 # START MOTOR CONFIGURATION
 
@@ -766,4 +766,6 @@ pol softlowerlim 0
 pol softupperlim 3
 pol home 0
 
+proc motor_set_sobj_attributes {} {
+}
 # END MOTOR CONFIGURATION

site_ansto/instrument/sans/config/nexus/nexus_bmonscan.dic

@@ -18,7 +18,7 @@ row_index_name=vertical_channel_number
 #---------- NXentry level
 etitle=/$(entryName),NXentry/SDS title -type NX_CHAR
 program_name=/$(entryName),NXentry/SDS program_name -type NX_CHAR \
--attr {nx_schema_release_tag,$Name: not supported by cvs2svn $} -attr {nx_schema_revision_num,$Revision: 1.2 $}
+-attr {nx_schema_release_tag,$Name: not supported by cvs2svn $} -attr {nx_schema_revision_num,$Revision: 1.3 $}
 
 erun=/$(entryName),NXentry/SDS run_number -type NX_INT32  -rank 1 -dim {-1}
 estart=/$(entryName),NXentry/SDS start_time -type NX_CHAR 
@@ -65,6 +65,7 @@ scandata=/$(entryName),NXentry/data,NXdata/NXVGROUP
 scanhoraxis=/$(entryName),NXentry/data,NXdata/NXVGROUP
 scanvertaxis=/$(entryName),NXentry/data,NXdata/NXVGROUP
 scanvar=/$(entryName),NXentry/data,NXdata/NXVGROUP
+scantwotheta=/$(entryName),NXentry/scan_step,NXdata/SDS two_theta  -type NX_FLOAT32 -attr {units,degree} -attr {long_name,two_theta}
 scanstep=/$(entryName),NXentry/scan_step,NXdata/SDS value  -type NX_FLOAT32 -attr {units,degree} -attr {long_name,stepsize}
 #histogram=/$(entryName),NXentry/histogram,NXdata/NXVGROUP
 #scanvar=/$(entryName),NXentry/$(scan_variable),NXdata/NXVGROUP

site_ansto/instrument/sans/config/nexus/nexus_hmscan.dic

@@ -18,7 +18,7 @@ row_index_name=vertical_channel_number
 #---------- NXentry level
 etitle=/$(entryName),NXentry/SDS title -type NX_CHAR
 program_name=/$(entryName),NXentry/SDS program_name -type NX_CHAR \
--attr {nx_schema_release_tag,$Name: not supported by cvs2svn $} -attr {nx_schema_revision_num,$Revision: 1.2 $}
+-attr {nx_schema_release_tag,$Name: not supported by cvs2svn $} -attr {nx_schema_revision_num,$Revision: 1.3 $}
 
 erun=/$(entryName),NXentry/SDS run_number -type NX_INT32  -rank 1 -dim {-1}
 estart=/$(entryName),NXentry/SDS start_time -type NX_CHAR 
@@ -55,7 +55,7 @@ dradius=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS ra
 dheight=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS height -type NX_FLOAT32  -attr {units,mm}
 detangle_rad=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS arc -type NX_FLOAT32  -attr {units,radians}
 detangle_degrees=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS arc -type NX_FLOAT32  -attr {units,degrees} 
-dtheta=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS polar_angle -type NX_FLOAT32  -LZW -rank 2 -dim {-1,$(padim1)} -attr {units,degrees}
+dtheta=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS two_theta -type NX_FLOAT32  -LZW -rank 2 -dim {-1,$(padim1)} -attr {units,degrees}
 dvaxis=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS y_pixel_offset -type NX_FLOAT32 -LZW -rank 1 -dim {$(padim0)} -attr {units,mm}
 dhaxis=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS x_pixel_offset -type NX_FLOAT32 -LZW -rank 1 -dim {$(padim1)} -attr {units,mm} 
 drowindex=/$(entryName),NXentry/$(inst),NXinstrument/$(detector),NXdetector/SDS $(row_index_name) -type NX_INT32 -LZW -rank 1 -dim {$(padim0)}
@@ -90,6 +90,7 @@ scandata=/$(entryName),NXentry/data,NXdata/NXVGROUP
 scanhoraxis=/$(entryName),NXentry/data,NXdata/NXVGROUP
 scanvertaxis=/$(entryName),NXentry/data,NXdata/NXVGROUP
 scanvar=/$(entryName),NXentry/data,NXdata/NXVGROUP
+scantwotheta=/$(entryName),NXentry/scan_step,NXdata/SDS two_theta  -type NX_FLOAT32 -attr {units,degree} -attr {long_name,two_theta}
 scanstep=/$(entryName),NXentry/scan_step,NXdata/SDS value  -type NX_FLOAT32 -attr {units,degree} -attr {long_name,stepsize}
 #histogram=/$(entryName),NXentry/histogram,NXdata/NXVGROUP
 #scanvar=/$(entryName),NXentry/$(scan_variable),NXdata/NXVGROUP

site_ansto/instrument/sans/config/plc/plc.tcl

@@ -1,5 +1,5 @@
-#MakeAsyncQueue plc_chan SafetyPLC 137.157.204.65 30002
+MakeAsyncQueue plc_chan SafetyPLC 137.157.204.65 30002
-#MakeSafetyPLC plc plc_chan 0
+MakeSafetyPLC plc plc_chan 0
 
 source $cfPath(plc)/plc_common_1.tcl
 

site_ansto/instrument/sans/config/scan/scan.tcl

@@ -1,8 +1 @@
-namespace eval scancommand {
+source $cfPath(scan)/scan_common_1.tcl
-  proc init {} {
-  }
-  proc commands_hpath_setup {parent} {
-  }
-  proc graphics_hpath_setup {parent} {
-  }
-}

site_ansto/instrument/sans/config/velsel/velsel.tcl

@@ -1,16 +1,5 @@
-#START SERVER CONFIGURATION SECTION
+puts "velsel.tcl NOT YET AVAILABLE"
-set sicsroot /usr/local/sics
+if 0 {
-source dmc2280_util.tcl
-source server_config.tcl
-#END SERVER CONFIGURATION SECTION
-
-########################################
-# INSTRUMENT SPECIFIC CONFIGURATION
-VarMake Instrument Text Internal 
-Instrument Quokka 
-Instrument lock
-
-# Chopper NCS013 communications
 set velsel_controller(host) 137.157.202.70
 set velsel_controller(port) 10000
 set velsel_controller(user) NVS
@@ -28,3 +17,4 @@ MakeTCPSelector  velsel [params \
 velsel add 3600 4900
 velsel add 7800 10500
 velsel add 30000 30000
+}

site_ansto/instrument/sans/quokka_configuration.tcl

@@ -1,11 +1,12 @@
-# $Revision: 1.1 $
+# $Revision: 1.2 $
-# $Date: 2007-07-09 05:24:46 $
+# $Date: 2007-07-22 05:23:40 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
-# Last revision by: $Author: dcl $
+# Last revision by: $Author: ffr $
 
 # Required by server_config.tcl 
-VarMake Instrument Text Internal 
+VarMake Instrument Text Internal
-Instrument Quokka 
+sicslist setatt Instrument privilege internal
+Instrument quokka 
 Instrument lock
 
 #START SERVER CONFIGURATION SECTION
@@ -19,7 +20,6 @@ source server_config.tcl
 
 fileeval $cfPath(velsel)/velsel.tcl
 fileeval $cfPath(motors)/motor_configuration.tcl
-#fileeval gen_hipadaba.tcl
 
 fileeval $cfPath(plc)/plc.tcl
 fileeval $cfPath(counter)/counter.tcl
@@ -29,6 +29,29 @@ fileeval $cfPath(scan)/scan.tcl
 source $cfPath(hipadaba)/hipadaba_configuration.tcl
 source gumxml.tcl
 
-MakeStateMon
+#::histogram_memory::setmode pulser
+#::histogram_memory::setmode calibration
+::histogram_memory::setmode normal
+#::histogram_memory::hmm_initialize
+::histogram_memory::hmm_setup transparent 0 3 oat_nyc_eff  oat_nxc_eff oat_ntc_eff
+hmm_start 0
 
+MakeStateMon hmscan 
+
+proc instrument_set_sobj_attributes {} {
+
+    motor_set_sobj_attributes 
+    ::utility::set_motor_attributes
+    ::utility::set_histomem_attributes
+    ::utility::set_sobj_attributes
+    ::counter::set_sobj_attributes 
+    ::nexus::set_sobj_attributes 
+    ::histogram_memory::set_sobj_attributes 
+## TODO move the following to the new ansto gumxml.tcl
+    sicslist setatt getgumtreexml privilege internal
+}
+
+instrument_set_sobj_attributes 
+buildHDB instrument_dictionary
+#buildHDB [instname]_dictionary
 fileeval extraconfig.tcl

site_ansto/instrument/server_config.tcl

@@ -1,9 +1,9 @@
 # SICS common configuration
 
-# $Revision: 1.26 $
+# $Revision: 1.27 $
-# $Date: 2007-07-09 05:25:57 $
+# $Date: 2007-07-22 05:23:40 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
-# Last revision by $Author: dcl $
+# Last revision by $Author: ffr $
 
 #set sicsroot /usr/local/sics
 set sicsroot ../
@@ -11,9 +11,9 @@ set cfParent config
 array set cfPath [list\
 motors    $cfParent/motors\
 counter   $cfParent/counter\
+chopper   $cfParent/chopper\
 hmm       $cfParent/hmm\
 scan      $cfParent/scan\
-chopper   $cfParent/chopper\
 velsel    $cfParent/velsel\
 nexus     $cfParent/nexus\
 hipadaba  $cfParent/hipadaba\
@@ -43,54 +43,53 @@ SicsUser spy 007 3
 MakeDataNumber SicsDataNumber $sicsroot/data/DataNumber 
 
 #Instrument specific configs must set the Instrument variable
-VarMake SicsDataPrefix Text Internal 
+::utility::mkVar SicsDataPrefix Text internal
 SicsDataPrefix [SplitReply [Instrument]] 
 SicsDataPrefix lock
 
-VarMake sics_release Text Internal
+::utility::mkVar SicsDataSuffix Text manager
+SicsDataSuffix nx.hdf
+
+
+::utility::mkVar sics_release Text internal
 set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}]
 sics_release [lindex $tmpstr [expr [llength $tmpstr] - 1]]
 sics_release lock
 
-VarMake sics_revision_num Text Internal
+::utility::mkVar sics_revision_num Text internal
-set tmpstr [string map {"$" ""} {$Revision: 1.26 $}]
+set tmpstr [string map {"$" ""} {$Revision: 1.27 $}]
 sics_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
 sics_revision_num lock
 
-VarMake SicsDataPath Text Internal 
+::utility::mkVar SicsDataPath Text internal
 SicsDataPath $sicsroot/data/ 
 SicsDataPath lock
-VarMake SicsDataPostFix Text User 
+::utility::mkVar Title Text user title true experiment true true
-#SicsDataPostFix .hdf 
+::utility::mkVar Sample Text user description true sample true true
-#SicsDataPostFix lock
+::utility::mkVar User Text user user true user true true
-VarMake Title Text User 
+::utility::mkVar Email Text user email true user true true
-VarMake Sample Text User 
+::utility::mkVar Phone Text user phone true user true true
-VarMake User Text User 
+::utility::mkVar starttime Text user start true experiment true true
-VarMake Email Text User
-VarMake Phone Text User
-VarMake starttime Text User 
-VarMake currentfile Text User 
-VarMake batchroot Text User 
 MakeDrive
 
 exe batchpath ../batch
 exe syspath ../batch
 
-VarMake detector_type Text Internal
+::utility::mkVar detector_type Text internal
-VarMake detector_description Text Internal
+::utility::mkVar detector_description Text internal
 
-VarMake dataFileName Text User
+::utility::mkVar dataFileName Text user datafile true experiment true true
 
-VarMake hmm_simulation Text Internal
+::utility::mkVar hmm_simulation Text internal
 hmm_simulation false
 
-VarMake counter_simulation Text Internal
+::utility::mkVar counter_simulation Text internal
 counter_simulation false
 
-VarMake motor_simulation Text Internal
+::utility::mkVar motor_simulation Text internal
 motor_simulation false
 
-VarMake sics_simulation Text Internal
+::utility::mkVar sics_simulation Text internal
 sics_simulation false
 
 if {[SplitReply [sics_simulation]] == "true"} {
@@ -98,3 +97,27 @@ if {[SplitReply [sics_simulation]] == "true"} {
   counter_simulation true
   motor_simulation true
 }
+
+proc server_set_sobj_attributes {} {
+# set_sicsobj_atts sobj klass group name control data
+#set_sicsobj_atts Title experiment @none title true true;
+#set_sicsobj_atts Sample experiment user sample true true; 
+#set_sicsobj_atts User experiment user name true true;
+#set_sicsobj_atts Email experiment user email true true; 
+#set_sicsobj_atts Phone  experiment user phone true true;
+#set_sicsobj_atts starttime experiment user start true true;
+#set_sicsobj_atts dataFileName experiment @none datafile true true;
+
+#sicslist setatt SicsDataPrefix  privilege internal
+#sicslist setatt sics_release  privilege internal
+#sicslist setatt sics_revision_num  privilege internal
+#sicslist setatt SicsDataPath  privilege internal
+#sicslist setatt detector_type  privilege internal
+#sicslist setatt detector_description  privilege internal
+#sicslist setatt hmm_simulation  privilege internal
+#sicslist setatt counter_simulation  privilege internal
+#sicslist setatt motor_simulation  privilege internal
+#sicslist setatt sics_simulation  privilege internal
+}
+
+server_set_sobj_attributes

site_ansto/instrument/util/command.tcl

@@ -0,0 +1,139 @@
+set cmd_prop_list {kind command data false control true klass command nxsave false}
+set cmd_par_prop_list {kind hobj data false control true nxsave false klass command}
+
+#Useful for selecting arguments passed to a mapped function
+
+# type = one of hipadaba types
+# range restricts type values, maps to the argtype hlist property
+# command {type:range p1 type:range p2} { ... }
+proc command {acmdName arglist body} {
+  global cmd_prop_list cmd_par_prop_list
+  set NS [uplevel namespace current]
+  set cmdName ${NS}::$acmdName
+  variable ${cmdName}_param_list
+  variable ${cmdName}_feedback_list
+  if {[info exists ${cmdName}_param_list]} {
+    unset ${cmdName}_param_list
+  }
+  if {[info exists ${cmdName}_feedback_list]} {
+    unset ${cmdName}_feedback_list
+  }
+ # puts "cmdName: $cmdName"
+    foreach {type_spec var} $arglist {
+      lappend params $var
+      foreach {type domain} [split $type_spec :] {}
+        lappend ${cmdName}_param_list $var ${cmdName}_par_$var
+        set sicsvar [lindex [set ${cmdName}_param_list] end]
+        # Make var with priv=user so we can use sicslist on it
+        VarMake $sicsvar $type user
+        # Set privilege internal to stop hdb builder adding it to hdb tree
+        sicslist setatt $sicsvar privilege internal
+        #FIXME Can argtype be replace with 'domain' then we setatt domain $domain
+        if {$domain == ""} {
+          sicslist setatt $sicsvar argtype $type
+        } else {
+          if {$type == "text"} {
+            if {[string first , $domain] == -1} {
+              sicslist setatt $sicsvar argtype $domain
+            } else {
+              sicslist setatt $sicsvar argtype $type
+              sicslist setatt $sicsvar values $domain
+            }
+          } else {
+            sicslist setatt $sicsvar argtype $type
+            foreach {min max} [split $domain ,] {}
+            sicslist setatt $sicsvar min $min
+            sicslist setatt $sicsvar max $max
+          }
+        }
+        sicslist setatt $sicsvar long_name $var
+        foreach {att val} $cmd_par_prop_list {
+          sicslist setatt $sicsvar $att $val
+        }
+    }
+    set options {
+      set __cmdinfo [info level 0]
+      set __cmd [lindex $__cmdinfo 0]
+      variable ${__cmd}_param_list
+      switch -- [lindex $args 0] {
+        -map {
+          switch [lindex $args 1] {
+            "param" {
+              foreach {__var __param} [set ${__cmd}_param_list] {
+                  eval [lindex $args 2] [lrange $args 3 end] $__param $__var
+              }
+              return
+            }
+            "feedback" {
+              if {[info exists ${__cmd}_feedback_list] != 1} {
+                return
+              } 
+              foreach {__var __fbvar} [set ${__cmd}_feedback_list] {
+                  eval [lindex $args 2] [lrange $args 3 end] $__fbvar $__var
+              }
+              return
+            }
+          }
+        }
+        -list {
+          switch [lindex $args 1] {
+            "param" {
+              return [set ${__cmd}_param_list]
+            }
+            "feedback" {
+              return [set ${__cmd}_feedback_list]
+            }
+          }
+        }
+        -set {
+          if {[lindex $args 1] == "feedback"} {
+            set __vname [lindex $args 2]
+            set __ptype fb
+            if {[llength $args] > 3} {
+              set __val [lindex $args 3]
+            }
+          } else {
+            set __vname [lindex $args 1]
+            set __ptype par
+            if {[llength $args] > 2} {
+              set __val [lindex $args 2]
+            }
+          }
+          if {[llength [sicslist ${__cmd}_${__ptype}_${__vname}]] == 0} {
+            error_msg "${__cmd}_${__ptype}_${__vname} doesnt exist"
+            return
+          } 
+          if {[info exists __val]} {
+            ${__cmd}_${__ptype}_${__vname} $__val
+            return
+          } else {
+            return [SplitReply [${__cmd}_${__ptype}_${__vname}]]
+          } 
+        }
+        -addfb {
+          foreach {__type __var} [lrange $args 1 end] {
+            set __sicsvar ${__cmd}_fb_${__var}
+            VarMake $__sicsvar $__type user
+            sicslist setatt $__sicsvar privilege internal
+            sicslist setatt $__sicsvar control true
+            sicslist setatt $__sicsvar data false
+            sicslist setatt $__sicsvar nxsave false
+            sicslist setatt $__sicsvar klass @none
+            lappend ${__cmd}_feedback_list $__var $__sicsvar
+          }
+          return
+        }
+      }
+    }
+    # The foreach loop initialises the parameters for the command body
+    # The 'if' statement makes sure that the SICS 'parameter' variables are only
+    # updated if they change.
+    proc $cmdName {args} [subst -nocommands {$options foreach n {$params} v \$args {set \$n \$v; if {\$v != [SplitReply [${cmdName}_par_\$n]]} {debug_msg "set ${cmdName}_par_\$n \$v"; ${cmdName}_par_\$n \$v}}; $body }]
+    publish $cmdName user
+    sicslist setatt $cmdName long_name $acmdName
+    sicslist setatt $cmdName privilege user
+    sicslist setatt $cmdName group [string map {:: ""} $NS]
+    foreach {att val} $cmd_prop_list {
+      sicslist setatt $cmdName $att $val
+    }
+}

site_ansto/instrument/util/extra_utility.tcl

@@ -0,0 +1,107 @@
+# Many of these functions are also useful in test and debug code
+# running on an external Tcl interpreter.
+ 
+# LIST FUNCTIONS
+proc head {args} {lindex [join $args] 0}
+proc tail {args} {join [lrange [join $args] 1 end]}
+
+# SET FUNCTIONS
+
+# Set membership
+proc setmem {el A} {
+  expr {[lsearch $A $el] >= 0}
+}
+
+# Set difference: A\B, members of A that are not in B
+proc setdiff {A B} {
+  foreach el $A {
+    if {[lsearch -exact $B $el] == -1} {
+      lappend missing $el;
+    }
+  }
+  if {[info exists missing]} {
+    return $missing;
+  }
+}
+
+proc _intersection {lista listb} {
+  set result {}
+  foreach elem [join $listb] {
+    if { [lsearch -exact $lista $elem] != -1 } {
+      lappend result $elem
+    }
+  }
+  return $result
+}
+
+proc intersection {lista args} {
+  if {[llength $args] == 0} {return $lista}
+  if {[llength $args] == 1} {return [_intersection $lista $args]}
+  return [intersection [_intersection $lista [head $args]] [tail $args]];
+}
+
+
+# TYPE CHECKING
+# This is an enhanced set membership function.
+# It can check that an element is a member of a list or
+# of a named type
+proc isoneof {element setb} {
+  global simpleType;
+  set result 0;
+
+  foreach elb $setb {
+    switch $elb {
+      alpha {set result [string is alpha $element]}
+      text {set result [string is wordchar $element]}
+      print {set result [string is print $element]} 
+      float {set result [string is double $element]}
+      int {set result [string is integer $element]}
+      default {set result [expr {$element == $elb}]}
+    }
+    if {$result == 1} {return 1}
+  }
+  return 0;
+}
+
+# Returns 'sicslist' output in lower case, this may be useful in macros.
+# This function is used a lot in the hdbbuilder
+proc tolower_sicslist {args} {
+  set result [eval sicslist $args]
+  return [string tolower $result];
+}
+
+# You can use debug_msg in place of 'puts' for debug info in Tcl macros.  
+# debug on, turns on debugging
+# debug off, turns off debugging
+proc debug_mode {mode} {
+  switch $mode {
+    on {
+      proc debug_msg {args} {
+          set cmdinfo [info level -1]
+          set cmd [lindex $cmdinfo 0]
+          set arglist [lrange $cmdinfo 1 end]
+          clientput "DEBUG:$args> [namespace origin $cmd] $arglist"
+      }
+    }
+    off {
+      proc debug_msg {args} {};
+    }
+  }
+}
+proc debug_msg {args} {};
+publish debug_mode mugger
+sicslist setatt debug_mode privilege internal
+
+proc todo_msg {args} {
+  set cmdinfo [info level -1]
+  set cmd [lindex $cmdinfo 0]
+  set arglist [lrange $cmdinfo 1 end]
+  clientput "TODO:$args> [namespace origin $cmd] $arglist"
+}
+
+proc error_msg {args} {
+  set cmdinfo [info level -1]
+  set cmd [lindex $cmdinfo 0]
+  set arglist [lrange $cmdinfo 1 end]
+  clientput "ERROR: [namespace origin $cmd] $arglist: $args" error
+}

site_ansto/instrument/util/utility.tcl

@@ -1,10 +1,18 @@
 # Some useful functions for SICS configuration.
 
-# $Revision: 1.3 $
+# $Revision: 1.4 $
-# $Date: 2007-04-20 01:53:31 $
+# $Date: 2007-07-22 05:23:41 $
 # 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} {
@@ -47,8 +55,6 @@ proc setpos {motor pos} {
     set newZero [expr $currPos - $pos + $oldZero]
     uplevel #0 "$motor softzero $newZero"
 }
-publish setpos user
-publish SplitReply user
 
 proc getinfo {object} {
   set wc [format "%s_*" $object];
@@ -59,4 +65,152 @@ proc getinfo {object} {
     }
   }
 }
-publish getinfo spy
+
+
+# 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 {
+  namespace export instname;
+  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 x} {aklass x} {acontrol x} {adata x}} {
+    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];
+  }
+}
+
+namespace import ::utility::*;
+Publish getinfo spy
+Publish setpos user
+Publish SplitReply user
+Publish instname user
+
+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
+  }
+}
+
+# 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] =] ]]
+}