55 lines
1.9 KiB
Tcl
55 lines
1.9 KiB
Tcl
#===========================================================================
|
|
# Support routines for scripting NeXus files with nxscript.
|
|
#
|
|
# Mark Koennecke, February 2003
|
|
#==========================================================================
|
|
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]
|
|
}
|
|
#==========================================================================
|
|
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 {
|
|
nxscript putfloat $alias [expr $val * 1.0 ]
|
|
}
|
|
}
|
|
#=========================================================================
|
|
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
|
|
}
|