# $Revision: 1.23 $
# $Date: 2007-11-05 02:17:36 $
# Author: Ferdi Franceschini
# Based on the examples in the hs_test.tcl sample configuration by Mark Lesha.
# http://gumtree.ansto.gov.au:9080/nbicms/bragg-systems/histogram-server/hs_test.tcl/view
# Last revision by: $Author: ffr $

##
# @file Provides generic code and parameters for configuring the ANSTO histogram memory server
# The instrument specific histogram memory configuration files must define an initialisation 
# function with the following signature 
# @code proc ::histogram_memory::initialize {}
# this function should call the generic initalisation function, 
# ::histogram_memory::_initialize
#
#@see ::histogram_memory::_initialize
set sim_mode [SplitReply [hmm_simulation]]
if {$sim_mode == "true"} {
  MakeHM hmm SIM
  MakeHM hmm_xy SIM
  MakeHM hmm_xt SIM
  MakeHM hmm_yt SIM
  MakeHM hmm_x SIM
  MakeHM hmm_y SIM
  MakeHM hmm_t SIM
  hmm configure daq Stopped
  hmm configure statuscheck false
  namespace eval histogram_memory {
    proc hmc {_start _preset _mode _pause pauseval} {
      bm mode $_mode;
      bm preset $_preset;
      hmm countblock;
    }
  }
} else {
  MakeHM hmm anstohttp;
  MakeHM hmm_xy anstohttp;
  MakeHM hmm_xt anstohttp;
  MakeHM hmm_yt anstohttp;
  MakeHM hmm_x anstohttp;
  MakeHM hmm_y anstohttp;
  MakeHM hmm_t anstohttp;

  MakeHMControl_ANSTO hmc bm hmm;
}

hmm configure rank 3
hmm_xy configure rank 2
hmm_xt configure rank 2
hmm_yt configure rank 2
hmm_x configure rank 1
hmm_y configure rank 1
hmm_t configure rank 1


namespace eval histogram_memory {
  ::utility::mkVar detector_active_height_mm Float user active_height true detector true true
  sicslist setatt detector_active_height_mm units mm
  ::utility::mkVar detector_active_width_mm  Float user active_width  true detector true true
  sicslist setatt detector_active_width_mm units mm

  ::utility::mkVar hmm_user_configpath Text manager user_configpath false detector true false 
    hmm_user_configpath ../user_config/hmm
    ::utility::mkVar hmm_mode Text user mode true detector true true
    ::utility::mkVar _hmm_vert_axis Text user vert_axis true detector false true
    ::utility::mkVar _hmm_hor_axis Text user hor_axis true detector false true
    ::utility::mkVar _hmm_hor_axis_alias Text user hor_axis_alias true detector false true
    ::utility::mkVar _hmm_vert_axis_alias Text user vert_axis_alias true detector false true
    ::utility::mkVar _hmm_hor_channel_name Text user hor_channel_name true detector false true
    _hmm_vert_axis y_pixel_offset
    _hmm_vert_axis_alias dvaxis
    _hmm_hor_axis polar_angle
    _hmm_hor_axis_alias dtheta
    _hmm_hor_channel_name horizontal_channel_number
##############################################
# Creating the histogram memories in SICS
##############################################

# Make a histogram memory object hmm, allows control of the
# remote histogram server via http, and acquisition
# of histogram period data.


##############################################
# Configuring the histogram server
##############################################

# Procedure to read a single config (or any) file, return content as a string.
    proc returnconfigfile {filename} {
      set fh [open $filename]
        set xml [read $fh]
        debug_msg $xml value
        close $fh
        return [subst $xml]
    }

# Initialize the histogram server.
# This call to hmm init (with init 1 configured) causes the histogram server
# to be loaded with the specified configuration files.  Subsequent inits (with init 0 configured)
# only cause specific histogram server FAT settings to be updated.
# If the histogram server's default configfiles are adequate, the init 1 stage can be skipped.
# Before configuring, make sure the server is stopped, since configuration
# 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 setup {} {
    set configuration "::histogram_memory::returnconfigfile config/hmm/anstohm_linked.xml"
    debug_msg $configuration

    hmm configure statuscheck true
    hmm configure histmode transparent
    hmm stop
    hmm configure statuscheck false
    hmm configure hmDataPath ../HMData
    hmm configure hmconfigscript $configuration

    hmm configure init 0
    hmm init
    hmm configure statuscheck true
    hmm stop
    hmm configure statuscheck false
# Load the configuration to the histogram server.
    hmm configure init 1
    hmm init
# Restore the init level to 0, subesquent inits will only upload specified FAT settings to histogram server.
    hmm configure init 0

##############################################
# Configuring the histogram memories in SICS
##############################################

# 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 configure statuscheck true
    hmm stop
    hmm configure statuscheck false
  }
# 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} {
    set resp [$histomem configure $dictitem]
      set retn [lindex [split $resp " "] 2]
      return $retn
  }

