Files
sicspsi/utils/check/tricscheck
cvs e6c51e8fe9 - Fixed missalignment in TAS scan messages
- Fixed a counting/driving race in devexec
- Fixed some problems with sanscheck
2003-11-25 10:29:22 +00:00

289 lines
8.7 KiB
Tcl
Executable File

#! /bin/sh
#next line is executed by sh, not by Tcl \
exec tclsh $0 ${1+"$@"}
#--------------------------------------------------------------------------
# This is the SICS syntax checker for the TRICS
#
# Mark Koennecke, March 2003
#--------------------------------------------------------------------------
source /data/lnslib/bin/sicscheck/sicssyntaxlib.tcl
#------------ define TRICS motors and aliases
sicsSyntaxMap momu syntaxMotor
sicsSyntaxMap mtvu syntaxMotor
sicsSyntaxMap mtpu syntaxMotor
sicsSyntaxMap mgvu syntaxMotor
sicsSyntaxMap mgpu syntaxMotor
sicsSyntaxMap mcvu syntaxMotor
sicsSyntaxMap moml syntaxMotor
sicsSyntaxMap mtvl syntaxMotor
sicsSyntaxMap mtpl syntaxMotor
sicsSyntaxMap mgvl syntaxMotor
sicsSyntaxMap mcvl syntaxMotor
sicsSyntaxMap mexz syntaxMotor
sicsSyntaxMap cex1 syntaxMotor
sicsSyntaxMap som syntaxMotor
sicsSyntaxMap stt syntaxMotor
sicsSyntaxMap sch syntaxMotor
sicsSyntaxMap sph syntaxMotor
sicsSyntaxMap dg1 syntaxMotor
sicsSyntaxMap dg2 syntaxMotor
sicsSyntaxMap dg3 syntaxMotor
sicsSyntaxMap a17 syntaxMotor
sicsSyntaxMap a18 syntaxMotor
sicsSyntaxMap a1 syntaxMotor
sicsSyntaxMap a12 syntaxMotor
sicsSyntaxMap a13 syntaxMotor
sicsSyntaxMap a14 syntaxMotor
sicsSyntaxMap a15 syntaxMotor
sicsSyntaxMap a16 syntaxMotor
sicsSyntaxMap b1 syntaxMotor
sicsSyntaxMap a22 syntaxMotor
sicsSyntaxMap a23 syntaxMotor
sicsSyntaxMap a24 syntaxMotor
sicsSyntaxMap a25 syntaxMotor
sicsSyntaxMap a26 syntaxMotor
sicsSyntaxMap a37 syntaxMotor
sicsSyntaxMap a3 syntaxMotor
sicsSyntaxMap om syntaxMotor
sicsSyntaxMap a4 syntaxMotor
sicsSyntaxMap th syntaxMotor
sicsSyntaxMap a10 syntaxMotor
sicsSyntaxMap a20 syntaxMotor
sicsSyntaxMap ch syntaxMotor
sicsSyntaxMap chi syntaxMotor
sicsSyntaxMap ph syntaxMotor
sicsSyntaxMap a31 syntaxMotor
sicsSyntaxMap a32 syntaxMotor
sicsSyntaxMap a33 syntaxMotor
sicsSyntaxMap phi syntaxMotor
sicsSyntaxMap muca syntaxMotor
#------------ define TRICS counters
sicsSyntaxMap counter syntaxCounter
sicsSyntaxMap hm1 syntaxHM
sicsSyntaxMap hm2 syntaxHM
sicsSyntaxMap hm3 syntaxHM
#------------ define TRICS variables
sicsSyntaxMap title syntaxTextPar
sicsSyntaxMap user syntaxTextPar
sicsSyntaxMap adres syntaxTextPar
sicsSyntaxMap collimation syntaxTextPar
sicsSyntaxMap sample syntaxTextPar
sicsSyntaxMap comment1 syntaxTextPar
sicsSyntaxMap comment2 syntaxTextPar
sicsSyntaxMap comment3 syntaxTextPar
sicsSyntaxMap fax syntaxTextPar
sicsSyntaxMap email syntaxTextPar
sicsSyntaxMap sample syntaxTextPar
#----------- define TRICS environment
sicsSyntaxMap temperature evSyntax
sicsSyntaxMap tt evSyntax
#---------- define TRICS auxiliary
proc xbu {fname} {
fileeval $fname
}
proc exe {fname} {
fileeval $fname
}
proc do {fname} {
fileeval $fname
}
sicsSyntaxMap o2t syntaxNumPar
sicsSyntaxMap four syntaxTextPar
sicsSyntaxMap hmc hmcSyntax
sicsSyntaxMap hkl syntaxHKL
sicsSyntaxMap opti optiSyntax
sicsSyntaxMap rliste syntaxWarn
#-------------------------------------------------------------------------
# TRICS uses a couple of special scan commands with a special common
# syntax. This is defined here.
#-----------------------------------------------------------------------
proc tttscan { var start delta np {mode NULL} {preset NULL} } {
if { [syntaxNumeric $start] != 1} {
error "ERROR: $start is no number, expected scan start"
}
if { [syntaxNumeric $delta] != 1} {
error "ERROR: $delta is no number, expected scan step"
}
if { [syntaxNumeric $np] != 1} {
error "ERROR: $np is no number, expected scan noPoints"
}
if { [string compare $preset NULL] != 0 } {
if { [syntaxNumeric $preset] != 1} {
error "ERROR: $preset is no number, expected scan preset"
}
}
if { [string compare $mode NULL] != 0 } {
set mode [string trim [string tolower $mode]]
if { [syntaxCounterMode $mode] != 1} {
error "ERROR: $mode is no valid count mode!"
}
}
syntaxLimit $var $start
syntaxLimit $var [expr $start + $np*$delta]
}
proc tricsscan {start step np {mode NULL} {preset NULL} } {
tttscan om $start $step $np $mode $preset
}
proc detscan {start step np {mode NULL} {preset NULL} } {
tttscan stt $start $step $np $mode $preset
}
proc phscan {start step np {mode NULL} {preset NULL} } {
tttscan ph $start $step $np $mode $preset
}
#----------------------------------------------------------------------
# psdrefscan syntax. I wonder if anyone is using this........
#-----------------------------------------------------------------------
proc psdrefscan {filename step {mode NULL} {preset NULL}} {
if { [syntaxNumeric $step] != 1} {
error "ERROR: $step is no number, expected scan step"
}
if { [syntaxNumeric $np] != 1} {
error "ERROR: $np is no number, expected scan noPoints"
}
if { [string compare $preset NULL] != 0 } {
if { [syntaxNumeric $preset] != 1} {
error "ERROR: $preset is no number, expected scan preset"
}
}
if { [string compare $mode NULL] != 0 } {
set mode [string trim [string tolower $mode]]
if { [syntaxCountMode $mode] != 1} {
error "ERROR: $mode is no valid count mode!"
}
}
}
#----------------------------------------------------------------------
# mess measures a whole file with reflections
#----------------------------------------------------------------------
lappend messKey start file nb bi close writereflection
proc mess args {
global messKey sicsPar
if { [llength $args] < 1} {
error "ERROR: need subcommand to mess"
}
set subcommand [string trim [string tolower [lindex $args 0]]]
if { [lsearch $messKey $subcommand] >= 0} {
return
}
switch $subcommand {
preset -
np -
step -
compact {
if { [llength $args] > 1} {
set val [lindex $args 1]
if { [syntaxNumeric $val] != 1} {
error \
"ERROR: expected numeric par to $subcommand, got $val"
}
set sicsPar(mess.$subcommand) $val
} else {
return [syntaxGet mess.$subcommand]
}
}
mode -
countmode {
if { [llength $args] > 1} {
set val [lindex $args 1]
if { [syntaxCounterMode $val] != 1} {
error ERROR: expected counter mode, got $val
}
set sicsPar(mess.mode) $val
} else {
return [syntaxGet mess.mode]
}
}
reopen -
genlist -
measure {
if { [llength $args] < 2} {
error "ERROR: no filename to process for $subcommand"
}
}
default {
error "ERROR: subcommand $subcommand to mess not known"
}
}
}
#-------------------------------------------------------------------------
# The local maximum search command
#------------------------------------------------------------------------
lappend lomaPar window threshold steepness cogwindow cogcontour
proc lomax args {
global lomaPar sicsPar
if { [llength $args] < 1} {
error "ERROR: need subcommand to lomax"
}
set subcommand [string trim [string tolower [lindex $args 0]]]
if { [lsearch $lomaPar $subcommand] >= 0} {
if { [llength $args] > 1} {
set val [lindex $args 1]
if { [syntaxNumeric $val] != 1} {
error "ERROR: expected numeric arg to $subcommand, got $val"
}
set sicsPar(lomax.$subcommand) $val
} else {
return [syntaxGet lomax.$subcommand]
}
}
switch $subcommand {
stat -
search {
if { [llength $args] < 2} {
error "ERROR: need a hm to $subcommand"
}
set p [string trim [string tolower [lindex $args 1]]]
set ret [catch {info body $p} msg]
if { $ret != 0 } {
error [format "ERROR: no %s to $subcommand found" $p]
}
}
cog {
if { [llength $args] < 4} {
error "ERROR: not enough arguments to lomax cog"
}
set p [string trim [string tolower [lindex $args 1]]]
set ret [catch {info body $p} msg]
if { $ret != 0 } {
error [format "ERROR: no %s to calc COG fromfound" $p]
}
for {set i 2} {$i < [llength $args]} {incr i} {
set val [lindex $args $i]
if { [syntaxNumeric $val] != 1} {
error "ERROR: expected numeric par to cog, got $val"
}
}
}
default {
error "ERROR: subcommand $subcommand to lomax not known"
}
}
}
#--------------------------- main program --------------------------------
syntaxLoadSICS /data/lnslib/data/TRICS/2003/tricsstatus.tcl
#puts stdout [array names sicsPar]
if { $argc < 1} {
puts stdout "Usage: \n\ttricscheck filename"
exit 0
}
set filename [lindex $argv 0]
lappend fileList [file tail $filename]
puts stdout "Syntax checking --> $filename <-- ........."
source $filename
puts stdout "If this completed without errors the likelihoof of your script"
puts stdout "executing properly on the instrument has increased significantly"
exit 1