Merging release 2.0 branch with CVS trunk

r2601 | ffr | 2008-05-30 10:26:57 +1000 (Fri, 30 May 2008) | 2 lines

drive.c

@@ -39,6 +39,7 @@
 #include <stdlib.h>
 #include <assert.h>
 #include <string.h>
+#include <math.h>
 #include "fortify.h"
 #include "sics.h"
 #include "drive.h"
@@ -333,32 +334,44 @@
      
      /* interprete arguments as pairs name value and try to start */
      SetStatus(eDriving);
-     for(i = 1; i < argc; i+=2)
+     for(i = 1; i < argc; i+=2) {
-     {
+       if(argv[i+1] == NULL)
-        if(argv[i+1] == NULL)
+       {
-        {
+         sprintf(pBueffel,"ERROR: no value found for driving %s",
-           sprintf(pBueffel,"ERROR: no value found for driving %s",
+             argv[i]);
-                   argv[i]);
+         SCWrite(pCon,pBueffel,eError);
-           SCWrite(pCon,pBueffel,eError);
+         SetStatus(eOld); 
-           SetStatus(eOld); 
+         return 0;        
-           return 0;        
+       }
-        }
+       iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
-        iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
+       if (iRet == TCL_ERROR) {
-        if (iRet == TCL_ERROR) {
+         SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError);
-          SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError);
+         SetStatus(eOld);
-          StopExe(GetExecutor(),"ALL");
+         return 0;
-          SetStatus(eOld);
+       } else if (!isfinite(dTarget)) {
-          return 0;
+         sprintf(pBueffel,"ERROR: target %s value for %s is not a finite number",
-        }
+             argv[i+1], argv[i]);
-        iRet = Start2Run(pCon,pSics,argv[i],dTarget);
+         SCWrite(pCon,pBueffel,eError);
-        if(!iRet)
+         SetStatus(eOld); 
-        {
+         return 0;        
-          sprintf(pBueffel,"ERROR: cannot run %s to %s",argv[i],argv[i+1]);
+       }
-          SCWrite(pCon,pBueffel,eError);
+     }
-          StopExe(GetExecutor(),"ALL");
+     for(i = 1; i < argc; i+=2) {
-          SetStatus(eOld);
+       iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
-          return 0;
+       if (iRet == TCL_ERROR) {
-        }
+         SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError);
+         SetStatus(eOld);
+         return 0;
+       }
+       iRet = Start2Run(pCon,pSics,argv[i],dTarget);
+       if(!iRet)
+       {
+         sprintf(pBueffel,"ERROR: cannot run %s to %s",argv[i],argv[i+1]);
+         SCWrite(pCon,pBueffel,eError);
+         StopExe(GetExecutor(),"ALL");
+         SetStatus(eOld);
+         return 0;
+       }
      }     
 
      /* wait for completion */
@@ -433,32 +446,44 @@
      
      /* interprete arguments as pairs name value and try to start */
      SetStatus(eDriving);
-     for(i = 1; i < argc; i+=2)
+     for(i = 1; i < argc; i+=2) {
-     {
+       if(argv[i+1] == NULL)
-        if(argv[i+1] == NULL)
+       {
-        {
+         sprintf(pBueffel,"ERROR: no value found for driving %s",
-           sprintf(pBueffel,"ERROR: no value found for driving %s",
+             argv[i]);
-                   argv[i]);
+         SCWrite(pCon,pBueffel,eError);
-           SCWrite(pCon,pBueffel,eError);
+         SetStatus(eOld); 
-           SetStatus(eOld); 
+         return 0;        
-           return 0;        
+       }
-        }
+       iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
-        iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
+       if (iRet == TCL_ERROR) {
-        if (iRet == TCL_ERROR) {
+         SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError);
-          SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError);
+         SetStatus(eOld);
-          StopExe(GetExecutor(),"ALL");
+         return 0;
-          SetStatus(eOld);
+       } else if (!isfinite(dTarget)) {
-          return 0;
+         sprintf(pBueffel,"ERROR: target value %s for %s is not a finite number",
-        }
+             argv[i+1], argv[i]);
-        iRet = Start2Run(pCon,pSics,argv[i],dTarget);
+         SCWrite(pCon,pBueffel,eError);
-        if(!iRet)
+         SetStatus(eOld); 
-        {
+         return 0;        
-          sprintf(pBueffel,"ERROR: cannot run %s to %s",argv[i],argv[i+1]);
+       }
-          SCWrite(pCon,pBueffel,eError);
+     }
-          StopExe(GetExecutor(),"ALL");
+     for(i = 1; i < argc; i+=2) {
-          SetStatus(eOld);
+       iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget);
-          return 0;
+       if (iRet == TCL_ERROR) {
-        }
+         SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError);
+         SetStatus(eOld);
+         return 0;
+       }
+       iRet = Start2Run(pCon,pSics,argv[i],dTarget);
+       if(!iRet)
+       {
+         sprintf(pBueffel,"ERROR: cannot run %s to %s",argv[i],argv[i+1]);
+         SCWrite(pCon,pBueffel,eError);
+         StopExe(GetExecutor(),"ALL");
+         SetStatus(eOld);
+         return 0;
+       }
      } 
      return 1;    
 }

histmem.c