##
# @brief Use histogram server to control acquisitions
  proc set_termination_conditions {count_method count_size count_stop} {
    hmm configure FAT_COUNT_METHOD $count_method
    hmm configure FAT_COUNT_SIZE $count_size
    hmm configure FAT_COUNT_STOP $count_stop
    hmm init
  }

# Simulated counter. No error rate.  Required for technical reasons...
# The simulated 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
    blockctr SetExponent 0
    blockctr SetMode timer
    blockctr SetPreset 0


##############################################
# Support for using expanded histogram period
# to create interlaced/overlapped histograms
##############################################

# Define an OAT offset variable to use with both scans:
# It is possible to effectively offset the histogram filler's
# OAT table by an arbitrary amount.  For overlapped data acquisitions, we can
# configure an oversized histogram period using the EXPAND_OAT parameters
# in the FAT.  Then at each scan stop, before acqisition commences the offset
# can be adjusted using the OFFSET_OAT paramters of the FAT.  By progressively
# stepping the OFFSET_OAT, an overlapped image can be built up.
# The global variable oatoffset is defined for this purpose.
# During the scan, this variable is incremented and can be passed
# in to an argument of set_oat_offset to provide progressively
# increasing offset, producing an overlapped histogram.
#
    global oatoffset
#
#Function to apply OAT offsets to the histogram server.
    proc set_oat_offset {oatoff_x oatoff_y oatoff_t} {
      hmm configure FAT_OFFSET_OAT_X $oatoff_x
        hmm configure FAT_OFFSET_OAT_Y $oatoff_y
        hmm configure FAT_OFFSET_OAT_T $oatoff_t
        hmm init
        return
    }

##############################################
# Support for data acquisition
##############################################

# A simple procedure to read the histogram data through SICS
# and dump the data to a numbered file.
  proc savehistodata {histomem filename} {
    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]]
#	clientput $histodata value
      puts -nonewline $fh $histodata
      close $fh
      return
  }

