- Adding first working version of the McStas SICS connection to cvs

SKIPPED: psi/polterwrite.c
2005-06-22 07:09:59 +00:00
parent 734577e394
commit ef6c04e6b8
42 changed files with 3268 additions and 18 deletions
--- a/mcstas/dmc/nxsupport.tcl
+++ b/mcstas/dmc/nxsupport.tcl
@ -0,0 +1,96 @@
+#===========================================================================
+# Support routines for scripting NeXus files with nxscript.
+#
+# Mark Koennecke, February 2003
+# Mark Koennecke, January 2004
+#==========================================================================
+proc makeFileName args {
+    sicsdatanumber incr
+    set num [SplitReply [sicsdatanumber]]
+    set p [string trim [SplitReply [sicsdatapath]]]
+    set pre [string trim [SplitReply [sicsdataprefix]]]
+    set po [string trim [SplitReply [sicsdatapostfix]]]
+    return [format "%s%s%5.5d2003%s" $p $pre $num $po] 
+}
+#==========================================================================
+# new version, attending to the new 1000 grouping logic
+proc newFileName args {
+    set ret [catch {nxscript makefilename} msg]
+    if {$ret != 0} {
+	clientput "ERROR: Misconfiguration of file writing variables"
+	clientput "Defaulting filename to emergency.hdf"
+	set fil emergency.hdf
+    } else {
+	set fil $msg
+    }
+    return $fil
+}
+#==========================================================================
+proc writeFloatVar {alias var} {
+    set ret [catch {set val [SplitReply [$var]]} val]
+    if { $ret != 0} {
+	clientput [format "ERROR: failed to read %s, %s" $var $val]
+	return
+    } else {
+	set val [string trim $val]
+	set ret [catch {expr $val * 1.0} val]
+	if { $ret == 0} {
+	    nxscript putfloat $alias [expr $val * 1.0 ]
+	} else {
+	    clientput "ERROR: bad value $val when reading $var"
+	}
+    }
+}
+#==========================================================================
+proc writeIntVar {alias var} {
+    set ret [catch {set val [SplitReply [$var]]} val]
+    if { $ret != 0} {
+	clientput [format "ERROR: failed to read %s, %s" $var $val]
+	return
+    } else {
+	set val [string trim $val]
+	set ret [catch {expr $val * 1.0} val]
+	if { $ret == 0} {
+	    nxscript putint $alias [expr int($val * 1.0) ]
+	} else {
+	    clientput "ERROR: bad value $val when reading $var"
+	}
+    }
+}
+#=========================================================================
+proc writeTextVar {alias var} {
+    set ret [catch {$var} val]
+    if { $ret != 0} {
+	clientput [format "ERROR: failed to read %s" $var]
+	return
+    } else {
+	set index [string first = $val]
+	if {$index >= 0} {
+	    set txt [string trim [string range $val [expr $index + 1] end]]
+	    nxscript puttext $alias $txt
+	} else {
+	    clientput [format "ERROR: failed to read %s" $var]
+	}
+    }
+}
+#========================================================================
+proc writeTextAttribute {attName var} {
+    set ret [catch {set val [SplitReply [$var]]} val]
+    if { $ret != 0} {
+	clientput [format "ERROR: failed to read %s" $var]
+	return
+    } else {
+	nxscript putglobal $attName [string trim $val]
+    }
+}
+#=======================================================================
+proc writeStandardAttributes {fileName} {
+    nxscript putglobal file_name $fileName
+    nxscript putglobal file_time [sicstime]
+    writeTextAttribute instrument instrument
+    writeTextAttribute owner user
+    writeTextAttribute owner_telephone_number phone
+    writeTextAttribute owner_fax_number fax
+    writeTextAttribute owner_email email
+    writeTextAttribute owner_address adress
+}