@@ -1148,7 +1148,7 @@ static int checkHMEnd(pHistMem self, char *text){
          /* do it */
          Arg2Text(argc - 3, &argv[3],pBueffel, 511);
          /* authorise */
-         if(!SCMatchRights(pCon,usMugger))
+         if(!SCMatchRights(pCon,usUser)) /* FIXME ffr stupid hack */
          {
             sprintf(pBueffel,
                     "ERROR: you need to be manager in order to configure %s",
@@ -1254,7 +1254,7 @@ static int checkHMEnd(pHistMem self, char *text){
                           eError);
               return 0;
         }
-        if(SCMatchRights(pCon,usMugger))
+        if(SCMatchRights(pCon,usUser)) /* FIXME ffr stupid hack */
         {
            iRet = HistConfigure(self,pCon,pSics);
            if(iRet)

nxdict.c

@@ -191,9 +191,9 @@
      char *pPtr;
      int iToken;
      int iMode;
-     char pAlias[132];
+     char pAlias[1024];
-     char pDefinition[1024]; /* this is > 10 lines of definition */
+     char pDefinition[8192]; /* this is > 10 lines of definition */
-     char pWord[132];
+     char pWord[1024];
 
      assert(pBuffer);
      assert(pDict);

rs232controller.h

@@ -14,6 +14,8 @@
 #ifndef RS232CONTROLLER
 #define RS232CONTROLLER
 #include "network.h"
+#include "obdes.h" //PB
+#include "conman.h" //PB
 /*
   own error codes
 */

site_ansto/Makefile

@@ -80,14 +80,17 @@ OBJ= site_ansto.o anstoutil.o\
         motor_asim.o motor_dmc2280.o\
         lh45.o lh45driv.o \
         lakeshore340.o lakeshore340driv.o \
+        west4100.o west4100driv.o \
         nhq200.o \
         orhvps.o \
+        ls340.o \
         fsm.o \
         counterdriv.o \
         safetyplc.o \
         ../psi/tcpdornier.o \
         anstohttp.o \
-        hmcontrol_ansto.o
+        hmcontrol_ansto.o\
+        lssmonitor.o
 
 all: ../matrix/libmatrix.a $(COREOBJ:%=../%) $(EXTRA:%=../%) libansto.a libhardsup
 	$(CC) -g -o SICServer  $(COREOBJ:%=../%) $(EXTRA:%=../%) $(SUBLIBS) $(PSI_SLIBS:%=../%) $(PSI_LIBS) $(GHTTP_LIBS)

site_ansto/ansto_evcontroller.h

@@ -0,0 +1,14 @@
+#ifndef ANSTO_EVCONTROLLER_H
+#define ANSTO_EVCONTROLLER_H
+
+
+#include <evcontroller.h>
+#include <evcontroller.i>
+#include "evdriver.h"
+#include <interface.h>
+
+
+
+
+
+#endif

site_ansto/hardsup/asynsrv_utility.c

@@ -680,7 +680,7 @@
 */		struct AsynSrv__info	*asyn_info) {
 
     int			status;
-    char		cmnd[8], rply[8];
+    //char		cmnd[8], rply[8];
 		    /*----------------------------------------------
 		    ** Pre-set the routine name (in case of error)
 		    */
@@ -898,8 +898,8 @@
 /*	==================
 */		    char    *par_id,
 		    ...) {
-    int		i;
+    //int		i;
-    char	buff[4];
+    //char	buff[4];
     va_list	ap;		    /* Pointer to variable args */
     char       *txt_ptr;
     int		intval;
@@ -971,7 +971,7 @@
 		int	*my_errno,
 		int	*vaxc_errno) {
 
-    int		i, j, k;
+    int		i;//, j, k;
     char	buff[80];
 
     if (AsynSrv_call_depth <= 0) {
@@ -1034,7 +1034,7 @@
 */		struct AsynSrv__info	*asyn_info) {
 
     int			status;
-    char		cmnd[8], rply[8];
+    //char		cmnd[8], rply[8];
 		    /*----------------------------------------------
 		    ** Pre-set the routine name (in case of error)
 		    */
@@ -1124,25 +1124,25 @@
 */		struct AsynSrv__info	*asyn_info) {
 
     int			    i, status;
-    int			    my_skt;
+    //int			    my_skt;
-    char		    old_time_out[4];
+    //char		    old_time_out[4];
-    union {
+    //union {
-      char  chars[4];
+    //  char  chars[4];
-      int   val;
+    //  int   val;
-    } time_out;
+    //} time_out;
     char		    buff[128];
-    struct RS__MsgStruct    s_buff;
+    //struct RS__MsgStruct    s_buff;
-    struct RS__RespStruct   r_buff;
+    //struct RS__RespStruct   r_buff;
-    unsigned int	    oto_len, oto_status;
+    //unsigned int	    oto_len, oto_status;
-    struct hostent	   *rmt_hostent;
+    //struct hostent	   *rmt_hostent;
-    struct in_addr	   *rmt_inet_addr_pntr;
+    //struct in_addr	   *rmt_inet_addr_pntr;
-    struct in_addr	    rmt_inet_addr;
+    //struct in_addr	    rmt_inet_addr;
-    int			    rmt_sockname_len;
+    //int			    rmt_sockname_len;
-    struct sockaddr_in	    lcl_sockname;
+    //struct sockaddr_in	    lcl_sockname;
-    struct sockaddr_in	    rmt_sockname;
+    //struct sockaddr_in	    rmt_sockname;
 
-    char		*errtxt_ptr;
+    //char		*errtxt_ptr;
-    int			 errcode, my_errno, my_vaxc_errno;
+    //int			 errcode, my_errno, my_vaxc_errno;
 /*--------------------------------------------------------
 */
     asyn_info->skt = 0;
@@ -1225,17 +1225,17 @@
 /*	===============
 */		struct AsynSrv__info	*asyn_info) {
 
-    int			    i, status;
+    int			    status; //,i;
     int			    my_skt;
-    char		    old_time_out[4];
+    //char		    old_time_out[4];
-    union {
+    //union {
-      char  chars[4];
+    //  char  chars[4];
-      int   val;
+    //  int   val;
-    } time_out;
+    //} time_out;
     char		    buff[128];
     struct RS__MsgStruct    s_buff;
     struct RS__RespStruct   r_buff;
-    unsigned int	    oto_len, oto_status;
+    //unsigned int	    oto_len, oto_status;
     struct hostent	   *rmt_hostent;
     struct in_addr	   *rmt_inet_addr_pntr;
     struct in_addr	    rmt_inet_addr;
@@ -1243,8 +1243,8 @@
     struct sockaddr_in	    lcl_sockname;
     struct sockaddr_in	    rmt_sockname;
 
-    char		*errtxt_ptr;
+    //char		*errtxt_ptr;
-    int			 errcode, my_errno, my_vaxc_errno;
+    //int			 errcode, my_errno, my_vaxc_errno;
 /*--------------------------------------------------------
 */
     asyn_info->skt = 0;
@@ -1478,7 +1478,7 @@
     int			i, status, c_len, size, max_size, ncmnds;
     int			bytes_to_come, bytes_left;
     char		*nxt_byte_ptr;
-    char		err_text[80];
+//    char		err_text[80];
     char		text[20];
     va_list		ap;		/* Pointer to variable args */
     char		*txt_ptr;
@@ -1724,7 +1724,7 @@
     int			i, status, size, max_size, ncmnds;
     int			bytes_to_come, bytes_left;
     char		*nxt_byte_ptr;
-    char		err_text[80];
+    //char		err_text[80];
     char		text[20];
     va_list		ap;		/* Pointer to variable args */
     int			*c_len, s_len;
@@ -2046,7 +2046,7 @@
 		int			 state) {
 
     int			status;
-    char		cmnd[8], rply[8];
+    char		cmnd[8];//, rply[8];
 		    /*----------------------------------------------
 		    ** Pre-set the routine name (in case of error)
 		    */
@@ -2091,7 +2091,7 @@
 */		struct AsynSrv__info	*asyn_info) {
 
     int			status;
-    char		cmnd[8], rply[8];
+    //char		cmnd[8], rply[8];
 		    /*----------------------------------------------
 		    ** Pre-set the routine name (in case of error)
 		    */

site_ansto/hardsup/makefile

@@ -10,7 +10,7 @@ SRC    = .
 CC     = gcc
 CFLAGS = -g -DLINUX $(DFORTIFY) -I$(SRC) -I../.. -Wall -Wno-unused
 
-HOBJ=   itc4util.o lh45util.o lakeshore340util.o asynsrv_utility.o geterrno.o strjoin.o chopper.o
+HOBJ=   nhq200util.o itc4util.o lh45util.o lakeshore340util.o west4100util.o asynsrv_utility.o geterrno.o strjoin.o chopper.o modbustcp.o
 
 libhlib.a: $(HOBJ)
 	rm -f libhlib.a

site_ansto/hardsup/modbustcp.c

@@ -0,0 +1,135 @@
+/*---------------------------------------------------------------------------
+							M O D B U S T C P . C
+
+Paul Barron, January 2008
+
+RTU Modbus functions designed for use with the WEST4100 Temperature Controller.
+If another modbus device is required at ANSTO sections of this code will need
+to be modified. 
+
+ MBAP: Modbus Application Protocol Header
+ PDU: Protocol Data Unit
+ 
+ Modbus TCP Packet Format
+|							MBAP					 		 |      PDU		 |
+|Transact Identifier|Protocol Identifier|Length Field|Unit ID|Funct Code|Data|
+|      2 Bytes 		|		2 Bytes		|   2 Bytes	 | 1 Byte|  1 Byte	| n	 |
+  
+Paul Barron, January 2008
+----------------------------------------------------------------------------*/
+
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <rs232controller.h>
+#include "modbustcp.h"
+
+/*-------------------------------------------------------------------------*/
+
+int ModbusTCPException(unsigned char *response);
+
+int MsgGenModbusTCP(unsigned char *ModbusMsg, int ModbusMsgLength, unsigned char *TcpPacket, 
+			int *TcpPacketLength)
+{	
+	unsigned char MBAPbyte1 = 1, MBAPbyte2 = 1;
+	unsigned char lengthByte1, lengthByte2;
+	int index;
+	   	     							
+	// Check if Device Address is Valid. This is based on RS485 having up to 
+	// 32 devices, since we currently only have one device this won't be a problem.
+	if ((ModbusMsg[0] > 32) || (ModbusMsg[0] < 1))
+	{
+		printf("Error: Modbus Address out of Range: %X\n",ModbusMsg[0]);
+		return MODBUSTCP_BadDataAddress;
+	}	
+	
+	// Check if Function code is Valid
+	if ((ModbusMsg[1] > 16) || (ModbusMsg[1] < 1))
+	{
+		printf("Error: Modbus Function Code Invalid: %X\n",ModbusMsg[1]);
+		return MODBUSTCP_BadFunction;
+	}
+	
+	// Calculate Legth Field
+	// Length should never be greater than 255 but just in case.
+	if ((ModbusMsgLength)>255){
+		lengthByte1=ModbusMsgLength/255;
+		lengthByte2=ModbusMsgLength%255;
+	}
+	else{
+		lengthByte1=0;
+		lengthByte2=ModbusMsgLength;	
+	}
+	
+	sprintf((char *)TcpPacket,"%c%c%c%c%c%c",MBAPbyte1,MBAPbyte2,0,0,lengthByte1,lengthByte2);
+	
+	for(index=0;index<=ModbusMsgLength;index++)sprintf((char *)&TcpPacket[index+6],"%c",ModbusMsg[index]);
+	
+	*TcpPacketLength=ModbusMsgLength+6;
+	
+	return 1;
+}	
+
+/*-------------------------------------------------------------------------*/
+
+int transactModbusTCP(prs232 self, unsigned char *query, int queryLength, unsigned char *response, int responseLength)
+{
+  unsigned char TCPquery[40];
+  int iRet, index, TCPqueryLength;
+	
+  // Generate the TCP message
+  iRet=MsgGenModbusTCP(query,queryLength,TCPquery,&TCPqueryLength);
+  
+  // Send the message and Read the reply
+  memset(response,0,responseLength); // puts zeros in reply up until reply length
+  if ((iRet=transactRS232(self,TCPquery,/*strlen(pCommand)*/12,response,20))<=0)
+  {
+     printf("Comms error!\n");
+     return iRet; // Comms problem
+  }	
+  					  
+  // Check that the response transact and protocol identifier are the same
+  if( (strncmp((char *)TCPquery,(char *)response,3)) == 0)
+  { 	
+	 // Check that there is not a modbus error, see page 98 from WEST4100 User manual.
+	 if ( response[7] > 0x80 )
+ 	 {
+		iRet=ModbusTCPException(response);
+		
+		return iRet;
+  	}
+  	else 
+  	{
+  		// Return the modbus response minus the TCP Header
+  		for(index=0;index<6;index++)
+			response[index]=response[index+6];
+  		
+  		return 1;
+  	}
+	
+	return 1; // Success
+  }
+  
+  return MODBUSTCP_TCPError;
+}
+
+/*-------------------------------------------------------------------------*/
+
+int ModbusTCPException(unsigned char *response)
+{	
+	if(response[8] == 0x01){
+		printf("Exception Code 01h: Illegal Function\n"); 
+		return MODBUSTCP_IllegalFunction;
+	}else if(response[8] == 0x02){
+		printf("Exception Code 02h: Illegal Data Address\n");
+		return MODBUSTCP_IllegalDataAddress;
+	}else if(response[8] == 0x03){
+		printf("Exception Code 03h: Illegal Data Value\n");
+		return MODBUSTCP_IllegalDataValue;
+	}else{
+		printf("Error code is greater than 81h, 82h or 83h\n");
+		return MODBUSTCP_UnsupportedError;
+	} 
+}
+
+/*-------------------------------------------------------------------------*/

site_ansto/hardsup/modbustcp.h

@@ -0,0 +1,28 @@
+/*---------------------------------------------------------------------------
+					M O D B U S T C P . H
+
+Modbus functions designed for use with the WEST4100 Temperature Controller.
+  
+Paul Barron, 2008
+----------------------------------------------------------------------------*/
+
+#ifndef MODBUSTCP
+#define MODBUSTCP
+#include "rs232controller.h"
+
+// Own Codes
+#define MODBUSTCP_BadFunction 			-8001 
+#define MODBUSTCP_BadDataAddress 		-8002
+#define MODBUSTCP_IllegalFunction 		-8011 
+#define MODBUSTCP_IllegalDataAddress 	-8012
+#define MODBUSTCP_IllegalDataValue 		-8013
+#define MODBUSTCP_UnsupportedError		-8014 // Device returned a modbus error that is not 81, 82 or 83
+#define MODBUSTCP_TCPError 				-8016 // Repsonse Transaction and Protocol Identifier do no match query
+#define MODBUSTCP_UnknownError 			-8017
+
+
+/*---------------------------------------------------------------------------*/
+                      
+	int transactModbusTCP(prs232 self, unsigned char *query, int queryLength, unsigned char *response, int responseLength);
+
+#endif

site_ansto/hardsup/serialsinq.c

@@ -105,14 +105,14 @@
   {
     int			    status;
     struct SerialInfo	   *my_info;
-    void		   *my_hndl;
+    //void		   *my_hndl;
-    struct hostent	   *rmt_hostent;
+    //struct hostent	   *rmt_hostent;
-    struct in_addr	   *rmt_inet_addr_pntr;
+    //struct in_addr	   *rmt_inet_addr_pntr;
-    int			    rmt_sockname_len;
+    //int			    rmt_sockname_len;
-    struct sockaddr_in	    lcl_sockname;
+    //struct sockaddr_in	    lcl_sockname;
-    struct sockaddr_in	    rmt_sockname;
+    //struct sockaddr_in	    rmt_sockname;
-    char		    msr_cmnd[20];
+    //char		    msr_cmnd[20];
-    struct RS__RplyStruct  *rply_ptr;
+    //struct RS__RplyStruct  *rply_ptr;
 
     *pData = NULL;
     
@@ -158,14 +158,14 @@
   {
     int			    status;
     struct SerialInfo	    *my_info;
-    void		   *my_hndl;
+    //void		   *my_hndl;
-    struct hostent	   *rmt_hostent;
+    //struct hostent	   *rmt_hostent;
-    struct in_addr	   *rmt_inet_addr_pntr;
+    //struct in_addr	   *rmt_inet_addr_pntr;
-    int			    rmt_sockname_len;
+    //int			    rmt_sockname_len;
-    struct sockaddr_in	    lcl_sockname;
+    //struct sockaddr_in	    lcl_sockname;
-    struct sockaddr_in	    rmt_sockname;
+    //struct sockaddr_in	    rmt_sockname;
-    char		    msr_cmnd[20];
+    //char		    msr_cmnd[20];
-    struct RS__RplyStruct  *rply_ptr;
+    //struct RS__RplyStruct  *rply_ptr;
 
     *pData = NULL;
 
@@ -246,7 +246,7 @@
   int SerialGetSocket(void **pData)
   {
     struct SerialInfo *my_info = NULL;
-    int iTmo;
+//    int iTmo;
     
     my_info = (struct SerialInfo *)*pData;
     assert(my_info);
@@ -260,7 +260,7 @@
   {
 
     struct SerialInfo	*info_ptr;
-    char		buff[4];
+//    char		buff[4];
 
     info_ptr = (struct SerialInfo *) *pData;
     if (info_ptr == NULL) return True;
@@ -278,7 +278,7 @@
   {
 
     struct SerialInfo	*info_ptr;
-    char		buff[4];
+  //  char		buff[4];
 
     info_ptr = (struct SerialInfo *) *pData;
     if (info_ptr == NULL) return True;
@@ -348,15 +348,17 @@
   int SerialSend(void **pData, char *pCommand)
   {
     struct SerialInfo	*info_ptr;
-    int			status, c_len, size, max_size, ncmnds;
+    //int			status, c_len, size, max_size, ncmnds;
-    int			bytes_to_come, bytes_left;
+    int			status, c_len, size, ncmnds;
+    //int			bytes_to_come, bytes_left;
+    int			bytes_left;
     int                 iResult;
-    char		*nxt_byte_ptr;
+    //char		*nxt_byte_ptr;
-    char		err_text[80];
+    //char		err_text[80];
     char		text[20];
     char		*txt_ptr;
     char		*cmnd_lst_ptr;
-    char                *pComCom = NULL;
+    //char                *pComCom = NULL;
 
 		    /*
 		    ** Do nothing if no connection - the connection gets
@@ -443,17 +445,18 @@
   int SerialReceive(void **pData, char *pBuffer, int iBufLen)
   {
     struct SerialInfo	*info_ptr;
-    int			status, c_len, size, max_size, ncmnds;
+    int			status;//, c_len, 
+    int                 size, max_size; //, ncmnds;
     int			bytes_to_come, bytes_left;
     int                 iResult;
     char		*nxt_byte_ptr;
-    char		err_text[80];
+    //char		err_text[80];
-    char		text[20];
+    //char		text[20];
-    char		*txt_ptr;
+    //char		*txt_ptr;
-    char		*cmnd_lst_ptr;
+    //char		*cmnd_lst_ptr;
     struct RS__RplyStruct_V01B *ptr = NULL;
-    long lMask = 0L;
+    //long lMask = 0L;
-    struct timeval tmo = {0,1};
+    //struct timeval tmo = {0,1};
 
     
 		    /*
@@ -565,17 +568,18 @@
                              int iBufLen, char *cTerm )
   {
     struct SerialInfo	*info_ptr;
-    int			status, c_len, size, max_size, ncmnds;
+    int			status;//, c_len, 
+    int                 size, max_size;//, ncmnds;
     int			bytes_to_come, bytes_left;
     int                 iResult;
     char		*nxt_byte_ptr;
-    char		err_text[80];
+    //char		err_text[80];
-    char		text[20];
+    //char		text[20];
-    char		*txt_ptr;
+    //char		*txt_ptr;
-    char		*cmnd_lst_ptr;
+    //char		*cmnd_lst_ptr;
     struct RS__RplyStruct_V01B *ptr = NULL;
-    long lMask = 0L;
+    //long lMask = 0L;
-    struct timeval tmo = {0,1};
+    //struct timeval tmo = {0,1};
 
     
 		    /*
@@ -889,7 +893,7 @@
    void SetSerialSleep(void **pData, SerialSleep pFun, void *pUserData)
    {
        struct SerialInfo *pInfo = NULL;
-       int iRet;
+  //     int iRet;
        
        pInfo = (struct SerialInfo *)*pData;
        pInfo->pFunc = pFun;

site_ansto/hardsup/west4100util.c

@@ -0,0 +1,507 @@
+/*--------------------------------------------------------------------------
+
+                         W E S T 4 1 0 0 U T I L . C
+                       
+     A few utility functions for dealing with a WEST4100 temperature controller
+     within the SINQ setup: host -- TCP/IP -- MAC --- RS-232.
+     
+     Mark Koennecke, Juli 1997
+     Mark Lesha, January 2006 (based on ITC4 code)
+     Paul Barron, January 2008 (Note: This is based on the old LAKESHORE340 code and 
+     							not the new LS340 code written by Rodney Davies Feb 08)
+
+       Copyright:
+
+       Labor fuer Neutronenstreuung
+       Paul Scherrer Institut
+       CH-5423 Villigen-PSI
+
+
+      The authors hereby grant permission to use, copy, modify, distribute,
+      and license this software and its documentation for any purpose, provided
+      that existing copyright notices are retained in all copies and that this
+      notice is included verbatim in any distributions. No written agreement,
+      license, or royalty fee is required for any of the authorized uses.
+      Modifications to this software may be copyrighted by their authors
+      and need not follow the licensing terms described here, provided that
+      the new terms are clearly indicated on the first page of each file where
+      they apply.
+
+      IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+      FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+      ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+      DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+      POSSIBILITY OF SUCH DAMAGE.
+
+      THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+      INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+      FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
+      IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+      NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+      MODIFICATIONS.
+----------------------------------------------------------------------------*/
+#include <string.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+#include <fortify.h>
+#include <sics.h>
+#include <modriv.h>
+#include <rs232controller.h>
+#include "west4100util.h"
+#include "modbustcp.h"
+/*-------------------------------------------------------------------------*/
+
+
+  int WEST4100_Check_Status(pWEST4100 self)
+  /* Can be called to check for correct operation of the WEST4100 */
+  {
+     int iRet, iRetry;
+     unsigned char pCommand[20];
+     unsigned char pReply[132];
+
+  	 iRetry=0;
+  	 do
+  	 {
+	    // Check Alarm 1
+	    printf("%-9s %-23s","Checking:", "Status Alarm 1........");
+	    sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,0x01,0x00,0x05,0x00,0x01);
+	    if ((iRet=transactModbusTCP(self->controller,pCommand,6,pReply,79))<=0)
+	      	return iRet;
+	    
+	    if(pReply[3] != 0x0)
+	    {
+	    	printf("Warning: Alarm 1 Activated\n");
+	    	strcpy(self->pAns,pReply);
+			return 1;
+	    }else printf("OK\n");
+	     
+	    // Check Alarm 2
+	    printf("%-9s %-23s","Checking:", "Status Alarm 2........");
+	    sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,0x01,0x00,0x06,0x00,0x01);
+	    if ((iRet=transactModbusTCP(self->controller,pCommand,6,pReply,79))<=0)
+	      	return iRet;
+	    
+	    if(pReply[3]!=0x0)
+	    {
+	    	printf("Warning: Alarm 2 Activated\n");
+	    	strcpy(self->pAns,pReply);
+			return 1;
+	    }else{ 
+	    	printf("OK\n");
+     		return 1;
+	    }
+  	 } while((++iRetry<10));
+  	 /* If we fell out of the loop, the WEST4100 recieved a bad response*/
+     sprintf(self->pAns,"Write Status=%s",pReply);
+     printf("Bad response received!\n");
+     return WEST4100__BADREAD;
+  }
+/*-------------------------------------------------------------------------*/  
+  int WEST4100_ConfigureAndQueryGen(pWEST4100 self, char *command, int fParAdr, float fVal, char *diagnosis)
+  {
+     int iRet;
+     unsigned char pCommandSet[79], pCommandCheck[79];
+     unsigned char pReply[79];
+     unsigned char fParAdrHex[2],fValHex[2];
+     
+     // Convert int to hexstring
+     if((iRet=(int2hexstring((int)fParAdr,fParAdrHex)))==0)
+     	return iRet;
+     if((iRet=(int2hexstring((int)fVal,fValHex)))==0)
+     	return iRet;
+     
+     /* Construct a write command. */
+	 printf("%-9s %-23s","Setting: ",command);
+	 sprintf(pCommandSet,"%c%c%c%c%c%c",self->iAdr,0x06,
+	 		fParAdrHex[0],fParAdrHex[1],fValHex[0],fValHex[1]);
+	 	 
+	/* Issue a write command. */
+	 if((iRet=transactModbusTCP(self->controller,pCommandSet,/*strlen(pCommand)*/6,pReply,79))!=1)     
+       return iRet;
+     printf("OK\n");
+     
+     /* Construct a read command to check that the paramater was set.*/
+     printf("%-9s %-23s","Checking:",command);
+     sprintf(pCommandCheck,"%c%c%c%c%c%c",self->iAdr,04,fParAdrHex[0],fParAdrHex[1],0x00,0x1);
+     
+     /* Issue a read command .*/
+     if ((iRet=transactModbusTCP(self->controller,pCommandCheck,6,pReply,79))<=0)
+     {
+       printf("transactRS232 error! Code=%d.\n",iRet);
+       printf("DEBUG: pReply='%s' len=%d \n",pReply,strlen(pReply));
+       return iRet;
+     }
+ 	 
+ 	 // Check that the read data is the same as that was set
+ 	 if ( (pCommandSet[4]!=pReply[3]) || (pCommandSet[5]!=pReply[4]) )
+     {
+     	printf("Response was bad, Data not set.\n");
+     	if (diagnosis&&*diagnosis)
+     		sprintf(self->pAns,"%s response=%s (%s.)",command,pReply,diagnosis);
+     	else
+     		sprintf(self->pAns,"%s response=%s",command,pReply);
+     	return WEST4100__BADREAD;
+     }
+     printf("OK\n");
+     return 1;
+  }
+/*-------------------------------------------------------------------------*/ 
+  int WEST4100_SetControl(pWEST4100 self, int iControl)
+  {
+	// Left over from lakeshore code, West only has 1 sensor to choose from. 
+	
+	return 1;
+  }
+/*-------------------------------------------------------------------------*/  
+  int WEST4100_Setup(pWEST4100 self)
+  {
+     int iRet;
+     unsigned char pCommand[40];
+     unsigned char pReply[132];
+     //int fVal = 999999.;
+     
+     /* Check the WEST4100 status */
+  	 if ((iRet=WEST4100_Check_Status(self))!=1)
+  	 	return iRet;
+     
+     // Check the write status
+     printf("%-9s %-23s","Checking:", "Write Status..........");
+     sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,0x01,0x00,0x01,0x00,0x01);
+     if ((iRet=transactModbusTCP(self->controller,pCommand,6,pReply,79))<=0)
+     {
+     	printf("Comms error!\n");
+       	return iRet; // Comms problem
+     }
+     if (pReply[3] & 0x1)
+     {
+     	printf("OK\n");
+     }else if (pReply[3] == 0x00)
+     {
+     	printf("Status is Write Disabled.\n");
+     	return WEST4100__READONLY;	
+     }
+     
+     /* Check that the controller is a gen-new-wine WEST4100 */
+     printf("%-9s %-23s","Checking:", "ID....................");
+     sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,0x03,0x00,122,0x00,0x01);
+     if((iRet=transactModbusTCP(self->controller,pCommand,/*strlen*/6,pReply,79))!=1)     
+       return iRet;
+     
+     if ((pReply[3]!=0x17) || (pReply[4]!=0xd4))
+     {
+     	printf("Error: Incorrect ID\n");
+     	strcpy(self->pAns,pReply);
+		return WEST4100__NOWEST4100;
+     }
+     else printf("OK\n");
+
+     // Set Output Limit
+	 if((iRet=WEST4100_ConfigureAndQueryGen(self,"Output Power to 100%..",20,100,""))!=1)     
+     	return iRet;
+     
+     // Set Alarm1 Limit
+	 if((iRet=WEST4100_ConfigureAndQueryGen(self,"Alarm1 to 1600........",13,1600,""))!=1)     
+     	return iRet;
+    
+	 // Set Alarm2 Limit
+	 if((iRet=WEST4100_ConfigureAndQueryGen(self,"Alarm2 to 0...........",14,0,""))!=1)     
+     	return iRet;
+     	
+     // Set Upper Limit
+	 if((iRet=WEST4100_ConfigureAndQueryGen(self,"Upper Limit to 1800...",22,1800,""))!=1)     
+     	return iRet;
+    
+	 // Set Lower Limit
+	 if((iRet=WEST4100_ConfigureAndQueryGen(self,"Lower Limit to 0......",23,0,""))!=1)     
+     	return iRet;
+     	
+     // Set Ramp Rate
+	 if((iRet=WEST4100_ConfigureAndQueryGen(self,"Ramp Rate to 0ff......",24,10000,""))!=1)     
+     	return iRet;
+     	
+     /* Check the WEST4100 operating status one last time */
+  	 if ((iRet=WEST4100_Check_Status(self))!=1)
+  	 	return iRet;
+  	 	
+     return 1; /* Success */
+  }
+/*-------------------------------------------------------------------------*/
+  int WEST4100_Open(pWEST4100 *pData, char *pRS232, int iAddress, int iTransaction)
+  {
+     pWEST4100 self = NULL;
+     
+     self = (pWEST4100)malloc(sizeof(WEST4100));
+     if(self == NULL)
+     {
+       return WEST4100__BADMALLOC;
+     }
+     *pData = self;
+     self->iAdr    = iAddress;
+     self->iTransact = iTransaction;
+
+     self->controller = NULL;
+     
+     self->controller = (prs232)FindCommandData(pServ->pSics,pRS232,
+                                       "RS232 Controller");
+     if(!self->controller){
+       /*SCWrite(pCon,"ERROR: motor controller not found",eError); */
+       return WEST4100__BADCOM;
+     }
+
+     return WEST4100_Setup(self);
+  }  
+/*--------------------------------------------------------------------------*/
+  void WEST4100_Close(pWEST4100 *pData)
+  {
+     pWEST4100 self;
+	 
+     self = *pData;
+     if (!self)
+     	return; // Just in case
+ 
+	 return;
+  }  
+/*--------------------------------------------------------------------------*/
+  int WEST4100_Config(pWEST4100 *pData, int iTmo, int iRead, int iControl)
+  {
+    pWEST4100 self;
+    
+    self = *pData;
+    
+    return 1;
+  }  
+/*--------------------------------------------------------------------------*/
+  int WEST4100_Send(pWEST4100 *pData, char *pCommand, char *pReply, int iLen)
+  {
+  	 int iRet;
+     pWEST4100 self;
+
+     self = *pData;
+     
+	 char *ptr = pCommand;
+	 unsigned int byte;
+	 unsigned char pCommandHex[79];
+	 size_t i;
+	
+	 // Convert char string command to hex string with every two characters concatenated to one array field
+	 for (i=0;i<sizeof pCommandHex ;++i)
+	 {
+		if(sscanf(ptr,"%2x",&byte)!=1)
+		{
+			break;
+		}
+		pCommandHex[i]=byte;
+		ptr +=2;
+	 }
+	 
+	 // Issue hex command
+	 printf("%s ","Issuing Send: ");
+	 if((iRet=transactModbusTCP(self->controller,pCommandHex,6,pReply,79))!=1){
+	   printf("%-s","Response: ");
+       displayHexString(pReply);	     
+       return iRet;
+	 }
+     printf("OK\n");
+     
+     printf("%-s","Response: ");
+     displayHexString(pReply);
+           
+     /* Check the WEST4100 operating status after issuing the command, if it was successful */
+     if (iRet>=1)
+   	 	iRet=WEST4100_Check_Status(self);
+   	 	
+  	 return iRet;
+  }
+/*--------------------------------------------------------------------------*/
+  int WEST4100_Read(pWEST4100 *pData, float *fVal)
+  {
+     unsigned char pCommand[20], pReply[132];
+     int iRet;
+     float fRead = -999999.;
+     pWEST4100 self;
+
+     self = *pData;
+ 
+ 	 sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,04,0x0,0x1,0x0,0x1);
+     if ((iRet=transactModbusTCP(self->controller,pCommand,6,pReply,79))<=0)
+     {
+        printf("transactRS232 error! Code=%d.\n",iRet);
+        printf("DEBUG: pReply='%s' len=%d \n",pReply,strlen(pReply));
+        return iRet;
+     }
+
+     // Because a value read will never be greater than FF FF we can use a simple line to convert
+     fRead=(256*pReply[3])+pReply[4]; 
+      
+     if(fRead > 65535 || fRead < 0) // Not a number, probably an error response
+     {
+       return WEST4100__BADREAD;
+     }
+     
+     *fVal = fRead;
+     
+	 return 1;
+  }
+/*--------------------------------------------------------------------------*/
+  int WEST4100_Query(pWEST4100 *pData, int parAddress, int *parValue)
+  {
+     unsigned char pCommand[20], pReply[132], pAddress[1];
+     int iRet;
+     pWEST4100 self;
+
+     self = *pData;
+	
+	 int2hexstring(parAddress,pAddress);
+ 	 sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,0x4,pAddress[0],pAddress[1],0x0,0x1);
+     if ((iRet=transactModbusTCP(self->controller,pCommand,6,pReply,79))<=0)
+     {
+        printf("transactRS232 error! Code=%d.\n",iRet);
+        printf("DEBUG: pReply='%s' len=%d \n",pReply,strlen(pReply));
+        return iRet;
+     }
+
+     // Because a value read will never be greater than FF FF we can use a simple line to convert
+     *parValue=(256*pReply[3])+pReply[4]; 
+      
+     if(*parValue > 65535 || *parValue < 0) // Not a number, probably an error response
+     {
+       return WEST4100__BADREAD;
+     }
+  	 	
+	 return 1;
+  }
+/*-------------------------------------------------------------------------*/
+  int WEST4100_Write(pWEST4100 *pData, int parAddress, int parValue)
+  {
+     unsigned char displaytext[20];
+     int iRet;
+     pWEST4100 self;
+
+     self = *pData;
+	 
+	 sprintf(displaytext,"Parameter Number %d...",parAddress);
+	 if((iRet=WEST4100_ConfigureAndQueryGen(self,displaytext,parAddress,parValue,""))!=1)     
+     	return iRet;
+  	 
+  	 if ((iRet=WEST4100_Check_Status(self))!=1)
+  	 	return iRet;
+  	 	     
+	 return 1;
+  }
+/*-------------------------------------------------------------------------*/
+  int WEST4100_Set(pWEST4100 *pData, float fVal)
+  {
+     int iRet, i;
+     pWEST4100 self;
+
+     self = *pData;
+     
+     for(i = 0; i < 3; i++)
+     {  
+        // Set setpoint 
+	 	if((iRet=WEST4100_ConfigureAndQueryGen(self,"Setpoint...",0x02,fVal,""))!=1)     
+     		return iRet;
+ 
+        printf("SETP OK, checking status and returning.\n");
+  	 	iRet=WEST4100_Check_Status(self);
+  	 	
+  	 	return iRet;
+     }
+     printf("SETP failed!\n");
+     return WEST4100__BADSET;
+  }
+/*-------------------------------------------------------------------------*/
+void WEST4100_ErrorTxt(pWEST4100 *pData,int iCode, char *pError, int iLen)
+  {
+     char pBueffel[512];
+     pWEST4100 self;
+
+     self = *pData;
+     
+     switch(iCode)
+     {
+        case WEST4100__BADCOM:
+             sprintf(pBueffel,"WEST4100: Invalid command or offline, got %s",
+                     self->pAns);
+             strncpy(pError,pBueffel,iLen);
+             break;
+        case WEST4100__BADPAR:
+             strncpy(pError,"WEST4100: Invalid parameter specified",iLen);
+             break;
+        case WEST4100__BADMALLOC:
+             strncpy(pError,"WEST4100: Error allocating memory in WEST4100",iLen);
+             break;
+        case WEST4100__BADREAD:
+             strncpy(pError,"WEST4100: Badly formatted answer",iLen);
+             break;
+        case WEST4100__BADSET:
+             strncpy(pError,"WEST4100: Failed three times to write new set value to WEST4100",iLen);
+             break;
+        case WEST4100__FAULT: // Covers various WEST4100 self-diagnosed fault conditions
+             sprintf(pBueffel,"WEST4100: Internal fault condition detected: %s",self->pAns);
+             strncpy(pError,pBueffel,iLen);
+             break;
+        case WEST4100__NOWEST4100:
+             sprintf(pBueffel,"WEST4100: Wrong model number (driver is for Model 340 only): %s",self->pAns);
+             strncpy(pError,pBueffel,iLen);
+        	 break;
+        default:
+             getRS232Error(iCode, pError,iLen);
+             break;                    
+     }
+  }
+/*-------------------------------------------------------------------------*/ 
+int int2hexstring(int fVal, unsigned char *hexstring)
+{
+	size_t k;
+	int fValInt;
+	unsigned char temp[79];
+	int result,remainder,index,index2;
+	
+	fValInt=fVal;
+	
+	if(fValInt>65535)
+	{
+		printf("Value greater than FF FF");
+		return 0;
+	}
+	
+	// Convert integer to hex and putting each char in an array
+	memset(temp,0,sizeof(temp));
+	result=1;
+	for(k=0;result!=0;k++)
+	{
+		result=fValInt/16;
+		remainder=fValInt%16;
+		fValInt=result;
+		temp[k]=remainder;
+	}
+	
+	// Formatting a new array so that there is one byte per array field
+	if((k%2)==0)
+		index2=k/2-1;
+	else
+		index2=k/2;
+		
+	if(fVal>255)
+	{	
+		for(index=0;index2>=0;(index=index+2),index2--)
+		{
+			hexstring[index2]=(temp[index+1]*16)+temp[index];
+		}
+	}else{
+		hexstring[0]=0x0;
+		hexstring[1]=(temp[1]*16)+temp[0];
+	}	
+	
+	return 1;
+}
+/*-------------------------------------------------------------------------*/
+void displayHexString(unsigned char *hexstring)
+{
+	int i;
+	
+	for(i=0;(i<5)|(hexstring[i]!='\0');i++)printf("%02x ",hexstring[i]);
+	printf("\n");
+}

site_ansto/hardsup/west4100util.h

@@ -0,0 +1,130 @@
+/*---------------------------------------------------------------------------
+                         W E S T 4 1 0 0 
+                         
+  A few utility functions for talking to a Lakeshore 340
+  temperature controller via the SINQ setup: TCP/IP--MAC--RS-232--
+  WEST4100.
+  
+  Mark Koennecke, Juli 1997
+  Mark Lesha, January 2006 (based on ITC4 code)
+  Paul Barron, January 2008 (Note: This is based on the old LAKESHORE340 code and 
+     					 	 not the new LS340 code written by Rodney Davies Feb 08)
+  
+----------------------------------------------------------------------------*/
+#ifndef SINQWEST4100
+#define SINQWEST4100
+
+/*----------------------- ERRORCODES--------------------------------------
+  Most functions return a negative error code on failure. Error codes 
+  defined are those defined for serialsinq plus a few additional ones:
+*/
+
+#define WEST4100__BADCOM -501
+/* command not recognized */
+#define WEST4100__BADPAR -502 
+/* bad parameter to command */
+#define WEST4100__BADMALLOC -503 
+/* error allocating memory */
+#define WEST4100__BADREAD  -504
+/* error analysing command string on Read */
+#define WEST4100__FAULT	-505
+/* fault or overload condition exists in WEST4100 */
+#define WEST4100__NOWEST4100  -510
+/* Controller is not WEST4100  */
+#define WEST4100__BADSET -530
+/* failed three times to set temperature */
+#define WEST4100__READONLY -531
+/*------------------------------------------------------------------------*/
+  typedef struct __WEST4100 {
+                            int iAdr;
+                            int iTransact;
+                            void *pData;
+                            char pAns[80];
+                            prs232 controller;
+                           } WEST4100; 
+
+  typedef struct __WEST4100 *pWEST4100;
+
+/*-----------------------------------------------------------------------*/
+  int WEST4100_Open(pWEST4100 *pData,char *pHost, int iAddress, int iTransaction);
+  /***** creates an WEST4100 datastructure and opens a connection to the WEST4100
+         controller. Input Parameters are:
+                 the hostname
+                 the port number
+                 the RS-232 channel number on the Mac.
+                 iMode: 1 for ReadOnly, 0 for normal mode
+
+          Return values are 1 for success, a negative error code on
+          failure.
+
+  */       
+                 
+  void   WEST4100_Close(pWEST4100 *pData);
+  /****** close a connection to an WEST4100controller and frees its
+          data structure. The only parameter is a pointer to the data 
+          structure for this controller. This pointer will be invalid after
+          this call.
+  */          
+
+  int WEST4100_Config(pWEST4100 *pData, int iTmo, int iRead, 
+                  int iControl);
+   /***** configure some aspects of a WEST4100temperature controller.
+          The parameter are:
+                    - a pointer to the data structure for the controller as 
+                      returned by WEST4100_Open
+                    - a value for the connection timeout
+                    - the temperature sensor to use for reading the 
+                      temperature.
+                    - the temperature sensor used by the WEST4100controller 
+                      for regulating the temperature.
+                    - the divisor needed to calculate the real temperature
+                      from the sensor.     
+          The function returns 1 on success, a negative error code on 
+          failure.
+    */
+    
+    int WEST4100_Send(pWEST4100 *pData, char *pCommand, char *pReply, int iLen);
+    /******* send a the command in pCommand to the WEST4100controller.
+             A possible reply is returned in the buffer pReply.
+             Maximum iLen characters are copied to pReply.
+             The first parameter is a pointer to a WEST4100data structure
+             as returned by WEST4100_Open.
+             
+             Return values are 1 for success, a negative error code on
+             failure.
+     */
+     
+     int WEST4100_Read(pWEST4100 *pData, float *fVal);
+     /******* reads the current actual temperature of the sensor
+              configured by ConfigWEST4100for reading. The value is returned
+              in fVal. The first parameter is a pointer to a WEST4100
+              data structure as returned by WEST4100_Open.
+ 
+              Return values are 1 for success, a negative error code on
+              failure.
+     */
+
+      int WEST4100_Set(pWEST4100 *pData, float fVal);
+      /****** sets a new preset temperature in the WEST4100temperature
+              controller. Parameters are:
+              - a pointer to a WEST4100data structure as returned by WEST4100_Open.
+              - the new preset value.
+
+              Return values are 1 for success, a negative error code on
+              failure.pEVInterface
+      */
+      
+      void  WEST4100_ErrorTxt(pWEST4100 *pData, int iCode, char *pError, int iLen);
+      /******* translates one of the negative error WEST4100error codes
+               into text. Maximum iLen bytes will be copied to the
+               buffer pError;
+      */                                  
+      
+      int WEST4100_Query(pWEST4100 *pData, int parAddress, int *parValue);
+      int WEST4100_Write(pWEST4100 *pData, int parAddress, int parValue);
+      int int2hexstring(int fVal, unsigned char *hexstring);
+      void displayHexString(unsigned char *hexstring);                       
+
+#endif  
+                       
+		

site_ansto/instrument/MANIFEST.TXT

@@ -1,4 +1,5 @@
 server_config.tcl
+barebones.tcl
 util
 gumxml.tcl
 config/hmm/anstohm_linked.xml

site_ansto/instrument/TEST_SICS/fakeDMC/simAxis.tcl

@@ -1,7 +1,7 @@
-# $Revision: 1.7 $
+# $Revision: 1.8 $
-# $Date: 2008-05-12 01:08:15 $
+# $Date: 2008-05-30 00:26:54 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
-# Last revision by: $Author: dcl $
+# Last revision by: $Author: ffr $
 
 # Requires a configuration array for each axis that you want to simulate.
 # eg
@@ -87,7 +87,9 @@ proc BG {_axis} {
 proc MG {args} {
 # Skip formatting
   if {[string index [lindex $args 0] 0] == "F"} {
-    set msg [lrange $args 1 end]
+      set msg [lrange $args 1 end]
+    } else {
+      set msg $args
     }
 # If msg starts with _ then return val for axis
   if {[string index $msg 0] == "_"} {
@@ -111,7 +113,7 @@ proc nextstep {paxis step target} {
   set axis(TP) [expr int($step * $mult + $axis(TP))];
   set TD_POS [expr int($axis(TD) + $step)];
   set axis(TD) [expr int($TD_POS)];
-  if {$axis(ST) == 1 || [expr abs($TD_POS - double($target))] < 0.5} {
+  if {$axis(ST) == 1} {
     set axis(TS) 44; # Stopped, limit switches open
     set axis(BG) 0; # motor has stopped 
     set axis(ST) 0; # make sure stop flag is unset

site_ansto/instrument/barebones.tcl

@@ -0,0 +1,48 @@
+# $Revision: 1.2 $
+# $Date: 2008-05-30 00:26:54 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by: $Author: ffr $
+
+# @file This is a barebones SICS configuration file, it's useful for testing 
+# drivers in isolation.
+#
+# NOTE\n
+# This configuration does not create a GumTree interface or let you
+# save nexus data files.
+
+# Required by server_config.tcl 
+VarMake Instrument Text Internal
+Instrument echidna 
+Instrument lock
+
+#START SERVER CONFIGURATION SECTION
+source sics_ports.tcl
+
+########source server_config.tcl
+
+set sicsroot ../
+source util/utility.tcl
+ServerOption LogFileBaseName $sicsroot/log/serverlog 
+
+###### installprotocolhandler 
+
+ServerOption statusfile $sicsroot/log/status.tcl 
+ServerOption RedirectFile $sicsroot/log/stdout 
+ServerOption LogFileDir $sicsroot/log 
+ServerOption QuieckPort [get_portnum $quieckport ]
+ServerOption ServerPort [get_portnum $serverport ]
+ServerOption InterruptPort [get_portnum $interruptport ]
+ServerOption TelWord sicslogin 
+ServerOption TelnetPort [get_portnum $telnetport ]
+ServerOption ReadUserPasswdTimeout 600000 
+ServerOption AcceptTimeOut 10 
+ServerOption ReadTimeOut 10 
+SicsUser manager ansto 1 
+SicsUser user sydney 2 
+SicsUser spy 007 3 
+
+MakeDrive
+
+exe batchpath ../batch
+exe syspath ../batch
+clientput "serverport [get_portnum $::serverport]"

site_ansto/instrument/config/anticollider/anticollider_common.tcl

@@ -0,0 +1,167 @@
+# $Revision: 1.2 $
+# $Date: 2008-05-30 00:26:54 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by: $Author: ffr $
+
+# TODO Handle sequencing when simultaneously moving multiple axes
+# TODO Handle functional dependencies (just write your own tcl script)
+#      or get the generic acscript to call a user proc
+# FIXME The anticollider module does not report the error messages from the
+# anticollision script, we currently get around this by using broadcast.
+
+AntiCollisionInstall
+namespace eval anticollider {
+  variable veto_region
+}
+array unset ::anticollider::veto_region 
+array set ::anticollider::veto_region ""
+
+##
+# @brief Load an anticollider script
+proc ::anticollider::loadscript {args} {
+  variable prog
+  set prog ""
+
+  set fh [open $::cfPath(anticollider)/[lindex $args 0] RDONLY ] 
+  while {[gets $fh line] >= 0} {
+    # Skip empty lines and comments
+    if [regexp {^\s*$|^ *#} $line] {
+      continue
+    }
+    lappend prog $line
+  }
+}
+
+##
+# @brief Compile compile an anticollider declaration into a veto region table
+# for the anticollider script.
+#
+# @param vprog, an anticollider declaration as a list of quote enclosed lines.
+# @return Generates the ::anticollider::veto_region lookup table.  
+#
+# Example\n
+# forbid {160 167} for stth when mtth in {87 88}\n
+# forbid { {0 15} {20 25} } for stth when mtth in { {80 90} {139.5 140.5} }\n
+# for pcx forbid { {80 130} {-inf 10} }\n
+# when mom in {0 45} forbid {{0 15} {345 360}} for pcr\n
+# for sphi forbid { {0 5} {10 15} } when schi in { {5 10} {15 20} }\n
+# forbid {-inf 5} when mtth in {0 10} for sphi\n
+# forbid {0 10} for samx whenall { samrot in {0 5} samy in {0 15} }\n
+proc ::anticollider::genveto {vprog} {
+  variable veto_region
+  array unset veto_region 
+  set lnum 1
+
+  foreach line $vprog {
+    array unset vp
+    array set vp $line
+    if [info exists vp(whenall)] {
+      foreach {mot in range} $vp(whenall) {
+        if {[llength [join $range]] != 2} {
+          error "ERROR: $range is not a valid range for $mot. Line $lnum of the veto list"
+        }
+        lappend condlist $mot $range
+      }
+      lappend veto_region($vp(for)) [list $vp(forbid) @and $condlist]
+    } elseif [info exists vp(when)] {
+      lappend veto_region($vp(for)) [list $vp(forbid) $vp(when) $vp(in)]
+    } else {
+      lappend veto_region($vp(for)) [list $vp(forbid) @any @all]
+    }
+    incr lnum
+  }
+}
+
+##
+# @brief Generic anti-collision script for simple collision avoidance.
+#
+# WARNING: This does not handle sequencing. Only run one motor at a time.
+# This script requires that an ::anticollider::veto_region has been generated
+# by the ::anticollider::genveto procedure.
+# 
+# The ::anticollider::veto_region is a hash indexed by the names of the motors
+# which have been registered with the anticollision module.
+proc ::anticollider::acscript {args} {
+  variable veto_region
+
+    foreach {regmot target} $args {
+      foreach row  $veto_region($regmot) {
+      if { [lindex $row 1] == "@and"} {
+        set forbid [lindex $row 0]
+        set no_veto 0
+        foreach {mot range} [lindex $row 2] {
+          set pos [SplitReply [$mot]]
+          foreach {lower upper} $range {}
+          if {$pos < $lower || $pos > $upper} {
+            set no_veto 1
+            break
+          }
+        }
+        if {$no_veto} {
+          continue
+        } else {
+          foreach {min max} $forbid {}
+          if {$min <= $target && $target <= $max} {
+            broadcast "ERROR:The range ($forbid) is forbidden for $regmot when [lindex $row 2]"
+            error "ERROR:The range ($forbid) is forbidden for $regmot when [lindex $row 2]"
+          }
+        }
+      } else {
+        foreach {forbidden_range obstmot obstrange} $row {
+          if {$obstmot == "@any"} {
+            if {$obstrange == "@all"} {
+              foreach {min max} [join $forbidden_range] {
+                if {$min <= $target && $target <= $max} {
+                  broadcast "ERROR: $regmot target ($target) is in the forbidden region ($forbidden_range)"
+                  error "ERROR: $regmot target ($target) is in the forbidden region ($forbidden_range)"
+                }
+              }
+            } else {
+              broadcast "ERROR: veto table must use @all with @any"
+              error "ERROR: veto table must use @all with @any"
+            }
+          } else {
+            if {$obstrange == "@all"} {
+              broadcast "ERROR: veto table must use @any with @all"
+              error "ERROR: veto table must use @any with @all"
+            } else {
+              foreach {lower upper} [join $obstrange] {
+                set pos [SplitReply [$obstmot]]
+                if {$lower <= $pos && $pos <= $upper} {
+                  foreach {min max} [join $forbidden_range] {
+                    if {$min <= $target && $target <= $max} {
+                      broadcast "ERROR:The range $min to $max is forbidden for $regmot when $obstmot is in this region ($obstrange)"
+                      error "ERROR:The range $min to $max is forbidden for $regmot when $obstmot is in this region ($obstrange)"
+
+                    }
+                  }
+                }
+              }
+            }
+          }
+        }
+      }
+      }
+      anticollision add 0 $regmot $target
+    }
+}
+
+##
+# @brief Generate anticollider veto_region and register motors with anticollider
+proc ::anticollider::init {} {
+  variable evp
+  variable veto_region
+
+  if [ catch {
+    ::anticollider::genveto $::anticollider::prog
+    foreach motor [array names veto_region] {
+      anticollision register $motor
+    }
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
+}
+
+publish ::anticollider::acscript user
+anticollision script ::anticollider::acscript

site_ansto/instrument/config/commands/commands_common.tcl

@@ -0,0 +1,85 @@
+##
+# @file Definition of common command node procs.
+
+################################################################################
+# SCAN COMMANDS
+namespace eval scan {
+command hdb_bmonscan {
+  text=drivable scan_variable
+  float scan_start
+  float scan_increment
+  int NP
+  text=monitor,timer mode
+  float preset
+  int=0,2 channel
+} { 
+
+    bmonscan clear
+#    bmonscan configure script
+
+    bmonscan add $scan_variable $scan_start $scan_increment
+    bmonscan setchannel $channel;
+    set status [catch {bmonscan run $NP $mode $preset} msg]
+#    bmonscan configure soft
+    if {$status == 0} {
+      return $msg
+    } else {
+      return -code error "ERROR [info level 0]"
+    }
+
+
+}
+::scan::hdb_bmonscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status
+::scan::hdb_bmonscan -set feedback status IDLE
+
+command hdb_hmscan {
+  text=drivable scan_variable
+  float scan_start
+  float scan_increment
+  int NP
+  text=monitor,timer mode
+  float preset
+  int=0,2 channel
+} { 
+
+    hmscan clear
+
+    hmscan add $scan_variable $scan_start $scan_increment
+    hmscan setchannel $channel;
+    set status [catch {hmscan run $NP $mode $preset} msg]
+
+    if {$status == 0} {
+      return $msg
+    } else {
+      return -code error "ERROR [info level 0]"
+    }
+
+
+}
+::scan::hdb_hmscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status
+::scan::hdb_hmscan -set feedback status IDLE
+}
+sicslist setatt ::scan::hdb_bmonscan long_name bmonscan
+sicslist setatt ::scan::hdb_hmscan long_name hmscan
+################################################################################
+
+################################################################################
+# MONITOR COMMANDS
+namespace eval monitor {
+  command count {
+    text=timer,monitor mode
+    float preset
+  } {
+    ::monitor::count -set feedback status BUSY
+    bm setmode $mode
+    bm count $preset
+    ::monitor::count -set feedback counts [SplitReply [bm getcounts]];
+    ::monitor::count -set feedback status IDLE
+  }
+  ::monitor::count -addfb int counts text status
+  ::monitor::count -set feedback status IDLE
+  array set fbarr [::monitor::count -list feedback]
+  ::utility::mkData $fbarr(counts) data monitor privilege user mutable true
+  array unset fbarr
+}
+################################################################################

site_ansto/instrument/config/counter/counter_common_1.tcl

@@ -1,20 +1,2 @@
-#FIXME Nexus path info is coded into this source.  This means that if you change the
-# monitor data path in the config/hipadaba/common_instrument_dictionary.tcl then
-# you may also need to change the paths here
 bm SetExponent 0
 sicslist setatt bm privilege internal
-namespace eval monitor {
-  command count {text:timer,monitor mode float: preset} {
-    #FIXME remove dependency on hdb path
-    ::monitor::count -set feedback status BUSY
-    bm setmode $mode
-    bm count $preset
-    ::monitor::count -set feedback counts [SplitReply [bm getcounts]];
-    ::monitor::count -set feedback status IDLE
-  }
-  ::monitor::count -addfb int counts text status
-  ::monitor::count -set feedback status IDLE
-  array set fbarr [::monitor::count -list feedback]
-  ::utility::mkData $fbarr(counts) data monitor privilege user mutable true
-  array unset fbarr
-}

site_ansto/instrument/config/environment/temperature/lakeshore340_common.tcl

@@ -0,0 +1,28 @@
+namespace eval ::environment::temperature { }
+
+# @brief Make a simulated temperature controller object.
+#
+# @param temp_sobj, name for temperature controller object.
+proc ::environment::temperature::mkls340sim {temp_sobj} {
+  EvFactory new $temp_sobj sim
+  sicslist setatt $temp_sobj numsensors 4
+  sicslist setatt $temp_sobj controlsensor sensora
+  sicslist setatt $temp_sobj sensorlist sensora,sensorb,sensorc,sensord
+  sicslist setatt $temp_sobj heateron 1
+  sicslist setatt $temp_sobj range 2
+  sicslist setatt $temp_sobj units kelvin
+  sicslist setatt $temp_sobj klass @none
+}
+
+# @brief Make a lakeshore340 temperature controller object.
+#
+# @param temp_sobj, name for temperature controller object
+# @param IP, (optional) IP address for temperature controller.
+# @param port, (optional) port number for temperature controller.
+proc ::environment::temperature::mkls340 {temp_sobj {IP 137.157.201.50} {port 4001}} {
+  Makeasyncqueue sertemp1 LS340 $IP $port
+  sertemp1 timeout 2000
+  EvFactory new $temp_sobj ls340 sertemp1 1 D ABCD
+  sicslist setatt $temp_sobj units kelvin
+  sicslist setatt $temp_sobj klass @none
+}

site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl

@@ -32,11 +32,107 @@ set instrument_dictionary [subst {
     datatype @none
     property {data true control true nxsave false klass NXinstrument type instrument}
   }
-  instrument/status {
+  instrument/aperture {
     privilege spy
-    sobj {@any plc}
+    sobj {@any aperture}
     datatype @none
-    property {data false control true nxsave false klass @none type part}
+    property {data true control true nxsave false klass NXaperture type part}
+  }
+  instrument/attenuator {
+    privilege spy
+    sobj {@any attenuator}
+    datatype @none
+    property {data true control true nxsave false klass NXattenuator type part}
+  }
+  instrument/beam_stop {
+    privilege spy
+    sobj {@any beam_stop}
+    datatype @none
+    property {data true control true nxsave false klass NXbeam_stop type part}
+  }
+  instrument/bending_magnet {
+    privilege spy
+    sobj {@any bending_magnet}
+    datatype @none
+    property {data true control true nxsave false klass NXbending_magnet type part}
+  }
+  instrument/crystal {
+    privilege spy
+    sobj {@any crystal}
+    datatype @none
+    property {data true control true nxsave false klass NXcrystal type part}
+  }
+  instrument/disk_chopper {
+    privilege spy
+    sobj {@any disk_chopper}
+    datatype @none
+    property {data true control true nxsave false klass NXdisk_chopper type part}
+  }
+  instrument/fermi_chopper {
+    privilege spy
+    sobj {@any fermi_chopper}
+    datatype @none
+    property {data true control true nxsave false klass NXfermi_chopper type part}
+  }
+  instrument/filter {
+    privilege spy
+    sobj {@any filter}
+    datatype @none
+    property {data true control true nxsave false klass NXfilter type part}
+  }
+  instrument/flipper {
+    privilege spy
+    sobj {@any flipper}
+    datatype @none
+    property {data true control true nxsave false klass NXflipper type part}
+  }
+  instrument/guide {
+    privilege spy
+    sobj {@any guide}
+    datatype @none
+    property {data true control true nxsave false klass NXguide type part}
+  }
+  instrument/insertion_device {
+    privilege spy
+    sobj {@any insertion_device}
+    datatype @none
+    property {data true control true nxsave false klass NXinsertion_device type part}
+  }
+  instrument/mirror {
+    privilege spy
+    sobj {@any mirror}
+    datatype @none
+    property {data true control true nxsave false klass NXmirror type part}
+  }
+  instrument/moderator {
+    privilege spy
+    sobj {@any moderator}
+    datatype @none
+    property {data true control true nxsave false klass NXmoderator type part}
+  }
+  instrument/polarizer {
+    privilege spy
+    sobj {@any polarizer}
+    datatype @none
+    property {data true control true nxsave false klass NXpolarizer type part}
+  }
+  instrument/positioner {
+    privilege spy
+    sobj {@any positioner}
+    datatype @none
+    property {data true control true nxsave false klass NXpositioner type part}
+  }
+  instrument/source {
+    privilege spy
+    sobj {@any source}
+    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
@@ -44,29 +140,17 @@ set instrument_dictionary [subst {
     datatype @none
     property {data true control true nxsave false klass NXdetector type part}
   }
-  sample {
-    privilege spy
-    sobj {@any sample}
-    datatype @none
-    property {data true control true nxsave false klass NXsample type part}
-  }
   instrument/collimator {
     privilege spy
     sobj {@any collimator}
     datatype @none
     property {data true control true nxsave false klass NXcollimator type part}
   }
-  monitor {
-    privilege spy
-    sobj {@any monitor}
-    datatype @none
-    property {data true control true nxsave false klass NXmonitor type part}
-  }
   instrument/monochromator {
     privilege spy
-    sobj {@any monochromator @any crystal}
+    sobj {@any monochromator}
     datatype @none
-    property {data true control true nxsave false klass NXcrystal type part}
+    property {data true control true nxsave false klass NXmonochromator type part}
   }
   instrument/slits {
     privilege spy
@@ -74,17 +158,17 @@ set instrument_dictionary [subst {
     datatype @none
     property {data true control true nxsave false klass NXfilter type part}
   }
-  user {
+  sample {
     privilege spy
-    sobj {@any user}
+    sobj {@any sample @any environment}
     datatype @none
-    property {data true control true nxsave false klass NXuser type part}
+    property {data true control true nxsave false klass NXsample type part}
   }
-  experiment {
+  monitor {
     privilege spy
-    sobj {@any experiment}
+    sobj {@any monitor}
     datatype @none
-    property {data true control true nxsave false klass NXnote type part}
+    property {data true control true nxsave false klass NXmonitor type part}
   }
   data {
     privilege spy
@@ -92,6 +176,43 @@ set instrument_dictionary [subst {
     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}
+    datatype @none
+    property {data true control false nxsave false klass NXevent_data type part datatype UNKNOWN currentfiletype UNKNOWN}
+  }
+  user {
+    privilege spy
+    sobj {@any user}
+    datatype @none
+    property {data true control true nxsave false klass NXuser type part}
+  }
+  process {
+    privilege spy
+    sobj {@any process}
+    datatype @none
+    property {data true control true nxsave false klass NXprocess type part}
+  }
+  characterization {
+    privilege spy
+    sobj {@any characterization}
+    datatype @none
+    property {data true control true nxsave false klass NXcharacterization type part}
+  }
+
+  experiment {
+    privilege spy
+    sobj {@any experiment}
+    datatype @none
+    property {data true control true nxsave false klass NXnote type part}
+  }
+  instrument/status {
+    privilege spy
+    sobj {@any plc}
+    datatype @none
+    property {data false control true nxsave false klass @none type part}
+  }
   data/data_set {
     privilege spy
     datatype @none

site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl

@@ -15,8 +15,384 @@ InstallHdb
 
 namespace eval ::hdb {
 namespace export buildHDB attlist
+
+set NXlog_template {
+  NXlog {
+    $name {
+      $paramarr(time)
+      $paramarr(value)
+      $paramarr(raw_value)
+      $paramarr(description)
+      $paramarr(average_value)
+      $paramarr(average_value_error)
+      $paramarr(minimum_value)
+      $paramarr(maximum_value)
+      $paramarr(duration)
+    }
+  }
 }
 
+set NXnote_template {
+  NXnote {
+    $name {
+      $paramarr(author)
+      $paramarr(date)
+      $paramarr(type)
+      $paramarr(file_name)
+      $paramarr(description)
+      $paramarr(data)
+    }
+  }
+}
+
+set NXbeam_template {
+  $name {
+    $paramarr(distance)
+    $paramarr(incident_energy)
+    $paramarr(final_energy)
+    $paramarr(energy_transfer)
+    $paramarr(incident_wavelength)
+    $paramarr(incident_wavelength_spread)
+    $paramarr(incident_beam_divergence)
+    $paramarr(final_wavelength)
+    $paramarr(incident_polarization)
+    $paramarr(final_polarization)
+    $paramarr(final_wavelength_spread)
+    $paramarr(final_beam_divergence)
+    $paramarr(flux)
+  }
+}
+
+# NOTE: paramarr(offset) was added for Quokka's DetPosYOffsetmm parameter
+set NXgeometry_template {
+  NXgeometry {
+    geometry {
+      sobjlist {$paramarr(geomdescription)}
+      NXshape {
+        shape {
+          sobjlist {$paramarr(shape) $paramarr(size)}
+        }
+      }
+      NXtranslation {
+        position {
+          sobjlist {$paramarr(position) $paramarr(offset) $paramarr(coordinate_scheme)}
+          NXgeometry {
+            geometry {
+              link {
+                target {$paramarr(refpos)}
+                nxalias {$paramarr(position)}
+              }
+            }
+          }
+        }
+      }
+      NXorientation {
+        orientation {
+          sobjlist {$paramarr(orientation)}
+        }
+      }
+    }
+  }
+}
+
+set NXaperture_template [subst -novariables {
+  NXaperture {
+    $name { 
+      sobjlist {$paramarr(material) $paramarr(description)}
+      [ set NXgeometry_template ]
+    }
+  }
+} ]
+
+set NXvelocity_selector_template [subst -novariables {
+  NXvelocity_selector {
+    $name {
+      sobjlist {
+        $paramarr(type)
+        $paramarr(rotation_speed)
+        $paramarr(radius)
+        $paramarr(spwidth)
+        $paramarr(length)
+        $paramarr(num)
+        $paramarr(twist)
+        $paramarr(table)
+        $paramarr(height)
+        $paramarr(width)
+        $paramarr(wavelength)
+        $paramarr(wavelength_spread)
+      }
+      [ set NXgeometry_template ]
+    }
+  }
+} ]
+}
+
+proc ::hdb::MakeLog {name klass paramlist} {
+  variable NXlog_template
+  array set paramarr $paramlist
+  set newtable [list]
+  prune_NX newtable $NXlog_template
+  ::hdb::subtree_macro $name $klass $newtable
+}
+proc ::hdb::MakeNote {name klass paramlist} {
+  variable NXnote_template
+  array set paramarr $paramlist
+  set newtable [list]
+  prune_NX newtable $NXnote_template
+  ::hdb::subtree_macro $name $klass $newtable
+}
+proc ::hdb::MakeBeam {name klass paramlist} {
+  variable NXbeam_template
+  array set paramarr $paramlist
+  set newtable [list]
+  prune_NX newtable $NXbeam_template
+  ::hdb::subtree_macro $name $klass $newtable
+}
+
+proc ::hdb:MakeEnvironment {name klass paramlist} {
+  variable NXenvironment_template
+  array set paramarr $paramlist
+  set newtable [list]
+  prune_NX newtable $NXenvironment_template
+  ::hdb::subtree_macro $name $klass $newtable
+}
+
+proc ::hdb::MakeGeometry {name klass paramlist} {
+  variable NXgeometry_template
+  array set paramarr $paramlist
+  set newtable [list]
+  prune_NX newtable $NXgeometry_template
+  ::hdb::subtree_macro $name $klass $newtable
+}
+
+##
+# @brief Generates an hdb subtree macro from a named list of SICS objects.
+#
+# NOTE: Currently the only SICS objects supported are 'sicsvariable' and 'macro'.
+# @param name, This is the name of the aperture.
+# @paramlist, A name value list of aperture parameters. All parameters are optional.
+proc ::hdb::MakeAperture {name paramlist} {
+  array set paramarr $paramlist
+  variable NXaperture_template
+  set newtable [list]
+  prune_NX newtable $NXaperture_template
+  ::hdb::subtree_macro $name instrument $newtable
+}
+
+proc ::hdb::MakeVelocity_Selector {name paramlist} {
+  variable NXvelocity_selector_template
+  array set paramarr $paramlist
+  set newtable [list]
+  prune_NX newtable $NXvelocity_selector_template
+  ::hdb::subtree_macro $name instrument $newtable
+}
+
+##
+# @brief This simplifies a NeXus-class template by removing unnecessary branches.
+# A NeXus-class template is a keyed-list which has Tcl variables for some of the nodes,
+# if the Tcl variables aren't defined for some branch then that branch is removed.
+# All other variables are expanded in place, also all 'sobjlists' are split up into type
+# specific lists.  This is intended as a helper function for commands which generate 
+# NeXus-class keyed lists from a simple set of optional parameters.
+#
+# @param NXklist, This is a keyed list representation of the NeXus class which will be augmented
+# with the pruned nx_template. Note this can just be an empty list.
+# @param nx_template, The NeXus-class template which will be pruned.
+# @param path, (optional, default="") Parent path in recursive calls.
+# @param node, (optional, default="") Current node in recursive calls.
+# @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 {
+    set currpath $path/$node
+  }
+  foreach {n v} $nx_template {
+    switch $n {
+      "sobjlist" {
+        set has_sobj 0
+        foreach var $v {
+          if {[string index $var 0] == "$"} {
+          set vn [string range $var 1 end]
+          upvar $level $vn lvar 
+          if [info exists lvar] {
+            foreach sobj $lvar {
+              lappend [getatt $sobj type]_list $sobj
+            }
+            set has_sobj 1
+          }
+          } else {
+            foreach sobj $var {
+              lappend [getatt $sobj type]_list $sobj
+            }
+            set has_sobj 1
+          }
+        }
+        if {$has_sobj} {
+          if [info exists sicsvariable_list] {
+          ::utility::tabset newtable $currpath/sicsvariable [subst {{$sicsvariable_list}}]
+          }
+          if [info exists macro_list] {
+          ::utility::tabset newtable $currpath/macro [subst {{$macro_list}}]
+          }
+        } else {
+        }
+      }
+      "link" {
+        set linktarget ""
+        array set linkinfo $v
+        if {[string index $linkinfo(target) 0] == "$"} {
+          set vn [string range $linkinfo(target) 1 end]
+          upvar $level $vn lvar 
+          if [info exists lvar] {
+            set linktarget $lvar
+          }
+        } else {
+            set linktarget $linkinfo(target)
+        }
+        if {[string index $linkinfo(nxalias) 0] == "$"} {
+          set vn [string range $linkinfo(nxalias) 1 end]
+          upvar $level $vn avar 
+        if [info exists avar] {
+          set linkname $avar
+        }
+        } else {
+          set linkname $linkinfo(nxalias)
+        }
+        if {$linktarget != ""} {
+          ::utility::tabset newtable $currpath/link/target [subst {{$linktarget}}]
+          ::utility::tabset newtable $currpath/link/nxalias [subst {{$linkname}}]
+        }
+      }
+      default {
+        if {[string range $n 0 1] == "NX"} {
+          set node $n
+        } elseif {[string index $n 0] == "$"} { 
+          set vn [string range $n 1 end]
+          upvar $level $vn lvar
+          if [info exists lvar] {
+            set node $lvar
+          } else {
+          }
+        } else {
+          set node $n
+        }
+        prune_NX newtable $v $currpath $node [expr $level+1]
+      }
+    }
+  }
+}
+
+##
+# @brief Make an aperture
+#
+# @param args optional name and description variables
+#proc MakeAperture {apname nxgeometry args} {
+#  set nxaperture [::hdb::NXaperture $apname $nxgeometry $args]
+#  ::hdb::subtree_macro $apname instrument $nxaperture
+#}
+
+##
+# @brief Generate a subtree macro procedure
+#
+# @param Name of the subtree macro
+# @klass Category which the macro belongs to (usually a NeXus class)
+# @klist A keyed list which describes the subtree.
+proc ::hdb::subtree_macro {name klass klist} {
+  set st_macroname ${name}_subtree_macro
+  proc ::hdb::$st_macroname {} "return [list $klist]"
+  ::hdb::set_subtree_props ::hdb::$st_macroname $klass
+}
+
+##
+# @brief Publish an hdb_subtree macro and initialise it's property list
+#
+# @param st_name The name of the hdb_subtree macro
+# @param klass Where should the subtree be placed in the hdb heirarchy
+# @param control (optional, default=true) Add it to the control interface?
+# @param privilege (optional, default=user) Modification privilege.
+proc ::hdb::set_subtree_props {st_name klass {control "true"} {privilege "user"} } {
+  publish $st_name mugger
+  sicslist setatt $st_name klass $klass
+  sicslist setatt $st_name control $control
+  sicslist setatt $st_name privilege $privilege 
+  sicslist setatt $st_name kind "hdb_subtree"
+  sicslist setatt $st_name long_name "@none"
+  sicslist setatt $st_name data "true"
+  sicslist setatt $st_name nxsave "true"
+}
+
+# @brief Add a subtree to a given hipadaba path.  
+#
+# @param hpath, Basepath for subtree
+# @param object, SICS object name
+# @param subtree, A nested Tcl list which represents the subtree
+# @param type, the SICS object type if we are adding SICS object node. Optional, default = @none.
+# @param makenode, type of node to make. Optional, default = @none.
+proc ::hdb::add_subtree {hpath subtree {object @none} {type @none} {makenode @none}} {
+  set ::errorInfo "" 
+  set SICStypes {sicsvariable macro}
+  if [catch {
+    switch $makenode { 
+      "@none" {
+        foreach {n v} $subtree {
+          if {[lsearch -exact $::nexus_classes $n] != -1} {
+            add_subtree $hpath $v $object $n NXclass
+          } elseif {[lsearch -exact $SICStypes $n] != -1} {
+            add_subtree $hpath $v $object $n sicsobject
+          } elseif {$n=="link"} {
+            add_subtree $hpath $v $object $n link
+          } else {
+            error "ERROR:Unknown type, '$n'"
+          }
+        }
+      }
+      "NXclass" {
+        foreach {item val} $subtree {
+          add_hpath $hpath $item
+          hsetprop $hpath/$item klass $type
+          add_subtree $hpath/$item $val $object
+        }
+      }
+      "sicsobject" {
+        foreach item $subtree {
+          if {$item==$object} {
+            error "ERROR: Infinite recursion, cannot add $item as a node to it's own hdb subtree"
+          }
+          set objtype [getatt $item type] 
+          if {$type != $objtype} {
+            error "ERROR: Specified type of '$type' doesn't match actual type, '$objtype', for $item"
+          }
+          sobjadd $hpath $item
+        }
+      }
+      "link" {
+        set target [::utility::tabget subtree target]
+        set nxalias [::utility::tabget subtree nxalias]
+        foreach l $nxalias t $target {
+          set refname [getatt $t long_name]
+          ::hdb::add_hpath $hpath $refname
+          hsetprop $hpath/$refname data "true"
+          hsetprop $hpath/$refname nxsave "false"
+          hsetprop $hpath/$refname control "false"
+
+          hsetprop $hpath/$refname link $t
+          hsetprop $hpath/$refname nxalias ${l}_posref
+          hsetprop $hpath/$refname type nxvgroup
+          hsetprop $hpath/$refname klass @none
+        }
+      }
+      default {
+        error "ERROR: Unknown node type, $makenode"
+      }
+    }
+  } message ] {
+    if {$::errorCode=="NONE"} {return $hpath}
+    return -code error $message
+  }
+}
 ##
 # @brief Add an hdb path to the hdb tree at the given basePath
 #
@@ -87,103 +463,113 @@ proc ::hdb::add_feedback {hpath sobj name} {
 proc ::hdb::add_node {basePath args} {
   global nodeindex
   array unset arg_array
-  array set arg_array $args;
+  if [ catch {
-  
+    array set arg_array $args 
-  if {[info exists arg_array(path)] && [info exists arg_array(prop_list)]} {
+    if {[info exists arg_array(path)] && [info exists arg_array(prop_list)]} {
-    add_hpath $basePath $arg_array(path)
+      add_hpath $basePath $arg_array(path)
-    if {$basePath == "/"} {
+      if {$basePath == "/"} {
-      set node_path /$arg_array(path)
+        set node_path /$arg_array(path)
-    } else {
+      } else {
-      set node_path $basePath/$arg_array(path)
+        set node_path $basePath/$arg_array(path)
-    }
-  #  if {[info exists arg_array(prop_list)]} {
-      foreach {prop pval} $arg_array(prop_list) {
-        hsetprop $node_path $prop $pval
       }
-  #  }
+    #  if {[info exists arg_array(prop_list)]} {
-    return $node_path
+        foreach {prop pval} $arg_array(prop_list) {
-  }
+          hsetprop $node_path $prop $pval
+        }
+    #  }
+      return $node_path
+    }
 
-  if {![info exists arg_array(dlen)]} {
+    if {![info exists arg_array(dlen)]} {
-    set arg_array(dlen) ""
+      set arg_array(dlen) ""
-  }
+    }
-  set gp_path [file dirname $arg_array(node)]
+    set gp_path [file dirname $arg_array(node)]
-  set node_name [file tail $arg_array(node)]
+    set node_name [file tail $arg_array(node)]
-  if {$gp_path != "."} {
+    if {$gp_path != "."} {
-    add_hpath $basePath $gp_path
+      add_hpath $basePath $gp_path
-    set basePath $basePath/$gp_path
+      set basePath $basePath/$gp_path
-    hsetprop $basePath type part
+      hsetprop $basePath type part
-  }
+    }
-  if {[lsearch [hlist $basePath] $node_name] == -1} {
+    if {[lsearch [hlist $basePath] $node_name] == -1} {
-  #TODO allow hdb nodes of type drivable countable environment
+    #TODO allow hdb nodes of type drivable countable environment
-    array set attribute [attlist $node_name]
+      array set attribute [attlist $node_name]
-    switch $arg_array(kind) {
+      switch $arg_array(kind) {
-      command {
+        command {
-        # A command is a macro, node=macro name 
+          # A command is a macro, node=macro name 
-        set command $node_name
+          set command $node_name
-        set cmd_path [add_command $basePath $command]
+          set cmd_path [add_command $basePath $command]
-        set node_path $cmd_path
+          set node_path $cmd_path
-        # The extra arguments for add_node are supplied by the command parameters
+          # The extra arguments for add_node are supplied by the command parameters
-        # and command feedback procedures.
+          # and command feedback procedures.
-        if {[string length [info procs ${command}_parameters]] > 0} {
+          if {[string length [info procs ${command}_parameters]] > 0} {
-          ${command}_parameters add_node $cmd_path
+            ${command}_parameters add_node $cmd_path
-        } else {
+          } else {
-          $command -map param ::hdb::add_cmd_par $cmd_path 
+            $command -map param ::hdb::add_cmd_par $cmd_path 
+          }
+          if {[string length [info procs ${command}_feedback]] > 0} {
+            add_hpath $cmd_path feedback
+            hsetprop $cmd_path/feedback type part
+            ${command}_feedback add_node $cmd_path/feedback
+          } else {
+            add_hpath $cmd_path feedback
+            hsetprop $cmd_path/feedback type part
+            $command -map feedback ::hdb::add_feedback $cmd_path/feedback 
+          }
         }
-        if {[string length [info procs ${command}_feedback]] > 0} {
+        hobj {
-          add_hpath $cmd_path feedback
+          hattach $basePath $node_name $arg_array(long_name)
-          hsetprop $cmd_path/feedback type part
+          set node_path $basePath/$arg_array(long_name)
-          ${command}_feedback add_node $cmd_path/feedback
+          hsetprop $node_path data    [getatt $node_name data]
-        } else {
+          hsetprop $node_path control [getatt $node_name control]
-          add_hpath $cmd_path feedback
+          hsetprop $node_path nxsave  [getatt $node_name nxsave]
-          hsetprop $cmd_path/feedback type part
+          hsetprop $node_path mutable  [getatt $node_name mutable]
-          $command -map feedback ::hdb::add_feedback $cmd_path/feedback 
+          hsetprop $node_path klass   [getatt $node_name klass]
+          if [info exists attribute(hdbchain)] {
+            foreach pmot [split $attribute(hdbchain) ,] {
+              hchain $node_path [getatt $pmot hdb_path]
+            }
+          }
+          foreach child [hlist $node_path] {
+            hsetprop $node_path/$child data    false
+            hsetprop $node_path/$child control [getatt $node_name control]
+            hsetprop $node_path/$child nxsave  false
+            hsetprop $node_path/$child klass   [getatt $node_name klass]
+          }
+        }
+        script - getset {
+          # A r/w pair of scripts, node = a node path
+          set node_path $basePath/[getatt $node_name long_name]
+          set data_type [getatt $node_name dtype]
+          set data_length [getatt $node_name dlen]
+           if {[getatt $node_name access] == "read_only"} {
+             hmakescript $node_path $node_name hdbReadOnly $data_type $data_length
+           } else {
+             hmakescript $node_path $node_name $node_name $data_type $data_length
+           }
+           hsetprop $node_path sicsdev $node_name
+           hsetprop $node_path nxalias $node_name
+           hsetprop $node_path data [getatt $node_name data]
+           hsetprop $node_path control [getatt $node_name control]
+           hsetprop $node_path klass [getatt $node_name klass]
+           hsetprop $node_path sdsinfo [getatt $node_name sdsinfo]
+           hsetprop $node_path savecmd [getatt $node_name savecmd]
+          #hmakescript $node_path $arg_array(rscript) $arg_array(wscript) $arg_array(dtype) $arg_array(dlen)
         }
       }
-      hobj {
+      if {[info exists attribute(units)]} { 
-        hattach $basePath $node_name $arg_array(long_name)
+        hsetprop $node_path units $attribute(units)
-        set node_path $basePath/$arg_array(long_name)
+      }
-        hsetprop $node_path data    [getatt $node_name data]
+      if {[info exists arg_array(prop_list)]} {
-        hsetprop $node_path control [getatt $node_name control]
+        foreach {prop pval} $arg_array(prop_list) {
-        hsetprop $node_path nxsave  [getatt $node_name nxsave]
+          hsetprop $node_path $prop $pval
-        hsetprop $node_path klass   [getatt $node_name klass]
-        foreach child [hlist $node_path] {
-          hsetprop $node_path/$child data    false
-          hsetprop $node_path/$child control [getatt $node_name control]
-          hsetprop $node_path/$child nxsave  false
-          hsetprop $node_path/$child klass   [getatt $node_name klass]
         }
       }
-      script {
+      sicslist setatt $node_name hdb_path $node_path
-        # A r/w pair of scripts, node = a node path
+      return $node_path
-        set node_path $basePath/[getatt $node_name long_name]
-        set data_type [getatt $node_name dtype]
-        set data_length [getatt $node_name dlen]
-         if {[getatt $node_name access] == "read_only"} {
-           hmakescript $node_path $node_name hdbReadOnly $data_type $data_length
-         } else {
-           hmakescript $node_path $node_name $node_name $data_type $data_length
-         }
-         hsetprop $node_path sicsdev $node_name
-         hsetprop $node_path nxalias $node_name
-         hsetprop $node_path data true
-         hsetprop $node_path control false
-         hsetprop $node_path klass [getatt $node_name klass]
-         hsetprop $node_path sdsinfo [getatt $node_name sdsinfo]
-         hsetprop $node_path savecmd [getatt $node_name savecmd]
-        #hmakescript $node_path $arg_array(rscript) $arg_array(wscript) $arg_array(dtype) $arg_array(dlen)
-      }
     }
-    if {[info exists attribute(units)]} { 
+  } message ] {
-      hsetprop $node_path units $attribute(units)
+    if {$::errorCode=="NONE"} {return $message}
-    }
+    return -code error $message
-    if {[info exists arg_array(prop_list)]} {
-      foreach {prop pval} $arg_array(prop_list) {
-        hsetprop $node_path $prop $pval
-      }
-    }
-    sicslist setatt $node_name hdb_path $node_path
-    return $node_path
   }
 }
 
@@ -218,10 +604,15 @@ proc ::hdb::add_command {basePath command} {
 # @param sicsobj SICS object name
 # @return a list of name value pairs for the sicsobj attributes
 proc ::hdb::attlist {sicsobj} {
-  foreach att [tolower_sicslist $sicsobj] {
+  if [ catch {
-    lappend atts [split [string range $att 0 end-1] =]
+    foreach att [tolower_sicslist $sicsobj] {
+      lappend atts [split [string range $att 0 end-1] =]
+    }
+    return [join $atts] 
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
   }
-  return [join $atts] 
 }
 
 
@@ -273,109 +664,108 @@ proc ::hdb::sobjadd {hpath sobj args} {
 # TODO Check if args parameter needs to be here, it might be there in case the function is called
 # with more than two arguments.
   array unset sobjatt
-  array set sobjatt [attlist $sobj]
+  if [ catch {
-  sicslist setatt $sobj id $sobj
+    array set sobjatt [attlist $sobj]
-  switch $sobjatt(type) {
+    sicslist setatt $sobj id $sobj
-    motor - configurablevirtualmotor {
+    switch $sobjatt(type) {
-      if {[info exists sobjatt(group)]} {
+      motor - configurablevirtualmotor {
-        set hpath [add_hpath $hpath $sobjatt(group)]
+        if {[info exists sobjatt(group)]} {
-        if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
+          set hpath [add_hpath $hpath $sobjatt(group)]
-      }
+          if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
-      if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
-      set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
-      if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
-      if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
-      if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
-      if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
-      } else {
-        clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
-      }
-    }
-    macro {
-    # access attribute = ro,rw
-      if {[info exists sobjatt(group)]} {
-        set hpath [add_hpath $hpath $sobjatt(group)]
-        if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
-      }
-      if {[lsearch [hlist $hpath] $sobjatt(long_name)] != -1} {
-        clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
-      } else {
-        set node_path [add_node $hpath kind $sobjatt(kind) node $sobj priv $sobjatt(privilege) ]
-        if [info exists sobjatt(mutable)] {
-          if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
         }
-      }
+        if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
-    }
-    sicsvariable {
-      if {[info exists sobjatt(group)]} {
-        set hpath [add_hpath $hpath $sobjatt(group)]
-        if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
-      } 
-      if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
-        set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
-        if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
-        if {[catch {hsetprop $node_path nxalias $sobj} err]} {clientput $err error}
-        if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
-        if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
-        if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
-        if {[catch {hsetprop $node_path privilege $sobjatt(privilege)} err]} {clientput $err error}
-      } else {
-        clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
-      } 
-    }
-    node {
-    }
-    singlecounter {
-# TODO 
-      todo_msg "$sobjatt(type) case, add $sobj to $hpath"
-    }
-    histmem {
-      if {[info exists sobjatt(group)]} {
-        set hpath [add_hpath $hpath $sobjatt(group)]
-        if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
-      } 
-      if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
         set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
         if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
         if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
         if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
         if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
-        if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
+        } else {
-      } else {
+          clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
-        clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
+        }
-      } 
+      }
+      macro {
+      # access attribute = ro,rw
+        if {[info exists sobjatt(group)]} {
+          set hpath [add_hpath $hpath $sobjatt(group)]
+          if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
+        }
+        if {[lsearch [hlist $hpath] $sobjatt(long_name)] != -1} {
+          clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
+        } elseif {$sobjatt(kind) == "hdb_subtree"} {
+          add_subtree $hpath [$sobj]
+        } else {
+          set node_path [add_node $hpath kind $sobjatt(kind) node $sobj priv $sobjatt(privilege) ]
+          if [info exists sobjatt(mutable)] {
+            if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
+          }
+        }
+      }
+      sicsvariable {
+        if {[info exists sobjatt(group)]} {
+          set hpath [add_hpath $hpath $sobjatt(group)]
+          if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
+        } 
+        if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
+          set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
+          if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
+          if {[catch {hsetprop $node_path nxalias $sobj} err]} {clientput $err error}
+          if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
+          if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
+          if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
+          if {[catch {hsetprop $node_path privilege $sobjatt(privilege)} err]} {clientput $err error}
+        } else {
+          clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
+        } 
+      }
+      node {
+      }
+      singlecounter {
+  # TODO 
+        todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+      }
+      histmem {
+        if {[info exists sobjatt(group)]} {
+          set hpath [add_hpath $hpath $sobjatt(group)]
+          if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
+        } 
+        if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
+          set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
+          if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
+          if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
+          if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
+          if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
+          if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
+        } else {
+          clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
+        }
+      }
+      nxscript {
+  # TODO 
+        todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+      }
+      sicsdata  {
+  # TODO 
+        todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+      }
+      scanobject {
+  # TODO 
+        todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+      }
+      environment_controller {
+        todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+      }
     }
-    nxscript {
+  } message ] {
-# TODO 
+    if {$::errorCode=="NONE"} {return $message}
-      todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+    return -code error $message
-    }
+  }
-    sicsdata  {
+}
-# TODO 
+proc ::hdb::write_poll {pollnode val} {
-      todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+  hsetprop $pollnode poll_interval $val
-    }
+  sicspoll intervall $pollnode $val
-    scanobject {
+}
-# TODO 
+proc ::hdb::read_poll {pollnode} {
-      todo_msg "$sobjatt(type) case, add $sobj to $hpath"
+  return [getatt $pollnode]
-    } 
-    environment_controller {
-      if {[info exists sobjatt(group)]} {
-        set hpath [add_hpath $hpath $sobjatt(group)]
-        if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
-      } 
-      if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
-        set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
-        if {[catch { hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
-        if {[catch { hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
-        if {[catch { hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
-        if {[catch { hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
-        hmakescript $node_path/target "$sobj target" hdbReadOnly float
-        hsetprop $node_path/target data false
-        hsetprop $node_path/target control true
-      } else {
-        clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
-      } 
-    } 
-  } 
 }
 
 ##
@@ -388,12 +778,17 @@ proc ::hdb::sobjadd {hpath sobj args} {
 # @param given_klass A klass in instdict_specification.tcl
 # @see sobjadd
 proc ::hdb::sobjtypeadd {hpath sobjtype given_klass} {
-  foreach {sobj} [sobjlist $sobjtype $given_klass] {
+  if [ catch {
-    array unset sobjatt
+    foreach {sobj} [sobjlist $sobjtype $given_klass] {
-    array set sobjatt [attlist $sobj]
+      array unset sobjatt
-    if {[info exists sobjatt(privilege)] && $sobjatt(privilege) != "internal"} {
+      array set sobjatt [attlist $sobj]
-      sobjadd $hpath $sobj
+      if {[info exists sobjatt(privilege)] && $sobjatt(privilege) != "internal"} {
+        sobjadd $hpath $sobj
+      }
     }
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
   }
 }
 
@@ -453,18 +848,23 @@ proc ::hdb::prune {instdict} {
 proc ::hdb::buildHDB {instDict} {
 #TODO add data control nxsave nxtyp properties
 upvar #0 $instDict dictionary
-prune dictionary
+  if [ catch {
-  foreach {n v} $dictionary {
+    prune dictionary
-    array unset varr
+    foreach {n v} $dictionary {
-    array set varr $v
+      array unset varr
-    array unset property_array
+      array set varr $v
-    array set property_array $varr(property)
+      array unset property_array
-    add_node / path $n prop_list $varr(property)
+      array set property_array $varr(property)
-    if {[info exists varr(sobj)]} {
+      add_node / path $n prop_list $varr(property)
-      foreach {sicstype sobj_klass} $varr(sobj) {
+      if {[info exists varr(sobj)]} {
+        foreach {sicstype sobj_klass} $varr(sobj) {
         sobjtypeadd /$n $sicstype $sobj_klass
+        }
       }
     }
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
   }
 }
 

site_ansto/instrument/config/hipadaba/instdict_specification.tcl

@@ -11,14 +11,15 @@ set boolean {true false}
 #}
 
 # SICS OBJECTS MUST PROVIDE THE FOLLOWING INFORMATION
-set sobj_klass_list {@none aperture attenuator collimator command crystal data detector entry experiment graphics instrument monitor monochromator plc sample scan user}
+set sobj_klass_list {@none aperture attenuator collimator command crystal data detector entry environment experiment graphics instrument monitor monochromator plc sample scan sensor user}
 set sobj_sicstype_list {environment_controller sicsvariable macro motor configurablevirtualmotor singlecounter histmem nxscript sicsdata scanobject}
 # Different kinds of things are added to the hdb in different ways.
 # command: This is something a client can run with hset /a/b/c start, it may have parameters and feedback.
 #          Parameters and feedback should be made available in 'ilists' named after the command.
 # script: Supplies an rscript and a wscript to attach to a node for hgets and hsets.
 # hobj: Something that can be hattached to a node. {motor sicsvariable histmem}.
-set sobj_kind_list {command hobj script}
+# hdb_subtree: Is a macro which returns a keyed list that describes a hdb subtree.
+set sobj_kind_list {command hobj script hdb_subtree}
 set sobj_interfacelist [subst {drivable {$boolean} countable {$boolean} callback {$boolean} environment {$boolean} }]
 
 set privilege_list {spy user manager read_only internal}

site_ansto/instrument/config/hmm/hmm_cylindrical_detector_configuration.tcl

@@ -9,33 +9,36 @@ namespace eval histogram_memory {
  # requires detector_active_width_mm det_radius_mm deg_per_rad
   proc two_theta {args} {
     variable state
-    set opt [lindex $args 0]
+    if [ catch {
-    set arglist [lrange $args 1 end]
+      set opt [lindex $args 0]
-    set proc_name [namespace origin [lindex [info level 0] 0]]
+      set arglist [lrange $args 1 end]
-    set det_width_mm [SplitReply [detector_active_width_mm]]
+      set proc_name [namespace origin [lindex [info level 0] 0]]
-    set det_radius_mm [SplitReply [detector_radius_mm]]
+      set det_width_mm [SplitReply [detector_active_width_mm]]
-    set deg_per_radian [SplitReply [deg_per_rad]]
+      set det_radius_mm [SplitReply [detector_radius_mm]]
-    switch -- $opt {
+      set deg_per_radian [SplitReply [deg_per_rad]]
-      "-centres" - "-boundaries" - "-graph_type" {
+      switch -- $opt {
-        return [calc_axis $proc_name @none @none @none $opt $args]
+        "-centres" - "-boundaries" - "-graph_type" {
-      }
+          return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args]
-      "-arrayname" {
+        }
-        set max_b [OAT_TABLE -get X_MAX]
+        "-arrayname" {
-        set min_b [OAT_TABLE -get X_MIN]
+          set max_chan [OAT_TABLE X -getdata MAX_CHAN]
-        set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / ($max_b - $min_b)}]
+          set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}]
-        set offset [::histogram_memory::detector_posn_degrees]
+          set offset [::histogram_memory::detector_posn_degrees]
-        return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_boundaries] $opt $arglist]
+          return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist]
-      }
+        }
-      "-units" {
+        "-units" {
-        return "degrees"
+          return "degrees"
-      }
+        }
-      default {
+        default {
-        set max_b [OAT_TABLE -get X_MAX]
+          set max_chan [OAT_TABLE X -getdata MAX_CHAN]
-        set min_b [OAT_TABLE -get X_MIN]
+          set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}]
-        set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / ($max_b - $min_b)}]
+          set offset [::histogram_memory::detector_posn_degrees]
-        set offset [::histogram_memory::detector_posn_degrees]
+          return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $args]
-        return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_boundaries] $args]
+        }
       }
+    } message ] {
+      if {$::errorCode=="NONE"} {return $message}
+      return -code error $message
     }
   }
   set script_name ::histogram_memory::two_theta

site_ansto/instrument/config/nexus/nxscripts_common_1.tcl

@@ -5,8 +5,16 @@
 
 MakeNXScript
 sicsdatafactory new nxscript_data
+#mkVar name   type  access long_name  nxsave  klass  control data
+::utility::mkVar start_seconds int user start_seconds false entry false false
 ::utility::mkVar estart Text user start_time true entry false true
 ::utility::mkVar eend Text user end_time true entry false true
+::utility::mkVar timestamp int user time_stamp true entry false true
+::utility::mkVar data_run_number int user run_number true instrument false true
+sicslist setatt data_run_number mutable true
+sicslist setatt timestamp mutable true
+sicslist setatt timestamp units seconds
+
 namespace eval nexus {
   variable data_gp_path "/data"
   set exports [list newfile closefile save data]
@@ -32,12 +40,12 @@ namespace eval nexus {
   # TODO Put the filetype_spec in a separate file.
   variable filetype_spec {
     BEAM_MONITOR {
-      link {axis 1 ::data::gumtree_save_par_run_number}
+      link {axis 1 data_run_number}
       link {data_set ::monitor::count_fb_counts}
       save_policy {include @all exclude {hmm hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}}
     }
     HISTOGRAM_XYT {
-      link {axis 1 ::data::gumtree_save_par_run_number}
+      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}
@@ -45,40 +53,40 @@ namespace eval nexus {
       save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}}
     }
     HISTOGRAM_XY {
-      link {axis 1 ::data::gumtree_save_par_run_number}
+      link {axis 1 data_run_number}
       link {axis 2 ::histogram_memory::vertical_axis}
       link {axis 3 ::histogram_memory::horizontal_axis}
       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::gumtree_save_par_run_number}
+      link {axis 1 data_run_number}
       link {axis 2 ::histogram_memory::time_channel}
       link {axis 3 ::histogram_memory::horizontal_axis}
       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::gumtree_save_par_run_number}
+      link {axis 1 data_run_number}
       link {axis 2 ::histogram_memory::time_channel}
       link {axis 3 ::histogram_memory::vertical_axis}
       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::gumtree_save_par_run_number}
+      link {axis 1 data_run_number}
       link {axis 2 ::histogram_memory::horizontal_axis}
       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::gumtree_save_par_run_number}
+      link {axis 1 data_run_number}
       link {axis 2 ::histogram_memory::vertical_axis}
       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::gumtree_save_par_run_number}
+      link {axis 1 data_run_number}
       link {axis 2 ::histogram_memory::time_channel}
       link {data_set hmm_t}
       save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm}}
@@ -187,25 +195,30 @@ proc newFileName {postfix} {
     variable nexusdic
     variable state
     variable data_gp_path
-    if {$state(file,open) == "true"} {
+    if [ catch {
-      error_msg "Can't create a new file because the current file is still open"
+      if {$state(file,open) == "true"} {
-    } elseif {$state(file,new) == "false"} {
+          error_msg "Can't create a new file because the current file is still open"
-      error_msg "This function should only be called when state(file,new) = true"
+      } elseif {$state(file,new) == "false"} {
-    }
+        error_msg "This function should only be called when state(file,new) = true"
+      }
 
-    set file_format [SplitReply [SicsDataPostFix]]
+      set file_format [SplitReply [SicsDataPostFix]]
-    array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml]
+      array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml]
-    set nxdict_path [::nexus::gen_nxdict $nexusdic]
+      set nxdict_path [::nexus::gen_nxdict $nexusdic]
-    if {$state(file,namestyle) == "scratch"} {
+      if {$state(file,namestyle) == "scratch"} {
-      dataFileName [format "%s/scratch.%s" [::nexus::datapath] $file_format]
+        dataFileName [format "%s/scratch.%s" [::nexus::datapath] $file_format]
-    } else {
+      } else {
-      sicsdatanumber incr
+        sicsdatanumber incr
-      dataFileName [newFileName $file_format]
+        dataFileName [newFileName $file_format]
+      }
+      hsetprop $data_gp_path currentfiletype [::utility::hgetplainprop $data_gp_path datatype]
+      nxscript $nxmode($file_format) [SplitReply [dataFileName]] $nxdict_path
+      set state(file,open) false
+      set state(file,new) false
+    } message ] {
+      if {$::errorCode=="NONE"} {return $message}
+      return -code error $message
     }
-    hsetprop $data_gp_path currentfiletype [::utility::hgetplainprop $data_gp_path datatype]
-    nxscript $nxmode($file_format) [SplitReply [dataFileName]] $nxdict_path
-    set state(file,open) false
-    set state(file,new) false
   }
 
 ##
@@ -233,10 +246,11 @@ proc ::nexus::isValidFileType {type} {
   # state(file,open) true state(file,new) false
   # /data/currentfiletype == UNKNOWN
 proc ::nexus::newfile {type {namestyle data}} {
-    variable filetype_spec
+  variable filetype_spec
-    variable state
+  variable state
-    variable data_gp_path
+  variable data_gp_path
 
+  if [ catch {
     set state(file,namestyle) $namestyle
     set state(file,new) true
     hsetprop $data_gp_path currentfiletype UNKNOWN
@@ -248,7 +262,11 @@ proc ::nexus::newfile {type {namestyle data}} {
     } else {
       ::nexus::process_filetype_policy $type filetype_spec
     }
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
   }
+}
 
 ##
 # @brief Save data to the currently open file and then close it.
@@ -256,18 +274,29 @@ proc ::nexus::newfile {type {namestyle data}} {
 # @param point This is the array index for mutable data elements 
 # 
 # This function provides the top level call to the recursive ::nexus::savetree
-# function
+# function, it should only be called by the ::nexus::save command.
 #
 # @see ::nexus::savetree
+# @see ::nexus::save
   proc ::nexus::save_data {point} {
     debug_msg "save point $point in [dataFileName]"
-    ::nexus::nxreopenfile
+    if [ catch {
-    foreach child [hlist /] {
+      if {[info level]<2} {
-      if {[::utility::hgetplainprop /$child data] == "true"} {
+        error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
-        ::nexus::savetree $child $point
       }
+      set caller [namespace origin [lindex [info level -1] 0]]
+      if {$caller != "::nexus::save"} {
+        error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
+      }
+      foreach child [hlist /] {
+        if {[::utility::hgetplainprop /$child data] == "true"} {
+          ::nexus::savetree $child $point
+        }
+      }
+    } message ] {
+      if {$::errorCode=="NONE"} {return $message}
+      return -code error $message
     }
-    ::nexus::nxclosefile
   }
 
 ##
@@ -282,64 +311,105 @@ proc ::nexus::newfile {type {namestyle data}} {
     variable state
     variable data_gp_path
 
-    if {[string is integer $point] == 0} {
+    if [ catch {
-      error_msg "save index must be an integer"
+      if {[string is integer $point] == 0} {
-    } elseif {$point < 0} {
+        error_msg "save index must be an integer"
-      error_msg "save index cannot be negative"
+      } elseif {$point < 0} {
-    }
+        error_msg "save index cannot be negative"
+      }
 
-    ::data::gumtree_save -set run_number $point
+#      ::data::gumtree_save -set run_number $point
+      data_run_number $point
 
-    set isNewFile [expr {$state(file,new) == "true"}]
+      set isNewFile [expr {$state(file,new) == "true"}]
-    set currFileType [::utility::hgetplainprop $data_gp_path currentfiletype]
+      set currFileType [::utility::hgetplainprop $data_gp_path currentfiletype]
-    set currDataType [::utility::hgetplainprop $data_gp_path datatype]
+      set currDataType [::utility::hgetplainprop $data_gp_path datatype]
-    set dataTypeChanged [expr {$currFileType != $currDataType}]
+      set dataTypeChanged [expr {$currFileType != $currDataType}]
-    if {$currDataType == "UNKNOWN"} {
+      if {$currDataType == "UNKNOWN"} {
-      error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' "
+        error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' "
-    }
+      }
-
-    if {$isNewFile || $dataTypeChanged} {
-      set state(file,new) true
-      ::nexus::createfile
-      estart [lindex [sicstime] 1] 
-      eend [lindex [sicstime] 1] 
-      ::nexus::save_data $point
-      ::nexus::linkdata
-    } else {
-      eend [lindex [sicstime] 1] 
-      ::nexus::save_data $point
-    }
 
+      if {$isNewFile || $dataTypeChanged} {
+        set state(file,new) true
+        ::nexus::createfile
+        estart [lindex [sicstime] 1] 
+        eend [lindex [sicstime] 1] 
+        start_seconds [clock seconds]
+        timestamp 0
+        ::nexus::nxreopenfile
+        ::nexus::save_data $point
+        ::nexus::makelinks
+        ::nexus::set_plotdata_info
+        ::nexus::nxclosefile
+      } else {
+        eend [lindex [sicstime] 1] 
+        timestamp [expr {[clock seconds] - [SplitReply [start_seconds]]}] 
+        ::nexus::nxreopenfile
+        ::nexus::save_data $point
+        ::nexus::nxclosefile
+      }
+    } message ] {
+      if {$::errorCode=="NONE"} {return $message}
+      return -code error $message
+    } 
     return
   }
 
 ##
 # @brief Reopen the current file, close it with nxclosefile
+# this should only be called by the ::nexus::save command.
 #
 # @see nxclosefile
+# @see ::nexus::save
   proc ::nexus::nxreopenfile {} {
     global cfPath
     variable state
     variable nexusdic
-    if {$state(file,open) == "false"} {
+    if [ catch {
-      nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic
+      if {[info level]<2} {
-      set state(file,open) true
+        error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
-    }
+      }
+      set caller [namespace origin [lindex [info level -1] 0]]
+      if {$caller != "::nexus::save"} {
+        error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
+      }
+      if {$state(file,open) == "false"} {
+        nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic
+        set state(file,open) true
+      }
+    } message ] {
+      if {$::errorCode=="NONE"} {return $message}
+      return -code error $message
+    } 
   }
 
 ##
 # @brief Close the current file. You can reopen it with nxreopenfile
+# this should only be called by the ::nexus::save command.
 #
 # @see nxreopenfile
+# @see ::nexus::save
   proc ::nexus::nxclosefile {} {
     variable state
-    if {$state(file,open) == "true"} {
+    if [ catch {
-      nxscript close
+      if {[info level]<2} {
-      set state(file,open) false
+        error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
-      set flist [split [SplitReply [dataFileName]] "/"]
+      }
-      set fname [lindex $flist [expr [llength $flist] - 1] ]
+      set caller [namespace origin [lindex [info level -1] 0]]
-      clientput "$fname updated" "event"
+      if {$caller != "::nexus::save"} {
-    }
+        error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
+      }
+      if {$state(file,open) == "true"} {
+        nxscript close
+        set state(file,open) false
+        set flist [split [SplitReply [dataFileName]] "/"]
+        set fname [lindex $flist [expr [llength $flist] - 1] ]
+        clientput "$fname updated" "event"
+      }
+    } message ] {
+      if {$::errorCode=="NONE"} {return $message}
+      return -code error $message
+    } 
   }
 ##
 # @brief Records that a given data source should be linked to nexus data target.
@@ -439,25 +509,48 @@ proc ::nexus::newfile {type {namestyle data}} {
       }
   }
 
-
 ##
-# @brief Links data and axis into /data group
+# @brief Make dataset links
 #
-# Sets the "signal" and "axes" attributes on the plottable data
+  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
+        }
+      }
+    } message ] {
+      if {$::errorCode=="NONE"} {return $message}
+      return -code error $message
+    }
+  }
+##
+# @brief Sets the "signal" and "axes" attributes on the plottable data
 # Also sets the "axis" attribute for each of the axes.
-  proc ::nexus::linkdata {} {
+  proc ::nexus::set_plotdata_info {} {
     variable data_gp_path
 
     array unset axes
       set hpath $data_gp_path
-      ::nexus::nxreopenfile
       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"} {
-                  nxscript makelink $p_arr(nxalias) $p_arr(link)
                     switch -glob $child {
                       "axis_*" {
                         set n [lindex [split $child _] 1]
@@ -468,7 +561,7 @@ proc ::nexus::newfile {type {namestyle data}} {
                         nxscript putattribute $p_arr(link) signal 1
                           set data_set_alias $p_arr(link)
                       }
-                      default {error "ERROR: [info level -1]->linkdata, Unsupported data path $hpath/$child"}
+                      default {error "ERROR: [info level -1]->set_plotdata_info, Unsupported data path $hpath/$child"}
                     }
                 }
               }
@@ -481,7 +574,6 @@ proc ::nexus::newfile {type {namestyle data}} {
       }
       nxscript putattribute $data_set_alias axes [join $axes_list :]
     }
-    ::nexus::nxclosefile
   }
 
   ##
@@ -490,25 +582,31 @@ proc ::nexus::newfile {type {namestyle data}} {
   # @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}} {
-    foreach child [hlist /$hpath] {
+    set ::errorInfo ""
-      array unset p_arr
+    if [ catch {
-        array set p_arr [::utility::hlistplainprop /$hpath/$child] 
+      foreach child [hlist /$hpath] {
-        if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
+        array unset p_arr
-          return
+          array set p_arr [::utility::hlistplainprop /$hpath/$child] 
-        }
+          if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
-      set data_type [lindex [split [hinfo /$hpath/$child] , ] 0]
+            return
-        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(savecmd)] || [info exists p_arr(nxalias)]} {
-            error_msg "/$hpath/$child must have both 'savecmd' and 'nxalias' properties\nThe actual property list for /$hpath/$child is [array get p_arr]"
           }
-          ::nexus::savetree $hpath/$child $pt
+        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(savecmd)] || [info exists p_arr(nxalias)]} {
+              error_msg "/$hpath/$child must have both 'savecmd' and 'nxalias' properties\nThe actual property list for /$hpath/$child is [array get p_arr]"
+            }
+            ::nexus::savetree $hpath/$child $pt
+          }
+      }
+    } message ] {
+      if {$::errorCode=="NONE"} {return $message}
+      return -code error $message
     }
   }
 
@@ -526,6 +624,7 @@ proc ::nexus::newfile {type {namestyle data}} {
 # @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
@@ -556,6 +655,10 @@ proc ::nexus::newfile {type {namestyle data}} {
         set nxdictionary($alias) "$dictPath/NXVGROUP"
       }
     }
+    } message ] {
+      if {$::errorCode=="NONE"} {return $message}
+      return -code error $message
+    }
   }
 
   ##
@@ -566,15 +669,16 @@ proc ::nexus::newfile {type {namestyle data}} {
   # 
   # @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 {nexusdic} {
-    global cfPath
+  global cfPath
-      variable nxdictionary
+  variable nxdictionary
-      set nxdict_path $cfPath(nexus)/$nexusdic
+  if [ catch {
+    set nxdict_path $cfPath(nexus)/$nexusdic
       array unset nxdictionary 
       foreach hp [hlist /] {
         if {[::utility::hgetplainprop /$hp data] == true} {
           set nxclass [::utility::hgetplainprop /$hp klass]
-          ::nexus::_gen_nxdict $hp /entry1,NXentry $hp $nxclass
+            ::nexus::_gen_nxdict $hp /entry1,NXentry $hp $nxclass
         }
       }
     set fh [open $nxdict_path w]
@@ -586,44 +690,57 @@ proc ::nexus::newfile {type {namestyle data}} {
         puts $fh "$n = $v"
       }
     close $fh
-    return $nxdict_path
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
   }
+  return $nxdict_path
+}
 
 ##
 # @brief Set SICS object attributes which are required for creating nexus data files.
   proc ::nexus::set_sobj_attributes {} {
-    # SICS commands
+    if [ catch {
-    sicslist setatt nxscript privilege internal
+      # SICS commands
-    # SICS data objects
+      sicslist setatt nxscript privilege internal
-    sicslist setatt nxscript_data privilege internal
+      # SICS data objects
+      sicslist setatt nxscript_data privilege internal
 
-    foreach sobj [lrange [sicslist type motor] 1 end] {
+      foreach sobj [lrange [sicslist type motor] 1 end] {
-      sicslist setatt $sobj savecmd ::nexus::motor::save
+        sicslist setatt $sobj savecmd ::nexus::motor::save
-      sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
+        sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
-    }
+      }
-    foreach sobj [sicslist type configurablevirtualmotor] { 
+      foreach sobj [sicslist type configurablevirtualmotor] { 
-      sicslist setatt $sobj savecmd ::nexus::motor::save
+        sicslist setatt $sobj savecmd ::nexus::motor::save
-      sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
+        sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
-    }
+      }
-    foreach sobj [sicslist type histmem] { 
+      foreach sobj [sicslist type histmem] { 
-      sicslist setatt $sobj savecmd ::nexus::histmem::save
+        sicslist setatt $sobj savecmd ::nexus::histmem::save
-      sicslist setatt $sobj sdsinfo ::nexus::histmem::sdsinfo
+        sicslist setatt $sobj sdsinfo ::nexus::histmem::sdsinfo
-    }
+      }
-    foreach sobj [sicslist type sicsvariable] {
+      foreach sobj [sicslist type sicsvariable] {
-      sicslist setatt $sobj savecmd ::nexus::sicsvariable::save
+        sicslist setatt $sobj savecmd ::nexus::sicsvariable::save
-      sicslist setatt $sobj sdsinfo ::nexus::sicsvariable::sdsinfo
+        sicslist setatt $sobj sdsinfo ::nexus::sicsvariable::sdsinfo
-    }
+      }
-    foreach sobj [sicslist type singlecounter] {
+      foreach sobj [sicslist type singlecounter] {
-      sicslist setatt $sobj savecmd ::nexus::singlecounter::save
+        sicslist setatt $sobj savecmd ::nexus::singlecounter::save
-      sicslist setatt $sobj sdsinfo ::nexus::singlecounter::sdsinfo
+        sicslist setatt $sobj sdsinfo ::nexus::singlecounter::sdsinfo
-    }
+      }
-    foreach sobj [sicslist type environment_controller] {
+      foreach sobj [sicslist type environment_controller] {
-      sicslist setatt $sobj savecmd ::nexus::environment_controller::save
+        sicslist setatt $sobj savecmd ::nexus::environment_controller::save
-      sicslist setatt $sobj sdsinfo ::nexus::environment_controller::sdsinfo
+        sicslist setatt $sobj sdsinfo ::nexus::environment_controller::sdsinfo
-    }
+      }
-    foreach sobj [sicslist kind script] {
+      foreach sobj [sicslist kind script] {
-      sicslist setatt $sobj savecmd ::nexus::script::save
+        sicslist setatt $sobj savecmd ::nexus::script::save
-      sicslist setatt $sobj sdsinfo ::nexus::script::sdsinfo
+        sicslist setatt $sobj sdsinfo ::nexus::script::sdsinfo
+      }
+      foreach sobj [sicslist kind getset] {
+        sicslist setatt $sobj savecmd ::nexus::macro::getset_save
+        sicslist setatt $sobj sdsinfo ::nexus::macro::getset_sdsinfo
+      }
+    } message ] {
+      if {$::errorCode=="NONE"} {return $message}
+      return -code error $message
     }
   }
 
@@ -729,7 +846,41 @@ proc ::nexus::motor::sdsinfo {motor data_type args} {
     return " -type $dtype $units_att $name_att"
   }
 }
+##
+# @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} {
+  if {[lindex $args 0] == "point"} {
+    set index [lindex $args 1]
+      nxscript_data clear
+    nxscript_data putfloat 0 [getVal [$sobj] ]
+      nxscript putslab $nxalias [list $index] [list 1] nxscript_data
+  } else {
+    nxscript putfloat $nxalias [SplitReply [$sobj]]
+  }
+}
 
+##
+# @brief Define the scientific data set path for the nexus dictionary.
+proc ::nexus::macro::getset_sdsinfo {sobj data_type args} {
+  array set param $args
+  array set attribute [attlist $sobj]
+  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::save {evc nxalias data_type args} {
   if {[lindex $args 0] == "point"} {
     set index [lindex $args 1]
@@ -806,30 +957,59 @@ proc ::nexus::singlecounter::sdsinfo {counter data_type args} {
 #
 # The macro must return a 1D associative array when called with -arrayname.
 proc ::nexus::script::save {script nxalias data_type args} {
-  array set attribute [attlist $script]
+  if [ catch {
-    set darray [$script -arrayname]
+    array set attribute [attlist $script]
-    set size [array size $darray]
+    if {$attribute(klass) == "sensor"} {
-    set size [SplitReply [$darray used]]
+      if {[lindex $args 0] == "point"} {
-    if {[lindex $args 0] == "point"} {
+        set index [lindex $args 1]
-      set index [lindex $args 1]
+        nxscript_data clear
-      nxscript putslab $nxalias [list $index 0] [list 1 $size] $darray
+        nxscript_data putfloat 0 [$script]
+        nxscript putslab $nxalias [list $index] [list 1] nxscript_data
+      } else {
+        nxscript putfloat $nxalias [$script]
+      }
     } else {
-      nxscript putslab $nxalias [list 0] [list $size] $darray
+      set darray [$script -arrayname]
+      set size [array size $darray]
+      set size [SplitReply [$darray used]]
+      if {[lindex $args 0] == "point"} {
+        set index [lindex $args 1]
+        nxscript putslab $nxalias [list $index 0] [list 1 $size] $darray
+      } else {
+        nxscript putslab $nxalias [list 0] [list $size] $darray
+      }
+      if {[info exists attribute(units)]} {
+        nxscript putattribute $nxalias units $attribute(units)
+      }
     }
-  if {[info exists attribute(units)]} {
+  } message ] {
-    nxscript putattribute $nxalias units $attribute(units)
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
   }
 }
 
 proc ::nexus::script::sdsinfo {script data_type args} {
-  array set param $args
+  if [ catch {
-  set dtype [::nexus::hdb2nx_type $data_type]
+    array set param $args
-  set darray [$script -arrayname]
+    set dtype [::nexus::hdb2nx_type $data_type]
-  set size [SplitReply [$darray used]]
+    if {[getatt $script klass] == "sensor"} {
-  if {$param(mutable) == true} {
+      if {$param(mutable) == true} {
-    return " -type $dtype -rank 2 -dim {-1,$size}"
+        return " -type $dtype -rank 1 -dim {-1}"
-  } else {
+      } else {
-    return " -type $dtype -rank 1 -dim {$size}" 
+        return " -type $dtype"
+      }
+    } else {
+      set darray [$script -arrayname]
+      set size [SplitReply [$darray used]]
+      if {$param(mutable) == true} {
+        return " -type $dtype -rank 2 -dim {-1,$size}"
+      } else {
+        return " -type $dtype -rank 1 -dim {$size}" 
+      }
+    }
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
   }
 }
 
@@ -850,26 +1030,26 @@ 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.35 $}]
+set tmpstr [string map {"$" ""} {$Revision: 1.36 $}]
 set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
 
-namespace eval data {
+#namespace eval data {
-  ##
+#  ##
-  # @brief Nexus data save command for gumtree control interface
+#  # @brief Nexus data save command for gumtree control interface
-  #
+#  #
-  # @param run_number This is the run or scan point number, it serves as the array
+#  # @param run_number This is the run or scan point number, it serves as the array
-  # index for nexus data sets which correspond to mutable data
+#  # index for nexus data sets which correspond to mutable data
-  command gumtree_save {int: run_number} {
+#  command gumtree_save {int: run_number} {
-    ::nexus::save $run_number
+#    ::nexus::save $run_number
-  }
+#  }
-  sicslist setatt ::data::gumtree_save long_name save
+#  sicslist setatt ::data::gumtree_save long_name save
-    array set param [::data::gumtree_save -list param]
+#    array set param [::data::gumtree_save -list param]
-    ::utility::mkData $param(run_number) run_number instrument privilege READ_ONLY mutable true control false
+#    ::utility::mkData $param(run_number) run_number instrument privilege READ_ONLY mutable true control false
-    command gumtree_type {text:nx.hdf,xml type} {
+#    command gumtree_type {text:nx.hdf,xml type} {
-      SicsDataPostFix $type
+#      SicsDataPostFix $type
-    }
+#    }
-  sicslist set ::data::gumtree_type long_name file_format
+#  sicslist set ::data::gumtree_type long_name file_format
-    ::data::gumtree_type -set type [SplitReply [SicsDataPostFix]]
+#    ::data::gumtree_type -set type [SplitReply [SicsDataPostFix]]
-}
+#}
 
 ::nexus::init

site_ansto/instrument/config/scan/scan_common_1.tcl

@@ -52,7 +52,9 @@ proc ::scan::check_scanvar {sobj uobj} {
     set scan_increment [lindex $vlist 2];
     if {[getatt $scan_variable type] == "motor"} {
     if {[SplitReply [$scan_variable fixed]] >= 0} {
-      return -code error "Can't drive scan variable, $scan_variable position is set to 'fixed'"
+      return -code error "ERROR: Can't drive scan variable, $scan_variable position is set to 'fixed'"
+    } elseif {[SplitReply [$scan_variable thread0]] == -1} {
+      return -code error "ERROR: Can't scan ${scan_variable}. Thread zero has stopped running on the motion controller"
     }
     set target [expr $scan_start + $NP * $scan_increment]
     if [catch {
@@ -130,6 +132,7 @@ proc ::scan::hmm_count {sobj uobj point mode preset} {
     ::histogram_memory::start block
   }
 
+#TODO rangescan: drive to original position for rangescans, not the start position.
 proc ::scan::hmm_scan_finish {sobj uobj} {
     variable save_filetype
     variable reset_position
@@ -273,50 +276,6 @@ hmscan function count ::scan::hmm_count
 hmscan function prepare ::scan::hmm_scan_prepare
 hmscan function finish ::scan::hmm_scan_finish
 
-namespace eval scan {
-command hdb_bmonscan { text:drivable scan_variable float: scan_start float: scan_increment int: NP text:monitor,timer mode float: preset int:0,2 channel} { 
-
-    bmonscan clear
-#    bmonscan configure script
-
-    bmonscan add $scan_variable $scan_start $scan_increment
-    bmonscan setchannel $channel;
-    set status [catch {bmonscan run $NP $mode $preset} msg]
-#    bmonscan configure soft
-    if {$status == 0} {
-      return $msg
-    } else {
-      return -code error "ERROR [info level 0]"
-    }
-
-
-}
-::scan::hdb_bmonscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status
-::scan::hdb_bmonscan -set feedback status IDLE
- 
-
-
-command hdb_hmscan { text:drivable scan_variable float: scan_start float: scan_increment int: NP text:monitor,timer mode float: preset int:0,2 channel} { 
-
-    hmscan clear
-
-    hmscan add $scan_variable $scan_start $scan_increment
-    hmscan setchannel $channel;
-    set status [catch {hmscan run $NP $mode $preset} msg]
-
-    if {$status == 0} {
-      return $msg
-    } else {
-      return -code error "ERROR [info level 0]"
-    }
-
-
-}
-::scan::hdb_hmscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status
-::scan::hdb_hmscan -set feedback status IDLE
-}
-sicslist setatt ::scan::hdb_bmonscan long_name bmonscan
-sicslist setatt ::scan::hdb_hmscan long_name hmscan
 namespace eval scan {
   namespace export runscan
   VarMake ::scan::runscan_reset_position Text internal

site_ansto/instrument/deploySICS.sh

@@ -1,8 +1,8 @@
 #!/bin/sh 
-# $Revision: 1.26 $
+# $Revision: 1.27 $
-# $Date: 2008-05-29 04:57:42 $
+# $Date: 2008-05-30 00:26:54 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
-# Last revision by $Author: dcl $
+# Last revision by $Author: ffr $
 
 # Deploys SICServer and configuration files to
 # an instrument control computer.
@@ -187,7 +187,7 @@ INSTSPEC=$(for f in $(cat $INSTSRC/MANIFEST.TXT); do echo -n "$INSTSRC/$f "; don
 SCRIPT_VALIDATOR=$(for f in $(cat $INSTSRC/script_validator/MANIFEST.TXT); do echo -n "$INSTSRC/script_validator/$f "; done)
 
 # Create Instrument Control Server directories and copy SICS configs to the 'server' directory
-mkdir -p $TEMPDIR/$DESTDIR/{batch,server,data,log,tmp}
+mkdir -p $TEMPDIR/$DESTDIR/{batch,server,log,tmp}
 copy_server_config server
 cp -a --preserve=timestamps ../SICServer $TEMPDIR/$DESTDIR/server
 

site_ansto/instrument/hipd/DMC2280/controller1.txt

@@ -1,10 +1,11 @@
 ' WOMBAT - CONTROLLER 1
 '
-' $Revision: 1.10 $
+' $Revision: 1.11 $
-' $Date: 2008-04-13 23:50:38 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:55 $
 ' Author: Dan Bartlett
 ' Airpad control added by Doug Clowes
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-MONOCHROMATOR UPPER TILT
 ' B-MONOCHROMATOR LOWER TILT

site_ansto/instrument/hipd/DMC2280/controller2.txt

@@ -1,10 +1,11 @@
 ' WOMBAT - CONTROLLER 2
 '
-' $Revision: 1.6 $
+' $Revision: 1.7 $
-' $Date: 2008-03-07 05:12:47 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:55 $
 ' Author: Dan Bartlett
 ' Airpad control added by Doug Clowes
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-SAMPLE UPPER TILT
 ' B-SAMPLE LOWER TILT

site_ansto/instrument/hipd/DMC2280/controller3.txt

@@ -1,10 +1,11 @@
 ' WOMBAT - CONTROLLER 3
 '
-' $Revision: 1.4 $
+' $Revision: 1.5 $
-' $Date: 2008-03-07 05:12:47 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:55 $
 ' Author: Dan Bartlett
 ' Limit switch HOME routine added by Ferdi Franceschini
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-MONOCHROMATOR FOCUS
 ' B-MONOCHROMATOR FOCUS

site_ansto/instrument/hipd/DMC2280/controller4.txt

@@ -1,10 +1,11 @@
 ' WOMBAT - CONTROLLER 4
 '
-' $Revision: 1.3 $
+' $Revision: 1.4 $
-' $Date: 2008-03-07 05:12:47 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:55 $
 ' Author: Dan Bartlett
 ' Limit switch HOME routine added by Ferdi Franceschini
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-SPARE
 ' B-SPARE

site_ansto/instrument/hipd/MANIFEST.TXT

@@ -1,4 +1,6 @@
 sics_ports.tcl
+script_validator_ports.tcl
+instrument_vars.tcl
 wombat_configuration.tcl
 config
 util

site_ansto/instrument/hipd/config/INSTCFCOMMON.TXT

@@ -1,5 +1,7 @@
+config/anticollider/anticollider_common.tcl
 config/plc/plc_common_1.tcl
 config/counter/counter_common_1.tcl
+config/environment/temperature/lakeshore340_common.tcl
 config/hipadaba/hipadaba_configuration_common.tcl
 config/hipadaba/common_instrument_dictionary.tcl
 config/hipadaba/instdict_specification.tcl
@@ -9,3 +11,4 @@ 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

site_ansto/instrument/hipd/config/anticollider/acscript.txt

@@ -0,0 +1,16 @@
+# This script is loaded automatically by anticollider.tcl when SICS is launched
+# TODO Allow sequencing
+# TODO Allow functional dependencies
+#
+# Examples
+# for pcx forbid { {80 130} {10 20} }
+# when stth in { {0 10} {20 30} } forbid { {10 20} {90 100} } for mtth
+#
+## The next example forbids movement when both schi and sx are in the given ranges
+# forbid {0 10} for sphi whenall {schi in {10 15} sx {10 11} }
+
+
+for stth forbid {20 30} when mtth in {44 45}
+for stth forbid {-120 -100} when mtth in {99 100}
+for mtth forbid {90 100} when stth in {-120 -119}
+for mtth forbid {45 55} when stth in {29 30}

site_ansto/instrument/hipd/config/anticollider/anticollider.tcl

@@ -0,0 +1,7 @@
+# $Revision: 1.2 $
+# $Date: 2008-05-30 00:26:55 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by: $Author: ffr $
+
+source $cfPath(anticollider)/anticollider_common.tcl 
+::anticollider::loadscript acscript.txt

site_ansto/instrument/hipd/config/commands/commands.tcl

@@ -0,0 +1 @@
+source $cfPath(commands)/commands_common.tcl

site_ansto/instrument/hipd/config/environment/temperature/lakeshore340.tcl

@@ -0,0 +1,24 @@
+source $cfPath(environment)/temperature/lakeshore340_common.tcl
+
+# @brief Adds a lakeshore 340 temperature controller object.
+#
+# This must be called when the instrument configuration is loaded and before\n
+# the buildHDB function is called.  Currently there is no way to add and remove\n
+# environment controllers and their hdb paths at runtime.
+proc ::environment::temperature::add_ls340 {} {
+  set sim_mode [SplitReply [environment_simulation]]
+  if {$sim_mode == "true"} {
+    ::environment::temperature::mkls340sim tc1
+  } else {
+    ::environment::temperature::mkls340 tc1
+    tc1 tolerance 1
+    tc1 Settle 30
+    tc1 range 2
+    tc1 UpperLimit 500
+    tc1 LowerLimit 4
+  }
+
+  sicslist setatt tc1 environment_name tempone 
+  sicslist setatt tc1 long_name control_sensor_reading
+  ::environment::mkenvinfo tc1 {heateron {priv user} range {priv manager} }
+}

site_ansto/instrument/hipd/config/hmm/hmm_configuration.tcl

@@ -2,51 +2,119 @@ source $cfPath(hmm)/hmm_configuration_common_1.tcl
 source $cfPath(hmm)/hmm_cylindrical_detector_configuration.tcl
 set sim_mode [SplitReply [hmm_simulation]]
 
-##\brief Return the detector position
+proc ::histogram_memory::init_OAT_TABLE {} {
+  if [ catch {
+    # We don't need a MAX_CHAN parameter for time because the time channel 
+    # is scaled by calling the ::histogram_memory::clock_scale function
+      OAT_TABLE X -setdata MAX_CHAN 3872
+      OAT_TABLE X -setdata MAX_CHAN_PERSEG 992
+      OAT_TABLE Y -setdata MAX_CHAN 512
+      OAT_TABLE X -setdata ALLOWED_RESOLUTIONS {1 2 4 8 16 32}
+      OAT_TABLE X -setdata BMIN -0.5
+      OAT_TABLE X -setdata BMAX 991.5
+      OAT_TABLE Y -setdata BMIN -0.5
+      OAT_TABLE Y -setdata BMAX 511.5
+
+    # x bin range 0, 3871
+    # y bin range 0, 511
+      FAT_TABLE -set MULTI_HOST_HISTO_STITCH_OVERLAP 32
+      OAT_TABLE -set X { 991.5 990.5 } NXC 992 Y { 511.5 510.5 } NYC 512 T { 0 2000 } NTC 1
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
+}
+
+##
+# @brief Returns the oat table bin boundaries.
+proc ::histogram_memory::oat_bins {axis} {
+  array set channID {X NXC Y NYC T NTC}
+  if [ catch {
+    if {$axis == "X"} {
+      foreach {bb0 bb1} [OAT_TABLE -get $axis] {}
+      set bstep [expr $bb1 - $bb0]
+      if {$bstep < 0} {
+      set nch_perseg [OAT_TABLE -get $channID($axis)]
+      set overlap [FAT_TABLE -get MULTI_HOST_HISTO_STITCH_OVERLAP]
+      set bb0 [expr 4*$nch_perseg - 3*$overlap + $bstep/2.0]
+      set bb1 [expr $bb0+$bstep]
+        ###########
+#       set overlap [FAT_TABLE -get MULTI_HOST_HISTO_STITCH_OVERLAP]
+#       set bb0 [expr 4*$bb0 - 3*($overlap-1)]
+#       set bb1 [expr $bb0+$bstep]
+      } 
+      return [list $bb0 $bb1]
+    } else {
+      return [OAT_TABLE -get $axis]
+    }
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
+}
+##
+# @brief Returns the current number of channels for a given axis.
+proc ::histogram_memory::number_of_channels {axis} {
+  array set channID {X NXC Y NYC T NTC}
+  if [ catch { 
+    if {$axis == "X"} {
+      set nch_perseg [OAT_TABLE -get $channID($axis)]
+      set overlap [FAT_TABLE -get MULTI_HOST_HISTO_STITCH_OVERLAP]
+      set nch [expr 4*$nch_perseg - 3*$overlap]
+      return $nch
+    } else {
+      return [OAT_TABLE -get $channID($axis)]
+    }
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
+}
+
+##
+# @brief Return the detector position
 proc ::histogram_memory::detector_posn_degrees {} {
-  return [SplitReply [stth]]
+  if [ catch {
+    return [SplitReply [stth]]
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
 }
 proc ::histogram_memory::pre_count {} {}
 proc ::histogram_memory::post_count {} {}
 proc ::histogram_memory::initialize {} {
-  if {$::sim_mode == "true"} {
+  if [ catch {
-      hmm configure oat_ntc_eff 1
+    if {$::sim_mode == "true"} {
-      hmm configure oat_nyc_eff 512
+        hmm configure oat_ntc_eff 1
-      hmm configure oat_nxc_eff [expr 480*8 - 1]
+        hmm configure stitch_nyc 512
-  }
+        hmm configure stitch_nxc [expr 480*8 - 1]
-  ::histogram_memory::_initialize
+    }
-  ::histogram_memory::two_theta -boundaries
+    BAT_TABLE -init
+    CAT_TABLE -init
+    SAT_TABLE -init
+    OAT_TABLE -init
+    FAT_TABLE -init MULTI_HOST_HISTO_STITCH_OVERLAP
+    ::histogram_memory::_initialize
+    ::histogram_memory::two_theta -boundaries
 
-  detector_active_height_mm  200
+    detector_active_height_mm  200
-  detector_active_width_mm 500
+    detector_active_width_mm 500
-  detector_radius_mm 700.0
+    detector_radius_mm 700.0
-  set x_bb0 991.5; set xbbmax -0.5
-  set y_bb0 0; set ybbmax 511.5
-  hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
-  hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
-  hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
-  hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
-  set x_binwidth 1
-  if {[expr {$xbbmax - $x_bb0}] > 0} {
-    set x_bb1 [expr {$x_bb0+$x_binwidth}]
-  } else {
-    set x_bb1 [expr {$x_bb0-$x_binwidth}]
-  }
-  set y_binwidth 1
-  if {[expr {$ybbmax - $y_bb0}] > 0} {
-    set y_bb1 [expr {$y_bb0+$y_binwidth}]
-  } else {
-    set y_bb1 [expr {$y_bb0-$y_binwidth}]
-  }
-  OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax
-  # We default to one big bin for time
-  set t_bb0 [OAT_TABLE -get T_MIN]
-  set t_bb1 [OAT_TABLE -get T_MAX]
-  OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1"
-  ::histogram_memory::upload_config Filler_defaults
 
-  ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
+  # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
-  ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta
+  # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
+  # hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
+  # hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
+    ::histogram_memory::init_OAT_TABLE
+    ::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
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
 }
 
 proc histmem {cmd args} {

site_ansto/instrument/hipd/config/motors/motor_configuration.tcl

@@ -1,7 +1,8 @@
-# $Revision: 1.20 $
+# $Revision: 1.21 $
-# $Date: 2008-05-29 04:53:32 $
+# $Date: 2008-05-30 00:26:55 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
-# Last revision by: $Author: dcl $
+# Last revision by: $Author: ffr $
+source $cfPath(anticollider)/anticollider.tcl
 
 # START MOTOR CONFIGURATION
 
@@ -642,3 +643,4 @@ make_gap_motors ss2hg gap ss2ho offset ss2r ss2l mm $slit2HGroup
 proc motor_set_sobj_attributes {} {
 }
 # END MOTOR CONFIGURATION
+::anticollider::init

site_ansto/instrument/hipd/instrument_vars.tcl

@@ -0,0 +1,3 @@
+VarMake deg_per_rad Float Internal
+deg_per_rad 57.29577951308232
+deg_per_rad lock

site_ansto/instrument/hipd/script_validator_ports.tcl

@@ -0,0 +1,4 @@
+set quieckport quieck-val-wombat
+set serverport server-val-wombat
+set interruptport interrupt-val-wombat
+set telnetport telnet-val-wombat

site_ansto/instrument/hipd/wombat_configuration.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.19 $
+# $Revision: 1.20 $
-# $Date: 2007-11-07 04:57:40 $
+# $Date: 2008-05-30 00:26:55 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
 # Last revision by: $Author: ffr $
 
@@ -12,9 +12,6 @@ Instrument lock
 source util/dmc2280/dmc2280_util.tcl
 source sics_ports.tcl
 source server_config.tcl
-VarMake deg_per_rad Float Internal
-deg_per_rad 57.29577951308232
-deg_per_rad lock
 #END SERVER CONFIGURATION SECTION
 
 ########################################
@@ -22,61 +19,36 @@ deg_per_rad lock
 
 fileeval $cfPath(motors)/motor_configuration.tcl
 
-########
+source instrument_vars.tcl
-# Parameters set above the restore command will be clobbered by
-# the values in the status.tcl file
-restore
 
+source $cfPath(hipadaba)/hipadaba_configuration.tcl
 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(hmm)/hmm_configuration.tcl
 fileeval $cfPath(nexus)/nxscripts.tcl
 fileeval $cfPath(scan)/scan.tcl
-source $cfPath(hipadaba)/hipadaba_configuration.tcl
+fileeval $cfPath(commands)/commands.tcl
 source gumxml.tcl
 
+########
+# Parameters set above the restore command will be clobbered by
+# the values in the status.tcl file
+# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS
+# AN ERROR IF THERE IS NO ../log/status.tcl FILE.
+restore
+
 ::histogram_memory::initialize
+#::environment::temperature::add_ls340
 
 
-VarMake detector_layout Text Mugger
-detector_layout cylinder
-
-VarMake detector_angle_deg Float User
-detector_angle_deg 120.0
-VarMake detector_angle_rad Float User
-detector_angle_rad [expr [SplitReply [detector_angle_deg]]/[SplitReply [deg_per_rad]] ]
-
-VarMake crystal_type Text User
-VarMake crystal_wavelength_A Float User
-
-VarMake bmon_distance Float User
-
-## Number of last pixel on vertical axis
-VarMake detector_last_vert_pixel Float User
-detector_last_vert_pixel 511
-## Number of last pixel on horizontal axis
-VarMake detector_last_hor_pixel Float User
-detector_last_hor_pixel [expr 480 * 8 - 1]
-## Row number at beam centre
-VarMake detector_zero_row Float User
-detector_zero_row 255.5
-## Column number at beam centre for a detector rotation of 0 degrees
-VarMake detector_zero_col Float User
-detector_zero_col [SplitReply [detector_last_hor_pixel]]
-## Row offset for region of interest
-VarMake detector_ROI_row_offset Float User
-detector_ROI_row_offset 0
-## Column offset for region of interest
-VarMake detector_ROI_col_offset Float User
-detector_ROI_col_offset 0
-
-detector_type He-3 position sensitive detector
-detector_type lock
-
-detector_description 8 curved multiwire segments
-detector_description lock
-
 MakeStateMon hmscan
-fileeval extraconfig.tcl
+if [file exists extraconfig.tcl] {
+  fileeval extraconfig.tcl
+} else {
+  clientput "extraconfig.tcl not found. continueing"
+}
+
 server_set_sobj_attributes
 buildHDB instrument_dictionary

site_ansto/instrument/hrpd/DMC2280/controller1.txt

@@ -1,10 +1,11 @@
 ' ECHIDNA - CONTROLLER 1
 '
-' $Revision: 1.8 $
+' $Revision: 1.9 $
-' $Date: 2008-04-13 23:50:38 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:55 $
 ' Author: Dan Bartlett
 ' Airpad control added by Doug Clowes
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-MONOCHROMATOR UPPER TILT (mphi) - TILT 1
 ' B-MONOCHROMATOR LOWER TILT (mchi) - TILT 2

site_ansto/instrument/hrpd/DMC2280/controller2.txt

@@ -1,10 +1,11 @@
 ' ECHIDNA - CONTROLLER 2
 '
-' $Revision: 1.6 $
+' $Revision: 1.7 $
-' $Date: 2008-04-13 23:50:38 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:55 $
 ' Author: Dan Bartlett
 ' Airpad control added by Doug Clowes
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-SAMPLE UPPER TILT (sphi) - TILT 1
 ' B-SAMPLE LOWER TILT (schi) - TILT 2

site_ansto/instrument/hrpd/DMC2280/controller3.txt

@@ -1,10 +1,11 @@
 ' ECHIDNA - CONTROLLER 3
 '
-' $Revision: 1.10 $
+' $Revision: 1.11 $
-' $Date: 2008-05-08 06:48:32 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:55 $
 ' Author: Dan Bartlett
 ' Limit switch HOME routine added by Ferdi Franceschini
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-MONOCHROMATOR FOCUS
 ' B-SPARE

site_ansto/instrument/hrpd/DMC2280/controller4.txt

@@ -1,10 +1,11 @@
 ' ECHIDNA - CONTROLLER 4
 '
-' $Revision: 1.10 $
+' $Revision: 1.11 $
-' $Date: 2008-04-30 01:56:22 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:55 $
 ' Author: Dan Bartlett
 ' Limit switch HOME routine added by Ferdi Franceschini
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-SPARE
 ' B-SPARE

site_ansto/instrument/hrpd/MANIFEST.TXT

@@ -1,4 +1,6 @@
 sics_ports.tcl
+script_validator_ports.tcl
+instrument_vars.tcl
 echidna_configuration.tcl
 config
 util

site_ansto/instrument/hrpd/config/INSTCFCOMMON.TXT

@@ -1,5 +1,7 @@
+config/anticollider/anticollider_common.tcl
 config/plc/plc_common_1.tcl
 config/counter/counter_common_1.tcl
+config/environment/temperature/lakeshore340_common.tcl
 config/hipadaba/hipadaba_configuration_common.tcl
 config/hipadaba/common_instrument_dictionary.tcl
 config/hipadaba/instdict_specification.tcl
@@ -9,3 +11,4 @@ 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

site_ansto/instrument/hrpd/config/anticollider/acscript.txt

@@ -0,0 +1,18 @@
+# This script is loaded automatically by anticollider.tcl when SICS is launched
+# TODO Allow sequencing
+# TODO Allow functional dependencies
+#
+# Examples
+# for pcx forbid { {80 130} {10 20} }
+# when stth in { {0 10} {20 30} } forbid { {10 20} {90 100} } for mtth
+#
+## The next example forbids movement when both schi and sx are in the given ranges
+# forbid {0 10} for sphi whenall {schi in {10 15} sx {10 11} }
+
+
+for pcx forbid {80 130}
+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}
+for mtth forbid {87 100} when stth in {166 167}
+for mtth forbid {130 140.5} when stth in {0 1}

site_ansto/instrument/hrpd/config/anticollider/anticollider.tcl

@@ -0,0 +1,8 @@
+
+# $Revision: 1.2 $
+# $Date: 2008-05-30 00:26:56 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by: $Author: ffr $
+
+source $cfPath(anticollider)/anticollider_common.tcl 
+::anticollider::loadscript acscript.txt

site_ansto/instrument/hrpd/config/commands/commands.tcl

@@ -0,0 +1 @@
+source $cfPath(commands)/commands_common.tcl

site_ansto/instrument/hrpd/config/environment/temperature/lakeshore340.tcl

@@ -0,0 +1,24 @@
+source $cfPath(environment)/temperature/lakeshore340_common.tcl
+
+# @brief Adds a lakeshore 340 temperature controller object.
+#
+# This must be called when the instrument configuration is loaded and before\n
+# the buildHDB function is called.  Currently there is no way to add and remove\n
+# environment controllers and their hdb paths at runtime.
+proc ::environment::temperature::add_ls340 {} {
+  set sim_mode [SplitReply [environment_simulation]]
+  if {$sim_mode == "true"} {
+    ::environment::temperature::mkls340sim tc1
+  } else {
+    ::environment::temperature::mkls340 tc1
+    tc1 tolerance 1
+    tc1 Settle 30
+    tc1 range 2
+    tc1 UpperLimit 500
+    tc1 LowerLimit 4
+  }
+
+  sicslist setatt tc1 environment_name tempone 
+  sicslist setatt tc1 long_name control_sensor_reading
+  ::environment::mkenvinfo tc1 {heateron {priv user} range {priv manager} }
+}

site_ansto/instrument/hrpd/config/hmm/hmm_configuration.tcl

@@ -2,51 +2,63 @@ source $cfPath(hmm)/hmm_configuration_common_1.tcl
 source $cfPath(hmm)/hmm_cylindrical_detector_configuration.tcl
 set sim_mode [SplitReply [hmm_simulation]]
 
-##\brief Return the detector position
+proc ::histogram_memory::init_OAT_TABLE {} {
+  if [ catch {
+  # We don't need a MAX_CHAN parameter for time because the time channel 
+  # is scaled by calling the ::histogram_memory::clock_scale function
+    OAT_TABLE X -setdata MAX_CHAN 128
+    OAT_TABLE Y -setdata MAX_CHAN 512
+    OAT_TABLE X -setdata BMIN -0.5
+    OAT_TABLE X -setdata BMAX  127.5
+    OAT_TABLE Y -setdata BMIN -0.5
+    OAT_TABLE Y -setdata BMAX  511.5
+
+    OAT_TABLE -set X { 127.5 126.5 } NXC 128 Y { -0.5 0.5 } NYC 512 T { 0 2000 } NTC 1 
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
+}
+
+##
+# @brief Return the detector position
 proc ::histogram_memory::detector_posn_degrees {} {
   return [SplitReply [stth]]
 }
 proc ::histogram_memory::pre_count {} {}
 proc ::histogram_memory::post_count {} {}
 proc ::histogram_memory::initialize {} {
-  if {$::sim_mode == "true"} {
+  if [ catch {
-      hmm configure oat_ntc_eff 1
+    if {$::sim_mode == "true"} {
-      hmm configure oat_nyc_eff 1024
+        hmm configure oat_ntc_eff 1
-      hmm configure oat_nxc_eff 64
+        hmm configure oat_nyc_eff 1024
-  }
+        hmm configure oat_nxc_eff 64
-  ::histogram_memory::_initialize
+    }
-  ::histogram_memory::two_theta -boundaries
+    BAT_TABLE -init
+    CAT_TABLE -init
+    SAT_TABLE -init
+    OAT_TABLE -init
+    FAT_TABLE -init
+    ::histogram_memory::_initialize
+    ::histogram_memory::two_theta -boundaries
 
-  detector_active_height_mm 335
+    detector_active_height_mm 335
-  detector_active_width_mm 500
+    detector_active_width_mm 500
-  detector_radius_mm 1250.0
+    detector_radius_mm 1250.0
-  set x_bb0 -0.5; set xbbmax 63.5
-  set y_bb0 -0.5; set ybbmax 1023.5
-  hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
-  hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
-  hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
-  hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
-  set x_binwidth 1
-  if {[expr {$xbbmax - $x_bb0}] > 0} {
-    set x_bb1 [expr {$x_bb0+$x_binwidth}]
-  } else {
-    set x_bb1 [expr {$x_bb0-$x_binwidth}]
-  }
-  set y_binwidth 1
-  if {[expr {$ybbmax - $y_bb0}] > 0} {
-    set y_bb1 [expr {$y_bb0+$y_binwidth}]
-  } else {
-    set y_bb1 [expr {$y_bb0-$y_binwidth}]
-  }
-  OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax
-  # We default to one big bin for time
-  set t_bb0 [OAT_TABLE -get T_MIN]
-  set t_bb1 [OAT_TABLE -get T_MAX]
-  OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1"
-  ::histogram_memory::upload_config Filler_defaults
 
-  ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
+  # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
-  ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta
+  # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
+  # hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
+  # hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
+    ::histogram_memory::init_OAT_TABLE
+    ::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
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
 }
 
 proc histmem {cmd args} {

site_ansto/instrument/hrpd/config/motors/motor_configuration.tcl

@@ -1,7 +1,8 @@
-# $Revision: 1.23 $
+# $Revision: 1.24 $
-# $Date: 2008-05-29 04:54:06 $
+# $Date: 2008-05-30 00:26:56 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
-# Last revision by: $Author: dcl $
+# Last revision by: $Author: ffr $
+source $cfPath(anticollider)/anticollider.tcl
 
 # START MOTOR CONFIGURATION
 
@@ -256,7 +257,6 @@ mtth blockage_ratio 5
 mtth backlash_offset -1
 mtth creep_offset 90
 mtth creep_precision 0.02
-#mtth debug 1
 
 mtth part crystal
 mtth long_name takeoff_angle
@@ -445,7 +445,6 @@ stth blockage_ratio 1.5
 stth backlash_offset -0.1
 stth creep_offset 0.1
 stth creep_precision 0.00002
-stth debug 1
 
 stth part sample
 stth long_name azimuthal_angle
@@ -695,3 +694,4 @@ make_gap_motors ss2hg gap ss2ho offset ss2r ss2l mm $slit2HGroup
 proc motor_set_sobj_attributes {} {
 }
 # END MOTOR CONFIGURATION
+::anticollider::init

site_ansto/instrument/hrpd/echidna_configuration.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.26 $
+# $Revision: 1.27 $
-# $Date: 2007-11-05 02:28:46 $
+# $Date: 2008-05-30 00:26:55 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
 # Last revision by: $Author: ffr $
 
@@ -12,9 +12,6 @@ Instrument lock
 source util/dmc2280/dmc2280_util.tcl
 source sics_ports.tcl
 source server_config.tcl
-VarMake deg_per_rad Float Internal
-deg_per_rad 57.29577951308232
-deg_per_rad lock
 #END SERVER CONFIGURATION SECTION
 
 ########################################
@@ -22,61 +19,36 @@ deg_per_rad lock
 
 fileeval $cfPath(motors)/motor_configuration.tcl
 
-########
+source instrument_vars.tcl
-# Parameters set above the restore command will be clobbered by
-# the values in the status.tcl file
-restore
 
+source $cfPath(hipadaba)/hipadaba_configuration.tcl
 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(hmm)/hmm_configuration.tcl
 fileeval $cfPath(nexus)/nxscripts.tcl
 fileeval $cfPath(scan)/scan.tcl
-source $cfPath(hipadaba)/hipadaba_configuration.tcl
+fileeval $cfPath(commands)/commands.tcl
 source gumxml.tcl
 
+########
+# Parameters set above the restore command will be clobbered by
+# the values in the status.tcl file
+# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS
+# AN ERROR IF THERE IS NO ../log/status.tcl FILE.
+restore
+
 ::histogram_memory::initialize
+#::environment::temperature::add_ls340
 
 
-VarMake detector_layout Text Mugger
-detector_layout cylinder
-
-VarMake detector_angle_deg Float User
-detector_angle_deg 158.75
-VarMake detector_angle_rad Float User
-detector_angle_rad [expr [SplitReply [detector_angle_deg]]/[SplitReply [deg_per_rad]] ]
-
-VarMake crystal_type Text User
-VarMake crystal_wavelength_A Float User
-
-VarMake bmon_distance Float User
-
-## Number of last pixel on vertical axis
-VarMake detector_last_vert_pixel Float User
-detector_last_vert_pixel 511
-## Number of last pixel on horizontal axis
-VarMake detector_last_hor_pixel Float User
-detector_last_hor_pixel 127
-## Row number at beam centre
-VarMake detector_zero_row Float User
-detector_zero_row 255.5
-## Column number at beam centre for a detector rotation of 0 degrees
-VarMake detector_zero_col Float User
-detector_zero_col 124
-## Row offset for region of interest
-VarMake detector_ROI_row_offset Float User
-detector_ROI_row_offset 0
-## Column offset for region of interest
-VarMake detector_ROI_col_offset Float User
-detector_ROI_col_offset 0
-
-detector_type He-3 position sensitive detector, tube active length=335+/-5mm, tube diameter=25.4 +/- 0.8mm
-detector_type lock
-
-detector_description 128 He-3 proportional counter detector tubes (GE Energy Reuter Stokes Inc. item=RS-P4-0814-217)
-detector_description lock
-
 MakeStateMon hmscan
-fileeval extraconfig.tcl
+if [file exists extraconfig.tcl] {
+  fileeval extraconfig.tcl
+} else {
+  clientput "extraconfig.tcl not found. continueing"
+}
+
 server_set_sobj_attributes
 buildHDB instrument_dictionary

site_ansto/instrument/hrpd/extraconfig.tcl

@@ -1,70 +1,6 @@
-# Put extra config info here.
+# @file Put extra configuration info here.
-# Just some examples for now
+#
-bmon_distance -1.0
+# NOTE TO DEVELOPERS,\n
-Title "precommissioning tests"
+# Do not put this file name in the MANIFEST.TXT, it should not be automatically\n
-Sample "No Sample"
+# deployed to an instrument.
-# Selected wavelength in Angstroms
-crystal_wavelength_A "0.0"
-crystal_type "Unknown"
-## LAKESHORE
 
-#source util/dmc2280/dmc2280_util.tcl
-#First Lakshore340 tempcontroller creation
-MakeRS232Controller sertemp1 127.0.0.1 4001
-sertemp1 timeout 20000
-sertemp1 sendterminator 0xd
-sertemp1 replyterminator 0xd
-EvFactory new tc1 lakeshore340 sertemp1 1 1
-tc1 tolerance 0.2
-tc1 UpperLimit 500
-tc1 LowerLimit 4
-tc1 sensor 3
-tc1 control 3
-#Second Lakshore340 tempcontroller creation
-MakeRS232Controller sertemp2 127.0.0.1 4002
-sertemp2 timeout 20000
-sertemp2 sendterminator 0xd
-sertemp2 replyterminator 0xd
-EvFactory new tc2 lakeshore340 sertemp2 1 1
-tc2 tolerance 0.2
-tc2 UpperLimit 500
-tc2 LowerLimit 4
-tc2 sensor 3
-tc2 control 3
-#First Julabo tempcontroller creation
-MakeRS232Controller sertemp3 127.0.0.1 4003
-sertemp3 timeout 20000
-sertemp3 sendterminator 0xd 0xa
-sertemp3 replyterminator 0xd
-EvFactory new tc3 lh45 sertemp3 1 1
-tc3 tolerance 0.5
-tc3 UpperLimit 110
-tc3 LowerLimit -30
-#Second Julabo tempcontroller creation
-MakeRS232Controller sertemp4 127.0.0.1 4004
-sertemp4 timeout 20000
-sertemp4 sendterminator 0xd 0xa
-sertemp4 replyterminator 0xd
-EvFactory new tc4 lh45 sertemp4 1 1
-tc4 tolerance 0.5
-tc4 UpperLimit 110
-tc4 LowerLimit -30
-
-sicslist setatt tc1 long_name tempone
-sicslist setatt tc2 long_name temptwo
-sicslist setatt tc3 long_name tempthree
-sicslist setatt tc4 long_name tempfour
-#END SERVER CONFIGURATION SECTION
-
-sicslist setatt tc1 units kelvin
-sicslist setatt tc2 units kelvin
-sicslist setatt tc3 units Celsius
-sicslist setatt tc4 units Celsius
-sicslist setatt tc1 savecmd ::nexus::evcontroller::save
-sicslist setatt tc1 sdsinfo ::nexus::evcontroller::sdsinfo
-sicslist setatt tc2 savecmd ::nexus::evcontroller::save
-sicslist setatt tc2 sdsinfo ::nexus::evcontroller::sdsinfo
-sicslist setatt tc3 savecmd ::nexus::evcontroller::save
-sicslist setatt tc3 sdsinfo ::nexus::evcontroller::sdsinfo
-sicslist setatt tc4 savecmd ::nexus::evcontroller::save
-sicslist setatt tc4 sdsinfo ::nexus::evcontroller::sdsinfo

site_ansto/instrument/hrpd/instrument_vars.tcl

@@ -0,0 +1,9 @@
+# @file This file defines the instrument variables.
+
+VarMake deg_per_rad Float Internal
+deg_per_rad 57.29577951308232
+deg_per_rad lock
+
+
+
+

site_ansto/instrument/hrpd/script_validator_ports.tcl

@@ -0,0 +1,4 @@
+set quieckport quieck-val-echidna
+set serverport server-val-echidna
+set interruptport interrupt-val-echidna
+set telnetport telnet-val-echidna

site_ansto/instrument/reflectometer/DMC2280/controller1.txt

@@ -1,9 +1,10 @@
 ' PLATYPUS - CONTROLLER 1
 '
-' $Revision: 1.11 $
+' $Revision: 1.12 $
-' $Date: 2008-04-30 01:57:55 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:56 $
 ' Author: Dan Bartlett
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-BEAM SHADE RAISE
 ' B-COLLIMATOR TRANSLATE A=7350364, B=6529772, C=6941582

site_ansto/instrument/reflectometer/DMC2280/controller2.txt

@@ -1,9 +1,10 @@
 ' PLATYPUS - CONTROLLER 2
 '
-' $Revision: 1.6 $
+' $Revision: 1.7 $
-' $Date: 2008-04-30 01:57:55 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:56 $
 ' Author: Dan Bartlett
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-SAMPLE TILT 1
 ' B-SAMPLE TILT 2

site_ansto/instrument/reflectometer/DMC2280/controller3.txt

@@ -1,9 +1,10 @@
 ' PLATYPUS - CONTROLLER 3
 '
-' $Revision: 1.6 $
+' $Revision: 1.7 $
-' $Date: 2008-04-30 01:57:55 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:56 $
 ' Author: Dan Bartlett
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-SLIT S1 WEST BLADE
 ' B-SLIT S1 EAST BLADE

site_ansto/instrument/reflectometer/DMC2280/controller4.txt

@@ -1,9 +1,10 @@
 ' PLATYPUS - CONTROLLER 4
 '
-' $Revision: 1.6 $
+' $Revision: 1.7 $
-' $Date: 2008-04-30 01:57:55 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:56 $
 ' Author: Dan Bartlett
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-SLIT S3 BOTTOM BLADE
 ' B-SLIT S3 TOP BLADE

site_ansto/instrument/reflectometer/MANIFEST.TXT

@@ -1,4 +1,6 @@
 platypus_configuration.tcl
 sics_ports.tcl
+script_validator_ports.tcl
+extraconfig.tcl
 config
 util

site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT

@@ -1,3 +1,4 @@
+config/anticollider/anticollider_common.tcl
 config/plc/plc_common_1.tcl
 config/counter/counter_common_1.tcl
 config/hipadaba/hipadaba_configuration_common.tcl
@@ -8,3 +9,4 @@ 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

site_ansto/instrument/reflectometer/config/anticollider/acscript.txt

@@ -0,0 +1,3 @@
+# Forbid detector motion when the detector voltage is on
+forbid {-inf inf} for dy when dhv1 in {20 inf}
+forbid {-inf inf} for dz when dhv1 in {20 inf}

site_ansto/instrument/reflectometer/config/anticollider/anticollider.tcl

@@ -0,0 +1,8 @@
+
+# $Revision: 1.2 $
+# $Date: 2008-05-30 00:26:56 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by: $Author: ffr $
+
+source $cfPath(anticollider)/anticollider_common.tcl 
+::anticollider::loadscript acscript.txt

site_ansto/instrument/reflectometer/config/commands/commands.tcl

@@ -0,0 +1 @@
+source $cfPath(commands)/commands_common.tcl

site_ansto/instrument/reflectometer/config/hipadaba/hipadaba_configuration.tcl

@@ -1 +1,10 @@
 source $cfPath(hipadaba)/hipadaba_configuration_common.tcl
+set sobj_klass_list [concat $sobj_klass_list junk]
+set instrument_dictionary [concat $instrument_dictionary {
+  junk {
+    sobj {@any junk}
+    privilege spy
+    datatype @none
+    property {data true control true nxsave true klass NXnote type part}
+  }
+} ]

site_ansto/instrument/reflectometer/config/hmm/detector.tcl

@@ -0,0 +1,18 @@
+# Detector voltage controller
+
+set sim_mode [SplitReply [detector_simulation]]
+
+if {$::sim_mode == "true"} {
+  EvFactory new dhv1 sim
+} else {
+clientput "Detector Voltage control not yet available"
+# makeasyncqueue acq NHQ200 xxxxxxxxxxxxxx yyyy
+# evfactory new dhv1 nhqvps acq
+# dhv1 lowerlimit xxx
+# dhv1 upperlimit xxx
+# dhv1 tolerance xxx
+# dhv1 max xxx
+# dhv1 rate xxx
+# dhv1 lock
+}
+

site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl

@@ -1,46 +1,55 @@
 source $cfPath(hmm)/hmm_configuration_common_1.tcl
 set sim_mode [SplitReply [hmm_simulation]]
 
+proc ::histogram_memory::init_OAT_TABLE {} {
+  if [ catch {
+  # We don't need a MAX_CHAN parameter for time because the time channel 
+  # is scaled by calling the ::histogram_memory::clock_scale function
+    OAT_TABLE X -setdata MAX_CHAN 421
+    OAT_TABLE Y -setdata MAX_CHAN 221
+    OAT_TABLE X -setdata BMIN -210.5
+    OAT_TABLE X -setdata BMAX  210.5
+    OAT_TABLE Y -setdata BMIN -110.5
+    OAT_TABLE Y -setdata BMAX  110.5
+
+      OAT_TABLE -set X { -210.5 -209.5 } NXC 421 Y { -110.5 -109.5 } NYC 221 T { 0 2000 } 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::initialize {} {
-  if {$::sim_mode == "true"} {
+  if [ catch {
-      hmm configure oat_ntc_eff 1
+    if {$::sim_mode == "true"} {
-      hmm configure oat_nyc_eff 210
+        hmm configure oat_ntc_eff 1
-      hmm configure oat_nxc_eff 210
+        hmm configure oat_nyc_eff 210
-  }
+        hmm configure oat_nxc_eff 210
-  ::histogram_memory::_initialize
+    }
+    BAT_TABLE -init
+    CAT_TABLE -init
+    SAT_TABLE -init
+    OAT_TABLE -init
+    FAT_TABLE -init
+    ::histogram_memory::_initialize
 
-  detector_active_height_mm  257.5
+    detector_active_height_mm  257.5
-  detector_active_width_mm 500
+    detector_active_width_mm 500
 
-  set x_bb0 -210.5; set xbbmax 210.5
+  # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
-  set y_bb0 -110.5; set ybbmax 110.5
+  # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
-  hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
+  # hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
-  hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
+  # hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
-  hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
+    ::histogram_memory::init_OAT_TABLE
-  hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
+    ::histogram_memory::upload_config Filler_defaults
-  set x_binwidth 1
-  if {[expr {$xbbmax - $x_bb0}] > 0} {
-    set x_bb1 [expr {$x_bb0+$x_binwidth}]
-  } else {
-    set x_bb1 [expr {$x_bb0-$x_binwidth}]
-  }
-  set y_binwidth 1
-  if {[expr {$ybbmax - $y_bb0}] > 0} {
-    set y_bb1 [expr {$y_bb0+$y_binwidth}]
-  } else {
-    set y_bb1 [expr {$y_bb0-$y_binwidth}]
-  }
-  OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax
-  # We default to one big bin for time
-  set t_bb0 [OAT_TABLE -get T_MIN]
-  set t_bb1 [OAT_TABLE -get T_MAX]
-  OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1"
-  ::histogram_memory::upload_config Filler_defaults
 
-  ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_bin
+    ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_bin
-  ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_bin
+    ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_bin
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
+  }
 }
 
 ##
@@ -50,8 +59,9 @@ proc ::histogram_memory::tochfreq {} {
     ::chopper::ready?
     set chfreq [::chopper::get_frequency]
     ::histogram_memory::set_frame_freq $chfreq EXTERNAL
-  } errmsg ] {
+  } message ] {
-    return -code error $errmsg
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
   }
 }
 
@@ -71,11 +81,13 @@ proc histmem {cmd args} {
         ::histogram_memory::tochfreq
       }
       default {
-        eval "_histmem $cmd $args"
+        set reply [eval "_histmem $cmd $args"]
       }
     }
-  } errmsg ] {
+    return $reply
-    return -code error $errmsg
+  } message ] {
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
   }
 }
 publish histmem user

site_ansto/instrument/reflectometer/config/parameters/parameters.tcl

@@ -0,0 +1,28 @@
+##
+# @brief Instrument parameters
+# TODO There should be an NXgeometry entry for each distance, and linked to an NXgeometry
+# entry for the chopper [SICS-108]. We put them in a junk entry for now to avoid holding up 
+# testing and development.
+foreach vn {
+  detector_distance
+  detector_base
+  slit4_distance
+  slit4_base
+  sample_distance
+  sample_base
+  slit3_distance
+  slit3_base
+} {
+  ::utility::mkVar $vn float manager $vn true junk true true
+}
+
+detector_distance 10000
+detector_base 300
+slit4_distance 6000
+slit4_base 20
+sample_distance 5800
+sample_base 50
+slit3_distance 5600
+slit3_base 20
+
+

site_ansto/instrument/reflectometer/platypus_configuration.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.14 $
+# $Revision: 1.15 $
-# $Date: 2007-10-31 06:07:10 $
+# $Date: 2008-05-30 00:26:56 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
 # Last revision by: $Author: ffr $
 
@@ -17,25 +17,37 @@ source server_config.tcl
 ########################################
 # INSTRUMENT SPECIFIC CONFIGURATION
 
+source $cfPath(hipadaba)/hipadaba_configuration.tcl
+fileeval $cfPath(parameters)/parameters.tcl
 fileeval $cfPath(motors)/motor_configuration.tcl
+fileeval $cfPath(plc)/plc.tcl
+fileeval $cfPath(counter)/counter.tcl
+fileeval $cfPath(hmm)/hmm_configuration.tcl
+fileeval $cfPath(hmm)/detector.tcl
+fileeval $cfPath(nexus)/nxscripts.tcl
+fileeval $cfPath(scan)/scan.tcl
+fileeval $cfPath(chopper)/chopper.tcl
+fileeval $cfPath(commands)/commands.tcl
+fileeval $cfPath(anticollider)/anticollider.tcl
+source gumxml.tcl
+
 
 ########
 # Parameters set above the restore command will be clobbered by
 # the values in the status.tcl file
+# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS
+# AN ERROR IF THERE IS NO ../log/status.tcl FILE.
 restore
 
-fileeval $cfPath(plc)/plc.tcl
-fileeval $cfPath(counter)/counter.tcl
-fileeval $cfPath(hmm)/hmm_configuration.tcl
-fileeval $cfPath(nexus)/nxscripts.tcl
-fileeval $cfPath(scan)/scan.tcl
-fileeval $cfPath(chopper)/chopper.tcl
-source $cfPath(hipadaba)/hipadaba_configuration.tcl
-source gumxml.tcl
-
 ::histogram_memory::initialize
 
 MakeStateMon hmscan
-fileeval extraconfig.tcl
+if [file exists extraconfig.tcl] {
+  fileeval extraconfig.tcl
+} else {
+  clientput "extraconfig.tcl not found. continueing"
+}
+
+::anticollider::init
 server_set_sobj_attributes
 buildHDB instrument_dictionary

site_ansto/instrument/reflectometer/script_validator_ports.tcl

@@ -0,0 +1,4 @@
+set quieckport quieck-val-platypus
+set serverport server-val-platypus
+set interruptport interrupt-val-platypus
+set telnetport telnet-val-platypus

site_ansto/instrument/rsd/DMC2280/controller1.txt

@@ -1,10 +1,11 @@
 ' KOWARI - CONTROLLER 1
 '
-' $Revision: 1.6 $
+' $Revision: 1.7 $
-' $Date: 2008-04-14 00:28:07 $
+' $Name: not supported by cvs2svn $
+' $Date: 2008-05-30 00:26:56 $
 ' Author: Dan Bartlett
 ' Airpad control added by Doug Clowes
-' Last revision by: $Author: dcl $
+' Last revision by: $Author: ffr $
 '
 ' A-MONOCHROMATOR UPPER TILT
 ' B-MONOCHROMATOR LOWER TILT

site_ansto/instrument/rsd/DMC2280/controller2.txt

@@ -1,9 +1,10 @@
 NO TE: KOWARI - CONTROLLER 2
 NO TE: 
 NO TE: $Revision:
-NO TE: $Date: 2008-05-08 06:50:32 $
+NO TE: $Name: not supported by cvs2svn $
+NO TE: $Date: 2008-05-30 00:26:56 $
 NO TE: Author: Dan Bartlett
-NO TE: Last revision by: $Author: dcl $
+NO TE: Last revision by: $Author: ffr $
 NO TE:
 NO TE: GALIL 31 BIT FIRMWARE IS REQUIRED FOR THIS CODE
 NO TE: A-SAMPLE RAISE FIRST SECTION

site_ansto/instrument/rsd/DMC2280/controller3.txt

@@ -1,9 +1,10 @@
 NO TE: KOWARI - CONTROLLER 3
 NO TE:
-NO TE: $Revision: 1.3 $
+NO TE: $Revision: 1.4 $
-NO TE: $Date: 2008-05-08 06:50:04 $
+NO TE: $Name: not supported by cvs2svn $
+NO TE: $Date: 2008-05-30 00:26:56 $
 NO TE: Author: Dan Bartlett
-NO TE: Last revision by: $Author: dcl $
+NO TE: Last revision by: $Author: ffr $
 NO TE:
 NO TE: A-MONOCHROMATOR FOCUS 1
 NO TE: B-MONOCHROMATOR FOCUS 2

site_ansto/instrument/rsd/DMC2280/controller4.txt

@@ -1,9 +1,10 @@
 NO TE: KOWARI - CONTROLLER 4
 NO TE:
-NO TE: $Revision: 1.2 $
+NO TE: $Revision: 1.3 $
-NO TE: $Date: 2007-09-24 01:25:23 $
+NO TE: $Name: not supported by cvs2svn $
+NO TE: $Date: 2008-05-30 00:26:56 $
 NO TE: Author: Dan Bartlett
-NO TE: Last revision by: $Author: dbx $
+NO TE: Last revision by: $Author: ffr $
 NO TE:
 NO TE: A-PRE SAMPLE COLLIMATOR X (ACROSS BEAM)
 NO TE: B-PRE SAMPLE COLLIMATOR Y (ALONG BEAM)

site_ansto/instrument/rsd/MANIFEST.TXT

@@ -1,4 +1,5 @@
 sics_ports.tcl
+script_validator_ports.tcl
 kowari_configuration.tcl
 extraconfig.tcl
 config

site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT

@@ -1,3 +1,4 @@
+config/anticollider/anticollider_common.tcl
 config/plc/plc_common_1.tcl
 config/counter/counter_common_1.tcl
 config/hipadaba/hipadaba_configuration_common.tcl
@@ -8,3 +9,4 @@ 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

site_ansto/instrument/rsd/config/anticollider/acscript.txt

@@ -0,0 +1,10 @@
+# This script is loaded automatically by anticollider.tcl when SICS is launched
+# TODO Allow sequencing
+# TODO Allow functional dependencies
+#
+# Examples
+# for mphi forbid {-inf inf} when mchi in {{85 87} {93 95}}
+# when stth in { {0 10} {20 30} } forbid { {10 20} {90 100} } for mtth
+#
+## The next example forbids movement when both schi and sx are in the given ranges
+# forbid {0 10} for sphi whenall {schi in {10 15} sx {10 11} }

site_ansto/instrument/rsd/config/anticollider/anticollider.tcl

@@ -0,0 +1,8 @@
+
+# $Revision: 1.2 $
+# $Date: 2008-05-30 00:26:56 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by: $Author: ffr $
+
+source $cfPath(anticollider)/anticollider_common.tcl 
+::anticollider::loadscript acscript.txt

site_ansto/instrument/rsd/config/commands/commands.tcl

@@ -0,0 +1 @@
+source $cfPath(commands)/commands_common.tcl

site_ansto/instrument/rsd/config/hmm/hmm_configuration.tcl

@@ -2,47 +2,48 @@
 source $cfPath(hmm)/hmm_configuration_common_1.tcl
 set sim_mode [SplitReply [hmm_simulation]]
 
+proc ::histogram_memory::init_OAT_TABLE {} {
+  # We don't need a MAX_CHAN parameter for time because the time channel 
+  # is scaled by calling the ::histogram_memory::clock_scale function
+    OAT_TABLE X -setdata MAX_CHAN 421
+    OAT_TABLE Y -setdata MAX_CHAN 421
+    OAT_TABLE X -setdata BMIN -210.5
+    OAT_TABLE X -setdata BMAX  210.5
+    OAT_TABLE Y -setdata BMIN -210.5
+    OAT_TABLE Y -setdata BMAX  210.5
+
+    OAT_TABLE -set X { -210.5 -209.5 } NXC 421 Y { -210.5 -209.5 } NYC 421 T { 0 2000 } NTC 1 
+}
 
 proc ::histogram_memory::pre_count {} {}
 proc ::histogram_memory::post_count {} {}
 proc ::histogram_memory::initialize {} {
-  if {$::sim_mode == "true"} {
+  if [ catch {
-      hmm configure oat_ntc_eff 1
+    if {$::sim_mode == "true"} {
-      hmm configure oat_nyc_eff 421
+        hmm configure oat_ntc_eff 1
-      hmm configure oat_nxc_eff 421
+        hmm configure oat_nyc_eff 421
-  }
+        hmm configure oat_nxc_eff 421
-  ::histogram_memory::_initialize
+    }
+    BAT_TABLE -init
+    CAT_TABLE -init
+    SAT_TABLE -init
+    OAT_TABLE -init
+    FAT_TABLE -init
+    ::histogram_memory::_initialize
 
-  detector_active_height_mm  500
+  # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
-  detector_active_width_mm 500
+  # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
+  # hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
+  # hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
+    ::histogram_memory::init_OAT_TABLE
+    ::histogram_memory::upload_config Filler_defaults
 
-  set x_bb0 -210.5; set xbbmax 210.5
+    ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
-  set y_bb0 -210.5; set ybbmax 210.5
+    ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_pixel_offset
-  hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
+  } message ] {
-  hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
+    if {$::errorCode=="NONE"} {return $message}
-  hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
+    return -code error $message
-  hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
-  set x_binwidth 1
-  if {[expr {$xbbmax - $x_bb0}] > 0} {
-    set x_bb1 [expr {$x_bb0+$x_binwidth}]
-  } else {
-    set x_bb1 [expr {$x_bb0-$x_binwidth}]
   }
-  set y_binwidth 1
-  if {[expr {$ybbmax - $y_bb0}] > 0} {
-    set y_bb1 [expr {$y_bb0+$y_binwidth}]
-  } else {
-    set y_bb1 [expr {$y_bb0-$y_binwidth}]
-  }
-  OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax
-  # We default to one big bin for time
-  set t_bb0 [OAT_TABLE -get T_MIN]
-  set t_bb1 [OAT_TABLE -get T_MAX]
-  OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1"
-  ::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::x_pixel_offset
 }
 
 proc histmem {cmd args} {

site_ansto/instrument/rsd/config/motors/motor_configuration.tcl

@@ -1,7 +1,7 @@
-# $Revision: 1.23 $
+# $Revision: 1.24 $
-# $Date: 2008-05-29 04:55:49 $
+# $Date: 2008-05-30 00:26:56 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
-# Last revision by: $Author: dcl $
+# Last revision by: $Author: ffr $
 
 # START MOTOR CONFIGURATION
 
@@ -62,8 +62,7 @@ set sx_Home 9067806
 set sy_Home 18782188
 
 set som_Home 23164850
-#set stth_Home 28686300
+set stth_Home 28686300
-set stth_Home 29446192
 
 #set psho_home 542093
 set psho_home 7576691
@@ -381,18 +380,18 @@ Motor stth $motor_driver_type [params \
   asyncqueue mc2\
   axis F\
   units degrees\
-  hardlowerlim -90\
+  hardlowerlim 30\
-  hardupperlim 120\
+  hardupperlim 150\
   maxSpeed 0.5\
   maxAccel 0.1\
   maxDecel 0.1\
   stepsPerX 25000\
   absEnc 1\
   absEncHome $stth_Home\
-  cntsPerX -8192]
+  cntsPerX -93207]
-stth softlowerlim -90
+stth softlowerlim 30
-stth softupperlim 120
+stth softupperlim 150
-stth home 0
+stth home 90
 stth speed 0.5
 stth movecount $move_count
 stth precision 0.01

site_ansto/instrument/rsd/kowari_configuration.tcl

@@ -1,5 +1,5 @@
-# $Revision: 1.9 $
+# $Revision: 1.10 $
-# $Date: 2007-11-05 02:29:31 $
+# $Date: 2008-05-30 00:26:56 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
 # Last revision by: $Author: ffr $
 
@@ -19,42 +19,33 @@ source server_config.tcl
 
 fileeval $cfPath(motors)/motor_configuration.tcl
 
-########
-# Parameters set above the restore command will be clobbered by
-# the values in the status.tcl file
-restore
 
+source $cfPath(hipadaba)/hipadaba_configuration.tcl
 fileeval $cfPath(plc)/plc.tcl
 fileeval $cfPath(counter)/counter.tcl
 fileeval $cfPath(hmm)/hmm_configuration.tcl
 fileeval $cfPath(nexus)/nxscripts.tcl
 fileeval $cfPath(scan)/scan.tcl
-source $cfPath(hipadaba)/hipadaba_configuration.tcl
+fileeval $cfPath(commands)/commands.tcl
+fileeval $cfPath(anticollider)/anticollider.tcl
 source gumxml.tcl
 
+########
+# Parameters set above the restore command will be clobbered by
+# the values in the status.tcl file
+# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS
+# AN ERROR IF THERE IS NO ../log/status.tcl FILE.
+restore
+
 ::histogram_memory::initialize
 
-
-VarMake crystal_type Text User
-VarMake crystal_wavelength_A Float User
-
-VarMake bmon_distance Float User
-
-## Column number at beam centre
-VarMake detector_zero_row Float User
-detector_zero_row 255.5
-## Row number at beam centre for a detector rotation of 0 degrees
-VarMake detector_zero_col Float User
-detector_zero_col 100
-
-detector_type Kowari detector
-detector_type lock
-
-detector_description This detects Kowaris
-detector_description lock
-MakeStateMon hmscan 
-
 MakeStateMon hmscan
-fileeval extraconfig.tcl
+if [file exists extraconfig.tcl] {
+  fileeval extraconfig.tcl
+} else {
+  clientput "extraconfig.tcl not found. continueing"
+}
+
+::anticollider::init
 server_set_sobj_attributes
 buildHDB instrument_dictionary

site_ansto/instrument/rsd/script_validator_ports.tcl

@@ -0,0 +1,4 @@
+set quieckport quieck-val-kowari
+set serverport server-val-kowari
+set interruptport interrupt-val-kowari
+set telnetport telnet-val-kowari

site_ansto/instrument/sans/DMC2280/controller1.txt

@@ -1,9 +1,10 @@
 NO TE: QUOKKA - CONTROLLER 1
 NO TE:
-NO TE: $Revision: 1.8 $
+NO TE: $Revision: 1.9 $
-NO TE: $Date: 2007-09-24 01:10:59 $
+NO TE: $Name: not supported by cvs2svn $
+NO TE: $Date: 2008-05-30 00:26:57 $
 NO TE: Author: Dan Bartlett
-NO TE: Last revision by: $Author: dbx $
+NO TE: Last revision by: $Author: ffr $
 NO TE:
 NO TE: A-SAMPLE UPPER TILT
 NO TE: B-SAMPLE LOWER TILT

site_ansto/instrument/sans/DMC2280/controller2.txt

@@ -1,9 +1,10 @@
 NO TE: QUOKKA - CONTROLLER 2
 NO TE:
-NO TE: $Revision: 1.5 $
+NO TE: $Revision: 1.6 $
-NO TE: $Date: 2007-09-24 01:10:59 $
+NO TE: $Name: not supported by cvs2svn $
+NO TE: $Date: 2008-05-30 00:26:57 $
 NO TE: Author: Dan Bartlett
-NO TE: Last revision by: $Author: dbx $
+NO TE: Last revision by: $Author: ffr $
 NO TE:
 NO TE: A-COLLIMATION OPTICS - CHAMBER 1
 NO TE: B-COLLIMATION OPTICS - CHAMBER 2

site_ansto/instrument/sans/DMC2280/controller3.txt

@@ -1,9 +1,10 @@
 NO TE: QUOKKA - CONTROLLER 3
 NO TE:
-NO TE: $Revision: 1.5 $
+NO TE: $Revision: 1.6 $
-NO TE: $Date: 2007-09-24 01:10:59 $
+NO TE: $Name: not supported by cvs2svn $
+NO TE: $Date: 2008-05-30 00:26:57 $
 NO TE: Author: Dan Bartlett
-NO TE: Last revision by: $Author: dbx $
+NO TE: Last revision by: $Author: ffr $
 NO TE:
 NO TE: A-COLLIMATION OPTICS - CHAMBER 9
 NO TE: B-COLLIMATION OPTICS - CHAMBER 10

site_ansto/instrument/sans/DMC2280/controller4.txt

@@ -1,9 +1,10 @@
 NO TE: QUOKKA - CONTROLLER 4
 NO TE:
-NO TE: $Revision: 1.7 $
+NO TE: $Revision: 1.8 $
-NO TE: $Date: 2007-09-24 01:10:59 $
+NO TE: $Name: not supported by cvs2svn $
+NO TE: $Date: 2008-05-30 00:26:57 $
 NO TE: Author: Dan Bartlett
-NO TE: Last revision by: $Author: dbx $
+NO TE: Last revision by: $Author: ffr $
 NO TE:
 NO TE: A-BEAM STOPS TRANS. X (ACCROSS BEAM) +VE=WEST
 NO TE: B-BEAM STOPS TRANSLATION - RAISE

site_ansto/instrument/sans/MANIFEST.TXT

@@ -1,6 +1,6 @@
 quokka_configuration.tcl
-velsel.tcl
 sics_ports.tcl
+script_validator_ports.tcl
 extraconfig.tcl
 config
 util

site_ansto/instrument/sans/config/INSTCFCOMMON.TXT

@@ -1,3 +1,4 @@
+config/anticollider/anticollider_common.tcl
 config/plc/plc_common_1.tcl
 config/counter/counter_common_1.tcl
 config/hipadaba/hipadaba_configuration_common.tcl
@@ -8,3 +9,4 @@ 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

site_ansto/instrument/sans/config/anticollider/acscript.txt

@@ -0,0 +1,3 @@
+# Forbid detector motion when the detector voltage is on
+forbid {-inf inf} for det    when dhv1 in {20 inf}
+forbid {-inf inf} for detoff when dhv1 in {20 inf}

site_ansto/instrument/sans/config/anticollider/anticollider.tcl

@@ -0,0 +1,8 @@
+
+# $Revision: 1.2 $
+# $Date: 2008-05-30 00:26:57 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by: $Author: ffr $
+
+source $cfPath(anticollider)/anticollider_common.tcl 
+::anticollider::loadscript acscript.txt

site_ansto/instrument/sans/config/commands/commands.tcl

@@ -0,0 +1,65 @@
+source $cfPath(commands)/commands_common.tcl
+
+namespace eval sample {
+  command select {int=0:8 sampid} {
+    SampleNum $sampid
+  }
+}
+
+namespace eval optics {
+	VarMake ::optics::select::section text user
+	VarMake ::optics::polarizer::in text user
+	VarMake ::optics::lens::selection text user
+	
+  command rotary_attenuator {int=0,15,45,90,180 angle} {
+    AttRotDeg $angle
+  }
+
+  command entrance_aperture {
+    int=0,45,90,135,180,270 angle
+    text=circ,squ,open,rect shape
+  } {
+    RotApDeg $angle
+    RotApShape $shape
+  }
+
+  command sample_aperture {
+    int=25,50 size
+    text=circ,squ,open,rect shape
+  } {
+    SApXmm $size
+    SApZmm $size
+    SApShape $shape
+  }
+
+##############################
+##
+# @brief set_guide uses a lookup table to setup the collimation system
+# @param row, selects a row from the guide configuration table
+#
+# eg\n
+# set_guide HIRES 
+  command guide "
+  text=[join [array names ::optics::guide_configuration] , ] configuration
+  " {
+
+    variable guide_configuration
+    variable guide_configuration_columns
+
+    array set c1_map {G 1 MT 2 P 3}
+    array set c2_map {MT 1 G 2 A 3}
+    array set c3_map {MT 1 G 2 A 3}
+    array set c4_map {MT 1 G 2 A 3}
+    array set c5_map {MT 1 G 2 A 3}
+    array set c6_map {MT 1 G 2 A 3}
+    array set c7_map {MT 1 G 2 A 3}
+    array set c8_map {MT 1 G 2 A 3}
+    array set c9_map {LP 1 MT 2 G 3 A 4 L 5}
+
+    foreach el $guide_configuration($configuration) guide $guide_configuration_columns {
+      lappend to_config $guide
+      lappend to_config [set ${guide}_map($el)] 
+    }
+    eval "drive $to_config"
+  }
+}

site_ansto/instrument/sans/config/hmm/detector.tcl

@@ -0,0 +1,17 @@
+# Detector voltage controller
+
+set sim_mode [SplitReply [detector_simulation]]
+
+if {$::sim_mode == "true"} {
+  EvFactory new dhv1 sim
+} else {
+  makeasyncqueue acq ORHVPS 137.157.202.85 4001
+  evfactory new dhv1 orhvps acq
+  dhv1 lowerlimit 0
+  dhv1 upperlimit 2400
+  dhv1 tolerance 19
+  dhv1 max 2400
+  dhv1 rate 10
+  dhv1 lock
+}
+

site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl

@@ -1,41 +1,56 @@
 
 source $cfPath(hmm)/hmm_configuration_common_1.tcl
+set sim_mode [SplitReply [hmm_simulation]]
 
+proc ::histogram_memory::init_OAT_TABLE {} {
+  if [ catch {
+  # We don't need a MAX_CHAN parameter for time because the time channel 
+  # is scaled by calling the ::histogram_memory::clock_scale function
+    OAT_TABLE X -setdata MAX_CHAN 128
+    OAT_TABLE Y -setdata MAX_CHAN 128
+    OAT_TABLE X -setdata BMIN -0.5
+    OAT_TABLE X -setdata BMAX  127.5
+    OAT_TABLE Y -setdata BMIN -0.5
+    OAT_TABLE Y -setdata BMAX  127.5
+
+    OAT_TABLE -set X { 127.5 126.5 } NXC 128 Y { -0.5 0.5 } NYC 127 T { 0 2000 } 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::initialize {} {
-  ::histogram_memory::_initialize
+  if [ catch {
+    if {$::sim_mode == "true"} {
+        hmm configure oat_ntc_eff 1
+        hmm configure oat_nyc_eff 127
+        hmm configure oat_nxc_eff 127
+    }
+    BAT_TABLE -init
+    CAT_TABLE -init
+    SAT_TABLE -init
+    OAT_TABLE -init
+    FAT_TABLE -init
+    ::histogram_memory::_initialize
 
-  detector_active_height_mm  192
+    detector_active_height_mm  257.5
-  detector_active_width_mm 192
+    detector_active_width_mm 500
 
-  set x_bb0 -0.5; set xbbmax 191.5
+  # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
-  set y_bb0 -0.5; set ybbmax 191.5
+  # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
-  hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
+  # hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
-  hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
+  # hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
-  hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
+    ::histogram_memory::init_OAT_TABLE
-  hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
+    ::histogram_memory::upload_config Filler_defaults
-  set x_binwidth 1
+
-  if {[expr {$xbbmax - $x_bb0}] > 0} {
+    ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_bin
-    set x_bb1 [expr {$x_bb0+$x_binwidth}]
+    ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_bin
-  } else {
+  } message ] {
-    set x_bb1 [expr {$x_bb0-$x_binwidth}]
+    if {$::errorCode=="NONE"} {return $message}
+    return -code error $message
   }
-  set y_binwidth 1
-  if {[expr {$ybbmax - $y_bb0}] > 0} {
-    set y_bb1 [expr {$y_bb0+$y_binwidth}]
-  } else {
-    set y_bb1 [expr {$y_bb0-$y_binwidth}]
-  }
-  OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax
-  # We default to one big bin for time
-  set t_bb0 [OAT_TABLE -get T_MIN]
-  set t_bb1 [OAT_TABLE -get T_MAX]
-  OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1"
-  ::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::x_pixel_offset
 }
 
 proc histmem {cmd args} {

site_ansto/instrument/sans/config/motors/motor_configuration.tcl

@@ -1,7 +1,7 @@
-# $Revision: 1.15 $
+# $Revision: 1.16 $
-# $Date: 2008-02-19 04:27:19 $
+# $Date: 2008-05-30 00:26:57 $
 # Author: Ferdi Franceschini (ffr@ansto.gov.au)
-# Last revision by: $Author: dcl $
+# Last revision by: $Author: ffr $
 
 # START MOTOR CONFIGURATION
 
@@ -959,39 +959,3 @@ make_coll_motor_1 c8 section_8 pc9 $vc_units
 make_coll_motor_1 c9 section_9 pc10 $vc_units
 unset vc_units
 
-namespace eval guide {
-	VarMake ::guide::select::section text user
-	VarMake ::guide::polarizer::in text user
-	VarMake ::guide::lens::selection text user
-	
-	#TODO Set aperture size variable.
-		command select {int:0,1,2,3,4,5,6,7,8,9 section} {
-			set empty {2 1 1 1 1 1 1 1 2}
-			set aperture {2 3 3 3 3 3 3 3 4}
-			set guide {1 2 2 2 2 2 2 2 3} 
-			array set lens {left 1 right 5 none 2}
-
-			set target $empty 
-			if {$section > 0} {
-				set gr [lrange $guide 0 [expr $section -1]] 
-				set er [lrange $empty $section 8]
-				set target [list $gr $er]
-				if {[SplitReply [::guide::polarizer::in]] == "yes"} {
-					lset target 0 3
-				}
-			} else {
-				lset target 8 $lens([SplitReply [::guide::lens::selection]])
-			}
-			set fh [open junk.txt w]
-			for {set i 1} {$i <= 9} {incr i} {
-				puts $fh "run vc0$i [lindex target [expr {$i-1}]]"
-			}
-			close $fh
-		}
-	command polarizer {text:yes,no in} {
-		::guide::polarizer::in $in
-	}
-	command lens {text:left,right,none selection} {
-		::guide::lens::selection $selection
-	}
-}

site_ansto/instrument/sans/config/optics/guide_configuration.tcl

@@ -10,30 +10,30 @@ namespace eval optics {
 # configuration parameters
 # Rows can be of mixed type
 array set guide_configuration {
-  GA         {MT A  A  A  A  A  A  A  A  } 
+  ga         {MT A  A  A  A  A  A  A  A  } 
-  MT         {MT MT MT MT MT MT MT MT MT }
+  mt         {MT MT MT MT MT MT MT MT MT }
-  LP         {MT MT MT MT MT MT MT MT LP } 
+  lp         {MT MT MT MT MT MT MT MT LP } 
-  LENS       {MT MT MT MT MT MT MT MT L  } 
+  lens       {MT MT MT MT MT MT MT MT L  } 
-  P1         {P  A  MT MT MT MT MT MT MT } 
+  p1         {P  A  MT MT MT MT MT MT MT } 
-  P1LP       {P  A  MT MT MT MT MT MT LP } 
+  p1lp       {P  A  MT MT MT MT MT MT LP } 
-  P1LENS     {P  A  MT MT MT MT MT MT L  } 
+  p1lens     {P  A  MT MT MT MT MT MT L  } 
-  G1         {G  A  MT MT MT MT MT MT MT } 
+  g1         {G  A  MT MT MT MT MT MT MT } 
-  P2         {P  G  A  MT MT MT MT MT MT } 
+  p2         {P  G  A  MT MT MT MT MT MT } 
-  G2         {G  G  A  MT MT MT MT MT MT } 
+  g2         {G  G  A  MT MT MT MT MT MT } 
-  P3         {P  G  G  A  MT MT MT MT MT } 
+  p3         {P  G  G  A  MT MT MT MT MT } 
-  G3         {G  G  G  A  MT MT MT MT MT } 
+  g3         {G  G  G  A  MT MT MT MT MT } 
-  P4         {P  G  G  G  A  MT MT MT MT } 
+  p4         {P  G  G  G  A  MT MT MT MT } 
-  G4         {G  G  G  G  A  MT MT MT MT } 
+  g4         {G  G  G  G  A  MT MT MT MT } 
-  P5         {P  G  G  G  G  A  MT MT MT } 
+  p5         {P  G  G  G  G  A  MT MT MT } 
-  G5         {G  G  G  G  G  A  MT MT MT } 
+  g5         {G  G  G  G  G  A  MT MT MT } 
-  P6         {P  G  G  G  G  G  A  MT MT } 
+  p6         {P  G  G  G  G  G  A  MT MT } 
-  G6         {G  G  G  G  G  G  A  MT MT } 
+  g6         {G  G  G  G  G  G  A  MT MT } 
-  P7         {P  G  G  G  G  G  G  A  MT } 
+  p7         {P  G  G  G  G  G  G  A  MT } 
-  G7         {G  G  G  G  G  G  G  A  MT } 
+  g7         {G  G  G  G  G  G  G  A  MT } 
-  P8         {P  G  G  G  G  G  G  G  A  } 
+  p8         {P  G  G  G  G  G  G  G  A  } 
-  G8         {G  G  G  G  G  G  G  G  A  } 
+  g8         {G  G  G  G  G  G  G  G  A  } 
-  P9         {P  G  G  G  G  G  G  G  G  } 
+  p9         {P  G  G  G  G  G  G  G  G  } 
-  G9         {G  G  G  G  G  G  G  G  G  } 
+  g9         {G  G  G  G  G  G  G  G  G  } 
 }
 
 # This list maps the motor names to columns of the
@@ -49,32 +49,3 @@ namespace eval optics {
   variable guide_configuration_columns
   namespace export set_guide 
 }
-##
-# @brief set_guide uses a lookup table to setup the collimation system
-# @param row, selects a row from the guide configuration table
-#
-# eg\n
-# set_guide HIRES 
-proc ::optics::set_guide {row} {
-  variable guide_configuration
-  variable guide_configuration_columns
-
-  array set c1_map {G 1 MT 2 P 3}
-  array set c2_map {MT 1 G 2 A 3}
-  array set c3_map {MT 1 G 2 A 3}
-  array set c4_map {MT 1 G 2 A 3}
-  array set c5_map {MT 1 G 2 A 3}
-  array set c6_map {MT 1 G 2 A 3}
-  array set c7_map {MT 1 G 2 A 3}
-  array set c8_map {MT 1 G 2 A 3}
-  array set c9_map {LP 1 MT 2 G 3 A 4 L 5}
-
-  foreach el $guide_configuration($row) guide $guide_configuration_columns {
-    lappend to_config $guide
-    lappend to_config [set ${guide}_map($el)] 
-  }
-  eval "drive $to_config"
-}
-namespace import ::optics::set_guide
-
-publish set_guide user