##############################################
##############################################
##         Scan Callback Procedures         ##
##############################################
##############################################


  proc init {} {
  }
  proc graphics_hpath_setup {parent} {
  }
  proc commands_hpath_setup {parent} {
  }
  proc instrument_hpath_setup {parent} {
  }
  proc experiment_hpath_setup {parent} {
  }

  proc set_sobj_attributes {} {
    # SICS commands
    sicslist setatt blockctr privilege internal;

    # histogram memory macros
    sicslist setatt ::histogram_memory::set_oat_offset  privilege internal;
    sicslist setatt ::histogram_memory::scan2_runb  privilege internal;
    sicslist setatt ::histogram_memory::scan2_runa  privilege internal;
    sicslist setatt ::histogram_memory::returnconfigfile  privilege internal;
    sicslist setatt ::histogram_memory::save  privilege internal;

    foreach hm_obj [sicslist type histmem] {
      set_sicsobj_atts $hm_obj detector @none $hm_obj true true;
      sicslist setatt $hm_obj privilege user
      sicslist setatt $hm_obj kind hobj
      sicslist setatt $hm_obj nxsave false
    }
  } 

 
  proc clock_scale {args} {
    switch $args {
      "" { return 1 }
      "units" { return "microseconds"}
      default {
        todo_msg "Set clock_scale as an integer number of nanoseconds"
      }
    }
  }
  ## \brief Calculate axis array from a given list of bin boundaries
  #
  # \param proc_name Fully qualified name of the calling procedure
  # \param scale_factor axis scale factor or @none
  # \param offset axis offset or @none
  # \param boundaries list of bin boundaries or @none
  proc calc_axis {proc_name scale_factor offset boundaries args} {
    variable state

    set parlist [join $args]
    set opt [lindex $parlist 0]
    set arglist [lrange $parlist 1 end]
    if {$scale_factor == "@none" || $boundaries == "@none"} {
    # Don't calculate axis values, we're just setting or getting the graph_type
    } else {
      set i 0
      ${proc_name}_array clear
      if {$state($proc_name,graph_type) == "boundaries"} {
        foreach bb $boundaries {
          set val [expr {$scale_factor*$bb + $offset}]
          lappend values $val
          ${proc_name}_array putfloat $i $val
          incr i
        }
      } else {
        foreach b0 [lrange $boundaries 0 end-1] b1 [lrange $boundaries 1 end] {
          set val [expr {$scale_factor*($b1 + $b0)/2.0 + $offset}]
          lappend values $val
          ${proc_name}_array putfloat $i $val
          incr i
        }
      }
    }
    switch -- $opt {
      "-arrayname" {
        return "${proc_name}_array"
      }
      "-centres" {
        set state($proc_name,graph_type) "centres"
      }
      "-boundaries" {
        set state($proc_name,graph_type) "boundaries"
      }
      "-graph_type" {
        return $state($proc_name,graph_type)
      }
      default {
        return $values
      }
    }
  }

  ##
  # @brief Provides y_bin boundary array for data axes
  sicsdatafactory new ::histogram_memory::y_bin_array
  proc y_bin {args} {
    set opt [lindex $args 0]
    set arglist [lrange $args 1 end]
    set proc_name [namespace origin [lindex [info level 0] 0]]
    switch -- $opt {
      "-centres" - "-boundaries" - "-graph_type" {
        return [calc_axis $proc_name @none @none @none $opt $arglist]
      }
      "-arrayname" {
        return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get Y_BOUNDARIES] $opt $arglist]
      }
      default {
        return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get Y_BOUNDARIES] $args]
      }
    }
  }
  set script_name ::histogram_memory::y_bin
  publish $script_name user
  sicslist setatt $script_name privilege user
  sicslist setatt $script_name kind script
  sicslist setatt $script_name access read_only
  sicslist setatt $script_name dtype floatvarar
  sicslist setatt $script_name dlen 100
  sicslist setatt $script_name klass detector
  sicslist setatt $script_name control false
  sicslist setatt $script_name data true
  sicslist setatt $script_name nxsave true
  sicslist setatt $script_name mutable false
  sicslist setatt $script_name long_name y_bin
  unset script_name

  ##
  # @brief Provides x_bin boundary array for data axes
  sicsdatafactory new ::histogram_memory::x_bin_array
  proc x_bin {args} {
    set opt [lindex $args 0]
    set arglist [lrange $args 1 end]
    set proc_name [namespace origin [lindex [info level 0] 0]]
    switch -- $opt {
      "-centres" - "-boundaries" - "-graph_type" {
        return [calc_axis $proc_name @none @none @none $opt $arglist]
      }
      "-arrayname" {
        return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get X_BOUNDARIES] $opt $arglist]
      }
      default {
        return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get X_BOUNDARIES] $args]
      }
    }
  }
  set script_name ::histogram_memory::x_bin
  publish $script_name user
  sicslist setatt $script_name privilege user
  sicslist setatt $script_name kind script
  sicslist setatt $script_name access read_only
  sicslist setatt $script_name dtype floatvarar
  sicslist setatt $script_name dlen 100
  sicslist setatt $script_name klass detector
  sicslist setatt $script_name control false
  sicslist setatt $script_name data true
  sicslist setatt $script_name nxsave true
  sicslist setatt $script_name mutable false
  sicslist setatt $script_name long_name x_bin
  unset script_name

 # requires detector_active_width_mm det_radius_mm
  sicsdatafactory new ::histogram_memory::y_pixel_offset_array
  proc y_pixel_offset {args} {
    variable state
    set opt [lindex $args 0]
    set arglist [lrange $args 1 end]
    set proc_name [namespace origin [lindex [info level 0] 0]]
    switch -- $opt {
      "-centres" - "-boundaries" - "-graph_type" {
        return [calc_axis $proc_name @none @none @none $opt $arglist]
      }
      "-arrayname" {
        set det_height_mm [SplitReply [detector_active_height_mm]]
        set max_b [OAT_TABLE -get Y_MAX]
        set min_b [OAT_TABLE -get Y_MIN]
        set scale_factor [expr {$det_height_mm / ($max_b - $min_b)}]
        set offset 0.0
        return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get Y_BOUNDARIES] $opt $arglist]
      }
      "-units" {
        return "mm"
      }
      default {
        set det_height_mm [SplitReply [detector_active_height_mm]]
        set max_b [OAT_TABLE -get Y_MAX]
        set min_b [OAT_TABLE -get Y_MIN]
        set scale_factor [expr {$det_height_mm / ($max_b - $min_b)}]
        set offset 0.0
        return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get Y_BOUNDARIES] $args]
      }
    }
  }
  set script_name ::histogram_memory::y_pixel_offset
  publish $script_name user
  sicslist setatt $script_name privilege user
  sicslist setatt $script_name kind script
  sicslist setatt $script_name access read_only
  sicslist setatt $script_name dtype floatvarar
  sicslist setatt $script_name dlen 100
  sicslist setatt $script_name klass detector
  sicslist setatt $script_name control false
  sicslist setatt $script_name data true
  sicslist setatt $script_name nxsave true
  sicslist setatt $script_name mutable false
  sicslist setatt $script_name long_name y_pixel_offset
  sicslist setatt $script_name units [::histogram_memory::y_pixel_offset -units]
  unset script_name

 # requires detector_active_width_mm det_radius_mm
  sicsdatafactory new ::histogram_memory::x_pixel_offset_array
  proc x_pixel_offset {args} {
    variable state
    set opt [lindex $args 0]
    set arglist [lrange $args 1 end]
    set proc_name [namespace origin [lindex [info level 0] 0]]
    switch -- $opt {
      "-centres" - "-boundaries" - "-graph_type" {
        return [calc_axis $proc_name @none @none @none $opt $args]
      }
      "-arrayname" {
        set det_width_mm [SplitReply [detector_active_width_mm]]
        set max_b [OAT_TABLE -get X_MAX]
        set min_b [OAT_TABLE -get X_MIN]
        set scale_factor [expr {$det_width_mm / ($max_b - $min_b)}]
        set offset 0.0
        return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_BOUNDARIES] $opt $arglist]
      }
      "-units" {
        return "mm"
      }
      default {
        set det_width_mm [SplitReply [detector_active_width_mm]]
        set max_b [OAT_TABLE -get X_MAX]
        set min_b [OAT_TABLE -get X_MIN]
        set scale_factor [expr {$det_width_mm / ($max_b - $min_b)}]
        set offset 0.0
        return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_BOUNDARIES] $args]
      }
    }
  }
  set script_name ::histogram_memory::x_pixel_offset
  publish $script_name user
  sicslist setatt $script_name privilege user
  sicslist setatt $script_name kind script
  sicslist setatt $script_name access read_only
  sicslist setatt $script_name dtype floatvarar
  sicslist setatt $script_name dlen 100
  sicslist setatt $script_name klass detector
  sicslist setatt $script_name control false
  sicslist setatt $script_name data true
  sicslist setatt $script_name nxsave true
  sicslist setatt $script_name mutable false
  sicslist setatt $script_name long_name x_pixel_offset
  sicslist setatt $script_name units [::histogram_memory::x_pixel_offset -units]
  unset script_name
  
  sicsdatafactory new ::histogram_memory::time_channel_array
  proc time_channel {args} {
    variable state
    set opt [lindex $args 0]
    set arglist [lrange $args 1 end]
    set proc_name [namespace origin [lindex [info level 0] 0]]
    switch -- $opt {
      "-centres" - "-boundaries" - "-graph_type" {
        return [calc_axis $proc_name @none @none @none $opt $args]
      }
      "-arrayname" {
        return [calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE -get T_BOUNDARIES] $opt $arglist]
      }
      default {
        return [calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE -get T_BOUNDARIES] $args]
      }
    }
  }
  set script_name ::histogram_memory::time_channel
  publish $script_name user
  sicslist setatt $script_name privilege user
  sicslist setatt $script_name kind script
  sicslist setatt $script_name access read_only
  sicslist setatt $script_name dtype floatvarar
  sicslist setatt $script_name dlen 100
  sicslist setatt $script_name klass detector
  sicslist setatt $script_name control false
  sicslist setatt $script_name data true
  sicslist setatt $script_name nxsave true
  sicslist setatt $script_name mutable false
  sicslist setatt $script_name long_name time_of_flight
  sicslist setatt $script_name units [::histogram_memory::clock_scale units]
  unset script_name
}

