349 lines
9.7 KiB
Tcl
349 lines
9.7 KiB
Tcl
#-------------------------------------------------------------------------
|
|
# Functions for writing NeXus files for a triple axis spectrometer and
|
|
# configuration of the internal scan object to support this.
|
|
#
|
|
# Mark Koennecke, May 2005
|
|
# reworked to new NeXus standards, Mark Koennecke, February 2007
|
|
#-----------------------------------------------------------------------
|
|
catch {sicsdatafactory new __transfer}
|
|
set __tasdata(out) ""
|
|
#----------------------------------------------------------------------
|
|
proc appendMotor {np motor alias} {
|
|
set val [tasSplit [$motor]]
|
|
if { [string length $val] > 0} {
|
|
__transfer putfloat 0 $val
|
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
|
} else {
|
|
clientput "WARNING: failed to read $motor"
|
|
}
|
|
}
|
|
#------------------------------------------------------------------
|
|
proc appendIfPresent {np obj alias} {
|
|
# sea_get is defined in ~/sea/tcl/remob.tcl
|
|
set status [catch {sea_get val $obj} msg]
|
|
if {$status != 0} {
|
|
return
|
|
}
|
|
if {$msg} {
|
|
__transfer putfloat 0 $val
|
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
|
}
|
|
}
|
|
#------------------------------------------------------------------
|
|
proc appendFloat {np alias val} {
|
|
if {[string length $val] > 0} {
|
|
__transfer putfloat 0 $val
|
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
|
} else {
|
|
clientput "WARNING: failed to read $alias"
|
|
}
|
|
}
|
|
#-------------------------------------------------------------------
|
|
proc appendCount {np value alias} {
|
|
__transfer putint 0 $value
|
|
nxscript putslab $alias [list $np] [list 1] __transfer
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc donothing {obj userobj} {
|
|
}
|
|
#---------------------------------------------------------------------
|
|
proc xmlprepare {obj userobj} {
|
|
global __tasdata
|
|
#------- normal prepare
|
|
tasscan prepare $obj $userobj
|
|
|
|
#--------- parse out variable
|
|
set out [tasSplit [output]]
|
|
if {[string compare [string toupper $out] "UNKNOWN"]==0} {
|
|
set out ""
|
|
}
|
|
set out [string map { "=" " " "," " "} $out]
|
|
set outlist [split $out]
|
|
foreach var $outlist {
|
|
if { [string length $var] > 1} {
|
|
set ret [catch {tasSplit [$var]} msg]
|
|
if {$ret == 0} {
|
|
lappend __tasdata(out) $var
|
|
}
|
|
}
|
|
}
|
|
#------- build Header
|
|
append head " PNT "
|
|
set scanvars [split [tasSplit [iscan getscanvars]]]
|
|
foreach var $scanvars {
|
|
if { [string length $var] > 1} {
|
|
append head [format "%9s " [string toupper $var]]
|
|
}
|
|
}
|
|
foreach var $__tasdata(out) {
|
|
append head [format "%9s " [string toupper $var]]
|
|
}
|
|
append head [format "%8s " M1]
|
|
append head [format "%8s " M2]
|
|
append head [format "%8s " TIME]
|
|
append head [format "%8s " CNTS]
|
|
append head [format "%8s " CTOT]
|
|
clientput $head
|
|
|
|
set __tasdata(starttime) [sicstime]
|
|
|
|
xmltaswrite $obj $userobj
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc xmlwritepoint {obj userobj np} {
|
|
global __tasdata scripthome
|
|
|
|
nxscript reopen $__tasdata(file) $scripthome/tasub.dic
|
|
|
|
append line [format " %3d" $np]
|
|
set scanvars [split [tasSplit [iscan getscanvars]]]
|
|
foreach var $scanvars {
|
|
if { [string length $var] > 1} {
|
|
set val [tasSplit [eval $var]]
|
|
append line [format "%9.4f " [tasSplit [$var]]]
|
|
appendMotor $np $var sc_$var
|
|
lappend storedvars $var
|
|
}
|
|
}
|
|
foreach var $__tasdata(out) {
|
|
append line [format "%9.4f " [tasSplit [eval $var]]]
|
|
appendMotor $np $var sc_$var
|
|
lappend storedvars $var
|
|
|
|
}
|
|
|
|
|
|
append line [format "%8d " [tasSplit [counter getmonitor 1]]]
|
|
append line [format "%8d " [tasSplit [counter getmonitor 2]]]
|
|
append line [format "%8.2f " [tasSplit [counter gettime]]]
|
|
append line [format "%8d " [tasSplit [counter getcounts]]]
|
|
clientput $line
|
|
|
|
appendCount $np [tasSplit [counter getcounts]] counts
|
|
appendCount $np [tasSplit [counter getmonitor 1]] cter_01
|
|
appendCount $np [tasSplit [counter getcounts]] cter_02
|
|
appendFloat $np motime [tasSplit [counter gettime]]
|
|
|
|
set varlist [list qh qk ql qm en ei ef a1 a2 a3 a4 a5 a6 sgu sgl]
|
|
|
|
foreach var $varlist {
|
|
if {[lsearch $storedvars $var] < 0} {
|
|
appendMotor $np $var sc_${var}
|
|
}
|
|
}
|
|
|
|
if {$np == 0} {
|
|
makeTASLinks
|
|
}
|
|
|
|
nxscript close
|
|
}
|
|
#====================== actual XML stuff ============================
|
|
proc writeUserData {} {
|
|
writeTextVar usnam user
|
|
writeTextVar usaff affiliation
|
|
writeTextVar usadd address
|
|
writeTextVar usmail email
|
|
writeTextVar lonam local
|
|
}
|
|
#-------------------------------------------------------------------
|
|
proc writeMonochromator {} {
|
|
global __tasdata
|
|
nxscript puttext mono_type "Pyrolytic Graphite"
|
|
appendMotor 0 mcv sc_mcv
|
|
nxscript putfloat mono_dd [tasSplit [tasub mono dd]]
|
|
}
|
|
#-------------------------------------------------------------------
|
|
proc writeAnalyzer {} {
|
|
global __tasdata
|
|
nxscript puttext ana_type "Pyrolytic Graphite"
|
|
nxscript putfloat ana_dd [tasSplit [tasub ana dd]]
|
|
set sa [tasSplit [tasub ss]]
|
|
if {$sa == 1} {
|
|
set az 0.
|
|
} else {
|
|
set az 180.
|
|
}
|
|
nxscript putfloat ana_az $az
|
|
}
|
|
#-------------------------------------------------------------------
|
|
proc writeDetector {} {
|
|
global __tasdata
|
|
set sa [tasSplit [tasub ana ss]]
|
|
if {$sa == 1} {
|
|
set az 0.
|
|
} else {
|
|
set az 180.
|
|
}
|
|
nxscript putfloat det_az $az
|
|
}
|
|
#-------------------------------------------------------------------
|
|
proc writeMonitor {} {
|
|
nxscript putcounter cter counter
|
|
}
|
|
#-----------------------------------------------------------------
|
|
proc writeSample {} {
|
|
global __tasdata
|
|
tasscan nxdump nxscript sa
|
|
writeTextVar sanam sample
|
|
set sa [tasSplit [tasub mono ss]]
|
|
if {$sa == 1} {
|
|
set az 0.
|
|
} else {
|
|
set az 180.
|
|
}
|
|
nxscript putfloat saaz $az
|
|
}
|
|
#-----------------------------------------------------------------
|
|
proc writePowderSample {} {
|
|
global __tasdata
|
|
tasscan nxdump nxscript sa
|
|
writeTextVar sanam sample
|
|
set sa [tasSplit [tasub mono ss]]
|
|
if {$sa == 1} {
|
|
set az 0.
|
|
} else {
|
|
set az 180.
|
|
}
|
|
nxscript putfloat saaz $az
|
|
}
|
|
#------------------------------------------------------------------
|
|
proc makeTASLinks {} {
|
|
nxscript makelink dana sc_ei
|
|
nxscript makelink dana sc_ef
|
|
nxscript makelink dana sc_qh
|
|
nxscript makelink dana sc_qk
|
|
nxscript makelink dana sc_ql
|
|
nxscript makelink dana sc_en
|
|
nxscript makelink dana counts
|
|
}
|
|
#------------------------------------------------------------------
|
|
proc makePowderLinks {} {
|
|
nxscript makelink dana sc_ei
|
|
nxscript makelink dana sc_ef
|
|
nxscript makelink dana sc_qm
|
|
nxscript makelink dana sc_en
|
|
nxscript makelink dana counts
|
|
}
|
|
#-------------------------------------------------------------------
|
|
proc makeScanLinks {} {
|
|
set alreadyLinked [list sc_ei sc_ef sc_qh sc_qf sc_qk sc_en sc_qm]
|
|
set nscan [tasSplit [iscan noscanvar]]
|
|
set axis 0
|
|
for {set i 0} {$i < $nscan} {incr i } {
|
|
set varpar [iscan getvarpar $i]
|
|
set l [split $varpar =]
|
|
set var [lindex $l 0]
|
|
set idx [string first . $var]
|
|
set var [string range $var [expr $idx + 1] end]
|
|
set alias [format "sc_%s" [string trim $var]]
|
|
set testalias [string trim [tasSplit [nxscript isalias $alias]]]
|
|
if {[lsearch $alreadyLinked $alias] < 0} {
|
|
if {$testalias == 1} {
|
|
nxscript makelink dana $alias
|
|
}
|
|
}
|
|
if {$axis == 0} {
|
|
set step [string trim [lindex $l 2]]
|
|
if {abs($step) > .001} {
|
|
if {$testalias == 1} {
|
|
nxscript putattribute $alias axis 1
|
|
set axis 1
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# if axis = 0 there is no alias; so we create something in here from the
|
|
# scan data in iscan
|
|
if {$axis == 0} {
|
|
set data [tasSplit [iscan getvardata 0]]
|
|
set count 0
|
|
foreach e $data {
|
|
set ar($count) [string trim $e]
|
|
incr count
|
|
}
|
|
nxscript putarray danascanvar ar [llength $data]
|
|
}
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc xmltaswrite {obj userobj} {
|
|
global home __tasdata
|
|
|
|
set fil [string trim [tasSplit [iscan getfile]]]
|
|
nxscript createxml $fil $home/tasub.dic
|
|
set __tasdata(file) $fil
|
|
|
|
writeTextVar etitle title
|
|
nxscript puttext estart $__tasdata(starttime)
|
|
nxscript puttext eend [sicstime]
|
|
nxscript puttext edef NXmonotas
|
|
nxscript putglobal file_name $fil
|
|
nxscript putglobal file_time [sicstime]
|
|
|
|
nxscript updatedictvar NP [tasSplit [iscan np]]
|
|
nxscript updatedictvar INSTRUMENT [tasSplit [instrument]]
|
|
|
|
writeUserData
|
|
|
|
writeMonochromator
|
|
|
|
writeMonitor
|
|
|
|
writeSample
|
|
|
|
writeAnalyzer
|
|
|
|
writeDetector
|
|
|
|
|
|
nxscript close
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc xmlpowderwrite {obj userobj} {
|
|
global home __tasdata
|
|
|
|
set fil [string trim [tasSplit [iscan getfile]]]
|
|
nxscript createxml $fil $home/tasub.dic
|
|
set __tasData(file) $fil
|
|
|
|
writeTextVar etitle title
|
|
nxscript puttext estart $__tasdata(starttime)
|
|
nxscript puttext eend [sicstime]
|
|
nxscript puttext edef NXmonotas
|
|
nxscript putglobal file_name $fil
|
|
nxscript putglobal file_time [sicstime]
|
|
|
|
nxscript updatedictvar NP [tasSplit [iscan np]]
|
|
nxscript updatedictvar INSTRUMENT [tasSplit [instrument]]
|
|
|
|
writeUserData
|
|
|
|
writeMonochromator
|
|
|
|
writeMonitor
|
|
|
|
writePowderSample
|
|
|
|
writeAnalyzer
|
|
|
|
writeDetector
|
|
|
|
makePowderLinks
|
|
|
|
nxscript close
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc xmlfinish {obj userobj} {
|
|
}
|
|
#----------------------------------------------------------------------
|
|
proc initxmlscan {} {
|
|
iscan configure script
|
|
iscan function writeheader donothing
|
|
iscan function prepare xmlprepare
|
|
iscan function drive tasscan drive
|
|
iscan function count tasscan count
|
|
iscan function collect tasscan collect
|
|
iscan function writepoint xmlwritepoint
|
|
iscan function finish xmlfinish
|
|
}
|