- A syntax checker for SICS was implemented
This commit is contained in:
cvs
68
mumo.c
68
mumo.c
@ -13,6 +13,10 @@
|
||||
|
||||
heavily reworked and simplified, Mark Koennecke, June 1997
|
||||
|
||||
added: defpos, recovernampos and made mumo save named positions
|
||||
to the backup file. Mark Koennecke, March 2003
|
||||
|
||||
|
||||
Copyright:
|
||||
|
||||
Labor fuer Neutronenstreuung
|
||||
@ -59,6 +63,28 @@
|
||||
#include "stringdict.h"
|
||||
#include "mumo.h"
|
||||
#include "mumo.i"
|
||||
/*-------------------------------------------------------------------------*/
|
||||
static int SaveMumo(void *pData, char *name, FILE *fd)
|
||||
{
|
||||
pMulMot self = NULL;
|
||||
char pCommand[512];
|
||||
const char *pName = NULL;
|
||||
|
||||
self = (pMulMot)pData;
|
||||
if(self == NULL)
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
fprintf(fd,"#----- MultiMotor %s\n", name);
|
||||
while((pName = StringDictGetNext(self->pNamPos,pCommand, 511)) != NULL)
|
||||
{
|
||||
if(strcmp(pName,"back") != 0)
|
||||
{
|
||||
fprintf(fd,"%s recovernampos %s %s\n",name,pName,pCommand);
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
/*--------------------------------------------------------------------------*/
|
||||
pMulMot MakeMultiMotor(void)
|
||||
{
|
||||
@ -88,12 +114,13 @@
|
||||
free(pNew);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
pNew->pDes->SaveStatus = SaveMumo;
|
||||
|
||||
/* the parameter array */
|
||||
pNew->pParam = ObParCreate(1);
|
||||
ObParInit(pNew->pParam,ACCESS,"accesscode",usUser,usMugger);
|
||||
|
||||
|
||||
pNew->name = NULL;
|
||||
return pNew;
|
||||
}
|
||||
@ -162,6 +189,7 @@
|
||||
#define NAMALL 12
|
||||
#define LIST 13
|
||||
#define DEFPOS 14
|
||||
#define RECOVERNAMPOS 15
|
||||
/*-------------------------------------------------------------------------*/
|
||||
static int GetNextToken(psParser self, pMulMot pDings)
|
||||
{
|
||||
@ -289,6 +317,11 @@
|
||||
self->iCurrentToken = DEFPOS;
|
||||
return DEFPOS;
|
||||
}
|
||||
else if(strcmp(self->Token,"recovernampos") ==0)
|
||||
{
|
||||
self->iCurrentToken = RECOVERNAMPOS;
|
||||
return RECOVERNAMPOS;
|
||||
}
|
||||
else
|
||||
{
|
||||
self->iCurrentToken = SYMBOL;
|
||||
@ -675,12 +708,24 @@
|
||||
iToken = GetNextToken(pPP,self);
|
||||
}
|
||||
|
||||
/* The rest of the stuff should be the motors to drive until
|
||||
we are there
|
||||
*/
|
||||
StringDictAddPair(self->pNamPos,namPos,command);
|
||||
return 1;
|
||||
}
|
||||
/*-----------------------------------------------------------------------*/
|
||||
static void RecoverNamPos(pMulMot self, int argc, char *argv[])
|
||||
{
|
||||
char pCommand[512];
|
||||
|
||||
Arg2Text(argc-1,&argv[1],pCommand, 511);
|
||||
if(StringDictExists(self->pNamPos,argv[0]))
|
||||
{
|
||||
StringDictUpdate(self->pNamPos,argv[0],pCommand);
|
||||
}
|
||||
else
|
||||
{
|
||||
StringDictAddPair(self->pNamPos,argv[0],pCommand);
|
||||
}
|
||||
}
|
||||
/*---------------------------------------------------------------------------
|
||||
MultiWrapper is the user interface to a multi motor unit. It supports the
|
||||
following syntax, where DingsBums is the name of the unit:
|
||||
@ -695,6 +740,9 @@
|
||||
name.
|
||||
DingsBums drop all - drops all named positions (except back)
|
||||
DingsBums list - lists all named positions.
|
||||
DingsBums recovernampos nam bla.... - internal command to recover
|
||||
saved named positions
|
||||
|
||||
|
||||
*/
|
||||
|
||||
@ -757,6 +805,7 @@
|
||||
if(iRet)
|
||||
{
|
||||
SCSendOK(pCon);
|
||||
SCparChange(pCon);
|
||||
return 1;
|
||||
}
|
||||
else
|
||||
@ -782,6 +831,7 @@
|
||||
}
|
||||
break;
|
||||
case DEFPOS:
|
||||
SCparChange(pCon);
|
||||
return ParseDefPos(pSics,&MyParser,self,pCon);
|
||||
break;
|
||||
case LIST:
|
||||
@ -816,6 +866,7 @@
|
||||
if((iToken == SYMBOL) || (iToken == NAMPOS))
|
||||
{
|
||||
MakeCurrentNamPos(MyParser.Token,pCon,self);
|
||||
SCparChange(pCon);
|
||||
return 1;
|
||||
}
|
||||
else
|
||||
@ -836,6 +887,7 @@
|
||||
}
|
||||
else
|
||||
{
|
||||
SCparChange(pCon);
|
||||
return ParseDropPos(&MyParser, pCon, self);
|
||||
}
|
||||
}
|
||||
@ -857,6 +909,14 @@
|
||||
sprintf(pError,"ERROR: Unknown Token %s",MyParser.Token);
|
||||
SCWrite(pCon,pError,eError);
|
||||
return 0;
|
||||
case RECOVERNAMPOS:
|
||||
/*
|
||||
This is not meant to be user command but a facility to read
|
||||
back data from sattus file. This is why the error checking
|
||||
is not happening
|
||||
*/
|
||||
RecoverNamPos(self,argc-2,&argv[2]);
|
||||
return 1;
|
||||
default:
|
||||
SCWrite(pCon,"ERROR: Parse Error",eError);
|
||||
return 0;
|
||||
|
||||
97
utils/check/amorcheck
Executable file
97
utils/check/amorcheck
Executable file
@ -0,0 +1,97 @@
|
||||
#! /bin/sh
|
||||
#next line is executed by sh, not by Tcl \
|
||||
exec tclsh $0 ${1+"$@"}
|
||||
#--------------------------------------------------------------------------
|
||||
# This is the SICS syntax checker for the AMOR reflectometer
|
||||
#
|
||||
# Mark Koennecke, March 2003
|
||||
#--------------------------------------------------------------------------
|
||||
source /data/koenneck/src/sics/utils/check/sicssyntaxlib.tcl
|
||||
|
||||
#------------ define AMOR motors and aliases
|
||||
sicsSyntaxMap ftz syntaxMotor
|
||||
sicsSyntaxMap fom syntaxMotor
|
||||
sicsSyntaxMap d1l syntaxMotor
|
||||
sicsSyntaxMap d1r syntaxMotor
|
||||
sicsSyntaxMap d1t syntaxMotor
|
||||
sicsSyntaxMap d1b syntaxMotor
|
||||
sicsSyntaxMap moz syntaxMotor
|
||||
sicsSyntaxMap mty syntaxMotor
|
||||
sicsSyntaxMap mom syntaxMotor
|
||||
sicsSyntaxMap mtz syntaxMotor
|
||||
sicsSyntaxMap d2l syntaxMotor
|
||||
sicsSyntaxMap d2r syntaxMotor
|
||||
sicsSyntaxMap d2t syntaxMotor
|
||||
sicsSyntaxMap d2b syntaxMotor
|
||||
sicsSyntaxMap d3l syntaxMotor
|
||||
sicsSyntaxMap d3r syntaxMotor
|
||||
sicsSyntaxMap d3t syntaxMotor
|
||||
sicsSyntaxMap d3b syntaxMotor
|
||||
sicsSyntaxMap stz syntaxMotor
|
||||
sicsSyntaxMap som syntaxMotor
|
||||
sicsSyntaxMap sch syntaxMotor
|
||||
sicsSyntaxMap soz syntaxMotor
|
||||
sicsSyntaxMap stb syntaxMotor
|
||||
sicsSyntaxMap d4l syntaxMotor
|
||||
sicsSyntaxMap d4r syntaxMotor
|
||||
sicsSyntaxMap d4t syntaxMotor
|
||||
sicsSyntaxMap d4b syntaxMotor
|
||||
sicsSyntaxMap aoz syntaxMotor
|
||||
sicsSyntaxMap aom syntaxMotor
|
||||
sicsSyntaxMap atz syntaxMotor
|
||||
sicsSyntaxMap d5l syntaxMotor
|
||||
sicsSyntaxMap d5r syntaxMotor
|
||||
sicsSyntaxMap d5t syntaxMotor
|
||||
sicsSyntaxMap d5b syntaxMotor
|
||||
sicsSyntaxMap coz syntaxMotor
|
||||
sicsSyntaxMap c3z syntaxMotor
|
||||
sicsSyntaxMap com syntaxMotor
|
||||
sicsSyntaxMap cox syntaxMotor
|
||||
|
||||
#------------ define AMOR counters
|
||||
sicsSyntaxMap counter syntaxCounter
|
||||
sicsSyntaxMap hm syntaxHM
|
||||
|
||||
#------------ define AMOR 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 AMOR environment
|
||||
sicsSyntaxMap temperature evSyntax
|
||||
sicsSyntaxMap tt evSyntax
|
||||
sicsSyntaxMap pby evSyntax
|
||||
sicsSyntaxMap aby evSyntax
|
||||
sicsSyntaxMap magnet evSyntax
|
||||
|
||||
#---------- define AMOR auxiliary
|
||||
sicsSyntaxMap dr syntaxDrive
|
||||
sicsSyntaxMap s2t syntaxNumPar
|
||||
sicsSyntaxMap o2t syntaxNumPar
|
||||
sicsSyntaxMap td syntaxNumPar
|
||||
sicsSyntaxMap aw syntaxNumPar
|
||||
sicsSyntaxMap shutter syntaxTextPar
|
||||
|
||||
#syntaxLoadSICS amorstatus.tcl
|
||||
#puts stdout [array names sicsPar]
|
||||
|
||||
if { $argc < 1} {
|
||||
puts stdout "Usage: \n\tamorcheck 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
|
||||
|
||||
68
utils/check/dmccheck
Executable file
68
utils/check/dmccheck
Executable file
@ -0,0 +1,68 @@
|
||||
#! /bin/sh
|
||||
#next line is executed by sh, not by Tcl \
|
||||
exec tclsh $0 ${1+"$@"}
|
||||
#--------------------------------------------------------------------------
|
||||
# This is the SICS syntax checker for the DMC powder diffractometer
|
||||
#
|
||||
# Mark Koennecke, March 2003
|
||||
#--------------------------------------------------------------------------
|
||||
source /data/koenneck/src/sics/utils/check/sicssyntaxlib.tcl
|
||||
|
||||
#------------------------- define DMC motors and aliases
|
||||
sicsSyntaxMap omegam syntaxMotor
|
||||
sicsSyntaxMap twothetam syntaxMotor
|
||||
sicsSyntaxMap monox syntaxMotor
|
||||
sicsSyntaxMap monoy syntaxMotor
|
||||
sicsSyntaxMap curvem syntaxMotor
|
||||
sicsSyntaxMap monophi syntaxMotor
|
||||
sicsSyntaxMap monochi syntaxMotor
|
||||
sicsSyntaxMap table syntaxMotor
|
||||
sicsSyntaxMap twothetad syntaxMotor
|
||||
sicsSyntaxMap a1 syntaxMotor
|
||||
sicsSyntaxMap a2 syntaxMotor
|
||||
sicsSyntaxMap a3 syntaxMotor
|
||||
sicsSyntaxMap a4 syntaxMotor
|
||||
sicsSyntaxMap a5 syntaxMotor
|
||||
sicsSyntaxMap a6 syntaxMotor
|
||||
sicsSyntaxMap a7 syntaxMotor
|
||||
sicsSyntaxMap a8 syntaxMotor
|
||||
sicsSyntaxMap a9 syntaxMotor
|
||||
|
||||
#------------ define DMC counters
|
||||
sicsSyntaxMap counter syntaxCounter
|
||||
sicsSyntaxMap banana syntaxHM
|
||||
|
||||
#------------ define DMC variables
|
||||
sicsSyntaxMap title syntaxTextPar
|
||||
sicsSyntaxMap user 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
|
||||
sicsSyntaxMap lambda syntaxNumPar
|
||||
|
||||
#----------- define DMC environment
|
||||
sicsSyntaxMap temperature evSyntax
|
||||
sicsSyntaxMap tt evSyntax
|
||||
|
||||
#---------- define DMC auxiliary
|
||||
sicsSyntaxMap beam syntaxDummy
|
||||
|
||||
#--------- Main checking stuff
|
||||
|
||||
if { $argc < 1} {
|
||||
puts stdout "Usage: \n\tdmccheck 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
|
||||
|
||||
82
utils/check/focuscheck
Executable file
82
utils/check/focuscheck
Executable file
@ -0,0 +1,82 @@
|
||||
#! /bin/sh
|
||||
#next line is executed by sh, not by Tcl \
|
||||
exec tclsh $0 ${1+"$@"}
|
||||
#--------------------------------------------------------------------------
|
||||
# This is the SICS syntax checker for the FOCUS TOF diffractometer
|
||||
#
|
||||
# Mark Koennecke, March 2003
|
||||
#--------------------------------------------------------------------------
|
||||
source /data/koenneck/src/sics/utils/check/sicssyntaxlib.tcl
|
||||
|
||||
#------------ define FOCUS motors and aliases
|
||||
sicsSyntaxMap mtt syntaxMotor
|
||||
sicsSyntaxMap msl syntaxMotor
|
||||
sicsSyntaxMap mth syntaxMotor
|
||||
sicsSyntaxMap mtx syntaxMotor
|
||||
sicsSyntaxMap mty syntaxMotor
|
||||
sicsSyntaxMap mgo syntaxMotor
|
||||
sicsSyntaxMap m1ch syntaxMotor
|
||||
sicsSyntaxMap m1cv syntaxMotor
|
||||
sicsSyntaxMap m2ch syntaxMotor
|
||||
sicsSyntaxMap m2cv syntaxMotor
|
||||
sicsSyntaxMap mex syntaxMotor
|
||||
sicsSyntaxMap som syntaxMotor
|
||||
sicsSyntaxMap sth syntaxMotor
|
||||
sicsSyntaxMap sph syntaxMotor
|
||||
sicsSyntaxMap theta syntaxMotor
|
||||
|
||||
sicsSyntaxMap a1 syntaxMotor
|
||||
sicsSyntaxMap a2 syntaxMotor
|
||||
|
||||
#------------ define FOCUS counters
|
||||
sicsSyntaxMap counter syntaxCounter
|
||||
sicsSyntaxMap hm syntaxHM
|
||||
|
||||
#------------ define FOCUS 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
|
||||
sicsSyntaxMap lambda syntaxNumPar
|
||||
|
||||
#----------- define FOCUS environment
|
||||
sicsSyntaxMap temperature evSyntax
|
||||
sicsSyntaxMap tt evSyntax
|
||||
|
||||
#---------- define FOCUS auxiliary
|
||||
sicsSyntaxMap fermispeed syntaxNumPar
|
||||
sicsSyntaxMap diskspeed syntaxNumPar
|
||||
sicsSyntaxMap ratio syntaxNumPar
|
||||
sicsSyntaxMap phase syntaxNumPar
|
||||
|
||||
sicsSyntaxMap shutter syntaxTextPar
|
||||
sicsSyntaxMap colli syntaxTextPar
|
||||
sicsSyntaxMap td syntaxNumPar
|
||||
sicsSyntaxMap aw syntaxNumPar
|
||||
sicsSyntaxMap helium syntaxDummy
|
||||
|
||||
sicsSyntaxMap mono syntaxDummy
|
||||
|
||||
#--------- Main checking stuff
|
||||
#syntaxLoadSICS focusstatus.tcl
|
||||
#puts stdout [array names sicsPar]
|
||||
|
||||
if { $argc < 1} {
|
||||
puts stdout "Usage: \n\tfocuscheck 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
|
||||
|
||||
85
utils/check/hrptcheck
Executable file
85
utils/check/hrptcheck
Executable file
@ -0,0 +1,85 @@
|
||||
#! /bin/sh
|
||||
#next line is executed by sh, not by Tcl \
|
||||
exec tclsh $0 ${1+"$@"}
|
||||
#--------------------------------------------------------------------------
|
||||
# This is the SICS syntax checker for the HRPT powder diffractometer
|
||||
#
|
||||
# Mark Koennecke, March 2003
|
||||
#--------------------------------------------------------------------------
|
||||
source /data/koenneck/src/sics/utils/check/sicssyntaxlib.tcl
|
||||
|
||||
#------------------------- define HRPT 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 som syntaxMotor
|
||||
sicsSyntaxMap stt syntaxMotor
|
||||
sicsSyntaxMap cex1 syntaxMotor
|
||||
sicsSyntaxMap cex2 syntaxMotor
|
||||
sicsSyntaxMap a1 syntaxMotor
|
||||
sicsSyntaxMap a3 syntaxMotor
|
||||
sicsSyntaxMap om syntaxMotor
|
||||
sicsSyntaxMap omega syntaxMotor
|
||||
sicsSyntaxMap a4 syntaxMotor
|
||||
sicsSyntaxMap th syntaxMotor
|
||||
sicsSyntaxMap b1 syntaxMotor
|
||||
sicsSyntaxMap a17 syntaxMotor
|
||||
sicsSyntaxMap a18 syntaxMotor
|
||||
sicsSyntaxMap a12 syntaxMotor
|
||||
sicsSyntaxMap a13 syntaxMotor
|
||||
sicsSyntaxMap a14 syntaxMotor
|
||||
sicsSyntaxMap a15 syntaxMotor
|
||||
sicsSyntaxMap a16 syntaxMotor
|
||||
sicsSyntaxMap a37 syntaxMotor
|
||||
sicsSyntaxMap a22 syntaxMotor
|
||||
sicsSyntaxMap a24 syntaxMotor
|
||||
sicsSyntaxMap a25 syntaxMotor
|
||||
sicsSyntaxMap a26 syntaxMotor
|
||||
#------------ define HRPT counters
|
||||
sicsSyntaxMap counter syntaxCounter
|
||||
sicsSyntaxMap banana syntaxHM
|
||||
|
||||
#------------ define HRPT variables
|
||||
sicsSyntaxMap title syntaxTextPar
|
||||
sicsSyntaxMap user 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
|
||||
sicsSyntaxMap lambda syntaxNumPar
|
||||
sicsSyntaxMap mtt syntaxNumPar
|
||||
|
||||
#----------- define HRPT environment
|
||||
sicsSyntaxMap temperature evSyntax
|
||||
sicsSyntaxMap tt evSyntax
|
||||
|
||||
#---------- define HRPT auxiliary
|
||||
sicsSyntaxMap beam syntaxDummy
|
||||
sicsSyntaxMap graphit syntaxTextPar
|
||||
#--------- Main checking stuff
|
||||
|
||||
if { $argc < 1} {
|
||||
puts stdout "Usage: \n\thrptcheck 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
|
||||
|
||||
118
utils/check/sanscheck
Executable file
118
utils/check/sanscheck
Executable file
@ -0,0 +1,118 @@
|
||||
#! /bin/sh
|
||||
#next line is executed by sh, not by Tcl \
|
||||
exec tclsh $0 ${1+"$@"}
|
||||
#--------------------------------------------------------------------------
|
||||
# This is the SICS syntax checker for the SANS small angle machine
|
||||
#
|
||||
# Mark Koennecke, March 2003
|
||||
#--------------------------------------------------------------------------
|
||||
source /data/koenneck/src/sics/utils/check/sicssyntaxlib.tcl
|
||||
|
||||
#------------------------- define SANS motors and aliases
|
||||
sicsSyntaxMap som syntaxMotor
|
||||
sicsSyntaxMap sax syntaxMotor
|
||||
sicsSyntaxMap say syntaxMotor
|
||||
sicsSyntaxMap saz syntaxMotor
|
||||
sicsSyntaxMap spos syntaxMotor
|
||||
sicsSyntaxMap mz syntaxMotor
|
||||
sicsSyntaxMap mom syntaxMotor
|
||||
sicsSyntaxMap gphi syntaxMotor
|
||||
sicsSyntaxMap gtheta syntaxMotor
|
||||
sicsSyntaxMap gomega syntaxMotor
|
||||
sicsSyntaxMap detectorx syntaxMotor
|
||||
sicsSyntaxMap detectory syntaxMotor
|
||||
sicsSyntaxMap detectorrotation syntaxMotor
|
||||
sicsSyntaxMap beamstopy syntaxMotor
|
||||
sicsSyntaxMap beamstopx syntaxMotor
|
||||
|
||||
#------------ multimotors and their aliases
|
||||
sicsSyntaxMap emagnetsampleholder mumoSyntax
|
||||
set sicsPar(emagnetsampleholder.alias) [list z om]
|
||||
set sicsPar(emagnetsampleholder.nampos) [list back]
|
||||
|
||||
sicsSyntaxMap msh mumoSyntax
|
||||
set sicsPar(msh.alias) [list z om]
|
||||
set sicsPar(msh.nampos) [list back]
|
||||
|
||||
sicsSyntaxMap cryomagnetsampleholder mumoSyntax
|
||||
set sicsPar(cryomagnetsampleholder.alias) [list phi theta omega]
|
||||
set sicsPar(cryomagnetsampleholder.nampos) [list back]
|
||||
|
||||
sicsSyntaxMap cryo mumoSyntax
|
||||
set sicsPar(cryo.alias) [list phi theta omega]
|
||||
set sicsPar(cryo.nampos) [list back]
|
||||
|
||||
sicsSyntaxMap sampletable mumoSyntax
|
||||
set sicsPar(sampletable.alias) [list omega x y z posi]
|
||||
set sicsPar(sampletable.nampos) [list back]
|
||||
|
||||
sicsSyntaxMap detector mumoSyntax
|
||||
set sicsPar(detector.alias) [list x y phi]
|
||||
set sicsPar(detector.nampos) [list back]
|
||||
|
||||
sicsSyntaxMap dt mumoSyntax
|
||||
set sicsPar(dt.alias) [list x y phi]
|
||||
set sicsPar(dt.nampos) [list back]
|
||||
|
||||
sicsSyntaxMap beamstop mumoSyntax
|
||||
set sicsPar(beamstop.alias) [list x y]
|
||||
set sicsPar(beamstop.nampos) [list back]
|
||||
|
||||
sicsSyntaxMap bs mumoSyntax
|
||||
set sicsPar(bs.alias) [list x y]
|
||||
set sicsPar(bs.nampos) [list back]
|
||||
|
||||
#------------ define SANS counters
|
||||
sicsSyntaxMap counter syntaxCounter
|
||||
sicsSyntaxMap banana syntaxHM
|
||||
|
||||
#------------ define SANS variables
|
||||
sicsSyntaxMap title syntaxTextPar
|
||||
sicsSyntaxMap user 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
|
||||
sicsSyntaxMap lambda syntaxNumPar
|
||||
sicsSyntaxMap nvs syntaxNumPar
|
||||
|
||||
#----------- define SANS environment
|
||||
sicsSyntaxMap temperature evSyntax
|
||||
sicsSyntaxMap tt evSyntax
|
||||
|
||||
|
||||
|
||||
#---------- define SANS auxiliary
|
||||
sicsSyntaxMap beam syntaxDummy
|
||||
sicsSyntaxMap detemp syntaxDummy
|
||||
sicsSyntaxMap temp2 syntaxDummy
|
||||
sicsSyntaxMap temp3 syntaxDummy
|
||||
sicsSyntaxMap temp4 syntaxDummy
|
||||
sicsSyntaxMap coll syntaxNumPar
|
||||
sicsSyntaxMap att syntaxNumPar
|
||||
sicsSyntaxMap shutter syntaxTextPar
|
||||
sicsSyntaxMap bschange syntaxNumPar
|
||||
sicsSyntaxMap qrange syntaxNumPar
|
||||
sicsSyntaxMap bsin syntaxDummy
|
||||
sicsSyntaxMap bsout syntaxDummy
|
||||
|
||||
#--------- Main checking stuff
|
||||
|
||||
if { $argc < 1} {
|
||||
puts stdout "Usage: \n\tsanscheck 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
|
||||
|
||||
|
||||
|
||||
@ -66,13 +66,75 @@ proc syntaxCounterMode {par} {
|
||||
default { return 0}
|
||||
}
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
# syntaxLoadSICS loads a SICS status file. The trick is to ignore all
|
||||
# errors because the syntax checker may not have all commands implemented
|
||||
#-------------------------------------------------------------------------
|
||||
proc syntaxLoadSICS {fname} {
|
||||
set f [open $fname r]
|
||||
while { [gets $f line] > 0} {
|
||||
set ret [catch {eval $line} msg]
|
||||
# if { $ret != 0} {
|
||||
# puts stdout "ERROR in: $line"
|
||||
# }
|
||||
}
|
||||
close $f
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
# syntaxLimit checks if a parameter violates a limit
|
||||
#------------------------------------------------------------------------
|
||||
proc syntaxLimit {var val} {
|
||||
global sicsPar
|
||||
|
||||
#-------- fixed?
|
||||
if { [info exists sicsPar($var.fixed)] } {
|
||||
set lim $sicsPar($var.fixed)
|
||||
if { $lim > 0 } {
|
||||
error "ERROR: $var is fixed"
|
||||
}
|
||||
}
|
||||
|
||||
#--------- lower limit?
|
||||
set lim shit
|
||||
if { [info exists sicsPar($var.softlowerlim)] } {
|
||||
set lim $sicsPar($var.softlowerlim)
|
||||
}
|
||||
if { [info exists sicsPar($var.lowerlimit)] } {
|
||||
set lim $sicsPar($var.lowerlimit)
|
||||
}
|
||||
if { [syntaxNumeric $lim] == 1} {
|
||||
if { $val < $lim} {
|
||||
error "ERROR: lower limit $lim violated by $val for $var"
|
||||
}
|
||||
}
|
||||
#------------ upper limit?
|
||||
set lim shit
|
||||
if { [info exists sicsPar($var.softupperlim)] } {
|
||||
set lim $sicsPar($var.softupperlim)
|
||||
}
|
||||
if { [info exists sicsPar($var.upperlimit)] } {
|
||||
set lim $sicsPar($var.upperlimit)
|
||||
}
|
||||
if { [syntaxNumeric $lim] == 1} {
|
||||
if { $val > $lim} {
|
||||
error "ERROR: upper limit $lim violated by $val for $var"
|
||||
}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# syntaxDummy is a syntax checking procedure which does nothing. This is a
|
||||
# quick fix for SICS commands for which no syntax checking procedure has yet
|
||||
# been defined.
|
||||
#-------------------------------------------------------------------------
|
||||
proc syntaxDummy {name args} {
|
||||
set args [syntaxListify $args]
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# syntaxWarn is a syntax checking procedure which does nothing. This is a
|
||||
# quick fix for SICS commands for which no syntax checking procedure has not
|
||||
# yet been defined or makes no sense. This version wanrs about it.
|
||||
#-------------------------------------------------------------------------
|
||||
proc syntaxWarn {name args} {
|
||||
puts stdout "INFO: Syntax for $name not checked"
|
||||
return
|
||||
}
|
||||
#-----------------------------------------------------------------------
|
||||
@ -113,12 +175,12 @@ proc syntaxNumPar {name args} {
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# syntaxMotor handles the syntax for a SICS motor
|
||||
# syntaxMtor handles the syntax for a SICS motor
|
||||
#-------------------------------------------------------------------------
|
||||
lappend motSubKey list reset interest uninterest position hardposition
|
||||
lappend motSub hardlowerlim hardupperlim softlowerlim
|
||||
lappend motSub softupperlim softzero fixed interruptmode precision
|
||||
lappend motSub accessmode sign failafter
|
||||
lappend motSub accessmode sign failafter accesscode
|
||||
|
||||
proc syntaxMotor {name args} {
|
||||
global sicsPar motSub motSubKey
|
||||
@ -154,15 +216,836 @@ proc syntaxMotor {name args} {
|
||||
#---------------------------------------------------------------------------
|
||||
# syntaxCounter deals with the syntax for a single counter
|
||||
#---------------------------------------------------------------------------
|
||||
lappend cterKey interest uninterest stop send
|
||||
|
||||
proc syntaxCounter {name args} {
|
||||
global sicsPar motSub motSubKey
|
||||
global cterKey sicsPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args == 0} {
|
||||
if { [llength $args] == 0} {
|
||||
error [format "ERROR: subcommand expected to %s" $name]
|
||||
}
|
||||
#--------- get command
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
#------ test keyWords
|
||||
if { [lsearch $cterKey $subcommand] >= 0} {
|
||||
return
|
||||
}
|
||||
#------- the rest
|
||||
switch $subcommand {
|
||||
count -
|
||||
countnb {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to count/coutnb"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to count/countb"
|
||||
}
|
||||
return
|
||||
}
|
||||
getpreset {
|
||||
return [syntaxGet $name.preset]
|
||||
}
|
||||
getexponent {
|
||||
return [syntaxGet $name.exponent]
|
||||
}
|
||||
gettime {
|
||||
return [format "%s.time = 77" $name]
|
||||
}
|
||||
getcounts {
|
||||
return [format "%s.counts = {77 77 77 77 77}" $name]
|
||||
}
|
||||
getthreshold {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to getthreshold"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to getthreshold"
|
||||
}
|
||||
return [syntaxGet $name.threshold]
|
||||
}
|
||||
getmonitor {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to getmonitor"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to getmonitor"
|
||||
}
|
||||
return "$name.monitor 1 = 77"
|
||||
}
|
||||
status {
|
||||
return "counter.status = 77 77 77"
|
||||
}
|
||||
setmode {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to getthreshold"
|
||||
}
|
||||
if { [syntaxCounterMode [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: invalid counter mode: %s" \
|
||||
[lindex $args 1]]
|
||||
}
|
||||
return
|
||||
}
|
||||
setpreset {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to setpreset"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to setpreset"
|
||||
}
|
||||
return
|
||||
}
|
||||
setexponent {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to setexponent"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to setexponent"
|
||||
}
|
||||
return
|
||||
}
|
||||
mode {
|
||||
if { [llength $args] <2} {
|
||||
return [syntaxGet $name.mode]
|
||||
} else {
|
||||
if { [syntaxCounterMode [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: invalid counter mode: %s" \
|
||||
[lindex $args 1]]
|
||||
}
|
||||
set sicsPar($name.mode) [lindex $args 1]
|
||||
return
|
||||
}
|
||||
}
|
||||
preset {
|
||||
if { [llength $args] <2} {
|
||||
return [syntaxGet $name.preset]
|
||||
} else {
|
||||
if { [syntaxNumeric [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: iexpected numeric preset, got : %s" \
|
||||
[lindex $args 1]]
|
||||
}
|
||||
set sicsPar($name.preset) [lindex $args 1]
|
||||
return
|
||||
}
|
||||
}
|
||||
getthreshold {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argument to getthreshold"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to getthreshold"
|
||||
}
|
||||
return "$name.threshold = 77"
|
||||
}
|
||||
setthreshold {
|
||||
if { [llength $args] < 3} {
|
||||
error "ERROR: missing argument to setthreshold"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 1]] == 0 } {
|
||||
error "ERROR: expected numeric argument to setthreshold"
|
||||
}
|
||||
if {[syntaxNumeric [lindex $args 2]] == 0 } {
|
||||
error "ERROR: expected numeric argument to setthreshold"
|
||||
}
|
||||
return
|
||||
}
|
||||
default {
|
||||
error "ERROR: subcommand $subcommand to counter not known"
|
||||
}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# The syntax handler for SICS histogram memories
|
||||
#--------------------------------------------------------------------------
|
||||
lappend hmKey count countf interest uninterest init countblock clearbin
|
||||
lappend hmConf dim0 dim1 binwidth rank overflowmode histmode xfac yfac
|
||||
lappend hmConf xfrac yfrac hmcomputer hmport counter init
|
||||
|
||||
proc syntaxHM {name args} {
|
||||
global hmKey hmConf sicsPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] == 0} {
|
||||
error [format "ERROR: subcommand expected to %s" $name]
|
||||
}
|
||||
#--------- get command
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
#------ test keyWords
|
||||
if { [lsearch $hmKey $subcommand] >= 0} {
|
||||
return
|
||||
}
|
||||
switch $subcommand {
|
||||
preset {
|
||||
if { [llength $args] <2} {
|
||||
return [syntaxGet $name.preset]
|
||||
} else {
|
||||
if { [syntaxNumeric [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: iexpected numeric preset, got : %s" \
|
||||
[lindex $args 1]]
|
||||
}
|
||||
set sicsPar($name.preset) [lindex $args 1]
|
||||
return
|
||||
}
|
||||
}
|
||||
exponent {
|
||||
if { [llength $args] <2} {
|
||||
return [syntaxGet $name.exponent]
|
||||
} else {
|
||||
if { [syntaxNumeric [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: expected numeric exponent, got : %s"\
|
||||
[lindex $args 1]]
|
||||
}
|
||||
set sicsPar($name.exponent) [lindex $args 1]
|
||||
return
|
||||
}
|
||||
}
|
||||
countmode -
|
||||
mode {
|
||||
if { [llength $args] <2} {
|
||||
return [syntaxGet $name.mode]
|
||||
} else {
|
||||
if { [syntaxCounterMode [lindex $args 1]] == 0} {
|
||||
error [format "ERROR: invalid counter mode: %s" \
|
||||
[lindex $args 1]]
|
||||
}
|
||||
set sicsPar($name.mode) [lindex $args 1]
|
||||
return
|
||||
}
|
||||
}
|
||||
get -
|
||||
uuget -
|
||||
zipget {
|
||||
for { set i 1} { $i < [llength $args]} {incr i} {
|
||||
if { [syntaxNumeric [lindex $args $i]] == 0} {
|
||||
error \
|
||||
[format "ERROR: expected numeric hm argument, got %s"\
|
||||
[lindex $args $i]]
|
||||
|
||||
}
|
||||
}
|
||||
return
|
||||
}
|
||||
genbin {
|
||||
if { [llength $args] < 4 } {
|
||||
error "ERROR: insufficient number of argument to hm genbin"
|
||||
}
|
||||
for { set i 1} { $i < 4} { incr i} {
|
||||
if { [syntaxNumeric [lindex $args $i]] == 0} {
|
||||
error \
|
||||
[format "ERROR: expected numeric hm argument, got %s"\
|
||||
[lindex $args $i]]
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
notimebin {
|
||||
return "$name.notimebin = 77"
|
||||
}
|
||||
timebin {
|
||||
return "histogram.timebins = 77 77 77 77 77 77"
|
||||
}
|
||||
setbin {
|
||||
if { [llength $args] < 3 } {
|
||||
error "ERROR: insufficient number of argument to hm setbin"
|
||||
}
|
||||
for { set i 1} { $i < 3} { incr i} {
|
||||
if { [syntaxNumeric [lindex $args $i]] == 0} {
|
||||
error \
|
||||
[format "ERROR: expected numeric hm argument, got %s"\
|
||||
[lindex $args $i]]
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
sum {
|
||||
return
|
||||
}
|
||||
configure {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: insufficient number of arguments to hm configure"
|
||||
}
|
||||
set opt [string trim [string tolower [lindex $args 1]]]
|
||||
if { [lsearch $hmConf $opt] < 0} {
|
||||
error "ERROR: configuration option $opt not known"
|
||||
}
|
||||
return
|
||||
}
|
||||
default {
|
||||
error "ERROR: subcommand $subcommand to hm not known"
|
||||
}
|
||||
}
|
||||
}
|
||||
#-----------------------------------------------------------------------------
|
||||
# a syntax handler for environment controllers
|
||||
#-----------------------------------------------------------------------------
|
||||
lappend evKey send interest uninterest list
|
||||
lappend evPar tolerance access errorHandler interrupt upperlimit lowerlimit
|
||||
lappend evPar safevalue maxwait settle ramp
|
||||
|
||||
proc evSyntax {name args} {
|
||||
global sicsPar evKey evPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
#------ no subcommand: get value
|
||||
if { [llength $args] == 0} {
|
||||
return [syntaxGet $name]
|
||||
}
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
#-------- numeric subcommand: drive!
|
||||
if { [syntaxNumeric $subcommand] == 1} {
|
||||
set sicsPar($name) $subcommand
|
||||
return
|
||||
}
|
||||
#--------- keywords
|
||||
if { [lsearch $evKey $subcommand] >= 0} {
|
||||
return
|
||||
}
|
||||
#---------- parameters
|
||||
if { [lsearch $evPar $subcommand] < 0} {
|
||||
error [format "ERROR: evcontroller %s does not know subcommand %s" \
|
||||
$name $subcommand]
|
||||
} else {
|
||||
if { [llength $args] > 1 } {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxNumeric $val] == 0 } {
|
||||
error [format "ERROR: %s.%s expected number, received %s" \
|
||||
$name $subcommand $val]
|
||||
} else {
|
||||
set sicsPar($name.$subcommand) $val
|
||||
}
|
||||
} else {
|
||||
return [syntaxGet $name.$subcommand]
|
||||
}
|
||||
}
|
||||
}
|
||||
#----------------------------------------------------------------------------
|
||||
# the syntax drive command
|
||||
#---------------------------------------------------------------------------
|
||||
proc syntaxDrive {name args} {
|
||||
global sicsPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] < 2 } {
|
||||
error "insufficient number or arguments for $name"
|
||||
}
|
||||
for {set i 0} {$i < [llength $args]} {set i [expr $i + 2]} {
|
||||
set ret [catch {info body [lindex $args $i]} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to %s found" $name [lindex $args $i]]
|
||||
}
|
||||
if { [syntaxNumeric [lindex $args [expr $i + 1]]] != 1 } {
|
||||
error [format "ERROR: expected numeric %s target, got %s" \
|
||||
$name [lindex $args [expr $i +1]]]
|
||||
}
|
||||
syntaxLimit [lindex $args $i] [lindex $args [expr $i + 1]]
|
||||
set sicsPar([lindex $args $i]) [lindex $args [expr $i + 1]]
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# The syntax count command
|
||||
#--------------------------------------------------------------------------
|
||||
proc count { {mode NULL } { preset NULL } } {
|
||||
set m [string trim [string tolower $mode]]
|
||||
if { [string compare $m null] == 0} {
|
||||
return
|
||||
} else {
|
||||
if { [syntaxCounterMode $m] != 1 } {
|
||||
error "ERROR: invalid counter mode $m specified for count"
|
||||
}
|
||||
}
|
||||
set p [string trim [string tolower $preset]]
|
||||
if { [string compare $p null] == 0} {
|
||||
return
|
||||
} else {
|
||||
if {[syntaxNumeric $p] != 1 } {
|
||||
error "ERROR: count expected numeric preset, got $p"
|
||||
}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# The co command, same syntax as count though functionally different
|
||||
#---------------------------------------------------------------------------
|
||||
proc co { {mode NULL} {prest NULL} } {
|
||||
count $mode $prest
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# the syntax repeat command
|
||||
#---------------------------------------------------------------------------
|
||||
proc repeat { num {mode NULL} {preset NULL} } {
|
||||
if { [syntaxNumeric $num] != 1 } {
|
||||
error "ERROR: expected numeric repeat count, got $num"
|
||||
}
|
||||
set m [string trim [string tolower $mode]]
|
||||
if { [string compare $m null] == 0} {
|
||||
return
|
||||
} else {
|
||||
if { [syntaxCounterMode $m] != 1 } {
|
||||
error "ERROR: invalid counter mode $m specified for count"
|
||||
}
|
||||
}
|
||||
set p [string trim [string tolower $preset]]
|
||||
if { [string compare $p null] == 0} {
|
||||
return
|
||||
} else {
|
||||
if {[syntaxNumeric $p] != 1 } {
|
||||
error "ERROR: count expected numeric preset, got $p"
|
||||
}
|
||||
}
|
||||
}
|
||||
#----------------------------------------------------------------------------
|
||||
# The scan commands for the syntax checker
|
||||
#----------------------------------------------------------------------------
|
||||
proc cscan { var center delta np preset } {
|
||||
|
||||
set ret [catch {info body $var} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to scan found" $var]
|
||||
}
|
||||
if { [syntaxNumeric $center] != 1} {
|
||||
error "ERROR: $center is no number, expected scan center"
|
||||
}
|
||||
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 { [syntaxNumeric $preset] != 1} {
|
||||
error "ERROR: $preset is no number, expected scan preset"
|
||||
}
|
||||
set val [expr $center - ($np/2) *$delta]
|
||||
syntaxLimit $var $val
|
||||
set val [expr $center + ($np/2)*$delta]
|
||||
syntaxLimit $var $val
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
proc sscan args {
|
||||
set lang [llength $args]
|
||||
if { $lang < 5} {
|
||||
error "ERROR: not enough arguments to sscan"
|
||||
}
|
||||
#-------- last two: np, preset
|
||||
set val [lindex $args [expr $lang - 1]]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected numeric preset, got $val"
|
||||
}
|
||||
set val [lindex $args [expr $lang - 2]]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected numeric NP, got $val"
|
||||
}
|
||||
set np $val
|
||||
#-------- from start: var start step sequences
|
||||
for {set i 0} { $i < [expr $lang - 2]} { set i [expr $i + 3]} {
|
||||
set var [string trim [string tolower [lindex $args $i]]]
|
||||
set ret [catch {info body $var} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to scan found" $var]
|
||||
}
|
||||
set start [lindex $args [expr $i + 1]]
|
||||
if { [syntaxNumeric $start] != 1} {
|
||||
error "ERROR: $start is no number, expected scan start"
|
||||
}
|
||||
set step [lindex $args [expr $i + 2]]
|
||||
if { [syntaxNumeric $step] != 1} {
|
||||
error "ERROR: $step is no number, expected scan step"
|
||||
}
|
||||
syntaxLimit $var $start
|
||||
set val [expr $start + $np * $step]
|
||||
syntaxLimit $var $val
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
# The main scan object
|
||||
#------------------------------------------------------------------------
|
||||
proc scan args {
|
||||
global sicsPar
|
||||
|
||||
if { [llength $args] < 1} {
|
||||
error "ERROR: need subcommand for scan"
|
||||
}
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
switch $subcommand {
|
||||
info -
|
||||
getvars -
|
||||
xaxis -
|
||||
cinterest -
|
||||
uuinterest -
|
||||
pinterest -
|
||||
file -
|
||||
list -
|
||||
clear -
|
||||
getcounts -
|
||||
run -
|
||||
recover -
|
||||
forceclear {
|
||||
return
|
||||
}
|
||||
np -
|
||||
preset -
|
||||
setchannel {
|
||||
if { [llength $args] > 1} {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error ERROR: expected numeric arg to $subcommand, got $val
|
||||
}
|
||||
set sicsPar(scan.$subcommand) $val
|
||||
} else {
|
||||
return [syntaxGet scan.$subcommand]
|
||||
}
|
||||
}
|
||||
var {
|
||||
if { [llength $args] < 4} {
|
||||
error "ERROR: not enough arguments for scan var"
|
||||
}
|
||||
set var [lindex $args 1]
|
||||
set ret [catch {info body $var} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to scan found" $var]
|
||||
}
|
||||
set val [lindex $args 2]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected number for start, got $val"
|
||||
}
|
||||
set val [lindex $args 3]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected number for step, got $val"
|
||||
}
|
||||
}
|
||||
mode {
|
||||
if { [llength $args] > 1} {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxCounterMode $val] != 1} {
|
||||
error ERROR: expected counter mode, got $val
|
||||
}
|
||||
set sicsPar(scan.mode) $val
|
||||
} else {
|
||||
return [syntaxGet scan.mode]
|
||||
}
|
||||
}
|
||||
default {
|
||||
error "ERROR: subcommand $subcommand to scan not known"
|
||||
}
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
# optimiseSyntax: The syntax for the optimize command
|
||||
#-----------------------------------------------------------------------
|
||||
lappend optiPar maxcycles threshold channel preset
|
||||
|
||||
proc optiSyntax {name args} {
|
||||
global optiPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] < 1} {
|
||||
error "ERROR: need subcommand for optimise"
|
||||
}
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
if { [lsearch $optiPar $subcommand] >= 0} {
|
||||
if { [llength $args] > 1 } {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxNumeric $val] == 0 } {
|
||||
error [format "ERROR: %s.%s expected number, received %s" \
|
||||
$name $subcommand $val]
|
||||
} else {
|
||||
set sicsPar($name.$subcommand) $val
|
||||
return
|
||||
}
|
||||
} else {
|
||||
return [syntaxGet $name.$subcommand]
|
||||
}
|
||||
}
|
||||
switch $subcommand {
|
||||
addvar {
|
||||
if { [llength $args] < 5} {
|
||||
error "ERROR: not enough arguments to addvar"
|
||||
}
|
||||
set var [string trim [string tolower [lindex $args 1]]]
|
||||
set ret [catch {info body $var} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to optimise found" $var]
|
||||
}
|
||||
for { set i 2} {$i < [llength $args]} {incr i} {
|
||||
set val [lindex $args $i]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected numeric par to opti, got $val"
|
||||
}
|
||||
}
|
||||
}
|
||||
clear -
|
||||
run { return}
|
||||
countmode {
|
||||
if { [llength $args] > 1} {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxCounterMode $val] != 1} {
|
||||
error ERROR: expected counter mode, got $val
|
||||
}
|
||||
set sicsPar(opti.mode) $val
|
||||
} else {
|
||||
return [syntaxGet opti.mode]
|
||||
}
|
||||
}
|
||||
default {
|
||||
error "ERROR: optimiser does not know about subcommand $subcommand"
|
||||
}
|
||||
}
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
# mumoSyntax: the syntax for SANS style multi motors
|
||||
# The aliases must be set in sicsPar(multimotorname.alias) during setup
|
||||
# in order for this to find them
|
||||
# Also sicsPar(multimotorname.nampos) has to be initialised to [list back]
|
||||
#------------------------------------------------------------------------
|
||||
proc mumoSyntax {name args} {
|
||||
global sicsPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] == 0} {
|
||||
return
|
||||
}
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
#---------check named position
|
||||
if {[lsearch $sicsPar($name.nampos) $subcommand] >= 0} {
|
||||
return
|
||||
}
|
||||
switch $subcommand {
|
||||
list {
|
||||
return
|
||||
}
|
||||
pos -
|
||||
recovernampos {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: not enough args to $subcommand"
|
||||
}
|
||||
set nam [string trim [string tolower [lindex $args 1]]]
|
||||
if { [lsearch $sicsPar($name.nampos) $nam] < 0} {
|
||||
lappend sicsPar($name.nampos) $nam
|
||||
}
|
||||
return
|
||||
}
|
||||
drop {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: not enough args to $subcommand"
|
||||
}
|
||||
set nam [string trim [string tolower [lindex $args 1]]]
|
||||
if { [string compare $name all] == 0} {
|
||||
set sicsPar($name.nampos) [list back]
|
||||
} else {
|
||||
set ind [lsearch $sicsPar($name.nampos) $nam]
|
||||
if { $ind >= 0} {
|
||||
set sicsPar($name.nampos) \
|
||||
[lreplace $sicsPar($name.nampos) $ind $ind]
|
||||
} else {
|
||||
puts stdout "INFO: failed to drop $nam"
|
||||
}
|
||||
}
|
||||
return
|
||||
}
|
||||
}
|
||||
#------------------ now it can only be the alias syntax
|
||||
# but we have to wash away all =,+,- first before we can analyze it
|
||||
set aliastxt [string trim [string tolower [join $args]]]
|
||||
set word 1
|
||||
set length [string length $aliastxt]
|
||||
for {set i 0} { $i < $length} {incr i} {
|
||||
set c [string index $aliastxt $i]
|
||||
if { [regexp \[=+-\] $c] == 1} {
|
||||
# puts stdout "Discovered +=- $c"
|
||||
if { $word == 1} {
|
||||
append washedTxt " "
|
||||
set word 0
|
||||
}
|
||||
continue
|
||||
}
|
||||
if { [string match {\ } $c] == 1} {
|
||||
# puts stdout "Discovered white space $c"
|
||||
if { $word == 1} {
|
||||
append washedTxt $c
|
||||
set word 0
|
||||
}
|
||||
continue
|
||||
}
|
||||
# puts stdout "Discovered $c"
|
||||
append washedTxt $c
|
||||
set word 1
|
||||
}
|
||||
# puts stdout $washedTxt
|
||||
#------- now we should have aliases followed by numbers only
|
||||
set args [split $washedTxt]
|
||||
for { set i 0} { $i < [llength $args]} { set i [expr $i +2]} {
|
||||
set var [lindex $args $i]
|
||||
if { [lsearch $sicsPar($name.alias) $var] < 0} {
|
||||
error "ERROR: alias $var does not exist in $name"
|
||||
}
|
||||
set val [lindex $args [expr $i + 1]]
|
||||
if { [syntaxNumeric $val] != 1 } {
|
||||
error "ERROR expected numeric target, got $val"
|
||||
}
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# The wait operation
|
||||
#--------------------------------------------------------------------------
|
||||
proc wait {time} {
|
||||
if { [syntaxNumeric $time] != 1} {
|
||||
error "ERROR: expected numeric wait time, got $time"
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# fileeval. Fileeval checks for loops in command
|
||||
# files. This is no error but a usage feature
|
||||
#--------------------------------------------------------------------------
|
||||
lappend fileList grrrmmmpffff
|
||||
|
||||
proc fileeval {name} {
|
||||
global fileList
|
||||
set f [file tail $name]
|
||||
if { [lsearch $fileList $f] >= 0} {
|
||||
puts stdout "INFO: Command file loop detected!"
|
||||
return
|
||||
} else {
|
||||
lappend fileList $f
|
||||
source $name
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# batchrun
|
||||
#--------------------------------------------------------------------------
|
||||
proc batchrun {name} {
|
||||
global sicsPar
|
||||
fileeval $sicspar(batchroot)/$name
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# The sp command for setting zero points
|
||||
#--------------------------------------------------------------------------
|
||||
proc sp {axis value} {
|
||||
set axis [string tolower [string trim $axis]]
|
||||
set ret [catch {info body $axis]} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: no %s to zero found" $axis]
|
||||
}
|
||||
if { [syntaxNumeric $value] != 1 } {
|
||||
error [format "ERROR: expected numeric zero target, got %s" \
|
||||
$name $value]
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
# The psdconfigure command 4 TRICS and AMOR
|
||||
#--------------------------------------------------------------------------
|
||||
proc psdconfigure {hm xSize ySize} {
|
||||
set ret [catch {info body $hm} msg]
|
||||
if { $ret != 0 } {
|
||||
error [format "ERROR: $hm to configure not found!" $hm]
|
||||
}
|
||||
if { [syntaxNumeric $xSize] != 1 } {
|
||||
error "ERROR: expected numeric xSize, got $xSize"
|
||||
}
|
||||
if { [syntaxNumeric $ySize] != 1 } {
|
||||
error "ERROR: expected numeric ySize, got $ySize"
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
# The histogram memory control syntax
|
||||
#-----------------------------------------------------------------------
|
||||
proc hmcSyntax {name args} {
|
||||
set args [syntaxListify $args]
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: missing argumnets to $name"
|
||||
}
|
||||
set p [lindex $args 0]
|
||||
if { [syntaxNumeric $p] != 1} {
|
||||
error "ERROR: expected numeric preset for $name, got $p"
|
||||
}
|
||||
set p [string trim [string tolower [lindex $args 1]]]
|
||||
if { [syntaxCountMode $p] != 1} {
|
||||
error "ERROR: invalid count mode $p for $name"
|
||||
}
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
# The syntax for the fourcircle calculation module
|
||||
#--------------------------------------------------------------------------
|
||||
lappend hklKey list current
|
||||
lappend hklPar lambda hm
|
||||
|
||||
proc syntaxHKL {name args} {
|
||||
global hklKey hklPar
|
||||
|
||||
set args [syntaxListify $args]
|
||||
|
||||
if { [llength $args] < 1} {
|
||||
error "ERROR: no subcommand to $name"
|
||||
}
|
||||
set subcommand [string trim [string tolower [lindex $args 0]]]
|
||||
#-------- check keyword commands
|
||||
if { [lsearch $hklKey $subcommand] >= 0} {
|
||||
return
|
||||
}
|
||||
#-------- check parameter commands
|
||||
if { [lsearch $hklPar $subcommand] >= 0} {
|
||||
if { [llength $args] > 1 } {
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxNumeric $val] == 0 } {
|
||||
error [format "ERROR: %s.%s expected number, received %s" \
|
||||
$name $subcommand $val]
|
||||
} else {
|
||||
set sicsPar($name.$subcommand) $val
|
||||
}
|
||||
} else {
|
||||
return [syntaxGet $name.$subcommand]
|
||||
}
|
||||
}
|
||||
#------------ check the rest
|
||||
switch $subcommand {
|
||||
calc -
|
||||
drive -
|
||||
run {
|
||||
if { [llength $args] < 4} {
|
||||
error "ERROR: insufficient no args to $name calc,drive,run"
|
||||
}
|
||||
for { set i 1} { $i < [llength $args]} { incr i} {
|
||||
set val [lindex $args $i]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected numeric argument, got $val"
|
||||
}
|
||||
}
|
||||
}
|
||||
nb -
|
||||
quadrant {
|
||||
if { [llength $args] < 2} {
|
||||
error "ERROR: insufficient no args to $name nb, quadrant"
|
||||
}
|
||||
set val [lindex $args 1]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error \
|
||||
"ERROR: expected numeric argument ot nb, quadrant, got $val"
|
||||
}
|
||||
}
|
||||
setub {
|
||||
if { [llength $args] < 10 } {
|
||||
error "ERROR: insufficient no args to $name setub"
|
||||
}
|
||||
for { set i 1} { $i < [llength $args]} { incr i} {
|
||||
set val [lindex $args $i]
|
||||
if { [syntaxNumeric $val] != 1} {
|
||||
error "ERROR: expected numeric argument, got $val"
|
||||
}
|
||||
}
|
||||
}
|
||||
default {
|
||||
error "ERROR: $name does not know subcomand $subcommand"
|
||||
}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
# Mappings for some common SICS commands and variables
|
||||
#---------------------------------------------------------------------------
|
||||
sicsSyntaxMap clientput syntaxDummy
|
||||
sicsSyntaxMap ClientPut syntaxDummy
|
||||
sicsSyntaxMap success syntaxDummy
|
||||
sicsSyntaxMap drive syntaxDrive
|
||||
sicsSyntaxMap run syntaxDrive
|
||||
sicsSyntaxMap peak syntaxDummy
|
||||
sicsSyntaxMap center syntaxDummy
|
||||
sicsSyntaxMap batchroot syntaxTextPar
|
||||
sicsSyntaxMap sicstime syntaxDummy
|
||||
|
||||
|
||||
|
||||
142
utils/check/topsicheck
Executable file
142
utils/check/topsicheck
Executable file
@ -0,0 +1,142 @@
|
||||
#! /bin/sh
|
||||
#next line is executed by sh, not by Tcl \
|
||||
exec tclsh $0 ${1+"$@"}
|
||||
#--------------------------------------------------------------------------
|
||||
# This is the SICS syntax checker for the TOPSI diffractometer
|
||||
#
|
||||
# Mark Koennecke, March 2003
|
||||
#--------------------------------------------------------------------------
|
||||
source /data/koenneck/src/sics/utils/check/sicssyntaxlib.tcl
|
||||
|
||||
#------------------------- define TOPSI motors and aliases
|
||||
sicsSyntaxMap d1r syntaxMotor
|
||||
sicsSyntaxMap d1l syntaxMotor
|
||||
sicsSyntaxMap d2r syntaxMotor
|
||||
sicsSyntaxMap d2l syntaxMotor
|
||||
sicsSyntaxMap d3r syntaxMotor
|
||||
sicsSyntaxMap d3l syntaxMotor
|
||||
sicsSyntaxMap dxt syntaxMotor
|
||||
sicsSyntaxMap dxb syntaxMotor
|
||||
sicsSyntaxMap utz syntaxMotor
|
||||
sicsSyntaxMap uty syntaxMotor
|
||||
sicsSyntaxMap sth syntaxMotor
|
||||
sicsSyntaxMap stt syntaxMotor
|
||||
sicsSyntaxMap stx syntaxMotor
|
||||
sicsSyntaxMap sty syntaxMotor
|
||||
sicsSyntaxMap sgx syntaxMotor
|
||||
sicsSyntaxMap sgy syntaxMotor
|
||||
sicsSyntaxMap utt syntaxMotor
|
||||
sicsSyntaxMap scx syntaxMotor
|
||||
sicsSyntaxMap scy syntaxMotor
|
||||
sicsSyntaxMap po1 syntaxMotor
|
||||
sicsSyntaxMap po2 syntaxMotor
|
||||
sicsSyntaxMap mth syntaxMotor
|
||||
sicsSyntaxMap mtt syntaxMotor
|
||||
sicsSyntaxMap mtx syntaxMotor
|
||||
sicsSyntaxMap mty syntaxMotor
|
||||
sicsSyntaxMap mgx syntaxMotor
|
||||
sicsSyntaxMap mfv syntaxMotor
|
||||
sicsSyntaxMap d1b syntaxMotor
|
||||
sicsSyntaxMap d2b syntaxMotor
|
||||
sicsSyntaxMap d3b syntaxMotor
|
||||
sicsSyntaxMap d1t syntaxMotor
|
||||
sicsSyntaxMap d2t syntaxMotor
|
||||
sicsSyntaxMap d3t syntaxMotor
|
||||
#------------ aliases
|
||||
sicsSyntaxMap s1r syntaxMotor
|
||||
sicsSyntaxMap s1l syntaxMotor
|
||||
sicsSyntaxMap s2r syntaxMotor
|
||||
sicsSyntaxMap s2l syntaxMotor
|
||||
sicsSyntaxMap s3r syntaxMotor
|
||||
sicsSyntaxMap s3l syntaxMotor
|
||||
sicsSyntaxMap a6 syntaxMotor
|
||||
sicsSyntaxMap a5 syntaxMotor
|
||||
sicsSyntaxMap a3 syntaxMotor
|
||||
sicsSyntaxMap som syntaxMotor
|
||||
sicsSyntaxMap th syntaxMotor
|
||||
sicsSyntaxMap om syntaxMotor
|
||||
sicsSyntaxMap a4 syntaxMotor
|
||||
sicsSyntaxMap s2t syntaxMotor
|
||||
sicsSyntaxMap tth syntaxMotor
|
||||
sicsSyntaxMap 2t syntaxMotor
|
||||
sicsSyntaxMap stu syntaxMotor
|
||||
sicsSyntaxMap stl syntaxMotor
|
||||
sicsSyntaxMap sgu syntaxMotor
|
||||
sicsSyntaxMap sgl syntaxMotor
|
||||
sicsSyntaxMap mgu syntaxMotor
|
||||
sicsSyntaxMap sch syntaxMotor
|
||||
sicsSyntaxMap sph syntaxMotor
|
||||
sicsSyntaxMap pol syntaxMotor
|
||||
sicsSyntaxMap ana syntaxMotor
|
||||
sicsSyntaxMap a1 syntaxMotor
|
||||
sicsSyntaxMap mom syntaxMotor
|
||||
sicsSyntaxMap a2 syntaxMotor
|
||||
sicsSyntaxMap m2t syntaxMotor
|
||||
sicsSyntaxMap mtu syntaxMotor
|
||||
sicsSyntaxMap mtl syntaxMotor
|
||||
sicsSyntaxMap mcv syntaxMotor
|
||||
sicsSyntaxMap sttl syntaxMotor
|
||||
sicsSyntaxMap u2t syntaxMotor
|
||||
|
||||
#------------ define TOPSI counters
|
||||
sicsSyntaxMap counter syntaxCounter
|
||||
|
||||
#------------ define TOPSI variables
|
||||
sicsSyntaxMap title syntaxTextPar
|
||||
sicsSyntaxMap user 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
|
||||
sicsSyntaxMap lambda syntaxNumPar
|
||||
|
||||
#----------- define TOPSI environment
|
||||
sicsSyntaxMap temperature evSyntax
|
||||
sicsSyntaxMap tt evSyntax
|
||||
|
||||
#---------- define TOPSI auxiliary
|
||||
sicsSyntaxMap beam syntaxDummy
|
||||
sicsSyntaxMap o2t syntaxNumPar
|
||||
sicsSyntaxMap o2tl syntaxNumPar
|
||||
sicsSyntaxMap o2u syntaxNumPar
|
||||
sicsSyntaxMap ttc syntaxTextPar
|
||||
sicsSyntaxMap sttc syntaxTextPar
|
||||
sicsSyntaxMap sef syntaxTextPar
|
||||
sicsSyntaxMap remote syntaxTextPar
|
||||
|
||||
#------------------------------------------------------------------------
|
||||
# some strange TOPSI commands with 3 numeric parameters
|
||||
#-----------------------------------------------------------------------
|
||||
proc dah {w1 w2 w3} {
|
||||
if { [syntaxNumeric $w1] != 1 } {
|
||||
error "ERROR: expected numeric w1, got $w1"
|
||||
}
|
||||
if { [syntaxNumeric $w2] != 1 } {
|
||||
error "ERROR: expected numeric w2, got $w2"
|
||||
}
|
||||
if { [syntaxNumeric $w3] != 1 } {
|
||||
error "ERROR: expected numeric w3, got $w3"
|
||||
}
|
||||
}
|
||||
proc dav {w1 w2 w3} {
|
||||
dah $w1 $w2 $w3
|
||||
}
|
||||
|
||||
#--------- Main checking stuff
|
||||
|
||||
if { $argc < 1} {
|
||||
puts stdout "Usage: \n\ttopsicheck 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
|
||||
|
||||
288
utils/check/tricscheck
Executable file
288
utils/check/tricscheck
Executable file
@ -0,0 +1,288 @@
|
||||
#! /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/koenneck/src/sics/utils/check/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 amorstatus.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
|
||||
|
||||
Reference in New Issue
Block a user