80 lines
2.3 KiB
Tcl
80 lines
2.3 KiB
Tcl
#---------------------------------------------------------------------------
|
|
# The first step when doing a four circle experiment is to search
|
|
# reflections manually. When some have been found a UB-matrix calculation
|
|
# can be tried. In between it is necessary to keep a list of peak positons
|
|
# found and to write them to file. This is exactly what this is for.
|
|
#
|
|
# Mark Koennecke, October 1998
|
|
#---------------------------------------------------------------------------
|
|
|
|
#----- where data files shall go by default
|
|
set prefix ./
|
|
|
|
#--------------------------------------------------------------------------
|
|
proc iiGetNum { text } {
|
|
set list [split $text =]
|
|
return [lindex $list 1]
|
|
}
|
|
|
|
#------------ clear everything
|
|
proc iiinit {} {
|
|
global iiref
|
|
set iiref(np) 0
|
|
set iiref(OM) ""
|
|
set iiref(TH) ""
|
|
set iiref(CH) ""
|
|
set iiref(PH) ""
|
|
set iiref(title) ""
|
|
}
|
|
#------- run this once when loading in order to empty space
|
|
iiinit
|
|
#------------------- store
|
|
proc iistore {} {
|
|
global iiref
|
|
incr iiref(np)
|
|
lappend iiref(OM) [iiGetNum [OM]]
|
|
lappend iiref(TH) [iiGetNum [TH]]
|
|
lappend iiref(CH) [iiGetNum [CH]]
|
|
lappend iiref(PH) [iiGetNum [PH]]
|
|
lappend iiref(title) [iiGetNum [title]]
|
|
}
|
|
#------------- write to file
|
|
proc iiwrite {fil} {
|
|
global iiref
|
|
global prefix
|
|
set fd [open $prefix/$fil w]
|
|
for {set i 0} {$i < $iiref(np)} { incr i } {
|
|
set om [lindex $iiref(OM) $i]
|
|
set th [lindex $iiref(TH) $i]
|
|
set ch [lindex $iiref(CH) $i]
|
|
set ph [lindex $iiref(PH) $i]
|
|
set tt [lindex $iiref(title) $i]
|
|
puts $fd [format "%8.2f %8.2f %8.2f %8.2f %d %s" $th $om $ch $ph $i $tt]
|
|
}
|
|
close $fd
|
|
}
|
|
#------------------- the actual control implementation function
|
|
proc rliste args {
|
|
if {[llength $args] < 1} {
|
|
error "ERROR: keyword expected to rliste"
|
|
}
|
|
switch [lindex $args 0] {
|
|
"clear" {
|
|
iiinit
|
|
return
|
|
}
|
|
"store" {
|
|
iistore
|
|
}
|
|
"write" {
|
|
if { [llength $args] < 2 } {
|
|
error "ERROR: expected filename after write"
|
|
}
|
|
iiwrite [lindex $args 1]
|
|
}
|
|
default {
|
|
error "ERROR: keyword [lindex $args 0] not recognized"
|
|
}
|
|
}
|
|
}
|