From 2ec6505ef82f701ef123d927938742238fe9bf99 Mon Sep 17 00:00:00 2001 From: Ferdi Franceschini Date: Wed, 25 Nov 2009 09:56:49 +1100 Subject: [PATCH] Merged 2.4 branch r2828 | ffr | 2009-11-25 09:56:49 +1100 (Wed, 25 Nov 2009) | 2 lines --- conman.c | 13 +- event.h | 2 + hipadaba.c | 8 + hipadaba.h | 7 + napi.h | 7 + nxscript.c | 2 +- sicshipadaba.c | 164 ++- sicslist.c | 25 + sicvar.c | 63 +- site_ansto/anstohttp.c | 61 +- site_ansto/hardsup/makefile | 2 +- site_ansto/hmcontrol_ansto.c | 6 +- .../config/commands/commands_common.tcl | 44 +- .../hipadaba/common_instrument_dictionary.tcl | 97 +- .../hipadaba_configuration_common.tcl | 81 +- .../config/hmm/hmm_configuration_common_1.tcl | 599 ++++------ ...hmm_cylindrical_detector_configuration.tcl | 50 +- .../config/motors/sct_positmotor_common.tcl | 16 +- .../config/nexus/nxscripts_common_1.tcl | 1062 ++++++++--------- .../instrument/config/scan/scan_common_1.tcl | 29 +- site_ansto/instrument/gumxml.tcl | 4 +- .../instrument/hipd/config/INSTCFCOMMON.TXT | 3 + .../hipd/config/hmm/hmm_configuration.tcl | 14 +- .../hipd/script_validator/sics_ports.tcl | 8 +- .../hipd/script_validator_ports.tcl | 8 +- site_ansto/instrument/hipd/sics_ports.tcl | 8 +- .../instrument/hipd/wombat_configuration.tcl | 5 +- .../instrument/hrpd/config/INSTCFCOMMON.TXT | 2 + .../hrpd/config/anticollider/acscript.txt | 8 +- .../hrpd/config/hmm/hmm_configuration.tcl | 14 +- .../config/motors/motor_configuration.tcl | 36 +- .../hrpd/config/nexus/nxscripts.tcl | 3 + .../instrument/hrpd/echidna_configuration.tcl | 15 +- .../hrpd/script_validator/sics_ports.tcl | 8 +- .../hrpd/script_validator_ports.tcl | 8 +- site_ansto/instrument/hrpd/sics_ports.tcl | 8 +- .../instrument/pas/config/INSTCFCOMMON.TXT | 3 + .../instrument/pas/pelican_configuration.tcl | 5 +- .../reflectometer/config/INSTCFCOMMON.TXT | 3 + .../config/hmm/hmm_configuration.tcl | 9 +- .../config/parameters/parameters.tcl | 67 +- .../reflectometer/platypus_configuration.tcl | 8 +- .../script_validator/sics_ports.tcl | 8 +- .../reflectometer/script_validator_ports.tcl | 8 +- .../instrument/reflectometer/sics_ports.tcl | 8 +- .../instrument/rsd/config/INSTCFCOMMON.TXT | 3 + .../rsd/config/hmm/hmm_configuration.tcl | 73 +- .../instrument/rsd/kowari_configuration.tcl | 5 +- .../rsd/script_validator/sics_ports.tcl | 8 +- .../instrument/rsd/script_validator_ports.tcl | 8 +- site_ansto/instrument/rsd/sics_ports.tcl | 8 +- .../instrument/sans/config/INSTCFCOMMON.TXT | 5 +- .../sans/config/hmm/hmm_configuration.tcl | 9 +- .../config/motors/motor_configuration.tcl | 188 ++- .../motors/positmotor_configuration.tcl | 2 +- .../sans/config/nexus/nxscripts.tcl | 2 + .../sans/config/parameters/parameters.tcl | 49 +- .../sans/config/velsel/sct_velsel.tcl | 552 +++++++-- .../instrument/sans/config/velsel/velsel.tcl | 62 +- .../instrument/sans/quokka_configuration.tcl | 16 +- .../sans/script_validator/sics_ports.tcl | 8 +- .../sans/script_validator_ports.tcl | 8 +- site_ansto/instrument/sans/sics_ports.tcl | 8 +- site_ansto/instrument/server_config.tcl | 16 +- .../instrument/util/check/query_sics.tcl | 2 +- site_ansto/instrument/util/extra_utility.tcl | 2 +- .../instrument/util/script_context_util.tcl | 42 +- site_ansto/instrument/util/utility.tcl | 43 +- site_ansto/site_ansto.c | 2 + statemon.c | 33 +- statusfile.c | 2 + 71 files changed, 2237 insertions(+), 1528 deletions(-) diff --git a/conman.c b/conman.c index 43db287b..33385e83 100644 --- a/conman.c +++ b/conman.c @@ -572,9 +572,6 @@ extern pServer pServ; { return 0; } - if (self->iMacro) { - iOut = eInternal; - } return self->write(self,pBuffer,iOut); } /*-----------------------------------------------------------------------*/ @@ -718,9 +715,11 @@ static void writeToLogFiles(SConnection *self, char *buffer) /* supress */ iRet = 0; } else { - sprintf(pBueffel,"Next line intended for socket(1): %d",iRet); - SICSLogWrite(pBueffel,eInternal); - SICSLogWrite(buffer,iOut); + if (self->iMacro != 1) { + sprintf(pBueffel,"Next line intended for socket(1): %d",iRet); + SICSLogWrite(pBueffel,eInternal); + SICSLogWrite(buffer,iOut); + } } /* write to commandlog if user or manager privilege */ @@ -1037,6 +1036,8 @@ pDynString SCEndBuffering(SConnection *pCon) { return 0; } + if (strcmp(buffer, "OK") == 0) + return 1; /* log it for any case */ if(self->pSock) diff --git a/event.h b/event.h index ee92c179..08b41b96 100644 --- a/event.h +++ b/event.h @@ -47,6 +47,8 @@ #define HDBVAL 20 #define STSTART 21 #define STEND 22 +#define STPAUSE 23 +#define STCONTINUE 24 #line 115 "event.w" diff --git a/hipadaba.c b/hipadaba.c index 88c1cd28..953adea8 100644 --- a/hipadaba.c +++ b/hipadaba.c @@ -931,6 +931,14 @@ static int calcDataLength(pHdb node, int testLength){ } } /*---------------------------------------------------------------------------*/ +int HasHdbProperty(pHdb node, char *key){ + if(node != NULL && node->properties != NULL){ + return StringDictExists(node->properties,key); + } else { + return 0; + } +} +/*---------------------------------------------------------------------------*/ int GetHdbProperty(pHdb node, char *key, char *value, int len){ if(node != NULL && node->properties != NULL){ return StringDictGet(node->properties,key,value,len); diff --git a/hipadaba.h b/hipadaba.h index 22c7a745..212cacf6 100644 --- a/hipadaba.h +++ b/hipadaba.h @@ -415,6 +415,13 @@ int GetHipadabaPar(pHdb node, hdbValue *v, void *callData); * @param len The length of value * @return 0 on failure, 1 on success */ +/** + * Check if a property exists + * @param node The node to get the property from + * @param key The properties key + * @return 1 or 0 for true or false + */ +int HasHdbProperty(pHdb node, char *key); int GetHdbProperty(pHdb node, char *key, char *value, int len); /** * get the value of a property diff --git a/napi.h b/napi.h index 50536245..b2b18bb1 100644 --- a/napi.h +++ b/napi.h @@ -30,6 +30,13 @@ /* NeXus HDF45 */ #define NEXUS_VERSION "4.1.0" /* major.minor.patch */ +#define H5Eset_auto_vers 1 +#define H5Dopen_vers 1 +#define H5Gopen_vers 1 +#define H5Acreate_vers 1 +#define H5Dcreate_vers 1 +#define H5Gcreate_vers 1 +#define H5Aiterate_vers 1 #define CONSTCHAR const char diff --git a/nxscript.c b/nxscript.c index 0546595a..ddf89287 100644 --- a/nxscript.c +++ b/nxscript.c @@ -430,7 +430,7 @@ static void putHdb(SConnection *pCon, SicsInterp *pSics, pNXScript self, } } GetHipadabaPar(node,&v,pCon); - if (strcmp(argv[3],"point")==0) { + if (argc > 3 && strcmp(argv[3],"point")==0) { NXDopenalias(self->fileHandle, self->dictHandle,alias); start[0]=atoi(argv[4]); size[0]=1; switch(v.dataType){ diff --git a/sicshipadaba.c b/sicshipadaba.c index dc68109b..877747ef 100644 --- a/sicshipadaba.c +++ b/sicshipadaba.c @@ -2379,7 +2379,8 @@ static int GetHdbVal(SConnection *pCon, SicsInterp *pSics, void *pData, return 0; } memset(&newValue,0,sizeof(hdbValue)); - GetHipadabaPar(targetNode, &newValue, pCon); + if (0 == GetHipadabaPar(targetNode, &newValue, pCon)) + return 0; parData = formatValue(newValue, targetNode); if(parData == NULL){ SCWrite(pCon,"ERROR: out of memory formatting data",eError); @@ -3056,6 +3057,27 @@ static int DelSICSHdbProperty(SConnection *pCon, SicsInterp *pSics, void *pData, return 1; } /*--------------------------------------------------------------------------*/ +static int HasSICSHdbProperty(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]){ + pHdb targetNode = NULL; + + if(argc < 3) { + SCWrite(pCon,"ERROR: need path key as parameters",eError); + return 0; + } + targetNode = FindHdbNode(NULL,argv[1],pCon); + if(targetNode == NULL){ + SCWrite(pCon,"ERROR: node not found",eError); + return 0; + } + if (HasHdbProperty(targetNode,argv[2])) { + SCPrintf(pCon,eValue,"%s", "true"); + return 1; + } else { + SCPrintf(pCon,eValue,"%s", "false"); + return 1; + } +} +/*--------------------------------------------------------------------------*/ static int GetSICSHdbProperty(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]){ pHdb targetNode = NULL; @@ -3110,10 +3132,13 @@ static int ListSICSHdbProperty(SConnection *pCon, SicsInterp *pSics, void *pData char buffer[512]; const char *pKey = NULL; pDynString data = NULL; + int genTclList = 0; if(argc < 2) { SCWrite(pCon,"ERROR: need path as parameter",eError); return 0; + } else if (argc == 3) { + genTclList = 1; } targetNode = FindHdbNode(NULL,argv[1],pCon); if(targetNode == NULL){ @@ -3128,33 +3153,105 @@ static int ListSICSHdbProperty(SConnection *pCon, SicsInterp *pSics, void *pData InitHdbPropertySearch(targetNode); while((pKey = GetNextHdbProperty(targetNode, buffer, 511)) != NULL){ DynStringConcat(data,(char *)pKey); - DynStringConcat(data,"="); - DynStringConcat(data,buffer); - DynStringConcat(data,"\n"); + if (genTclList) { + DynStringConcat(data," "); + DynStringConcat(data,"{"); + DynStringConcat(data,buffer); + DynStringConcat(data,"}"); + DynStringConcat(data," "); + } else { + DynStringConcat(data,"="); + DynStringConcat(data,buffer); + DynStringConcat(data,"\n"); + } } SCWrite(pCon,GetCharArray(data), eValue); DeleteDynString(data); return 1; } +static int ANSTO_ListSICSHdbProperty(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pHdb targetNode = NULL; + char buffer[512], *globPtr=NULL; + int cmpSize = 0; + const char *pKey = NULL; + pDynString data = NULL; + + if(argc < 3) { + SCWrite(pCon,"ERROR: need path and search string as parameters",eError); + return 0; + } + targetNode = FindHdbNode(NULL,argv[1],pCon); + if(targetNode == NULL){ + SCWrite(pCon,"ERROR: node not found",eError); + return 0; + } + data = CreateDynString(64,64); + if(data == NULL){ + SCWrite(pCon,"ERROR: out of memory in ListSICSHdbProperty",eError); + return 0; + } + InitHdbPropertySearch(targetNode); + + /* Allow simple glob matches with '*' as a suffix + Eg hfindprop /hpath @* + */ + if ((globPtr = index(argv[2], '*')) != NULL ) { + *globPtr = '\0'; + } + cmpSize = strlen(argv[2]); + while((pKey = GetNextHdbProperty(targetNode, buffer, 511)) != NULL) { + if (strncasecmp(argv[2], pKey, cmpSize) == 0) { + DynStringConcat(data,(char *)pKey); + DynStringConcat(data," "); + DynStringConcat(data,buffer); + DynStringConcat(data,"\n"); + } + } + SCWrite(pCon,GetCharArray(data), eValue); + DeleteDynString(data); + return 1; + } /*---------------------------------------------------------------------------*/ -static pHdb matchHdbProp(pHdb root, char *propname, char *buffer){ - char value[1024]; +static pHdb matchHdbProp(SConnection *pCon, pHdb root, char *propname, char *buffer, pDynString result, int invertmatch){ + char value[1024], *path=NULL; pHdb current = NULL, search; memset(value,0,1024); - if(GetHdbProperty(root,propname,value,1023) == 1){ - if(strstr(buffer,value) != NULL){ - return root; - } - } + if (strcmp(buffer, "*") == 0) { + if(GetHdbProperty(root,propname,value,1023) == 1) { + if (!invertmatch) { + path = GetHipadabaPath(root); + DynStringConcat(result, path); + DynStringConcat(result, "\n"); + free(path); + } + } else if (invertmatch) { + path = GetHipadabaPath(root); + DynStringConcat(result, path); + DynStringConcat(result, "\n"); + free(path); + } + } else if(GetHdbProperty(root,propname,value,1023) == 1) { + if(strstr(buffer,value) != NULL) { + if (!invertmatch) { + path = GetHipadabaPath(root); + DynStringConcat(result, path); + DynStringConcat(result, "\n"); + free(path); + } + } else if (invertmatch) { + path = GetHipadabaPath(root); + DynStringConcat(result, path); + DynStringConcat(result, "\n"); + free(path); + } + } current = root->child; - while(current != NULL){ - search = matchHdbProp(current,propname,buffer); - if(search != NULL){ - return search; - } - current = current->next; - } + while(current != NULL){ + search = matchHdbProp(pCon, current,propname,buffer, result, invertmatch); + current = current->next; + } return NULL; } @@ -3164,31 +3261,36 @@ static int MatchHdbProperty(SConnection *pCon, SicsInterp *pSics, void *pData, pHdb root = NULL; pHdb foundNode = NULL; char buffer[1024], *path = NULL; + int node = 1, prop = 2, propval= 3, invertmatch = 0; + pDynString matchList = NULL; if(argc < 4){ SCWrite(pCon,"ERROR: need root, property name and target string for search", eError); return 0; } + if (argc >= 5) { + if (strcasecmp(argv[1], "invert") == 0) { + invertmatch = 1; + node++; + prop++; + propval++; + } + } memset(buffer,0,1024); - Arg2Text(argc-3,&argv[3],buffer,1023); - root = GetHipadabaNode(GetHipadabaRoot(), argv[1]); + Arg2Text(argc-propval,&argv[propval],buffer,1023); + root = GetHipadabaNode(GetHipadabaRoot(), argv[node]); if(root == NULL){ SCWrite(pCon,"ERROR: start node for search not found",eError); return 0; } - strtolower(argv[2]); + strtolower(argv[prop]); strtolower(buffer); - foundNode = matchHdbProp(root,argv[2],buffer); - - if(foundNode == NULL){ - SCWrite(pCon,"NONE", eValue); - } else { - path = GetHipadabaPath(foundNode); - SCWrite(pCon,path,eValue); - free(path); - } + matchList = CreateDynString(128,128); + foundNode = matchHdbProp(pCon, root,argv[prop],buffer, matchList, invertmatch); + SCWrite(pCon,GetCharArray(matchList),eValue); + DeleteDynString(matchList); return 1; } /*======================= Factory Functions =================================*/ @@ -3230,7 +3332,9 @@ int InstallSICSHipadaba(SConnection *pCon, SicsInterp *pSics, void *pData, AddCommand(pSics,"hgetprop",GetSICSHdbProperty, NULL, NULL); AddCommand(pSics,"hgetpropval",GetSICSHdbPropertyVal, NULL, NULL); AddCommand(pSics,"hmatchprop",MatchHdbProperty, NULL, NULL); + AddCommand(pSics,"hpropexists",HasSICSHdbProperty, NULL, NULL); AddCommand(pSics,"hlistprop",ListSICSHdbProperty, NULL, NULL); + AddCommand(pSics,"hfindprop",ANSTO_ListSICSHdbProperty, NULL, NULL); InstallSICSPoll(pCon,pSics,pData,argc,argv); poller = (pSicsPoll)FindCommandData(pSics,"sicspoll","SicsPoll"); diff --git a/sicslist.c b/sicslist.c index 50f674b7..15eaa8c5 100644 --- a/sicslist.c +++ b/sicslist.c @@ -161,6 +161,16 @@ static int printObjectData(SConnection *pCon, pDummy obj, char *key){ return 1; } } +static int existsObjectData(SConnection *pCon, pDummy obj, char *key) { + char *ptr = NULL; + ptr = IFindOption(obj->pDescriptor->pKeys,key); + if(ptr != NULL) + SCPrintf(pCon, eValue, "%s", "true"); + else + SCPrintf(pCon, eValue, "%s", "false"); + + return 1; +} /*----------------------------------------------------------------- * this function implements a set on top of a list. This means that * the list is first searched for the occurence of name. name is only @@ -493,6 +503,21 @@ int SicsList(SConnection *pCon, SicsInterp *pSics, void *pData, } } + if(strcmp(argv[1],"exists") == 0) { + if (argc < 4) { + SCWrite(pCon,"ERROR: not enough arguments",eError); + return 0; + } else { + pCom = FindCommand(pSics,argv[2]); + if ( pCom == NULL ) { + SCWrite(pCon,"ERROR: Object doesn't exist",eError); + return 0; + } else + return existsObjectData(pCon,(pDummy)pCom->pData, argv[3]); + } + } + + /* * object properties */ diff --git a/sicvar.c b/sicvar.c index a62d3b15..748e52e5 100644 --- a/sicvar.c +++ b/sicvar.c @@ -46,10 +46,11 @@ #include "status.h" #include "sicsvar.h" +#define SV_MAXBUF 512 /*-------------------------------------------------------------------------*/ static int VarSave(void *pData, char *name, FILE *fd) { - char pBueffel[512]; + char pBueffel[SV_MAXBUF]; pSicsVariable pVar = NULL; assert(pData); @@ -59,21 +60,21 @@ { return 1; } - sprintf(pBueffel,"# Variable %s\n",name); + snprintf(pBueffel, SV_MAXBUF, "# Variable %s\n",name); switch(pVar->eType) { case veText: - sprintf(pBueffel,"%s %s\n",name, pVar->text); + snprintf(pBueffel, SV_MAXBUF, "%s %s\n",name, pVar->text); break; case veInt: - sprintf(pBueffel,"%s %d\n",name, pVar->iVal); + snprintf(pBueffel, SV_MAXBUF, "%s %d\n",name, pVar->iVal); break; case veFloat: - sprintf(pBueffel,"%s %f\n",name,pVar->fVal); + snprintf(pBueffel, SV_MAXBUF, "%s %f\n",name,pVar->fVal); break; } fputs(pBueffel,fd); - sprintf(pBueffel,"%s setAccess %d\n",name,pVar->iAccessCode); + snprintf(pBueffel, SV_MAXBUF, "%s setAccess %d\n",name,pVar->iAccessCode); fputs(pBueffel,fd); return 1; } @@ -141,7 +142,7 @@ int argc, char *argv[]) { pSicsVariable pRes = NULL; - char pBueffel[512]; + char errMsg[512]; VarType eType; int i; int iCode, iRet; @@ -153,9 +154,9 @@ argtolower(argc,argv); if(argc < 4) { - sprintf(pBueffel,"Insufficient no of args to %s, Usage: %s name type accescode", + sprintf(errMsg,"Insufficient no of args to %s, Usage: %s name type accescode", argv[0],argv[0]); - SCWrite(pCon,pBueffel,eError); + SCWrite(pCon,errMsg,eError); return 0; } @@ -182,18 +183,18 @@ eType = veFloat; break; default: - sprintf(pBueffel,"Var %s Type --> %s <-- not recognized", + sprintf(errMsg,"Var %s Type --> %s <-- not recognized", argv[1], argv[2]); - SCWrite(pCon,pBueffel,eError); + SCWrite(pCon,errMsg,eError); return 0; } /* argv[3] must be the access code, check that now */ i = decodeSICSPriv(argv[3]); if(i < 0){ - sprintf(pBueffel," %s access code %s not recognized", + sprintf(errMsg," %s access code %s not recognized", argv[1], argv[3]); - SCWrite(pCon,pBueffel,eError); + SCWrite(pCon,errMsg,eError); return 0; } @@ -201,15 +202,15 @@ pRes = VarCreate(i,eType,argv[1]); if(!pRes) { - sprintf(pBueffel,"Memory Error creating variable %s", argv[1]); - SCWrite(pCon,pBueffel,eError); + sprintf(errMsg,"Memory Error creating variable %s", argv[1]); + SCWrite(pCon,errMsg,eError); return 0; } iRet = AddCommand(pSics,argv[1],VarWrapper,(KillFunc)VarKill,pRes); if(!iRet) { - sprintf(pBueffel,"ERROR: duplicate command %s not created",argv[1]); - SCWrite(pCon,pBueffel,eError); + sprintf(errMsg,"ERROR: duplicate command %s not created",argv[1]); + SCWrite(pCon,errMsg,eError); VarKill(pRes); return 0; } @@ -349,7 +350,7 @@ commandContext cc) { SConnection *pCon; - char pBueffel[512]; + char pBueffel[SV_MAXBUF]; pSicsVariable pVar = NULL; int iVal, status; float fVal; @@ -365,19 +366,19 @@ { case veInt: VarGetInt(pVar,&iVal); - sprintf(pBueffel,"%s = %d",pVar->name,iVal); + snprintf(pBueffel, SV_MAXBUF, "%s = %d",pVar->name,iVal); SCWrite(pCon,pBueffel,eValue); status = 1; break; case veFloat: VarGetFloat(pVar,&fVal); - sprintf(pBueffel,"%s = %f",pVar->name,fVal); + snprintf(pBueffel, SV_MAXBUF, "%s = %f",pVar->name,fVal); SCWrite(pCon,pBueffel,eValue); status = 1; break; case veText: VarGetText(pVar,&pText); - sprintf(pBueffel,"%s = %s", pVar->name,pText); + snprintf(pBueffel, SV_MAXBUF, "%s = %s", pVar->name,pText); SCWrite(pCon,pBueffel,eValue); if(pText) { @@ -394,7 +395,7 @@ static int VarSetFromText(pSicsVariable self, SConnection *pCon, char *text) { int status; double dVal; - char pBueffel[132]; + char errMsg[132]; if(!SCMatchRights(pCon,self->iAccessCode)) { @@ -407,9 +408,9 @@ static int VarSetFromText(pSicsVariable self, SConnection *pCon, char *text) status = Tcl_GetDouble(InterpGetTcl(pServ->pSics), text,&dVal); if(status != TCL_OK) { - snprintf(pBueffel,131,"ERROR: failed to convert %s to number", + snprintf(errMsg,131,"ERROR: failed to convert %s to number", text); - SCWrite(pCon,pBueffel,eError); + SCWrite(pCon,errMsg,eError); return 0; } if(self->eType == veInt) @@ -439,7 +440,7 @@ static int VarSetFromText(pSicsVariable self, SConnection *pCon, char *text) VarType eTyp; TokenList *pList = NULL; TokenList *pCurrent; - char pBueffel[256]; + char pBueffel[SV_MAXBUF]; int iRet; Status eStat; long lID; @@ -467,19 +468,19 @@ static int VarSetFromText(pSicsVariable self, SConnection *pCon, char *text) { case veInt: VarGetInt(pVar,&iVal); - sprintf(pBueffel,"%s = %d",argv[0],iVal); + snprintf(pBueffel, SV_MAXBUF, "%s = %d",argv[0],iVal); SCWrite(pCon,pBueffel,eValue); DeleteTokenList(pList); return 1; case veFloat: VarGetFloat(pVar,&fVal); - sprintf(pBueffel,"%s = %f",argv[0],fVal); + snprintf(pBueffel, SV_MAXBUF, "%s = %f",argv[0],fVal); SCWrite(pCon,pBueffel,eValue); DeleteTokenList(pList); return 1; case veText: VarGetText(pVar,&pText); - sprintf(pBueffel,"%s = %s", argv[0],pText); + snprintf(pBueffel, SV_MAXBUF, "%s = %s", argv[0],pText); SCWrite(pCon,pBueffel,eValue); if(pText) { @@ -574,7 +575,7 @@ static int VarSetFromText(pSicsVariable self, SConnection *pCon, char *text) SCWrite(pCon,"ERROR: new value missing for force",eError); return 0; } - Arg2Text(argc-2,&argv[2],pBueffel,255); + Arg2Text(argc-2,&argv[2],pBueffel,SV_MAXBUF-1); iRet = VarSetFromText(pVar,pCon,pBueffel); if(iRet == 1) { @@ -602,7 +603,7 @@ static int VarSetFromText(pSicsVariable self, SConnection *pCon, char *text) /* is it locked ? */ if(pVar->iLock) { - sprintf(pBueffel,"ERROR: variable %s is configured locked!", + snprintf(pBueffel, SV_MAXBUF, "ERROR: variable %s is configured locked!", argv[0]); SCWrite(pCon,pBueffel,eError); DeleteTokenList(pList); @@ -615,7 +616,7 @@ static int VarSetFromText(pSicsVariable self, SConnection *pCon, char *text) DeleteTokenList(pList); return 0; } - Arg2Text(argc-1,&argv[1],pBueffel,255); + Arg2Text(argc-1,&argv[1],pBueffel,SV_MAXBUF-1); iRet = VarSetFromText(pVar,pCon,pBueffel); if(iRet == 1) { diff --git a/site_ansto/anstohttp.c b/site_ansto/anstohttp.c index 4d42f122..1e4a9b39 100644 --- a/site_ansto/anstohttp.c +++ b/site_ansto/anstohttp.c @@ -26,6 +26,9 @@ #include extern char *trim(char *); +extern pICallBack statemon_cbinterface; +int ANSTO_HTTP_PAUSE = 0; +int AnstoHttpPause(pHistDriver self,SConnection *pCon); /*=================================================================== The request strings to append to the computer address ====================================================================*/ @@ -41,6 +44,7 @@ static char configure[] = {"/admin/configure.egi"}; static char preset[] = {"/admin/presethm.egi"}; static char dynamicsrvmodify[] = {"/admin/selectdynamicsrvmodify.egi?dynamicSRVmodifyparamname=%s&dynamicSRVmodifyparamvalue=%s"}; static char dynamicfatmodify[] = {"/admin/selectdynamicfatmodify.egi?dynamicFATmodifyparamname=%s&dynamicFATmodifyparamvalue=%s"}; +static char devName[32] = "histmem"; /*==================================================================== error codes ======================================================================*/ @@ -71,6 +75,7 @@ typedef struct { // the dictionary, even though a pointer to the dictionary isn't passed in. // Hopefully this will not have any side effects. pStringDict pOption; + pICallBack pCall; }anstoHttp, *pAnstoHttp; /*------------------------------------------------------------------*/ static int anstoHttpGetPrepare(pAnstoHttp self, char *request){ @@ -376,6 +381,7 @@ static int AnstoHttpStatus_Base(pHistDriver self,SConnection *pCon,int *pextrast ghttp_status httpStatus; char daqStatus[20]; int status; + pAnstoHttp pInternal = NULL; static int last_known_status=HWIdle; // assume idle initially pPriv = (pAnstoHttp)self->pPriv; @@ -384,9 +390,10 @@ static int AnstoHttpStatus_Base(pHistDriver self,SConnection *pCon,int *pextrast // MJL for the ANSTO histogram server we STILL need status checking to occur // even when in paused mode (our pause mode has a different functionality). // So the code below is removed. -/// if(pPriv->pause == 1){ -/// return HWPause; -/// } +/* ffr reenabled because we now have AnstoHttpVeto()*/ + if(pPriv->pause == 1){ + return HWPause; + } if(pPriv->asyncRunning == 0){ status = anstoHttpGetPrepare(pPriv,statusdaq); @@ -446,13 +453,17 @@ static int AnstoHttpStatus_Base(pHistDriver self,SConnection *pCon,int *pextrast // // Basically we just diagnose whether the DAQ is running or not, // but also return more detailed status via pextrastatus if supplied. + pInternal = (pAnstoHttp) self->pPriv; if(strstr(daqStatus,"Started") != NULL){ + if (last_known_status != HWBusy) + InvokeCallBack(statemon_cbinterface, STSTART, devName); if (pextrastatus) *pextrastatus=ANSTO_HS_STATUS_STARTED; return last_known_status=HWBusy; } else if(strstr(daqStatus,"Paused") != NULL){ if (pextrastatus) *pextrastatus=ANSTO_HS_STATUS_PAUSED; return last_known_status=HWIdle; } else if(strstr(daqStatus,"Stopped") != NULL){ + InvokeCallBack(statemon_cbinterface, STEND, devName); if (pextrastatus) *pextrastatus=ANSTO_HS_STATUS_STOPPED; return last_known_status=HWIdle; // @@ -519,7 +530,7 @@ static int AnstoHttpStatusWithRetries(pHistDriver self, int requiredstate,SConne &&(bad_status_requestspOption,"daq",daqStatus,20); if(strstr(daqStatus,"Stopped") != NULL){ @@ -597,6 +612,7 @@ static int AnstoHttpVeto(pHistDriver self,SConnection *pCon) pPriv->pause = 1; AnstoHttpStatusWithRetries(self,ANSTO_HS_STATUS_PAUSED,pCon); + InvokeCallBack(statemon_cbinterface, STPAUSE, devName); return OKOK; } @@ -614,18 +630,20 @@ static int AnstoHttpNoVeto(pHistDriver self,SConnection *pCon) } pPriv->pause = 0; AnstoHttpStatusWithRetries(self,ANSTO_HS_STATUS_STARTED,pCon); + InvokeCallBack(statemon_cbinterface, STCONTINUE, devName); return OKOK; } int AnstoHttpPause(pHistDriver self,SConnection *pCon){ pAnstoHttp pPriv = NULL; int status; +/* ffr revert to R2.3 char daqStatus[20]; StringDictGet(self->pOption,"daq",daqStatus,20); if(strstr(daqStatus,"Stopped") != NULL){ return OKOK; } - +*/ pPriv = (pAnstoHttp)self->pPriv; assert(pPriv != NULL); @@ -633,7 +651,9 @@ int AnstoHttpPause(pHistDriver self,SConnection *pCon){ if(status != 1){ return HWFault; } - pPriv->pause = 1; +/*ffr AnstoHttpVeto now provides pause() +pPriv->pause = 1; +*/ AnstoHttpStatusWithRetries(self,ANSTO_HS_STATUS_PAUSED,pCon); @@ -856,6 +876,9 @@ static int AnstoHttpFreePrivate(pHistDriver self){ if(pPriv->syncRequest != NULL){ ghttp_request_destroy(pPriv->syncRequest); } + if (pPriv->pCall != NULL) { + DeleteCallBackInterface(pPriv->pCall); + } free(pPriv); return 1; } @@ -864,6 +887,7 @@ static int AnstoHttpFreePrivate(pHistDriver self){ pHistDriver CreateAnstoHttpDriver(pStringDict pOption){ pHistDriver pNew = NULL; pAnstoHttp pInternal = NULL; + pICallBack pCallNew = NULL; /* create the general driver */ pNew = CreateHistDriver(pOption); @@ -890,11 +914,18 @@ pHistDriver CreateAnstoHttpDriver(pStringDict pOption){ free(pInternal); return NULL; } + pCallNew = CreateCallBackInterface(); + if (!pCallNew) { + free(pNew); + free(pInternal); + return NULL; + } // Save a pointer to the string dictionary internally, // for the use of those functions that require it and // don't get a pOption passed in via the argument list. pInternal->pOption=pOption; + pInternal->pCall = pCallNew; /* configure all those functions */ pNew->Configure = AnstoHttpConfigure; @@ -911,7 +942,7 @@ pHistDriver CreateAnstoHttpDriver(pStringDict pOption){ pNew->Preset = AnstoHttpPreset; pNew->FreePrivate = AnstoHttpFreePrivate; pNew->Pause = AnstoHttpVeto; - pNew->Continue = AnstoHttpNoVeto; + pNew->Continue = AnstoHttpContinue; return pNew; } @@ -930,6 +961,22 @@ pHistDriver CreateAnstoHttpDriver(pStringDict pOption){ SCSendOK(pCon); return 1; } + if(strcmp(argv[1],"veto") == 0) { + if(!SCMatchRights(pCon,usUser)) { + return 0; + } + AnstoHttpVeto(self->pDriv,pCon); + SCSendOK(pCon); + return 1; + } + if(strcmp(argv[1],"noveto") == 0) { + if(!SCMatchRights(pCon,usUser)) { + return 0; + } + AnstoHttpNoVeto(self->pDriv,pCon); + SCSendOK(pCon); + return 1; + } return HistAction(pCon, pSics, pData, argc, argv); } diff --git a/site_ansto/hardsup/makefile b/site_ansto/hardsup/makefile index 7a804347..39353c7b 100644 --- a/site_ansto/hardsup/makefile +++ b/site_ansto/hardsup/makefile @@ -10,7 +10,7 @@ SRC = . CC = gcc CFLAGS = -g -DLINUX $(DFORTIFY) -I$(SRC) -I../.. -Wall -Wno-unused -Wextra -HOBJ= nhq200util.o itc4util.o lh45util.o lakeshore340util.o west4100util.o asynsrv_utility.o geterrno.o strjoin.o chopper.o modbustcp.o sct_galilprot.o sct_orhvpsprot.o sct_velselprot.o sct_usbtmcprot.o +HOBJ= nhq200util.o itc4util.o lh45util.o lakeshore340util.o west4100util.o asynsrv_utility.o geterrno.o strjoin.o chopper.o modbustcp.o sct_galilprot.o sct_orhvpsprot.o sct_velselprot.o sct_usbtmcprot.o sct_ansrfamp.o libhlib.a: $(HOBJ) rm -f libhlib.a diff --git a/site_ansto/hmcontrol_ansto.c b/site_ansto/hmcontrol_ansto.c index 7ccaf798..98c01ada 100644 --- a/site_ansto/hmcontrol_ansto.c +++ b/site_ansto/hmcontrol_ansto.c @@ -21,6 +21,7 @@ #include "devexec.h" /*----------------------------------------------------------------------*/ +extern int ANSTO_HTTP_PAUSE; static int HMCStatus_ANSTO(void *pData, SConnection *pCon) // A slightly modified version of the original HMCStatus(), // to support pause-on-count-terminate option for ANSTO HM, @@ -47,9 +48,10 @@ static int HMCStatus_ANSTO(void *pData, SConnection *pCon) // functions to do this. // ffr: NOTE: Pause() is now mapped to AnstoHttpVeto() // we need to call AnstoHttpPause() via the histmem Pause - if (((pHMcontrol_ANSTO)pData)->Pause_HM_After_Count==1) + if (((pHMcontrol_ANSTO)pData)->Pause_HM_After_Count==1) { + ANSTO_HTTP_PAUSE = 1; self->pCount->Pause(self,pCon); - else + } else self->pCount->Halt(self); } /* diff --git a/site_ansto/instrument/config/commands/commands_common.tcl b/site_ansto/instrument/config/commands/commands_common.tcl index 8bd8616a..aefde99c 100644 --- a/site_ansto/instrument/config/commands/commands_common.tcl +++ b/site_ansto/instrument/config/commands/commands_common.tcl @@ -16,6 +16,7 @@ namespace eval ::histogram { int=0:inf preset float freq text=[join $::histogram_memory::ic_fsrce_values , ] frame_source + text=safe,fast cmd_mode }] { variable parameters switch $cmd { @@ -29,21 +30,28 @@ namespace eval ::histogram { } "start" { ::histogram::histmem_cmd -set feedback status STARTING - if {$parameters(mode) != $mode} { + if {$cmd_mode == "fast"} { + if {$parameters(mode) != $mode} { + histmem mode $mode + set parameters(mode) $mode + } + if {$parameters(preset) != $preset} { + histmem preset $preset + set parameters(preset) $preset + } + if {$parameters(freq) != $freq} { + histmem freq $freq + set parameters(freq) $freq + } + if {$parameters(frame_source) != $frame_source} { + histmem fsrce $frame_source + set parameters(frame_source) $frame_source + } + } else { histmem mode $mode - set parameters(mode) $mode - } - if {$parameters(preset) != $preset} { histmem preset $preset - set parameters(preset) $preset - } - if {$parameters(freq) != $freq} { histmem freq $freq - set parameters(freq) $freq - } - if {$parameters(frame_source) != $frame_source} { histmem fsrce $frame_source - set parameters(frame_source) $frame_source } histmem start ::histogram::histmem_cmd -set feedback status BUSY @@ -53,13 +61,15 @@ namespace eval ::histogram { } } } - ::histogram::histmem_cmd -set mode [histmem mode] - ::histogram::histmem_cmd -set preset [histmem preset] - ::histogram::histmem_cmd -set freq [histmem freq] - ::histogram::histmem_cmd -set frame_source [histmem fsrce] + ::histogram::histmem_cmd -set mode [::histogram_memory::count_method] + ::histogram::histmem_cmd -set preset 0 + ::histogram::histmem_cmd -set freq [::histogram_memory::get_frame_freq ] + ::histogram::histmem_cmd -set frame_source [::histogram_memory::get_frame_source ] + ::histogram::histmem_cmd -set cmd_mode "safe" ::histogram::histmem_cmd -addfb text status ::histogram::histmem_cmd -set feedback status IDLE sicslist setatt ::histogram::histmem_cmd long_name histmem + sicslist setatt ::histogram::histmem_cmd id histmem } # SCAN COMMANDS namespace eval ::scan { @@ -106,6 +116,10 @@ command hdb_bmonscan { text=save,nosave savetype text=true,false force }] { + variable parameters + + set parameters(mode) $mode + set parameters(preset) $preset ::scan::runscan $scan_variable $scan_start $scan_stop $numpoints $mode $preset savetype $savetype datatype $datatype force $force } ::scan::runscan_cmd -addfb float scan_variable_value float scan_step int scanpoint text status diff --git a/site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl b/site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl index 51168591..5d6eec67 100644 --- a/site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl +++ b/site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl @@ -27,7 +27,7 @@ set instrument_dictionary [subst { property {data true control true nxsave false klass @none type graphset} } instrument { - sobj {@any instrument @any NXvelocity_selector} + sobj {@any instrument @any NXvelocity_selector @any NXaperture @any NXdetector} privilege spy datatype @none property {data true control true nxsave false klass NXinstrument type instrument} @@ -38,6 +38,11 @@ set instrument_dictionary [subst { datatype @none property {data true control true nxsave true klass NXparameter type part} } + instrument/parameters/parameters_group { + privilege spy + datatype @none + property {data true control false nxsave false klass @none type nxvgroup nxalias parameters_group} + } instrument/parameters/derived_parameters { privilege spy sobj {@any derived_parameter} @@ -140,12 +145,6 @@ set instrument_dictionary [subst { datatype @none property {data true control true nxsave false klass NXsource type part} } - instrument/velocity_selector { - privilege spy - sobj {@any velocity_selector} - datatype @none - property {data true control true nxsave false klass NXvelocity_selector type part} - } instrument/detector { privilege spy sobj {@any detector} @@ -176,18 +175,17 @@ set instrument_dictionary [subst { datatype @none property {data true control true nxsave false klass NXsample type part} } + sample/sample_group { + privilege spy + datatype @none + property {data true control false nxsave false klass @none type nxvgroup nxalias sample_group} + } monitor { privilege spy sobj {@any monitor} datatype @none property {data true control true nxsave false klass NXmonitor type part} } - data { - privilege spy - sobj {@any data} - datatype @none - property {data true control false nxsave false klass NXdata type part datatype UNKNOWN currentfiletype UNKNOWN} - } event_data { privilege spy sobj {@any event_data} @@ -225,74 +223,15 @@ set instrument_dictionary [subst { datatype @none property {data false control true nxsave false klass @none type part} } + data { + privilege spy + sobj {@any data} + datatype @none + property {data true control false nxsave false klass NXdata type part datatype UNKNOWN currentfiletype UNKNOWN} + } data/data_set { privilege spy datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias data_set link @none} - } - data/axis_1 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias axis_1 link @none} - } - data/axis_2 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias axis_2 link @none} - } - data/axis_3 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias axis_3 link @none} - } - data/axis_4 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias axis_4 link @none} - } - data/aux_data_1 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias aux_data_1 link @none} - } - data/aux_data_2 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias aux_data_2 link @none} - } - data/aux_data_3 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias aux_data_3 link @none} - } - data/aux_data_4 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias aux_data_4 link @none} - } - data/aux_data_5 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias aux_data_5 link @none} - } - data/aux_data_6 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias aux_data_6 link @none} - } - data/aux_data_7 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias aux_data_7 link @none} - } - data/aux_data_8 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias aux_data_8 link @none} - } - data/aux_data_9 { - privilege spy - datatype @none - property {data true control false nxsave false klass @none type nxvgroup nxalias aux_data_9 link @none} + property {data true control false nxsave false klass @none type nxvgroup nxalias data_set} } }] diff --git a/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl b/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl index c49633a6..f6a06ff3 100644 --- a/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl +++ b/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl @@ -205,7 +205,6 @@ proc ::hdb::MakeVelocity_Selector {name paramlist} { # @param level, (optional,default=1) The location of the template parameters in the callstack. proc prune_NX {NXklist nx_template {path ""} {node ""} {level 1}} { upvar $NXklist newtable -# puts "[info level 0]\nCallstack depth = [info level]\nRecursion depth = [expr $level-1]" if {$path == ""} { set currpath $node } else { @@ -541,10 +540,6 @@ proc ::hdb::add_node {basePath args} { hsetprop $node_path/$child klass [getatt $node_name klass] } } - scobj { - set node_path ${basePath}/$node_name - hfactory $node_path link $node_name - } script - getset { # A r/w pair of scripts, node = a node path set node_path $basePath/[normalgetatt $node_name long_name] @@ -616,6 +611,7 @@ proc ::hdb::add_command {basePath command} { hsetprop $cmd_path control $cmd_atts(control) hsetprop $cmd_path klass $cmd_atts(klass) hsetprop $cmd_path nxsave $cmd_atts(nxsave) + hsetprop $cmd_path sicsdev $cmd_atts(id) return $cmd_path } @@ -687,7 +683,9 @@ proc ::hdb::sobjadd {hpath sobj args} { array unset sobjatt if [ catch { array set sobjatt [attlist $sobj] - sicslist setatt $sobj id $sobj + if {[sicslist exists $sobj id] == false} { + sicslist setatt $sobj id $sobj + } switch $sobjatt(type) { motor - configurablevirtualmotor { if {[info exists sobjatt(group)]} { @@ -791,8 +789,11 @@ proc ::hdb::sobjadd {hpath sobj args} { } # TODO Can this be replaced with a sct_* glob? sct_object { - set sobjName [normalgetatt $sobj long_name] - add_node $hpath node $sobjName long_name $sobjName kind scobj + set node_name [normalgetatt $sobj long_name] + set node_path $hpath/$node_name + hfactory $node_path link $sobj + hsetprop $node_path type $sobjatt(type) + sicslist setatt $sobj hdb_path $node_path } environment_controller { todo_msg "$sobjatt(type) case, add $sobj to $hpath" @@ -849,7 +850,9 @@ proc ::hdb::sobjtypeadd {hpath sobjtype given_klass} { proc ::hdb::prune {instdict} { upvar $instdict dict array set dictarr $dict - set candidates [array names dictarr] + foreach {n v} $dict { + lappend candidates $n + } # While there are candidates for removal remove the childless ones # which have an empty sobj list while {[expr [llength $candidates]] > 0} { @@ -870,6 +873,13 @@ proc ::hdb::prune {instdict} { if { [llength [join $sobjects]] == 0 } { if {[llength [array get dictarr $name/*]] == 0} { array unset dictarr $name + foreach {n v} $dict { + if {$n != $name} { + lappend tempdict $n + lappend tempdict $v + } + } + set $dict $tempdict } else { if {[lsearch $candidates $name/*] >= 0} { lappend new_candidates $name @@ -879,7 +889,6 @@ proc ::hdb::prune {instdict} { } set candidates $new_candidates } - set dict [array get dictarr] return } @@ -922,32 +931,34 @@ upvar #0 $instDict dictionary # @param top This is just here to make the recursion work from the top level, You don't need # to set this proc ::hdb::set_save {hpath mode {top true}} { - if {$hpath != "/"} { - set hnode $hpath - } else { - foreach hp [hlist /] { - ::hdb::set_save /$hp $mode - } - return - } - if {[::utility::hgetplainprop $hnode data] == "false"} { - return - } - foreach hp [hlist $hnode] { - set_save $hnode/$hp $mode false - } - if {$top == "true"} { - hsetprop $hnode nxsave $mode - if {$mode == "true"} { - set hp "" - foreach ps [lrange [split [string trim $hnode /] /] 0 end-1] { - set hp $hp/$ps - hsetprop $hp nxsave true - } +if [ catch { + if {$hpath != "/"} { + set hnode $hpath + if {[hpropexists $hnode data] && [hgetpropval $hnode data] != "false"} { + foreach hp [hlist $hnode] { + set_save $hnode/$hp $mode false + } + if {$top == "true"} { + hsetprop $hnode nxsave $mode + if {$mode == "true"} { + set hp "" + foreach ps [lrange [split [string trim $hnode /] /] 0 end-1] { + set hp $hp/$ps + hsetprop $hp nxsave true + } + } + } else { + hsetprop $hnode nxsave $mode + } + } + } else { + foreach hp [hlist /] { + ::hdb::set_save /$hp $mode + } } - } else { - hsetprop $hnode nxsave $mode - } +} message ] { + return -code error "([info level 0]) $message" +} } namespace import ::hdb::* diff --git a/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl b/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl index 807480cc..38f78c06 100644 --- a/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl +++ b/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.46 $ -# $Date: 2009-03-31 06:25:18 $ +# $Revision: 1.47 $ +# $Date: 2009-11-24 22:56:46 $ # Author: Ferdi Franceschini # Based on the examples in the hs_test.tcl sample configuration by Mark Lesha. # http://gumtree.ansto.gov.au:9080/nbicms/bragg-systems/histogram-server/hs_test.tcl/view @@ -14,6 +14,9 @@ # ::histogram_memory::ic_initialize # #@see ::histogram_memory::ic_initialize + + +source $cfPath(hmm)/hmm_object.tcl namespace eval histogram_memory { # Common config variables variable histmem_simulation @@ -41,13 +44,13 @@ namespace eval histogram_memory { set ic_fsrce_values [ list INTERNAL EXTERNAL ] set ic_count_methods [concat [list time unlimited period count frame] $::counter::isc_beam_monitor_list ] if {$histmem_simulation == "true"} { - ANSTO_MakeHM hmm SIM - ANSTO_MakeHM hmm_xy SIM - ANSTO_MakeHM hmm_xt SIM - ANSTO_MakeHM hmm_yt SIM - ANSTO_MakeHM hmm_x SIM - ANSTO_MakeHM hmm_y SIM - ANSTO_MakeHM hmm_t SIM + MakeHM hmm SIM + # MakeHM hmm_xy SIM + # MakeHM hmm_xt SIM + # MakeHM hmm_yt SIM + # MakeHM hmm_x SIM + # MakeHM hmm_y SIM + # MakeHM hmm_t SIM hmm configure daq Stopped hmm configure statuscheck false hmm configure num_events_filled_to_histo 12345 @@ -68,29 +71,14 @@ namespace eval histogram_memory { bm preset $_preset hmm countblock } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } } else { ANSTO_MakeHM hmm anstohttp - ANSTO_MakeHM hmm_xy anstohttp - ANSTO_MakeHM hmm_xt anstohttp - ANSTO_MakeHM hmm_yt anstohttp - ANSTO_MakeHM hmm_x anstohttp - ANSTO_MakeHM hmm_y anstohttp - ANSTO_MakeHM hmm_t anstohttp - - MakeHMControl_ANSTO hmc bm hmm; + MakeHMControl_ANSTO hmc bm hmm; } - hmm configure rank 3 - hmm_xy configure rank 2 - hmm_xt configure rank 2 - hmm_yt configure rank 2 - hmm_x configure rank 1 - hmm_y configure rank 1 - hmm_t configure rank 1 # Frame source for each instrument if freq = 0, this can happen when automatically @@ -127,8 +115,7 @@ namespace eval histogram_memory { ::utility::mkVar hmm_mode Text user mode true detector true true ::utility::mkVar hmm_preset Float user preset true detector true true } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } ############################################## @@ -150,11 +137,11 @@ namespace eval histogram_memory { set fh [open $filename] set xml [read $fh] close $fh - return [subst $xml] + set cfg [subst $xml] } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $cfg } # Here, define a function to let us read back the value of dictionary items from the hmm @@ -162,12 +149,11 @@ namespace eval histogram_memory { proc hmmdictitemval {histomem dictitem} { if [ catch { set resp [$histomem configure $dictitem] - set retn [lindex [split $resp " "] 2] - return $retn + set retn [lindex [split $resp " "] 2] } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $retn } ## @@ -179,8 +165,7 @@ namespace eval histogram_memory { hmm configure FAT_COUNT_STOP $count_stop hmm init } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -220,8 +205,7 @@ namespace eval histogram_memory { hmm configure FAT_OFFSET_OAT_T $oatoff_t hmm init } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -249,8 +233,8 @@ namespace eval histogram_memory { ## Scan Callback Procedures ## ############################################## ############################################## - - +if {0} { +#XXX REMOVE proc init {} { } proc graphics_hpath_setup {parent} { @@ -261,7 +245,7 @@ namespace eval histogram_memory { } proc experiment_hpath_setup {parent} { } - +} proc set_sobj_attributes {} { if [ catch { # SICS commands @@ -274,15 +258,8 @@ namespace eval histogram_memory { sicslist setatt ::histogram_memory::returnconfigfile privilege internal; sicslist setatt ::histogram_memory::save privilege internal; - foreach hm_obj [sicslist type histmem] { - set_sicsobj_atts $hm_obj detector @none $hm_obj false true; - sicslist setatt $hm_obj privilege user - sicslist setatt $hm_obj kind hobj - sicslist setatt $hm_obj nxsave false - } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -302,60 +279,60 @@ namespace eval histogram_memory { } } } - ## @brief Calculate axis array from a given list of bin boundaries + ## @brief Use boundaries or centres to calculate axis values # - # @param proc_name Fully qualified name of the calling procedure + # @param axis_name x_bin, y_bin, x_pixel_offset, y_pixel_offset, two_theta + # @param type centres or boundaries + proc set_graphtype {axis_name type} { + variable state + + switch -- $type { + "centres" { + set state($axis_name,graph_type) "centres" + } + "boundaries" { + set state($axis_name,graph_type) "boundaries" + } + default { + error "ERROR: Unknown graph type $type" + } + } + } + + proc get_graphtype {axis_name} { + variable state + return $state($axis_name,graph_type) + } + + ## @brief Calculate axis array from a given list of bin boundaries + # Generates a sicsdata array + # + # @param axis_name Fully qualified name of the calling procedure # @param scale_factor axis scale factor or @none # @param offset axis offset or @none # @param boundaries list of bin boundaries or @none - proc calc_axis {proc_name scale_factor offset boundaries args} { + proc calc_axis {axis_name scale_factor offset boundaries {bb_zero_offset 0}} { variable state + set bin_array ::histogram_memory::${axis_name}_array if [ catch { - set parlist [join $args] - set opt [lindex $parlist 0] - set arglist [lrange $parlist 1 end] - if {$scale_factor == "@none" || $boundaries == "@none"} { - # Don't calculate axis values, we're just setting or getting the graph_type + set i 0 + $bin_array clear + if {$state($axis_name,graph_type) == "boundaries"} { + foreach bb $boundaries { + set val [expr {$scale_factor*($bb+$bb_zero_offset) + $offset}] + $bin_array putfloat $i $val + incr i + } } else { - set i 0 - ${proc_name}_array clear - if {$state($proc_name,graph_type) == "boundaries"} { - foreach bb $boundaries { - set val [expr {$scale_factor*$bb + $offset}] - lappend values $val - ${proc_name}_array putfloat $i $val - incr i - } - } else { - foreach b0 [lrange $boundaries 0 end-1] b1 [lrange $boundaries 1 end] { - set val [expr {$scale_factor*($b1 + $b0)/2.0 + $offset}] - lappend values $val - ${proc_name}_array putfloat $i $val - incr i - } - } - } - switch -- $opt { - "-arrayname" { - return "${proc_name}_array" - } - "-centres" { - set state($proc_name,graph_type) "centres" - } - "-boundaries" { - set state($proc_name,graph_type) "boundaries" - } - "-graph_type" { - return $state($proc_name,graph_type) - } - default { - return $values + foreach b0 [lrange $boundaries 0 end-1] b1 [lrange $boundaries 1 end] { + set val [expr {$scale_factor*($bb_zero_offset + ($b1 + $b0)/2.0) + $offset}] + $bin_array putfloat $i $val + incr i } } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -364,24 +341,16 @@ namespace eval histogram_memory { # @brief Provides y_bin boundary array for data axes proc y_bin {args} { if [ catch { - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $arglist] - } - "-arrayname" { - return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE Y -getdata BOUNDARIES] $opt $arglist] - } - default { - return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE Y -getdata BOUNDARIES] $args] - } + ::histogram_memory::calc_axis "y_bin" 1.0 0.0 [OAT_TABLE Y -getdata BOUNDARIES] + if {$args == "-get_data_ref"} { + set binarray "::histogram_memory::y_bin_array" + } else { + set binarray [::histogram_memory::y_bin_array used] } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $binarray } set script_name ::histogram_memory::y_bin publish $script_name user @@ -403,24 +372,16 @@ namespace eval histogram_memory { # @brief Provides x_bin boundary array for data axes proc x_bin {args} { if [ catch { - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $arglist] - } - "-arrayname" { - return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist] - } - default { - return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE X -getdata BOUNDARIES] $args] - } + ::histogram_memory::calc_axis "x_bin" 1.0 0.0 [OAT_TABLE X -getdata BOUNDARIES] + if {$args == "-get_data_ref"} { + set binarray "::histogram_memory::x_bin_array" + } else { + set binarray [::histogram_memory::x_bin_array used] } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $binarray } set script_name ::histogram_memory::x_bin publish $script_name user @@ -442,35 +403,20 @@ namespace eval histogram_memory { proc y_pixel_offset {args} { variable state if [ catch { - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $arglist] - } - "-arrayname" { - set det_height_mm [SplitReply [detector_active_height_mm]] - set max_chan [OAT_TABLE Y -getdata MAX_CHAN] - set scale_factor [expr {$det_height_mm / $max_chan}] - set offset 0.0 - return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE Y -getdata BOUNDARIES] $opt $arglist] - } - "-units" { - return "mm" - } - default { - set det_height_mm [SplitReply [detector_active_height_mm]] - set max_chan [OAT_TABLE Y -getdata MAX_CHAN] - set scale_factor [expr {$det_height_mm / $max_chan}] - set offset 0.0 - return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE Y -getdata BOUNDARIES] $args] - } + set det_height_mm [SplitReply [detector_active_height_mm]] + set max_chan [OAT_TABLE Y -getdata MAX_CHAN] + set scale_factor [expr {$det_height_mm / $max_chan}] + set offset 0.0 + ::histogram_memory::calc_axis "y_pixel_offset" $scale_factor $offset [OAT_TABLE Y -getdata BOUNDARIES] + if {$args == "-get_data_ref"} { + set binarray "::histogram_memory::y_pixel_offset_array" + } else { + set binarray [::histogram_memory::y_pixel_offset_array used] } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $binarray } set script_name ::histogram_memory::y_pixel_offset publish $script_name user @@ -485,7 +431,7 @@ namespace eval histogram_memory { sicslist setatt $script_name nxsave true sicslist setatt $script_name mutable false sicslist setatt $script_name long_name y_pixel_offset - sicslist setatt $script_name units [::histogram_memory::y_pixel_offset -units] + sicslist setatt $script_name units "mm" unset script_name # requires detector_active_width_mm det_radius_mm @@ -493,35 +439,20 @@ namespace eval histogram_memory { proc x_pixel_offset {args} { variable state if [ catch { - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args] - } - "-arrayname" { - set det_width_mm [SplitReply [detector_active_width_mm]] - set max_chan [OAT_TABLE X -getdata MAX_CHAN] - set scale_factor [expr {$det_width_mm / $max_chan}] - set offset 0.0 - return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist] - } - "-units" { - return "mm" - } - default { - set det_width_mm [SplitReply [detector_active_width_mm]] - set max_chan [OAT_TABLE X -getdata MAX_CHAN] - set scale_factor [expr {$det_width_mm / $max_chan}] - set offset 0.0 - return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $args] - } + set det_width_mm [SplitReply [detector_active_width_mm]] + set max_chan [OAT_TABLE X -getdata MAX_CHAN] + set scale_factor [expr {$det_width_mm / $max_chan}] + set offset 0.0 + ::histogram_memory::calc_axis "x_pixel_offset" $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] + if {$args == "-get_data_ref"} { + set binarray "::histogram_memory::x_pixel_offset_array" + } else { + set binarray [::histogram_memory::x_pixel_offset_array used] } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $binarray } set script_name ::histogram_memory::x_pixel_offset publish $script_name user @@ -536,31 +467,23 @@ namespace eval histogram_memory { sicslist setatt $script_name nxsave true sicslist setatt $script_name mutable false sicslist setatt $script_name long_name x_pixel_offset - sicslist setatt $script_name units [::histogram_memory::x_pixel_offset -units] + sicslist setatt $script_name units "mm" unset script_name sicsdatafactory new ::histogram_memory::time_channel_array proc time_channel {args} { variable state if [ catch { - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args] - } - "-arrayname" { - return [::histogram_memory::calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE T -getdata BOUNDARIES] $opt $arglist] - } - default { - return [::histogram_memory::calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE T -getdata BOUNDARIES] $args] - } + ::histogram_memory::calc_axis "time_channel" [::histogram_memory::clock_scale] 0.0 [OAT_TABLE T -getdata BOUNDARIES] + if {$args == "-get_data_ref"} { + set binarray "::histogram_memory::time_channel_array" + } else { + set binarray [::histogram_memory::time_channel_array used] } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $binarray } set script_name ::histogram_memory::time_channel publish $script_name user @@ -614,11 +537,10 @@ proc ::histogram_memory::calc_boundaries {values channels} { } else { error "ERROR: You must specify at least two bin boundaries" } - return $BOUNDARIES } message ] { - if {$::errorCode=="NONE"} {return $message} return -code error $message } + return $BOUNDARIES } set hmm_xml "" @@ -652,6 +574,7 @@ proc HISTMEM_TABLE {tpath args} { global hmm_xml if [ catch { + set retVal "" set tpath [string toupper $tpath] foreach {opt arglist} [::utility::get_opt_arglist $args] {} switch -- $opt { @@ -660,14 +583,14 @@ proc HISTMEM_TABLE {tpath args} { } "-allowed_attributes" { if {[llength $arglist] == 0} { - return [::utility::tabget hmm_xml $tpath/_ALLOWED_ATTRIBUTES_] + set retVal [::utility::tabget hmm_xml $tpath/_ALLOWED_ATTRIBUTES_] } else { ::utility::tabset hmm_xml $tpath/_ALLOWED_ATTRIBUTES_ [lindex $arglist 0] } } "-allowed_elements" { if {[llength $arglist] == 0} { - return [::utility::tabget hmm_xml $tpath/_ALLOWED_ELEMENTS_] + set retVal [::utility::tabget hmm_xml $tpath/_ALLOWED_ELEMENTS_] } else { ::utility::tabset hmm_xml $tpath/_ALLOWED_ELEMENTS_ [lindex $arglist 0] ::utility::tabset hmm_xml $tpath/_ELEMENTS_ [lindex $arglist 0] @@ -693,11 +616,11 @@ proc HISTMEM_TABLE {tpath args} { } "-getel" { set element [lindex $arglist 0] - return [::utility::tabget hmm_xml $tpath/$element/_CONTENT_] + set retVal [::utility::tabget hmm_xml $tpath/$element/_CONTENT_] } "-getatt" { set attribute [lindex $arglist 0] - return [::utility::tabget hmm_xml $tpath/_ATTLIST_/$attribute] + set retVal [::utility::tabget hmm_xml $tpath/_ATTLIST_/$attribute] } "-delel" { set element [lindex $arglist 0] @@ -730,21 +653,22 @@ proc HISTMEM_TABLE {tpath args} { set arglist [lindex $arglist 0] } if {[llength $arglist] <= 1} { - return [::utility::tabget hmm_xml $tpath/_DATA_/$arglist] + set retVal [::utility::tabget hmm_xml $tpath/_DATA_/$arglist] } else { foreach name $arglist { lappend values [::utility::tabget hmm_xml $tpath/_DATA_/$name] } - return $values + set retVal $values } } "-getxml" { - return [::utility::tabxml hmm_xml $tpath] + set retVal [::utility::tabxml hmm_xml $tpath] } } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" + } else { + return $retVal } } @@ -753,8 +677,8 @@ proc HISTMEM_TABLE {tpath args} { # proc BAT_TABLE {args} { if [ catch { - set attributes { FRAME_FREQUENCY SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE } - set elements {{ }} + set attributes { NO_BAT_ENTRIES NO_BAT_PERIODS NO_REPEAT_ENTRY NO_REPEAT_TABLE NO_EXECUTE_TABLE } + set elements {{PERIOD_INDICES }} set tag BAT foreach {opt arglist} [::utility::get_opt_arglist $args] {} @@ -832,7 +756,7 @@ proc BAT_TABLE {args} { } } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -920,7 +844,7 @@ proc CAT_TABLE {args} { } } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -1009,7 +933,7 @@ proc FAT_TABLE {args} { } } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -1139,7 +1063,7 @@ proc OAT_TABLE {args} { } } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -1225,7 +1149,7 @@ proc SAT_TABLE {args} { } } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -1238,8 +1162,7 @@ proc ::histogram_memory::synch_tables {} { set notch [OAT_TABLE -get NTC] FAT_TABLE -set SIZE_PERIOD [expr $noxch*$noych*$notch] } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -1252,8 +1175,7 @@ proc ::histogram_memory::clear_tables {} { OAT_TABLE -clear SAT_TABLE -clear } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -1283,7 +1205,7 @@ proc ::histogram_memory::max_chan_num {axis} { return $numb_bins } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } ## @@ -1296,15 +1218,13 @@ proc ::histogram_memory::max_chan_num {axis} { proc ::histogram_memory::filler_defaults {args} { variable hmm_def_filename if [ catch { - if {[llength $args] == 0} { - return $hmm_def_filename - } else { + if {[llength $args] > 0} { set hmm_def_filename $args } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $hmm_def_filename } ## @@ -1314,11 +1234,10 @@ proc ::histogram_memory::filler_defaults {args} { proc ::histogram_memory::oat_bins {axis} { if [ catch { set bins [OAT_TABLE -get $axis] - return $bins } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $bins } ## @@ -1328,11 +1247,11 @@ proc ::histogram_memory::oat_bins {axis} { proc ::histogram_memory::number_of_channels {axis} { array set channID {X NXC Y NYC T NTC} if [ catch { - return [OAT_TABLE -get $channID($axis)] + set nchans [OAT_TABLE -get $channID($axis)] } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $nchans } # TODO Set current oat table after uploading proposed oat_table @@ -1353,7 +1272,7 @@ proc ::histogram_memory::upload_config {filler_defaults} { hmm configure statuscheck true hmm stop hmm configure statuscheck false - ::histogram_memory::configure_dims +# ::histogram_memory::configure_dims # foreach axis {X Y T} { # set bins [oat_bins $axis] # set nch [number_of_channels $axis] @@ -1364,74 +1283,12 @@ proc ::histogram_memory::upload_config {filler_defaults} { clientput "histmem configuration uploaded" return $message } else { - return -code error $message + return -code error "([info level 0]) $message" } } } -## -# @brief Configure the dimensions for the controlling histogram object, and for -# each auxiliary histogram object. -proc ::histogram_memory::configure_dims {} { - if [ catch { - if {[instname] == "wombat"} { - array set dim_map { - hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc} {hmm_dim2 stitch_nxc}} - hmm,read_data_type HISTOPERIOD_XYT - hmm_xy {{hmm_dim0 stitch_nyc} {hmm_dim1 stitch_nxc}} - hmm_xy,read_data_type TOTAL_HISTOGRAM_XY - hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nxc}} - hmm_xt,read_data_type TOTAL_HISTOGRAM_XT - hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc}} - hmm_yt,read_data_type TOTAL_HISTOGRAM_YT - hmm_x {{hmm_dim0 stitch_nxc}} - hmm_x,read_data_type TOTAL_HISTOGRAM_X - hmm_y {{hmm_dim0 stitch_nyc}} - hmm_y,read_data_type TOTAL_HISTOGRAM_Y - hmm_t {{hmm_dim0 oat_ntc_eff}} - hmm_t,read_data_type TOTAL_HISTOGRAM_T - } - } else { - array set dim_map { - hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff} {hmm_dim2 oat_nxc_eff}} - hmm,read_data_type HISTOPERIOD_XYT - hmm_xy {{hmm_dim0 oat_nyc_eff} {hmm_dim1 oat_nxc_eff}} - hmm_xy,read_data_type TOTAL_HISTOGRAM_XY - hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nxc_eff}} - hmm_xt,read_data_type TOTAL_HISTOGRAM_XT - hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff}} - hmm_yt,read_data_type TOTAL_HISTOGRAM_YT - hmm_x {{hmm_dim0 oat_nxc_eff}} - hmm_x,read_data_type TOTAL_HISTOGRAM_X - hmm_y {{hmm_dim0 oat_nyc_eff}} - hmm_y,read_data_type TOTAL_HISTOGRAM_Y - hmm_t {{hmm_dim0 oat_ntc_eff}} - hmm_t,read_data_type TOTAL_HISTOGRAM_T - } - } - - foreach hm_obj [sicslist type histmem] { - set rank [SplitReply [$hm_obj configure rank]] - foreach elmt $dim_map($hm_obj) { - set [lindex $elmt 0] [hmmdictitemval hmm [lindex $elmt 1]] - } - $hm_obj configure READ_DATA_TYPE $dim_map($hm_obj,read_data_type) -# ffr:SICS-330 UNCALIBRATED stops "hmm get 1" commands from getting data -# $hm_obj configure READ_DATA_UNCAL_CAL UNCALIBRATED - $hm_obj stop - $hm_obj configure init 0 - $hm_obj init - - for {set i 0} {$i < $rank} {incr i} { - $hm_obj configure dim$i [set hmm_dim$i] - } - } - } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message - } -} ## # @brief If set to true then the frame_source will always be set to INTERNAL. # @@ -1451,7 +1308,7 @@ proc ::histogram_memory::frame_source_always_internal {args} { } } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } publish ::histogram_memory::frame_source_always_internal mugger @@ -1468,7 +1325,7 @@ proc ::histogram_memory::get_frame_source {} { } } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } ## @@ -1493,19 +1350,18 @@ proc ::histogram_memory::set_frame_source {srce} { ::histogram_memory::stop hmm init } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } ## # @brief Return the last frame frequency which SICS attempted to set proc ::histogram_memory::get_frame_freq {} { if [ catch { - return [SplitReply [hmm configure fat_frame_frequency]] + set frameFreq [SplitReply [hmm configure fat_frame_frequency]] } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $frameFreq } ## @@ -1545,8 +1401,7 @@ proc ::histogram_memory::set_frame_freq {freq {frame_source EXTERNAL}} { hmm configure fat_frame_frequency $newfreq hmm init } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } publish ::histogram_memory::set_frame_freq user @@ -1555,8 +1410,7 @@ proc ::histogram_memory::t_max {} { if [ catch { set frame_freq [SplitReply [hmm configure fat_frame_frequency]] } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -1636,11 +1490,11 @@ proc ::histogram_memory::ic_initialize {} { } } set configuration "::histogram_memory::returnconfigfile config/hmm/anstohm_linked.xml" - ::histogram_memory::y_bin -boundaries - ::histogram_memory::x_bin -boundaries - ::histogram_memory::y_pixel_offset -boundaries - ::histogram_memory::x_pixel_offset -boundaries - ::histogram_memory::time_channel -boundaries + ::histogram_memory::set_graphtype "y_bin" "boundaries" + ::histogram_memory::set_graphtype "x_bin" "boundaries" + ::histogram_memory::set_graphtype "y_pixel_offset" "boundaries" + ::histogram_memory::set_graphtype "x_pixel_offset" "boundaries" + ::histogram_memory::set_graphtype "time_channel" "boundaries" ::histogram_memory::clear_tables # FAT_TABLE -set VIEW_MAG_X -1 VIEW_MAG_Y -1 @@ -1650,24 +1504,19 @@ proc ::histogram_memory::ic_initialize {} { $hm_obj configure password SICS $hm_obj configure histmode transparent } - hmm configure init 0 - hmm init - hmm configure statuscheck true - hmm stop - hmm configure statuscheck false + ::histogram_memory::initialise_dictionary ::histogram_memory::frame_source_always_internal $default_frame_source_always_internal([instname]) ::histogram_memory::set_frame_freq 50 ::histogram_memory::set_frame_source $default_frame_source_when_there_is_no_frame_signal([instname]) ::histogram_memory::count_method unlimited ::histogram_memory::count_size 0 - ::histogram_memory::veto false + ::histogram_memory::softveto false hmm configure hmDataPath ../HMData hmm configure hmconfigscript $configuration - ::histogram_memory::configure_dims +#XXX ::histogram_memory::configure_dims scriptcallback connect hmm COUNTEND ::histogram_memory::countend_event } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -1709,11 +1558,7 @@ proc ::histogram_memory::post_count {} {} if {$oscmd_controlled == "true"} { hmm count } else { - #hmc start 1000000000 timer pause 1 - # ffr: Can't set pause because this now calls the - # new AnstoHttpVeto function. hmcontrol_ansto.c needs - # to be fixed so it calls AnstoHttpPause() - hmc start 1000000000 timer stop 1 + hmc start 1000000000 timer pause 1 } } set reply [SplitReply [hmm configure daq]] @@ -1723,21 +1568,21 @@ proc ::histogram_memory::post_count {} {} clientput "histmem started" value if {$blocking == "block"} { blockctr count 0 + ::histogram_memory::pause } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } - proc ::histogram_memory::veto {{enable ""}} { + proc ::histogram_memory::softveto {{enable ""}} { variable state if {$enable == ""} { return $state(veto) } if {[string is boolean $enable] == 0} { - error "ERROR: $args must be a boolean" + error "ERROR: $enable must be a boolean" } else { if {$enable} { hmm configure FAT_SOFT_VETO_1 ENABLE @@ -1746,6 +1591,28 @@ proc ::histogram_memory::post_count {} {} } } } + + proc ::histogram_memory::veto {action} { + switch $action { + "enable" { + if {[status] == "status = Counting"} { + hmm veto + } else { + error "ERROR: veto only allowed while counting" + } + } + "disable" { + if {[status] == "status = Paused"} { + hmm noveto + } else { + error "ERROR: disabling veto not allowed in this state" + } + } + default { + error "ERROR: $action must be 'enable' or 'disable'" + } + } + } ## # @brief This sends the magic incantation which stops the histogram server. @@ -1761,13 +1628,9 @@ proc ::histogram_memory::post_count {} {} error "ERROR: Histogram server failed to stop" } } message ] { - if {$::errorCode=="NONE"} { - clientput "histmem stopped" value - return $message - } else { - return -code error $message - } + return -code error "([info level 0]) $message" } + clientput "histmem stopped" value } ## # @brief Allows resume if MULTIPLE_DATASETS=DISABLE, otherwise if MULTIPLE_DATASETS=ENABLE @@ -1782,13 +1645,9 @@ proc ::histogram_memory::post_count {} {} error "ERROR: Histogram server failed to pause" } } message ] { - if {$::errorCode=="NONE"} { - clientput "histmem paused" value - return $message - } else { - return -code error $message - } + return -code error "([info level 0]) $message" } + clientput "histmem paused" value } ## @@ -1800,35 +1659,33 @@ proc ::histogram_memory::post_count {} {} variable preset_mult variable monitor_controlled + if {$method==""} { + return [SplitReply [hmm_mode]] + } if [ catch { set modes $ic_count_methods - if {$method==""} { - return [SplitReply [hmm_mode]] - } else { - if {[lsearch $modes $method] == -1} { - error "ERROR: Count mode, $method, must be one of $modes" - } - if {$method == "time"} { - set preset_mult 100 - } else { - set preset_mult 1 - } - hmm configure FAT_COUNT_METHOD $method - if {[string range $method 0 [string first "R_" $method]] == "MONITOR"} { - hmm configure FAT_${method}_CONTROL ENABLE - set bmchan [expr [string index $method end] - 1] - bm setchannel $bmchan - set monitor_controlled "true" - } else { - set monitor_controlled "false" - } - hmm stop - hmm init - hmm_mode $method + if {[lsearch $modes $method] == -1} { + error "ERROR: Count mode, $method, must be one of $modes" } + if {$method == "time"} { + set preset_mult 100 + } else { + set preset_mult 1 + } + hmm configure FAT_COUNT_METHOD $method + if {[string range $method 0 [string first "R_" $method]] == "MONITOR"} { + hmm configure FAT_${method}_CONTROL ENABLE + set bmchan [expr [string index $method end] - 1] + bm setchannel $bmchan + set monitor_controlled "true" + } else { + set monitor_controlled "false" + } + hmm stop + hmm init + hmm_mode $method } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -1855,7 +1712,7 @@ proc ::histogram_memory::post_count {} {} } } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -1863,13 +1720,13 @@ proc ::histogram_memory::post_count {} {} # @brief Check histogram memory status # # @return Stopped, Paused, Started, or raises a Tcl error - proc ::histogram_memory::status {} { + proc ::histogram_memory::hmm_status {} { if [ catch { set reply [SplitReply [hmm configure daq]] } message ] { - if {$::errorCode=="NONE"} {return $reply} - return -code error $message + return -code error "([info level 0]) $message" } + return $reply } ## @@ -1889,7 +1746,7 @@ proc ::histogram_memory::post_count {} {} } } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } namespace eval ::histogram_memory { @@ -1929,6 +1786,9 @@ namespace eval ::histogram_memory { "pause" { ::histogram_memory::pause } + "veto" { + eval "::histogram_memory::veto $args" + } "mode" { if {$args == ""} { set reply [::histogram_memory::count_method ] @@ -1958,7 +1818,7 @@ namespace eval ::histogram_memory { } } "status" { - set reply [::histogram_memory::status] + set reply [::histogram_memory::hmm_status] } "loadconf" { # Loads configuration tables (OAT, FAT, ...) to histogram server @@ -1972,9 +1832,8 @@ namespace eval ::histogram_memory { error "ERROR: Available commands are, start stop pause mode preset freq fsrce status loadconf" } } - return $reply } message ] { - if {$::errorCode=="NONE"} { return $reply } - return -code error $message + return -code error "([info level 0]) $message" } + return $reply } diff --git a/site_ansto/instrument/config/hmm/hmm_cylindrical_detector_configuration.tcl b/site_ansto/instrument/config/hmm/hmm_cylindrical_detector_configuration.tcl index c85c88fe..eec38be9 100644 --- a/site_ansto/instrument/config/hmm/hmm_cylindrical_detector_configuration.tcl +++ b/site_ansto/instrument/config/hmm/hmm_cylindrical_detector_configuration.tcl @@ -1,49 +1,35 @@ -sicsdatafactory new ::histogram_memory::two_theta_array +sicsdatafactory new ::histogram_memory::x_pixel_angular_offset_array namespace eval histogram_memory { ::utility::mkVar detector_radius_mm Float user radius true detector true true sicslist setatt detector_radius_mm units mm ## - # @brief Calculate two_theta array from X bin boundaries + # @brief Calculate x_pixel_angular_offset array from X bin boundaries # # requires detector_active_width_mm det_radius_mm deg_per_rad - proc two_theta {args} { + proc x_pixel_angular_offset {args} { variable state if [ catch { - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] set deg_per_radian [SplitReply [deg_per_rad]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args] - } - "-arrayname" { - set max_chan [OAT_TABLE X -getdata MAX_CHAN] + set max_chan [OAT_TABLE X -getdata MAX_CHAN] + set bb_zero_offset [expr -1*($max_chan-1)] set det_width_mm [SplitReply [detector_active_width_mm]] set det_radius_mm [SplitReply [detector_radius_mm]] - set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}] - set offset [::histogram_memory::detector_posn_degrees] - return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist] - } - "-units" { - return "degrees" - } - default { - set max_chan [OAT_TABLE X -getdata MAX_CHAN] - set det_width_mm [SplitReply [detector_active_width_mm]] - set det_radius_mm [SplitReply [detector_radius_mm]] - set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}] - set offset [::histogram_memory::detector_posn_degrees] - return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $args] - } + set scale_factor [expr {-1.0*$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}] +# set offset [::histogram_memory::detector_posn_degrees] + set offset 0 + ::histogram_memory::calc_axis "x_pixel_angular_offset" $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $bb_zero_offset + if {$args == "-get_data_ref"} { + return "::histogram_memory::x_pixel_angular_offset_array" + } else { + return [::histogram_memory::x_pixel_angular_offset_array used] } } message ] { if {$::errorCode=="NONE"} {return $message} return -code error $message } } - set script_name ::histogram_memory::two_theta + set script_name ::histogram_memory::x_pixel_angular_offset publish $script_name user sicslist setatt $script_name privilege user sicslist setatt $script_name kind script @@ -54,9 +40,9 @@ namespace eval histogram_memory { sicslist setatt $script_name control false sicslist setatt $script_name data true sicslist setatt $script_name nxsave true - sicslist setatt $script_name mutable true - sicslist setatt $script_name long_name two_theta - sicslist setatt $script_name units [::histogram_memory::two_theta -units] + sicslist setatt $script_name mutable false + sicslist setatt $script_name long_name x_pixel_angular_offset + sicslist setatt $script_name units "degrees" unset script_name - ::histogram_memory::two_theta -boundaries + ::histogram_memory::set_graphtype "x_pixel_angular_offset" "boundaries" } diff --git a/site_ansto/instrument/config/motors/sct_positmotor_common.tcl b/site_ansto/instrument/config/motors/sct_positmotor_common.tcl index 510c1083..a201cc5c 100644 --- a/site_ansto/instrument/config/motors/sct_positmotor_common.tcl +++ b/site_ansto/instrument/config/motors/sct_positmotor_common.tcl @@ -130,7 +130,7 @@ namespace eval ::scobj::positmotor { # } sct oldval $data sct update $data - if {$data > 0} { + if {$data > 0 && [string is integer $data]} { if {$calc_instpar == "@none"} { hset $path/$staticpar $posit_label($motor,$data) } else { @@ -155,15 +155,18 @@ namespace eval ::scobj::positmotor { set val [pos2val [sct target] $motor] hset $path/status BUSY run $motor $val - $sct_controller poll $path 1 +# $sct_controller poll $path 1 } errmsg ] { error $errmsg - return idle + return noResponse } else { - return idle + return noResponse } } + proc noResponse {} { + return idle + } # TODO Check thread 0 and motion control disabled? proc check_motor {} { @@ -217,6 +220,7 @@ namespace eval ::scobj::positmotor { hsetprop $scobjPath/$pindex read ${ns}::rd_index $pindex $motor hsetprop $scobjPath/$pindex state_reading_index ${ns}::state_reading_index $scobjPath $pindex $motor $staticpar $calc_instpar hsetprop $scobjPath/$pindex write ${ns}::w_index $sct_controller $scobjPath $pindex $motor + hsetprop $scobjPath/$pindex noResponse ${ns}::noResponse hsetprop $scobjPath/$pindex check ${ns}::check_motor hsetprop $scobjPath/$pindex oldval UNKNOWN @@ -239,7 +243,7 @@ namespace eval ::scobj::positmotor { proc ${motor}_MOTEND {} [subst -nocommands { if { [hval $scobjPath/status] == "BUSY"} { - $sct_controller poll $scobjPath/$pindex 5 +# $sct_controller poll $scobjPath/$pindex 5 hset $scobjPath/status STOPPING } }] @@ -247,7 +251,7 @@ namespace eval ::scobj::positmotor { scriptcallback connect $motor MOTEND ${ns}::${motor}_MOTEND - $sct_controller poll $scobjPath/$pindex + $sct_controller poll $scobjPath/$pindex 2 $sct_controller write $scobjPath/$pindex sicslist setatt $scobjName long_name $scobjName diff --git a/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl b/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl index 63baf7a6..63b8251e 100644 --- a/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl +++ b/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl @@ -21,7 +21,6 @@ sicslist setatt timestamp units seconds sicslist setatt nexus_datatype mutable false namespace eval nexus { - variable data_gp_path "/data" nexus_datatype "UNKNOWN" set exports [list newfile closefile save data newfile_collection save_collection] eval namespace export $exports @@ -36,87 +35,34 @@ namespace eval nexus { ## # @brief Records the current Nexus file state. variable state - ## - # @brief Specifies the save policy with an optional list of data link sources. - # - # NOTE: The ::histogram_memory::horizontal_axis and ::histogram_memory::vertical_axis are aliases which - # must be set by the instrument specific histogram memory configuration. - # - # TODO Put the filetype_spec in a separate file. - variable bmon_filetype_spec - array set bmon_filetype_spec { - BEAM_MONITOR { - link {axis 1 data_run_number} - link {data_set monitor_counts} - save_policy {include @all exclude {hmm hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}} - } - } - variable histmem_filetype_spec - array set histmem_filetype_spec { - HISTOGRAM_XYT { - link {axis 1 data_run_number} - link {axis 2 ::histogram_memory::time_channel} - link {axis 3 ::histogram_memory::vertical_axis} - link {axis 4 ::histogram_memory::horizontal_axis} - link {aux_data 1 ::histogram_memory::time} - link {aux_data 2 ::histogram_memory::total_counts} - link {data_set hmm} - save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}} - } - HISTOGRAM_XY { - link {axis 1 data_run_number} - link {axis 2 ::histogram_memory::vertical_axis} - link {axis 3 ::histogram_memory::horizontal_axis} - link {aux_data 1 ::histogram_memory::time} - link {aux_data 2 ::histogram_memory::total_counts} - link {data_set hmm_xy} - save_policy {include @all exclude {hmm hmm_xt hmm_yt hmm_x hmm_y hmm_t}} - } - HISTOGRAM_XT { - link {axis 1 data_run_number} - link {axis 2 ::histogram_memory::time_channel} - link {axis 3 ::histogram_memory::horizontal_axis} - link {aux_data 1 ::histogram_memory::time} - link {aux_data 2 ::histogram_memory::total_counts} - link {data_set hmm_xt} - save_policy {include @all exclude {hmm_xy hmm hmm_yt hmm_x hmm_y hmm_t}} - } - HISTOGRAM_YT { - link {axis 1 data_run_number} - link {axis 2 ::histogram_memory::time_channel} - link {axis 3 ::histogram_memory::vertical_axis} - link {aux_data 1 ::histogram_memory::time} - link {aux_data 2 ::histogram_memory::total_counts} - link {data_set hmm_yt} - save_policy {include @all exclude {hmm_xy hmm_xt hmm hmm_x hmm_y hmm_t}} - } - HISTOGRAM_X { - link {axis 1 data_run_number} - link {axis 2 ::histogram_memory::horizontal_axis} - link {aux_data 1 ::histogram_memory::time} - link {aux_data 2 ::histogram_memory::total_counts} - link {data_set hmm_x} - save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm hmm_y hmm_t}} - } - HISTOGRAM_Y { - link {axis 1 data_run_number} - link {axis 2 ::histogram_memory::vertical_axis} - link {aux_data 1 ::histogram_memory::time} - link {aux_data 2 ::histogram_memory::total_counts} - link {data_set hmm_y} - save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm hmm_t}} - } - HISTOGRAM_T { - link {axis 1 data_run_number} - link {axis 2 ::histogram_memory::time_channel} - link {aux_data 1 ::histogram_memory::time} - link {aux_data 2 ::histogram_memory::total_counts} - link {data_set hmm_t} - save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm}} - } + # @brief Sets the default naming convention for the NXentry group. + variable NXentry_nm_convention + array set NXentry_nm_convention { + "echidna" "simple" + "wombat" "simple" + "kowari" "simple" + "quokka" "fname" + "platypus" "simple" } } +namespace eval ::nexus::histmem {} +namespace eval ::nexus::motor {} +namespace eval ::nexus::environment_controller {} +namespace eval ::nexus::sicsvariable {} +namespace eval ::nexus::singlecounter {} +namespace eval ::nexus::script {} +namespace eval ::histogram_memory { + variable histmem_axes + array set histmem_axes { + TOF /instrument/detector/time + HOR /instrument/detector/x_pixel_offset + VER /instrument/detector/y_pixel_offset + PER /instrument/run_number + SVAR /instrument/run_number + } +} + ## # @brief Strips the output of a SICS command leaving only the value\n @@ -136,66 +82,41 @@ proc ::nexus::datapath {} { # # @param postfix This is the filename suffix, must be one of: nx.hdf, hdf, h5, nx5, xml proc newFileName {idNum postfix} { - - array set inst_mnem {quokka QKK wombat WBT echidna ECH kowari KWR koala KOL taipan TPN platypus PLP pelican PLN} -# set prefix [SplitReply [sicsdataprefix]] - set date_time_arr [split [sicstime] " "] - set isodate [lindex $date_time_arr 0] - set isotime [string map {: -} [lindex $date_time_arr 1]] - return [format "%s/%s%07d.%s" [::nexus::datapath] $inst_mnem([instname]) $idNum $postfix] + if [ catch { + array set inst_mnem {quokka QKK wombat WBT echidna ECH kowari KWR koala KOL taipan TPN platypus PLP pelican PLN} + # set prefix [SplitReply [sicsdataprefix]] + set date_time_arr [split [sicstime] " "] + set isodate [lindex $date_time_arr 0] + set isotime [string map {: -} [lindex $date_time_arr 1]] + set fmtStr [format "%s/%s%07d.%s" [::nexus::datapath] $inst_mnem([instname]) $idNum $postfix] + } message ] { + return -code error "([info level 0]) $message" + } + return $fmtStr } - proc ::nexus::process_filetype_policy {filetype filetype_spec} { - - upvar $filetype_spec ft_spec - array set ft_spec_arr $ft_spec - if {[info exists ft_spec_arr($filetype)] == 0} { - error "$filetype is invalid, should be one of [array names ft_spec_arr]" - } - set ft_policy $ft_spec_arr($filetype) - ::nexus::data clear - foreach {pol_type policy} $ft_policy { - switch $pol_type { - "link" { - ::nexus::data $policy - } - "save_policy" { - foreach {save_action action_list} $policy { - switch $save_action { - "include" { - if {$action_list == "@all"} { - ::hdb::set_save / true - } else { - foreach item $action_list { - if {[getatt $item type] == ""} { - error "ERROR: Unknown $item specified for inclusion in the data file" - } - ::hdb::set_save [getatt $item hdb_path] true - } - } - } - "exclude" { - if {$action_list == "@all"} { - ::hdb::set_save / false - } else { - foreach item $action_list { - if {[getatt $item type] == ""} { - error "ERROR: Unknown $item specified for exclusion from the data file" - } - ::hdb::set_save [getatt $item hdb_path] false - } - } - } - default { - error "ERROR: Unknown save action $save_action specified in the save policy" - } - } - } - } - default { - error "$pol_type is invalid, should be one of 'link' 'save_policy'" - } + proc ::nexus::process_filetype_policy {filetype} { + if [ catch { + if {$filetype == "BEAM_MONITOR"} { + ::hdb::set_save / true + ::hdb::set_save $::histogram_memory::HP_HMM false + set ::counter::HP_BM [getatt monitor_counts hdb_path] + hsetprop $::counter::HP_BM link data_set + hsetprop $::counter::HP_BM @signal 1 + } else { + ::hdb::set_save / true + hsetprop $::histogram_memory::HP_HMM datatype_savelist $filetype + hsetprop $::histogram_memory::HP_HMM link data_set + ::histogram_memory::set_axes $filetype } + foreach sobj [sicslist link data_set] { + hsetprop [getatt $sobj hdb_path] link data_set + } + foreach sobj [sicslist link parameters_group] { + hsetprop [getatt $sobj hdb_path] link parameters_group + } + } message ] { + return -code error "([info level 0]) $message" } } @@ -206,6 +127,7 @@ proc newFileName {idNum postfix} { variable state variable nexusdic variable currFilename + variable isNewFile variable save_count_arr variable start_seconds_array variable file_states @@ -221,6 +143,7 @@ proc newFileName {idNum postfix} { set nexusdic "nexus.dic" array set currFilename "" + array set isNewFile "" array set save_count_arr "" array set start_seconds_array "" array set file_states {U "UNKNOWN" O "OPEN" C "CLOSED" S "SAVING"} @@ -230,9 +153,6 @@ proc newFileName {idNum postfix} { } proc ::nexus::ic_initialize {} { - variable bmon_filetype_spec - variable histmem_filetype_spec - variable filetype_spec [concat [array get bmon_filetype_spec] [array get histmem_filetype_spec] ] } ## @@ -242,7 +162,6 @@ proc newFileName {idNum postfix} { proc ::nexus::createfile {FileName} { variable nexusdic variable state - variable data_gp_path if [ catch { if {$state(file,open) == "true"} { @@ -256,8 +175,8 @@ proc newFileName {idNum postfix} { } } - set nxdict_path [::nexus::gen_nxdict $nexusdic] - hsetprop $data_gp_path currentfiletype [::utility::hgetplainprop $data_gp_path datatype] + set baseName [lindex [split [file tail $FileName] "."] 0] + set nxdict_path [::nexus::gen_nxdict $baseName $nexusdic] if {$state(file,incr_datnum) == true} { sicsdatanumber incr } @@ -267,8 +186,7 @@ proc newFileName {idNum postfix} { } set state(file,open) false } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -300,16 +218,42 @@ proc ::nexus::newfile {type {namestyle data}} { ::nexus::newfile_collection -filetype $type -savetype $namestyle } +## +# @brief Returns a list of paths matching the given property +# +# @param hpath, subtree path to search +# @param prop, name of property, can be 'abc*' but not 'a*c' +proc ::nexus::findHdbProps {hpath prop} { + if [ catch { + set hpList "" + foreach hp [hlist $hpath] { + if {$hpath == "/"} { + set subList [::nexus::findHdbProps /$hp $prop] + } else { + set subList [::nexus::findHdbProps $hpath/$hp $prop] + } + if {[llength $subList] > 0} { + lappend hpList [join $subList] + } + } + if {[string length [hfindprop $hpath $prop]] > 0 } { + lappend hpList $hpath + } + } message ] { + return -code error "([info level 0]) $message" + } + return [join $hpList] +} + ## # @brief Let's make a collection of files (ie a file-set) or just one. # # @param -labels L or {L1 L2 ..}, optional. A list of labels which identify a file-set # If you don't specify a list of labels then only one file is created proc ::nexus::newfile_collection {args} { - variable filetype_spec variable state - variable data_gp_path variable currFilename + variable isNewFile variable save_count_arr variable file_states @@ -328,11 +272,10 @@ proc ::nexus::newfile_collection {args} { set state(file,namestyle) $param(-savetype) array unset save_count_arr array unset currFilename + array unset isNewFile if {$param(-savetype) == "scratch"} { - set state(file,isNewScratchFile) true set state(file,incr_datnum) false } else { - set state(file,isNewScratchFile) false set state(file,incr_datnum) true } set idNum [expr 1 + [SplitReply [sicsdatanumber]]] @@ -342,12 +285,14 @@ proc ::nexus::newfile_collection {args} { if {$param(-savetype) == "scratch"} { foreach fid $state(file,labels) { set save_count_arr($fid) 0 + set isNewFile($fid) "true" set currFilename($fid) [format "%s/scratch_%s.%s" [::nexus::datapath] $fid $file_suffix] lappend files $currFilename($fid) } } else { foreach fid $state(file,labels) { set save_count_arr($fid) 0 + set isNewFile($fid) "true" set currFilename($fid) [newFileName $idNum $file_suffix] incr idNum lappend files $currFilename($fid) @@ -358,6 +303,7 @@ proc ::nexus::newfile_collection {args} { set state(file,fileset) "false" set state(file,labels) @singlefile set save_count_arr(@singlefile) 0 + set isNewFile(@singlefile) "true" if {$param(-savetype) == "scratch"} { set currFilename(@singlefile) [format "%s/scratch.%s" [::nexus::datapath] $file_suffix] } else { @@ -367,22 +313,25 @@ proc ::nexus::newfile_collection {args} { save_count 0 currpoint 0 file_status $file_states(U) - hsetprop $data_gp_path currentfiletype UNKNOWN if {$param(-filetype) == "clear"} { - ::nexus::data clear ::hdb::set_save / false - hsetprop $data_gp_path currentfiletype UNKNOWN - hsetprop $data_gp_path datatype UNKNOWN nexus_datatype "UNKNOWN" file_set_list "UNKNOWN" # dataFileName "UNKNOWN" } else { - ::nexus::process_filetype_policy $param(-filetype) filetype_spec + foreach hp [split [::nexus::findHdbProps / link]] { + hdelprop $hp link + } + foreach hp [::nexus::findHdbProps / @*] { + foreach {pname pval} [hfindprop $hp @*] { + hdelprop $hp $pname + } + } + ::nexus::process_filetype_policy $param(-filetype) nexus_datatype $param(-filetype) } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } else { return OK } @@ -398,7 +347,7 @@ proc ::nexus::newfile_collection {args} { # # @see ::nexus::savetree # @see ::nexus::save - proc ::nexus::save_data {point} { + proc ::nexus::save_data {point filestatus} { set valid_caller "::nexus::save_collection" debug_msg "save point $point in [dataFileName]" @@ -411,13 +360,12 @@ proc ::nexus::newfile_collection {args} { error "ERROR: [lindex [info level 0] 0] can only be called via the $valid_caller command, not by $caller" } foreach child [hlist /] { - if {[::utility::hgetplainprop /$child data] == "true"} { - ::nexus::savetree $child $point + if {[hpropexists /$child data] && [hgetpropval /$child data] == "true"} { + ::nexus::savetree $child $point $filestatus } } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -433,8 +381,7 @@ proc ::nexus::save {{point 0}} { if [ catch { ::nexus::save_collection -index $point } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -442,10 +389,10 @@ proc ::nexus::save {{point 0}} { # @brief Save data in a file from a file-set proc ::nexus::save_collection {args} { variable state - variable data_gp_path variable start_seconds variable start_seconds_array variable currFilename + variable isNewFile variable save_count_arr variable file_states @@ -465,13 +412,6 @@ proc ::nexus::save {{point 0}} { # ::data::gumtree_save -set run_number $point data_run_number $point - set currFileType [::utility::hgetplainprop $data_gp_path currentfiletype] - set currDataType [::utility::hgetplainprop $data_gp_path datatype] - set dataTypeChanged [expr {$currFileType != $currDataType}] - if {$currDataType == "UNKNOWN"} { - error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' " - } - if [info exists param(-label)] { if {[lsearch -exact $state(file,labels) $param(-label)] == -1} { error "ERROR: The label must be one of $state(file,labels)" @@ -483,16 +423,11 @@ proc ::nexus::save {{point 0}} { } set data_label @singlefile } - if {! [file exists $currFilename($data_label)]} { - set isNewFile true - } else { - set isNewFile false - } - if {$isNewFile || $state(file,isNewScratchFile)} { + if {$isNewFile($data_label)} { ::nexus::createfile $currFilename($data_label) dataFileName $currFilename($data_label) - estart [lindex [sicstime] 1] - eend [lindex [sicstime] 1] + estart [sicstime] + eend [sicstime] array unset start_seconds_array set start_seconds [clock seconds] # set start_seconds_array($data_label) $start_seconds @@ -500,24 +435,22 @@ proc ::nexus::save {{point 0}} { file_status $file_states(O) ::nexus::nxreopenfile $currFilename($data_label) file_status $file_states(S) - ::nexus::save_data $point - ::nexus::makelinks - ::nexus::set_plotdata_info + ::nexus::save_data $point newfile ::nexus::nxclosefile $currFilename($data_label) file_status $file_states(C) incr save_count_arr($data_label) save_count $save_count_arr($data_label) currpoint $point - set state(file,isNewScratchFile) false + set isNewFile($data_label) "false" } else { - eend [lindex [sicstime] 1] + eend [sicstime] # timestamp [expr {[clock seconds] - $start_seconds_array($data_label)}] timestamp [expr {[clock seconds] - $start_seconds}] dataFileName $currFilename($data_label) file_status $file_states(O) ::nexus::nxreopenfile $currFilename($data_label) file_status $file_states(S) - ::nexus::save_data $point + ::nexus::save_data $point oldfile ::nexus::nxclosefile $currFilename($data_label) file_status $file_states(C) incr save_count_arr($data_label) @@ -525,9 +458,10 @@ proc ::nexus::save {{point 0}} { save_count $save_count_arr($data_label) } } message ] { - ::nexus::nxclosefile $currFilename($data_label) - if {$::errorCode=="NONE"} {return $message} - return -code error $message + if {[info exists data_label] && [info exists currFilename($data_label)]} { + ::nexus::nxclosefile $currFilename($data_label) + } + return -code error "([info level 0]) $message" } return } @@ -557,8 +491,7 @@ proc ::nexus::save {{point 0}} { set state(file,open) true } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -588,8 +521,7 @@ proc ::nexus::save {{point 0}} { clientput "$fname updated" "event" } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } ## @@ -612,192 +544,132 @@ proc ::nexus::save {{point 0}} { # data alias , remove alias # data alias , set as an alias for unless it has already been defined. proc ::nexus::data {args} { + # TODO This is obsolete + } + proc ::nexus::data_junk {args} { variable state variable data_gp_path - if {[llength $args] == 1} { - set arguments [lindex $args 0] - } else { - set arguments $args - } + if [ catch { + if {[llength $args] == 1} { + set arguments [lindex $args 0] + } else { + set arguments $args + } - set dpath $data_gp_path - set opt [lindex $arguments 0] - set arglist [lrange $arguments 1 end] + set dpath $data_gp_path + set opt [lindex $arguments 0] + set arglist [lrange $arguments 1 end] - switch $opt { - "axis" - "aux_data" { - debug_msg "'axis' case of switch" - set link_target [lindex $arguments 2] - if {[getatt $link_target privilege] == "internal"} { - error "[info level 0], Cannot link $link_target because it doesn't have an hdb node." + switch $opt { + "axis" - "aux_data" { + debug_msg "'axis' case of switch" + set link_target [lindex $arguments 2] + if {[getatt $link_target privilege] == "internal"} { + error "[info level 0], Cannot link $link_target because it doesn't have an hdb node." + } + set axnum [lindex $arguments 1] + if {[string is integer $axnum] == 0} { + error "ERROR: [info level -1]->data, index for data axis should be an integer, not $axnum" + } + if {[getatt $link_target type] == ""} { + error "Unknown link target $link_target" + } + set hp $dpath/${opt}_$axnum + # if {[::utility::hgetplainprop $hp link] == "@none"} { +# hsetprop $hp link [getatt [lindex $arguments 2] id] + hsetprop $hp long_name [getatt [lindex $arguments 2] long_name] + # } } - set axnum [lindex $arguments 1] - if {[string is integer $axnum] == 0} { - error "ERROR: [info level -1]->data, index for data axis should be an integer, not $axnum" + "data_set" { + debug_msg "'data_set' case of switch" + set link_target [lindex $arguments 1] + if {[getatt $link_target type] == ""} { + error "Unknown link target $link_target" + } + hsetprop $dpath datatype [lindex [info level -1] 0] + set hp $dpath/data_set + # if {[::utility::hgetplainprop $hp link] == "@none"} { +# hsetprop $hp link [getatt $link_target id] + hsetprop $hp long_name [getatt $link_target long_name] + # } } - if {[getatt $link_target type] == ""} { - error "Unknown link target $link_target" + "clear" { + debug_msg "'clear' case of switch" + foreach child [hlist $dpath] { +# hsetprop $dpath/$child link @none + hsetprop $dpath/$child long_name @none + } } - set hp $dpath/${opt}_$axnum -# if {[::utility::hgetplainprop $hp link] == "@none"} { - hsetprop $hp link [getatt [lindex $arguments 2] id] - hsetprop $hp long_name [getatt [lindex $arguments 2] long_name] -# } - } - "data_set" { - debug_msg "'data_set' case of switch" - set link_target [lindex $arguments 1] - if {[getatt $link_target type] == ""} { - error "Unknown link target $link_target" - } - hsetprop $dpath datatype [lindex [info level -1] 0] - set hp $dpath/data_set -# if {[::utility::hgetplainprop $hp link] == "@none"} { - hsetprop $hp link [getatt $link_target id] - hsetprop $hp long_name [getatt $link_target long_name] -# } - } - "clear" { - debug_msg "'clear' case of switch" - foreach child [hlist $dpath] { - hsetprop $dpath/$child link @none - hsetprop $dpath/$child long_name @none - } - } - "alias" { - debug_msg "'alias' case of switch" - set alias_name [lindex $arglist 0] - set alias_target [lindex $arglist 1] - switch $alias_target { - "" { - if {[info exists state(data,alias,$alias_name)]} { - definealias $alias_name - set state(data,alias,$alias_name) @none + "alias" { + debug_msg "'alias' case of switch" + set alias_name [lindex $arglist 0] + set alias_target [lindex $arglist 1] + switch $alias_target { + "" { + if {[info exists state(data,alias,$alias_name)]} { + definealias $alias_name + set state(data,alias,$alias_name) @none + } } - } - default { - if {[info exists state(data,alias,$alias_name)]} { - if { $state(data,alias,$alias_name) == "@none" } { + default { + if {[info exists state(data,alias,$alias_name)]} { + if { $state(data,alias,$alias_name) == "@none" } { + definealias $alias_name $alias_target + } + } else { definealias $alias_name $alias_target } - } else { - definealias $alias_name $alias_target } - return } - } - } - default {error "ERROR: [info level -1]->data, Unsupported option $opt"} - } - } - -## -# @brief Make dataset links -# - proc ::nexus::makelinks {{hpath /}} { - if [ catch { - foreach child [hlist $hpath] { - if {$hpath == "/"} { - set newpath /$child - } else { - set newpath $hpath/$child - } - # clientput $newpath - array set p_arr [::utility::hlistplainprop $newpath] - if {$p_arr(data) == "true" && $p_arr(nxsave) == "true"} { - if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { - if {$p_arr(link) != "@none"} { -# clientput "Link $p_arr(nxalias) to $p_arr(link)" - nxscript makelink $p_arr(nxalias) $p_arr(link) - } } - ::nexus::makelinks $newpath + default {error "ERROR: [info level -1]->data, Unsupported option $opt"} } - } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } -## -# @brief Sets the "signal" and "axes" attributes on the plottable data -# Also sets the "axis" attribute for each of the axes. - proc ::nexus::set_plotdata_info {} { - variable data_gp_path - array unset axes - set hpath $data_gp_path - foreach child [hlist $hpath] { - array set p_arr [::utility::hlistplainprop $hpath/$child] - if {$p_arr(data) == true && $p_arr(nxsave) == true} { - if {[info exists p_arr(nxalias)]} { - if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { - if {$p_arr(link) != "@none"} { - switch -glob $child { - "axis_*" { - set n [lindex [split $child _] 1] - set axes($n) [::utility::hgetplainprop $hpath/$child long_name] - nxscript putattribute $p_arr(link) axis $n - } - "data_set" { - nxscript putattribute $p_arr(link) signal 1 - set data_set_alias $p_arr(link) - } - "aux_data_*" { - continue - } - default {error "ERROR: [info level -1]->set_plotdata_info, Unsupported data path $hpath/$child"} - } - } - } - } - } - } - if {[info exists axes]} { - foreach n [lsort [array names axes]] { - lappend axes_list $axes($n) - } - nxscript putattribute $data_set_alias axes [join $axes_list :] - } - } ## # @brief Traverse the hdb subtree from the given path and save the data in the currently open file # # @param hpath path of subtree to save, must not be "/" # @param pt Current array index for mutable data (optional default=0) - proc ::nexus::savetree {hpath {pt 0}} { - set ::errorInfo "" + proc ::nexus::savetree {hpath pt filestatus} { if [ catch { foreach child [hlist /$hpath] { array unset p_arr - array set p_arr [::utility::hlistplainprop /$hpath/$child] - if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { - continue - } - set data_type [lindex [split [hinfo /$hpath/$child] , ] 0] - if {$p_arr(data) == true && $p_arr(nxsave) == true } { - if {[info exists p_arr(savecmd)] && [info exists p_arr(nxalias)] } { - if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true" } { - $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type point $pt - } else { - $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type - } - } elseif {[info exists p_arr(nxalias)]} { - if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true" } { - nxscript puthdb /$hpath/$child point $pt - } else { - nxscript puthdb /$hpath/$child point 0 + array set p_arr [hlistprop /$hpath/$child tcllist] + if {([info exists p_arr(type)] == 0) || ($p_arr(type) != "nxvgroup")} { + set data_type [lindex [split [hinfo /$hpath/$child] , ] 0] + if {[info exists p_arr(data)] && ($p_arr(data) == true) && ($p_arr(nxsave) == true) } { + if {[info exists p_arr(nxalias)]} { + if {[info exists p_arr(savecmd)]} { + if {[info exists p_arr(mutable)] && ($p_arr(mutable) == "true") } { + $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) /$hpath/$child $data_type $filestatus point $pt + } else { + $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) /$hpath/$child $data_type $filestatus + } + } else { + if {[info exists p_arr(mutable)] && ($p_arr(mutable) == "true") } { + nxscript puthdb /$hpath/$child point $pt + } else { + nxscript puthdb /$hpath/$child + } + if {$filestatus == "newfile"} { + if {[info exists p_arr(link)] && ($p_arr(link) != "@none")} { + nxscript makelink $p_arr(link) $p_arr(nxalias) + } + } + } } + ::nexus::savetree $hpath/$child $pt $filestatus } - ::nexus::savetree $hpath/$child $pt - } + } } } message ] { - set message "$message, hpath=$hpath/$child" - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -813,16 +685,13 @@ proc ::nexus::save {{point 0}} { # hdb path # # @see gen_nxdict - proc ::nexus::_gen_nxdict {hpath dictPath name nxc} { - variable nxdictionary - if [ catch { - if {[::utility::hgetplainprop /$hpath data] == "false"} { - debug_msg "$hpath doesn't have a data property" - return - } - foreach child [hlist /$hpath] { - if {[::utility::hgetplainprop /$hpath/$child data] == true} { - set nxclass [::utility::hgetplainprop /$hpath/$child klass] +proc ::nexus::_gen_nxdict {hpath dictPath name nxc} { + variable nxdictionary + if [ catch { + if {[hpropexists /$hpath data] && [hgetpropval /$hpath data] == true} { + foreach child [hlist /$hpath] { + if {[hpropexists /$hpath/$child data] && [hgetpropval /$hpath/$child data] == true} { + set nxclass [hgetpropval /$hpath/$child klass] if {$nxc == "NXentry"} { ::nexus::_gen_nxdict $hpath/$child $dictPath $child $nxclass } elseif {[string range $nxc 0 1] == "NX"} { @@ -830,72 +699,97 @@ proc ::nexus::save {{point 0}} { } else { ::nexus::_gen_nxdict $hpath/$child $dictPath ${name}_$child $nxclass } + } } - } - array set p_arr [::utility::hlistplainprop /$hpath] - set data_type [lindex [split [hinfo /$hpath] , ] 0] - if {$data_type == "none" && $p_arr(type) != "nxvgroup"} { - #XXX Do we need to check data_type here. This would skip NXVGROUP nodes - return; - } - if {$p_arr(data) == "true" && $p_arr(nxsave) == "true" && [info exists p_arr(nxalias)]} { - set alias $p_arr(nxalias) - if {[info exists p_arr(sdsinfo)]} { - if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true"} { - if {[info exists p_arr(savecmd)]} { - set nxdictionary($alias) "$dictPath/SDS $name [$p_arr(sdsinfo) $p_arr(sicsdev) $data_type mutable true]" + array set p_arr [hlistprop /$hpath tcllist] + set data_type [lindex [split [hinfo /$hpath] , ] 0] + if {$data_type != "none" || $p_arr(type) == "nxvgroup"} { + #XXX Do we need to check data_type here. This would skip NXVGROUP nodes + if {$p_arr(data) == "true" && $p_arr(nxsave) == "true" && [info exists p_arr(nxalias)]} { + set alias $p_arr(nxalias) + if {[info exists p_arr(sdsinfo)]} { + if {[info exists p_arr(sdsname)]} { + set sdsName $p_arr(sdsname) } else { - set nxdictionary($alias) "$dictPath/SDS $name [$p_arr(sdsinfo) $data_type mutable true]" + set sdsName $name } - } else { - if {[info exists p_arr(savecmd)]} { - set nxdictionary($alias) "$dictPath/SDS $name [$p_arr(sdsinfo) $p_arr(sicsdev) $data_type mutable false]" + if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true"} { + set isMutable "true" } else { - set nxdictionary($alias) "$dictPath/SDS $name [$p_arr(sdsinfo) $data_type mutable false]" + set isMutable "false" } + if {[info exists p_arr(savecmd)]} { + set SDSstr "[$p_arr(sdsinfo) $sdsName $data_type $p_arr(sicsdev) mutable $isMutable hpath /$hpath]" + } else { + set SDSstr "[$p_arr(sdsinfo) $sdsName $data_type mutable $isMutable hpath /$hpath]" + } + set nxdictionary($alias) "$dictPath/SDS $SDSstr" + } elseif {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { + set nxdictionary($alias) "$dictPath/NXVGROUP" } - } elseif {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { - set nxdictionary($alias) "$dictPath/NXVGROUP" + } } } - } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + } message ] { + return -code error "([info level 0]) $message" + } +} + +## +# @brief Generate the NXentry name +# +# @param baseName, this is the data file basename it is used as the entry name +# when the 'fname' naming convention is selected. +proc ::nexus::gen_NXentry_name {baseName} { + variable NXentry_nm_convention + + set nm_conv $NXentry_nm_convention([instname]) + switch $nm_conv { + "simple" { + return "/entry1" + } + "fname" { + return "/${baseName}" + } + default { + return -code error "ERROR: Unknown NXentry naming convention $nm_conv" } } - +} ## # @brief Generate a nexus dictionary file from the hdb tree # # An entry in the nexus dictionary is generated for each node in the # hdb tree which has the following properties and values, data=true and nxsave=true # + # @param baseName The base name of the file without suffix # @param nexusdic Name of the nexus dictionary that will be created. # @return Full path to the nexus dictionary. -proc ::nexus::gen_nxdict {nexusdic} { +proc ::nexus::gen_nxdict {baseName nexusdic} { global cfPath variable nxdictionary if [ catch { set nxdict_path $cfPath(nexus)/$nexusdic array unset nxdictionary + set entryName [gen_NXentry_name $baseName] foreach hp [hlist /] { - if {[::utility::hgetplainprop /$hp data] == true} { - set nxclass [::utility::hgetplainprop /$hp klass] - ::nexus::_gen_nxdict $hp /entry1,NXentry $hp $nxclass + if {[hgetpropval /$hp data] == true} { + set nxclass [hgetpropval /$hp klass] + ::nexus::_gen_nxdict $hp $entryName,NXentry $hp $nxclass } } set fh [open $nxdict_path w] puts $fh "##NXDICT-1.0" - puts $fh padim0=0 - puts $fh padim1=0 - puts $fh padim2=0 + puts $fh pa_hmmdimstr=-1,0 + puts $fh pa_hmmrank=1 + puts $fh pa_hmmdatname=hmm + foreach {n v} [array get nxdictionary] { puts $fh "$n = $v" } close $fh } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } return $nxdict_path } @@ -946,18 +840,10 @@ proc ::nexus::gen_nxdict {nexusdic} { sicslist setatt $sobj sdsinfo ::nexus::macro::getset_sdsinfo } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } -namespace eval ::nexus::histmem {} -namespace eval ::nexus::motor {} -namespace eval ::nexus::environment_controller {} -namespace eval ::nexus::sicsvariable {} -namespace eval ::nexus::singlecounter {} -namespace eval ::nexus::script {} - ## # @brief Convert the given hdb type to Nexus data type # @@ -982,81 +868,108 @@ proc ::nexus::hdb2nx_type {dtype} { # The savecmd attribute of any histogram memory objects should be set to this function # # @see set_sobj_attributes -proc ::nexus::histmem::save {hm nxalias data_type args} { - if [catch { - set rank [SplitReply [$hm configure rank]] +proc ::nexus::histmem::save {hm nxalias hpath data_type filestatus args} { + variable HMOBJ - set datalen 1 - set indStartList [lindex $args 1] - set indLenList [list 1] - for {set i 0} {$i < $rank} {incr i} { - lappend indStartList 0 - set dim$i [SplitReply [$hm configure dim$i]] - lappend indLenList [set dim$i] - set datalen [expr $datalen * [set dim$i]] - nxscript updatedictvar padim$i [set dim$i] - } - set data_start 0 - set bank 1 - nxscript putslab $nxalias $indStartList $indLenList $hm $data_start $datalen $bank - }] { - return -code error $::errorInfo + if [catch { + set point [lindex $args 1] + array set pa [hlistprop $hpath tcllist] + foreach sdsname $pa(hmmdatname) rank $pa(hmmrank) dimstr $pa(hmmdimstr) hmmslabstart $pa(hmmslabstart) hmmslabend $pa(hmmslabend) hmmperiodsize $pa(hmmperiodsize) axes $pa(@axes) signal $pa(@signal) { + nxscript updatedictvar pa_hmmdatname $sdsname + if {$pa(mutable)} { + nxscript updatedictvar pa_hmmrank [expr {$rank+1}] + nxscript updatedictvar pa_hmmdimstr "-1,$dimstr" + } else { + nxscript updatedictvar pa_hmmrank $rank + nxscript updatedictvar pa_hmmdimstr $dimstr + } + set max_period [SplitReply [$HMOBJ configure maximum_period]] + set datsize $hmmperiodsize + if {$pa(save_periods) == "all_periods"} { + $HMOBJ configure read_data_period_number -1 + set datsize [expr $hmmperiodsize * (1 + $max_period)] + } elseif { $max_period > 0} { + $HMOBJ configure read_data_period_number $point + } + broadcast nxscript putslab $nxalias [join [list $point $hmmslabstart ]] [join [list 1 $hmmslabend]] $HMOBJ 0 $datsize 1 + nxscript putslab $nxalias [join [list $point $hmmslabstart ]] [join [list 1 $hmmslabend]] $HMOBJ 0 $datsize 1 +##### + if {$filestatus == "newfile"} { + if [hpropexists $hpath link] { + set link [hgetpropval $hpath link] + nxscript makelink $link $nxalias + } + nxscript putattribute $nxalias axes $axes + nxscript putattribute $nxalias signal $signal + } + } + } message ] { + return -code error "([info level 0]) $message" } } -# TODO Get rank from /data -proc ::nexus::histmem::sdsinfo {hm data_type args} { - array set param $args - set rank [SplitReply [$hm configure rank]] - - for {set i 0} {$i < $rank} {incr i} {lappend dimstr "\$(padim$i)"} - set dimstr [join $dimstr ,] - if {$param(mutable) == true} { - return " -type NX_INT32 -LZW -rank [expr $rank+1] -dim {-1,$dimstr}" - } else { - return " -type NX_INT32 -LZW -rank $rank -dim {$dimstr}" - } +proc ::nexus::histmem::sdsinfo {sdsName data_type hm args} { + return "\$(pa_hmmdatname) -type NX_INT32 -LZW -rank \$(pa_hmmrank) -dim {\$(pa_hmmdimstr)}" } # The save commands are called with the sobj name and nxalias # The sdsinfo commands provide the SDS description for an nxdic -proc ::nexus::motor::save {motor nxalias data_type args} { - if {[lindex $args 0] == "point"} { - set index [lindex $args 1] +proc ::nexus::motor::save {motor nxalias hpath data_type filestatus args} { + if [ catch { + if {[lindex $args 0] == "point"} { + set index [lindex $args 1] nxscript_data clear - nxscript_data putfloat 0 [getVal [$motor] ] + nxscript_data putfloat 0 [getVal [$motor] ] nxscript putslab $nxalias [list $index] [list 1] nxscript_data - } else { - if {[getatt $motor type] == "motor"} { - nxscript putmot $nxalias $motor } else { - nxscript putfloat $nxalias [SplitReply [$motor]] + if {[getatt $motor type] == "motor"} { + nxscript putmot $nxalias $motor + } else { + nxscript putfloat $nxalias [SplitReply [$motor]] + } } + if {$filestatus == "newfile"} { + if [hpropexists $hpath link] { + set link [hgetpropval $hpath link] + nxscript makelink $link $nxalias + } + foreach {propName propValue} [hfindprop $hpath @*] { + set attName [string range $propName 1 end] + nxscript putattribute $nxalias $attName $propValue + } + } + } message ] { + return -code error "([info level 0]) $message" } } -proc ::nexus::motor::sdsinfo {motor data_type args} { - array set param $args - array set attribute [::utility::normalattlist $motor] - if {[info exists attribute(units)]} { - set units_att " -attr {units,$attribute(units)} " - } else { - set units_att " " - } - set dtype [::nexus::hdb2nx_type $data_type] - set name_att " -attr {long_name,$attribute(long_name)} " - if {$param(mutable) == true} { - return " -type $dtype -rank 1 -dim {-1} $units_att $name_att" - } else { - return " -type $dtype $units_att $name_att" +proc ::nexus::motor::sdsinfo {sdsName data_type motor args} { + if [ catch { + array set param $args + array set attribute [::utility::normalattlist $motor] + if {[info exists attribute(units)]} { + set units_att " -attr {units,$attribute(units)} " + } else { + set units_att " " + } + set dtype [::nexus::hdb2nx_type $data_type] + set name_att " -attr {long_name,$attribute(long_name)} " + if {$param(mutable) == true} { + set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att $name_att" + } else { + set sdsStr "$sdsName -type $dtype $units_att $name_att" + } + } message ] { + return -code error "([info level 0]) $message" } + return $sdsStr } ## # @brief Save data from a 'getset macro' # # NOTE: Currently just saves floats namespace eval ::nexus::macro {} -proc ::nexus::macro::getset_save {sobj nxalias data_type args} { +proc ::nexus::macro::getset_save {sobj nxalias hpath data_type filestatus args} { if [ catch { if {[lindex $args 0] == "point"} { set index [lindex $args 1] @@ -1077,15 +990,25 @@ proc ::nexus::macro::getset_save {sobj nxalias data_type args} { default {error "ERROR: [info level 0] Unknown data type $data_type when saving $sobj"} } } + if {$filestatus == "newfile"} { + if [hpropexists $hpath link] { + set link [hgetpropval $hpath link] + nxscript makelink $link $nxalias + } + foreach {propName propValue} [hfindprop $hpath @*] { + set attName [string range $propName 1 end] + nxscript putattribute $nxalias $attName $propValue + } + } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error "::nexus::macro::getset_save, $message" + return -code error "([info level 0]) $message" } } ## # @brief Define the scientific data set path for the nexus dictionary. -proc ::nexus::macro::getset_sdsinfo {sobj data_type args} { +proc ::nexus::macro::getset_sdsinfo {sdsName data_type sobj args} { + if [ catch { array set param $args array set attribute [::utility::normalattlist $sobj] set dtype [::nexus::hdb2nx_type $data_type] @@ -1096,43 +1019,66 @@ proc ::nexus::macro::getset_sdsinfo {sobj data_type args} { } set name_att " -attr {long_name,$attribute(long_name)} " if {$param(mutable) == true} { - return " -type $dtype -rank 1 -dim {-1} $units_att $name_att" + set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att $name_att" } else { - return " -type $dtype $units_att $name_att" + set sdsStr "$sdsName -type $dtype $units_att $name_att" } + } message ] { + return -code error "([info level 0]) $message" + } + return $sdsStr } #### -proc ::nexus::environment_controller::save {evc nxalias data_type args} { - if {[lindex $args 0] == "point"} { - set index [lindex $args 1] +proc ::nexus::environment_controller::save {evc nxalias hpath data_type filestatus args} { + if [ catch { + if {[lindex $args 0] == "point"} { + set index [lindex $args 1] nxscript_data clear - nxscript_data putfloat 0 [getVal [$evc] ] + nxscript_data putfloat 0 [getVal [$evc] ] nxscript putslab $nxalias [list $index] [list 1] nxscript_data - } else { - nxscript putfloat $nxalias [SplitReply [$evc]] + } else { + nxscript putfloat $nxalias [SplitReply [$evc]] + } + if {$filestatus == "newfile"} { + if [hpropexists $hpath link] { + set link [hgetpropval $hpath link] + nxscript makelink $link $nxalias + } + foreach {propName propValue} [hfindprop $hpath @*] { + set attName [string range $propName 1 end] + nxscript putattribute $nxalias $attName $propValue + } + } + } message ] { + return -code error "([info level 0]) $message" } } -proc ::nexus::environment_controller::sdsinfo {evc data_type args} { - array set param $args - array set attribute [::utility::normalattlist $evc] - set dtype [::nexus::hdb2nx_type $data_type] - if {[info exists attribute(units)]} { - set units_att " -attr {units,$attribute(units)} " - } else { - set units_att " " - } - set name_att " -attr {long_name,$attribute(long_name)} " - if {$param(mutable) == true} { - return " -type $dtype -rank 1 -dim {-1} $units_att $name_att" - } else { - return " -type $dtype $units_att $name_att" +proc ::nexus::environment_controller::sdsinfo {sdsName data_type evc args} { + if [ catch { + array set param $args + array set attribute [::utility::normalattlist $evc] + set dtype [::nexus::hdb2nx_type $data_type] + if {[info exists attribute(units)]} { + set units_att " -attr {units,$attribute(units)} " + } else { + set units_att " " + } + set name_att " -attr {long_name,$attribute(long_name)} " + if {$param(mutable) == true} { + set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att $name_att" + } else { + set sdsStr "$sdsName -type $dtype $units_att $name_att" + } + } message ] { + return -code error "([info level 0]) $message" } + return $sdsStr } namespace eval ::nexus { } -proc ::nexus::sicsvariable::save {svar nxalias data_type args} { +proc ::nexus::sicsvariable::save {svar nxalias hpath data_type filestatus args} { if [ catch { set val [SplitReply [$svar]] if {[lindex $args 0] == "point"} { @@ -1152,47 +1098,74 @@ proc ::nexus::sicsvariable::save {svar nxalias data_type args} { default {error "ERROR: [info level -1]->::nexus::sicsvariable::save, unknown type $data_type"} } } + if {$filestatus == "newfile"} { + if [hpropexists $hpath link] { + set link [hgetpropval $hpath link] + nxscript makelink $link $nxalias + } + foreach {propName propValue} [hfindprop $hpath @*] { + set attName [string range $propName 1 end] + nxscript putattribute $nxalias $attName $propValue + } + } } message ] { - if {$::errorCode=="NONE"} {return $message} return -code error "::nexus::sicsvariable::save, $message" } } -# TODO Add optional units to sicsvariables -proc ::nexus::sicsvariable::sdsinfo {sobj data_type args} { - array set param $args - set dtype [::nexus::hdb2nx_type $data_type] - array set attribute [::utility::normalattlist $sobj] - if {[info exists attribute(units)]} { - set units_att " -attr {units,$attribute(units)} " - } else { - set units_att " " - } - if {$param(mutable) == true} { - return " -type $dtype -rank 1 -dim {-1} $units_att" - } else { - return " -type $dtype $units_att" +proc ::nexus::sicsvariable::sdsinfo {sdsName data_type sobj args} { + if [ catch { + array set param $args + set dtype [::nexus::hdb2nx_type $data_type] + array set attribute [::utility::normalattlist $sobj] + if {[info exists attribute(units)]} { + set units_att " -attr {units,$attribute(units)} " + } else { + set units_att " " + } + if {$param(mutable) == true} { + set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att" + } else { + set sdsStr "$sdsName -type $dtype $units_att" + } + } message ] { + return -code error "([info level 0]) $message" } + return $sdsStr } namespace eval ::nexus::scobj {} -proc ::nexus::scobj::sdsinfo {data_type args} { - array set param $args +proc ::nexus::scobj::sdsinfo {sdsName data_type args} { + if [ catch { + array set param $args set dtype [::nexus::hdb2nx_type $data_type] - if {$param(mutable) == true} { - return " -type $dtype -rank 1 -dim {-1}" - } else { - return " -type $dtype" + switch $data_type { + text { + set dimdef [subst {-dim {[string length [hval $param(hpath)]]}}] + set sdsStr "$sdsName -type $dtype $dimdef" + } + default { + if {$param(mutable) == true} { + set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1}" + } else { + set sdsStr "$sdsName -type $dtype" + } + } } + } message ] { + return -code error "([info level 0]) $message" + } + return $sdsStr } namespace eval ::nexus::chopperadapter { } -proc ::nexus::chopperadapter::save {sobj nxalias data_type args} { - array set attribute [attlist $sobj] +proc ::nexus::chopperadapter::save {sobj nxalias hpath data_type filestatus args} { + if [ catch { + array set attribute [attlist $sobj] set val [SplitReply [$sobj]] if {[lindex $args 0] == "point"} { set index [lindex $args 1] - nxscript_data clear + nxscript_data clear switch $data_type { int {nxscript_data putint 0 $val} float {nxscript_data putfloat 0 $val} @@ -1207,35 +1180,53 @@ proc ::nexus::chopperadapter::save {sobj nxalias data_type args} { default {error "ERROR: [info level -1]->::nexus::chopperadapter::save, unknown type $data_type"} } } + if {$filestatus == "newfile"} { + if [hpropexists $hpath link] { + set link [hgetpropval $hpath link] + nxscript makelink $link $nxalias + } + foreach {propName propValue} [hfindprop $hpath @*] { + set attName [string range $propName 1 end] + nxscript putattribute $nxalias $attName $propValue + } + } + } message ] { + return -code error "([info level 0]) $message" + } } -proc ::nexus::chopperadapter::sdsinfo {sobj data_type args} { - array set param $args - set dtype [::nexus::hdb2nx_type $data_type] - array set attribute [::utility::normalattlist $sobj] - if {[info exists attribute(units)]} { - set units_att " -attr {units,$attribute(units)} " - } else { - set units_att " " - } - if {$param(mutable) == true} { - return " -type $dtype -rank 1 -dim {-1} $units_att" - } else { - return " -type $dtype $units_att" +proc ::nexus::chopperadapter::sdsinfo {sdsName data_type sobj args} { + if [ catch { + array set param $args + set dtype [::nexus::hdb2nx_type $data_type] + array set attribute [::utility::normalattlist $sobj] + if {[info exists attribute(units)]} { + set units_att " -attr {units,$attribute(units)} " + } else { + set units_att " " + } + if {$param(mutable) == true} { + set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att" + } else { + set sdsStr "$sdsName -type $dtype $units_att" + } + } message ] { + return -code error "([info level 0]) $message" } + return $sdsStr } -proc ::nexus::singlecounter::save {counter nxalias data_type args} { +proc ::nexus::singlecounter::save {counter nxalias hpath data_type filestatus args} { todo_msg "Save counter: $counter" } -proc ::nexus::singlecounter::sdsinfo {counter data_type args} { +proc ::nexus::singlecounter::sdsinfo {sdsName data_type counter args} { todo_msg "Get sdsinfo for counter: $counter" } ## # @brief Save command for hdb nodes associated with a tcl macro # -# The macro must return a 1D associative array when called with -arrayname. -proc ::nexus::script::save {script nxalias data_type args} { +# The macro must return the name of a 1D associative array when called with -get_data_ref. +proc ::nexus::script::save {script nxalias hpath data_type filestatus args} { if [ catch { array set attribute [attlist $script] if {$attribute(klass) == "sensor"} { @@ -1248,8 +1239,7 @@ proc ::nexus::script::save {script nxalias data_type args} { nxscript putfloat $nxalias [$script] } } else { - set darray [$script -arrayname] - set size [array size $darray] + set darray [$script -get_data_ref] set size [SplitReply [$darray used]] if {[lindex $args 0] == "point"} { set index [lindex $args 1] @@ -1258,13 +1248,22 @@ proc ::nexus::script::save {script nxalias data_type args} { nxscript putslab $nxalias [list 0] [list $size] $darray } } + if {$filestatus == "newfile"} { + if [hpropexists $hpath link] { + set link [hgetpropval $hpath link] + nxscript makelink $link $nxalias + } + foreach {propName propValue} [hfindprop $hpath @*] { + set attName [string range $propName 1 end] + nxscript putattribute $nxalias $attName $propValue + } + } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } -proc ::nexus::script::sdsinfo {sobj data_type args} { +proc ::nexus::script::sdsinfo {sdsName data_type sobj args} { if [ catch { array set param $args set dtype [::nexus::hdb2nx_type $data_type] @@ -1276,25 +1275,25 @@ proc ::nexus::script::sdsinfo {sobj data_type args} { } if {[getatt $sobj klass] == "sensor"} { if {$param(mutable) == true} { - return " -type $dtype -rank 1 -dim {-1} $units_att" + set sdsStr "$sdsName -type $dtype -rank 1 -dim {-1} $units_att" } else { - return " -type $dtype $units_att" + set sdsStr "$sdsName -type $dtype $units_att" } } else { - set darray [$sobj -arrayname] + set darray [$sobj -get_data_ref] set size [SplitReply [$darray used]] if {$param(mutable) == true} { - return " -type $dtype -rank 2 -dim {-1,$size}" + set sdsStr "$sdsName -type $dtype $units_att -rank 2 -dim {-1,$size}" } else { - return " -type $dtype -rank 1 -dim {$size}" + set sdsStr "$sdsName -type $dtype $units_att -rank 1 -dim {$size}" } } } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + #TODO CHECK ERROR: failed to open alias ::histogram_memory::y_bin etc. + return -code error "([info level 0]) $message" } + return $sdsStr } - namespace import ::nexus::* foreach expt $::nexus::exports { publish $expt user @@ -1302,7 +1301,6 @@ foreach expt $::nexus::exports { } # TODO Return filename from nxcreatefile and call nxreopen nxclose etc -# TODO Make an nxscript namespace for all this. # dictalias is a global hash which records the alias which the value of # a sics object (eg motors) is written to. The has is indexed by the @@ -1312,7 +1310,7 @@ foreach expt $::nexus::exports { set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}] set nx_content_release_tag [lindex $tmpstr [expr [llength $tmpstr] - 1]] -set tmpstr [string map {"$" ""} {$Revision: 1.47 $}] +set tmpstr [string map {"$" ""} {$Revision: 1.48 $}] set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]] #namespace eval data { diff --git a/site_ansto/instrument/config/scan/scan_common_1.tcl b/site_ansto/instrument/config/scan/scan_common_1.tcl index 49fb6df1..55a78a82 100644 --- a/site_ansto/instrument/config/scan/scan_common_1.tcl +++ b/site_ansto/instrument/config/scan/scan_common_1.tcl @@ -376,6 +376,7 @@ namespace eval scan { variable reset_position variable force_scan + if [ catch { set force_scan false set hm_ft_names [array names ::nexus::histmem_filetype_spec] @@ -386,13 +387,13 @@ namespace eval scan { set savetype "save" set reset_position [SplitReply [::scan::runscan_reset_position]] if {[is_drivable $scanvar] == 0} { - return -code error "The scan variable <$scanvar> must be drivable" + error "The scan variable <$scanvar> must be drivable" } if {[string is integer $numpoints] != 1} { - return -code error "Number of points <$numpoints> must be an integer" + error "Number of points <$numpoints> must be an integer" } if { $numpoints < 1 } { - return -code error "Number of points <$numpoints> must not be less than one" + error "Number of points <$numpoints> must not be less than one" } ::histogram_memory::count_method $mode ::histogram_memory::count_size $preset @@ -417,11 +418,7 @@ namespace eval scan { } } "datatype" { - if {[lsearch $hm_ft_names $val] == -1} { - error "ERROR: datatype should be one of $hm_ft_names" - } else { - set ic_hmm_datatype $val - } + set ic_hmm_datatype $val } "savetype" { switch $val { @@ -432,7 +429,7 @@ namespace eval scan { set save_filetype scratch } default { - return -code error "ERROR: $arg $val, valid values for $arg are 'save' or 'nosave'" + error "ERROR: $arg $val, valid values for $arg are 'save' or 'nosave'" } } } @@ -452,14 +449,14 @@ namespace eval scan { ::scan::runscan_cmd -set feedback scan_step $step ::scan::runscan_cmd -set mode $mode ::scan::runscan_cmd -set preset $preset - set status [catch {hmscan run $numpoints timer 0} msg] + hmscan run $numpoints timer 0 + } message ] { set force_scan false - - if {$status == 0} { - return $msg - } else { - return -code error "ERROR [info level 0]\n$msg" - } + return -code error "ERROR [info level 0]\n$message" + } else { + set force_scan false + return $message + } } } namespace import ::scan::runscan diff --git a/site_ansto/instrument/gumxml.tcl b/site_ansto/instrument/gumxml.tcl index 4cb047e8..242c6da0 100644 --- a/site_ansto/instrument/gumxml.tcl +++ b/site_ansto/instrument/gumxml.tcl @@ -8,7 +8,7 @@ set type [getdataType $path] set prefix [string repeat " " $indent] set newIndent [expr $indent + 2] set control "true" - foreach {key value} [string map {= " "} [hlistprop $path]] { + foreach {key value} [string map {= " "} [hlistprop $path tcl]] { if {[string compare -nocase $key "control"] == 0} { if {[string compare -nocase $value "false"] == 0} { set control "false" @@ -30,7 +30,7 @@ set control "true" proc property_elements {path indent} { set prefix [string repeat " " $indent] - foreach {key value} [string map {= " "} [hlistprop $path]] { + foreach {key value} [string map {= " "} [hlistprop $path tcl]] { if {[string compare -nocase $key "control"] == 0} {continue} lappend proplist "$prefix\n" foreach v [split $value ,] { diff --git a/site_ansto/instrument/hipd/config/INSTCFCOMMON.TXT b/site_ansto/instrument/hipd/config/INSTCFCOMMON.TXT index 1e43c217..add63e17 100644 --- a/site_ansto/instrument/hipd/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/hipd/config/INSTCFCOMMON.TXT @@ -3,10 +3,12 @@ config/anticollider/anticollider_common.tcl config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl config/environment/temperature/lakeshore340_common.tcl +config/environment/temperature/sct_lakeshore_3xx.tcl config/hipadaba/hipadaba_configuration_common.tcl config/hipadaba/common_instrument_dictionary.tcl config/hipadaba/instdict_specification.tcl config/hmm/hmm_configuration_common_1.tcl +config/hmm/hmm_object.tcl config/hmm/hmm_cylindrical_detector_configuration.tcl config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd @@ -14,3 +16,4 @@ config/scan/scan_common_1.tcl config/nexus/nxscripts_common_1.tcl config/commands/commands_common.tcl config/motors/sct_positmotor_common.tcl +config/motors/sct_jogmotor_common.tcl diff --git a/site_ansto/instrument/hipd/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/hipd/config/hmm/hmm_configuration.tcl index 697b4469..ec6162c1 100644 --- a/site_ansto/instrument/hipd/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/hipd/config/hmm/hmm_configuration.tcl @@ -96,13 +96,16 @@ proc ::histogram_memory::detector_posn_degrees {} { proc ::histogram_memory::pre_count {} {} proc ::histogram_memory::post_count {} {} proc ::histogram_memory::isc_initialize {} { + # Instrument specific X and Y dimension names + variable INST_NXC "stitch_nxc" + variable INST_NYC "stitch_nyc" if [ catch { ::histogram_memory::init_hmm_objs if {$::sim_mode == "true"} { hmm configure oat_ntc_eff 1 - hmm configure stitch_nyc 512 - hmm configure stitch_nxc [expr 480*8 - 1] + hmm configure $INST_NYC 512 + hmm configure $INST_NXC [expr 480*8 - 1] } BAT_TABLE -init CAT_TABLE -init @@ -110,17 +113,20 @@ proc ::histogram_memory::isc_initialize {} { OAT_TABLE -init FAT_TABLE -init MULTI_HOST_HISTO_STITCH_OVERLAP MULTI_HOST_HISTO_JOIN_STITCH_ORDER ::histogram_memory::ic_initialize - ::histogram_memory::two_theta -boundaries + ::histogram_memory::set_graphtype "two_theta" "boundaries" detector_active_height_mm 203.2 + detector_active_height_mm lock detector_active_width_mm 1524 + detector_active_width_mm lock detector_radius_mm 728.0 + detector_radius_mm lock ::histogram_memory::init_OAT_TABLE res "std_968x128" ::histogram_memory::upload_config Filler_defaults ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset - ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta + ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_pixel_angular_offset } message ] { if {$::errorCode=="NONE"} {return $message} return -code error $message diff --git a/site_ansto/instrument/hipd/script_validator/sics_ports.tcl b/site_ansto/instrument/hipd/script_validator/sics_ports.tcl index ecec1f2e..5bde9159 100644 --- a/site_ansto/instrument/hipd/script_validator/sics_ports.tcl +++ b/site_ansto/instrument/hipd/script_validator/sics_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-val-wombat -set serverport server-val-wombat -set interruptport interrupt-val-wombat -set telnetport telnet-val-wombat +set quieckport sics-quieck-val-wombat +set serverport sics-server-val-wombat +set interruptport sics-interrupt-val-wombat +set telnetport sics-telnet-val-wombat diff --git a/site_ansto/instrument/hipd/script_validator_ports.tcl b/site_ansto/instrument/hipd/script_validator_ports.tcl index ecec1f2e..5bde9159 100644 --- a/site_ansto/instrument/hipd/script_validator_ports.tcl +++ b/site_ansto/instrument/hipd/script_validator_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-val-wombat -set serverport server-val-wombat -set interruptport interrupt-val-wombat -set telnetport telnet-val-wombat +set quieckport sics-quieck-val-wombat +set serverport sics-server-val-wombat +set interruptport sics-interrupt-val-wombat +set telnetport sics-telnet-val-wombat diff --git a/site_ansto/instrument/hipd/sics_ports.tcl b/site_ansto/instrument/hipd/sics_ports.tcl index 681672b4..799f2b34 100644 --- a/site_ansto/instrument/hipd/sics_ports.tcl +++ b/site_ansto/instrument/hipd/sics_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-wombat -set serverport server-wombat -set interruptport interrupt-wombat -set telnetport telnet-wombat +set quieckport sics-quieck-wombat +set serverport sics-server-wombat +set interruptport sics-interrupt-wombat +set telnetport sics-telnet-wombat diff --git a/site_ansto/instrument/hipd/wombat_configuration.tcl b/site_ansto/instrument/hipd/wombat_configuration.tcl index 67c8d151..96e29948 100644 --- a/site_ansto/instrument/hipd/wombat_configuration.tcl +++ b/site_ansto/instrument/hipd/wombat_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.30 $ -# $Date: 2009-03-31 06:25:18 $ +# $Revision: 1.31 $ +# $Date: 2009-11-24 22:56:46 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -28,6 +28,7 @@ fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(counter)/counter.tcl #TODO Provide method for choosing environment controller fileeval $cfPath(environment)/temperature/lakeshore340.tcl +fileeval $cfPath(environment)/temperature/sct_lakeshore_3xx.tcl fileeval $cfPath(environment)/temperature/west400.tcl fileeval $cfPath(hmm)/hmm_configuration.tcl fileeval $cfPath(nexus)/nxscripts.tcl diff --git a/site_ansto/instrument/hrpd/config/INSTCFCOMMON.TXT b/site_ansto/instrument/hrpd/config/INSTCFCOMMON.TXT index f3add065..add63e17 100644 --- a/site_ansto/instrument/hrpd/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/hrpd/config/INSTCFCOMMON.TXT @@ -3,10 +3,12 @@ config/anticollider/anticollider_common.tcl config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl config/environment/temperature/lakeshore340_common.tcl +config/environment/temperature/sct_lakeshore_3xx.tcl config/hipadaba/hipadaba_configuration_common.tcl config/hipadaba/common_instrument_dictionary.tcl config/hipadaba/instdict_specification.tcl config/hmm/hmm_configuration_common_1.tcl +config/hmm/hmm_object.tcl config/hmm/hmm_cylindrical_detector_configuration.tcl config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd diff --git a/site_ansto/instrument/hrpd/config/anticollider/acscript.txt b/site_ansto/instrument/hrpd/config/anticollider/acscript.txt index 3cc73a9d..a40338cc 100644 --- a/site_ansto/instrument/hrpd/config/anticollider/acscript.txt +++ b/site_ansto/instrument/hrpd/config/anticollider/acscript.txt @@ -10,8 +10,14 @@ # forbid {0 10} for sphi whenall {schi in {10 15} sx {10 11} } +#-----------monochromator rotation--------------- +for mom forbid {0 48} +#----------primary collimator translation-------- for pcx forbid {80 130} -for pcr forbid {3 176} when mom in {45 50} +#----------primary collimator rotation----------- +for pcr forbid {{3 177} {-177 -3}} when mom in {0 89} +for pcr forbid {{3 177} {-177 -3}} when pcx in {{-inf 68} {72 inf}} + #for pcr forbid {-inf inf} when mom in {45 50} for stth forbid {160 167} when mtth in {87 88} #for stth forbid {0 15} when mtth in {139.5 140.5} diff --git a/site_ansto/instrument/hrpd/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/hrpd/config/hmm/hmm_configuration.tcl index 8d9cd12b..972fe651 100644 --- a/site_ansto/instrument/hrpd/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/hrpd/config/hmm/hmm_configuration.tcl @@ -130,13 +130,16 @@ proc ::histogram_memory::detector_posn_degrees {} { proc ::histogram_memory::pre_count {} {} proc ::histogram_memory::post_count {} {} proc ::histogram_memory::isc_initialize {} { + # Instrument specific X and Y dimension names + variable INST_NXC "oat_nxc_eff" + variable INST_NYC "oat_nyc_eff" if [ catch { ::histogram_memory::init_hmm_objs if {$::sim_mode == "true"} { hmm configure oat_ntc_eff 1 - hmm configure oat_nyc_eff 1024 - hmm configure oat_nxc_eff 64 + hmm configure $INST_NYC 1024 + hmm configure $INST_NXC 64 } BAT_TABLE -init CAT_TABLE -init @@ -144,11 +147,14 @@ proc ::histogram_memory::isc_initialize {} { OAT_TABLE -init FAT_TABLE -init ::histogram_memory::ic_initialize - ::histogram_memory::two_theta -boundaries + ::histogram_memory::set_graphtype "two_theta" "boundaries" detector_active_height_mm 335 + detector_active_height_mm lock detector_active_width_mm 3490.64 + detector_active_width_mm lock detector_radius_mm 1250.0 + detector_radius_mm lock # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax @@ -160,7 +166,7 @@ proc ::histogram_memory::isc_initialize {} { ::histogram_memory::upload_config Filler_defaults ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset - ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta + ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_pixel_angular_offset } message ] { if {$::errorCode=="NONE"} {return $message} return -code error $message diff --git a/site_ansto/instrument/hrpd/config/motors/motor_configuration.tcl b/site_ansto/instrument/hrpd/config/motors/motor_configuration.tcl index 0fee33a8..7b0b0614 100644 --- a/site_ansto/instrument/hrpd/config/motors/motor_configuration.tcl +++ b/site_ansto/instrument/hrpd/config/motors/motor_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.35 $ -# $Date: 2009-03-31 06:25:19 $ +# $Revision: 1.36 $ +# $Date: 2009-11-24 22:56:47 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -36,10 +36,12 @@ set mphi_Home 11839906 set mchi_Home 8417936 set my_Home 7781389 set mx_Home 7580366 -set mom_Home 13442930 +#set mom_Home 13442930 +set mom_Home 13447313 set mtth_Home 11534660 set pcx_Home 8345600 set pcr_Home 5440000 +set scr_Home 31734679 set sphi_Home 7924507 set schi_Home 7542917 set sy_Home 7626584 @@ -160,7 +162,7 @@ Motor mchi $motor_driver_type [params \ asyncqueue mc1\ axis B\ units degrees\ - hardlowerlim 88\ + hardlowerlim -2\ hardupperlim 92\ maxSpeed 1\ maxAccel 1\ @@ -169,8 +171,7 @@ Motor mchi $motor_driver_type [params \ absEnc 1\ absEncHome $mchi_Home\ cntsPerX 8192] -mchi 90.1 -mchi softlowerlim 88 +mchi softlowerlim -2 mchi softupperlim 92 mchi speed 1 mchi movecount $move_count @@ -326,6 +327,27 @@ pcr precision 0.01 pcr part collimator pcr long_name primary_collimator_rotation +# Secondary Collimator Rotation +Motor scr $motor_driver_type [params \ + asyncqueue mc2\ + axis G\ + units degrees\ + hardlowerlim -10\ + hardupperlim 10\ + maxSpeed 1.0\ + maxAccel 0.1\ + maxDecel 0.1\ + stepsPerX 12500\ + absEnc 1\ + absEncHome $scr_Home\ + cntsPerX 4096] +setHomeandRange -motor scr -home 0 -lowrange 5 -uprange 185 +scr speed 1 +scr movecount $move_count +scr precision 0.01 +scr part collimator +scr long_name secondary_collimator_rotation + ############################ # Motor Controller 2 # Motor Controller 2 @@ -498,6 +520,8 @@ mf1 speed 0.1 mf1 movecount $move_count mf1 precision 0.01 mf1 creep_offset 0.1 +mf1 part crystal +mf1 long_name mf1 # Slit 1, right Motor ss1r $motor_driver_type [params \ diff --git a/site_ansto/instrument/hrpd/config/nexus/nxscripts.tcl b/site_ansto/instrument/hrpd/config/nexus/nxscripts.tcl index 1845cac3..5f4166ab 100644 --- a/site_ansto/instrument/hrpd/config/nexus/nxscripts.tcl +++ b/site_ansto/instrument/hrpd/config/nexus/nxscripts.tcl @@ -1 +1,4 @@ source $cfPath(nexus)/nxscripts_common_1.tcl +proc ::nexus::isc_initialize {} { + ::nexus::ic_initialize +} diff --git a/site_ansto/instrument/hrpd/echidna_configuration.tcl b/site_ansto/instrument/hrpd/echidna_configuration.tcl index 1d9efe21..f09b319c 100644 --- a/site_ansto/instrument/hrpd/echidna_configuration.tcl +++ b/site_ansto/instrument/hrpd/echidna_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.36 $ -# $Date: 2009-03-31 06:25:19 $ +# $Revision: 1.37 $ +# $Date: 2009-11-24 22:56:47 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -28,6 +28,7 @@ fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(counter)/counter.tcl #TODO Provide method for choosing environment controller fileeval $cfPath(environment)/temperature/lakeshore340.tcl +fileeval $cfPath(environment)/temperature/sct_lakeshore_3xx.tcl fileeval $cfPath(environment)/temperature/west400.tcl fileeval $cfPath(hmm)/hmm_configuration.tcl fileeval $cfPath(nexus)/nxscripts.tcl @@ -37,10 +38,16 @@ fileeval $cfPath(anticollider)/anticollider.tcl fileeval $cfPath(environment)/robby_configuration.tcl source gumxml.tcl +# Old Lakeshore340 driver (c-code) # ::environment::temperature::add_ls340 tc1 1 # ::environment::temperature::add_ls340 tc2 2 - ::environment::temperature::add_west400 -# ::robot::add_robby +# +# New sct Lakeshore340 driver (in tcl) +# ::environment::temperature::add_ls340t tc1 1 +# ::environment::temperature::add_ls340t tc2 2 + +# ::environment::temperature::add_west400 + ::robot::add_robby server_init ########################################### # WARNING: Do not add any code below server_init, if you do SICS may fail to initialise properly. diff --git a/site_ansto/instrument/hrpd/script_validator/sics_ports.tcl b/site_ansto/instrument/hrpd/script_validator/sics_ports.tcl index 6ff92173..22cf905d 100644 --- a/site_ansto/instrument/hrpd/script_validator/sics_ports.tcl +++ b/site_ansto/instrument/hrpd/script_validator/sics_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-val-echidna -set serverport server-val-echidna -set interruptport interrupt-val-echidna -set telnetport telnet-val-echidna +set quieckport sics-quieck-val-echidna +set serverport sics-server-val-echidna +set interruptport sics-interrupt-val-echidna +set telnetport sics-telnet-val-echidna diff --git a/site_ansto/instrument/hrpd/script_validator_ports.tcl b/site_ansto/instrument/hrpd/script_validator_ports.tcl index 6ff92173..22cf905d 100644 --- a/site_ansto/instrument/hrpd/script_validator_ports.tcl +++ b/site_ansto/instrument/hrpd/script_validator_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-val-echidna -set serverport server-val-echidna -set interruptport interrupt-val-echidna -set telnetport telnet-val-echidna +set quieckport sics-quieck-val-echidna +set serverport sics-server-val-echidna +set interruptport sics-interrupt-val-echidna +set telnetport sics-telnet-val-echidna diff --git a/site_ansto/instrument/hrpd/sics_ports.tcl b/site_ansto/instrument/hrpd/sics_ports.tcl index 413c3097..f2adf091 100644 --- a/site_ansto/instrument/hrpd/sics_ports.tcl +++ b/site_ansto/instrument/hrpd/sics_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-echidna -set serverport server-echidna -set interruptport interrupt-echidna -set telnetport telnet-echidna +set quieckport sics-quieck-echidna +set serverport sics-server-echidna +set interruptport sics-interrupt-echidna +set telnetport sics-telnet-echidna diff --git a/site_ansto/instrument/pas/config/INSTCFCOMMON.TXT b/site_ansto/instrument/pas/config/INSTCFCOMMON.TXT index 7caec613..55c528b6 100644 --- a/site_ansto/instrument/pas/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/pas/config/INSTCFCOMMON.TXT @@ -2,13 +2,16 @@ config/source/source_common.tcl config/anticollider/anticollider_common.tcl config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl +config/environment/temperature/sct_lakeshore_3xx.tcl config/hipadaba/hipadaba_configuration_common.tcl config/hipadaba/common_instrument_dictionary.tcl config/hipadaba/instdict_specification.tcl config/hmm/hmm_configuration_common_1.tcl +config/hmm/hmm_object.tcl config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd config/scan/scan_common_1.tcl config/nexus/nxscripts_common_1.tcl config/commands/commands_common.tcl config/motors/sct_positmotor_common.tcl +config/motors/sct_jogmotor_common.tcl diff --git a/site_ansto/instrument/pas/pelican_configuration.tcl b/site_ansto/instrument/pas/pelican_configuration.tcl index df6384e1..fbfc8f86 100644 --- a/site_ansto/instrument/pas/pelican_configuration.tcl +++ b/site_ansto/instrument/pas/pelican_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.2 $ -# $Date: 2008-10-20 00:08:30 $ +# $Revision: 1.3 $ +# $Date: 2009-11-24 22:56:47 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -25,6 +25,7 @@ source $cfPath(hipadaba)/hipadaba_configuration.tcl fileeval $cfPath(parameters)/parameters.tcl fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(counter)/counter.tcl +fileeval $cfPath(environment)/temperature/sct_lakeshore_3xx.tcl fileeval $cfPath(hmm)/hmm_configuration.tcl fileeval $cfPath(hmm)/detector.tcl fileeval $cfPath(nexus)/nxscripts.tcl diff --git a/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT b/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT index 7caec613..55c528b6 100644 --- a/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT @@ -2,13 +2,16 @@ config/source/source_common.tcl config/anticollider/anticollider_common.tcl config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl +config/environment/temperature/sct_lakeshore_3xx.tcl config/hipadaba/hipadaba_configuration_common.tcl config/hipadaba/common_instrument_dictionary.tcl config/hipadaba/instdict_specification.tcl config/hmm/hmm_configuration_common_1.tcl +config/hmm/hmm_object.tcl config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd config/scan/scan_common_1.tcl config/nexus/nxscripts_common_1.tcl config/commands/commands_common.tcl config/motors/sct_positmotor_common.tcl +config/motors/sct_jogmotor_common.tcl diff --git a/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl index 23ef0e8b..33a3ca17 100644 --- a/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl @@ -21,13 +21,16 @@ proc ::histogram_memory::init_OAT_TABLE {} { proc ::histogram_memory::pre_count {} {} proc ::histogram_memory::post_count {} {} proc ::histogram_memory::isc_initialize {} { + # Instrument specific X and Y dimension names + variable INST_NXC "oat_nxc_eff" + variable INST_NYC "oat_nyc_eff" if [ catch { ::histogram_memory::init_hmm_objs if {$::sim_mode == "true"} { hmm configure oat_ntc_eff 1 - hmm configure oat_nyc_eff 210 - hmm configure oat_nxc_eff 210 + hmm configure $INST_NYC 210 + hmm configure $INST_NXC 210 } BAT_TABLE -init CAT_TABLE -init @@ -37,7 +40,9 @@ proc ::histogram_memory::isc_initialize {} { ::histogram_memory::ic_initialize detector_active_height_mm 230 + detector_active_height_mm lock detector_active_width_mm 480 + detector_active_width_mm lock # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax diff --git a/site_ansto/instrument/reflectometer/config/parameters/parameters.tcl b/site_ansto/instrument/reflectometer/config/parameters/parameters.tcl index 3b309898..b292452a 100644 --- a/site_ansto/instrument/reflectometer/config/parameters/parameters.tcl +++ b/site_ansto/instrument/reflectometer/config/parameters/parameters.tcl @@ -2,39 +2,42 @@ # @brief Instrument parameters # TODO There should be an NXgeometry entry for each distance, and linked to an NXgeometry # entry for the chopper [SICS-108]. -foreach vn { - detector_distance - detector_base - slit4_distance - slit4_base - sample_distance - sample_base - slit3_distance - slit3_base - guide1_distance - guide1_base - guide2_distance - guide2_base - slit2_distance - slit2_base - chopper4_distance - chopper4_base - chopper3_distance - chopper3_base - chopper2_distance - chopper2_base - chopper1_distance - chopper1_base - chopper1_phase_offset - chopper2_phase_offset - chopper3_phase_offset - chopper4_phase_offset - slit1_distance - slit1_base - omega - twotheta +foreach {vn klass units} { + detector_distance parameter mm + detector_base parameter mm + slit4_distance parameter mm + slit4_base parameter mm + sample_distance parameter mm + sample_base parameter mm + slit3_distance parameter mm + slit3_base parameter mm + guide1_distance parameter mm + guide1_base parameter mm + guide2_distance parameter mm + guide2_base parameter mm + slit2_distance parameter mm + slit2_base parameter mm + chopper4_distance parameter mm + chopper4_base parameter mm + chopper3_distance parameter mm + chopper3_base parameter mm + chopper2_distance parameter mm + chopper2_base parameter mm + chopper1_distance parameter mm + chopper1_base parameter mm + chopper1_phase_offset parameter degrees + chopper2_phase_offset parameter degrees + chopper3_phase_offset parameter degrees + chopper4_phase_offset parameter degrees + slit1_distance parameter mm + slit1_base parameter mm + omega parameter degrees + twotheta parameter degrees + anal_distance polarizer mm + anal_base polarizer mm } { - ::utility::mkVar $vn float manager $vn true parameter true true + ::utility::mkVar $vn float manager $vn true $klass true true + sicslist setatt $vn units $units } foreach vn { diff --git a/site_ansto/instrument/reflectometer/platypus_configuration.tcl b/site_ansto/instrument/reflectometer/platypus_configuration.tcl index 9d47e53c..960bd588 100644 --- a/site_ansto/instrument/reflectometer/platypus_configuration.tcl +++ b/site_ansto/instrument/reflectometer/platypus_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.22 $ -# $Date: 2008-10-27 04:55:45 $ +# $Revision: 1.23 $ +# $Date: 2009-11-24 22:56:47 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -17,15 +17,17 @@ source server_config.tcl ######################################## # INSTRUMENT SPECIFIC CONFIGURATION +source $cfPath(hipadaba)/hipadaba_configuration.tcl fileeval $cfPath(motors)/motor_configuration.tcl +fileeval $cfPath(motors)/sct_batmotor.tcl fileeval $cfPath(source)/source.tcl -source $cfPath(hipadaba)/hipadaba_configuration.tcl fileeval $cfPath(motors)/positmotor_configuration.tcl fileeval $cfPath(parameters)/parameters.tcl fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(counter)/counter.tcl +fileeval $cfPath(environment)/temperature/sct_lakeshore_3xx.tcl fileeval $cfPath(hmm)/hmm_configuration.tcl fileeval $cfPath(nexus)/nxscripts.tcl fileeval $cfPath(hmm)/detector.tcl diff --git a/site_ansto/instrument/reflectometer/script_validator/sics_ports.tcl b/site_ansto/instrument/reflectometer/script_validator/sics_ports.tcl index 25f2802a..462d5b36 100644 --- a/site_ansto/instrument/reflectometer/script_validator/sics_ports.tcl +++ b/site_ansto/instrument/reflectometer/script_validator/sics_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-val-platypus -set serverport server-val-platypus -set interruptport interrupt-val-platypus -set telnetport telnet-val-platypus +set quieckport sics-quieck-val-platypus +set serverport sics-server-val-platypus +set interruptport sics-interrupt-val-platypus +set telnetport sics-telnet-val-platypus diff --git a/site_ansto/instrument/reflectometer/script_validator_ports.tcl b/site_ansto/instrument/reflectometer/script_validator_ports.tcl index 25f2802a..462d5b36 100644 --- a/site_ansto/instrument/reflectometer/script_validator_ports.tcl +++ b/site_ansto/instrument/reflectometer/script_validator_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-val-platypus -set serverport server-val-platypus -set interruptport interrupt-val-platypus -set telnetport telnet-val-platypus +set quieckport sics-quieck-val-platypus +set serverport sics-server-val-platypus +set interruptport sics-interrupt-val-platypus +set telnetport sics-telnet-val-platypus diff --git a/site_ansto/instrument/reflectometer/sics_ports.tcl b/site_ansto/instrument/reflectometer/sics_ports.tcl index 6f377861..db238faf 100644 --- a/site_ansto/instrument/reflectometer/sics_ports.tcl +++ b/site_ansto/instrument/reflectometer/sics_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-platypus -set serverport server-platypus -set interruptport interrupt-platypus -set telnetport telnet-platypus +set quieckport sics-quieck-platypus +set serverport sics-server-platypus +set interruptport sics-interrupt-platypus +set telnetport sics-telnet-platypus diff --git a/site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT b/site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT index 7caec613..55c528b6 100644 --- a/site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT @@ -2,13 +2,16 @@ config/source/source_common.tcl config/anticollider/anticollider_common.tcl config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl +config/environment/temperature/sct_lakeshore_3xx.tcl config/hipadaba/hipadaba_configuration_common.tcl config/hipadaba/common_instrument_dictionary.tcl config/hipadaba/instdict_specification.tcl config/hmm/hmm_configuration_common_1.tcl +config/hmm/hmm_object.tcl config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd config/scan/scan_common_1.tcl config/nexus/nxscripts_common_1.tcl config/commands/commands_common.tcl config/motors/sct_positmotor_common.tcl +config/motors/sct_jogmotor_common.tcl diff --git a/site_ansto/instrument/rsd/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/rsd/config/hmm/hmm_configuration.tcl index 3dbcd7b1..644f6ede 100644 --- a/site_ansto/instrument/rsd/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/rsd/config/hmm/hmm_configuration.tcl @@ -1,6 +1,8 @@ source $cfPath(hmm)/hmm_configuration_common_1.tcl set sim_mode [SplitReply [hmm_simulation]] +::utility::mkVar sample_to_detector_distance float manager sample_to_detector_distance true detector true true +sicslist setatt sample_to_detector_distance units mm proc ::histogram_memory::init_OAT_TABLE {} { # We don't need a MAX_CHAN parameter for time because the time channel @@ -18,39 +20,54 @@ proc ::histogram_memory::init_OAT_TABLE {} { proc ::histogram_memory::pre_count {} {} proc ::histogram_memory::post_count {} {} -proc ::histogram_memory::mk_hmm_corrected {} { - if {$::sim_mode == "true"} { - MakeHM hmm_xy_corrected SIM - MakeHM hmm_x_corrected SIM - } else { - MakeHM hmm_xy_corrected anstohttp - MakeHM hmm_x_corrected anstohttp +## +# @brief Adds Kowari specific hmm data types +proc ::histogram_memory::is_select_read_type {type} { + variable HMOBJ + # Instrument specific X and Y dimension names + variable INST_NXC + variable INST_NYC + + if [catch { + $HMOBJ configure read_data_period_number 0 + + switch [string toupper $type] { + "TOTAL_HISTOGRAM_X_CORRECTED" { + $HMOBJ configure rank 1 + $HMOBJ configure dim0 [SplitReply [$HMOBJ configure $INST_NXC]] + $HMOBJ configure READ_DATA_UNCAL_CAL CALIBRATED + $HMOBJ configure READ_DATA_TYPE TOTAL_HISTOGRAM_X + set hmm_ext "_total_x" + } + "TOTAL_HISTOGRAM_XY_CORRECTED" { + $HMOBJ configure rank 2 + $HMOBJ configure dim0 [SplitReply [$HMOBJ configure $INST_NXC]] + $HMOBJ configure dim1 [SplitReply [$HMOBJ configure $INST_NYC]] + $HMOBJ configure READ_DATA_UNCAL_CAL CALIBRATED + $HMOBJ configure READ_DATA_TYPE TOTAL_HISTOGRAM_XY + set hmm_ext "_total_xy" + } + default { + $HMOBJ configure READ_DATA_UNCAL_CAL UNCALIBRATED + set hmm_ext "notfound" + } } - hmm_xy_corrected configure rank 2 - hmm_xy_corrected configure READ_DATA_UNCAL_CAL CALIBRATED - hmm_xy_corrected configure READ_DATA_TYPE TOTAL_HISTOGRAM_XY - hmm_xy_corrected configure dim0 421 - hmm_xy_corrected configure dim1 421 - hmm_xy_corrected configure init 0 - hmm_xy_corrected init - - hmm_x_corrected configure rank 1 - hmm_x_corrected configure READ_DATA_UNCAL_CAL CALIBRATED - hmm_x_corrected configure READ_DATA_TYPE TOTAL_HISTOGRAM_X - hmm_x_corrected configure dim0 421 - hmm_x_corrected configure init 0 - hmm_x_corrected init + } msg ] { + return -code error "([info level 0]) $msg" + } + return $hmm_ext } - proc ::histogram_memory::isc_initialize {} { + # Instrument specific X and Y dimension names + variable INST_NXC "oat_nxc_eff" + variable INST_NYC "oat_nyc_eff" if [ catch { ::histogram_memory::init_hmm_objs - ::histogram_memory::mk_hmm_corrected if {$::sim_mode == "true"} { hmm configure oat_ntc_eff 1 - hmm configure oat_nyc_eff 421 - hmm configure oat_nxc_eff 421 + hmm configure $INST_NYC 421 + hmm configure $INST_NXC 421 } BAT_TABLE -init CAT_TABLE -init @@ -58,8 +75,10 @@ proc ::histogram_memory::isc_initialize {} { OAT_TABLE -init FAT_TABLE -init - detector_active_height_mm 300 - detector_active_width_mm 300 + detector_active_height_mm 280 + detector_active_height_mm lock + detector_active_width_mm 280 + detector_active_width_mm lock ::histogram_memory::ic_initialize diff --git a/site_ansto/instrument/rsd/kowari_configuration.tcl b/site_ansto/instrument/rsd/kowari_configuration.tcl index 311af22b..38098740 100644 --- a/site_ansto/instrument/rsd/kowari_configuration.tcl +++ b/site_ansto/instrument/rsd/kowari_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.16 $ -# $Date: 2008-10-27 04:55:46 $ +# $Revision: 1.17 $ +# $Date: 2009-11-24 22:56:48 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -25,6 +25,7 @@ source $cfPath(hipadaba)/hipadaba_configuration.tcl fileeval $cfPath(motors)/positmotor_configuration.tcl fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(counter)/counter.tcl +fileeval $cfPath(environment)/temperature/sct_lakeshore_3xx.tcl fileeval $cfPath(hmm)/hmm_configuration.tcl fileeval $cfPath(nexus)/nxscripts.tcl fileeval $cfPath(scan)/scan.tcl diff --git a/site_ansto/instrument/rsd/script_validator/sics_ports.tcl b/site_ansto/instrument/rsd/script_validator/sics_ports.tcl index 167c4803..0a407bc9 100644 --- a/site_ansto/instrument/rsd/script_validator/sics_ports.tcl +++ b/site_ansto/instrument/rsd/script_validator/sics_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-val-kowari -set serverport server-val-kowari -set interruptport interrupt-val-kowari -set telnetport telnet-val-kowari +set quieckport sics-quieck-val-kowari +set serverport sics-server-val-kowari +set interruptport sics-interrupt-val-kowari +set telnetport sics-telnet-val-kowari diff --git a/site_ansto/instrument/rsd/script_validator_ports.tcl b/site_ansto/instrument/rsd/script_validator_ports.tcl index 167c4803..0a407bc9 100644 --- a/site_ansto/instrument/rsd/script_validator_ports.tcl +++ b/site_ansto/instrument/rsd/script_validator_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-val-kowari -set serverport server-val-kowari -set interruptport interrupt-val-kowari -set telnetport telnet-val-kowari +set quieckport sics-quieck-val-kowari +set serverport sics-server-val-kowari +set interruptport sics-interrupt-val-kowari +set telnetport sics-telnet-val-kowari diff --git a/site_ansto/instrument/rsd/sics_ports.tcl b/site_ansto/instrument/rsd/sics_ports.tcl index 84d2cfa8..52996b03 100644 --- a/site_ansto/instrument/rsd/sics_ports.tcl +++ b/site_ansto/instrument/rsd/sics_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-kowari -set serverport server-kowari -set interruptport interrupt-kowari -set telnetport telnet-kowari +set quieckport sics-quieck-kowari +set serverport sics-server-kowari +set interruptport sics-interrupt-kowari +set telnetport sics-telnet-kowari diff --git a/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT b/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT index 8f4e3ab3..b32195a5 100644 --- a/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT @@ -6,6 +6,7 @@ config/hipadaba/hipadaba_configuration_common.tcl config/hipadaba/common_instrument_dictionary.tcl config/hipadaba/instdict_specification.tcl config/hmm/hmm_configuration_common_1.tcl +config/hmm/hmm_object.tcl config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd config/scan/scan_common_1.tcl @@ -13,4 +14,6 @@ config/nexus/nxscripts_common_1.tcl config/commands/commands_common.tcl config/motors/sct_positmotor_common.tcl config/environment/temperature/sct_julabo_lh45.tcl -config/environment/temperature/config/lakeshore340_common.tcl \ No newline at end of file +config/environment/temperature/lakeshore340_common.tcl +config/environment/temperature/sct_lakeshore_3xx.tcl +config/motors/sct_jogmotor_common.tcl diff --git a/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl index afb83d9b..4b03625d 100644 --- a/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl @@ -15,20 +15,22 @@ proc ::histogram_memory::init_OAT_TABLE {} { OAT_TABLE -set X { 191.5 190.5 } NXC 192 Y { -0.5 0.5 } NYC 192 T { 0 20000 } NTC 1 } message ] { - if {$::errorCode=="NONE"} {return $message} return -code error $message } } proc ::histogram_memory::pre_count {} {} proc ::histogram_memory::post_count {} {} proc ::histogram_memory::isc_initialize {} { + # Instrument specific X and Y dimension names + variable INST_NXC "oat_nxc_eff" + variable INST_NYC "oat_nyc_eff" if [ catch { ::histogram_memory::init_hmm_objs if {$::sim_mode == "true"} { hmm configure oat_ntc_eff 1 - hmm configure oat_nyc_eff 127 - hmm configure oat_nxc_eff 127 + hmm configure $INST_NYC 127 + hmm configure $INST_NXC 127 } BAT_TABLE -init CAT_TABLE -init @@ -52,7 +54,6 @@ proc ::histogram_memory::isc_initialize {} { ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_pixel_offset } message ] { - if {$::errorCode=="NONE"} {return $message} return -code error $message } } diff --git a/site_ansto/instrument/sans/config/motors/motor_configuration.tcl b/site_ansto/instrument/sans/config/motors/motor_configuration.tcl index 04de1c7a..86beafa2 100644 --- a/site_ansto/instrument/sans/config/motors/motor_configuration.tcl +++ b/site_ansto/instrument/sans/config/motors/motor_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.27 $ -# $Date: 2009-03-30 23:16:53 $ +# $Revision: 1.28 $ +# $Date: 2009-11-24 22:56:48 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -73,11 +73,14 @@ set att_Home 24782942 set bsx_Home 7831707 set bsz_Home 10143000 -set bs5_Home 0 -set bs4_Home 0 -set bs3_Home 0 -set bs2_Home 0 -set bs1_Home 0 +set bs1_Home 19027 +set bs2_Home 5721 +set bs3_Home 15844 +set bs4_Home 23089 +set bs5_Home 2293 +set bs6_Home 12597 +set bs_cntsPerX [expr 32768.0/360.0] +set bs_stepsPerX [expr -25000.0*160.0/360.0] set pol_Home 7500000 # early Guide mesaurements @@ -389,7 +392,7 @@ det precision 1 det softlowerlim 350 det softupperlim 19330 det home 350.5 -det speed 20 +det speed 40 det Blockage_Fail 0 # Detector translation across beam [-50,450] mm @@ -681,11 +684,11 @@ Motor pc10 $motor_driver_type [params \ absEncHome $pc10_Home\ cntsPerX $coll_CntsPerX\ posit_count 5] -pc10 posit_1 [expr $pc10_Empty + 81920] +pc10 posit_1 26197033 pc10 posit_2 [expr $pc10_Empty] pc10 posit_3 [expr $pc10_Guide] pc10 posit_4 [expr $pc10_Aperture] -pc10 posit_5 [expr $pc10_Aperture - 81920] +pc10 posit_5 25730100 pc10 part collimator pc10 long_name pc10 setHomeandRange -motor pc10 -home 0 -lowrange 190 -uprange 190 @@ -829,8 +832,8 @@ Motor bsx $motor_driver_type [params \ units mm\ hardlowerlim -200\ hardupperlim 200\ - maxSpeed 1\ - maxAccel 1\ + maxSpeed 5\ + maxAccel 2\ maxDecel 5\ stepsPerX [expr -(25000.0*7.0)/5.0/1.02]\ absEnc 1\ @@ -840,6 +843,7 @@ bsx part detector bsx long_name bsx bsx softlowerlim -200 bsx softupperlim 200 +bsx speed 5 bsx home 0 # beam stop vertical [-240,100] mm @@ -864,38 +868,148 @@ bsz softlowerlim -240 bsz softupperlim 80 bsz home 0 -if {1} { -# largest to smallest -# MakeActionObject obj aQ JG-speed upsw downsw axis -MakeActionObject bs1 mc4 [expr $bs125sign*$bs_steps_per_rev*$bs1gear/360.0] 8 4 C -MakeActionObject bs2 mc4 [expr $bs125sign*$bs_steps_per_rev*$bs2gear/360.0] 8 4 D -MakeActionObject bs3 mc4 [expr $bs34sign*$bs_steps_per_rev*$bs3gear/360.0] 4 8 E -MakeActionObject bs4 mc4 [expr $bs34sign*$bs_steps_per_rev*$bs4gear/360.0] 4 8 F -MakeActionObject bs5 mc4 [expr $bs125sign*$bs_steps_per_rev*$bs5gear/360.0] 8 4 G - -} - -# Polarizer Rotation -Motor pol $motor_driver_type [params \ +# Largest beamstop +Motor bs1 $motor_driver_type [params \ + asyncqueue mc4\ + axis C\ + units degrees\ + hardlowerlim 0\ + hardupperlim 90\ + maxSpeed 1\ + maxAccel 1\ + maxDecel 1\ + stepsPerX $bs_stepsPerX\ + absEnc 1\ + absEncHome $bs1_Home\ + cntsPerX $bs_cntsPerX] +bs1 part detector +bs1 long_name bs1 +bs1 softlowerlim 0 +bs1 softupperlim 90 +bs1 home 0 +sicslist setatt bs1 link parameters_group + +Motor bs2 $motor_driver_type [params \ + asyncqueue mc4\ + axis D\ + units degrees\ + hardlowerlim 0\ + hardupperlim 90\ + maxSpeed 1\ + maxAccel 1\ + maxDecel 1\ + stepsPerX $bs_stepsPerX\ + absEnc 1\ + absEncHome $bs2_Home\ + cntsPerX $bs_cntsPerX] +bs2 part detector +bs2 long_name bs2 +bs2 softlowerlim 0 +bs2 softupperlim 90 +bs2 home 0 +sicslist setatt bs2 link parameters_group + +Motor bs3 $motor_driver_type [params \ + asyncqueue mc4\ + axis E\ + units degrees\ + hardlowerlim 0\ + hardupperlim 90\ + maxSpeed 1\ + maxAccel 1\ + maxDecel 1\ + stepsPerX $bs_stepsPerX\ + absEnc 1\ + absEncHome $bs3_Home\ + cntsPerX $bs_cntsPerX] +bs3 part detector +bs3 long_name bs3 +bs3 softlowerlim 0 +bs3 softupperlim 90 +bs3 home 0 +sicslist setatt bs3 link parameters_group + +Motor bs4 $motor_driver_type [params \ + asyncqueue mc4\ + axis F\ + units degrees\ + hardlowerlim 0\ + hardupperlim 90\ + maxSpeed 1\ + maxAccel 1\ + maxDecel 1\ + stepsPerX $bs_stepsPerX\ + absEnc 1\ + absEncHome $bs4_Home\ + cntsPerX $bs_cntsPerX] +bs4 part detector +bs4 long_name bs4 +bs4 softlowerlim 0 +bs4 softupperlim 90 +bs4 home 0 +sicslist setatt bs4 link parameters_group + +Motor bs5 $motor_driver_type [params \ + asyncqueue mc4\ + axis G\ + units degrees\ + hardlowerlim 0\ + hardupperlim 90\ + maxSpeed 1\ + maxAccel 1\ + maxDecel 1\ + stepsPerX $bs_stepsPerX\ + absEnc 1\ + absEncHome $bs5_Home\ + cntsPerX $bs_cntsPerX] +bs5 part detector +bs5 long_name bs5 +bs5 softlowerlim 0 +bs5 softupperlim 90 +bs5 home 0 +sicslist setatt bs5 link parameters_group + +Motor bs6 $motor_driver_type [params \ asyncqueue mc4\ - host mc4-quokka\ - port pmc4-quokka\ axis H\ units degrees\ hardlowerlim 0\ - hardupperlim 3\ + hardupperlim 90\ maxSpeed 1\ maxAccel 1\ - maxDecel 5\ - stepsPerX 25000\ + maxDecel 1\ + stepsPerX $bs_stepsPerX\ absEnc 1\ - absEncHome $pol_Home\ - cntsPerX 8192] -pol part detector -pol long_name pol -pol softlowerlim 0 -pol softupperlim 3 -pol home 0 + absEncHome $bs6_Home\ + cntsPerX $bs_cntsPerX] +bs6 part detector +bs6 long_name bs6 +bs6 softlowerlim 0 +bs6 softupperlim 90 +bs6 home 0 +sicslist setatt bs6 link parameters_group + +# Polarizer Rotation +#Motor pol $motor_driver_type [params \ +# asyncqueue mc4\ +# host mc4-quokka\ +# port pmc4-quokka\ +# axis H\ +# units degrees\ +# hardlowerlim 0\ +# hardupperlim 3\ +# maxSpeed 1\ +# maxAccel 1\ +# maxDecel 5\ +# stepsPerX 25000\ +# absEnc 1\ +# absEncHome $pol_Home\ +# cntsPerX 8192] +#pol part detector +#pol long_name pol +#pol softlowerlim 0 +#pol softupperlim 3 +#pol home 0 proc motor_set_sobj_attributes {} { } diff --git a/site_ansto/instrument/sans/config/motors/positmotor_configuration.tcl b/site_ansto/instrument/sans/config/motors/positmotor_configuration.tcl index 0fd48edb..5f961ce4 100644 --- a/site_ansto/instrument/sans/config/motors/positmotor_configuration.tcl +++ b/site_ansto/instrument/sans/config/motors/positmotor_configuration.tcl @@ -37,7 +37,7 @@ index position mk_sct_positmotor sct_mc1 parameter samx changer_position samplenum 20SAMPLES $20sample_table set auto_ap_table { -thickness_mm position +diameter position 2.5 0 5.0 -23 7.5 -47 diff --git a/site_ansto/instrument/sans/config/nexus/nxscripts.tcl b/site_ansto/instrument/sans/config/nexus/nxscripts.tcl index 81336df8..ea5459df 100644 --- a/site_ansto/instrument/sans/config/nexus/nxscripts.tcl +++ b/site_ansto/instrument/sans/config/nexus/nxscripts.tcl @@ -1,5 +1,6 @@ source $cfPath(nexus)/nxscripts_common_1.tcl proc ::nexus::isc_initialize {} { +if {0} { variable histmem_filetype_spec foreach spec [array names histmem_filetype_spec] { lappend histmem_filetype_spec($spec) link {aux_data 3 LambdaA} @@ -7,5 +8,6 @@ proc ::nexus::isc_initialize {} { lappend histmem_filetype_spec($spec) link {aux_data 5 ::histogram_memory::x_bin} lappend histmem_filetype_spec($spec) link {aux_data 6 ::histogram_memory::y_bin} } +} ::nexus::ic_initialize } diff --git a/site_ansto/instrument/sans/config/parameters/parameters.tcl b/site_ansto/instrument/sans/config/parameters/parameters.tcl index 7adf23a0..02d1e567 100644 --- a/site_ansto/instrument/sans/config/parameters/parameters.tcl +++ b/site_ansto/instrument/sans/config/parameters/parameters.tcl @@ -2,7 +2,6 @@ # @brief We can't change the coordinate scheme at runtime because this would require # restructuring the hdb tree, but we should save it. foreach {var lname nxname} { - VelSelCoordScheme VelSelCoordScheme coordinate_scheme SApCoordScheme SApCoordScheme coordinate_scheme EApCoordScheme EApCoordScheme coordinate_scheme SampleCoordScheme SampleCoordScheme coordinate_scheme @@ -18,11 +17,13 @@ foreach {var lname nxname} { ## # @brief User privilege text variables # -foreach {var lname type nxname priv units klass} { - SApShape SApShape text shape user none parameter - BSShape BSShape text shape user none parameter - SampleThickness thickness float thickness user mm sample - TransmissionFlag transmission_flag int transmission user none sample +foreach {var lname type priv units klass} { + SApShape SApShape text user none parameter + BSShape BSShape text user none parameter + SampleThickness thickness float user mm sample + TransmissionFlag transmission_flag int user none sample + magnetic_field magnetic_field float user T sample + lambda lambda float user Ao data } { ::utility::mkVar $var $type $priv $lname true $klass true true if {$units != "none"} { @@ -34,9 +35,6 @@ foreach {var lname type nxname priv units klass} { # @brief The velocity selector position is used as the reference for other instrument # component positions. For simplicity we set it as the origin x=y=z=0. foreach {var lname nxname units klass} { - VelSelPosXmm VelSelPosXmm x mm @none - VelSelPosYmm VelSelPosYmm y mm @none - VelSelPosZmm VelSelPosZmm z mm @none EndFacePosYmm EndFacePosYmm y mm parameter RotApPosYmm RotApPosYmm y mm @none } { @@ -222,22 +220,11 @@ foreach {pname motor units} { ${pname}_status "IDLE" } ################################################################################ -## -# @brief This is the position of the velocity selector bunker face. It is used -# as the reference for other positions. x=y=z=0. -#::hdb::MakeVelocity_Selector velocity_selector { -# wavelength LambdaA -# wavelength_spread LambdaResFWHM_percent -# coordinate_scheme VelSelCoordScheme -# position {VelSelPosXmm VelSelPosYmm VelSelPosZmm} -#} - ::hdb::MakeAperture sample_aperture { shape SApShape size {SApXmm SApZmm} coordinate_scheme SApCoordScheme position {SApPosXmm SApPosYmm SApPosZmm} - refpos {VelSelPosXmm EndFacePosYmm VelSelPosZmm} } ::hdb::MakeAperture entrance_aperture { @@ -245,7 +232,6 @@ foreach {pname motor units} { size {EApXmm EApYmm EApZmm} coordinate_scheme EApCoordScheme position EApPosYmm - refpos VelSelPosYmm } ::hdb::MakeAperture rotary_aperture { @@ -253,27 +239,23 @@ foreach {pname motor units} { size {RotApXmm RotApZmm} position RotApPosYmm orientation RotApDeg - refpos VelSelPosYmm } #::hdb::MakeGeometry sample_geometry sample { # coordinate_scheme SampleCoordScheme # position {SamplePosXmm SamplePosYmm SamplePosZmm} # orientation {SampleTiltXDeg SampleTiltYDeg SampleRotDeg} -# refpos {VelSelPosXmm EndFacePosYmm VelSelPosZmm} #} ::hdb::MakeGeometry detector_geometry detector { coordinate_scheme DetCoordScheme position {DetPosXmm DetPosYmm} offset DetPosYOffsetmm - refpos {VelSelPosXmm EndFacePosYmm} } ::hdb::MakeGeometry collimator_geometry collimator { coordinate_scheme CollCoordScheme position EndFacePosYmm - refpos VelSelPosYmm } ::hdb::MakeGeometry beamstop_geometry beam_stop { @@ -298,9 +280,6 @@ array set collapposmm { ap9 19925 } -VelSelPosXmm 0.0 -VelSelPosYmm 0.0 -VelSelPosZmm 0.0 EndFacePosYmm 20095 RotApPosYmm 675 @@ -399,17 +378,3 @@ proc check {args} { } publish check user -foreach {pname bsname} { - beamstop110 bs1 - beamstop88 bs2 - beamstop66 bs3 - beamstop44 bs4 - beamstop22 bs5 -} { -::utility::macro::getset text $pname {} [subst -nocommands { - return [$bsname status] -}] - sicslist setatt $pname long_name $pname - sicslist setatt $pname mutable false - sicslist setatt $pname klass derived_parameter -} diff --git a/site_ansto/instrument/sans/config/velsel/sct_velsel.tcl b/site_ansto/instrument/sans/config/velsel/sct_velsel.tcl index 96c5cd3e..18e18665 100644 --- a/site_ansto/instrument/sans/config/velsel/sct_velsel.tcl +++ b/site_ansto/instrument/sans/config/velsel/sct_velsel.tcl @@ -1,31 +1,96 @@ +# TODO Check if requested tilt-angle is within range + ## # @file # The velocity selector control is split into two objects, # 1. velsel_poller: This object polls the velocity selector to get its -# current state. -# 2. velsel: This object provides manages a set of status nodes which +# current state. The first time that it gets valid state info it will +# register the read and write parameters for the velocity_selector object +# and create nvs_speed and nvs_lambda drivable adapters. +# 2. velocity_selector: This object manages a set of status nodes which # correspond to the state parameters read by the velsel_poller object. -# It also provides commands to set the speed and angle for the velocity -# selector. +# It also provides commands to set the speed, wavelength and angle for the velocity +# selector and provides drivable interfaces for the speed and wavelength. +# +# You can drive the velocity selector speed via the driveable object called nvs_speed +# You can drive the wavelength via the driveable object called nvs_lambda + +# NOTE Doesn't provide the power loss command. Do we need it? # Test by adding the following to barebones.tcl # InstallHdb -# source config/velsel/sct_velsel.tcl -# hfactory /velsel link velsel +# source config/velocity_selector/xsct_velsel.tcl +# hfactory /velocity_selector link velocity_selector # The velocity selector doesn't close client connections # if the connection is broken. It only closes the connection # when a client logs off with "#SES#bye", NOTE bye must be lowercase. -makesctcontroller sct_velsel astvelsel 137.157.202.73:10000 "" 10 -sct_velsel transact "NVS" -sct_velsel transact "NVS" - -namespace eval ::scobj::velsel { +namespace eval ::scobj::velocity_selector { + variable UID + variable PWD + variable sim_mode variable paramindex variable paramtype - variable pollrate - set pollrate 7 + variable pollrate 7 + + #from NVSOptions.cpp nha + # m_dTwistAngle degrees + # m_dTwistAngle m + # m_iMaxSpeed rpm + variable m_dTwistAngle + variable m_dLength + variable m_iMaxSpeed + variable rBeamCenter + variable VNeutron + variable blocked_speeds + + set sim_mode [SplitReply [velsel_simulation]] + + proc AngleSpeedToWavelength {angle VsVarSpeed} { + variable m_dTwistAngle + variable m_dLength + variable m_iMaxSpeed + variable rBeamCenter + variable VNeutron + + if {$VsVarSpeed < 3100} { + return -code error "Minimum speed is 3100 rpm" + } + + set lambda0 [expr ($m_dTwistAngle*60.0*$VNeutron)/(360.0*$m_dLength*$m_iMaxSpeed)] + set pi [expr acos(-1)] + # set pi = 3.14159265358979; + + set A [expr (2.0 * $rBeamCenter * $pi) / (60.0 * $VNeutron)] + set angle_rad [expr ($angle * $pi) / 180.0] + set lambda1 [expr ( tan($angle_rad)+($A * $m_iMaxSpeed * $lambda0) ) / ((-($A*$A) * $m_iMaxSpeed * $VsVarSpeed * $lambda0 * tan($angle_rad) )+($A * $VsVarSpeed))] + + return [format "%#.5g" $lambda1] + } + + proc WavelengthToSpeed {angle lambda1} { + variable m_dTwistAngle + variable m_dLength + variable m_iMaxSpeed + variable rBeamCenter + variable VNeutron + + if {$lambda1 < 4.6125} { + return -code error "Minimum wavelength is 4.6125 Angstrom" + } + + set lambda0 [expr ($m_dTwistAngle*60.0*$VNeutron)/(360.0*$m_dLength*$m_iMaxSpeed)] + set pi [expr acos(-1)] + # set pi = 3.14159265358979; + + set A [expr (2.0 * $rBeamCenter * $pi) / (60.0 * $VNeutron)] + set angle_rad [expr ($angle * $pi) / 180.0] + set VsVarSpeed [expr ( tan($angle_rad)+($A * $m_iMaxSpeed * $lambda0) ) / ((-($A*$A) * $m_iMaxSpeed * $lambda1 * $lambda0 * tan($angle_rad) )+($A * $lambda1))] + + return [expr round($VsVarSpeed)] + } + array set paramindex { state 0 @@ -66,27 +131,98 @@ namespace eval ::scobj::velsel { bcuun float } MakeSICSObj velsel_poller SCT_OBJECT - MakeSICSObj velsel SCT_OBJECT - sicslist setatt velsel klass NXvelocity_selector - sicslist setatt velsel long_name velsel + MakeSICSObj velocity_selector SCT_OBJECT + sicslist setatt velocity_selector klass NXvelocity_selector + sicslist setatt velocity_selector long_name velocity_selector +proc sendUID {user} { + sct send $user + return rdPwdChallenge +} + +proc rdPwdChallenge {} { + set challenge [sct result] + return sndPwd +} +proc sndPwd {pwd} { + sct send $pwd + return rdPwdAck +} +proc rdPwdAck {} { + set ack [sct result] + return idle +} ## # @brief Request a state report from the velocity selector proc getStatus {} { sct send "#SOS#STATE " - return rdStatus + return rdState } ## # @brief Read the current state report from the velocity selector. - proc rdStatus {} { - set data [sct result] - if {$data != [sct oldval]} { - sct oldval $data - set status [lrange [split $data "#"] 3 end-1] + proc rdState {root statuspath} { + variable paramindex + + set staterep [sct result] + if {[string match {ASCERR:*} $staterep]} { + hset $root/device_error $staterep + return idle + } + if {[string match {*#SES#You are not a valid user*} $staterep]} { + return sendUID + } + if {[string match {#SOS#*} $staterep] == 0 } { + hset $root/device_error $staterep + return idle + } + set status [lrange [split $staterep "#"] 3 end-1] + set rspeed [lindex $status $paramindex(rspeed) end] + set aspeed [lindex $status $paramindex(aspeed) end] + set speedvar [expr 0.2*$rspeed/100] + if {[hval $root/status] == "busy"} { + set target [hgetpropval $root/setspeed target] + if {$rspeed != $target} { + hset $root/device_error "Resending target speed $target" + hset $root/setspeed $target" + return idle + } + if {[expr abs($rspeed - $aspeed)] <= $speedvar} { + hset $root/status "idle" + statemon stop nvs_speed + statemon stop nvs_lambda + if [hgetpropval $root/setspeed driving] { + hsetprop $root/setspeed driving 0 + hsetprop $root/setLambdaA driving 0 + } + } + } + if {$staterep != [sct oldval]} { + set state [lindex $status $paramindex(state) end] + if {$state != [sct oldstate]} { + if {[string match {*CONTROL*} $state] && [expr abs($rspeed - $aspeed)] > $speedvar} { +# hset $root/status "busy" + } elseif {[string match {*CONTROL*} $state]==0 && $aspeed == 0} { + hset $root/status "idle" + statemon stop nvs_speed + statemon stop nvs_lambda + if [hgetpropval $root/setspeed driving] { + hsetprop $root/setspeed driving 0 + hsetprop $root/setLambdaA driving 0 + } + } + sct oldstate $state + } + if {[sct oldval] == "UNKNOWN"} { + sct_velsel_init $root + } + sct oldval $staterep sct update $status sct utime readtime } + if {[hval $root/device_error] != ""} { + hset $root/device_error "" + } return idle } @@ -116,13 +252,27 @@ namespace eval ::scobj::velsel { return idle } - proc setSpeed {nextState} { + proc setSpeed {vs_root statuspath nextState} { + variable paramindex set speed [format "%5d" [sct target]] + sct send "#SOS#SPEED $speed" + set angle [lindex [hval $statuspath] $paramindex(ttang) end] + set lambda [AngleSpeedToWavelength $angle $speed] + sct target $speed + hsetprop $vs_root/setLambdaA target $lambda + hset $vs_root/status "busy" + statemon start nvs_speed + statemon start nvs_lambda + if {[sct writestatus] == "start"} { + # Called by drive adapter + hsetprop $vs_root/setspeed driving 1 + hsetprop $vs_root/setLambdaA driving 1 + } return $nextState } - proc setState {nextState} { + proc sendCommand {nextState} { set state [string tolower [sct target]] switch $state { "idle" { @@ -131,61 +281,327 @@ namespace eval ::scobj::velsel { "brake" { sct send "#SOS#BRAKE " } + "init" { + sct send "#SOS#TTINIT" + } default { - return idle + return idle } } return $nextState } - hfactory /sics/velsel_poller/status plain internal text - hsetprop /sics/velsel_poller/status read ::scobj::velsel::getStatus - hsetprop /sics/velsel_poller/status rdStatus ::scobj::velsel::rdStatus - hsetprop /sics/velsel_poller/status oldval UNKNOWN + proc readLambda {statuspath} { + variable paramindex - sct_velsel poll /sics/velsel_poller/status $pollrate halt read - hfactory /sics/velsel/LambdaA plain user float - hfactory /sics/velsel/LambdaResFWHM_percent plain user float - - foreach par [lsort [array names paramindex]] { - hfactory /sics/velsel/$par plain spy $paramtype($par) - hsetprop /sics/velsel/$par read ::scobj::velsel::getpar rdpar - hsetprop /sics/velsel/$par rdpar ::scobj::velsel::updatepar /sics/velsel_poller/status $paramindex($par) - hsetprop /sics/velsel/$par oldval UNKNOWN - sct_velsel poll /sics/velsel/$par $pollrate + set angle [lindex [hval $statuspath] $paramindex(ttang) end] + set aspeed [lindex [hval $statuspath] $paramindex(aspeed) end] + set lambda [AngleSpeedToWavelength $angle $aspeed] + if {$lambda != [sct oldval]} { + sct oldval $lambda + sct update $lambda + sct utime readtime + } + return idle } - hfactory /sics/velsel/setspeed plain spy $paramtype($par) - hsetprop /sics/velsel/setspeed write ::scobj::velsel::setSpeed ignore - hsetprop /sics/velsel/setspeed ignore ::scobj::velsel::noResponse - sct_velsel write /sics/velsel/setspeed +## +# @brief This will check if turntable operation is allowed + proc ttableCheck {statuspath nextState} { + variable paramindex - hfactory /sics/velsel/setstate plain spy $paramtype($par) - hsetprop /sics/velsel/setstate write ::scobj::velsel::setState ignore - hsetprop /sics/velsel/setstate ignore ::scobj::velsel::noResponse - sct_velsel write /sics/velsel/setstate + set state [lindex [hval $statuspath] $paramindex(state) end] + set aspeed [lindex [hval $statuspath] $paramindex(aspeed) end] + if {[string match {*CONTROL*} $state] || $aspeed != 0} { + error "Not allowed while the velocity selector is running" + } + return OK + } - ::scobj::hinitprops velsel - hsetprop /sics/velsel klass NXvelocity_selector - hsetprop /sics/velsel privilege spy - hsetprop /sics/velsel type part - ::scobj::set_required_props /sics/velsel - foreach {hpath klass priv alias} { - LambdaA parameter user velsel_lambdaa - LambdaResFWHM_percent parameter user velsel_lambdaresfwhm_percent - rspeed parameter user velsel_rspeed - aspeed parameter user velsel_aspeed - ttang parameter user velsel_ttang - } { - hsetprop /sics/velsel/$hpath nxalias $alias - hsetprop /sics/velsel/$hpath klass $klass - hsetprop /sics/velsel/$hpath privilege $priv - hsetprop /sics/velsel/$hpath control true - hsetprop /sics/velsel/$hpath data true - hsetprop /sics/velsel/$hpath nxsave true - hsetprop /sics/velsel/$hpath mutable true - hsetprop /sics/velsel/$hpath sdsinfo ::nexus::scobj::sdsinfo +proc is_Speed_in_blocked_range {speed} { + variable blocked_speeds + foreach {min max} $blocked_speeds { + if {$min <= $speed && $speed <= $max} { + error "Speed of $speed rpm is within the blocked range of $min to $max rpm" } - + } + return OK +} +proc get_nearest_allowed_speed {speed} { + variable blocked_speeds + set speed_ok true + + foreach {min max} $blocked_speeds { + if {$min <= $speed && $speed <= $max} { + set speed_ok false + break + } + } + if {$speed_ok} { + return $speed + } else { + foreach {min max} $blocked_speeds { + if {$min <= $speed && $speed <= $max} { + if {$min == -inf} { + return [expr $max+10] + } + if {$max == inf} { + return [expr $min-10] + } + if {[expr $max - $speed] > [expr $speed - $min]} { + return [expr $min-10] + } else { + return [expr $max+10] + } + } + } + } +} + +## +# @brief This will check if the requested speed is allowed + proc checkBlockedSpeeds {statuspath} { + variable paramindex + + set speed [sct target] + set ttang [lindex [hval $statuspath] $paramindex(ttang) end] + if {$ttang > 90} { + error "ERROR: You must first initialise the turntable" + } + + return [is_Speed_in_blocked_range $speed] + } + +## +# @brief This will check if target wavelength is allowed +proc checkBlockedWavelengths {statuspath} { + variable paramindex + + set lambda [sct target] + set ttang [lindex [hval $statuspath] $paramindex(ttang) end] + if {$ttang > 90} { + error "ERROR: You must first initialise the turntable" + } + set angle [lindex [hval $statuspath] $paramindex(ttang) end] + set speed [WavelengthToSpeed $angle $lambda] + return [is_Speed_in_blocked_range $speed] +} +## +# @brief Implement the checkstatus command for the drivable interface +# +# NOTE: The drive adapter initially sets the writestatus to "start" and will +# only call this when writestatus!="start" +# TODO Do we need to handle hardware faults or is the state check in rdstate enough? + proc drivestatus {} { + if [sct driving] { + return busy + } else { + return idle + } + } + +proc halt {root} { + hsetprop $root/setspeed driving 0 + hsetprop $root/setLambdaA driving 0 + hset $root/status "idle" + statemon stop nvs_speed + statemon stop nvs_lambda + set speed [get_nearest_allowed_speed [hval $root/aspeed]] + broadcast halt: set speed to $speed + catch {hset $root/setspeed $speed} msg + broadcast $msg + return idle +} + + proc setPar {par nextState} { + set val [sct target] + sct send "#SOS#$par $val" + return $nextState + } + + proc setLambda {vs_root statuspath nextState} { + variable paramindex + set lambda [sct target] + + set angle [lindex [hval $statuspath] $paramindex(ttang) end] + set speed [WavelengthToSpeed $angle $lambda] + set fmtspeed [format "%5d" $speed] + sct send "#SOS#SPEED $fmtspeed" + sct target $lambda + hsetprop $vs_root/setspeed target $speed + hset $vs_root/status "busy" + statemon start nvs_speed + statemon start nvs_lambda + if {[sct writestatus] == "start"} { + # Called by drive adapter + hsetprop $vs_root/setLambdaA driving 1 + hsetprop $vs_root/setspeed driving 1 + } + return $nextState + } + +# Create Velocity selector control + set scobjNS ::scobj::velocity_selector + set statusPath /sics/velsel_poller/status + set velselPath /sics/velocity_selector + + hfactory $statusPath plain internal text + hsetprop $statusPath read ${scobjNS}::getStatus + hsetprop $statusPath rdState ${scobjNS}::rdState $velselPath $statusPath + hsetprop $statusPath sendUID ${scobjNS}::sendUID $UID + hsetprop $statusPath rdPwdChallenge ${scobjNS}::rdPwdChallenge + hsetprop $statusPath sndPwd ${scobjNS}::sndPwd $PWD + hsetprop $statusPath rdPwdAck ${scobjNS}::rdPwdAck + hsetprop $statusPath oldval "UNKNOWN" + hsetprop $statusPath oldstate "UNKNOWN" + +# Abstract status info for GumTree + hfactory $velselPath/status plain spy text + hset $velselPath/status "UNKNOWN" + hsetprop $velselPath/status values busy,idle + hfactory $velselPath/device_error plain spy text + hset $velselPath/device_error "" + +# Must be set by user + hfactory $velselPath/LambdaResFWHM_percent plain user float + hfactory $velselPath/geometry plain spy none + hfactory $velselPath/geometry/position plain spy none + hfactory $velselPath/geometry/position/VelSelPosXmm plain user float + hfactory $velselPath/geometry/position/VelSelPosYmm plain user float + hfactory $velselPath/geometry/position/VelSelPosZmm plain user float + hfactory $velselPath/geometry/position/VelSelCoordScheme plain user text + +# Get parameters from state report + foreach par [lsort [array names paramindex]] { + hfactory $velselPath/$par plain spy $paramtype($par) + hsetprop $velselPath/$par read ${scobjNS}::getpar rdpar + hsetprop $velselPath/$par rdpar ${scobjNS}::updatepar $statusPath $paramindex($par) + hsetprop $velselPath/$par oldval "UNKNOWN" + } +# Initialise turntable command + hfactory $velselPath/ttinit plain spy none + hsetprop $velselPath/ttinit check ${scobjNS}::ttableCheck $statusPath ignore + hsetprop $velselPath/ttinit write ${scobjNS}::sendCommand ignore + hsetprop $velselPath/ttinit ignore ${scobjNS}::noResponse + hsetprop $velselPath/ttinit values init + +# Set tilt angle +# TODO Can we set "check" to test if angle is within range then chain to ttableCheck + hfactory $velselPath/set_ttang plain spy float + hsetprop $velselPath/set_ttang check ${scobjNS}::ttableCheck $statusPath ignore + hsetprop $velselPath/set_ttang write ${scobjNS}::setPar TTANGL ignore + hsetprop $velselPath/set_ttang ignore ${scobjNS}::noResponse + + +# Get Lambda + hfactory $velselPath/LambdaA plain spy float + hsetprop $velselPath/LambdaA read ${scobjNS}::getpar rdpar + hsetprop $velselPath/LambdaA rdpar ${scobjNS}::readLambda $statusPath + hsetprop $velselPath/LambdaA oldval "UNKNOWN" +# Set Lambda + hfactory $velselPath/setLambdaA plain spy float + hsetprop $velselPath/setLambdaA check ${scobjNS}::checkBlockedWavelengths $statusPath + hsetprop $velselPath/setLambdaA write ${scobjNS}::setLambda $velselPath $statusPath ignore + hsetprop $velselPath/setLambdaA ignore ${scobjNS}::noResponse + hsetprop $velselPath/setLambdaA driving 0 +#TODO WARNING remove sicsdev and type if setLambdaA gets a drive addapter +# hsetprop $velselPath/setLambdaA sicsdev "nvs_lambda" + hsetprop $velselPath/setLambdaA type "drivable" + hsetprop $velselPath/setLambdaA target 0 + hsetprop $velselPath/setLambdaA writestatus "UNKNOWN" + +# Set speed + hfactory $velselPath/setspeed plain spy int + hsetprop $velselPath/setspeed check ${scobjNS}::checkBlockedSpeeds $statusPath + hsetprop $velselPath/setspeed write ${scobjNS}::setSpeed $velselPath $statusPath ignore + hsetprop $velselPath/setspeed ignore ${scobjNS}::noResponse + hsetprop $velselPath/setspeed driving 0 + hsetprop $velselPath/setspeed type "drivable" + hsetprop $velselPath/setspeed target 0 + hsetprop $velselPath/setspeed writestatus "UNKNOWN" + +# Stop velocity selector (brake or idle) + hfactory $velselPath/cmd plain spy text + hsetprop $velselPath/cmd write ${scobjNS}::sendCommand ignore + hsetprop $velselPath/cmd ignore ${scobjNS}::noResponse + hsetprop $velselPath/cmd values brake,idle + +#XXX ::scobj::hinitprops velocity_selector + ::scobj::set_required_props $velselPath + hsetprop $velselPath klass NXvelocity_selector + hsetprop $velselPath privilege spy + hsetprop $velselPath type part + hsetprop $velselPath control true + hsetprop $velselPath data true + hsetprop $velselPath/geometry klass NXgeometry + hsetprop $velselPath/geometry privilege spy + hsetprop $velselPath/geometry type instrument + hsetprop $velselPath/geometry data true + hsetprop $velselPath/geometry control true + hsetprop $velselPath/geometry/position klass NXtranslation + hsetprop $velselPath/geometry/position privilege spy + hsetprop $velselPath/geometry/position type instrument + hsetprop $velselPath/geometry/position data true + hsetprop $velselPath/geometry/position control true + foreach {hpath klass control data nxsave mutable priv alias} { + LambdaA parameter true true true true user velsel_lambdaa + LambdaResFWHM_percent parameter true true true true spy velsel_lambdaresfwhm_percent + rspeed parameter true true true true spy velsel_rspeed + aspeed parameter true true true true user velsel_aspeed + ttang parameter true true true true user velsel_ttang + ttinit parameter true false false true user velsel_ttang + geometry/position/VelSelPosXmm parameter true true true false user VelSelPosXmm + geometry/position/VelSelPosYmm parameter true true true false user VelSelPosYmm + geometry/position/VelSelPosZmm parameter true true true false user VelSelPosZmm + geometry/position/VelSelCoordScheme parameter true true true false user VelSelCoordScheme + } { + hsetprop $velselPath/$hpath nxalias $alias + hsetprop $velselPath/$hpath klass $klass + hsetprop $velselPath/$hpath privilege $priv + hsetprop $velselPath/$hpath control $control + hsetprop $velselPath/$hpath data $data + hsetprop $velselPath/$hpath nxsave $nxsave + hsetprop $velselPath/$hpath mutable $mutable + hsetprop $velselPath/$hpath sdsinfo ::nexus::scobj::sdsinfo + } + + hsetprop $velselPath/setspeed checklimits ${scobjNS}::checkBlockedSpeeds $statusPath + hsetprop $velselPath/setspeed checkstatus ${scobjNS}::drivestatus + hsetprop $velselPath/setspeed halt ${scobjNS}::halt $velselPath + + hsetprop $velselPath/setLambdaA checklimits ${scobjNS}::checkBlockedWavelengths $statusPath + hsetprop $velselPath/setLambdaA checkstatus ${scobjNS}::drivestatus + hsetprop $velselPath/setLambdaA halt ${scobjNS}::halt $velselPath + +## +# @brief This is the position of the velocity selector bunker face. It is used +# as the reference for other positions. x=y=z=0. + hset $velselPath/geometry/position/VelSelPosXmm 0.0 + hset $velselPath/geometry/position/VelSelPosYmm 0.0 + hset $velselPath/geometry/position/VelSelPosZmm 0.0 + hset $velselPath/geometry/position/VelSelCoordScheme "Cartesian" + + + + proc sct_velsel_init {velselPath } { + variable pollrate + variable paramindex + + foreach par [lsort [array names paramindex]] { + sct_velsel poll $velselPath/$par $pollrate + } + sct_velsel write $velselPath/ttinit + sct_velsel write $velselPath/set_ttang + sct_velsel poll $velselPath/LambdaA $pollrate + sct_velsel write $velselPath/setLambdaA + sct_velsel write $velselPath/setspeed + sct_velsel write $velselPath/cmd + ansto_makesctdrive nvs_speed $velselPath/setspeed $velselPath/aspeed sct_velsel + ansto_makesctdrive nvs_lambda $velselPath/setLambdaA $velselPath/LambdaA sct_velsel + } + if {$sim_mode == "false"} { + makesctcontroller sct_velsel astvelsel $velsel_IP:$velsel_port "" 10 + sct_velsel poll $statusPath $pollrate + } } diff --git a/site_ansto/instrument/sans/config/velsel/velsel.tcl b/site_ansto/instrument/sans/config/velsel/velsel.tcl index 64d0ee62..46bd3ef1 100644 --- a/site_ansto/instrument/sans/config/velsel/velsel.tcl +++ b/site_ansto/instrument/sans/config/velsel/velsel.tcl @@ -1,20 +1,48 @@ -puts "velsel.tcl NOT YET AVAILABLE" -if 0 { -set velsel_controller(host) 137.157.202.70 -set velsel_controller(port) 10000 -set velsel_controller(user) NVS -set velsel_controller(password) NVS +set currVelSel "two" +namespace eval ::scobj::velocity_selector { + variable blocked_speeds + variable velsel_IP + variable velsel_port -# Velocity Selector -MakeTCPSelector velsel [params \ - Host $velsel_controller(host) \ - Port $velsel_controller(port) \ - User $velsel_controller(user) \ - Password $velsel_controller(password) \ -] - -velsel add 3600 4900 -velsel add 7800 10500 -velsel add 30000 30000 + set ::currVelSel [string tolower $::currVelSel] + switch $::currVelSel { + "one" { + set velsel_IP "137.157.202.73" + set velsel_port 10000 + set m_dTwistAngle 48.30 + set m_dLength 0.250 + set m_iMaxSpeed 28300.0 + set rBeamCenter 0.110 + set ::scobj::velocity_selector::UID "NVS" + set ::scobj::velocity_selector::PWD "NVS" + set VNeutron 3955.98 + set ::scobj::velocity_selector::blocked_speeds { + -inf 3099 + 3600 4999 + 7800 10599 + 28301 inf + } + } + "two" { + # dc2-quokka.nbi.ansto.gov.au + set velsel_IP "137.157.202.74" + set velsel_port 10000 + set m_dTwistAngle 37.6 + set m_dLength 0.250 + set m_iMaxSpeed 21500.0 + set rBeamCenter 0.1170 + set VNeutron 3955.98 + set ::scobj::velocity_selector::UID "NVS" + set ::scobj::velocity_selector::PWD "NVS" + set ::scobj::velocity_selector::blocked_speeds { + -inf 3099 + 3600 4999 + 7800 9699 + 21500 inf + } + } + } } + +source $cfPath(velsel)/sct_velsel.tcl diff --git a/site_ansto/instrument/sans/quokka_configuration.tcl b/site_ansto/instrument/sans/quokka_configuration.tcl index 91f690ac..c9d75623 100644 --- a/site_ansto/instrument/sans/quokka_configuration.tcl +++ b/site_ansto/instrument/sans/quokka_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.19 $ -# $Date: 2008-12-12 06:53:52 $ +# $Revision: 1.20 $ +# $Date: 2009-11-24 22:56:48 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -23,22 +23,32 @@ fileeval $cfPath(motors)/motor_configuration.tcl fileeval $cfPath(source)/source.tcl source $cfPath(hipadaba)/hipadaba_configuration.tcl fileeval $cfPath(motors)/positmotor_configuration.tcl -fileeval $cfPath(parameters)/parameters.tcl fileeval $cfPath(velsel)/velsel.tcl +fileeval $cfPath(parameters)/parameters.tcl fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(optics)/optics.tcl fileeval $cfPath(counter)/counter.tcl +fileeval $cfPath(environment)/temperature/lakeshore340.tcl +fileeval $cfPath(environment)/temperature/sct_lakeshore_3xx.tcl fileeval $cfPath(hmm)/hmm_configuration.tcl fileeval $cfPath(nexus)/nxscripts.tcl fileeval $cfPath(hmm)/detector.tcl fileeval $cfPath(scan)/scan.tcl fileeval $cfPath(commands)/commands.tcl fileeval $cfPath(anticollider)/anticollider.tcl +fileeval $cfPath(environment)/temperature/sct_julabo_lh45.tcl source gumxml.tcl ::utility::mkVar ::anticollider::protect_detector text manager protect_detector false detector true false ::anticollider::protect_detector "true" +if {[SplitReply [environment_simulation]]=="false"} { + catch { add_lh45 tc1 137.157.202.85 4003 1} message + puts $message + #catch { add_ls340t tc1 127.0.0.1 4001 1} message + #puts $message +} +#::environment::temperature::add_ls340 tc1 1 server_init ########################################### # WARNING: Do not add any code below server_init, if you do SICS may fail to initialise properly. diff --git a/site_ansto/instrument/sans/script_validator/sics_ports.tcl b/site_ansto/instrument/sans/script_validator/sics_ports.tcl index 5d41e8ca..8e368cce 100644 --- a/site_ansto/instrument/sans/script_validator/sics_ports.tcl +++ b/site_ansto/instrument/sans/script_validator/sics_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-val-quokka -set serverport server-val-quokka -set interruptport interrupt-val-quokka -set telnetport telnet-val-quokka +set quieckport sics-quieck-val-quokka +set serverport sics-server-val-quokka +set interruptport sics-interrupt-val-quokka +set telnetport sics-telnet-val-quokka diff --git a/site_ansto/instrument/sans/script_validator_ports.tcl b/site_ansto/instrument/sans/script_validator_ports.tcl index 5d41e8ca..8e368cce 100644 --- a/site_ansto/instrument/sans/script_validator_ports.tcl +++ b/site_ansto/instrument/sans/script_validator_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-val-quokka -set serverport server-val-quokka -set interruptport interrupt-val-quokka -set telnetport telnet-val-quokka +set quieckport sics-quieck-val-quokka +set serverport sics-server-val-quokka +set interruptport sics-interrupt-val-quokka +set telnetport sics-telnet-val-quokka diff --git a/site_ansto/instrument/sans/sics_ports.tcl b/site_ansto/instrument/sans/sics_ports.tcl index a8cba5be..86ffa1a3 100644 --- a/site_ansto/instrument/sans/sics_ports.tcl +++ b/site_ansto/instrument/sans/sics_ports.tcl @@ -1,4 +1,4 @@ -set quieckport quieck-quokka -set serverport server-quokka -set interruptport interrupt-quokka -set telnetport telnet-quokka +set quieckport sics-quieck-quokka +set serverport sics-server-quokka +set interruptport sics-interrupt-quokka +set telnetport sics-telnet-quokka diff --git a/site_ansto/instrument/server_config.tcl b/site_ansto/instrument/server_config.tcl index 919f11c2..c54a7de2 100644 --- a/site_ansto/instrument/server_config.tcl +++ b/site_ansto/instrument/server_config.tcl @@ -1,7 +1,7 @@ # SICS common configuration -# $Revision: 1.47 $ -# $Date: 2009-03-30 23:16:52 $ +# $Revision: 1.48 $ +# $Date: 2009-11-24 22:56:45 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by $Author: ffr $ # RELEASE_NUMBER: $Name: not supported by cvs2svn $ @@ -28,6 +28,9 @@ motor_simulation false VarMake chopper_simulation Text internal chopper_simulation false +VarMake velsel_simulation Text internal +velsel_simulation false + VarMake plc_simulation Text internal plc_simulation false @@ -75,6 +78,7 @@ if {[string trim [lindex [split [sics_fullsimulation] =] 1]] == "true"} { environment_simulation true motor_simulation true chopper_simulation true + velsel_simulation true plc_simulation true } @@ -141,7 +145,7 @@ sics_release [lindex $tmpstr [expr [llength $tmpstr] - 1]] sics_release lock ::utility::mkVar sics_revision_num Text internal -set tmpstr [string map {"$" ""} {$Revision: 1.47 $}] +set tmpstr [string map {"$" ""} {$Revision: 1.48 $}] sics_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]] sics_revision_num lock @@ -210,7 +214,7 @@ proc server_set_sobj_attributes {} { } motor_set_sobj_attributes ::utility::set_motor_attributes - ::utility::set_histomem_attributes +#XXX::utility::set_histomem_attributes ::utility::set_sobj_attributes ::utility::set_envcontrol_attributes ::plc::set_sobj_attributes @@ -257,8 +261,6 @@ proc server_init {} { server_set_sobj_attributes } message ] { - clientput $errorContext - clientput $callStack return -code error $message } else { @@ -268,8 +270,6 @@ proc server_init {} { } buildHDB instrument_dictionary } message ] { - clientput $errorContext - clientput $callStack return -code error $message } return $message diff --git a/site_ansto/instrument/util/check/query_sics.tcl b/site_ansto/instrument/util/check/query_sics.tcl index ce9ed879..5c863798 100644 --- a/site_ansto/instrument/util/check/query_sics.tcl +++ b/site_ansto/instrument/util/check/query_sics.tcl @@ -58,7 +58,7 @@ proc _query_nameval {query nameval_list} { } } "int" { - if {[string is internal $proparr($prop)] == $test} { + if {[string is integer $proparr($prop)] == $test} { continue } else { return 0 diff --git a/site_ansto/instrument/util/extra_utility.tcl b/site_ansto/instrument/util/extra_utility.tcl index 6d1d391b..1e5d3a0e 100644 --- a/site_ansto/instrument/util/extra_utility.tcl +++ b/site_ansto/instrument/util/extra_utility.tcl @@ -74,7 +74,7 @@ proc callStack {enable} { trace $trace_opt execution catch leave leavecatch } publish callStack mugger -callStack true +callStack false # LIST FUNCTIONS diff --git a/site_ansto/instrument/util/script_context_util.tcl b/site_ansto/instrument/util/script_context_util.tcl index dac38377..e9e674aa 100644 --- a/site_ansto/instrument/util/script_context_util.tcl +++ b/site_ansto/instrument/util/script_context_util.tcl @@ -5,6 +5,37 @@ proc ::scobj::set_required_props {hpath} { ::scobj::set_required_props $hpath/$child } } + +proc ::scobj::hinit_nodeprops {node hpath} { + hsetprop $hpath nxalias $node + foreach {prop propval} [subst { + control true + data true + nxsave true + mutable true + klass parameter + sdsinfo ::nexus::scobj::sdsinfo + long_name $node + }] { + if {[hpropexists $hpath $prop] == false} { + hsetprop $hpath $prop $propval + } + } +} +proc ::scobj::hinit_scobjprops {scobj hpath} { + foreach {prop propval} [subst { + klass parameter + long_name $scobj + }] { + if {[hpropexists $hpath $prop] == false} { + sicslist setatt $scobj $prop $propval + } else { + sicslist setatt $scobj $prop [hgetpropval $hpath $prop] + } + } + hsetprop $hpath sicsdev $scobj + ::scobj::hinit_nodeprops $scobj $hpath +} ## # @brief Initialise the hdb properties required for generating the GumTree interface and # saving data for script context objects @@ -13,16 +44,9 @@ proc ::scobj::set_required_props {hpath} { proc ::scobj::hinitprops {scobj {par "@none"}} { if {$par == "@none"} { set hpath /sics/$scobj - hsetprop $hpath nxalias $scobj + ::scobj::hinit_scobjprops $scobj $hpath } else { set hpath /sics/$scobj/$par - hsetprop $hpath nxalias ${scobj}_$par + ::scobj::hinit_nodeprops ${scobj}_$par $hpath } - hsetprop $hpath control true - hsetprop $hpath data true - hsetprop $hpath nxsave true - hsetprop $hpath mutable true - hsetprop $hpath klass parameter -# hsetprop $hpath sicsdev $scobj - hsetprop $hpath sdsinfo ::nexus::scobj::sdsinfo } diff --git a/site_ansto/instrument/util/utility.tcl b/site_ansto/instrument/util/utility.tcl index cc903188..bef632a9 100644 --- a/site_ansto/instrument/util/utility.tcl +++ b/site_ansto/instrument/util/utility.tcl @@ -1,7 +1,7 @@ # Some useful functions for SICS configuration. -# $Revision: 1.21 $ -# $Date: 2009-03-30 23:16:54 $ +# $Revision: 1.22 $ +# $Date: 2009-11-24 22:56:49 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by $Author: ffr $ @@ -206,14 +206,14 @@ namespace eval utility { set currvalbase $valbase_port foreach inst $instrument_names { array set sics_port [list\ - telnet-$inst $currbase\ - interrupt-$inst [expr {$currbase+1}]\ - server-$inst [expr {$currbase+2}]\ - quieck-$inst [expr {$currbase+3}]\ - telnet-val-$inst $currvalbase\ - interrupt-val-$inst [expr {$currvalbase+1}]\ - server-val-$inst [expr {$currvalbase+2}]\ - quieck-val-$inst [expr {$currvalbase+3}]\ + sics-telnet-$inst $currbase\ + sics-interrupt-$inst [expr {$currbase+1}]\ + sics-server-$inst [expr {$currbase+2}]\ + sics-quieck-$inst [expr {$currbase+3}]\ + sics-telnet-val-$inst $currvalbase\ + sics-interrupt-val-$inst [expr {$currvalbase+1}]\ + sics-server-val-$inst [expr {$currvalbase+2}]\ + sics-quieck-val-$inst [expr {$currvalbase+3}]\ ] set currbase [expr {$currbase+100}] set currvalbase [expr {$currvalbase+100}] @@ -286,7 +286,7 @@ proc getatt {sicsobj att} { if [catch { lindex [split [tolower_sicslist $sicsobj $att] =] 1 } reply ] { - return -code error $reply + return -code error "([info level 0]) $reply" } else { return $reply } @@ -361,8 +361,9 @@ proc params {args} { # Parse motor readings for virtual motor scripts. proc SplitReply { text } { - set l [split $text =] - return [string trim [lindex $l 1]] + set val_index [string first "=" $text] + incr val_index + return [string trim [string range $text $val_index end]] } # Sets motor position reading to pos by adjusting the softzero @@ -526,19 +527,19 @@ proc ::utility::set_envcontrol_attributes {} { # Retuns plain value of hdb node property proc ::utility::hgetplainprop {hpath prop} { if [ catch { - return [string trim [lindex [split [hgetprop $hpath $prop] =] 1] ] + set propStr [string trim [lindex [split [hgetprop $hpath $prop] =] 1] ] } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $propStr } proc ::utility::hlistplainprop {hpath} { if [ catch { - return [string trim [join [split [string map {" " _} [regsub {[^ ]*= * } [hlistprop $hpath] {} ]] =] ]] + set propStr [string trim [join [split [string map {" " _} [regsub {[^ ]*= * } [hlistprop $hpath] {} ]] =] ]] } message ] { - if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } + return $propStr } proc ::utility::GetUID {userName} { @@ -635,7 +636,7 @@ proc ::utility::check_valid_options {arglist valid_options} { } } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } @@ -661,7 +662,7 @@ proc ::utility::check_required_options {arglist required_options} { } } message ] { if {$::errorCode=="NONE"} {return $message} - return -code error $message + return -code error "([info level 0]) $message" } } ## diff --git a/site_ansto/site_ansto.c b/site_ansto/site_ansto.c index 01503ceb..22d19804 100644 --- a/site_ansto/site_ansto.c +++ b/site_ansto/site_ansto.c @@ -57,6 +57,7 @@ extern void AddGalilProtocoll(); extern void AddOrdHVPSProtocoll(); extern void AddVelSelProtocol(); extern void AddUSBTMCProtocoll(); +extern void AddAnsfrProtocol(); extern int ANSTO_MakeHistMemory(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]); @@ -71,6 +72,7 @@ void SiteInit(void) { AddOrdHVPSProtocoll(); AddVelSelProtocol(); AddUSBTMCProtocoll(); + AddAnsfrProtocol(); } static pSite /*@null@*/ siteANSTO = NULL; diff --git a/statemon.c b/statemon.c index a2ff6ab0..f5d3a609 100644 --- a/statemon.c +++ b/statemon.c @@ -19,6 +19,7 @@ #include "sicsvar.h" #define SICS_SUID "sics_suid" +pICallBack statemon_cbinterface = NULL; /*==========================================================================*/ typedef struct __STATEMON { pObjectDescriptor pDes; @@ -132,6 +133,14 @@ static int StateInterest(int iEvent, void *pEvent, void *pUser, snprintf(buffer,255,"FINISH = %s", device); SCWriteInContext(pCon,buffer,eWarning,cc); } + if(iEvent == STPAUSE){ + snprintf(buffer,255,"PAUSE = %s", device); + SCWriteInContext(pCon,buffer,eWarning,cc); + } + if(iEvent == STCONTINUE){ + snprintf(buffer,255,"CONTINUE = %s", device); + SCWriteInContext(pCon,buffer,eWarning,cc); + } } return 1; } @@ -272,6 +281,7 @@ int StateMonFactory(SConnection *pCon, SicsInterp *pSics, void *pData, memset(pNew,0,sizeof(StateMon)); pNew->pDes = CreateDescriptor("statemon"); pNew->pCall = CreateCallBackInterface(); + statemon_cbinterface = pNew->pCall; if(pNew->pDes == NULL || pNew->pCall == NULL){ SCWrite(pCon,"ERROR: out of memory creating StateMon",eError); return 0; @@ -334,6 +344,12 @@ int StateMonAction(SConnection *pCon, SicsInterp *pSics, void *pData, lID = RegisterCallback(self->pCall, SCGetContext(pCon),STEND, StateInterest, pCon, NULL); SCRegister(pCon,pSics, self->pCall,lID); + lID = RegisterCallback(self->pCall, SCGetContext(pCon),STPAUSE, StateInterest, + pCon, NULL); + SCRegister(pCon,pSics, self->pCall,lID); + lID = RegisterCallback(self->pCall, SCGetContext(pCon),STCONTINUE, StateInterest, + pCon, NULL); + SCRegister(pCon,pSics, self->pCall,lID); SCSendOK(pCon); return 1; } else if(strcmp(argv[1],"uninterest") == 0) { @@ -369,7 +385,22 @@ int StateMonAction(SConnection *pCon, SicsInterp *pSics, void *pData, return 1; } return 0; - } + } else if(strcmp(argv[1],"pause") == 0) { + if(argc > 2){ + InvokeCallBack(self->pCall,STPAUSE,argv[2]); + SCSendOK(pCon); + return 1; + } + return 0; + } else if(strcmp(argv[1],"continue") == 0) { + if(argc > 2){ + InvokeCallBack(self->pCall,STCONTINUE,argv[2]); + SCSendOK(pCon); + return 1; + } + return 0; + } + SCWrite(pCon,"ERROR: keyword not recognized",eError); return 0; diff --git a/statusfile.c b/statusfile.c index 85371cbb..9fed1e7b 100644 --- a/statusfile.c +++ b/statusfile.c @@ -57,6 +57,8 @@ static int parameterChange = 0; int StatusFileTask(void *data) { char *pFile = NULL; + if (!hasRestored()) + return 1; if (parameterChange) { parameterChange = 0;