##
# @brief Provides a standard set of subcommands for the histogram server table
# configuration commands.
#
# @param tag Table identifier, one of BAT CAT FAT NAT OAT SAT SRV 
# @param attributes Defines the list of attributes which you will be allowed to set.
# @param element_list Defines the list of elements which you will be allowed to set.
# Use "" if your table doesn't contain any elements.
# @param args This can be empty, or a list of name value pairs for the attributes
# and elements which you want to set or one of the subcommands listed below.
# If args is empty this function will simply return an xml fragment for the named table,
#
# Subcommands\n
# -clear clears the table\n
# -init A list of name value pairs. If you use attribute or element names then
# the corresponding table entries will be initilised to the given values, any
# attributes or elements which aren't specified will be cleared.  You can also 
# specify extra parameters to store in the table which might be required to 
# specify limits or constants which may be necessary for deriving configuration
# parameters.\n
# -get return the value for the named attribute or element\n
# -attlist list all of the attributes with their values.\n
# TODO Maintain "proposed" and "current" tables. Provide a setcurrent command which can
# only be called by the upload_config command to set the proposed tables as current
# TODO Allow for top level content in tables and attributes in sub-elements 
proc XXX_TABLE {tag attributes element_list args} {
  global hmm_xml
  if {[llength $args] == 1} {
    set arguments [lindex $args 0]
  } else {
    set arguments $args
  }
  set opt [lindex $arguments 0]
  set arglist [lrange $arguments 1 end]
  switch -- $opt {
    "" {
      foreach att $attributes {
        if {$hmm_xml($tag,[string toupper $att]) != ""} {
          append table  "$att=\"$hmm_xml($tag,$att)\"\n"
        }
      }
      set content ""
      foreach name $element_list {
        append content "\n<$name>\n$hmm_xml($tag,$name)\n</$name>"
      }
      if {[info exists table]} {
        return "<$tag\n$table>$content\n</$tag>"
      }
    }
    "-clear" {
      foreach att $attributes {
        set hmm_xml($tag,[string toupper $att]) ""
      }
      foreach element $element_list {
        set hmm_xml($tag,[string toupper $element]) ""
      }
    }
    "-init" {
      foreach att $attributes {
        set hmm_xml($tag,[string toupper $att]) ""
      }
      foreach element $element_list {
        set hmm_xml($tag,[string toupper $element]) ""
      }
      foreach {par val} $arglist {
        set hmm_xml($tag,[string toupper $par]) $val
      }
    }
    "-set" {
      foreach {par val} $arglist {
        set hmm_xml($tag,[string toupper $par]) $val
      }
    }
    "-get" {
      set par [string toupper [lindex $arglist 0]]
      if {[info exists hmm_xml($tag,$par)]} {
        return $hmm_xml($tag,$par)
      } else {
        foreach name [array names hmm_xml $tag,* ] {
          lappend valid_params [lindex [split $name ,] 1]
        }
        error_msg "$par should be one of $valid_params"
      }
    }
    "-attlist" {
    # List attributes
      foreach att $attributes {
        if {$hmm_xml($tag,$att) != ""} {
          lappend table $att $hmm_xml($tag,[string toupper $att])
        }
      }
      if {[info exists table]} {
        clientput $table
      }
    }
    default {
      array set param [string toupper $arguments]
      foreach att [string toupper $attributes] {
        if {[info exists param($att)]} {
          if {[info exists hmm_xml($tag,${att}_MIN)]} {
            if {$param($att) <= $hmm_xml($tag,${att}_MIN)} {
              error_msg "$att must be greater than $hmm_xml($tag,${att}_MIN)"
            }
          }
          if {[info exists hmm_xml($tag,${att}_MAX)]} {
            if {$param($att) >= $hmm_xml($tag,${att}_MAX)} {
              error_msg "$att must be less than $hmm_xml($tag,${att}_MAX)"
            }
          }
          set hmm_xml($tag,$att) $param($att)
        }
      }
      foreach element [string toupper $element_list] {
        if {[info exists param($element)]} {
          set hmm_xml($tag,$element) $param($element)
        }
      }
    }
  }
}

