PSI sics-cvs-psi_pre-ansto

tcl/reflist.tcl

@@ -0,0 +1,79 @@
+#---------------------------------------------------------------------------
+# The first step when doing a four circle experiment is to search
+# reflections manually. When some have been found a UB-matrix calculation
+# can be tried. In between it is necessary to keep a list of peak positons
+# found and to write them to file. This is exactly what this is for.
+#
+# Mark Koennecke, October 1998
+#---------------------------------------------------------------------------
+
+#----- where data files shall go by default
+set prefix ./
+
+#--------------------------------------------------------------------------
+proc iiGetNum { text } {
+	set list [split $text =]
+        return [lindex $list 1]
+}
+
+#------------ clear everything
+proc iiinit {} {
+   global iiref
+   set iiref(np) 0
+   set iiref(OM) ""
+   set iiref(TH) ""
+   set iiref(CH) ""
+   set iiref(PH) ""
+   set iiref(title) ""
+}
+#------- run this once when loading in order to empty space
+iiinit
+#------------------- store
+proc iistore {} {
+   global iiref
+   incr iiref(np)
+   lappend iiref(OM) [iiGetNum [OM]]
+   lappend iiref(TH) [iiGetNum [TH]]
+   lappend iiref(CH) [iiGetNum [CH]]
+   lappend iiref(PH) [iiGetNum [PH]]
+   lappend iiref(title) [iiGetNum [title]]
+}
+#------------- write to file
+proc iiwrite {fil} {
+   global iiref
+   global prefix
+   set fd [open $prefix/$fil w]
+   for {set i 0} {$i < $iiref(np)} { incr i } {
+      set om [lindex $iiref(OM) $i]
+      set th [lindex $iiref(TH) $i]
+      set ch [lindex $iiref(CH) $i]
+      set ph [lindex $iiref(PH) $i]
+      set tt [lindex $iiref(title) $i]
+      puts $fd [format "%8.2f %8.2f %8.2f %8.2f %d %s" $th $om $ch $ph $i $tt]
+    }
+    close $fd
+}
+#------------------- the actual control implementation function
+proc rliste args {
+     if {[llength $args] < 1} {
+       error "ERROR: keyword expected to rliste"
+     }
+     switch [lindex $args 0] {
+       "clear" {
+                 iiinit
+                 return
+               }
+       "store" {
+                  iistore
+               }
+       "write" {
+                  if { [llength $args] < 2 } {
+                    error "ERROR: expected filename after write"
+                  }
+                  iiwrite [lindex $args 1]
+               }
+       default {
+                   error "ERROR: keyword [lindex $args 0] not recognized"
+               }
+     }
+}