diff --git a/mumo.c b/mumo.c index 08fb41a8..3615aa0f 100644 --- a/mumo.c +++ b/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,11 +114,12 @@ 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: @@ -694,7 +739,10 @@ DingsBums drop name - deletes the current named position name. DingsBums drop all - drops all named positions (except back) - DingsBums list - lists all named positions. + 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,7 +866,8 @@ if((iToken == SYMBOL) || (iToken == NAMPOS)) { MakeCurrentNamPos(MyParser.Token,pCon,self); - return 1; + 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; diff --git a/utils/check/amorcheck b/utils/check/amorcheck new file mode 100755 index 00000000..a679a5d3 --- /dev/null +++ b/utils/check/amorcheck @@ -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 + diff --git a/utils/check/dmccheck b/utils/check/dmccheck new file mode 100755 index 00000000..4f7aca43 --- /dev/null +++ b/utils/check/dmccheck @@ -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 + \ No newline at end of file diff --git a/utils/check/focuscheck b/utils/check/focuscheck new file mode 100755 index 00000000..944b9480 --- /dev/null +++ b/utils/check/focuscheck @@ -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 + diff --git a/utils/check/hrptcheck b/utils/check/hrptcheck new file mode 100755 index 00000000..241f988b --- /dev/null +++ b/utils/check/hrptcheck @@ -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 + \ No newline at end of file diff --git a/utils/check/sanscheck b/utils/check/sanscheck new file mode 100755 index 00000000..0a70ccf7 --- /dev/null +++ b/utils/check/sanscheck @@ -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 + + + diff --git a/utils/check/sicssyntaxlib.tcl b/utils/check/sicssyntaxlib.tcl index 12f5f41c..05f91cd8 100644 --- a/utils/check/sicssyntaxlib.tcl +++ b/utils/check/sicssyntaxlib.tcl @@ -60,19 +60,81 @@ proc syntaxGet {name} { #----------------------------------------------------------------------- proc syntaxCounterMode {par} { set p [string trim [string tolower $par]] - switch $p{ + switch $p { monitor { return 1} timer {return 1} 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]]] - switch $subcommand { +#------ test keyWords + if { [lsearch $cterKey $subcommand] >= 0} { + return } -} \ No newline at end of file +#------- 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 + + diff --git a/utils/check/topsicheck b/utils/check/topsicheck new file mode 100755 index 00000000..57d98b5c --- /dev/null +++ b/utils/check/topsicheck @@ -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 + \ No newline at end of file diff --git a/utils/check/tricscheck b/utils/check/tricscheck new file mode 100755 index 00000000..884fd332 --- /dev/null +++ b/utils/check/tricscheck @@ -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 +