127 lines
4.1 KiB
Tcl
127 lines
4.1 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 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 address
|
|
}
|
|
#---------------------------------------------------------------------
|
|
proc appendMotor {np motor alias} {
|
|
set val [SplitReply [$motor]]
|
|
__transfer putfloat 0 $val
|
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
|
}
|
|
#---------------------------------------------------------------------
|
|
proc appendFloat {np alias val} {
|
|
__transfer putfloat 0 $val
|
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
|
}
|
|
#---------------------------------------------------------------------
|
|
proc appendCount {np value alias} {
|
|
__transfer putint 0 $value
|
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc appendSampleEnv {np device alias} {
|
|
#--------- test for presence
|
|
set status [catch {SplitReply [$device]} val]
|
|
if {$status != 0} {
|
|
return
|
|
}
|
|
#--------- test for validity
|
|
set status [catch {expr $val * 1.0} msg]
|
|
if {$status != 0} {
|
|
return
|
|
}
|
|
appendFloat $np $alias $val
|
|
}
|