74 lines
2.5 KiB
Tcl
74 lines
2.5 KiB
Tcl
#===========================================================================
|
|
# 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 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 writeTextVar {alias var} {
|
|
set ret [catch {set val [SplitReply [$var]]} val]
|
|
if { $ret != 0} {
|
|
clientput [format "ERROR: failed to read %s" $var]
|
|
return
|
|
} else {
|
|
nxscript puttext $alias $val
|
|
}
|
|
}
|
|
#========================================================================
|
|
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 $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
|
|
}
|