## 
# @brief Base Address Table configuration parameters as maintained by SICS
#
# @see XXX_TABLE for subcommands.
proc BAT_TABLE {args} {
  set attributes {}
  set elements ""
  set tag BAT
  global hmm_xml

  switch -glob -- [lindex $args 0] {
    "" {
      XXX_TABLE $tag $attributes $elements $args
    }
    "-*" {
      XXX_TABLE $tag $attributes $elements $args
    }
    default {
      XXX_TABLE $tag $attributes $elements $args
    }
  }
}
BAT_TABLE -clear

## 
# @brief CAlibration Table configuration parameters as maintained by SICS
#
# @see XXX_TABLE for subcommands.
proc CAT_TABLE {args} {
  set attributes {}
  set elements ""
  set tag CAT
  global hmm_xml

  switch -glob -- [lindex $args 0] {
    "" {
      XXX_TABLE $tag $attributes $elements $args
    }
    "-*" {
      XXX_TABLE $tag $attributes $elements $args
    }
    default {
      XXX_TABLE $tag $attributes $elements $args
    }
  }
}
CAT_TABLE -clear

## 
# @brief Frequency Address Table configuration parameters as maintained by SICS
#
# @see XXX_TABLE for subcommands.
proc FAT_TABLE {args} {
  set attributes {FRAME_FREQUENCY SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE}
  set elements ""
  set tag FAT
  global hmm_xml

  switch -glob -- [lindex $args 0] {
    "" {
      XXX_TABLE $tag $attributes $elements $args
    }
    "-*" {
      XXX_TABLE $tag $attributes $elements $args
    }
    default {
      XXX_TABLE $tag $attributes $elements $args
    }
  }
}
FAT_TABLE -clear

