From 0de5ee41e29ec311028ddd194b04a211a76d169d Mon Sep 17 00:00:00 2001
From: Ferdi Franceschini <ffr@ansto.gov.au>
Date: Fri, 9 Aug 2013 05:29:03 +1000
Subject: [PATCH] SICS-656 Make a multivariable runscan command. SICS-649
 Return to initial position after a scan for Platypus

---
 .../instrument/config/scan/scan_common_1.tcl  | 429 ++++++++++++++----
 1 file changed, 340 insertions(+), 89 deletions(-)

diff --git a/site_ansto/instrument/config/scan/scan_common_1.tcl b/site_ansto/instrument/config/scan/scan_common_1.tcl
index a3747156..9ced8aed 100644
--- a/site_ansto/instrument/config/scan/scan_common_1.tcl
+++ b/site_ansto/instrument/config/scan/scan_common_1.tcl
@@ -21,6 +21,10 @@ variable reset_position
 variable check_thread0
 variable check_instrument_ready
 variable force_scan
+variable scanvarlist
+variable startlist
+variable steplist
+variable scaninitposlist
 
 set check_thread0 true
 set check_instrument_ready true
@@ -42,46 +46,61 @@ proc force_scan {} {
 }
 publish force_scan user
 
-proc ::scan::bm_scan_collect {sobj uobj point} {
-    set vlist [split [$sobj getvarpar 0] = ];
+proc ::scan::print_hdr_svars {sobj point counts actime} {
+    set numvars [SplitReply [$sobj noscanvar]]
+    set infostart [expr [string length $sobj] + 1]
+    for {set i 0} {$i < $numvars} {incr i} {
+      set svinfo [$sobj getvarpar $i]
+      foreach {svar start step} [ split [string range $svinfo $infostart end] = ] {
+        set svar [string trim $svar]
+        lappend scanvarlist $svar
+        lappend scanstartlist $start
+        lappend scansteplist $step
+        lappend varposlist [SplitReply [$svar]]
+      }
+    }
+    set fmtstr "%-4.4s [string repeat "%-9.9s " $numvars] %-14s %-7.7s"
 
-    set w(NP) $point
-    set sv [string trim [lindex [split [lindex $vlist 0] . ] 1]]
-    set header [format "%-4.4s %-9.9s %-14s %-7.7s" NP $sv Counts Time]
-    set varval [SplitReply [$sv]]
-    set counts [SplitReply [bm getcounts]]
-    set time [SplitReply [bm gettime]]
-    set data [format "%-4d %-9.3f %-14d %-7.2f" $point $varval $counts $time]
+    set headercmd [subst {format "$fmtstr" NP $scanvarlist Counts Time}]
+    set header [eval $headercmd ]
+    set fmtstr "%-4d [string repeat "%-9.3f " $numvars] %-14d %-7.2f"
+    set datacmd [subst {format "$fmtstr" $point $varposlist $counts $actime} ]
+    set data [eval $datacmd]
     clientput $header
     clientput $data
+}
+proc ::scan::bm_scan_collect {sobj uobj point} {
+    set counts [SplitReply [bm getcounts]]
+    set actime [SplitReply [bm gettime]]
+    print_hdr_svars $sobj $point $counts $actime
     for {set chn 0} {$chn < $::counter::isc_numchannels} {incr chn} {
       clientput "Channel $chn [SplitReply [bm getmonitor $chn]]"
     }
 }
 
 proc ::scan::hmm_scan_collect {sobj uobj point} {
-    set vlist [split [$sobj getvarpar 0] = ];
-
-    set w(NP) $point
-    set sv [string trim [lindex [split [lindex $vlist 0] . ] 1]]
-    set header [format "%-4.4s %-9.9s %-14s %-7.7s" NP $sv Counts Time]
-    set varval [SplitReply [$sv]]
     set counts [SplitReply [::histogram_memory::total_counts]]
-    set time [SplitReply [::histogram_memory::time]]
-    set data [format "%-4d %-9.3f %-14d %-7.2f" $point $varval $counts $time]
-    clientput $header
-    clientput $data
+    set actime [SplitReply [::histogram_memory::time]]
+    print_hdr_svars $sobj $point $counts $actime
     for {set bmn 1} {$bmn <= $::counter::isc_numchannels} {incr bmn} {
       set bmon bm$bmn
       clientput "Monitor $bmn [SplitReply [$bmon getcounts]]"
     }
 }
 proc ::scan::hmscanend_event {} {
+  variable scanvarlist
+  variable startlist
+  variable steplist
+
   ::scan::runscan_cmd -set feedback status IDLE
 }
 publish ::scan::hmscanend_event user
 
 proc ::scan::bmonscanend_event {} {
+  variable scanvarlist
+  variable startlist
+  variable steplist
+
   ::scan::hdb_bmonscan -set feedback status IDLE
 }
 publish ::scan::bmonscanend_event user
@@ -171,8 +190,11 @@ proc ::scan::check_scanvar {sobj uobj} {
     if {[getatt $scan_variable type] == "motor"} {
     if {[SplitReply [$scan_variable fixed]] >= 0} {
       return -code error "ERROR: Can't drive scan variable, $scan_variable position is set to 'fixed'"
-    } elseif {$check_thread0 && [SplitReply [$scan_variable thread0]] == -1} {
-      return -code error "ERROR: Can't scan ${scan_variable}. Thread zero has stopped running on the motion controller"
+    } else {
+      set mtype [getatt $scan_variable mtype]
+      if {$mtype != "tlcmot" && $check_thread0 && [SplitReply [$scan_variable thread0]] == -1} {
+        return -code error "ERROR: Can't scan ${scan_variable}. Thread zero has stopped running on the motion controller"
+      }
     }
     set scan_final [expr $scan_start + ($NP-1) * $scan_increment]
     if [catch {
@@ -215,17 +237,26 @@ proc ::scan::hmm_scan_prepare {sobj uobj} {
 
       if [catch {
         set numpoints [SplitReply [$sobj np]]
-        set vlist [split [$sobj getvarpar 0] = ]
-        set scanstart [lindex $vlist 1]
-        set scanstep [lindex $vlist 2]
+        set numvars [SplitReply [$sobj noscanvar]]
+        set infostart [expr [string length $sobj] + 1]
+        for {set i 0} {$i < $numvars} {incr i} {
+          set svinfo [$sobj getvarpar $i]
+          foreach {sv start step} [ split [string range $svinfo $infostart end] = ] {
+            lappend scanvarlist $sv
+            lappend scanstartlist $start
+            lappend scansteplist $step
+          }
+        }
 
         ::scan::runscan_cmd -set feedback status BUSY
         run_mode "hmscan"
 
-        set ::histogram_memory::histmem_axes(SVAR) [SplitReply [sicslist [::scan::runscan_cmd -set scan_variable] hdb_path] ]
+        set ::histogram_memory::histmem_axes(SVAR) [SplitReply [sicslist [lindex $::scan::scanvarlist 0] hdb_path] ]
         ::nexus::newfile $ic_hmm_datatype $save_filetype
 
-        clientput "Scan start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
+        foreach sv $scanvarlist scanstart $scanstartlist scanstep $scansteplist {
+          clientput "Scanvar: $sv start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
+        }
         clientput "Datatype: $ic_hmm_datatype"
         # Prime DAE
         hmm pause
@@ -240,7 +271,7 @@ proc ::scan::hmm_scan_prepare {sobj uobj} {
 
 proc ::scan::hmm_count {sobj uobj point mode preset} {
     ::scan::runscan_cmd -set feedback scanpoint $point
-    ::scan::runscan_cmd -set feedback scan_variable_value [SplitReply [[::scan::runscan_cmd -set scan_variable]]]
+    ::scan::runscan_cmd -set feedback scan_variable_value [SplitReply [[lindex $::scan::scanvarlist 0]]]
     # Start histogram and block until count is complete
     ::histogram_memory::start block
   }
@@ -249,6 +280,11 @@ proc ::scan::hmm_count {sobj uobj point mode preset} {
 proc ::scan::hmm_scan_finish {sobj uobj} {
     variable save_filetype
     variable reset_position
+    variable scanvarlist
+    variable startlist
+    variable steplist
+    variable scaninitposlist
+
     set $save_filetype "data"
     ::histogram_memory::stop
     ::scan::runscan_cmd -set feedback status IDLE
@@ -258,11 +294,13 @@ proc ::scan::hmm_scan_finish {sobj uobj} {
     # and clear any data links
     ::nexus::newfile clear data
     if {$reset_position == "true"} {
-      set reset_position "false" 
-      set svar [::scan::runscan_cmd -get scan_variable]
-      set svtype [getatt $svar type]
-      if {$svtype == "motor" || $svtype == "configurablevirtualmotor"} {
-        drive $svar [::scan::runscan_cmd -get scan_start]
+#     set reset_position "false" 
+      foreach svar $scanvarlist initpos $scaninitposlist {
+        set svtype [getatt $svar type]
+        if {$svtype == "motor" || $svtype == "configurablevirtualmotor"} {
+          lappend drivelist $svar $initpos
+        }
+        eval drive $drivelist
       }
     }
 #    ::histogram_memory::configure_server Filler_defaults
@@ -270,6 +308,11 @@ proc ::scan::hmm_scan_finish {sobj uobj} {
 
 proc ::scan::bm_scan_finish {sobj uobj} {
     variable reset_position
+    variable scanvarlist
+    variable startlist
+    variable steplist
+    variable scaninitposlist
+
     ::scan::hdb_bmonscan -set feedback status IDLE
     run_mode "normal"
     set ::histogram_memory::histmem_axes(SVAR) "/instrument/run_number"
@@ -277,11 +320,13 @@ proc ::scan::bm_scan_finish {sobj uobj} {
     # and clear any data links
     ::nexus::newfile clear data
     if {$reset_position == "true"} {
-      set reset_position "false"
-      set svar [::scan::hdb_bmonscan -get scan_variable]
-      set svtype [getatt $svar type]
-      if {$svtype == "motor" || $svtype == "configurablevirtualmotor"} {
-        drive $svar [::scan::hdb_bmonscan -get scan_start]
+#     set reset_position "false"
+      foreach svar $scanvarlist initpos $scaninitposlist {
+        set svtype [getatt $svar type]
+        if {$svtype == "motor" || $svtype == "configurablevirtualmotor"} {
+          lappend drivelist $svar $initpos
+        }
+        eval drive $drivelist
       }
     }
   }
@@ -307,7 +352,7 @@ proc ::scan::bm_count {sobj uobj point mode preset} {
     ::scan::hdb_bmonscan -set feedback scanpoint $point; 
     ::scan::hdb_bmonscan -set feedback mode $mode; 
     ::scan::hdb_bmonscan -set feedback preset $preset; 
-    ::scan::hdb_bmonscan -set feedback scan_variable_value [SplitReply [[::scan::hdb_bmonscan -set scan_variable]]]
+    ::scan::hdb_bmonscan -set feedback scan_variable_value [SplitReply [[lindex $::scan::scanvarlist 0]]]
     ::monitor::count $mode $preset
   }
 
@@ -328,9 +373,18 @@ proc ::scan::bm_scan_prepare {sobj uobj} {
 
       if [catch {
     #TODO Parameterise varindex in some way
-        set varindex 0;
-
+        set varindex 0
         set numpoints [SplitReply [$sobj np]]
+        set numvars [SplitReply [$sobj noscanvar]]
+        set infostart [expr [string length $sobj] + 1]
+        for {set i 0} {$i < $numvars} {incr i} {
+          set svinfo [$sobj getvarpar $i]
+          foreach {sv start step} [ split [string range $svinfo $infostart end] = ] {
+            lappend scanvarlist $sv
+            lappend scanstartlist $start
+            lappend scansteplist $step
+          }
+        }
         set vlist [split [$sobj getvarpar $varindex] = ]
         set scanstart [lindex $vlist 1]
         set scanstep [lindex $vlist 2]
@@ -344,10 +398,12 @@ proc ::scan::bm_scan_prepare {sobj uobj} {
         run_mode "bmonscan"
         
         array set bm_fb [::scan::hdb_bmonscan -list feedback]
-        set ::histogram_memory::histmem_axes(SVAR) [SplitReply [sicslist [::scan::hdb_bmonscan -set scan_variable] hdb_path] ]
+        set ::histogram_memory::histmem_axes(SVAR) [SplitReply [sicslist [lindex $::scan::scanvarlist 0] hdb_path] ]
         ::nexus::newfile BEAM_MONITOR $save_filetype
         #stdscan prepare $sobj $uobj;
-        clientput "Scan start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
+        foreach sv $scanvarlist scanstart $scanstartlist scanstep $scansteplist {
+          clientput "Scanvar: $sv start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
+        }
         clientput "Datatype: BEAM_MONITOR"
       }] {
         run_mode "normal"
@@ -374,34 +430,43 @@ Publish ::scan::bm_writepoint user
 Publish ::scan::bm_count user
 
 namespace eval scan {
-  namespace export runscan
+  namespace export runscan mvrunscan
   VarMake ::scan::runscan_reset_position Text internal
   ::scan::runscan_reset_position false
-  #TODO Add counter (monitor_1 monitor_2 ... histmem) and filetype BEAM_MONITOR HISTMEM_?
-  ##
-  # @brief Run a histogram memory scan
-  # @param filetype one of the histogram filetypes (default=HISTOGRAM_XYT)
-  # @param savetype save/nosave (default=save)
-  # @param force true/false (default=false)
 
-  proc runscan {scanvar start stop numpoints mode preset args} {
+  # Utility to check the type of an argument
+  # returns true or raises an error if the type is invalid
+  proc checkarg {arg type errmsg} {
+    if {[string length $arg] == 0} {
+      error "Not enough arguments"
+    }
+    if {$type == "varname"} {
+      if [ string is alpha [string index $arg 0] ] {
+        set type "wordchar"
+      } else {
+        error $errmsg
+      }
+    }
+
+    if [string is $type $arg] {
+      return 1
+    } else {
+      error $errmsg
+    }
+  }
+
+  ##
+  # @brief Sets up and runs an hmscan or bmonscan object from a list of scan variables
+  # and parameters
+  proc doscan {scanvarlist startlist steplist numpoints mode preset args} {
     variable ic_hmm_datatype
     variable save_filetype
-    variable reset_position
     variable force_scan
 
-    if [ catch {
-    set force_scan false
-
-    set hm_ft_names [array names ::nexus::histmem_filetype_spec]
-    
-    # Default filetype for histogram memory scans
-    set ic_hmm_datatype "HISTOGRAM_XYT"
-    # Default save uniquely numbered files
-    set savetype "save" 
-    set reset_position [SplitReply [::scan::runscan_reset_position]]
-    if {[is_drivable $scanvar] == 0} {
-      error "The scan variable <$scanvar> must be drivable"
+    foreach scanvar $scanvarlist {
+      if {[is_drivable $scanvar] == 0} {
+        error "The scan variable <$scanvar> must be drivable"
+      }
     }
     if {[string is integer $numpoints] != 1} {
       error "Number of points <$numpoints> must be an integer"
@@ -410,16 +475,6 @@ namespace eval scan {
       error "Number of points <$numpoints> must not be less than one"
     }
 
-    if {$numpoints == 1} {
-      set step 0
-    } else {
-      set step [expr double($stop - $start)/($numpoints - 1.0)]
-    }
-    if {$step == 0 && $numpoints > 1} {
-      clientput "WARNING:Scan step is zero and number of points > 1. Adjusting numpoints to one"
-      set numpoints 1
-    }
-
     foreach {arg val} $args {
       switch $arg {
         "force" {
@@ -453,11 +508,13 @@ namespace eval scan {
 
     set det_type [::scan::runscan_cmd -get detector]
     if {$det_type == "histmem"} {
-    # hmscan ignores mode and preset, we use FAT_COUNT_METHOD and FAT_COUNT_STOP
+      # hmscan ignores mode and preset, we use FAT_COUNT_METHOD and FAT_COUNT_STOP
       ::histogram_memory::count_method $mode
       ::histogram_memory::count_size $preset
       hmscan clear 
-      hmscan add $scanvar $start $step
+      foreach scanvar $scanvarlist start $startlist step $steplist {
+        hmscan add $scanvar $start $step
+      }
     } elseif {$det_type == "bmon"} {
       set mode [string tolower $mode]
       switch -glob $mode {
@@ -466,31 +523,225 @@ namespace eval scan {
         default   {return -code error "ERROR: mode should be  'time' or 'monitor' not $mode"}
       }
       bmonscan clear 
-      bmonscan add $scanvar $start $step
+      foreach scanvar $scanvarlist start $startlist step $steplist {
+        bmonscan add $scanvar $start $step
+      }
     } else {
       return -code error "ERROR: detector type should be 'histmem' or 'bmon' not $det_type"
     }
-    ::scan::runscan_cmd -set numpoints $numpoints
-    ::scan::runscan_cmd -set scan_variable $scanvar
-    ::scan::runscan_cmd -set scan_start $start
-    ::scan::runscan_cmd -set scan_stop $stop
-    ::scan::runscan_cmd -set feedback scan_step $step
-    ::scan::runscan_cmd -set mode $mode
-    ::scan::runscan_cmd -set preset $preset
     if {$det_type == "histmem"} {
       hmscan run $numpoints timer 0
     } else {
       bmonscan run $numpoints $bms_mode $preset
     }
-  } message ] {
-    set force_scan false
-    return -code error "ERROR [info level 0]\n$message"
-  } else {
-    set force_scan false
-    return $message
   }
+
+  ## Multi-variable runscan
+  proc mvrunscan {scanvar start step args} {
+    variable ic_hmm_datatype
+    variable reset_position
+    variable force_scan
+    variable scanvarlist
+    variable startlist
+    variable steplist
+    variable scaninitposlist
+
+    set scanvarlist {}
+    set startlist {}
+    set steplist {}
+    set scaninitposlist {}
+
+    if [ catch {
+      set force_scan false
+
+      set hm_ft_names [array names ::nexus::histmem_filetype_spec]
+
+      # Default filetype for histogram memory scans
+      set ic_hmm_datatype "HISTOGRAM_XYT"
+      # Default save uniquely numbered files
+      set savetype "save" 
+      set reset_position [SplitReply [::scan::runscan_reset_position]]
+
+      checkarg $scanvar varname "Expecting a scan variable name, not $scanvar"
+      checkarg $start double "Expecing a float for $scanvar start value, not $start"
+      checkarg $step double "Expecing a float for $scanvar step value, not $step"
+      lappend scanvarlist $scanvar
+      lappend startlist $start
+      lappend steplist $step 
+      for {set argindex 0} {1} {incr argindex 3} {
+        set par [lindex $args $argindex]
+        if {[string length $par] == 0} {
+          error "Not enough arguments"
+        } elseif [string is double $par] {
+          set numpoints $par
+          incr argindex
+          break
+        }
+        set err "Expecting another scan variable name or number of scanpoints instead of $par"
+        checkarg $par varname $err
+
+        lappend scanvarlist [lindex $args $argindex]
+        set start [lindex $args $argindex+1]
+        if {![string is double $start]} {
+          error "Scan variable start value should be a float, not $start"
+        }
+        lappend startlist $start
+        set step [lindex $args $argindex+2]
+        if {![string is double $step]} {
+          error "Scan variable step value should be a float, not $step"
+        }
+        lappend steplist $step
+      }
+      set mode [lindex $args $argindex]
+      incr argindex
+      checkarg $mode alpha "Expecting mode but got $mode"
+
+      set preset [lindex $args $argindex]
+      incr argindex
+      checkarg $preset double "Expecting preset but got $preset"
+      foreach scanvar $scanvarlist {
+        lappend scaninitposlist [SplitReply [$scanvar]]
+      }
+      # The {*}[...] below uses the Tcl8.5 expand operator {*} to pass a list as separate arguments
+      doscan $scanvarlist $startlist $steplist $numpoints $mode $preset {*}[lrange $args $argindex end]
+    } message ] {
+      set force_scan false
+      return -code error "ERROR [info level 0]\n$message"
+    } else {
+      set force_scan false
+      return $message
+    }
   }
+    
+  #TODO Add counter (monitor_1 monitor_2 ... histmem) and filetype BEAM_MONITOR HISTMEM_?
+  ##
+  # @brief Run a histogram memory scan
+  # @param filetype one of the histogram filetypes (default=HISTOGRAM_XYT)
+  # @param savetype save/nosave (default=save)
+  # @param force true/false (default=false)
+    proc runscan {scanvar start stop numpoints mode preset args} {
+      variable ic_hmm_datatype
+      variable save_filetype
+      variable reset_position
+      variable force_scan
+      variable scanvarlist
+      variable startlist
+      variable steplist
+      variable scaninitposlist
+
+      set scanvarlist {}
+      set startlist {}
+      set steplist {}
+      set scaninitposlist {}
+
+      if [ catch {
+      set force_scan false
+
+      set hm_ft_names [array names ::nexus::histmem_filetype_spec]
+      
+      # Default filetype for histogram memory scans
+      set ic_hmm_datatype "HISTOGRAM_XYT"
+      # Default save uniquely numbered files
+      set savetype "save" 
+      set reset_position [SplitReply [::scan::runscan_reset_position]]
+      if {[is_drivable $scanvar] == 0} {
+        error "The scan variable <$scanvar> must be drivable"
+      }
+      lappend scanvarlist $scanvar
+      lappend startlist $start
+      if {[string is integer $numpoints] != 1} {
+        error "Number of points <$numpoints> must be an integer"
+      }
+      if { $numpoints < 1 } {
+        error "Number of points <$numpoints> must not be less than one"
+      }
+
+      if {$numpoints == 1} {
+        set step 0
+      } else {
+        set step [expr double($stop - $start)/($numpoints - 1.0)]
+      }
+      lappend steplist $step
+      if {$step == 0 && $numpoints > 1} {
+        clientput "WARNING:Scan step is zero and number of points > 1. Adjusting numpoints to one"
+        set numpoints 1
+      }
+
+      foreach {arg val} $args {
+        switch $arg {
+          "force" {
+            if [string is boolean $val] {
+              set force_scan $val    
+            } else {
+              error "ERROR: force must be true or false"
+            }
+          }
+          "datatype" {
+            set ic_hmm_datatype $val
+          }
+          "savetype" {
+            switch $val {
+              "save" {
+                set save_filetype data
+              }
+              "nosave" {
+                set save_filetype scratch
+              }
+              default {
+                error "ERROR: $arg $val, valid values for $arg are 'save' or 'nosave'"
+              }
+            }
+          }
+          default {
+            error "ERROR: $arg should be 'datatype' 'savetype' or 'force'"
+          }
+        }
+      }
+
+      set det_type [::scan::runscan_cmd -get detector]
+      if {$det_type == "histmem"} {
+      # hmscan ignores mode and preset, we use FAT_COUNT_METHOD and FAT_COUNT_STOP
+        ::histogram_memory::count_method $mode
+        ::histogram_memory::count_size $preset
+        hmscan clear 
+        hmscan add $scanvar $start $step
+      } elseif {$det_type == "bmon"} {
+        set mode [string tolower $mode]
+        switch -glob $mode {
+          "time"    { set bms_mode "timer" }
+          "monitor" { set bms_mode "monitor" }
+          default   {return -code error "ERROR: mode should be  'time' or 'monitor' not $mode"}
+        }
+        bmonscan clear 
+        bmonscan add $scanvar $start $step
+      } else {
+        return -code error "ERROR: detector type should be 'histmem' or 'bmon' not $det_type"
+      }
+      lappend scaninitposlist [SplitReply [$scanvar]]
+      ::scan::runscan_cmd -set numpoints $numpoints
+      ::scan::runscan_cmd -set scan_variable $scanvar
+      ::scan::runscan_cmd -set scan_start $start
+      ::scan::runscan_cmd -set scan_stop $stop
+      ::scan::runscan_cmd -set feedback scan_step $step
+      ::scan::runscan_cmd -set mode $mode
+      ::scan::runscan_cmd -set preset $preset
+      if {$det_type == "histmem"} {
+        hmscan run $numpoints timer 0
+      } else {
+        bmonscan run $numpoints $bms_mode $preset
+      }
+    } message ] {
+      set force_scan false
+      return -code error "ERROR [info level 0]\n$message"
+    } else {
+      set force_scan false
+      return $message
+    }
+    }
+
 }
 namespace import ::scan::runscan
+namespace import ::scan::mvrunscan
 publish runscan user 
+publish mvrunscan user
 sicslist setatt runscan privilege internal