##
# @brief Offset Address Table configuration parameters as maintained by SICS
#
# @param -clear clears OAT_TABLE XML fragment
# @param -init X_MIN <x0> X_MAX <x1> Y_MIN <y0> Y_MAX <y1>
# Initialise minimum and maximum bin boundaries.
# @param -get
# @param -attlist
# @param -clear clears the oat table and the fat table SIZE_PERIOD
#
# Sets X_BOUNDARIES, Y_BOUNDARIES and T_BOUNDARIES
# @see XXX_TABLE for subcommands.
proc OAT_TABLE {args} {
  global hmm_xml
  set attributes {NO_OAT_X_CHANNELS NO_OAT_Y_CHANNELS NO_OAT_T_CHANNELS}
  set tag OAT
  set coord_list {X Y T}
  set elements $coord_list

  switch -glob -- [lindex $args 0] {
    "" {
      XXX_TABLE $tag $attributes $elements $args
    }
    "-*" {
      XXX_TABLE $tag $attributes $elements $args
    }
    "-clear" {
      XXX_TABLE $tag $attributes $elements $args
      FAT_TABLE SIZE_PERIOD ""
    }
    default {
      array set param $args
      foreach coord $coord_list {
        if {[info exists param($coord)] == 0} {
          error_msg "You must specify $coord_list" 
        }
      }
      set NOXCH [SplitReply [hmm configure dim0]]
      set NOYCH [SplitReply [hmm configure dim1]]
      set NOTCH [SplitReply [hmm configure dim2]]
      foreach coord $coord_list {
        if {[info exists param($coord)]} {
          set bbnum [llength $param($coord)]
          set hmm_xml(OAT,${coord}_BOUNDARIES) ""
          if {$bbnum > 2} {
            set NO${coord}CH [expr {$bbnum - 1}]
            if {[info exists param(N${coord}C)]} {
              set NO${coord}CH $param(N${coord}C)
            }
            set hmm_xml(OAT,${coord}_BOUNDARIES) [lrange $param($coord) 0 [set NO${coord}CH]]
            set hmm_xml(OAT,$coord) ${coord}_BOUNDARIES
          } elseif {$bbnum == 2} {
            set hmm_xml(OAT,$coord) $param($coord)
            set b0  [lindex $param($coord) 0]
            set bstep [expr {[lindex $param($coord) 1] - $b0}]
            if {$bstep == 0} {
              return -code error "The generating bin boundaries for $coord are equal"
            }
            if {[info exists param(N${coord}C)]} {
              set NO${coord}CH $param(N${coord}C)
              for {set bb $b0; set i 0} {$i <= [set NO${coord}CH]} {incr i; set bb [expr {$bb + $bstep}] } {
                lappend hmm_xml(OAT,${coord}_BOUNDARIES) $bb
              }
            } else {
              if {$bstep > 0} {
                set bfinal [set hmm_xml(OAT,${coord}_MAX)]
              } else {
                set bfinal [set hmm_xml(OAT,${coord}_MIN)]
              }
              set brange [expr {abs($bfinal - $b0)}]
              set NO${coord}CH [expr {int(floor(abs($brange/$bstep)))}]
              for {set bb $b0} {1} {set bb [expr {$bb + $bstep}] } {
                lappend hmm_xml(OAT,${coord}_BOUNDARIES) $bb
                if [expr {abs($bfinal - $bb) < abs($bstep)}] { break }
              }
            }
          } else {
            error_msg "You must specify at least two bin boundaries for $coord"
          }
        }
      }
      set arglist [list NO_OAT_X_CHANNELS $NOXCH NO_OAT_Y_CHANNELS $NOYCH NO_OAT_T_CHANNELS $NOTCH]
      XXX_TABLE $tag $attributes $elements $arglist
      FAT_TABLE SIZE_PERIOD [expr {$NOXCH*$NOYCH*$NOTCH}]
      return [XXX_TABLE $tag $attributes $elements]
    }
  }
}
OAT_TABLE -clear

##
# @brief Spatial Allocation Table configuration parameters as maintained by SICS 
#
# @see XXX_TABLE for subcommands.
proc SAT_TABLE {args} {
  set attributes {}
  set elements ""
  set tag SAT
  global hmm_xml

  switch -glob -- [lindex $args 0] {
    "" {
      XXX_TABLE $tag $attributes $elements $args
    }
    "-*" {
      XXX_TABLE $tag $attributes $elements $args
    }
    default {
      XXX_TABLE $tag $attributes $elements $args
    }
  }
}
SAT_TABLE -clear

proc ::histogram_memory::clear_tables {} {
  BAT_TABLE -clear
  CAT_TABLE -clear
  FAT_TABLE -clear
  OAT_TABLE -clear
  SAT_TABLE -clear
}

##
# @brief When called without arguments this returns the name of the filler defaults file
# for the histogram server.  When called with an argument it sets the current name of the 
# filler defaults file.
#
# When anstohm_linked.xml is uploaded to the histogram server it calls this via
# command substitution to set the name of the filler defaults file.
proc ::histogram_memory::filler_defaults {args} {
  variable  hmm_def_filename
  if {[llength $args] == 0} {
    return $hmm_def_filename
  } else {
    set hmm_def_filename $args
  }
}

# XXX DEPRECATED, use upload_config instead.
proc ::histogram_memory::configure_server {instdef} {
  clientput "WARNING: ::histogram_memory::configure_server is deprecated, call ::histogram_memory::upload_config instead"
  ::histogram_memory::upload_config $instdef 
}
# TODO Set current oat table after uploading proposed oat_table
proc ::histogram_memory::upload_config {filler_defaults} {
  ::histogram_memory::filler_defaults $filler_defaults
#XXX  ::histogram_memory::setup
    hmm stop
    hmm configure init 1
    hmm init
# Restore the init level to 0
# subesquent inits will only upload specified FAT settings to histogram server.
    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 configure statuscheck true
    hmm stop
    hmm configure statuscheck false
  ::histogram_memory::configure_dims
}


##
# @brief Configure the dimensions for the controlling histogram object, and for
# each auxiliary histogram object.
proc ::histogram_memory::configure_dims {} {
#  set hmm_dim0 [hmmdictitemval hmm oat_ntc_eff]
#  if {[instname] == "wombat"} {
#    set hmm_dim1 [hmmdictitemval hmm stitch_nyc]
#    set hmm_dim2 [hmmdictitemval hmm stitch_nxc]
#  } else {
#    set hmm_dim1 [hmmdictitemval hmm oat_nyc_eff]
#    set hmm_dim2 [hmmdictitemval hmm oat_nxc_eff]
#  }
  if {[instname] == "wombat"} {
    array set dim_map {
      hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc} {hmm_dim2 stitch_nxc}}
      hmm,fat_read_data_type HISTOPERIOD_XYT
      hmm_xy {{hmm_dim0 stitch_nyc} {hmm_dim1 stitch_nxc}}
      hmm_xy,fat_read_data_type TOTAL_HISTOGRAM_XY
      hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nxc}}
      hmm_xt,fat_read_data_type TOTAL_HISTOGRAM_XT
      hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc}}
      hmm_yt,fat_read_data_type TOTAL_HISTOGRAM_YT
      hmm_x {{hmm_dim0 stitch_nxc}}
      hmm_x,fat_read_data_type TOTAL_HISTOGRAM_X
      hmm_y {{hmm_dim0 stitch_nyc}}
      hmm_y,fat_read_data_type TOTAL_HISTOGRAM_Y
      hmm_t {{hmm_dim0 oat_ntc_eff}}
      hmm_t,fat_read_data_type TOTAL_HISTOGRAM_T
    }
  } else {
    array set dim_map {
      hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff} {hmm_dim2 oat_nxc_eff}}
      hmm,fat_read_data_type HISTOPERIOD_XYT
      hmm_xy {{hmm_dim0 oat_nyc_eff} {hmm_dim1 oat_nxc_eff}}
      hmm_xy,fat_read_data_type TOTAL_HISTOGRAM_XY
      hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nxc_eff}}
      hmm_xt,fat_read_data_type TOTAL_HISTOGRAM_XT
      hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff}}
      hmm_yt,fat_read_data_type TOTAL_HISTOGRAM_YT
      hmm_x {{hmm_dim0 oat_nxc_eff}}
      hmm_x,fat_read_data_type TOTAL_HISTOGRAM_X
      hmm_y {{hmm_dim0 oat_nyc_eff}}
      hmm_y,fat_read_data_type TOTAL_HISTOGRAM_Y
      hmm_t {{hmm_dim0 oat_ntc_eff}}
      hmm_t,fat_read_data_type TOTAL_HISTOGRAM_T
    }
  }

  foreach hm_obj [sicslist type histmem] { 
    set rank [SplitReply [$hm_obj configure rank]]
    set hmm_length 1
    foreach elmt $dim_map($hm_obj) {
      set [lindex $elmt 0] [hmmdictitemval hmm [lindex $elmt 1]]
    }
    $hm_obj configure FAT_READ_DATA_TYPE $dim_map($hm_obj,fat_read_data_type)
    $hm_obj stop
    $hm_obj init 0
    $hm_obj init

    for {set i 0} {$i < $rank} {incr i} {
      set hmm_length [expr {$hmm_length * [set hmm_dim$i]} ]
      $hm_obj configure dim$i [set hmm_dim$i]
    }
  }
}

##
# @brief Sets the histogram memory frame frequency to the given value.
#
# @param freq Frequency in Hz.\n
# @param frame_source INTERNAL (default) or EXTERNAL
#
# If freq=0 then it sets the frequency to 50Hz with an internal frame source. This is useful 
# if you are setting the frequency from a chopper which is stopped.
proc ::histogram_memory::set_frame_freq {freq {frame_source INTERNAL}} {
  if {$freq < 0} {
    return -code error "Frequency must not be negative"
  }
#TODO Add tolerance parameters to choppercontroller
  if {abs($freq - 0) <= [expr {2.0/60.0}]} {
    hmm configure fat_frame_source INTERNAL
    set newfreq 50
  } else {
    hmm configure fat_frame_source [string toupper $frame_source]
    ::set newfreq $freq
  }
  if [ catch {
    ::histogram_memory::stop
    set clock_scale_ns 1000.0
    OAT_TABLE -set T_MAX [expr {1.0e9/($newfreq*$clock_scale_ns)}]
    hmm configure fat_frame_frequency $newfreq
    hmm init
  } errmsg ] {
    return -code error $errmsg
  }
}
publish ::histogram_memory::set_frame_freq user

proc ::histogram_memory::t_max {} {
  set frame_freq [SplitReply [hmm configure fat_frame_frequency]]
}
##
# @brief Sets histogram server to default configuration, initialises SICS histogram memory
# dictionary values and clears SICS OAT BAT CAT FAT ... tables
proc ::histogram_memory::_initialize {} {
  set configuration "::histogram_memory::returnconfigfile config/hmm/anstohm_linked.xml"
  ::histogram_memory::y_bin -boundaries
  ::histogram_memory::x_bin -boundaries
  ::histogram_memory::y_pixel_offset -boundaries
  ::histogram_memory::x_pixel_offset -boundaries
  ::histogram_memory::time_channel -boundaries
  ::histogram_memory::clear_tables
#XXX  ::histogram_memory::upload_config Filler_defaults

  foreach hm_obj [sicslist type histmem] { 
      $hm_obj configure hmaddress http://das1-[instname].nbi.ansto.gov.au:8080
      $hm_obj configure username spy
      $hm_obj configure password 007
      $hm_obj configure histmode transparent
  }
  hmm configure init 0
  hmm init
  hmm configure statuscheck true
  hmm stop
  hmm configure statuscheck false
  OAT_TABLE -init
  OAT_TABLE -set T_MIN 0
  ::histogram_memory::set_frame_freq 50
  FAT_TABLE -init SIZE_PERIOD_MAX 125000000
  hmm configure hmDataPath ../HMData
  hmm configure hmconfigscript $configuration
  if [ catch {
  ::histogram_memory::configure_dims
} ] {clientput $::errorInfo}
}

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::save user
Publish BAT_TABLE user
Publish CAT_TABLE user
Publish FAT_TABLE user
Publish OAT_TABLE user
Publish SAT_TABLE user

proc ::histogram_memory::pre_count {} {}
proc ::histogram_memory::post_count {} {}

  ##
  # @brief Start an acquisition, non-blocking by default
  #
  # @param block (optional) default="noblock"
  proc ::histogram_memory::start {{blocking "noblock"}} {
    set options [list block noblock]
    if {[lsearch $options $blocking] == -1} {
      return -code error "Valid options are $options"
    }
    ::histogram_memory::pre_count
    hmm init 0
    hmm init
    if [catch {hmc start 1000000000 timer pause 1}] {
      return -code error $::errorInfo
    }
    if {$blocking == "block"} {
      blockctr count 0
      ::histogram_memory::stop
    }
  }

  ##
  # @brief This sends the magic incantation which stops the histogram server.
  proc ::histogram_memory::stop {} {
    if [ catch {
      hmm pause
      hmm configure statuscheck true
      hmm stop
      hmm configure statuscheck false
    } errmsg ] {
      return -code error $errmsg
    }
  }
  ##
  # @brief Allows resume if MULTIPLE_DATASETS=DISABLE, otherwise if MULTIPLE_DATASETS=ENABLE
  # (the default) this acts like a stop but allows a fast restart.
  proc ::histogram_memory::pause {} {
    if [ catch {
      hmm pause
      ::histogram_memory::post_count
    } errmsg ] {
      return -code error $errmsg
    }
  }

  ##
  # @brief Choose method for controlling acquisition duration.
  proc ::histogram_memory::count_method {method} {
    set modes [list time monitor unlimited period count frame] 
    if {[lsearch $modes $method] == -1} {
      return -code error "Count mode, $method, must be one of $modes"
    }
    hmm configure FAT_COUNT_METHOD $method
    hmm init 0
    hmm init
  }
  ##
  # @brief Count until the preset count size has been reached.
  #
  # @param preset: The interpretation of the preset depends on the count method.
  # @see count_method
  proc ::histogram_memory::count_size {preset} {
    hmm configure FAT_COUNT_SIZE [expr {100.0 * $preset}]
    hmm init 0
    hmm init
  }
  ##
  # @brief Set stop condition for histogram memory
  #
  # @param condition
  proc ::histogram_memory::stop_condition {condition} {
    array set count_stop {immediate IMMEDIATE period AT_END_OF_PERIOD}
    hmm configure FAT_COUNT_STOP $count_stop($condition)
    hmm init 0
    hmm init
  }
namespace eval ::histogram_memory {
#TODO Create GumTree commands to setup, start and stop the histmem
  ##
  # @brief Choose method for controlling acquisition duration.
  #command mode {text:time,monitor,unlimited,period,count,frame method} {}
  ##
  # @brief Count until the preset count size has been reached.
  #
  # @param preset: The interpretation of the preset depends on the count method.
  # @see count_method
  #command preset {float: pre} {}
  ##
  # @brief Set stop condition for histogram memory
  #
  # @param condition
  #command stop_condition {text:immediate,period condition} 
}

  ##
  # @brief Convenience command providing user interface to histogram control
  #
  # @param cmd is one of start, stop, pause, mode, preset, loadconf
  # @param args is an optional list of arguments for the given command
  proc _histmem {cmd args} {
    if [ catch { 
      switch $cmd {
        "start" {
          eval "::histogram_memory::start $args"
        }
        "stop" {
          ::histogram_memory::stop
        }
        "pause" {
          ::histogram_memory::pause
        }
        "mode" {
          eval "::histogram_memory::count_method $args"
        }
        "preset" {
          eval "::histogram_memory::count_size $args"
        }
        "setfreq" {
          eval "::histogram_memory::set_frame_freq $args"
        }
        "loadconf" {
          # Loads configuration tables (OAT, FAT, ...) to histogram server
          if {$args == ""} {
            ::histogram_memory::upload_config Filler_defaults
          } else {
            eval "::histogram_memory::upload_config $args"
          }
        }
        default {
          error "Available commands are, start stop pause mode preset setfreq loadconf"
        }
      }
    } errmsg ] {
      return -code error $errmsg
    }
  }